summaryrefslogtreecommitdiff
path: root/dviware/crudetype/version3
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
committerNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
commite0c6872cf40896c7be36b11dcc744620f10adf1d (patch)
tree60335e10d2f4354b0674ec22d7b53f0f8abee672 /dviware/crudetype/version3
Initial commit
Diffstat (limited to 'dviware/crudetype/version3')
-rw-r--r--dviware/crudetype/version3/a-new-version24
-rw-r--r--dviware/crudetype/version3/aaaread.me484
-rw-r--r--dviware/crudetype/version3/circle.tex96
-rw-r--r--dviware/crudetype/version3/crude-c.c3597
-rw-r--r--dviware/crudetype/version3/crudetype.ch11
-rw-r--r--dviware/crudetype/version3/crudetype.pdfbin0 -> 11749 bytes
-rw-r--r--dviware/crudetype/version3/crudetype.web4033
-rw-r--r--dviware/crudetype/version3/hp.ch689
-rw-r--r--dviware/crudetype/version3/hpgf.ch832
-rw-r--r--dviware/crudetype/version3/makefile238
-rw-r--r--dviware/crudetype/version3/mytangle.ch413
-rw-r--r--dviware/crudetype/version3/mytangle.web3513
-rw-r--r--dviware/crudetype/version3/nasty.tex167
-rw-r--r--dviware/crudetype/version3/noscheme-c.c3679
-rw-r--r--dviware/crudetype/version3/noscheme.add88
-rw-r--r--dviware/crudetype/version3/nosve.ch263
-rw-r--r--dviware/crudetype/version3/nosve.com34
-rw-r--r--dviware/crudetype/version3/nosve.doc77
-rw-r--r--dviware/crudetype/version3/nosvebind.cyb1450
-rw-r--r--dviware/crudetype/version3/philips.ch256
-rw-r--r--dviware/crudetype/version3/primos.ch317
-rw-r--r--dviware/crudetype/version3/primos.cpl37
-rw-r--r--dviware/crudetype/version3/pro-pas.ch201
-rw-r--r--dviware/crudetype/version3/rado.tex64
-rw-r--r--dviware/crudetype/version3/sample.tex124
-rw-r--r--dviware/crudetype/version3/small.tex65
-rw-r--r--dviware/crudetype/version3/tables.tex202
-rw-r--r--dviware/crudetype/version3/tiny.dmp77
-rw-r--r--dviware/crudetype/version3/tiny.tex5
-rw-r--r--dviware/crudetype/version3/unix-c.ch564
-rw-r--r--dviware/crudetype/version3/unix-default.h34
-rw-r--r--dviware/crudetype/version3/unix-pas.ch391
-rw-r--r--dviware/crudetype/version3/unix-site.hp168
-rw-r--r--dviware/crudetype/version3/unix-site.sun171
-rw-r--r--dviware/crudetype/version3/unix.cap32
-rw-r--r--dviware/crudetype/version3/unix.h8
-rw-r--r--dviware/crudetype/version3/unixcru.man115
-rw-r--r--dviware/crudetype/version3/unixext.c132
-rw-r--r--dviware/crudetype/version3/vms-build.com83
-rw-r--r--dviware/crudetype/version3/vms.ch150
-rw-r--r--dviware/crudetype/version3/vmshpgf.tex109
-rw-r--r--dviware/crudetype/version3/vmsspew.com17
-rw-r--r--dviware/crudetype/version3/vmsuser.tex140
-rw-r--r--dviware/crudetype/version3/w2c-ext.c628
-rw-r--r--dviware/crudetype/version3/w2c-ext.h137
-rw-r--r--dviware/crudetype/version3/w2c-main.c41
-rw-r--r--dviware/crudetype/version3/w2c-symtab.h29
-rw-r--r--dviware/crudetype/version3/w2c.c623
-rw-r--r--dviware/crudetype/version3/w2c.defines93
-rw-r--r--dviware/crudetype/version3/w2c.h117
-rw-r--r--dviware/crudetype/version3/w2c.lex173
-rw-r--r--dviware/crudetype/version3/w2c.yacc1407
-rw-r--r--dviware/crudetype/version3/w2cbugs57
53 files changed, 26455 insertions, 0 deletions
diff --git a/dviware/crudetype/version3/a-new-version b/dviware/crudetype/version3/a-new-version
new file mode 100644
index 0000000000..c0e8ca6ca3
--- /dev/null
+++ b/dviware/crudetype/version3/a-new-version
@@ -0,0 +1,24 @@
+This describes the new features of Crudetype V3. I assume the flag character is
+'/' as in VMS, other systems use other flags.
+
+1. Two flavours of screen view. /b tries to generate a file suitable for
+examination on a terminal (must be 132 chars wide for most TEX formats). The
+most important change is that no over-struck characters can be shown, so (for
+example the empty set symbol will appear as just O instead of O over-struck
+with / and the multiply sign as / instead of / over-struck with \ . I
+have made a slight attempt to fix various bugs that non-overstriking introduces;
+e.g. in some fonts the less-equal sign ( normally < over-struck with _ ) would
+appear just as < so I made it appear as <= .
+
+2. /i produces immediate output on the terminal. Note that this is very
+system-dependent. I made it work on VMS and some types of Unix but there is no
+way I can possibly make it work on any other system without access to a machine
+of that type. /i can be given an argument, e.g. /i40 . This says that your
+terminal is 40 lines long. Default = 20. /i0 means infinite.
+
+3. Separate horizontal ( /x ) and vertical ( /y ) magnifications. the old
+/m is retained for compatibility only; if you give both /m and /x or /y
+they all take effect. With circle.tex for example, /x150 looks much better
+than /m150 .
+
+
diff --git a/dviware/crudetype/version3/aaaread.me b/dviware/crudetype/version3/aaaread.me
new file mode 100644
index 0000000000..4913de52ef
--- /dev/null
+++ b/dviware/crudetype/version3/aaaread.me
@@ -0,0 +1,484 @@
+SITE: UK.AC.RHBNC.VAX
+DIRECTORY:UHAH:[208.CRUDE]
+
+FILE: AAAREAD.ME. This file lists the intended contents of this directory.
+Note that not all these will be included when I send files out; you can get
+the missing ones if you have FTP access to this site.
+
+********************************** NOTE **********************************
+
+COPYRIGHT ( C ) R.M.Damerell, 1988.
+
+Permission is given to any person to make and distribute copies of this
+software, subject to the following conditions:
+
+1. All copies of the software must carry an exact copy of this notice.
+
+2. This software is distributed free of charge, "AS IS" with absolutely no
+guarantee of performance. Any persons receiving or using this software must do
+so entirely at their own risk. Neither the authors nor their institutions
+accept any liability for any defects of this software, or for any consequential
+loss or damage however caused.
+
+3. Any person who changes this software must clearly mark it as modified and
+add a note describing the changes made. Anybody making substantial additions or
+improvements is requested to give copies to me (RMD).
+
+****************************** VERSION 3 (1990) ********************************
+
+
+First, I want to thank G-H Knauf, M Rawohl, J Warbrick, A Trevorrow and P King,
+for many improvements which I have tried to incorporate into the WEB program.
+At present, this version runs on VMS and SUN-OS3.5 and "similar" versions of
+Unix. I have tried to adapt it to web2c; but the language that web2c translates
+is still nothing like Standard Pascal. The main changes include:
+
+Several new coding schemes;
+
+Separate horizontal and vertical magnifications;
+
+Two flavours of screenview
+
+Barring bugs, I intend V3 to support the Level 0 device driver standard,
+except as follows:
+
+2.6.1. (Location of origin). This must be allowed to move or else a
+negative \hoffset would force off the paper text which on a proper printer
+would be on the paper.
+
+2.6.3. (Range of movement). Standard specifies 2^31 units in any direction;
+Crudetype only allows 2^31-1 because that is VMS Pascal's maxint.
+
+3. Configuration. /D lets you specify the location of fonts. I dont know
+what the Standard means by changing the "naming scheme" for fonts, but I am
+sure you cannot do this without recompiling.
+
+4.1. Font formats. Since Crudetype does not use raster data, it reads TFM
+files only.
+
+5. For reasons explained in my original paper (Tugboat v7) you cannot get
+tolerable results on a lineprinter by merely rounding DVI units to printer
+units. Crudetype has to do something much more complicated.
+
+I have only seen a draft of the Standard, I dont know what changes may have
+been made since.
+
+
+ CRUDETYPE
+
+is written in PASCAL and WEB. In order to reduce the confusion of file names,
+I have had to try to introduce a definite scheme for naming files. In general,
+all files that belong to any particular operating system will have names that
+start with the system's name (truncated if necessary), and end with a (system-
+dependent) suffix indicating the type of file. Any exceptions should be
+documented here. e.g. the Unix Makefile ought to be called UNIX.COM or
+similar. Each file will start with a comment giving its name.
+
+CRUDETYPE.WEB the program, now Version 3
+CRUDETYPE.CH Dummy change file. (Its purpose is to let you weave
+ Crudetype, see below).
+
+
+VMS.CH VMS Change file.
+VMS.COM Command file giving some idea how to build Crudetype on VMS.
+ I am getting less and less interested in VMS; I dont
+ expect to make any serious attempt to debug this.
+VMSUSER.TEX Users documents. These are VMS-specific and will need to
+VMSHPGF.TEX be rewritten on other sites.
+
+
+UNIX.CH Unix Change file (written by Peter King, Heriot-Watt,
+ and copyrighted by him on the same terms. Altered by RMD.
+ I have made so many changes to all these files that I
+ think any bug reports should come to me ).
+Makefile Unix Makefile for the above. (ditto)
+UNIXEXT.C Routines in C to bypass defects in Unix Pascal. Mostly
+ copied from H.Trickey's DVITYEXT.C
+UNIX.CAP printcap file for some printers. buggy. I cannot get X-OFF flow
+ control to work properly.
+UNIXCRU.MAN Attempt at Unix style man page. This must be edited to reflect
+ local conditions.
+
+
+PRIMOS.CH Primos change file, by J.Warbrick.
+PRIMOS.CPL Command file for building this version.
+
+
+NOSVE.CH change file for NOS/VE, by courtesy of G-H Knauf
+ and M.Rawohl, University of Hannover.
+ (Provisional. Please send bug reports to RMD)
+NOSVE.DOC Document for this,
+NOSVE.COM a NOS/VE system procedure to call this program
+ (Needs rewriting, I dont know how)
+NOSVEBIND.CYB CYBIL routines for file handling (N.Schwarz, Ruhr
+ University Bochum).
+
+At present the Primos and NOS-VE files are all out of date; they belong to V2
+and I cannot do anything about this as I have no access to these machines.
+
+
+PRO-PAS.CH Attempted change file for MESS-DOS and Pro-Pascal. Failed
+ because the program is too big for Pro-Pascal, even
+ with the so-called "big" model and with some fudges
+ to reduce the data size. The worst thing is that the
+ diagnostics are completely useless. There is nothing
+ to show how much too big it is, or which bit is too big.
+ You dont even get told where in the program it failed;
+ the error is arbitrarily attached to the last line.
+
+
+NOSCHEME.ADD This has to be used with TFM files that do not have coding
+ schemes. Read it first, then append it to CRUDETYPE.WEB
+ then Tangle as usual. I believe it is system-independent.
+
+
+PHILIPS.CH Obsolete change file for Philips printer.
+HP.CH Change file for Hewlett-Packard Laserjet+
+HPGF.CH Same, but uses GF files instead of PXL. This version
+ is experimental, and slow. Allows /L = Landscape,
+ /E and /O = print even/odd pages only.
+
+
+CRUDETYPE.PAS etc. Files produced during compilation. Not distributed.
+
+W2C.* Modified version of WEB2C. See below.
+
+PHILIPS only works on a particular model of Philips GP300, with a particular
+suite of resident fonts (listed in the .CH file). It is really intended as a
+pattern to show what a printer change file should look like. There is a lot of
+scope for improvement, especially in the design of the multi-character
+commands. Because TEX characters are narrower than Philips, it seems that if
+you format a document correctly for ( say) A4 paper, it falls off the paper
+when printed on the Philips. This is most irritating, and I do not know any
+cure.
+Later: I have had to abandon any serious attempt to debug this version. The
+printer has been removed.
+
+HP cannot do landscape mode. (HPGF can) This could presumably be fixed fairly
+easily, given time. Also I can no longer test HP, because all the PIXEL files
+have been removed.
+
+ INSTALLATION
+
+This requires Pascal and the Stanford Tangle program (You will have Tangle if
+you got your TeX software from a reputable source.) In theory, you compile
+Crudetype the same way as TEX; assemble a suitable change file; then run it
+through Tangle and the Pascal compiler. In order to write Crudetype in any
+reasonably well-structured way I had to break the WEB rule that macros be
+defined before they are used. For simple and parametric macros, this rule is an
+illusion. In Tangle V4, this non-rule has been abandoned. If you use a macro
+before defining it TANGLE prints an error message "This identifier has already
+appeared" but expands it correctly. Such errors can therefore be disregarded.
+For numeric macros it is necessary to define WEB macros before use; I have
+conformed to this rule.
+
+When Crudetype was first written, I hoped to arrange that the installer could
+just take Change files for the local system and printer, concatenate them, and
+go. Unfortunately, it isnt that simple. Even if you are lucky enough to have a
+change file named after your system, there are often site-dependent variations.
+(Some of these are mentioned below). No matter what printer or machine you have
+in mind, I recommend that you get copies of ***all*** available change files.
+They show several possible approaches to similar problems. The basic version of
+Crudetype is designed for a lineprinter; you should start with this version
+because that defers the problems caused by trying to work with two changefiles
+at once.
+
+This seems time to mention a very obscure piece of jiggery-pokery in WEAVE.
+WEAVE will not work unless it can find a changefile. If WEAVE sees the command
+\let\maybe=\iffalse then it inserts a something into its TEX output. The result
+is that TEX prints only those modules that were altered by the changefile.
+CRUDETYPE.WEB contains this command, but CRUDETYPE.CH (which is only a dummy
+changefile) changes this to \iftrue. Weaving Crudetype with this will give the
+whole un-changed program. All the real changefiles leave \maybe unchanged; so
+these will give only the changed modules (well, maybe!!)
+
+Initially Crudetype was written for the VMS operating system, and a lot of very
+system-dependent code got into the main program. As change files started to
+appear, it became clear that this is unclean. I have now tried to remove all the
+most system-dependent code into the VMS change file. A typical example is the
+procedure that parses file names. CRUDETYPE.WEB merely provides a hook to hang
+this procedure on, saying "the changefile must define this procedure". All
+procedures that are handled in this way and all the code that is known to be not
+Standard Pascal are in the section headed "system-dependent code". Suppose that
+you have to write a change file from scratch, the most simple- minded way to
+begin is to choose any of the system change files and just throw the program at
+the compiler and look at the flood of errors that emerge. Tne go through the
+section on system-dependent code using the available change files as a model for
+the parts that have to be rewritten. I would assume that all of this section has
+to be rewritten for any new machine.
+
+If you succeed in getting Crudetype to work, then you need to edit the user
+document VMSUSER.TEX to reflect local conditions.
+
+ DIFFICULTIES
+
+This section describes some of the difficulties that have appeared on various
+systems, excluding those due to bugs in Crudetype, which I have tried to fix.
+Unix presents special difficulties, see below.
+
+1. Incompatible file formats. This disease is particularly bad on VMS systems.
+TEX and related programs assume that a binary file is just a stream of bytes.
+Now it seems that VMS Pascal cannot handle files of this type, so VMS TEX and
+Metafont generate files in fixed length 512-byte records. Crudetype expects
+this format. Some people have started distributing files in incompatible
+formats. I have seen: files in Stream-LF format, files with the bytes in a
+different order, and fixed-record files where the short record at the end is
+padded with what looks like random garbage. Stream-LF has two disadvantages: (a)
+there is no VMS software commonly available that can read it (b) some
+TEX-related files are intended to be read from the end backwards, and VMS Pascal
+can only do this with fixed-record files. What I think is particularly
+anti-social is that the authors of these files have not made any attempt to tell
+the rest of the VMS TEX community what they are doing or why. Later; it appears
+that somebody has cleaned this mess up. I have no idea who it was, but I am very
+grateful to him or her.
+
+When Crudetype meets a bad file, it will probably fail with a "cannot open file
+(name)" error. This can happen because: the file of that name isnt there; or the
+system doesnt give you permission to read it; or it has a bad record structure.
+In VMS, you can check by $DIRECTORY/FULL (name) . If the data is bad (e.g. bytes
+in unexpected order) you can check by dumping the first 100 bytes of the file in
+octal or hex and comparing this with the format as described in TUGboat. Or you
+can try running DVITYPE or TFTOPL or GFTYPE according to whatever file it was.
+This is easier, but if somebody has altered both the files and these programs,
+this will not be apparent. Note the (default) format of VMS DUMP is very
+peculiar, consult its manual.
+
+2. Missing coding schemes. The TFM files that come on tapes from Stanford
+contain a piece of data called a `coding scheme'. Essentially, this tells you
+what letter to expect to find in each cell of the font table, if you ignore
+topological differences of slant, blackness etc. Each table in Appendix F of the
+TEXbook gives a different scheme; and there are a few more schemes in fonts in
+common use. Unfortunately, some font designers have been producing fonts with
+this information lacking. It is not actually illegal to omit the coding scheme
+because the specification for TFM font files describes the coding scheme as
+optional. But in my opinion this is a bad practice. If a site cannot provide
+file space for every conceivable font, they will probably want to save space by
+some form of font-substitution. The coding scheme is an essential tool for
+trying to decide whether Font A is an acceptable substitute for B.
+
+If your TFM files do not have coding schemes, Crudetype should give a "no coding
+scheme" error. You can examine TFM files by TFTOPL or (in VMS) by DUMP. The file
+NOSCHEME.ADD gives code to tackle this problem. To use it, simply append it to
+CRUDETYPE.WEB. This essentially lists the schemes of each of the fonts I happen
+to have seen on a particular distribution. This will clearly go wrong if anybody
+starts writing TFM files of the same names with different schemes, and these new
+schemes are not written into the TFM file. V3 adds support for some Postscript
+fonts (due to J.Warbrick). The Postscript fonts on our site all have coding
+schemes but they were clearly inserted by somebody who didnt know what a coding
+scheme was. The schemes written into the files are like this: "HELVETICA LIGHT
+ITALIC", but the scheme actually used is nearly always "TEX TEXT". So when
+Crudetype finds an unknown scheme, it defaults to "TEX TEXT".
+
+3. Another difficulty (on VMS) was to find some way to get the output file
+across to the printer. I cannot give any useful advice on this because it is
+not merely system- but site-dependent. To get output on the HP, I had to
+connect it as a terminal because it was impossible to drive printers across
+our network. This needed the command:
+ $set terminal/eight_bit/form/pasthru
+to allow data to be tramsmitted correctly.
+ VMSSPEW.COM
+works at our site, as follows: user has to log in, then invoke the .COM file.
+This asks for the file to be printed, then pauses. Then it types the .HPL file
+at the terminal. Meanwhile the user must switch output onto the printer. Messy,
+but it works, and waiting for network software to be debugged is a job for
+Methuselah.
+
+In Unix I had to write a "printcap" file for similar reasons. My attempt at this
+was very buggy.
+
+4. Defects of PASCAL. In order to overcome some of the defects of Berkeley
+Pascal Peter King had to use some C programs which are part of the standard Unix
+Tex distribution (and needed for the same purpose there.) I could not get the
+regular versions of these to work, so I hacked them until they did work (on our
+machines). Essentially, I just deleted everything whose purpose was not obvious,
+but there was also a peculiar bug in passing strings from Pascal into C. These
+routines come in a file called "unixext.c". Eventually he or I might do the
+proper thing and make everything use the Pascal-to-C-converter. Meanwhile
+consult the Makefile for instructions. Similarly, the NOS-VE version uses a
+whole suite of "CYBIL" routines originally written for TEX by N.Schwarz. I
+gather that it is a complicated job to attach these to the program, at any rate
+I have no idea how it is done. You can go back to just using Pascal binding by
+redefining the macros in the changefile.
+
+5. Fortran carriage control. Originally there were bugs in this, I hope they
+are fixed. The code does work on VMS.
+
+6. In V3, the /i flag is extremely system-dependent. I got it to work on VMS
+and SUN-OS 3.5.
+
+
+
+
+
+ OTHER FILES
+
+In order to ease the process of installing the program on another system, I
+have prepared some test files. I am not sending any binary files as these get
+damaged in transit.
+
+SAMPLE.TEX A small piece of straightforward TEX text, copied from
+a Stanford tape.
+
+SAMPLE.DVI Its DVI file, produced by the VMS version of TEX,
+(also from a Stanford tape). Logically a DVI file is just a long stream of
+8-bit bytes, but it appears that VMS cannot handle that type of file properly.
+So VMS TEX writes DVI files in fixed-length 512 byte records.
+
+SAMPLE.PRI Same file, passed through Crudetype. Here again there
+is a peculiarity in the file format. Normal VMS text files have "list"
+carriage control, which means ( roughly speaking) that VMS will insert a CR
+and a LF at the end of each record when it prints the file. Crudetype has to
+use carriage control = NONE , which means that all carriage controls must be
+explicitly inserted by the program.
+
+SAMPLE.PHI Philips printer output.
+SAMPLE.HPL Laserjet printer output, generated by PHILIPS.EXE
+ and HPGF.EXE respectively.
+
+NASTY.TEX A selection from MYTANGLE.TEX . This contains some of
+ the modules from TANGLE; I chose several fragments
+ that gave me trouble when I tried to print them using
+ Crudetype.
+
+NASTY.DVI, etc. As for SAMPLE.
+
+TABLES.TEX, etc. Tries to print all the font tables from the TEXbook.
+ The purpose is to help installers to check any
+ font data that they enter.
+
+TINY.TEX A tiny piece of straight text. Provided to generate
+ the file
+TINY.DMP which is a hexadecimal dump of TINY.HPL . The idea is
+ that when you get a horrible mess coming out on your
+ printer, you can compare this file with a dump of your
+ locally-produced output. Reading VMS dump files is
+ somewhat of a black art: I have added comments.
+
+Another excellent test is to extract the quotation from Galileo from Page
+101 of the TEXbook. (copyright, so I cannot copy it here.) You need to set
+ \varunit=1.078pt
+to get it to work. The line-printed output looks best magnified by about 50%.
+
+
+ RECENT CHANGES
+
+1. Added extra magnification, described above.
+2. (Lineprinter) Improved horizontal & vertical positioning. Previously the
+line spacing jumped from double to triple quite unpredictably. Also WEB-style
+tables of contents used to come out excessively wide because the thin spaces
+between dots got expanded to whole lineprinter spaces. I have made a fix.
+3. (Lineprinter) Support for coding schemes "AEFMNOT ONLY" and "TEX TEXT
+WITHOUT F-LIGATURES".
+4. Improved sort routine. This makes the program at least 3 x faster; I think
+because it now takes advantage of runs in the input, and TEX DVI output is
+very "runny".
+5. I had to abandon the use of PXL files as they are too large. So I have
+cobbled together a GF-using version of HP. It needs a lot more work done on
+it; it is too slow.
+6. Fixed the "no-scheme" bug (caused Crudetype to crash if a TFM file has no
+coding scheme). If you have this sort of TFM file, you will need the file
+NOSCHEME.CH instead of CRUDETYPE.CH . Also some minor fixes.
+7. New version (Version 1, Jan '88). Fixes all bugs so far notified to me.
+Note: it also renders obsolete all previous Change files. The new versions
+all refer to Crudetype v.1.
+8. Tried to make the Lineprinter print TEX MATH EXTENSION characters.
+9. Unix Change file written by Peter King.
+10. NOS/VE Change file by courtesy of G-H Knauf and M.Rawohl.
+11. Version 2. Again, all existing change files are obsolete. Many bugfixes,
+code to read and parse a command line, and (I hope) a much cleaner interface
+to the operating system.
+12. HPGF altered to allow landscape mode printing. Also, print even- or odd-
+numbered pages. In theory this will allow double sided printing, but with
+difficulty.
+13. Some extra characters now get printed.
+14. Primos change file, courtesy J.Warbrick.
+15. After tremendous struggle, got it through web2c.
+16. Version 3.0. Bugfixes. Added flags /x, /y, /d, /b, /i. Try to conform to
+all relevant parts of the draft DVI driver standard (Level 0). Several extra
+coding schemes, courtesy J.Warbrick. Screenview versions, (also originally
+due to J.Warbrick).
+
+V3 makes all older changefiles obsolete. I have adapted vms.ch and unix.ch,
+but cannot deal with primos or nos-ve. I have added Emacs type labels to all
+changefiles.
+
+17. Version 3.01. Modified web2c so it will compile Crudetype. Further details
+below. Tiny change to the WEB file, does not affect any changefile I have seen.
+
+
+
+
+***************************************************************************
+
+MYTANGLE.WEB, .CH, etc.
+
+My version of TANGLE, more-or-less as described in TUGboat. (altered to give
+much better diagnostics than regular TANGLE). The change file is aimed at
+VMS. I hope my alterations might work with other sites versions of TANGLE.CH.
+Recently upgraded to Tangle V4; the VMS version has bugs which I hope to
+fix "soon".
+
+
+***************************************************************************
+
+ RUNNING CRUDETYPE on Unix
+
+This presents special difficulties because many Unix Pascal compilers are very
+bad and also very variable. There is in fact no such language as Unix Pascal;
+instead, there are many languages of the same name. Therefore some members of
+the Unix TEX community wrote a package called WEB2C that translates a very
+specialised and peculiar dialect of Pascal into C. Many constructions of
+Standard Pascal are rejected; others are incorrectly translated. In order to get
+around this I had to write my own version of Web2c; I have called it W2C to
+reduce confusion. The changes are all intended to make W2C more like Standard
+Pascal, but there is still an enormous difference. Also the change files for TEX
+etc contain many fudges to adapt these programs to Web2c; therefore I think it
+very unlikely that you could successfully compile TEX using my W2C. I hope
+sometime to rectify some of the following known defects. All of these and more
+are also in Web2c.
+
+The following constructions of Standard Pascal are mishandled by W2C:
+
+Procedures nested inside procedures; Procedure parameters; Redeclaration of
+identifiers in nested blocks (you can only redefine variables as variables);
+With statements; Variant records; Conformant array parameters; Enumerated types;
+Pointers; Arrays of dimension > 2; File^ for current member of a file; Non-local
+goto.
+
+Also W2C makes no attempt to detect run-time errors or various compile-time
+errors.
+
+Because the diagnostics are poor, I think W2C is only tolerable for use on a
+program that has already been extensively tested on a genuine Pascal compiler;
+so P.King's Unix changefile is still an essential tool for anybody who needs to
+test or debug Crudetype. On the other hand, using W2C does seem likely to work
+on a much wider range of Unixes that using Pascal, and the compiled program is
+roughly twice as fast (comparing unoptimised pc against unoptimised gcc ).
+W2C works on all Unix machines I have access to (not many).
+
+The procedure to build Crudetype from the sources is:
+
+1. On your TEX directory there should be a file called site.h that describes
+local conditions. Either use this or create a local site.h . Edit Makefile to
+point to this file.
+
+2. Edit other macros at the start of Makefile to describe local practice. In
+particular you need to edit the IMAGES macro to say what version(s) you want to
+build.
+
+In Makefile the POSSIBLE_IMAGES are:
+
+crudetype the main version, compiled with W2C.
+crude-p Ditto, compiled with pc
+noscheme-p noscheme-c Use these if your fonts dont have schemes.
+hpgf Attempt at HP LJ+ driver.
+
+
+3. Then run make; make install; and (optional) make clean or veryclean .
+
+This is a long messy process and requires YACC and LEX. If you dont want to do
+all this, I have included the files crude-c.c and noscheme-c.c; if you are
+clever you can probably bypass the w2c stage:
+
+touch crude-c.c
+make crudetype
diff --git a/dviware/crudetype/version3/circle.tex b/dviware/crudetype/version3/circle.tex
new file mode 100644
index 0000000000..a4496a7be7
--- /dev/null
+++ b/dviware/crudetype/version3/circle.tex
@@ -0,0 +1,96 @@
+%CIRCLE.TEX. Test Crudetype's positioning...copied from the TEXbook
+
+\message{ !! For lineprinter, Magnify me to 150 percent !!}
+
+\input manmac
+%\varunit=0.989pt % getting ready to make circular insert
+% that was from the TEXbook, the next line was a comment
+\varunit=1.078pt % was used with amr5: it had more letterspacing
+\setbox0=\vtop{\null
+\baselineskip6\varunit
+\parfillskip0pt
+\parshape 19
+-18.25\varunit 36.50\varunit
+-30.74\varunit 61.48\varunit
+-38.54\varunit 77.07\varunit
+-44.19\varunit 88.39\varunit
+-48.47\varunit 96.93\varunit
+-51.70\varunit 103.40\varunit
+-54.08\varunit 108.17\varunit
+-55.72\varunit 111.45\varunit
+-56.68\varunit 113.37\varunit
+-57.00\varunit 114.00\varunit
+-56.68\varunit 113.37\varunit
+-55.72\varunit 111.45\varunit
+-54.08\varunit 108.17\varunit
+-51.70\varunit 103.40\varunit
+-48.47\varunit 96.93\varunit
+-44.19\varunit 88.39\varunit
+-38.54\varunit 77.07\varunit
+-30.74\varunit 61.48\varunit
+-18.25\varunit 36.50\varunit
+\fiverm
+\frenchspacing
+\noindent
+\hbadness 6000
+\tolerance 9999
+\pretolerance 0
+\hyphenation{iso-peri-met-ric}
+The area of a circle is a mean proportional
+between any two regular and similar polygons of which one
+circumscribes it and the other is isoperimetric with it.
+In addition, the area of the circle is less than that of any
+circumscribed polygon and greater than that of any
+isoperimetric polygon. And further, of these
+circumscribed polygons, the one that has the greater number of sides
+has a smaller area than the one that has a lesser number;
+but, on the other hand, the isoperimetric polygon that
+has the greater number of sides is the larger.
+\hbox to 36.50\varunit{\hss[Galileo,\thinspace1638]\hss}
+}
+
+\danger
+\parshape 16
+3pc 26pc
+3pc 26pc
+0pc 24.69pc
+0pc 23.51pc
+0pc 22.73pc
+0pc 22.20pc
+0pc 21.85pc
+0pc 21.65pc
+0pc 21.58pc
+0pc 21.65pc
+0pc 21.85pc
+0pc 22.20pc
+0pc 22.73pc
+0pc 23.51pc
+0pc 24.69pc
+0pc 29pc
+\vadjust{\moveright 28pc\vbox to 0pt{\vskip88pt\vskip-60\varunit
+ \vskip-3pt\box0\vss}}%
+\strut It's possible to control the length of lines in a much more general
+way, if simple changes to |\leftskip| and |\rightskip| aren't
+flexible enough for your purposes. For example, a semicircular
+^{hole} has been cut out of the present paragraph, in order to make
+room for a circular illustration that contains some of ^{Galileo}'s
+immortal words about ^{circle}s; all of the line breaks in this paragraph
+and in the circular quotation were found by \TeX's line-breaking
+algorithm. You can specify an essentially arbitrary paragraph
+shape by saying ^|\parshape||=|\<number>, where the \<number> is
+a positive integer $n$, followed by $2n$ \<dimen> specifications.
+In general, `|\parshape=|$n$ $i_1$~$l_1$ $i_2$~$l_2$ $\ldots$ $i_n$~$l_n$'
+specifies a paragraph whose first $n$ lines will have lengths
+$l_1$, $l_2$, \dots,~$l_n$, respectively, and they will be
+indented from the left margin by the respective amounts
+$i_1$, $i_2$, \dots,~$i_n$. If the paragraph has fewer than
+$n$ lines, the additional specifications will be ignored;
+if it has more than $n$ lines, the specifications for line $n$ will
+be repeated ad infinitum. You can cancel the effect of a previously
+specified |\parshape| by saying `|\parshape=0|'.\parfillskip0pt
+
+
+
+
+
+\bye
diff --git a/dviware/crudetype/version3/crude-c.c b/dviware/crudetype/version3/crude-c.c
new file mode 100644
index 0000000000..da3ca96abc
--- /dev/null
+++ b/dviware/crudetype/version3/crude-c.c
@@ -0,0 +1,3597 @@
+#include "w2c-ext.h"
+/*732*/
+#define padded true
+#define padchar ' '
+#define ampand '&'
+#define ctrlflag '^'
+#define pauseask "PAUSED. Type <return> to continue"
+#define railwidth 1
+#define railheight 1
+#define postwidth 1
+#define postheight 1
+#define railtypes 2
+#define maxDfonts 100
+#define maxDchar 255
+#define maxligs 10000
+#define maxbuf 201
+#define maxstring 100
+#define pagemax 30000
+#define maxlinesize 1000
+#define leftstop 0
+#define deepest 10
+#define hresolution 10
+#define vresolution 6
+#define fixedwidth true
+#define charwidth 1
+#define gapwidth 1
+#define charht 1
+#define minfont 1
+#define maxfont 1
+#define onlyonefont true
+#define candlfont false
+#define mindlfont 0
+#define maxdlfont 0
+#define maxcodes 60
+#define maxplain 4
+typedef unsigned char byte;
+typedef schar bite;
+typedef short iword;
+typedef text /* file of bite*/bytefile;
+typedef schar Dfontptr;
+typedef unsigned char Dcharptr;
+typedef struct{iword breadth;
+ byte IMfont;
+ byte IMchar;
+ iword multi;
+}codeobject;
+typedef schar codeptr;
+typedef schar trio;
+typedef struct{iword vmove;
+ iword hmove;
+ codeobject symbol;
+ iword num;
+ iword guard;
+}ligthing;
+typedef schar sptr;
+typedef char fixstring[maxstring + 1];
+typedef struct{byte len;
+ fixstring data;
+}varstring;
+typedef short pagei;
+typedef pagei link;
+typedef struct{link prox;
+ iword hpos;
+ iword vpos;
+ codeobject symbol;
+ link down;
+}pagerecord;
+integer ini,inj;
+boolean usestdin;
+varstring command;
+boolean squash,runon,quiet,batchview;
+integer magnify,hmag,vmag,firstpage,countpages;
+bytefile dvifile,tfmfile,rasterfile;
+integer dviindx,tfmindx,rasterindx;
+varstring dviname,tfmname,rastername,printname,dvidef,tfmdef,rasterdef,printex
+;
+varstring fontname,pn,pd,pex;
+text printfile;
+boolean start,timetostop,pagegap;
+integer counter[10];
+integer Dh,Dv,Dw,Dx,Dy,Dz;
+integer Dhstack[203],Dvstack[203],Dwstack[203],Dxstack[203],Dystack[203],
+Dzstack[203];
+unsigned char stackht;
+boolean justpushed;
+real dvifactor,hconv,vconv,magnification;
+integer Dlmargin,Dtopmargin,nnn;
+byte bbb;
+codeobject railchars[railtypes + 1];
+integer railbase;
+codeobject postchar;
+Dfontptr nf;
+integer fontnum[maxDfonts + 1],fontspace[maxDfonts + 1],scheme[maxDfonts + 1],
+firstch[maxDfonts + 1],lastch[maxDfonts + 1];
+integer Dwidth[maxDfonts + 1][maxDchar + 1];
+integer Dcheck,thinspace,Dfont,curscheme;
+varstring knownschemes[maxcodes + 1];
+codeptr schememap[maxcodes + 1];
+codeobject codes[maxcodes + 1][maxDchar + 1];
+codeobject nochar;
+codeptr schemetop;
+ligthing ligatures[maxligs + 1];
+short topofligs;
+iword rowfont;
+byte ch;
+fixstring hack;
+varstring buffer,blank;
+sptr thumb,finger;
+integer Dhleft,IMhleft,Dhmid,IMhmid,Dhright,IMhright,IMh,IMv,Ddis,IMdis,Hshunt
+;
+integer IMhstack[203],IMvstack[203];
+iword hmax,vmax,hmin,vmin;
+link zzz,cell,tempp,curpgeptr,mid,midptr,run,runptr,left,leftptr,Lrunptr,right
+,rightptr,Rrunptr;
+pagei pagesize;
+iword Oldv,Oldh;
+boolean sorted;
+pagerecord pool[pagemax + 1];
+iword PRv,PRvnext,PRh,PRhnext,PRfont;
+char deviceID[13];
+boolean list,xwzfortran,bfeedabsolute,bfeedbystring,feedabsolute,bfeedscream,
+bspaceabsolute,bspacebystring,spaceabsolute,absisincr,wldoescr,wantsplit,
+isheader,dopause,inspection;
+integer wlfeeddist,crfeeddist,feeddist,tfeeddist,bfeeddist,tinydrop,bigdrop,
+spacedist,tspacedist,bspacedist,pausei,pausesteps;
+char feedchar,tfeedchar,crchar,spacechar,tspacechar,bspacechar;
+varstring startstuff,stopstuff,pagetop,bfeedstring,fontcommand,vabscom,habscom
+,pauseafter;
+real hfudge,vfudge,lmargin,topmargin;
+
+#include "coerce.h"
+
+#ifdef ANSI
+void error(void)
+#else /* not ANSI*/
+void error()
+#endif /* ANSI*/
+{ ;
+ }
+
+#ifdef ANSI
+void crash(void)
+#else /* not ANSI*/
+void crash()
+#endif /* ANSI*/
+{ real u;
+ u = -1;
+ error();
+ if((u<0))
+ uexit(1);
+ }
+
+#ifdef ANSI
+void zparsefile( varstring name, varstring *dir, varstring *nam, varstring *ex
+)
+#else /* not ANSI*/
+void zparsefile( name, dir, nam, ex)
+ varstring name;
+ varstring *dir;
+ varstring *nam;
+ varstring *ex;
+#endif /* ANSI*/
+{ sptr p,r,s;
+ dir[0] = blank;
+ nam[0] = blank;
+ ex[0] = blank;
+ s = name.len;
+ if((s>0))
+ {
+ p = ssearch(name,'/',- (integer)s);
+ if((p>0))
+ substring(dir[0],name,1,p);
+ r = ssearch(name,'.',- (integer)s);
+ if((r>p))
+ substring(ex[0],name,r,s-r+1);
+ else r = s+1;
+ substring(nam[0],name,p+1,r-p-1);
+ }
+ }
+
+#ifdef ANSI
+void znameof( fixstring result, varstring name)
+#else /* not ANSI*/
+void znameof( result, name)
+ fixstring result;
+ varstring name;
+#endif /* ANSI*/
+{ integer n,i;
+ n = name.len;
+ if((n>maxstring))
+ n = maxstring;
+ {register integer for_end;i=1;for_end=n; if (i<=for_end)do
+ result[i] = name.data[i];
+ while(i++ < for_end);}
+ {register integer for_end;i=n+1;for_end=maxstring; if (i<=for_end)do
+ result[i] = ' ';
+ while(i++ < for_end);}
+ }
+
+#ifdef ANSI
+boolean zopenbinary( bytefile ff, varstring *name, integer searchpath)
+#else /* not ANSI*/
+boolean zopenbinary( ff, name, searchpath)
+ bytefile ff;
+ varstring *name;
+ integer searchpath;
+#endif /* ANSI*/
+{ register boolean Result;ccharpointer curname;
+ curname = name[0].data;
+ if(testreadaccess(curname,searchpath))
+ {
+ reset(ff,curname);
+ Result = true;
+ }
+ else Result = false;
+ return(Result);
+ }
+
+#ifdef ANSI
+void getcommand(void)
+#else /* not ANSI*/
+void getcommand()
+#endif /* ANSI*/
+{ fixstring ss;
+ integer nn;
+ varstring tt;
+ ccharpointer cc;
+ command = blank;
+ {register integer for_end;nn=1;for_end=argc-1; if (nn<=for_end)do
+ {
+ argv(nn,ss);
+ cc = ss;
+ cc = cc+1;
+ setstring(cc,buffer);
+ tt = buffer;
+ append(command,tt);
+ command.len = command.len+1;
+ }
+ while(nn++ < for_end);}
+ }
+
+#ifdef ANSI
+void readterminal(void)
+#else /* not ANSI*/
+void readterminal()
+#endif /* ANSI*/
+{ byte k;
+ buffer = blank;
+ if(!eof(input))
+ {
+ if(eoln(input))
+ readln(input);
+ k = 0;
+ while((!eoln(input))){
+ k = k+1;
+ read(input,buffer.data[k]);
+ }
+ buffer.len = k;
+ finger = 0;
+ {
+ finger = finger+1;
+ ch = ord(buffer.data[finger]);
+ }
+ }
+ }
+
+#ifdef ANSI
+byte zreadbyte( bytefile ffile, integer *findx)
+#else /* not ANSI*/
+byte zreadbyte( ffile, findx)
+ bytefile ffile;
+ integer *findx;
+#endif /* ANSI*/
+{ register byte Result;bite x;
+ if(eof(ffile))
+ {
+ {
+ fprintf( *output, "%s%s%c", "Error: ", "End of file", '\n');
+ error();
+ }
+ Result = 0;
+ }
+ else{
+ read(ffile,x);
+ if(x<0)
+ Result = x+256;
+ else Result = x;
+ findx[0] = findx[0]+1;
+ }
+ return(Result);
+ }
+
+#ifdef ANSI
+void zskipbytes( bytefile ffile, integer *findx, integer n)
+#else /* not ANSI*/
+void zskipbytes( ffile, findx, n)
+ bytefile ffile;
+ integer *findx;
+ integer n;
+#endif /* ANSI*/
+{ integer k;
+ bite x;
+ if(n<0)
+ {
+ fprintf( *output, "%s%s%c",
+ "Fatal: ", "skip_bytes called with negative number", '\n');
+ crash();
+ }
+ findx[0] = findx[0]+n;
+ {register integer for_end;k=1;for_end=n; if (k<=for_end)do
+ {
+ if(eof(ffile))
+ {
+ fprintf( *output, "%s%s%c", "Error: ", "End of file", '\n');
+ error();
+ }
+ else read(ffile,x);
+ }
+ while(k++ < for_end);}
+ }
+
+#ifdef ANSI
+integer zreadinteger( bytefile ffile, integer *findx, integer k)
+#else /* not ANSI*/
+integer zreadinteger( ffile, findx, k)
+ bytefile ffile;
+ integer *findx;
+ integer k;
+#endif /* ANSI*/
+{ register integer Result;byte a,i;
+ integer n;
+ n = readbyte(ffile,findx[0]);
+ if((k<0)&&(n>127))
+ n = n-256;
+ {register integer for_end;i=1;for_end=abs(k)-1; if (i<=for_end)do
+ {
+ a = readbyte(ffile,findx[0]);
+ n = n*256+a;
+ }
+ while(i++ < for_end);}
+ Result = n;
+ return(Result);
+ }
+
+#ifdef ANSI
+void push(void)
+#else /* not ANSI*/
+void push()
+#endif /* ANSI*/
+{ real x;
+ if(stackht==200)
+ {
+ fprintf( *output, "%s%s%*d%c%c",
+ "Fatal: ", "Capacity exceeded (stack size=", 1, 200, ')', '\n');
+ crash();
+ }
+ else{
+ Dhstack[stackht] = Dh;
+ Dvstack[stackht] = Dv;
+ Dwstack[stackht] = Dw;
+ Dxstack[stackht] = Dx;
+ Dystack[stackht] = Dy;
+ Dzstack[stackht] = Dz;
+ IMhstack[stackht] = IMh;
+ IMvstack[stackht] = IMv;
+ if(justpushed&&(stackht>0))
+ {
+ x = hconv*(Dhstack[stackht]-Dhstack[stackht-1]);
+ if(abs(x)>1.5)
+ IMhstack[stackht] = IMhstack[stackht]+round(x);
+ }
+ Dhleft = Dh;
+ IMhleft = IMhstack[stackht];
+ stackht = stackht+1;
+ justpushed = true;
+ }
+ }
+
+#ifdef ANSI
+void pop(void)
+#else /* not ANSI*/
+void pop()
+#endif /* ANSI*/
+{ if(stackht==0)
+ {
+ fprintf( *output, "%s%s%c", "Error: ", "POP illegal at level zero", '\n')
+ ;
+ error();
+ }
+ else{
+ stackht = stackht-1;
+ Dh = Dhstack[stackht];
+ Dv = Dvstack[stackht];
+ Dw = Dwstack[stackht];
+ Dx = Dxstack[stackht];
+ Dy = Dystack[stackht];
+ Dz = Dzstack[stackht];
+ IMh = IMhstack[stackht];
+ IMv = IMvstack[stackht];
+ railbase = IMv*railtypes;
+ }
+ }
+
+#ifdef ANSI
+void zdopost( integer Drulht, integer Drulwidth)
+#else /* not ANSI*/
+void zdopost( Drulht, Drulwidth)
+ integer Drulht;
+ integer Drulwidth;
+#endif /* ANSI*/
+{ integer vn,vi,hn,hi,postv,rulehp;
+ codeobject rulecod;
+ roundIMh(0);
+ hn = round(Drulwidth*hconv/ ((double)postwidth));
+ vn = round(Drulht*vconv/ ((double)postheight));
+ if(hn<=0)
+ hn = 1;
+ if(vn<=0)
+ vn = 1;
+ rulecod = postchar;
+ Ddis = Drulwidth;
+ IMdis = hn*postwidth;
+ Dhright = Dh+Ddis;
+ IMhright = IMh+IMdis;
+ {register integer for_end;vi=vn-1;for_end=0; if (vi>=for_end)do
+ {
+ postv = IMv-vi*postheight;
+ {register integer for_end;hi=1;for_end=hn; if (hi<=for_end)do
+ {
+ rulehp = IMh+(hi-1)*postwidth;
+ dosetchar(postv,rulehp,rulecod);
+ }
+ while(hi++ < for_end);}
+ }
+ while(vi-- > for_end);}
+ }
+
+#ifdef ANSI
+void zdorail( integer Drulht, integer Drulwidth)
+#else /* not ANSI*/
+void zdorail( Drulht, Drulwidth)
+ integer Drulht;
+ integer Drulwidth;
+#endif /* ANSI*/
+{ integer vn,vi,hn,hi,railv,charvp,rulehp;
+ codeobject rulecod;
+ schar chari;
+ roundIMh(0);
+ hn = round(Drulwidth*hconv/ ((double)railwidth));
+ vn = round(Drulht*vconv*railtypes/ ((double)railheight));
+ if(hn<=0)
+ hn = 1;
+ if(vn<=0)
+ vn = 1;
+ Ddis = Drulwidth;
+ IMdis = hn*railwidth;
+ Dhright = Dh+Ddis;
+ IMhright = IMh+IMdis;
+ {register integer for_end;vi=vn-1;for_end=0; if (vi>=for_end)do
+ {
+ railv = railbase-vi;
+ charvp = ((railv-1)/railtypes)+1;
+ chari = railtypes-((railv-1)%railtypes);
+ rulecod = railchars[chari];
+ {register integer for_end;hi=1;for_end=hn; if (hi<=for_end)do
+ {
+ rulehp = IMh+(hi-1)*railwidth;
+ dosetchar(charvp,rulehp,rulecod);
+ }
+ while(hi++ < for_end);}
+ }
+ while(vi-- > for_end);}
+ }
+
+#ifdef ANSI
+codeptr znamesearch( varstring ss)
+#else /* not ANSI*/
+codeptr znamesearch( ss)
+ varstring ss;
+#endif /* ANSI*/
+{ register codeptr Result;codeptr i;
+ i = schemetop;
+ while(((i>0)&&(!equals(ss,knownschemes[i]))))i = i-1;
+ if((i==0))
+ Result = 0;
+ else Result = i;
+ return(Result);
+ }
+
+#ifdef ANSI
+void zsetscheme( codeptr ix)
+#else /* not ANSI*/
+void zsetscheme( ix)
+ codeptr ix;
+#endif /* ANSI*/
+{ schemetop = schemetop+1;
+ upcase(buffer);
+ knownschemes[schemetop] = buffer;
+ schememap[schemetop] = ix;
+ }
+
+#ifdef ANSI
+void zalphabet( byte start, byte length, codeptr s, byte PRfont, byte PRfirst
+)
+#else /* not ANSI*/
+void zalphabet( start, length, s, PRfont, PRfirst)
+ byte start;
+ byte length;
+ codeptr s;
+ byte PRfont;
+ byte PRfirst;
+#endif /* ANSI*/
+{ integer i;
+ codeobject ccc;
+ if((s<1))
+ {
+ fprintf( *output, "%s%s%c", "Fatal: ", "Alphabet: scheme < 1 ", '\n');
+ crash();
+ }
+ else if((s>maxcodes))
+ {
+ fprintf( *output, "%s%s%c",
+ "Fatal: ", "Alphabet: scheme too large", '\n');
+ crash();
+ }
+ else if((PRfirst<0))
+ {
+ fprintf( *output, "%s%s%c", "Fatal: ", "Alphabet: negative first", '\n');
+ crash();
+ }
+ else if((start<0))
+ {
+ fprintf( *output, "%s%s%c", "Fatal: ", "Alphabet: negative start", '\n')
+ ;
+ crash();
+ }
+ else if((length<0))
+ {
+ fprintf( *output, "%s%s%c", "Fatal: ", "Alphabet: negative length", '\n')
+ ;
+ crash();
+ }
+ else if((start+length-1>maxDchar))
+ {
+ fprintf( *output, "%s%s%c", "Fatal: ", "Alphabet: overflow", '\n');
+ crash();
+ }
+ ccc.IMfont = PRfont;
+ ccc.breadth = charwidth;
+ {register integer for_end;i=0;for_end=length-1; if (i<=for_end)do
+ {
+ ccc.IMchar = PRfirst+i;
+ codes[s][start+i] = ccc;
+ }
+ while(i++ < for_end);}
+ }
+
+#ifdef ANSI
+void zsetstring( ccharpointer ss, varstring *result)
+#else /* not ANSI*/
+void zsetstring( ss, result)
+ ccharpointer ss;
+ varstring *result;
+#endif /* ANSI*/
+{ byte i,j;
+ result[0] = blank;
+ j = strlen(ss)-1;
+ if(padded)
+ {
+ while(((j>0)&&(ss[j]==padchar)))j = j-1;
+ if((j==0)&&(ss[j]==padchar))
+ j = j-1;
+ }
+ j = j+1;
+ if((j>maxstring))
+ {
+ fprintf( *output, "%s%s%c", "Error: ", "String too long", '\n');
+ error();
+ }
+ else{
+ result[0].len = j;
+ {register integer for_end;i=1;for_end=j; if (i<=for_end)do
+ result[0].data[i] = ss[0+i-1];
+ while(i++ < for_end);}
+ }
+ }
+
+#ifdef ANSI
+void zsubstring( varstring *result, varstring ss, integer start,
+ integer length)
+#else /* not ANSI*/
+void zsubstring( result, ss, start, length)
+ varstring *result;
+ varstring ss;
+ integer start;
+ integer length;
+#endif /* ANSI*/
+{ sptr i;
+ result[0] = blank;
+ if(((start<=0)||(length<0)||(start+length>ss.len+1)))
+ {
+ fprintf( *output, "%s%s%c", "Error: ", "Impossible substring", '\n');
+ error();
+ }
+ else{
+ result[0].len = length;
+ {register integer for_end;i=1;for_end=length; if (i<=for_end)do
+ result[0].data[i] = ss.data[i-1+start];
+ while(i++ < for_end);}
+ }
+ }
+
+#ifdef ANSI
+void zappend( varstring *head, varstring tail)
+#else /* not ANSI*/
+void zappend( head, tail)
+ varstring *head;
+ varstring tail;
+#endif /* ANSI*/
+{ integer k;
+ if((head[0].len+tail.len>maxstring))
+ {
+ fprintf( *output, "%s%s%c", "Error: ", "string too long", '\n');
+ error();
+ }
+ else{
+ {register integer for_end;k=1;for_end=tail.len; if (k<=for_end)do
+ head[0].data[k+head[0].len] = tail.data[k];
+ while(k++ < for_end);}
+ head[0].len = head[0].len+tail.len;
+ }
+ }
+
+#ifdef ANSI
+void zaddchar( varstring *s, char c)
+#else /* not ANSI*/
+void zaddchar( s, c)
+ varstring *s;
+ char c;
+#endif /* ANSI*/
+{ if(s[0].len>=maxstring)
+ {
+ fprintf( *output, "%s%s%c", "Error: ", "string too long", '\n');
+ error();
+ }
+ else{
+ s[0].len = s[0].len+1;
+ s[0].data[s[0].len] = c;
+ }
+ }
+
+#ifdef ANSI
+boolean zequals( varstring s, varstring t)
+#else /* not ANSI*/
+boolean zequals( s, t)
+ varstring s;
+ varstring t;
+#endif /* ANSI*/
+{ register boolean Result;ccharpointer c,d;
+ c = s.data;
+ c = c+1;
+ d = t.data;
+ d = d+1;
+ if((s.len!=t.len))
+ Result = false;
+ else Result = (strncmp(c,d,s.len)==0);
+ return(Result);
+ }
+
+#ifdef ANSI
+void zprintcommand( varstring pattern, integer val, char control)
+#else /* not ANSI*/
+void zprintcommand( pattern, val, control)
+ varstring pattern;
+ integer val;
+ char control;
+#endif /* ANSI*/
+{ varstring ss;
+ splice(ss,pattern,val);
+ printstring(printfile,ss,control);
+ }
+
+#ifdef ANSI
+void zprintstring( text f, varstring ss, char control)
+#else /* not ANSI*/
+void zprintstring( f, ss, control)
+ text f;
+ varstring ss;
+ char control;
+#endif /* ANSI*/
+{ sptr i;
+ boolean iscon;
+ char cc;
+ iscon = false;
+ {register integer for_end;i=1;for_end=ss.len; if (i<=for_end)do
+ {
+ cc = ss.data[i];
+ if(iscon)
+ {
+ if((cc!=control))
+ cc = chr(ord(cc)%32);
+ iscon = false;
+ fprintf( *f, "%c", cc);
+ }
+ else if(((cc==control)&&(control!=' ')))
+ iscon = true;
+ else fprintf( *f, "%c", cc);
+ }
+ while(i++ < for_end);}
+ }
+
+#ifdef ANSI
+void zsplice( varstring *out, varstring source, integer nn)
+#else /* not ANSI*/
+void zsplice( out, source, nn)
+ varstring *out;
+ varstring source;
+ integer nn;
+#endif /* ANSI*/
+{ integer i;
+ char cc;
+ varstring tail;
+ i = ssearch(source,ampand,1);
+ if((i==0))
+ out[0] = source;
+ else{
+ substring(out[0],source,1,i-1);
+ substring(tail,source,i+2,source.len-i-1);
+ cc = source.data[i+1];
+ intstring(out[0],nn,cc);
+ append(out[0],tail);
+ }
+ }
+
+#ifdef ANSI
+void zintstring( varstring *result, integer n, char cc)
+#else /* not ANSI*/
+void zintstring( result, n, cc)
+ varstring *result;
+ integer n;
+ char cc;
+#endif /* ANSI*/
+{ integer nn;
+ if((cc=='O'))
+ intbase(result[0],n,8);
+ else if((cc=='H'))
+ intbase(result[0],n,16);
+ else if((cc=='D'))
+ intbase(result[0],n,10);
+ else if((cc=='B')&&(n>=0)&&(n<=255))
+ addchar(result[0],chr(n));
+ else if((cc=='B'))
+ {
+ fprintf( *output, "%s%s%c", "Error: ", "Out-of-range byte", '\n');
+ error();
+ }
+ else if((cc=='W'))
+ {
+ if((n>=0)&&(n<=32767))
+ {
+ addchar(result[0],chr(n/256));
+ addchar(result[0],chr(n%256));
+ }
+ else if((n<0)&&(n>-32768L))
+ {
+ nn = n+65536L;
+ addchar(result[0],chr(nn/256));
+ addchar(result[0],chr(nn%256));
+ }
+ else{
+ fprintf( *output, "%s%s%c", "Error: ", "Out-of-range word", '\n');
+ error();
+ }
+ }
+ else{
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Int_string called with illegal type", '\n');
+ error();
+ }
+ }
+
+#ifdef ANSI
+void zintbase( varstring *result, integer nn, byte s)
+#else /* not ANSI*/
+void zintbase( result, nn, s)
+ varstring *result;
+ integer nn;
+ byte s;
+#endif /* ANSI*/
+{ integer nh;
+ nh = nn;
+ if(nh<0)
+ {
+ addchar(result[0],'-');
+ nh = - (integer)nh;
+ }
+ if(nh>=s)
+ {
+ intbase(result[0],nh/s,s);
+ nh = nh%s;
+ }
+ if(nh>=10)
+ addchar(result[0],chr(nh+55));
+ else addchar(result[0],chr(nh+48));
+ }
+
+#ifdef ANSI
+void zupcase( varstring *ss)
+#else /* not ANSI*/
+void zupcase( ss)
+ varstring *ss;
+#endif /* ANSI*/
+{ sptr i;
+ byte ch;
+ {register integer for_end;i=1;for_end=ss[0].len; if (i<=for_end)do
+ {
+ ch = ord(ss[0].data[i]);
+ if(((ch>=97)&&(ch<=122)))
+ ss[0].data[i] = chr(ch-32);
+ }
+ while(i++ < for_end);}
+ }
+
+#ifdef ANSI
+integer zstoi( integer xwzdefault, boolean insist)
+#else /* not ANSI*/
+integer zstoi( xwzdefault, insist)
+ integer xwzdefault;
+ boolean insist;
+#endif /* ANSI*/
+{ register integer Result;/*732*/integer value,sig;
+ value = xwzdefault;
+ sig = 1;
+ while(((finger<=buffer.len)&&(ch==32))){
+ finger = finger+1;
+ ch = ord(buffer.data[finger]);
+ }
+ if((ch==43))
+ {
+ finger = finger+1;
+ ch = ord(buffer.data[finger]);
+ }
+ else if((ch==45))
+ {
+ sig = -1;
+ {
+ finger = finger+1;
+ ch = ord(buffer.data[finger]);
+ }
+ }
+ thumb = finger;
+ if((finger<=buffer.len)&&((ch>=48)&&(ch<=57)))
+ {
+ value = 0;
+ while(((finger<=buffer.len)&&((ch>=48)&&(ch<=57)))){
+ value = value*10+(ord(ch)-48);
+ {
+ finger = finger+1;
+ ch = ord(buffer.data[finger]);
+ }
+ }
+ value = value*sig;
+ }
+ else if(insist)
+ {
+ {
+ fprintf( *output, "%s%s%c", "Error: ", "Integer expected ", '\n');
+ error();
+ }
+ printstring(output,buffer,' ');
+ fprintf( *output, "%c%c", ' ', '\n');
+ fprintf( *output, "%*c%c", thumb, '^', '\n');
+ goto lab732;
+ }
+ else if(((sig==-1)&&(45==45)))
+ if((finger>1))
+ {
+ finger = finger-1;
+ ch = ord(buffer.data[finger]);
+ }
+ lab732:Result = value;
+ return(Result);
+ }
+
+#ifdef ANSI
+void zgetname( varstring *val)
+#else /* not ANSI*/
+void zgetname( val)
+ varstring *val;
+#endif /* ANSI*/
+{ while(((finger<=buffer.len)&&((ch==32)||(ch==61)))){
+ finger = finger+1;
+ ch = ord(buffer.data[finger]);
+ }
+ thumb = finger;
+ while(((finger<=buffer.len)&&!((ch==32)||(ch==45)))){
+ finger = finger+1;
+ ch = ord(buffer.data[finger]);
+ }
+ substring(val[0],buffer,thumb,finger-thumb);
+ }
+
+#ifdef ANSI
+sptr zssearch( varstring s, char target, integer go)
+#else /* not ANSI*/
+sptr zssearch( s, target, go)
+ varstring s;
+ char target;
+ integer go;
+#endif /* ANSI*/
+{ register sptr Result;/*732*/integer nn,gg;
+ gg = abs(go);
+ nn = 0;
+ if((gg>s.len)||(go==0))
+ {
+ fprintf( *output, "%s%s%c", "Error: ", "Impossible search", '\n');
+ error();
+ }
+ else{
+ if((go>0))
+ {
+ {register integer for_end;nn=gg;for_end=s.len; if (nn<=for_end)do
+ if((s.data[nn]==target))
+ goto lab732;
+ while(nn++ < for_end);}
+ }
+ else{
+ {register integer for_end;nn=gg;for_end=1; if (nn>=for_end)do
+ if((s.data[nn]==target))
+ goto lab732;
+ while(nn-- > for_end);}
+ }
+ nn = 0;
+ }
+ lab732:Result = nn;
+ return(Result);
+ }
+
+#ifdef ANSI
+void zroundIMh( byte code)
+#else /* not ANSI*/
+void zroundIMh( code)
+ byte code;
+#endif /* ANSI*/
+{ integer stop,diff,n,m,delta,newIMh,roundedh;
+ roundedh = round(hconv*(Dh+Dlmargin));
+ delta = Dh-Dhright;
+ if((delta>thinspace)||(delta<=-4*thinspace))
+ newIMh = roundedh;
+ else newIMh = IMhright+round(hconv*(delta));
+ if(!fixedwidth)
+ {
+ if((newIMh>roundedh+2))
+ newIMh = roundedh+2;
+ else if((newIMh<roundedh-2))
+ newIMh = roundedh-2;
+ }
+ else if((delta>thinspace)&&(newIMh<IMhright+gapwidth)&&!(((code==46)||(code
+ ==44))&&((curscheme>0)&&(curscheme<=maxplain))))
+ newIMh = IMhright+gapwidth;
+ else if((delta>-2*thinspace))
+ {
+ if((newIMh<IMhright))
+ newIMh = IMhright;
+ }
+ else{
+ stop = stackht;
+ Dhstack[stop] = Dhleft;
+ IMhstack[stop] = IMhleft;
+ stop = stop+1;
+ Dhstack[stop] = Dhmid;
+ IMhstack[stop] = IMhmid;
+ stop = stop+1;
+ Dhstack[stop] = Dhright;
+ IMhstack[stop] = IMhright;
+ m = stop;
+ {register integer for_end;n=stop;for_end=1; if (n>=for_end)do
+ {
+ diff = Dh-Dhstack[n];
+ if(abs(diff)<=abs(delta))
+ {
+ m = n;
+ delta = diff;
+ }
+ }
+ while(n-- > for_end);}
+ if((delta>thinspace)&&(newIMh<IMhstack[m]+gapwidth))
+ newIMh = IMhstack[m]+gapwidth;
+ else if((delta<- (integer)thinspace)&&(newIMh>IMhstack[m]-gapwidth))
+ newIMh = IMhstack[m]-gapwidth;
+ else if(abs(delta)<=thinspace)
+ newIMh = IMhstack[m];
+ }
+ if(justpushed)
+ {
+ Dhmid = Dh;
+ IMhmid = newIMh;
+ justpushed = false;
+ }
+ IMh = newIMh;
+ }
+
+#ifdef ANSI
+void zsetPRfont( integer newfont)
+#else /* not ANSI*/
+void zsetPRfont( newfont)
+ integer newfont;
+#endif /* ANSI*/
+{ if((newfont==PRfont)||onlyonefont)
+ ;
+ else{
+ printcommand(fontcommand,newfont,ctrlflag);
+ PRfont = newfont;
+ }
+ }
+
+#ifdef ANSI
+void zsetvabs( integer mm)
+#else /* not ANSI*/
+void zsetvabs( mm)
+ integer mm;
+#endif /* ANSI*/
+{ integer newpos;
+ if(absisincr)
+ newpos = mm-PRv;
+ else newpos = mm;
+ printcommand(vabscom,newpos,ctrlflag);
+ PRv = mm;
+ }
+
+#ifdef ANSI
+void zsethabs( integer mm)
+#else /* not ANSI*/
+void zsethabs( mm)
+ integer mm;
+#endif /* ANSI*/
+{ integer newpos;
+ if(absisincr)
+ newpos = mm-PRh;
+ else newpos = mm;
+ printcommand(habscom,newpos,ctrlflag);
+ PRh = mm;
+ }
+
+#ifdef ANSI
+boolean zopenandask( bytefile ff, integer *fc, varstring *name,
+ varstring *xwzdefault, boolean ask)
+#else /* not ANSI*/
+boolean zopenandask( ff, fc, name, xwzdefault, ask)
+ bytefile ff;
+ integer *fc;
+ varstring *name;
+ varstring *xwzdefault;
+ boolean ask;
+#endif /* ANSI*/
+{ register boolean Result;boolean success,fail;
+ varstring defdir,defnam,defex,trydir,trynam,tryex;
+ success = false;
+ fail = false;
+ do{parsefile(xwzdefault[0],defdir,defnam,defex);
+ parsefile(name[0],trydir,trynam,tryex);
+ if((trydir.len==0))
+ name[0] = defdir;
+ else name[0] = trydir;
+ append(name[0],trynam);
+ if((tryex.len==0))
+ append(name[0],defex);
+ else append(name[0],tryex);
+ success = openbinary(ff,name[0],fc[0]);
+ if(success)
+ fc[0] = 0;
+ else if(ask)
+ {
+ fprintf( *output, "%s", "Couldnt open file: ");
+ printstring(output,name[0],' ');
+ fprintf( *output, "%c%c", ' ', '\n');
+ if(true)
+ {
+ {
+ fprintf( *output, "%s%c",
+ "Please type a replacement or NO to abandon search", '\n');
+ readterminal();
+ }
+ name[0] = buffer;
+ if(((name[0].len==2)&&((name[0].data[1]=='N')||(name[0].data[1]=='n'))
+ &&((name[0].data[2]=='O')||(name[0].data[2]=='o'))))
+ fail = true;
+ }
+ else fail = true;
+ }
+ else fail = true;
+ }while( ! (success||fail) );
+ Result = success;
+ return(Result);
+ }
+
+#ifdef ANSI
+real zrrreadreal( bytefile ffile, integer *findx)
+#else /* not ANSI*/
+real zrrreadreal( ffile, findx)
+ bytefile ffile;
+ integer *findx;
+#endif /* ANSI*/
+{ register real Result;integer a,b;
+ a = readinteger(ffile,findx[0],-4);
+ b = readinteger(ffile,findx[0],-4);
+ if(b<=0)
+ {
+ {
+ fprintf( *output, "%s%s%c", "Error: ", "Denominator <= 0! ", '\n');
+ error();
+ }
+ Result = 1;
+ }
+ else Result = a/ ((double)b);
+ return(Result);
+ }
+
+#ifdef ANSI
+void setrule(void)
+#else /* not ANSI*/
+void setrule()
+#endif /* ANSI*/
+{ integer Dp,Dq;
+ Dp = readinteger(dvifile,dviindx,-4);
+ Dq = readinteger(dvifile,dviindx,-4);
+ if((Dp<=0)||(Dq<=0))
+ ;
+ else if((Dp*vconv<=postheight/ ((double)2)))
+ dorail(Dp,Dq);
+ else dopost(Dp,Dq);
+ }
+
+#ifdef ANSI
+void zchangefont( integer Dnew)
+#else /* not ANSI*/
+void zchangefont( Dnew)
+ integer Dnew;
+#endif /* ANSI*/
+{ Dfont = 0;
+ fontnum[nf] = Dnew;
+ while((fontnum[Dfont]!=Dnew))Dfont = Dfont+1;
+ if(Dfont==nf)
+ {
+ fprintf( *output, "%s%s%*d%c",
+ "Error: ", "Undefined font called for, number ", 1, Dnew, '\n');
+ error();
+ }
+ curscheme = scheme[Dfont];
+ thinspace = fontspace[Dfont];
+ }
+
+#ifdef ANSI
+void zdefinefont( integer Dnew)
+#else /* not ANSI*/
+void zdefinefont( Dnew)
+ integer Dnew;
+#endif /* ANSI*/
+{ /*9999 9998*/integer scalesize,designsize,k,f;
+ byte dirlen,namlen;
+ real fontmag;
+ boolean fontok;
+ integer TFMcheck,lh,nw;
+ byte fn,ck;
+ varstring tryname,tfmscheme;
+ integer inwidth[256];
+ byte widptr[256];
+ byte b3,b2,b1,b0;
+ integer alpha,beta,z;
+ Dcheck = readinteger(dvifile,dviindx,-4);
+ scalesize = readinteger(dvifile,dviindx,-4);
+ designsize = readinteger(dvifile,dviindx,-4);
+ dirlen = readinteger(dvifile,dviindx,1);
+ namlen = readinteger(dvifile,dviindx,1);
+ namlen = namlen+dirlen;
+ if(namlen==0)
+ {
+ fprintf( *output, "%s%s%c", "Error: ", "Null font name! ", '\n');
+ error();
+ }
+ else if(namlen>=maxstring)
+ {
+ printstring(output,fontname,' ');
+ fprintf( *output, "%s", " ---- ");
+ {
+ fprintf( *output, "%s%s%*d%c",
+ "Error: ", "Too-long font name! length = ", 1, namlen, '\n');
+ error();
+ }
+ goto lab9999;
+ }
+ tfmname = blank;
+ {register integer for_end;k=1;for_end=namlen; if (k<=for_end)do
+ {
+ tfmname.data[k] = chr(readbyte(dvifile,dviindx));
+ }
+ while(k++ < for_end);}
+ tfmname.len = namlen;
+ fontname = tfmname;
+ if((scalesize<=0)||(scalesize>=134217728L))
+ {
+ printstring(output,fontname,' ');
+ fprintf( *output, "%s", " ---- ");
+ {
+ fprintf( *output, "%s%s%*d%s%c",
+ "Error: ", "Bad scale (", 1, scalesize, ")!", '\n');
+ error();
+ }
+ goto lab9999;
+ }
+ else if((designsize<=0)||(designsize>=134217728L))
+ {
+ printstring(output,fontname,' ');
+ fprintf( *output, "%s", " ---- ");
+ {
+ fprintf( *output, "%s%s%*d%s%c",
+ "Error: ", "Bad design size (", 1, designsize, ")!", '\n');
+ error();
+ }
+ goto lab9999;
+ }
+ fontmag = scalesize/ ((double)designsize);
+ if((fontmag>1000)||(fontmag<0.001))
+ {
+ printstring(output,fontname,' ');
+ fprintf( *output, "%s", " ---- ");
+ {
+ fprintf( *output, "%s%s%E%c",
+ "Error: ", "Way-out font magnification!!! ", fontmag, '\n');
+ error();
+ }
+ goto lab9999;
+ }
+ if(nf==maxDfonts)
+ {
+ fprintf( *output, "%s%s%*d%s%c",
+ "Fatal: ", "Capacity exceeded (max fonts=", 1, maxDfonts, ")!", '\n');
+ crash();
+ }
+ fontnum[nf] = Dnew;
+ f = 0;
+ while((fontnum[f]!=Dnew))f = f+1;
+ if(f<nf)
+ {
+ printstring(output,fontname,' ');
+ fprintf( *output, "%s", " ---- ");
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Font was already defined!", '\n');
+ error();
+ }
+ goto lab9999;
+ }
+ fontspace[nf] = scalesize/6;
+ z = scalesize;
+ alpha = 16*z;
+ beta = 16;
+ while((z>=8388608L)){
+ z = z/2;
+ beta = beta/2;
+ }
+ tryname = tfmname;
+ upcase(tryname);
+ fontspace[nf] = round(fontspace[nf]*0.99);
+ tfmindx = TFMFILEPATH;
+ fontok = openandask(tfmfile,tfmindx,tfmname,tfmdef,true);
+ if(!fontok)
+ {
+ printstring(output,fontname,' ');
+ fprintf( *output, "%s", " ---- ");
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "TFM file can't be opened!", '\n');
+ error();
+ }
+ goto lab9999;
+ }
+ skipbytes(tfmfile,tfmindx,2);
+ lh = readinteger(tfmfile,tfmindx,2);
+ firstch[nf] = readinteger(tfmfile,tfmindx,2);
+ lastch[nf] = readinteger(tfmfile,tfmindx,2);
+ if((lastch[nf]<firstch[nf])||(lastch[nf]>maxDchar))
+ {
+ printstring(output,fontname,' ');
+ fprintf( *output, "%s", " ---- ");
+ {
+ fprintf( *output, "%s%s%*d%s%*d%c",
+ "Error: ", "Illegal values for first_char and/or last_char, first_char = ", 1, firstch[nf], " last_char = ", 1, lastch[nf], '\n')
+ ;
+ error();
+ }
+ goto lab9999;
+ }
+ nw = readinteger(tfmfile,tfmindx,2);
+ if((nw==0)||(nw>256))
+ {
+ printstring(output,fontname,' ');
+ fprintf( *output, "%s", " ---- ");
+ {
+ fprintf( *output, "%s%s%d%c",
+ "Error: ", "Illegal value for nw, nw= ", nw, '\n');
+ error();
+ }
+ goto lab9999;
+ }
+ skipbytes(tfmfile,tfmindx,14);
+ TFMcheck = readinteger(tfmfile,tfmindx,-4);
+ skipbytes(tfmfile,tfmindx,4);
+ tfmscheme = blank;
+ if(lh<2)
+ {
+ printstring(output,fontname,' ');
+ fprintf( *output, "%s", " ---- ");
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Header must have at least 2 words", '\n');
+ error();
+ }
+ goto lab9999;
+ }
+ else if(lh==2)
+ ;
+ else{
+ ck = readbyte(tfmfile,tfmindx);
+ if((ck>=40)||(ck>4*lh-9))
+ skipbytes(tfmfile,tfmindx,4*lh-9);
+ else{
+ tfmscheme.len = ck;
+ {register integer for_end;k=1;for_end=ck; if (k<=for_end)do
+ tfmscheme.data[k] = chr(readbyte(tfmfile,tfmindx));
+ while(k++ < for_end);}
+ skipbytes(tfmfile,tfmindx,4*lh-ck-9);
+ upcase(tfmscheme);
+ }
+ }
+ fn = namesearch(tryname);
+ if((fn==0))
+ {
+ k = tryname.len;
+ while(((ord(tryname.data[k])>=48)&&(ord(tryname.data[k])<=57))){
+ tryname.data[k] = ' ';
+ k = k-1;
+ }
+ tryname.len = k;
+ fn = namesearch(tryname);
+ if((fn==0))
+ fn = namesearch(tfmscheme);
+ }
+ if((fn==0)&&candlfont)
+ ;
+ else if((fn==0))
+ {
+ printstring(output,fontname,' ');
+ fprintf( *output, "%c%c", ':', '\n');
+ if((tfmscheme.len>0))
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Unknown coding scheme, using TEX TEXT instead", '\n');
+ error();
+ }
+ else{
+ fprintf( *output, "%s%s%c",
+ "Error: ", "No coding scheme, using TEX TEXT instead (examine NOSCHEME.ADD) ", '\n')
+ ;
+ error();
+ }
+ scheme[nf] = schememap[3];
+ }
+ else scheme[nf] = schememap[fn];
+ {register integer for_end;k=firstch[nf];for_end=lastch[nf]; if (k<=for_end)
+ do
+ {
+ widptr[k] = readbyte(tfmfile,tfmindx);
+ skipbytes(tfmfile,tfmindx,3);
+ if(widptr[k]>nw)
+ {
+ printstring(output,fontname,' ');
+ fprintf( *output, "%s", " ---- ");
+ {
+ fprintf( *output, "%s%s%d%c",
+ "Error: ", "Impossible width ", widptr[k], '\n');
+ error();
+ }
+ goto lab9999;
+ }
+ }
+ while(k++ < for_end);}
+ {register integer for_end;k=0;for_end=nw-1; if (k<=for_end)do
+ {
+ b0 = readbyte(tfmfile,tfmindx);
+ b1 = readbyte(tfmfile,tfmindx);
+ b2 = readbyte(tfmfile,tfmindx);
+ b3 = readbyte(tfmfile,tfmindx);
+ inwidth[k] = (((((b3*z)/256)+(b2*z))/256)+(b1*z))/beta;
+ if(b0==255)
+ inwidth[k] = inwidth[k]-alpha;
+ else if(b0!=0)
+ {
+ printstring(output,fontname,' ');
+ fprintf( *output, "%s", " ---- ");
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Out-of-bounds value for b0", '\n');
+ error();
+ }
+ goto lab9999;
+ }
+ }
+ while(k++ < for_end);}
+ if(inwidth[0]!=0)
+ {
+ printstring(output,fontname,' ');
+ fprintf( *output, "%s", " ---- ");
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "First width should be zero ", '\n');
+ error();
+ }
+ goto lab9999;
+ }
+ {register integer for_end;k=firstch[nf];for_end=lastch[nf]; if (k<=for_end)
+ do
+ Dwidth[nf][k] = inwidth[widptr[k]];
+ while(k++ < for_end);}
+ lab9998:{register integer for_end;k=firstch[nf];for_end=lastch[nf]; if (k<=
+ for_end)do
+ if((Dwidth[nf][k]<0)||(Dwidth[nf][k]>50000000L))
+ {
+ {
+ fprintf( *output, "%s%s%*d%s%*d%c",
+ "Error: ", "Way-out width = ", 1, Dwidth[nf][k], "DVI units, character number ", 1, k, '\n')
+ ;
+ error();
+ }
+ codes[scheme[nf]][k].breadth = -32766;
+ }
+ while(k++ < for_end);}
+ if((Dcheck!=0)&&(TFMcheck!=0)&&(Dcheck!=TFMcheck))
+ {
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Check sums do not agree!", '\n');
+ error();
+ }
+ fprintf( *output, "%s%d%s%d%c",
+ "DVI check was: ", Dcheck, " TFM check was: ", TFMcheck, '\n');
+ fprintf( *output, "%s", " ");
+ }
+ fontmag = (fontmag-1)*100.0;
+ if(!quiet)
+ {
+ fprintf( *output, "%c%c", ' ', '\n');
+ printstring(output,fontname,' ');
+ fprintf( *output, "%s%*d%s",
+ " --- loaded at ", 1, scalesize, " DVI units");
+ if(abs(fontmag)>1)
+ fprintf( *output, "%s%*d%s", " ( magnified ", 1, round(fontmag), "%)");
+ fprintf( *output, "%c%c", ' ', '\n');
+ }
+ nf = nf+1;
+ lab9999:if(fontok)
+ ;
+ }
+
+#ifdef ANSI
+void zsetcharacter( integer cnum)
+#else /* not ANSI*/
+void zsetcharacter( cnum)
+ integer cnum;
+#endif /* ANSI*/
+{ codeobject cod;
+ integer di;
+ if(curscheme==0)
+ ;
+ else if((cnum<firstch[Dfont])||(cnum>lastch[Dfont]))
+ {
+ {
+ fprintf( *output, "%s%s%*d%s%*d%c",
+ "Error: ", "Character ", 1, cnum, " invalid in font number ", 1, fontnum[Dfont], '\n')
+ ;
+ error();
+ }
+ }
+ else{
+ cod = codes[curscheme][cnum];
+ if(cod.breadth!=-32766)
+ {
+ roundIMh(cnum);
+ if(cod.breadth==-32765)
+ ;
+ dosetchar(IMv,IMh,cod);
+ Ddis = Dwidth[Dfont][cnum];
+ if(cod.breadth==-32766)
+ IMdis = 0;
+ else IMdis = abs(cod.breadth);
+ railbase = IMv*railtypes;
+ Dhright = Dh+Ddis;
+ IMhright = IMh+IMdis;
+ }
+ }
+ }
+
+#ifdef ANSI
+void zdosetchar( iword Setv, iword Seth, codeobject cod)
+#else /* not ANSI*/
+void zdosetchar( Setv, Seth, cod)
+ iword Setv;
+ iword Seth;
+ codeobject cod;
+#endif /* ANSI*/
+{ iword ki,kk,tempv,temph;
+ codeobject mc;
+ short kptr;
+ if(cod.breadth>=0)
+ {
+ if((Seth<hmin))
+ {
+ {
+ fprintf( *output, "%s%s%c", "Error: ", "Out of bounds --left", '\n');
+ error();
+ }
+ Seth = 0;
+ }
+ else if((Seth>hmax))
+ {
+ {
+ fprintf( *output, "%s%s%c", "Error: ", "Out of bounds --right", '\n')
+ ;
+ error();
+ }
+ Seth = hmax;
+ }
+ if((Setv<vmin)||(Setv>vmax))
+ {
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Out of bounds -- vertical ", '\n');
+ error();
+ }
+ Setv = vmax;
+ }
+ if(Hshunt>(Seth-3))
+ Hshunt = (Seth-3);
+ {
+ if(((Oldv>Setv)||((Oldv==Setv)&&(Oldh>Seth))))
+ {
+ pool[runptr].prox = zzz;
+ runptr = pool[run].prox;
+ cell = cell+1;
+ pool[midptr].prox = cell;
+ midptr = cell;
+ pool[midptr].down = runptr;
+ runptr = run;
+ pool[run].prox = zzz;
+ }
+ cell = cell+1;
+ pool[runptr].prox = cell;
+ runptr = cell;
+ {
+ pool[runptr].hpos = Seth;
+ Oldh = Seth;
+ pool[runptr].vpos = Setv;
+ Oldv = Setv;
+ pool[runptr].symbol = cod;
+ }
+ pagesize = pagesize+1;
+ if(pagesize>=pagemax)
+ {
+ fprintf( *output, "%s%s%c",
+ "Fatal: ", "Overflowed page: either a bug, or recompile with larger page_max", '\n')
+ ;
+ crash();
+ }
+ }
+ }
+ else if(cod.breadth==-32766)
+ ;
+ else{
+ if((cod.multi<=0)||(cod.multi>topofligs))
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Illegal value of char in multi-character command", '\n');
+ error();
+ }
+ else{
+ kptr = cod.multi;
+ if((ligatures[kptr].guard!=-32767))
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Sentry not found in Kerns ", '\n');
+ error();
+ }
+ ki = ligatures[kptr].num;
+ kptr = kptr-2*ki;
+ if((ki<=0)||(kptr<0))
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Illegal value of k_i in multi-character command", '\n');
+ error();
+ }
+ {register integer for_end;kk=1;for_end=ki; if (kk<=for_end)do
+ {
+ tempv = Setv+ligatures[kptr].vmove;
+ temph = Seth+ligatures[kptr].hmove;
+ kptr = kptr+1;
+ mc = ligatures[kptr].symbol;
+ dosetchar(tempv,temph,mc);
+ kptr = kptr+1;
+ }
+ while(kk++ < for_end);}
+ }
+ }
+ }
+
+#ifdef ANSI
+void zrowchar( integer context, codeobject *value)
+#else /* not ANSI*/
+void zrowchar( context, value)
+ integer context;
+ codeobject *value;
+#endif /* ANSI*/
+{ /*732*/
+#define obra 123
+#define oket 125
+#define hbra 91
+#define hket 93
+#define vbra 60
+#define vket 62
+ ligthing ligbuff[maxbuf + 1];
+ unsigned char bufnum;
+ unsigned char buflen;
+ iword deltah,deltav;
+ byte ch,bra;
+ integer i;
+ codeobject rowcod;
+ integer printwidth;
+ value[0].breadth = charwidth;
+ value[0].IMfont = rowfont;
+ {
+ finger = finger+1;
+ ch = ord(buffer.data[finger]);
+ }
+ if((context==0)&&(ch!=32)&&(ch!=90))
+ {
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Character specifiers must start with at least one space", '\n')
+ ;
+ error();
+ }
+ printstring(output,buffer,' ');
+ fprintf( *output, "%c%c", ' ', '\n');
+ fprintf( *output, "%*c%c", thumb, '^', '\n');
+ goto lab732;
+ }
+ while(((finger<=buffer.len)&&(ch==32))){
+ finger = finger+1;
+ ch = ord(buffer.data[finger]);
+ }
+ if(!(finger<=buffer.len))
+ {
+ {
+ fprintf( *output, "%s%s%c", "Error: ", "Fallen off row", '\n');
+ error();
+ }
+ printstring(output,buffer,' ');
+ fprintf( *output, "%c%c", ' ', '\n');
+ fprintf( *output, "%*c%c", thumb, '^', '\n');
+ goto lab732;
+ }
+ if((ch==65))
+ value[0].IMchar = 64;
+ else if((ch==83))
+ value[0].IMchar = 32;
+ else if((ch==81))
+ value[0].IMchar = 39;
+ else if((ch==87))
+ value[0].IMchar = 34;
+ else if((ch==69))
+ value[0].IMchar = 127;
+ else if((ch==39)||(ch==34)||(ch==64)||(ch==127))
+ {
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Bad character---Rejected", '\n');
+ error();
+ }
+ printstring(output,buffer,' ');
+ fprintf( *output, "%c%c", ' ', '\n');
+ fprintf( *output, "%*c%c", thumb, '^', '\n');
+ goto lab732;
+ }
+ else if((ch==32))
+ {
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Space found out of context", '\n');
+ error();
+ }
+ printstring(output,buffer,' ');
+ fprintf( *output, "%c%c", ' ', '\n');
+ fprintf( *output, "%*c%c", thumb, '^', '\n');
+ goto lab732;
+ }
+ else if((ch==90))
+ value[0].breadth = -32766;
+ else if((ch==76))
+ {
+ {
+ finger = finger+1;
+ ch = ord(buffer.data[finger]);
+ }
+ value[0].IMchar = ch;
+ }
+ else if((ch==67))
+ {
+ {
+ finger = finger+1;
+ ch = ord(buffer.data[finger]);
+ }
+ value[0].IMchar = ch%32;
+ }
+ else if((context>=250))
+ value[0].IMchar = ch;
+ else if((ch==77))
+ {
+ rowchar(250,value[0]);
+ value[0].IMchar = value[0].IMchar+128;
+ }
+ else if(((ch==78)||(ch==68))&&(context>=230))
+ {
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Narrow or Down escape out of context", '\n');
+ error();
+ }
+ printstring(output,buffer,' ');
+ fprintf( *output, "%c%c", ' ', '\n');
+ fprintf( *output, "%*c%c", thumb, '^', '\n');
+ goto lab732;
+ }
+ else if((ch==78))
+ {
+ rowchar(230,value[0]);
+ value[0].breadth = 0;
+ }
+ else if((ch==68))
+ {
+ rowchar(230,value[0]);
+ value[0].breadth = -32765;
+ }
+ else if((ch==70))
+ {
+ rowfont = stoi(0,true);
+ if((context==0))
+ rowchar(1,value[0]);
+ else rowchar(context,value[0]);
+ }
+ else if((ch==obra)||(ch==hbra)||(ch==vbra))
+ {
+ if((context>=ch))
+ {
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Illegal nesting of brackets in row_spec", '\n');
+ error();
+ }
+ printstring(output,buffer,' ');
+ fprintf( *output, "%c%c", ' ', '\n');
+ fprintf( *output, "%*c%c", thumb, '^', '\n');
+ goto lab732;
+ }
+ {register integer for_end;i=1;for_end=maxbuf; if (i<=for_end)do
+ ligbuff[i].symbol = nochar;
+ while(i++ < for_end);}
+ buflen = 0;
+ deltah = 0;
+ deltav = 0;
+ bra = ch;
+ do{rowchar(bra,rowcod);
+ if((rowcod.breadth==-32764))
+ deltav = deltav-charht;
+ else if((rowcod.breadth==-32763))
+ ;
+ else if((buflen+3>maxbuf))
+ {
+ fprintf( *output, "%s%s%c",
+ "Fatal: ", "Overflowed lig_buff array", '\n');
+ crash();
+ }
+ else if((rowcod.breadth==-32762))
+ deltah = deltah-stoi(0,true);
+ else if((rowcod.breadth==-32761))
+ deltav = deltav-stoi(0,true);
+ else{
+ buflen = buflen+1;
+ ligbuff[buflen].vmove = deltav;
+ ligbuff[buflen].hmove = deltah;
+ buflen = buflen+1;
+ ligbuff[buflen].symbol = rowcod;
+ if((bra==vbra))
+ deltav = deltav+charht;
+ if(((bra==hbra)||(batchview&&(bra==obra))))
+ deltah = deltah+charwidth;
+ }
+ }while( ! ((rowcod.breadth==-32763)||!(finger<=buffer.len)) );
+ bufnum = 0;
+ if((buflen==0))
+ value[0].breadth = -32766;
+ else if((topofligs+buflen+1>=maxligs))
+ {
+ fprintf( *output, "%s%s%c",
+ "Fatal: ", "Ligature array overflowed, must recompile with larger array", '\n')
+ ;
+ crash();
+ }
+ else{
+ {register integer for_end;i=1;for_end=buflen; if (i<=for_end)do
+ ligatures[topofligs+i] = ligbuff[i];
+ while(i++ < for_end);}
+ topofligs = topofligs+buflen+1;
+ bufnum = buflen/2;
+ ligatures[topofligs].num = bufnum;
+ ligatures[topofligs].guard = -32767;
+ value[0].multi = topofligs;
+ value[0].breadth = -20000;
+ }
+ if((bra==obra))
+ printwidth = charwidth;
+ else if((bra==hbra))
+ printwidth = deltah;
+ else{
+ printwidth = charwidth;
+ {register integer for_end;i=1;for_end=bufnum; if (i<=for_end)do
+ if((printwidth<- (integer)ligbuff[2*i].symbol.breadth)&&(ligbuff[2*i]
+ .symbol.breadth>-30000))
+ printwidth = - (integer)ligbuff[2*i].symbol.breadth;
+ while(i++ < for_end);}
+ }
+ value[0].breadth = - (integer)printwidth;
+ }
+ else if((ch==85)&&(context==vbra))
+ value[0].breadth = -32764;
+ else if((ch==85))
+ {
+ {
+ fprintf( *output, "%s%s%c", "Error: ", "U escape out of context", '\n')
+ ;
+ error();
+ }
+ printstring(output,buffer,' ');
+ fprintf( *output, "%c%c", ' ', '\n');
+ fprintf( *output, "%*c%c", thumb, '^', '\n');
+ goto lab732;
+ }
+ else if(((ch==oket)||(ch==hket)||(ch==vket))&&(context==ch-2))
+ value[0].breadth = -32763;
+ else if((ch==oket)||(ch==hket)||(ch==vket))
+ {
+ {
+ fprintf( *output, "%s%s%c", "Error: ", "Mismatching brackets ", '\n');
+ error();
+ }
+ printstring(output,buffer,' ');
+ fprintf( *output, "%c%c", ' ', '\n');
+ fprintf( *output, "%*c%c", thumb, '^', '\n');
+ goto lab732;
+ }
+ else if((ch==75)&&(context==hbra))
+ value[0].breadth = -32762;
+ else if((ch==75)&&(context==vbra))
+ value[0].breadth = -32761;
+ else if((ch==75))
+ {
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Kern escape out of context", '\n');
+ error();
+ }
+ printstring(output,buffer,' ');
+ fprintf( *output, "%c%c", ' ', '\n');
+ fprintf( *output, "%*c%c", thumb, '^', '\n');
+ goto lab732;
+ }
+ else value[0].IMchar = ch;
+ lab732:;
+ }
+
+#ifdef ANSI
+void parsecommand(void)
+#else /* not ANSI*/
+void parsecommand()
+#endif /* ANSI*/
+{ /*732*/byte key;
+ buffer = command;
+ finger = 0;
+ {
+ finger = finger+1;
+ ch = ord(buffer.data[finger]);
+ }
+ while((finger<=buffer.len)){
+ while(((finger<=buffer.len)&&(ch==32))){
+ finger = finger+1;
+ ch = ord(buffer.data[finger]);
+ }
+ if((finger<=buffer.len)&&(ch==45))
+ {
+ {
+ finger = finger+1;
+ ch = ord(buffer.data[finger]);
+ }
+ thumb = finger;
+ if(((ch>=97)&&(ch<=122)))
+ ch = ch-32;
+ key = ch;
+ {
+ finger = finger+1;
+ ch = ord(buffer.data[finger]);
+ }
+ while(((finger<=buffer.len)&&((ch==32)||(ch==61)))){
+ finger = finger+1;
+ ch = ord(buffer.data[finger]);
+ }
+ if((key==81))
+ quiet = true;
+ else if((key==83))
+ squash = true;
+ else if((key==82))
+ runon = true;
+ else if((key==80))
+ getname(printname);
+ else if((key==68))
+ getname(tfmdef);
+ else if((key==70))
+ firstpage = stoi(firstpage,true);
+ else if((key==67))
+ countpages = stoi(countpages,true);
+ else if((key==77))
+ magnify = stoi(magnify,true);
+ else if((key==88))
+ hmag = stoi(hmag,true);
+ else if((key==89))
+ vmag = stoi(vmag,true);
+ else if((key==66))
+ batchview = true;
+ else if((key==73))
+ {
+ inspection = true;
+ pausei = stoi(pausesteps,false);
+ if(((pausei<0)||(pausei>200)))
+ {
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Illegal value for I flag", '\n');
+ error();
+ }
+ printstring(output,buffer,' ');
+ fprintf( *output, "%c%c", ' ', '\n');
+ fprintf( *output, "%*c%c", thumb, '^', '\n');
+ goto lab732;
+ }
+ else pausesteps = pausei;
+ pausei = 0;
+ }
+ else{
+ {
+ fprintf( *output, "%s%s%c", "Error: ", "Unknown command ", '\n');
+ error();
+ }
+ printstring(output,buffer,' ');
+ fprintf( *output, "%c%c", ' ', '\n');
+ fprintf( *output, "%*c%c", thumb, '^', '\n');
+ goto lab732;
+ }
+ }
+ else if((finger<=buffer.len))
+ {
+ if((dviname.len>0))
+ {
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Two filenames. Previous name will be ignored, it was:", '\n')
+ ;
+ error();
+ }
+ printstring(output,dviname,' ');
+ fprintf( *output, "%c%c", ' ', '\n');
+ }
+ getname(dviname);
+ }
+ lab732:;
+ }
+ }
+
+#ifdef ANSI
+void zmovedown( integer ddd)
+#else /* not ANSI*/
+void zmovedown( ddd)
+ integer ddd;
+#endif /* ANSI*/
+{ integer newIMv,delta;
+ Dv = Dv+ddd;
+ delta = round(vconv*(ddd));
+ if(delta>=bigdrop)
+ {
+ newIMv = round(vconv*(Dv+Dtopmargin));
+ if((newIMv<IMv+bigdrop))
+ IMv = IMv+bigdrop;
+ else IMv = newIMv;
+ railbase = IMv*railtypes;
+ }
+ else if((delta<=- (integer)bigdrop))
+ {
+ newIMv = round(vconv*(Dv+Dtopmargin));
+ if((newIMv>IMv-bigdrop))
+ IMv = IMv-bigdrop;
+ else IMv = newIMv;
+ railbase = IMv*railtypes;
+ }
+ else{
+ IMv = IMv+delta;
+ railbase = railbase+round(vconv*(ddd*railtypes));
+ if((ddd>tinydrop)&&(delta==0))
+ IMv = IMv+1;
+ else if((ddd<- (integer)tinydrop)&&(delta==0))
+ IMv = IMv-1;
+ else railbase = IMv*railtypes;
+ }
+ }
+
+#ifdef ANSI
+link readline(void)
+#else /* not ANSI*/
+link readline()
+#endif /* ANSI*/
+{ register link Result;link head,tail;
+ integer size;
+ head = curpgeptr;
+ size = 0;
+ PRvnext = pool[curpgeptr].vpos;
+ do{tail = curpgeptr;
+ curpgeptr = pool[curpgeptr].prox;
+ size = size+1;
+ if(size==maxlinesize)
+ {
+ fprintf( *output, "%s%s%c", "Error: ", "Excessively long line ", '\n');
+ error();
+ }
+ }while( ! ((((curpgeptr==zzz))||(PRvnext!=pool[curpgeptr].vpos))) );
+ pool[tail].prox = zzz;
+ Result = head;
+ return(Result);
+ }
+
+#ifdef ANSI
+void zdoline( link lineptr, integer depth)
+#else /* not ANSI*/
+void zdoline( lineptr, depth)
+ link lineptr;
+ integer depth;
+#endif /* ANSI*/
+{ link overflow;
+ if((PRvnext<PRv))
+ {
+ if(bfeedabsolute)
+ setvabs(PRvnext);
+ else if(bfeedbystring)
+ while((PRvnext<PRv)){
+ printstring(printfile,bfeedstring,ctrlflag);
+ PRv = PRv-bfeeddist;
+ }
+ else if(bfeedscream)
+ {
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Printer cant feed backwards", '\n');
+ error();
+ }
+ fprintf( *output, "%s%d%c",
+ "approximate vertical position is: ", PRvnext, '\n');
+ fprintf( *output, "%s%c",
+ " printing over-fed line on line below", '\n');
+ fprintf( *output, "%c%c", ' ', '\n');
+ PRv = PRvnext;
+ }
+ }
+ if(list||xwzfortran||(wlfeeddist>0))
+ while((PRv+wlfeeddist<=PRvnext)){
+ fprintf( *printfile, "%c", '\n');
+ if(inspection)
+ flush(printfile);
+ if(dopause)
+ {
+ pausei = pausei+1;
+ if((pausei>=pausesteps))
+ {
+ {
+ fprintf( *printfile, "%c", '\n');
+ if(inspection)
+ flush(printfile);
+ fprintf( *output, "%c%c", ' ', '\n');
+ }
+ fprintf( *output, "%s", pauseask);
+ readln(input);
+ printstring(output,pauseafter,' ');
+ pausei = 0;
+ }
+ }
+ if(xwzfortran)
+ fprintf( *printfile, "%c", feedchar);
+ if(wldoescr)
+ PRh = 0;
+ PRv = PRv+wlfeeddist;
+ if(squash)
+ PRv = PRvnext;
+ }
+ else if(feedabsolute)
+ setvabs(PRvnext);
+ else{
+ while((PRvnext>=PRv+feeddist)){
+ fprintf( *printfile, "%c", feedchar);
+ if(squash)
+ PRv = PRvnext;
+ else PRv = PRv+feeddist;
+ }
+ fprintf( *printfile, "%c", '\n');
+ if(inspection)
+ flush(printfile);
+ if(wldoescr)
+ PRh = 0;
+ }
+ while((PRvnext>PRv)){
+ fprintf( *printfile, "%c", tfeedchar);
+ PRv = PRv+tfeeddist;
+ }
+ overflow = zzz;
+ while((lineptr!=zzz)){
+ PRhnext = pool[lineptr].hpos-Hshunt;
+ if(!bspaceabsolute&&!bspacebystring&&(PRhnext<PRh))
+ {
+ if((PRh<leftstop))
+ {
+ fprintf( *output, "%s%s%c", "Error: ", "negative H-pos", '\n');
+ error();
+ }
+ if(!batchview)
+ {
+ pool[overflow].prox = lineptr;
+ overflow = pool[overflow].prox;
+ }
+ lineptr = pool[lineptr].prox;
+ }
+ else{
+ if(PRhnext==PRh)
+ ;
+ else{
+ if((PRhnext<PRh))
+ {
+ if(bspaceabsolute)
+ sethabs(PRhnext);
+ else if(bspacebystring)
+ while((PRhnext<PRh)){
+ fprintf( *printfile, "%c", bspacechar);
+ PRh = PRh-bspacedist;
+ }
+ }
+ if(spaceabsolute&&(PRhnext>PRh))
+ sethabs(PRhnext);
+ else{
+ while((PRhnext>=PRh+spacedist)){
+ fprintf( *printfile, "%c", spacechar);
+ PRh = PRh+spacedist;
+ }
+ while((PRhnext>PRh)){
+ fprintf( *printfile, "%c", tspacechar);
+ PRh = PRh+tspacedist;
+ }
+ }
+ }
+ if(pool[lineptr].symbol.IMfont!=PRfont)
+ setPRfont(pool[lineptr].symbol.IMfont);
+ fprintf( *printfile, "%c", chr(pool[lineptr].symbol.IMchar));
+ PRh = PRh+pool[lineptr].symbol.breadth;
+ tempp = lineptr;
+ lineptr = pool[lineptr].prox;
+ }
+ }
+ if((overflow==zzz))
+ {
+ if(((!wldoescr)||feedabsolute||((!wantsplit)&&(bspaceabsolute||(crfeeddist
+ <wlfeeddist)))))
+ {
+ if(xwzfortran)
+ {
+ fprintf( *printfile, "%c", '\n');
+ if(inspection)
+ flush(printfile);
+ fprintf( *printfile, "%c", crchar);
+ PRh = 0;
+ PRv = PRv+crfeeddist;
+ }
+ else if((bspaceabsolute&&((crfeeddist>0)||(lmargin>0))))
+ sethabs(0);
+ else{
+ fprintf( *printfile, "%c", crchar);
+ PRh = 0;
+ PRv = PRv+crfeeddist;
+ }
+ }
+ }
+ else{
+ if(xwzfortran)
+ {
+ fprintf( *printfile, "%c", '\n');
+ if(inspection)
+ flush(printfile);
+ fprintf( *printfile, "%c", crchar);
+ PRh = 0;
+ PRv = PRv+crfeeddist;
+ }
+ else if((bspaceabsolute&&((crfeeddist>0)||(lmargin>0))))
+ sethabs(0);
+ else{
+ fprintf( *printfile, "%c", crchar);
+ PRh = 0;
+ PRv = PRv+crfeeddist;
+ }
+ if((depth<deepest))
+ {
+ pool[overflow].prox = zzz;
+ overflow = pool[zzz].prox;
+ doline(overflow,depth+1);
+ }
+ else{
+ fprintf( *output, "%s%s%c", "Error: ", "I am out of my depth", '\n');
+ error();
+ }
+ }
+ }
+
+#ifdef ANSI
+void Readonepage(void)
+#else /* not ANSI*/
+void Readonepage()
+#endif /* ANSI*/
+{ byte Dcom;
+ integer Dpar;
+ boolean endpage;
+ endpage = false;
+ Dw = 0;
+ Dx = 0;
+ Dy = 0;
+ Dz = 0;
+ stackht = 0;
+ railbase = 0;
+ justpushed = false;
+ thinspace = 0;
+ Dfont = nf;
+ curscheme = 0;
+ Dh = - (integer)Dlmargin;
+ Dv = - (integer)Dtopmargin;
+ IMh = 0;
+ IMv = 0;
+ Dhleft = - (integer)Dlmargin;
+ IMhleft = 0;
+ Dhmid = - (integer)Dlmargin;
+ IMhmid = 0;
+ Dhright = - (integer)Dlmargin;
+ IMhright = 0;
+ push();
+ Dh = 0;
+ Dv = 0;
+ Hshunt = 100000000L;
+ cell = zzz;
+ midptr = mid;
+ pool[mid].prox = zzz;
+ runptr = run;
+ pool[run].prox = zzz;
+ pagesize = 0;
+ Oldv = -32767;
+ do{Ddis = 0;
+ IMdis = 0;
+ Dcom = readbyte(dvifile,dviindx);
+ if(Dcom<128)
+ {
+ setcharacter(Dcom);
+ Dh = Dh+Ddis;
+ IMh = IMh+IMdis;
+ }
+ else if((Dcom>=171)&&(Dcom<=234))
+ changefont(Dcom-171);
+ else switch(Dcom)
+ {case 128:
+ case 129:
+ case 130:
+ case 131:
+ {
+ Dpar = readinteger(dvifile,dviindx,Dcom-127);
+ setcharacter(Dpar);
+ Dh = Dh+Ddis;
+ IMh = IMh+IMdis;
+ }
+ break;
+ case 132:
+ {
+ setrule();
+ Dh = Dh+Ddis;
+ IMh = IMh+IMdis;
+ }
+ break;
+ case 133:
+ case 134:
+ case 135:
+ case 136:
+ {
+ Dpar = readinteger(dvifile,dviindx,Dcom-132);
+ setcharacter(Dpar);
+ }
+ break;
+ case 137:
+ setrule();
+ break;
+ case 138:
+ ;
+ break;
+ case 140:
+ endpage = true;
+ break;
+ case 141:
+ push();
+ break;
+ case 142:
+ pop();
+ break;
+ case 143:
+ case 144:
+ case 145:
+ case 146:
+ {
+ Dpar = readinteger(dvifile,dviindx,143-Dcom-1);
+ Dh = Dh+Dpar;
+ }
+ break;
+ case 147:
+ Dh = Dh+Dw;
+ break;
+ case 148:
+ case 149:
+ case 150:
+ case 151:
+ {
+ Dpar = readinteger(dvifile,dviindx,148-Dcom-1);
+ Dw = Dpar;
+ Dh = Dh+Dw;
+ }
+ break;
+ case 152:
+ Dh = Dh+Dx;
+ break;
+ case 153:
+ case 154:
+ case 155:
+ case 156:
+ {
+ Dpar = readinteger(dvifile,dviindx,153-Dcom-1);
+ Dx = Dpar;
+ Dh = Dh+Dx;
+ }
+ break;
+ case 157:
+ case 158:
+ case 159:
+ case 160:
+ {
+ Dpar = readinteger(dvifile,dviindx,157-Dcom-1);
+ movedown(Dpar);
+ }
+ break;
+ case 161:
+ movedown(Dy);
+ break;
+ case 162:
+ case 163:
+ case 164:
+ case 165:
+ {
+ Dpar = readinteger(dvifile,dviindx,162-Dcom-1);
+ Dy = Dpar;
+ movedown(Dy);
+ }
+ break;
+ case 166:
+ movedown(Dz);
+ break;
+ case 167:
+ case 168:
+ case 169:
+ case 170:
+ {
+ Dpar = readinteger(dvifile,dviindx,167-Dcom-1);
+ Dz = Dpar;
+ movedown(Dz);
+ }
+ break;
+ case 235:
+ case 236:
+ case 237:
+ case 238:
+ {
+ Dpar = readinteger(dvifile,dviindx,Dcom-234);
+ changefont(Dpar);
+ }
+ break;
+ case 243:
+ case 244:
+ case 245:
+ case 246:
+ {
+ Dpar = readinteger(dvifile,dviindx,Dcom-242);
+ definefont(Dpar);
+ }
+ break;
+ case 239:
+ case 240:
+ case 241:
+ case 242:
+ {
+ Dpar = readinteger(dvifile,dviindx,Dcom-238);
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Cant do Special commands", '\n');
+ error();
+ }
+ skipbytes(dvifile,dviindx,Dpar);
+ }
+ break;
+ case 139:
+ case 247:
+ case 248:
+ case 249:
+ {
+ fprintf( *output, "%s%s%s%*d%s%c",
+ "Fatal: ", "Bad DVI file: ", "Byte: ", 1, Dcom, " out of context inside page", '\n')
+ ;
+ crash();
+ }
+ break;
+ case 250:
+ case 251:
+ case 252:
+ case 253:
+ case 254:
+ case 255:
+ {
+ fprintf( *output, "%s%s%s%d%c",
+ "Fatal: ", "Bad DVI file: ", "Illegal command byte, ", Dcom, '\n');
+ crash();
+ }
+ break;
+ }
+ }while( ! (endpage) );
+ pop();
+ }
+
+#ifdef ANSI
+void Skippage(void)
+#else /* not ANSI*/
+void Skippage()
+#endif /* ANSI*/
+{ byte Dcom;
+ integer Dpar;
+ boolean endpage;
+ endpage = false;
+ do{Dcom = readbyte(dvifile,dviindx);
+ if((Dcom<128)||((Dcom<=234)&&(Dcom>=171)))
+ ;
+ else switch(Dcom)
+ {case 128:
+ case 129:
+ case 130:
+ case 131:
+ skipbytes(dvifile,dviindx,Dcom-127);
+ break;
+ case 132:
+ case 137:
+ skipbytes(dvifile,dviindx,8);
+ break;
+ case 133:
+ case 134:
+ case 135:
+ case 136:
+ skipbytes(dvifile,dviindx,Dcom-132);
+ break;
+ case 138:
+ ;
+ break;
+ case 140:
+ endpage = true;
+ break;
+ case 141:
+ case 142:
+ ;
+ break;
+ case 143:
+ case 144:
+ case 145:
+ case 146:
+ skipbytes(dvifile,dviindx,Dcom-142);
+ break;
+ case 147:
+ ;
+ break;
+ case 148:
+ case 149:
+ case 150:
+ case 151:
+ skipbytes(dvifile,dviindx,Dcom-147);
+ break;
+ case 152:
+ ;
+ break;
+ case 153:
+ case 154:
+ case 155:
+ case 156:
+ skipbytes(dvifile,dviindx,Dcom-152);
+ break;
+ case 157:
+ case 158:
+ case 159:
+ case 160:
+ skipbytes(dvifile,dviindx,Dcom-156);
+ break;
+ case 161:
+ ;
+ break;
+ case 162:
+ case 163:
+ case 164:
+ case 165:
+ skipbytes(dvifile,dviindx,Dcom-161);
+ break;
+ case 166:
+ ;
+ break;
+ case 167:
+ case 168:
+ case 169:
+ case 170:
+ skipbytes(dvifile,dviindx,Dcom-166);
+ break;
+ case 235:
+ case 236:
+ case 237:
+ case 238:
+ skipbytes(dvifile,dviindx,Dcom-234);
+ break;
+ case 243:
+ case 244:
+ case 245:
+ case 246:
+ {
+ Dpar = readinteger(dvifile,dviindx,Dcom-242);
+ definefont(Dpar);
+ }
+ break;
+ case 239:
+ case 240:
+ case 241:
+ case 242:
+ {
+ Dpar = readinteger(dvifile,dviindx,Dcom-238);
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Cant do Special commands", '\n');
+ error();
+ }
+ skipbytes(dvifile,dviindx,Dpar);
+ }
+ break;
+ case 139:
+ case 247:
+ case 248:
+ case 249:
+ {
+ fprintf( *output, "%s%s%s%*d%s%c",
+ "Fatal: ", "Bad DVI file: ", "Byte: ", 1, Dcom, " out of context inside page", '\n')
+ ;
+ crash();
+ }
+ break;
+ case 250:
+ case 251:
+ case 252:
+ case 253:
+ case 254:
+ case 255:
+ {
+ fprintf( *output, "%s%s%s%d%c",
+ "Fatal: ", "Bad DVI file: ", "Illegal command byte, ", Dcom, '\n');
+ crash();
+ }
+ break;
+ }
+ }while( ! (endpage) );
+ }
+
+#ifdef ANSI
+void readBOP(void)
+#else /* not ANSI*/
+void readBOP()
+#endif /* ANSI*/
+{ byte k;
+ integer Dpar;
+ do{k = readbyte(dvifile,dviindx);
+ if((k>=243)&&(k<=246))
+ {
+ Dpar = readinteger(dvifile,dviindx,k-242);
+ definefont(Dpar);
+ k = 138;
+ }
+ }while( ! (k!=138) );
+ if(k==248)
+ countpages = -1;
+ else if(k!=139)
+ {
+ fprintf( *output, "%s%s%s%c",
+ "Fatal: ", "Bad DVI file: ", "Byte is not BOP", '\n');
+ crash();
+ }
+ else{
+ {register integer for_end;k=0;for_end=9; if (k<=for_end)do
+ counter[k] = readinteger(dvifile,dviindx,-4);
+ while(k++ < for_end);}
+ skipbytes(dvifile,dviindx,4);
+ }
+ }
+
+#ifdef ANSI
+void zrow( integer scheme, integer rownum, iword firstfont)
+#else /* not ANSI*/
+void zrow( scheme, rownum, firstfont)
+ integer scheme;
+ integer rownum;
+ iword firstfont;
+#endif /* ANSI*/
+{ /*732*/integer n;
+ codeobject codd;
+ rowfont = firstfont;
+ finger = 0;
+ {register integer for_end;n=8*rownum;for_end=8*rownum+7; if (n<=for_end)do
+ {
+ rowchar(0,codd);
+ if((codd.breadth==-32766))
+ ;
+ else codes[scheme][n] = codd;
+ }
+ while(n++ < for_end);}
+ lab732:;
+ }
+
+#ifdef ANSI
+void Sendpage(void)
+#else /* not ANSI*/
+void Sendpage()
+#endif /* ANSI*/
+{ link line;
+ PRfont = -32767;
+ PRh = 0;
+ PRv = 0;
+ while((!(curpgeptr==zzz))){
+ line = readline();
+ doline(line,0);
+ }
+ }
+void main_body() {*input = stdin;
+*output = stdout;
+ blank.len = 0;
+ {register integer for_end;ini=1;for_end=maxstring; if (ini<=for_end)do
+ blank.data[ini] = padchar;
+ while(ini++ < for_end);}
+ setstring(".dvi",buffer);
+ dvidef = buffer;
+ setstring("/tex/fonts/.tfm",buffer);
+ tfmdef = buffer;
+ setstring("/tex/gfdir/.&Dgf",buffer);
+ rasterdef = buffer;
+ setstring(".lpr",buffer);
+ printex = buffer;
+ quiet = false;
+ runon = false;
+ squash = false;
+ magnify = 100;
+ hmag = 100;
+ vmag = 100;
+ batchview = false;
+ firstpage = -1000000L;
+ countpages = 1000000L;
+ printname = blank;
+ start = false;
+ timetostop = false;
+ pagegap = false;
+ {register integer for_end;ini=0;for_end=9; if (ini<=for_end)do
+ counter[ini] = 0;
+ while(ini++ < for_end);}
+ nf = 0;
+ {register integer for_end;ini=0;for_end=maxDfonts; if (ini<=for_end)do
+ {
+ fontnum[ini] = 0;
+ scheme[ini] = 0;
+ firstch[ini] = 0;
+ lastch[ini] = 0;
+ fontspace[ini] = 0;
+ }
+ while(ini++ < for_end);}
+ nochar.breadth = -32766;
+ nochar.IMfont = 0;
+ nochar.IMchar = 0;
+ schemetop = 0;
+ {register integer for_end;ini=0;for_end=maxcodes; if (ini<=for_end)do
+ {
+ knownschemes[ini] = blank;
+ schememap[ini] = 0;
+ {register integer for_end;inj=0;for_end=maxDchar; if (inj<=for_end)do
+ {
+ codes[ini][inj] = nochar;
+ }
+ while(inj++ < for_end);}
+ }
+ while(ini++ < for_end);}
+ topofligs = 0;
+ {register integer for_end;ini=1;for_end=maxligs; if (ini<=for_end)do
+ ligatures[ini].symbol = nochar;
+ while(ini++ < for_end);}
+ hmax = hresolution*100;
+ vmax = vresolution*100;
+ hmin = 0;
+ vmin = 0;
+ cell = 0;
+ cell = cell+1;
+ mid = cell;
+ cell = cell+1;
+ left = cell;
+ cell = cell+1;
+ right = cell;
+ cell = cell+1;
+ run = cell;
+ cell = cell+1;
+ zzz = cell;
+ pool[zzz].vpos = 32767;
+ pool[zzz].prox = zzz;
+ midptr = zzz;
+ runptr = zzz;
+ vstrcpy(deviceID,"Lineprinter ");
+ list = false;
+ xwzfortran = false;
+ bfeedabsolute = false;
+ bfeedbystring = false;
+ feedabsolute = false;
+ bfeedscream = true;
+ bspaceabsolute = false;
+ bspacebystring = false;
+ spaceabsolute = false;
+ absisincr = false;
+ wldoescr = false;
+ wantsplit = true;
+ isheader = false;
+ dopause = false;
+ inspection = false;
+ wlfeeddist = 1;
+ crfeeddist = 0;
+ feeddist = 1;
+ tfeeddist = 1;
+ bfeeddist = 0;
+ tinydrop = 50000L;
+ bigdrop = 4;
+ spacedist = 1;
+ tspacedist = 1;
+ bspacedist = 1;
+ pausei = 0;
+ pausesteps = 20;
+ feedchar = chr(10);
+ tfeedchar = chr(10);
+ crchar = chr(13);
+ spacechar = chr(32);
+ tspacechar = chr(32);
+ bspacechar = chr(8);
+ startstuff = blank;
+ stopstuff = blank;
+ pagetop = blank;
+ bfeedstring = blank;
+ fontcommand = blank;
+ vabscom = blank;
+ habscom = blank;
+ pauseafter = blank;
+ lmargin = 1.0;
+ topmargin = 1.0;
+ hfudge = 7.227/ ((double)5.25);
+ vfudge = 2.0;
+ setpaths(TFMFILEPATHBIT+TEXINPUTPATHBIT);
+ wlfeeddist = 1;
+ wldoescr = true;
+ command = blank;
+ getcommand();
+ dviname = blank;
+ if((argc>1))
+ parsecommand();
+ if(true&&(dviname.len==0))
+ do{{
+ fprintf( *output, "%s%c", "DVI file name? ", '\n');
+ readterminal();
+ }
+ getname(dviname);
+ }while( ! ((dviname.len>0)) );
+ dviindx = TEXINPUTPATH;
+ if(!openandask(dvifile,dviindx,dviname,dvidef,true))
+ {
+ fprintf( *output, "%s%s%c", "Fatal: ", "couldnt open DVI file", '\n');
+ crash();
+ }
+ if(!(argc>1))
+ if(true)
+ {
+ buffer = blank;
+ {
+ fprintf( *output, "%s%c",
+ "First page? (default = print ALL pages) ", '\n');
+ readterminal();
+ }
+ if((buffer.len>0))
+ firstpage = stoi(firstpage,true);
+ {
+ fprintf( *output, "%s%c",
+ "Maximum no. of pages? (default = 1000000) ", '\n');
+ readterminal();
+ }
+ if((buffer.len>0))
+ countpages = stoi(countpages,true);
+ {
+ fprintf( *output, "%s%c",
+ "What magnification? (integer, percent, default=100%=DVI file mag)1", '\n')
+ ;
+ readterminal();
+ }
+ if((buffer.len>0))
+ magnify = stoi(magnify,true);
+ }
+ setstring("TEX EXTENDED ASCII",buffer);
+ setscheme(1);
+ alphabet(32,95,1,1,32);
+ setstring(
+ " . {|v} Z Z & ~ {LC-} Z ",
+ buffer);
+ row(1,0,1);
+ setstring(
+ " Z Z Z {^|} {+_} {LO+} Z Z ",
+ buffer);
+ row(1,1,1);
+ setstring(
+ " Z Z Z Z Z Z {LOx} Z ",
+ buffer);
+ row(1,2,1);
+ setstring(
+ " [{L<-}-] [-{-L>}] {=/} Z {L<_} {L>_} {=_} [or] ",
+ buffer);
+ row(1,3,1);
+ setstring("TEX TYPEWRITER TEXT",buffer);
+ setscheme(2);
+ alphabet(32,95,2,1,32);
+ codes[2][127].IMchar = 34;
+ setstring(
+ " Z [{/_}{_\\}] {0-} [/\\] Z Z Z Z ",
+ buffer);
+ row(2,0,1);
+ setstring(
+ " Z Z Z Z <U_{-_}> <U[__][||]> <U_{L>_}> LY ",
+ buffer);
+ row(2,0,1);
+ setstring(
+ " {oI} {u|} Z {^|} {v|} Q ! ? ",
+ buffer);
+ row(2,1,1);
+ setstring(
+ " i j ` Q Z Z <U_> <U.> ",
+ buffer);
+ row(2,2,1);
+ setstring(
+ " , {LB_} [ae] [oe] {o/} [LALE] [LOLE] {LO/} ",
+ buffer);
+ row(2,3,1);
+ setstring("TEX TEXT",buffer);
+ setscheme(3);
+ {register integer for_end;ini=0;for_end=127; if (ini<=for_end)do
+ codes[3][ini] = codes[2][ini];
+ while(ini++ < for_end);}
+ setstring(
+ " Z Z Z [ff] [fi] [fl] [ffi] [ffl] ",
+ buffer);
+ row(3,1,1);
+ setstring(
+ " Z Z Z Z ! Z ? Z ",
+ buffer);
+ row(3,7,1);
+ setstring(
+ " Z Z Z Z W Z Z <U.> ",
+ buffer);
+ row(3,11,1);
+ setstring(
+ " Z Z Z - [--] W ~ W ",
+ buffer);
+ row(3,15,1);
+ setstring("TEX TEXT WITHOUT F-LIGATURES",buffer);
+ setscheme(4);
+ {register integer for_end;ini=0;for_end=127; if (ini<=for_end)do
+ codes[4][ini] = codes[3][ini];
+ while(ini++ < for_end);}
+ setstring(
+ " {oI} {u|} Z {^|} {v|} Q ! ? ",
+ buffer);
+ row(4,1,1);
+ setstring("AEFMNOT ONLY",buffer);
+ setscheme(5);
+ setstring(
+ " Z LA Z Z Z LE LF Z ",
+ buffer);
+ row(5,8,1);
+ setstring(
+ " Z Z Z Z Z LM LN LO ",
+ buffer);
+ row(5,9,1);
+ setstring(
+ " Z Z Z Z LT Z Z Z ",
+ buffer);
+ row(5,10,1);
+ setstring("TEX MATH ITALIC",buffer);
+ setscheme(6);
+ {register integer for_end;ini=0;for_end=9; if (ini<=for_end)do
+ codes[6][ini] = codes[2][ini];
+ while(ini++ < for_end);}
+ alphabet(48,43,6,1,48);
+ alphabet(97,26,6,1,97);
+ setstring(
+ " Z Z . , Z / Z * ",
+ buffer);
+ row(6,7,1);
+ setstring("TEX MATH SYMBOLS",buffer);
+ setscheme(7);
+ alphabet(65,26,7,1,65);
+ setstring(
+ " - . {\\/} * {-:} Z {+_} <U_+> ",
+ buffer);
+ row(7,0,1);
+ setstring(
+ " {LO+} {LO-} {LOx} {LO/} LO LO o o ",
+ buffer);
+ row(7,1,1);
+ setstring(
+ " Z {=_} Z Z {L<_} {L>_} {L<_} {L>_} ",
+ buffer);
+ row(7,2,1);
+ setstring(
+ " ~ <U~~> Z Z [L<L<] [L>L>] L< L> ",
+ buffer);
+ row(7,3,1);
+ setstring(
+ " [{L<-}-] [-{L>-}] {|^} {|v} Z Z Z Z ",
+ buffer);
+ row(7,4,1);
+ setstring(
+ " Z Z Z Z [{L<-}{-L>}] / \\ {~_} ",
+ buffer);
+ row(7,4,1);
+ setstring(
+ " [{L<=}=] [={L>=}] {|^} {|v} Z Z Z Z ",
+ buffer);
+ row(7,5,1);
+ setstring(
+ " Z Z Z Z [{L<=}{=L>}] Z Z Z ",
+ buffer);
+ row(7,5,1);
+ setstring(
+ " Q [oo] {L(-} {-L)} Z Z Z Z ",
+ buffer);
+ row(7,6,1);
+ setstring(
+ " Z Z Z Z [{/_}{_\\}] <U[__][\\/]> / Q ",
+ buffer);
+ row(7,6,1);
+ setstring(
+ " [{\\-}{-/}] <U_[{-_}|]> ~ {0/} LR LT <U_|> {|_}",
+ buffer);
+ row(7,7,1);
+ setstring(
+ " Z Z Z LU Z {LU+} & [or] ",
+ buffer);
+ row(7,11,1);
+ setstring(
+ " [{|-}-] [-{-|}] Z Z Z Z L{ L} ",
+ buffer);
+ row(7,12,1);
+ setstring(
+ " L< L> | [||] {^|v} {^|v} \\ Z ",
+ buffer);
+ row(7,13,1);
+ setstring(
+ " <[S_]{v/}> [{LI_}{LI_}] <U[__][\\/]> <U/|/> Z Z Z Z ",
+ buffer);
+ row(7,14,1);
+ setstring(
+ " {LS*} {|-} {|-_} {9|} Z Z Z Z ",
+ buffer);
+ row(7,15,1);
+ setstring("TEX MATH EXTENSION",buffer);
+ setscheme(8);
+ setstring(
+ " <SL(L(> <SL)L)> <SL[L[> <SL]L]> ZZZZ",
+ buffer);
+ row(8,0,1);
+ setstring(
+ " <SL{L{> <SL}L}> <S/\\> <S\\/> ZZZZ",
+ buffer);
+ row(8,1,1);
+ setstring(
+ " <SL(L(L(> <SL)L)L)> <SL(L(L(L(> <SL)L)L)L)> ZZZZ",
+ buffer);
+ row(8,2,1);
+ setstring(
+ " <SL[|||> <SL]|||> <SL{/\\L{> <SL}\\/L}> ZZZZ",
+ buffer);
+ row(8,3,1);
+ setstring(
+ " <SL(L(L(L(L(> <SL)L)L)L)L)> <SL[|||L[> <SL]|||L]> ZZZZ",
+ buffer);
+ row(8,4,1);
+ setstring(
+ " <SL{L|L<|L{> <SL}|L>|L}> <S[S/]/\\[S\\]> <S\\[S\\][S/]/> ZZZZ",
+ buffer);
+ row(8,5,1);
+ setstring(
+ " <S/||> <S\\||> <SL[||> <SL]||> ZZZZ",
+ buffer);
+ row(8,6,1);
+ setstring(
+ " <S[S/]|> <S\\[S|]> <S|[S\\]> <S[S|]/> ZZZZ",
+ buffer);
+ row(8,7,1);
+ setstring(
+ " <S||\\> <S||/> <S|> <S|> ZZZZ",
+ buffer);
+ row(8,8,1);
+ setstring(
+ " <[__]\\[{/_}_]> <[__][LILI]> </|/> <S[||][\\/]> ZZZZ",
+ buffer);
+ row(8,10,1);
+ setstring(
+ " <S[{|_}{|_}]> <S[|S|][{|_}_{_|}]> <U_> <U[__]> ZZZZ",
+ buffer);
+ row(8,12,1);
+ setstring(
+ " <SL[L[L[> <SL]L]L]> <S||L[> <S||L]> ZZZZ",
+ buffer);
+ row(8,13,1);
+ setstring(
+ " <S{|^}> <S{|v}> / \\ ZZZZ",
+ buffer);
+ row(8,15,1);
+ setstring(
+ "ZZZZ <S|L[> <S|L]> <SL[|> <SL]|> ",
+ buffer);
+ row(8,0,1);
+ setstring(
+ "ZZZZ <S|> <S[||]> <S[S/]/> <Z\\[S\\]> ",
+ buffer);
+ row(8,1,1);
+ setstring(
+ "ZZZZ <SL[L[L[L[> <SL]L]L]L]> <S|||L[> <S|||L]> ",
+ buffer);
+ row(8,2,1);
+ setstring(
+ "ZZZZ <S[S/]/\\[S\\]> <S\\[S\\][S/]/> <S[S/][S/]//> <S\\\\[S\\][S\\]> "
+ ,buffer);
+ row(8,3,1);
+ setstring(
+ "ZZZZ <S||||L[> <S||||L]> <SL[||||> <SL]||||> ",
+ buffer);
+ row(8,4,1);
+ setstring(
+ "ZZZZ <S[S/][S/]//> <S\\\\[S\\][S\\]> <S[SS/][S/]/> <S\\[S\\][SS\\]> "
+ ,buffer);
+ row(8,5,1);
+ setstring(
+ "ZZZZ <S||L[> <S||L]> <S|> <S|> ",
+ buffer);
+ row(8,6,1);
+ setstring(
+ "ZZZZ <S[S|]L<[S|]> <S|[SL>]|> <S|> <S|> ",
+ buffer);
+ row(8,7,1);
+ setstring(
+ "ZZZZ <S[S/]L<[S\\]> <S\\[SL>]/> <S[{|_}{|_}]> <S[|S|][{|_}S{|_}]> ",
+ buffer);
+ row(8,8,1);
+ setstring(
+ "ZZZZ <S[/\\][||]> <S[|+|][\\_/]> <S[/\\]> <S[\\/]> ",
+ buffer);
+ row(8,10,1);
+ setstring(
+ "ZZZZ <U[___]> <U~> <U[~~]> <U[~~~]> ",
+ buffer);
+ row(8,12,1);
+ setstring(
+ "ZZZZ <SL[||> <SL]||> <SL{L{L{> <SL}L}L}> ",
+ buffer);
+ row(8,13,1);
+ setstring(
+ "ZZZZ \\ / <S{|^}> <S{|v}> ",
+ buffer);
+ row(8,15,1);
+ setstring(
+ " </{|O}/> <S/{|O}|/> <S[/\\][\\/]> <S[S_][/.\\][\\_/]> ZZZZ",
+ buffer);
+ row(8,9,1);
+ setstring(
+ "ZZZZ <S[{/_}{\\_}][\\/]> <S[S_][{/_}{|_}{_\\}][\\{|_}/]> ZZ",
+ buffer);
+ row(8,9,1);
+ setstring(
+ "ZZZZZZ <S[{\\/}{/\\}][{\\/}{/\\}]> <[S_][{\\/}S{/\\}][|{\\/}|][{/\\}_{/\\}]> "
+ ,buffer);
+ row(8,9,1);
+ setstring(
+ " <[___]\\[SL>][{/_}__]> <[___][|S|][|S|][|S|]> <S/||/> ZZZZZ",
+ buffer);
+ row(8,11,1);
+ setstring(
+ "ZZZ <S[|S|][|S|][\\_/]> <[S_][/S\\][|S|][|S|]> ZZZ",
+ buffer);
+ row(8,11,1);
+ setstring(
+ "ZZZZZ <S[|S|][|+|][\\_/]> <SS[S/\\][/SS\\]> <SS[\\SS/][S\\/]> "
+ ,buffer);
+ row(8,11,1);
+ setstring(
+ " <S[_S|][S\\|]> <S[SS|][_S|][S\\|]> <S[SS|][SS|][_S|][S\\|]> ZZZZZ",
+ buffer);
+ row(8,14,1);
+ setstring(
+ "ZZZ <S[SS|][SS|][SS|][_S|][S\\|]> <S[SS|][_S|][S\\|]> ZZZ",
+ buffer);
+ row(8,14,1);
+ setstring(
+ "ZZZZZ <S|> <U_|> <S[||]> ",
+ buffer);
+ row(8,14,1);
+ setstring("LATEX SYMBOLS",buffer);
+ setscheme(9);
+ setstring("LATEX CIRCLE",buffer);
+ setscheme(10);
+ setstring(
+ " Z [L<|] [{L<_}|] [|L>] [|{L>_}] Z Z Z ",
+ buffer);
+ row(9,0,1);
+ setstring(
+ " [L<] [L>] Z Z Z Z Z Z ",
+ buffer);
+ row(9,5,1);
+ setstring(
+ " Z Z ~ ~ Z Z Z Z ",
+ buffer);
+ row(9,7,1);
+ setstring("LATEX LINE",buffer);
+ setscheme(11);
+ setstring(
+ " / | | | | | Z Z ",
+ buffer);
+ row(11,0,1);
+ setstring(
+ " / L< / v | v ^ v ",
+ buffer);
+ row(11,1,1);
+ setstring(
+ " / / L> / / ^ Z ^ ",
+ buffer);
+ row(11,2,1);
+ setstring(
+ " / L< / L< / L< L> Z ",
+ buffer);
+ row(11,3,1);
+ setstring(
+ " / / / / Z / Z Z ",
+ buffer);
+ row(11,4,1);
+ setstring(
+ " _ L< L> L< / L> Z L< ",
+ buffer);
+ row(11,5,1);
+ setstring(
+ " Z L> Z L> Z Z ^ L> ",
+ buffer);
+ row(11,6,1);
+ setstring(
+ " Z L< L> Z Z L< L> v ",
+ buffer);
+ row(11,7,1);
+ setstring(
+ " \\ | | | | | Z Z ",
+ buffer);
+ row(11,8,1);
+ setstring(
+ " \\ L< \\ ^ | ^ v ^ ",
+ buffer);
+ row(11,9,1);
+ setstring(
+ " \\ \\ L> \\ \\ v Z v ",
+ buffer);
+ row(11,10,1);
+ setstring(
+ " \\ L< \\ L< \\ L< L> Z ",
+ buffer);
+ row(11,11,1);
+ setstring(
+ " \\ \\ \\ \\ Z \\ Z Z "
+ ,buffer);
+ row(11,12,1);
+ setstring(
+ " _ L< L> L< \\ L> Z L< ",
+ buffer);
+ row(11,13,1);
+ setstring(
+ " Z L> Z L> Z Z Z L> ",
+ buffer);
+ row(11,14,1);
+ setstring(
+ " Z L< L> Z Z L< L> Z ",
+ buffer);
+ row(11,15,1);
+ setstring("ADOBESTANDARDENCODING",buffer);
+ setscheme(12);
+ alphabet(32,95,12,1,32);
+ setstring(
+ " Z ! {LC/} $ / {Y=} f {LS*} ",
+ buffer);
+ row(12,20,1);
+ setstring(
+ " * Q W [L<L<] L< L> [fi] [fl] ",
+ buffer);
+ row(12,21,1);
+ setstring(
+ " Z - {|-} {|-_} . Z {9|} . ",
+ buffer);
+ row(12,22,1);
+ setstring(
+ " , [,,] W [L>L>] [...] [%.] Z ? ",
+ buffer);
+ row(12,23,1);
+ setstring(
+ " Z ` Q ^ ~ <U_> Z <U.> ",
+ buffer);
+ row(12,24,1);
+ setstring(
+ " <U[..]> Z <U.> , Z W , Z ",
+ buffer);
+ row(12,25,1);
+ setstring(
+ " [--] Z Z Z Z Z Z Z ",
+ buffer);
+ row(12,26,1);
+ setstring(
+ " Z [LALE] Z <U{a_}> Z Z Z Z ",
+ buffer);
+ row(12,28,1);
+ setstring(
+ " L {O/} [OLE] <U{o_}> Z Z Z Z ",
+ buffer);
+ row(12,29,1);
+ setstring(
+ " Z [ae] Z Z Z i Z Z ",
+ buffer);
+ row(12,30,1);
+ setstring(
+ " l {O/} [oe] {B_} Z Z Z Z ",
+ buffer);
+ row(12,31,1);
+ setstring("ADOBESYMBOLENCODING",buffer);
+ setscheme(13);
+ alphabet(32,48,13,1,32);
+ setstring(
+ " Z Z [{\\-}{-/}] Z <U_[{-_}|]> Z Z {)-}$ ",
+ buffer);
+ row(13,4,1);
+ setstring(
+ " {~=} Z Z X [{/_}{_\\}] Z {oI} S ",
+ buffer);
+ row(13,8,1);
+ setstring(
+ " Z Z v Z [/\\] Z Z Z ",
+ buffer);
+ row(13,9,1);
+ setstring(
+ " <U[__][||]> {O-} P <U_{L>_}> T Y Z Z ",
+ buffer);
+ row(13,10,1);
+ setstring(
+ " <U_{-_}> {u|} LZ L[ <U[S.][.S.]> L] {|_} _ ",
+ buffer);
+ row(13,11,1);
+ setstring(
+ " <U[S_]> Z Z Z Z Z Z Z ",
+ buffer);
+ row(13,12,1);
+ setstring(
+ " Z Z Z L{ | L} ~ Z ",
+ buffer);
+ row(13,15,1);
+ setstring(
+ " Z Z Q {L<_} / [oo] f Z ",
+ buffer);
+ row(13,20,1);
+ setstring(
+ " Z Z Z [{L<-}{-L>}] [{L<-}-] {^|} [-{-L>}] {|v} ",
+ buffer);
+ row(13,21,1);
+ setstring(
+ " o {+_} W {L>_} x Z d o ",
+ buffer);
+ row(13,22,1);
+ setstring(
+ " {-:} {=/} {=_} <U~~> [...] <U||> [---] Z ",
+ buffer);
+ row(13,23,1);
+ setstring(
+ " Z Z Z Z {Ox} {O+} {O/} Z ",
+ buffer);
+ row(13,24,1);
+ setstring(
+ " LU Z Z Z Z Z {(-} {(-/} ",
+ buffer);
+ row(13,25,1);
+ setstring(
+ " {/_} <U[__][\\/]> {Or} {Oc} [TLM] <U[__][||]> <U[S_]{v/}> . ",
+ buffer);
+ row(13,26,1);
+ setstring(
+ " ~ & [or] [{L<=}{=L>}] [{L<=}=] {^|} [={=L>}] {|v} ",
+ buffer);
+ row(13,27,1);
+ setstring(
+ " Z <U/\\> {Or} {Oc} [TLM] <U_{L>_}> <U[S/]|> <U||> ",
+ buffer);
+ row(13,28,1);
+ setstring(
+ " <U|[S\\]> <UL[|> <U||> <U|L[> <U[S/]|> <U||> <U|[S\\]> <U||> ",
+ buffer);
+ row(13,29,1);
+ setstring(
+ " Z <U\\/> <U[S/][S|]/> <U[S/]|> <U||> <U[S|]/> <U\\[S|]> <U||> ",
+ buffer);
+ row(13,30,1);
+ setstring(
+ " <U[S|]/> <UL]|> <U||> <U|L]> <U\\[S|]> <U||> <U[S|]/> Z ",
+ buffer);
+ row(13,31,1);
+ setstring("SYMBOL",buffer);
+ setscheme(13);
+ setstring("PSSYML",buffer);
+ setscheme(13);
+ setstring("PSSYMU",buffer);
+ setscheme(14);
+ {register integer for_end;ini=0;for_end=127; if (ini<=for_end)do
+ codes[14][ini] = codes[13][ini+128];
+ while(ini++ < for_end);}
+ if(batchview)
+ {
+ setstring(
+ " Z Z [\\=] Z [L<=] [L>=] [==] [or] ",
+ buffer);
+ row(1,3,1);
+ setstring(
+ " Z [==] Z Z [L<=] [L>=] [L<=] [L>=] ",
+ buffer);
+ row(7,2,1);
+ }
+ railchars[1] = codes[1][95];
+ railchars[2] = codes[1][45];
+ postchar = codes[1][124];
+ if(inspection)
+ {
+ batchview = true;
+ quiet = true;
+ dopause = (pausesteps>0);
+ }
+ if(batchview)
+ {
+ vstrcpy(deviceID,"screenview ");
+ runon = true;
+ xwzfortran = false;
+ list = true;
+ }
+ if(xwzfortran)
+ {
+ wldoescr = true;
+ wlfeeddist = 1;
+ feedchar = ' ';
+ tfeedchar = ' ';
+ crchar = '+';
+ }
+ if(list)
+ {
+ wlfeeddist = 1;
+ crfeeddist = 1;
+ crchar = ' ';
+ wldoescr = true;
+ lmargin = 0;
+ topmargin = 0;
+ }
+ if(!quiet)
+ fprintf( *output, "%s%s%s%c",
+ "This is Crudetype, Version 3.01, copyright, experimental WEB2C", " --- ", deviceID, '\n')
+ ;
+ if((printname.len==0))
+ {
+ parsefile(dviname,pd,pn,pex);
+ if(true)
+ printname = pd;
+ else printname = blank;
+ append(printname,pn);
+ append(printname,printex);
+ }
+ if(inspection)
+ {
+ setstring("/dev/tty",buffer);
+ printname = buffer;
+ }
+ rewrite(printfile,printname.data);
+ printstring(printfile,startstuff,ctrlflag);
+ fprintf( *printfile, "%c", '\n');
+ if(inspection)
+ flush(printfile);
+ bbb = readbyte(dvifile,dviindx);
+ if(bbb!=247)
+ {
+ fprintf( *output, "%s%s%s%c",
+ "Fatal: ", "Bad DVI file: ", "First byte isn't start of preamble!", '\n')
+ ;
+ crash();
+ }
+ bbb = readbyte(dvifile,dviindx);
+ if(bbb!=2)
+ {
+ fprintf( *output, "%s%s%*d%s%*d%c",
+ "Error: ", "Identification byte should be ", 1, 2, ", it is actually", 1, bbb, '\n')
+ ;
+ error();
+ }
+ dvifactor = rrreadreal(dvifile,dviindx)/ ((double)254000.0);
+ Dlmargin = round(lmargin/ ((double)dvifactor));
+ Dtopmargin = round(topmargin/ ((double)dvifactor));
+ magnification = readinteger(dvifile,dviindx,4)/ ((double)1000);
+ dvifactor = dvifactor*magnification;
+ dvifactor = dvifactor*magnify/ ((double)100.0);
+ hconv = dvifactor*hresolution*hfudge*hmag/ ((double)100.0);
+ vconv = dvifactor*vresolution*vfudge*vmag/ ((double)100.0);
+ bbb = readbyte(dvifile,dviindx);
+ if(quiet)
+ skipbytes(dvifile,dviindx,bbb);
+ else{
+ {register integer for_end;nnn=1;for_end=bbb; if (nnn<=for_end)do
+ fprintf( *output, "%c", chr(readbyte(dvifile,dviindx)));
+ while(nnn++ < for_end);}
+ fprintf( *output, "%c%c", ' ', '\n');
+ }
+ do{readBOP();
+ if((counter[0]>=firstpage))
+ start = true;
+ if(start&&(countpages>0))
+ {
+ if(runon)
+ {
+ fprintf( *printfile, "%c", '\n');
+ fprintf( *printfile, "%s%*d%c", "------ PAGE ", 1, counter[0], ' ');
+ fprintf( *printfile, "%s", "----------------------------------");
+ fprintf( *printfile, "%s", "----------------------------------");
+ fprintf( *printfile, "%c", '\n');
+ }
+ else if(pagegap)
+ page(printfile);
+ else pagegap = true;
+ if(isheader)
+ printstring(printfile,pagetop,ctrlflag);
+ countpages = countpages-1;
+ if(!quiet)
+ fprintf( *output, "%c%*d", '[', 1, counter[0]);
+ Readonepage();
+ sorted = false;
+ pool[runptr].prox = zzz;
+ runptr = pool[run].prox;
+ cell = cell+1;
+ pool[midptr].prox = cell;
+ midptr = cell;
+ pool[midptr].down = runptr;
+ do{pool[midptr].prox = zzz;
+ midptr = pool[mid].prox;
+ leftptr = left;
+ pool[left].prox = zzz;
+ rightptr = right;
+ pool[right].prox = zzz;
+ do{{
+ tempp = midptr;
+ midptr = pool[midptr].prox;
+ pool[leftptr].prox = tempp;
+ leftptr = pool[leftptr].prox;
+ }
+ if(!(midptr==zzz))
+ {
+ tempp = midptr;
+ midptr = pool[midptr].prox;
+ pool[rightptr].prox = tempp;
+ rightptr = pool[rightptr].prox;
+ }
+ }while( ! ((midptr==zzz)) );
+ midptr = mid;
+ pool[mid].prox = zzz;
+ pool[leftptr].prox = zzz;
+ leftptr = pool[left].prox;
+ pool[rightptr].prox = zzz;
+ rightptr = pool[right].prox;
+ sorted = (rightptr==zzz);
+ if(sorted)
+ curpgeptr = pool[pool[left].prox].down;
+ else do{if((rightptr==zzz))
+ {
+ tempp = leftptr;
+ leftptr = pool[leftptr].prox;
+ pool[midptr].prox = tempp;
+ midptr = pool[midptr].prox;
+ }
+ else if((leftptr==zzz))
+ {
+ tempp = rightptr;
+ rightptr = pool[rightptr].prox;
+ pool[midptr].prox = tempp;
+ midptr = pool[midptr].prox;
+ }
+ else{
+ runptr = run;
+ pool[run].prox = zzz;
+ Lrunptr = pool[leftptr].down;
+ Rrunptr = pool[rightptr].down;
+ do{if(((pool[Lrunptr].vpos<pool[Rrunptr].vpos)||((pool[Lrunptr]
+ .vpos==pool[Rrunptr].vpos)&&(pool[Lrunptr].hpos<=pool[Rrunptr]
+ .hpos))))
+ {
+ tempp = Lrunptr;
+ Lrunptr = pool[Lrunptr].prox;
+ pool[runptr].prox = tempp;
+ runptr = pool[runptr].prox;
+ }
+ else{
+ tempp = Rrunptr;
+ Rrunptr = pool[Rrunptr].prox;
+ pool[runptr].prox = tempp;
+ runptr = pool[runptr].prox;
+ }
+ }while( ! ((Rrunptr==zzz)&&(Lrunptr==zzz)) );
+ tempp = leftptr;
+ leftptr = pool[leftptr].prox;
+ tempp = rightptr;
+ rightptr = pool[rightptr].prox;
+ pool[runptr].prox = zzz;
+ runptr = pool[run].prox;
+ cell = cell+1;
+ pool[midptr].prox = cell;
+ midptr = cell;
+ pool[midptr].down = runptr;
+ }
+ }while( ! ((leftptr==zzz)&&(rightptr==zzz)) );
+ }while( ! (sorted) );
+ Sendpage();
+ if(!quiet)
+ fprintf( *output, "%c", ']');
+ }
+ else if((countpages>0))
+ Skippage();
+ else timetostop = true;
+ }while( ! (timetostop) );
+ printstring(printfile,stopstuff,ctrlflag);
+ fprintf( *printfile, "%c", '\n');
+ if(inspection)
+ flush(printfile);
+ if(!quiet)
+ {
+ fprintf( *output, "%s", "Output written to file: ");
+ printstring(output,printname,' ');
+ }
+ fprintf( *output, "%c%c", ' ', '\n');
+ lab732:;
+ }
diff --git a/dviware/crudetype/version3/crudetype.ch b/dviware/crudetype/version3/crudetype.ch
new file mode 100644
index 0000000000..c546e88796
--- /dev/null
+++ b/dviware/crudetype/version3/crudetype.ch
@@ -0,0 +1,11 @@
+% crudetype.ch -*-mode: change; webfile: crudetype.web version 3.01;-*-
+% dummy change file for Crudetype
+% The purpose of this is to let you Weave the basic program.
+% See AAAREAD.ME
+
+% [0] WEAVE: print whole program
+@x Module 0; Lines 43 -- 43
+\let\maybe=\iffalse
+@y
+\let\maybe=\iftrue
+@z
diff --git a/dviware/crudetype/version3/crudetype.pdf b/dviware/crudetype/version3/crudetype.pdf
new file mode 100644
index 0000000000..7b407ba9a8
--- /dev/null
+++ b/dviware/crudetype/version3/crudetype.pdf
Binary files differ
diff --git a/dviware/crudetype/version3/crudetype.web b/dviware/crudetype/version3/crudetype.web
new file mode 100644
index 0000000000..d996a04973
--- /dev/null
+++ b/dviware/crudetype/version3/crudetype.web
@@ -0,0 +1,4033 @@
+% CRUDETYPE.WEB ADAPTED FROM DVITYPE, VERSION 2.6.
+
+% REVISIONS:
+% 9/86: clarify names of global variables, supply hooks for attempted
+% Hewlett-Packard Laserjet version.
+% 1/88: Several bugfixes. Chiefly the noscheme bug (TFM files without coding
+% schemes)
+% Also, added some MATH EXTENSION character codes.
+% 4/88: Unix change file by P. King.
+% 10/88: Version 2. Changes include:
+% Read a command line; additional options; cleaner interface to operating
+% system; bugfixes.
+% 11/90: Version 3.01. Minor bugfixes; a serious attempt to tackle character
+% strings; (from J.Warbrick) screenview; several more coding schemes;
+% additional options.
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\indent\ignorespaces}
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like PASCAL
+\def\PASCAL{{\mc PASCAL}}
+\def\WEB{{\mc WEB}}
+
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index
+
+\def\title{Crudetype}
+\def\contentspagenumber{1}
+\def\topofcontents{\null
+ \def\titlepage{F} % include headline on the contents page
+ \def\rheader{\mainfont\hfil \contentspagenumber}
+ \vfill
+ \centerline{\titlefont Crudetype}
+ \vskip 45pt
+ \centerline{An adaptable device driver (Version 3, 1990)}
+ \vskip 45pt
+ \centerline{R.M.Damerell,} \vskip 20pt
+ \centerline{Mathematics Dept.,} \vskip 15pt
+ \centerline{Royal Holloway and Bedford College,} \vskip 15pt
+ \centerline{Egham, Surrey, U.K.} \vskip 15pt
+\vfill}
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+
+
+% These macros for verbatim scanning are copied from MANMAC.TEX. But we cant
+% use the vertical bar for a temporary escape character as WEAVE catches it.
+% So we will use ! instead and hope for the best
+\chardef\other=12
+\def\ttverbatim{\begingroup
+ \catcode`\\=\other \catcode`\{=\other \catcode`\}=\other \catcode`\$=\other
+ \catcode`\&=\other \catcode`\#=\other \catcode`\%=\other \catcode`\~=\other
+ \catcode`\_=\other \catcode`\^=\other
+ \obeyspaces \obeylines \tt}
+
+\def\begintt{$$\let\par=\endgraf \ttverbatim \parskip=0pt
+ \catcode`\!=0 \rightskip-5pc \ttfinish}
+{\catcode`\!=0 !catcode`!\=\other % ! is temporary escape character
+ !obeylines !obeyspaces % end of line is active
+ !gdef!ttfinish#1^^M#2\endtt{#1!vbox{#2}!endgroup$$}}
+
+\def\up{\hbox{\tt{\char'013}}}
+\def\markarrow#1{\vtop{\hbox{#1}\up}}
+
+@* Introduction.
+
+COPYRIGHT ( C ) R.M.Damerell, 1988.
+
+Permission is given to any person to make and distribute copies of this
+software, subject to the following conditions:
+
+1. All copies of the software must carry an exact copy of this notice.
+
+2. This software is distributed free of charge, ``AS IS" with absolutely no
+guarantee of performance. Any persons receiving or using this software must do
+so entirely at their own risk. Neither the authors nor their institutions
+accept any liability for any defects of this software, or for any consequential
+loss or damage however caused.
+
+3. Any person who changes this software must clearly mark it as modified and
+add a note describing the changes made.
+
+This is an experimental version and no guarantee of performance is given.
+I would like to receive bug reports, same address or electronic mail to
+DAMERELL at UK.AC.NSFNET-RELAY (From the USA, I believe that site is
+NSFNET-RELAY.AC.UK). \par\vskip 0.5in
+
+This program was originally based on D.E.Knuth's program \.{DVItype}, but so
+many changes were needed for various reasons that there is hardly any of the
+original code left. The purpose of this program is to provide a framework for
+users to write \TeX\ device drivers for a variety of `crude' devices. Roughly
+speaking, `crude' means any printer that cannot print the fonts that Metafont
+generates. This would include daisy-wheels and most impact dot-matrix
+printers. Considered as output printers for \TeX, such devices usually have
+some of the following misfeatures: \item
+1. Coarse resolution.\item
+2. Restricted character set. \item
+3. Some printers cannot do reverse line feeds, some can, and tear the paper.
+\item
+4. Slow interface between CPU and printer.\par
+
+Although such printers cannot do justice to \TeX\ output, drivers for them
+are still needed. Some users cannot afford high quality printers. Some can
+only afford to use them for final output; so they need to make proofs on a
+cheaper printer. Also, anybody who has a high quality printer may well need
+to refer to various \.{WEB} files while writing a driver for it. These can
+become illegible in critical places. Here is a sample from \.{DVItype}:
+\begintt
+
+A |fix_word| whose respective bytes are $(a,b,c,d)$ represents the number
+$$x=\left\{\vcenter{\halign{$#$,\hfil\qquad&if $#$\hfil\cr
+b\cdot2^{-4}+c\cdot2^{-12}+d\cdot2^{-20}&a=0;\cr
+-16+b\cdot2^{-4}+c\cdot2^{-12}+d\cdot2^{-20}&a=255.\cr}}\right.$$
+\endtt
+
+Using the basic (line printer) version of \.{Crudetype}, we can get a copy of
+these formulae which is at least legible, even though the result may not be at
+all pleasant to look at. A further difficulty with conventional drivers is
+that most of these use the algorithm `paint a page of pixels, send it down the
+line'. This places a heavy load on both the host computer and the link to the
+printer. Of course, one can try to reduce this load by various optimisations,
+(e.g. by writing critical bits of code in machine language) but this makes the
+program non-portable, and often introduces bugs. \.{Crudetype} is written
+entirely in \PASCAL, without any attempt at optimisation. When compiled on a
+VAX 780 with the NO-OPTIMISE, CHECK and DEBUG qualifiers it runs at about 2--3
+seconds a page. These times are highly variable, and the VMS optimiser reduces
+them by about 10-15\%.
+
+@ Printers vary enormously both in their capabilities and in the commands that
+drive them. The behaviour of \.{Crudetype} is controlled by a large number of
+constants, which supposedly describe how the target printer does things. This
+does have the disadvantage that the user must compile a separate copy of the
+program for each different printer, and also devise some way to ensure that he
+uses the right version for the intended printer. But the only alternative seemed
+to be that \.{Crudetype} should read and parse a file describing the printer and
+this appeared to be unbearably messy. In Version 3, many of these constants are
+now variables. This means that you can (to a limited extent) support different
+printers by flags in the command line. Ideally, these constants should be so
+designed that:
+
+\item
+1. Any decent printer can be driven by assigning the right values to these
+constants and recompiling. \item
+2. If the printer is properly documented, it should be immediately obvious
+what are the correct values for all these constants.
+
+At present I do not have enough experience of different printers to come near
+this ideal. In particular, some printers can download characters. The
+problems of writing a program to support this facility in proper generality
+are horrible and ghastly. I have not made any serious attempt yet to tackle
+them. There are just a few places where a hook appears, and I hope eventually
+to attach actual routines for downloading.
+
+Some of the more obvious problems of downloading are: when can you download?
+At any time? start of page? or only at start of document? Can you load one
+character, or must you load a whole font at a time? How much memory does the
+printer provide for downloading? How efficiently does it use its memory? What
+does it do when it runs out? Can you clear out old fonts to make more space?
+What is the format of a down-load command? What parameters does it need, in
+what order, with what punctuation? In what order must pixels be sent? Should
+they be compressed, and how?
+
+@ Implementation.
+
+The original version of \.{Crudetype} was aimed at a line printer, (because
+everybody has these) and was written on the VAX-VMS operating system. The
+intention is that this program should be easily adaptable both to other
+systems and to other printers. So most of it is written in Standard \PASCAL.
+(It is not possible to tell exactly how much of it is Standard, as we do not
+have a certified compiler.) But in some places, it is necessary to use
+extensions. In particular, \.{Crudetype} must read the font files, whose names
+are dynamically specified. That would be impossible in pure \PASCAL.
+\.{Crudetype} also uses non-Standard code in order to talk to the user's
+terminal. It asks for the name of the \.{DVI} file, and for the first page and
+the number of pages to print. Alternatively, it can read a `command line'
+and do simple-minded parsing. If an operating system forbids terminal
+interaction, the installer will have to find another way to give the program
+this information. As file handling is inevitably system-dependent, I have here
+allowed myself a lot of latitude in using VMS-specific procedures. If
+\.{Crudetype} cannot find a file, it will ask the user for another name. On
+the other hand, all files are read and written sequentially, and I have got
+rid of all uses of the default |case| statement. The intention is that all the
+system-dependent stuff goes near the top of the file, and all
+printer-dependent stuff at the end. Then with any luck you can merely
+concatenate Change files for the local system and the local printer, instead
+of having to merge them. All the code that is known to be non-Standard has
+been carefully segregated from the rest of the program. It amounts to about 20
+lines out of 750.
+@^System dependencies@>
+
+It is clearly impossible to predict what difficulties will appear in trying
+to install \.{Crudetype} on other systems, it would seem to be advisable to
+get the line printer version working before trying to adapt it for any other
+printer. To try to ease the process, I propose to distribute several test
+files with the program. These are of the form SAMPLE.TEX, SAMPLE.DVI and
+SAMPLE.PRI (the line printer output).
+
+Although `crude' printers differ very much in their capacities, one thing
+they nearly all have in common is that they cannot feed the paper backwards.
+Some printers cant |Backfeed| at all; some tear the paper, and others let the
+paper slip and so lose position. Therefore it seems to be essential to process
+each page as follows: first copy the page into a suitable structure, then sort
+it by vertical and horizontal position, then print it.
+
+Change files have been written for other systems: Unix (by P.King), NOS/VE
+(G-H.Knauf and M.Rawohl), and Primos (J.Warbrick). Many of the changes that
+these authors made are not system dependencies but improvements to the basic
+program. I have tried to incorporate these into the current version, and I
+want to thank them for their contributions.
+
+@* Main Program.
+
+@d banner=='This is Crudetype, Version 3.01, copyright, experimental'
+{printed when the program starts}
+
+@p program crudetype
+ @<Declarations@>
+ begin
+ @<Initialize@>;
+ repeat
+ @<For each page of \.{DVI}, print it if desired@>
+ until time_to_stop ;
+ @<Clean up afterwards@>;
+ exit: end.
+
+@ Now here are some of the messy things we must do to satisfy the rules of
+\PASCAL.
+
+@<Declarations@>=
+ (@<Files@>) ;
+ label exit ;
+ const @<Constants in the outer block@>
+ type @<Types in the outer block@>
+ var @<Globals in the outer block@>
+ @<Forward and external declarations@>
+ @<Lowest level procedures@>
+ @<Medium level procedures@>
+ @<Top level procedures@>
+
+@ @<Initialize@>=
+ @<Set |blank|@>
+ @<Set initial values@>
+ @<Open terminal channels@>
+ @<Determine operating parameters@>
+ @<Assign character codes@>
+ @<Set up for the printer@>
+ if not quiet then
+ display_ln(banner, ' --- ', device_ID) ;
+ @<Open |printfile|@>;
+ @<Read \.{DVI} preamble@>
+
+@ @<Glob...@>=
+ in_i, in_j :integer; {loop index for initializations}
+
+@ Next, here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@d do_nothing == {empty statement}
+@d exit == 732
+@d return == goto exit
+ {Go here when a loop ends abnormally}
+
+@ The next two procedures are very primitive debugging aids. All internally
+detected errors call |error|. Then they can be caught by suitable debugger
+commands. When \TeX\ sees a fatal error, it calls a procedure |jump_out| which
+jumps to a label at the ``|end.|'' of the program. This makes debugging much
+more difficult, because the program has ended normally, so it is impossible to
+interrogate variables, etc. So the earlier versions of \.{Crudetype} were
+designed to crash on a fatal error. This action is unpopular; I hope that fatal
+errors are now rare enough that we do not need to crash any longer.
+
+@<Forward...@>=
+procedure error ; begin end;
+@#
+procedure crash;
+var u: real;
+begin
+ u := -1 ;
+ error;
+ if ( u<0) then goto exit ;
+end;
+
+@* Interface to Operating System, 1: System dependent code.
+
+The purpose of these sections is to try to give a reasonable interface between
+the operating system and the rest of the program, which is supposed to be
+Standard \PASCAL. Nearly all the non-Standard code is concerned with file
+handling and the lowest level of I/O. This is an area where Standard \PASCAL\
+seems to be particularly weak. \.{Crudetype} was originally written for VMS,
+but as change files have started to appear, it has become clear that all the
+most VMS-specific code really ought to be put into a Change file. So this
+section contains a lot of dummy declarations. The actual declarations are
+expected to be found in Change files. It is hoped that most of the later
+sections will work on a wide range of machines. Everything here is system
+dependent, so there is no point in indexing each module separately.
+ @^System dependencies@>
+
+@ Here are some system-dependent types and constants. |integer| should be
+32-bits, and |real_number| should probably be 64. Normally, I use |integer|
+whenever the bit length is unimportant, but I use subranges in the
+|page_record| type, as this allows packing and may improve the program's
+performance.
+
+@d real_number == real
+@d make_real( #) == #
+ {convert an integer to a |real_number|. Usually automatic}
+@d max_half = 32767
+
+@<Types...@>=
+ byte = 0..255 ;
+ i_word = -max_half-1 .. max_half ;
+
+@ Characters and strings. I have here deleted all the code from \.{DVItype}
+that translates from characters to small integers and back. This is because
+we have to do a quite different translation anyway. If it is necessary to put
+that code back in, then it will probably be necessary to insert \begintt
+ define zchr(#) == xchr[#] \endtt
+because of the different brackets.
+
+Strings are represented internally by the |var_string| type and nearly all the
+code that uses these is Standard. There are 2 non-Standard things we need to do
+with strings: (1) convert a quoted string to a |var_string|. (2) convert a
+|var_string| into whatever type the local \PASCAL\ accepts as a file name.
+Because Standard \PASCAL\ has no decent mechanism to deal with quoted strings,
+every manufacturer has had to make non-Standard extensions to get a useful
+compiler. The main alternatives are: conformant arrays, blank-padding, and
+variable-length. The \WEB\ adopts conformant arrays because these are a ``level
+one'' feature of the Standard. But you can adopt other mechanisms by altering
+the macros and constants defined here. See various change files for examples.
+
+@d zchr == chr
+@d zord == ord
+@d Q_string == packed array[ first..last:integer] of char
+@d be_string(#) == set_string( #, buffer)
+@d set_j_to_length == j := last
+
+@<Forw...@>=
+ procedure set_string(
+ ss: Q_string; var result: var_string ) ; forward;
+
+@ These constants affect the way character strings get handled. They are
+described under ``character strings''.
+
+@<Const...@>=
+ padded = true ;
+ pad_char = ' ' ;
+ amp_and = '&' ;
+ ctrl_flag = '^' ;
+
+@ Now consider file names. As in \TeX, we assume that these have 3 parts:
+(directory)(name)(extension). The change file must define a procedure
+|@!parse_file| which chops a filename |name| into its components, called |dir|,
+|nam|, and |ex|. The procedure |name_of| must convert a |var_string| into
+whatever type the local \PASCAL\ accepts as a file name.
+
+@d filename == fix_string
+@d n_len == max_string
+
+@<Lowest...@>=
+ {Declare |parse_file|}
+
+@#
+ procedure name_of( var result: filename; name: var_string) ;
+ var n, i: integer;
+ begin
+ n := name.len ;
+ if ( n > n_len) then n := n_len ;
+ for i := 1 to n do result[ i] := name.data[ i] ;
+ for i := n+1 to n_len do result[ i] := ' ' ;
+ end;
+
+@ In this section we generate a name for the printed file, unless the user
+specified one. Essentially, this involves deleting the extension part of the
+\.{DVI} filename and adding a new one (in |@!print_ex|). If |@!same_dir|, put
+the file into the \.{DVI} file's directory.
+
+@<Open |printfile|@>=
+ if ( print_name.len = 0) then begin
+ parse_file( dvi_name, p_d, p_n, p_ex);
+ if same_dir then print_name := p_d
+ else print_name := blank ;
+ append( print_name, p_n );
+ append( print_name, print_ex) ;
+ end;
+
+@ The next few sections contain the lowest level code for file handling. These
+macros describe how we use the terminal.
+
+In V3, we have tried to implement a screen view version. To work this,
+we have to pause the output at times. on Unix and on VMS we had to do
+peculiar things to synchronise the terminal and printer streams. The
+macro |@!flush_out| works on VMS; see also the Unix changefile, under
+|inspection|.
+
+@d flush_out == begin print_ln ; display_ln(' '); end
+@#
+@d term_in==input {the terminal, considered as an input file}
+@d term_out==output {and output}
+@#
+@d can_interact == true
+@d i_reset_terminal == do_nothing {Switch terminal to input}
+@d o_rewrite_terminal == do_nothing {and back to output}
+@#
+@d display(#)==write(term_out, #)
+@d display_ln(#)==write_ln(term_out, # )
+@d print(#)==write(printfile, #)
+@d print_ln ==write_ln(printfile )
+@d string_show( #) == print_string( term_out, #, ' ')
+@d string_print( #) == print_string( printfile, #, ctrl_flag )
+@#
+@d warn (#)==begin display_ln('Error: ', #); error; end
+@d abort(#)==begin display_ln('Fatal: ', #); crash; end
+@d bad_dvi(#)==abort('Bad DVI file: ',# )
+
+@<Open terminal channels@>= do_nothing
+
+@ As an initial attempt at downloading, we declare a |@!raster_file|.
+
+@<Files@>= term_in, term_out, printfile, dvi_file, tfm_file, raster_file
+
+@ Here we define some system-dependent properties of files. \.{Crudetype}
+tries to search for files in a sensible way by using default names. Note that
+the default names should not contain wild cards for their missing bits.
+Several different patterns have been invented for raster file names. The
+default name |raster_def| contains the substring |'&D'|. This is put in to
+be replaced by the calculated magnification when we try to open the file.
+
+@d block_length = 512
+@d same_dir == false
+
+@<Set init...@>=
+ be_string( '.DVI' ) ; dvi_def := buffer ;
+ be_string( 'TEX$FONTS:.TFM' ) ; tfm_def := buffer ;
+ be_string( 'TEX$GF:.&DGF' ) ; raster_def := buffer ;
+ be_string( '.PRI' ) ; print_ex := buffer ;
+
+@ |@!open_binary| is the lowest-level procedure for opening binary files. If
+possible, it must try to open a file called |name| and not crash if the file
+cannot be opened. Return true or false to indicate success.
+
+@<Lowest...@>=
+ {Declare |open_binary|}
+
+@ @<Open |printfile|@>=
+ rewrite(printfile) ;
+
+@ \.{Crudetype} tries to read a ``command line''. |@!read_command_line| should
+be the procedure that actually reads the line, and these macros extract pieces
+of it. The code below should work on systems that cannot read command lines.
+
+@d get_val( #) == # := s_to_i( #, true)
+@d prefix == "/"
+@d got_cl == ( command.len > 0)
+@d read_command_line( #) == do_nothing
+
+@<Lowest...@>=
+ {Declare |read_command_line| }
+@#
+ procedure get_command ;
+ var ss: fix_string ;
+ begin
+ ss := blank.data ;
+ read_command_line( ss) ;
+ be_string( ss ) ; command := buffer ;
+ end;
+
+@ Here are macros for the adaptable merge sort. See the section on sorting for
+explanation.
+
+@d image(#) == pool[#]
+@d create == incr(cell)
+@d link_type == page_i
+@d first_cell == cell := 0
+@d wipe_out(#) ==
+@d declare_pool == pool: array [page_i] of page_record;
+@d garbage == cell := zzz ;
+
+@* Interface to Operating System, 2: Dialog with Environment.
+
+In this section, \.{Crudetype} will determine what it is supposed to be doing.
+It might be called either interactively, by a command like this: \begintt
+(RUN) crudetype \endtt
+ or in batchmode by a command like this:\begintt
+(RUN) crudetype (parameters)\endtt
+ In the first case, \.{Crudetype} must ask the user for all its operating
+parameters. In the second, it must read the parameters from the command line
+and supply defaults for all the missing ones. If the local operating system
+does not allow either of these methods, the installer will have to devise some
+other way to supply the data.
+
+If there is a command line, the system-dependent procedure |@!get_command|
+should fetch it and put it into |command|; then |parse_command| will read it.
+
+@<Determine operating parameters@>=
+ command := blank ; get_command ;
+ dvi_name := blank ;
+ if got_cl then parse_command ;
+ @<Get \.{DVI} file name and open it@> ;
+ if not got_cl then @<Ask the user@> ;
+
+@ The main argument is the input (\.{DVI}) file name. All other arguments are
+optional, and have the form (prefix)(key)(value). The |@!prefix| can be any
+character reserved for that purpose (`/' in VMS, `-' in Unix, etc). The
+keyword is one letter, in upper or lower case. The value is usually an
+integer. The permitted keys are:
+\item {\tt /p} |printfilename| to redirect output,
+\item {\tt /q} to suppress the information messages,
+\item {\tt /r} to suppress form feeds in the output,
+\item {\tt /s} to suppress blank lines,
+\item {\tt /i} attempts a screen view, (i stands for `|inspection|')
+\item {\tt /b} attempts a `batch' view version. The difference between these
+is that {\tt /i} tries to give immediate output on the terminal and {\tt /b}
+puts it in a file to be examined later.
+\item {\tt /m} (number) to give the magnification,
+\item {\tt /x} (number) to give a horizontal magnification,
+\item {\tt /y} (number) to give a vertical magnification,
+\item {\tt /d} (directory) specifies an alternative font directory,
+\item {\tt /f} (number) to give the first page number,
+\item {\tt /c} (number) to give the maximum number of pages to print.
+\item {\tt /e}, {\tt /o, /l } are reserved for use by certain changefiles.
+
+Here are the defaults:
+
+@<Set init...@>=
+ quiet := false ;
+ run_on := false ;
+ squash := false ;
+ magnify := 100 ;
+ h_mag := 100 ;
+ v_mag := 100 ;
+ batch_view := false ;
+ first_page := -1000000 ;
+ count_pages := 1000000 ;
+ print_name := blank ;
+
+@ @<Glob...@>=
+ command: var_string ;
+ squash, run_on, quiet, batch_view: boolean;
+ magnify, h_mag, v_mag, first_page, count_pages : integer ;
+
+@ If either {\tt /x} or {\tt /y} is present as well as {\tt /m}, they
+both take effect. Note these numbers are percents; default = 100
+means use the mag. specified in the \.{DVI} file. {\tt /v} implies
+{\tt /s} and {\tt /r}, and it also alters the vertical magnification
+and suppresses overstriking.
+
+@<If the |key| is valid, do the corresponding command@>=
+ if ( key = "Q") then quiet := true
+ else if ( key = "S") then squash := true
+ else if ( key = "R") then run_on := true
+ else if ( key = "P") then get_name( print_name)
+ else if ( key = "D") then get_name( tfm_def)
+ else if ( key = "F") then get_val( first_page)
+ else if ( key = "C") then get_val( count_pages)
+ else if ( key = "M") then get_val( magnify)
+ else if ( key = "X") then get_val( h_mag)
+ else if ( key = "Y") then get_val( v_mag)
+
+@ If there was no command line, try to send messages to the user at a
+terminal. This requires nonstandard \PASCAL\ constructions to handle the
+online interaction. So it may be necessary on some systems to omit the dialog.
+First, the \.{DVI} file name.
+
+@<Get \.{DVI} file name and open it@>=
+ if can_interact and ( dvi_name.len = 0) then repeat
+ ask_prompt('DVI file name? ') ;
+ get_name( dvi_name) ;
+ until ( dvi_name.len > 0) ;
+ if not open_and_ask(dvi_file, dvi_indx, dvi_name, dvi_def, true)
+ then abort('Couldnt open DVI file')
+ @.Fatal: Couldnt open@>
+
+@ But when we come to open a font file, we merely report a failure:
+
+@<Open font file@>=
+ font_ok := open_and_ask (tfm_file, tfm_indx, tfm_name, tfm_def, true) ;
+
+@ Nobody enjoys filling in forms; so we only ask a few parameters in
+interactive mode. Most characters in \TeX\ fonts are narrower than
+line-printer characters. So we must spread them out to make them fit.
+Originally, this was done by multiplying \.{DVI} distances by a constant
+factor |h_fudge|. This is all right for one size of type but it tends to fail
+for other sizes because if the predominant type size is larger than expected,
+then rounding with a constant factor makes everything\qquad\ very\qquad\
+badly\qquad\ spread\qquad\ out. It seemed that the least bad way to tackle
+this is to allow the user to specify an extra magnification factor.
+@^magnification@>
+
+@<Ask the user@>=
+ if can_interact then begin
+ buffer := blank ;
+ ask_prompt('First page? (default = print ALL pages) ' );
+ if ( buffer.len > 0) then get_val( first_page) ;
+ ask_prompt('Maximum no. of pages? (default = 1000000) ' ) ;
+ if ( buffer.len > 0) then get_val( count_pages) ;
+ ask_prompt (
+ 'What magnification? (integer, percent, default=100%=DVI file mag)1') ;
+ if ( buffer.len > 0) then get_val( magnify) ;
+ end;
+ @.First page?@>@.Max. no. of pages?@>@.What magnification?@>
+
+@ Since the terminal is being used for both input and output, some systems
+need a special routine to make sure that the user can see a prompt message
+before waiting for input based on that message. (Otherwise the message may
+just be sitting in a hidden buffer somewhere, and the user will have no idea
+what the program is waiting for.) Here, we assume that the system-dependent
+macros |@!i_reset_terminal| and |@!o_rewrite_terminal| (defined above) will do
+whatever is necessary to switch the terminal from output to input and back. We
+assume that the terminal is normally in output mode, and call these macros
+when we want input. If the system does not allow this, then |@!can_interact|
+should be set false.
+
+Here is how the program prompts for input: the argument of |ask_prompt| is the
+prompt text. Because of the anomalous behaviour of |write|, this ought to work
+with arguments of any length, even on versions of \PASCAL\ that only allow
+fixed length strings.
+
+@d ask_prompt(#) == begin
+ display_ln(#) ; read_terminal ; end;
+
+@<Lowest...@>=
+ procedure read_terminal;
+ var k: byte ;
+ begin i_reset_terminal;
+ buffer := blank ;
+ if not eof(term_in ) then begin
+ if eoln(term_in) then read_ln(term_in);
+ k:=0;
+ while( not eoln(term_in)) do
+ begin incr(k); buffer.data[k]:=term_in^; get(term_in);
+ end;
+ buffer.len := k ;
+ finger := 0 ; get_char ;
+ end;
+ o_rewrite_terminal ;
+ end;
+
+@ If the printer is actually a VDU, then possibly the user will want to pause
+at intervals.
+
+@<Check pause@>=
+ if do_pause then begin
+ incr(pause_i) ;
+ if (pause_i >= pause_steps) then begin
+ flush_out ;
+ display(pause_ask);
+ i_reset_terminal;
+ read_ln (term_in );
+ o_rewrite_terminal ;
+ string_show(pause_after);
+ pause_i := 0 ;
+ end;
+ end;
+
+@ @<Const...@>=
+ pause_ask = 'PAUSED. Type <return> to continue' ;
+
+@* Interface to Operating System, 3: Input from binary files.
+
+The main input file is the \.{DVI} file. Logically, this is just a stream of
+8-bit bytes, with no record or block structure. However VMS \PASCAL\
+apparently cannot handle files of this type; so I have adopted the blocking
+scheme (due to D.R.Fuchs) from the VMS \.{DVItype} change file. But a lot of
+the code has been rewritten. Some other operating systems use similar
+blocking schemes; so this code may possibly work without much change. The
+program deals with two binary file variables: |@!dvi_file| is the main input
+file that we are printing, and |@!tfm_file| the current font metric file from
+which character-width information is being read. Each of these has a name and
+a counter, declared here; also a default name (system dependent, and so
+declared previously).
+@^Fuchs, D.R.@>
+
+@<Types...@>=
+ @!byte_block=packed array [0..block_length-1] of byte ;
+ @!byte_file= packed file of byte_block;
+
+@ @<Glob...@>=
+ dvi_file, tfm_file, raster_file: byte_file ;
+ dvi_indx, tfm_indx, raster_indx: integer ; {Block pointers}
+ dvi_name, tfm_name, raster_name, print_name, {File names}
+ dvi_def, tfm_def, raster_def, print_ex : var_string ; {and default names}
+ font_name, p_n, p_d, p_ex : var_string ;
+ {Scratch variables for assembling names}
+ printfile: text ;
+
+@ Here is the procedure that actually opens binary files. It searches for a
+file called |name|, supplying missing bits from the default file-specification
+in |other_name|. |f_f| is the file being opened, and |f_c| is its counter.
+
+@<Medium...@>=
+ function open_and_ask
+ (var f_f: byte_file; var f_c: integer; var name,
+ default: var_string; ask: boolean) : boolean ;
+ var success, fail: boolean;
+ def_dir, def_nam, def_ex, try_dir, try_nam, try_ex: var_string ;
+ begin
+ success := false; fail := false ;
+ repeat
+ @<Assemble the |name|@> ;
+ success := open_binary(f_f, name ) ;
+ if success then f_c := 0
+ else @<Try another name@>
+ until success or fail ;
+ open_and_ask:= success ;
+ end;
+
+@ @<Assemble the |name|@>=
+ parse_file( default, def_dir, def_nam, def_ex) ;
+ parse_file( name, try_dir, try_nam, try_ex) ;
+ if ( try_dir.len = 0) then name := def_dir
+ else name := try_dir ;
+ append ( name , try_nam);
+ if ( try_ex.len = 0) then append ( name , def_ex)
+ else append ( name, try_ex) ;
+
+@ If this fails, then ask the user for another name. If the operating system
+forbids this, or if the user refuses, then indicate a failure.
+
+@<Try another name@>=
+ if ask then begin
+ display('Couldnt open file: ' );
+ string_show(name) ;
+ display_ln (' ') ;
+ if can_interact then begin
+ ask_prompt('Please type a replacement or NO to abandon search' ) ;
+ name := buffer ;
+ if ( (name.len = 2) and
+ ( (name.data[1] = 'N') or (name.data[1] = 'n'))
+ and ( (name.data[2] = 'O') or (name.data[2] = 'o')))
+ then fail := true;
+ end else fail := true;
+ end else fail := true;
+ @.Couldnt open file@>@.Please type...@>
+
+@ \.{DVItype} has seven functions for reading integers from the \.{DVI} file
+and two more for the \.{TFM} file. I have condensed these. In order for
+these procedures to work, they must all have as parameters both the file and
+its attached counter. These macros generate the procedure calls.
+
+@d read_end(#) == # @=)@>
+@d skip(#) == skip_bytes @=(@> # @& file, # @& indx, read_end
+@d get_integer(#) == read_integer @=(@> # @& file, # @& indx, read_end
+@d get_byte(#) == read_byte(# @& file, # @& indx)
+@d get_real(#) == read_real(# @& file, # @& indx)
+
+@<Lowest...@>=
+ function read_byte(var f_file: byte_file; var f_indx: integer) : byte;
+ begin
+ if eof(f_file) then
+ warn('End of file' )
+ else begin
+ read_byte := f_file^[f_indx] ;
+ incr(f_indx);
+ if f_indx =block_length then begin
+ get(f_file );
+ f_indx:=0;
+ end;
+ end;
+ end ;
+
+@#
+ procedure skip_bytes(var f_file: byte_file; var f_indx: integer; n:integer);
+ {discard n bytes from |f_file|}
+ begin
+ if n < 0 then abort('Skip_bytes called with negative number');
+ f_indx := f_indx + n;
+ while( f_indx >= block_length) do
+ begin
+ if eof(f_file) then
+ warn('End of file' )
+ else get(f_file );
+ f_indx := f_indx - block_length ;
+ end ;
+ end;
+ @.Error: End of file@> @.Fatal: Skip_bytes...@>
+
+@ The next function reads an integer from a file. |k| specifies the type.
+|abs(k)| is the number of bytes, and the integer will be signed if |k<0|.
+
+@<Lowest...@>=
+ function read_integer
+ (var f_file: byte_file; var f_indx: integer; k: integer): integer;
+ var a, i : byte; n: integer;
+ begin n := get_byte(f );
+ if (k < 0) and (n > 127) then n := n-256 ;
+ for i := 1 to abs(k) - 1 do
+ begin
+ a := get_byte(f ) ;
+ n := n*256 + a ;
+ end ;
+ read_integer := n ;
+ end;
+
+@ A real number is stored in the file as 2 integers, numerator first.
+
+@<Medium...@>=
+ function read_real(var f_file: byte_file; var f_indx: integer ): real_number;
+ var a, b: integer;
+ begin a := get_integer(f )(-4);
+ b := get_integer(f )(-4);
+ if b <= 0 then
+ begin
+ warn('Denominator <= 0! '); read_real:= 1;
+ end
+ else read_real:= make_real(a)/make_real(b) ;
+ end;
+ @.Error: Denominator...@>
+
+@* Page selection.
+
+We have now disposed of all the code that is known to be system-dependent, so
+we can resume a proper top-down description of the program. The basic method
+for processing each page is that all printable characters are written onto a
+structure called a `page image'. This is a list of things called `page
+records'. Each page record represents one printable character, and contains
+two fields giving the intended position on the page. Eventually the image will
+be sorted and then copied to the |printfile|. This means that \.{Crudetype}
+has to remember three sets of coordinates. In order to help to keep track of
+many global variables, we use prefixes. \.{DVI} variables are prefixed with
+|D_|, page image variables with |IM_|, and the printer's variables with |PR_|.
+When this module starts, the \.{DVI} file should be positioned at or before a
+BOP.
+
+@<For each page...@>=
+ read_BOP;
+ if (counter[0] >= first_page) then start := true ;
+ if start and (count_pages > 0 )
+ then begin
+ @<Maybe a formfeed@>
+ decr(count_pages);
+ if not quiet then display('[', counter[0]:1 ); {Progress report}
+ Read_one_page ;
+ @<Sort the page@>
+ Send_page ;
+ if not quiet then display( ']' );
+ end
+ else if ( count_pages > 0) then Skip_page
+ else time_to_stop := true;
+
+@ This program only gives a small subset of the page-selection facilities of
+\.{DVItype}. The most you can do is to specify the starting page and the
+maximum number of pages to print. This will be controlled by these variables:
+
+@<Glob...@>=
+ start, time_to_stop, page_gap: boolean;
+ counter: array[0..9] of integer ;
+
+@ @<Set init...@>=
+ start := false ; time_to_stop := false; page_gap := false ;
+ for in_i := 0 to 9 do counter[ in_i ] := 0 ;
+
+@ |@!D_com| is the \.{DVI} command byte, |@!D_par| its first parameter.
+
+@<Top level...@>=
+ procedure Read_one_page ;
+ var D_com: byte; D_par: integer; end_page: boolean ;
+ begin end_page := false;
+ @<Set up an empty page image and |push| the position@>
+ repeat
+ @<Get \.{DVI} command |D_com|, and do it@>
+ until end_page;
+ pop ;
+ end ;
+
+@#procedure Skip_page ;
+ var D_com: byte; D_par: integer; end_page: boolean ;
+ begin
+ end_page := false;
+ repeat
+ @<Skip \.{DVI} command, but we must process any |font_def|@>
+ until end_page;
+ end ;
+
+@* Translating the device-independent file, 1: The big switch.
+
+Refer to \.{DVItype} or to \.{TUG}boat (Vol.3, No.2) for a description of the
+\.{DVI} file format. As in \.{DVItype}, we process each \.{DVI} command via a
+big |case| statement. But 192 of the cases are very similar, so lets dispose
+of them first.
+ @.TUGboat@>
+
+@d id_byte=2 {identifies the kind of \.{DVI} files described here}
+@d move_right ==
+ D_h := D_h + D_dis ;
+ IM_h := IM_h + IM_dis
+
+@<Get \.{DVI} command...@>=
+ D_dis := 0 ; IM_dis := 0 ;
+ D_com := get_byte(dvi);
+ if D_com < 128 then begin
+ set_character(D_com); move_right ;
+ end
+ else if (D_com >= 171) and (D_com <= 234) then
+ change_font(D_com - 171)
+ else
+
+@ @<Skip \.{DVI} command...@>=
+ D_com := get_byte(dvi);
+ if (D_com < 128)
+ or ((D_com <= 234) and (D_com >= 171))
+ then do_nothing
+ else
+
+@ Now we come to the |case| statement proper. This section of the program is
+long and complicated, and I have tried to clean it up. Some commands want an
+unsigned parameter, called |D_par|, to be read from the file. We use
+|four_cases| for those. Others want a signed parameter; they are all
+movements. We use |move_cases| for those.
+
+@d four_case_end(#) == # ; end
+@d four_cases(#)==
+ #,#+1,#+2,#+3: begin D_par := get_integer(dvi)( D_com - # + 1 );
+ four_case_end
+@d move_cases(#)==
+ #,#+1,#+2,#+3: begin D_par := get_integer(dvi)( # - D_com - 1 );
+ four_case_end
+@#
+
+@<Get \.{DVI} command...@>=
+case D_com of
+ four_cases(128) (set_character(D_par); move_right );
+ 132: begin set_rule; move_right ; end;
+ four_cases(133) (set_character(D_par) );
+ 137: set_rule ;
+ 138: do_nothing ;
+@#
+ 140: end_page := true ;
+ 141: push;
+ 142: pop;
+ move_cases(143) (D_h := D_h+D_par);
+ 147:{W0} D_h := D_h+D_w ;
+ move_cases(148) (D_w := D_par; D_h := D_h+D_w );
+ 152:{X0} D_h := D_h+D_x ;
+ move_cases(153) (D_x := D_par; D_h := D_h+D_x );
+ move_cases(157) (move_down(D_par));
+ 161:{Y0} move_down(D_y);
+ move_cases(162) (D_y := D_par; move_down(D_y) );
+ 166:{Z0} move_down(D_z);
+ move_cases(167) (D_z := D_par; move_down(D_z) );
+@#
+ four_cases(235) (change_font(D_par) );
+ four_cases(243) (define_font(D_par) );
+@#
+ @<Fourteen illegal cases: print suitable error messages@>
+end ;
+
+@ When skipping a page, we must throw away parameters instead of using them.
+
+@d four_throw(#) ==
+ #,#+1,#+2,#+3: skip(dvi)(D_com - # + 1 )
+@#
+
+@<Skip \.{DVI} command...@>=
+case D_com of
+ four_throw(128);
+ 132, 137: skip(dvi)(8); {sizes of a rule}
+ four_throw(133);
+ 138: ;
+ 140: end_page := true ;
+ 141,142: ;
+ four_throw(143);
+ 147: ;
+ four_throw(148);
+ 152: ;
+ four_throw(153);
+ four_throw(157);
+ 161: ;
+ four_throw(162);
+ 166: ;
+ four_throw(167);
+@#
+ four_throw(235);
+ four_cases(243) (define_font(D_par) );
+@#
+@<Fourteen illegal...@>
+end ;
+
+@ Finally, there are 14 illegal values of |D_com| that generate various errors.
+
+@<Fourteen illegal...@>=
+ four_cases(239)
+ (warn('Cant do Special commands') ; skip(dvi)(D_par) );
+ 139, 247, 248, 249:
+ bad_dvi('Byte: ', D_com:1 , ' out of context inside page' ) ;
+ 250,251,252,253,254,255:
+ bad_dvi('Illegal command byte, ', D_com ) ;
+ @.Error: Cant do Special@>
+ @.Fatal: Bad DVI: Byte out of context@>
+
+@* Translating the device-independent file, 2: Paging and the stack.
+
+The definition of \.{DVI} files refers to six registers, (|D_h, D_v, D_w,
+D_x, D_y, D_z|), which hold integer values in \.{DVI} units. We shall need
+additional registers in order to calculate a rounded position. From time to
+time, we save the current values of these on a stack, represented by the
+following arrays.
+
+@d max_stack = 200 {\.{DVI} files shouldn't |push| beyond this depth}
+
+@<Glob...@>=
+ D_h,D_v,D_w,D_x,D_y,D_z : integer; {current \.{DVI} state values}
+ D_h_stack, D_v_stack, D_w_stack, D_x_stack, D_y_stack, D_z_stack:
+ array [0..max_stack+2] of integer; {pushed down values }
+ @!stack_ht: 0..max_stack; {current stack depth}
+ just_pushed: boolean;
+
+@ @<Set up an empty page...@>=
+ D_w := 0 ; D_x := 0 ;
+ D_y := 0 ; D_z := 0 ;
+ stack_ht := 0 ;
+ rail_base := 0 ;
+ just_pushed := false ;
+
+@ Here is how \.{DVItype} manipulates the stack: The first |push| on a page
+fills the zeroth place on the stack and sets |stack_ht| = 1. So the used
+places are numbered |0..stack_ht- 1|. Now |push| and |pop| do the obvious
+things.
+
+@<Lowest...@>=
+ procedure push;
+ var x: real_number ;
+ begin if stack_ht=max_stack then
+ abort('Capacity exceeded (stack size=', max_stack:1,')')
+ else begin
+ D_h_stack[stack_ht]:=D_h; D_v_stack[stack_ht]:=D_v;
+ D_w_stack[stack_ht]:=D_w; D_x_stack[stack_ht]:=D_x;
+ D_y_stack[stack_ht]:=D_y; D_z_stack[stack_ht]:=D_z;
+ @<Some adjustments are needed here for rounding@>
+ incr(stack_ht); just_pushed := true ;
+ end;
+ end;
+ @.Fatal: Capacity exceeded...@>
+
+@# procedure pop;
+ begin if stack_ht=0 then warn('POP illegal at level zero')
+ else begin
+ decr(stack_ht);
+ D_h:=D_h_stack[stack_ht]; D_v:=D_v_stack[stack_ht];
+ D_w:=D_w_stack[stack_ht]; D_x:=D_x_stack[stack_ht];
+ D_y:=D_y_stack[stack_ht]; D_z:=D_z_stack[stack_ht];
+ IM_h := IM_h_stack[stack_ht];IM_v := IM_v_stack[stack_ht];
+ @<Set |rail_base|@>
+ end;
+ end;
+ @.Error: POP illegal...@>
+
+@ This procedure gets called when we expect to read a new page. It looks for
+the next |BOP|; if it finds the postamble instead, it sets |count_pages < 0| as
+a signal.
+
+@d POST = 248
+@d NOP = 138
+@d BOP = 139
+
+@<Top level...@>=
+ procedure read_BOP;
+ var k: byte ; D_par:integer ;
+ begin
+ repeat k:= get_byte(dvi);
+ if (k>= 243)and(k <= 246 ) then {a |font_def|}
+ begin D_par:=get_integer(dvi) (k-242 ); define_font(D_par); k:=NOP;
+ end;
+ until k<>NOP;
+ if k=POST then
+ count_pages := -1
+ else if k<>BOP then bad_dvi('Byte is not BOP')
+ @.Fatal: Bad DVI: Byte not BOP@>
+ else begin
+ for k:=0 to 9 do counter[k]:= get_integer(dvi)(-4);
+ skip(dvi)(4);
+ end;
+ end;
+
+@ A \.{DVI}-reading program that reads the postamble first need not look at the
+preamble; but \.{Crudetype} reads the \.{DVI} file sequentially.
+
+@d PRE=247 {preamble}
+
+@<Read \.{DVI} preamble@>=
+ bbb:= get_byte(dvi); {fetch the first byte}
+ if bbb<>PRE then bad_dvi('First byte isn''t start of preamble!');
+ @.Fatal: Bad DVI: First byte...@>
+ bbb:= get_byte(dvi); {fetch the identification byte}
+ if bbb<>id_byte then
+ warn('Identification byte should be ',id_byte:1,', it is actually', bbb:1 );
+ @.Error: Identification...@>
+ @<Compute the conversion factors@>;
+ bbb:= get_byte(dvi); {fetch the length of the introductory comment}
+ if quiet then skip( dvi)( bbb)
+ else begin
+ for nnn := 1 to bbb do
+ display(zchr(get_byte(dvi)));
+ display_ln(' ');
+ end;
+
+@ The conversion factor |h_conv| is figured as follows: There are exactly
+|n/d| decimicrons per \.{DVI} unit and 254000 decimicrons per inch, and
+|h_resolution| |h_steps| per inch.
+
+@<Glob...@>=
+ dvi_factor, h_conv, v_conv, magnification : real_number;
+ D_l_margin, D_top_margin, nnn:integer; {general purpose register}
+ bbb: byte ;
+
+@ @<Compute the conversion factors@>=
+ dvi_factor := get_real(dvi)/254000.0 ;
+ {This converts \.{DVI} units to inches (on an ideal device) }
+ D_l_margin := round( l_margin/dvi_factor) ;
+ D_top_margin := round( top_margin/dvi_factor) ;
+ magnification := get_integer(dvi)(4) / 1000 ;
+ dvi_factor := dvi_factor * magnification ;
+ dvi_factor := dvi_factor * make_real( magnify/ 100.0) ;
+ {Extra magnification specified by user}
+ h_conv:= dvi_factor * h_resolution * h_fudge * make_real( h_mag/ 100.0) ;
+ v_conv:= dvi_factor * v_resolution * v_fudge * make_real( v_mag/ 100.0) ;
+
+@* Translating the device-independent file, 3: Setting a Rule.
+
+|D_p| is the height and |D_q| is the width. A rule has to be assembled from
+the available characters. First: is the rule to be set at all? Second: is it
+horizontal or vertical? (Because of the limited name lengths, we call them
+|Post| and |Rail|.) The test applied here is quite arbitrary.
+
+@<Medium...@>=
+ procedure set_rule;
+ var D_p,D_q: integer;
+ begin
+ D_p:=get_integer(dvi) (-4);
+ D_q:=get_integer(dvi)(-4);
+ if (D_p<=0)or(D_q<=0) then
+ {an invisible rule! Dont ask me why \TeX\ wants to do this}
+ else if (D_p*v_conv <= post_height/2)
+ then do_rail(D_p, D_q)
+ else do_post(D_p, D_q);
+ end;
+
+@ Setting a vertical rule is simple: we just fill all the space with the
+relevant character.
+
+@<Lowest...@>=
+ procedure do_post(D_rul_ht, D_rul_width: integer);
+ var vn, vi, hn, hi, post_v, rule_hp : integer;
+ rule_cod: code_object ;
+ begin
+ @<|Post| set sizes@>;
+ for vi := vn - 1 downto 0 do
+ begin
+ post_v := IM_v - vi * post_height ;
+ for hi := 1 to hn do
+ begin
+ rule_hp := IM_h + (hi - 1) * post_width ;
+ do_set_char(post_v, rule_hp, rule_cod);
+ end;
+ end;
+ end;
+
+@ Note that whereas \.{DVItype} rounds all sizes up, \.{Crudetype} rounds to
+nearest integer. This seems more likely to work on a crude resolution. But we
+force the rounded size to be |>= 1| .
+
+@<|Post| set...@>=
+ round_IM_h ( 0);
+ hn := round(D_rul_width * h_conv / post_width );
+ vn := round(D_rul_ht * v_conv / post_height);
+ if hn <= 0 then hn := 1;
+ if vn <= 0 then vn := 1;
+ rule_cod := post_char;
+
+@ A horizontal rule is more complicated, as there is then a selection of
+characters. This matters if the printer has only a very coarse vertical
+positioning. For example, a line printer has only minus and underscore, but a
+VT-100 has 5 bars at different heights. |@!rail_types| should be set to the
+number of different horizontal bars that the printer can draw within one
+|v_step|. We measure the vertical position of a rule in |rail_steps|,
+which are smaller than |v_steps| in the same ratio.
+
+@<Glob...@>=
+ rail_chars : packed array [1..rail_types] of code_object ;
+ {Number from bottom of page up; so no. 1 might be an underscore}
+ rail_base : integer ;
+ {Position of bottom edge of a rule in |rail_steps|}
+ post_char : code_object ;
+
+@ @<Const...@>=
+ @<Rule setting constants@>
+ {Printer-dependent, so they must go at the end of the file}
+
+@ @<Lowest...@>=
+ procedure do_rail(D_rul_ht, D_rul_width: integer);
+ var vn, vi, hn, hi,
+ rail_v, {Current position in |rail_steps|}
+ char_vp, {Position in |v_steps| where a rule char will be set}
+ rule_hp: integer;
+ rule_cod: code_object ;
+ char_i : 1..rail_types ; {indicates which character to be used}
+ begin
+ @<|Rail| set sizes@>
+ for vi := vn-1 downto 0 do begin
+ rail_v := rail_base - vi ;
+
+@ Now to assign |char_i| and |char_vp|. The easiest way is to consider a simple
+example. Suppose |rail_types = 5| and |rail_v = 50|. This addresses the
+underscore at the bottom edge of a text character at |10 v_steps|.
+So |char_i| wants to be 1 and |char_vp| 10. So...
+
+@<Lowest...@>=
+ char_vp := ((rail_v - 1) div rail_types ) + 1 ;
+ char_i := rail_types - ((rail_v - 1) mod rail_types ) ;
+ rule_cod := rail_chars [ char_i] ;
+ for hi := 1 to hn do begin
+ rule_hp := IM_h + (hi-1) * rail_width ;
+ do_set_char(char_vp, rule_hp, rule_cod) ;
+ end;
+end;
+end;
+
+@ @<|Rail| set...@>=
+ round_IM_h ( 0);
+ hn := round(D_rul_width * h_conv/ rail_width);
+ vn := round(D_rul_ht * v_conv * rail_types/ rail_height );
+ if hn <= 0 then hn := 1;
+ if vn <= 0 then vn := 1;
+
+@ Now consider how to set |rail_base|. Horizontal rules are mostly used for
+underlining text, and then they should be aligned with the underscore
+character on the same line of text. So normally, we just do the following. The
+exception occurs when the \.{DVI} file does an explicit vertical move.
+
+@<Set |rail_base|@>=
+ rail_base := IM_v * rail_types ;
+
+@* Translating the device-independent file, 4: Changing and defining Fonts.
+
+The following tables describe all the \TeX\ fonts that \.{Crudetype} currently
+knows about.
+
+@<Glob...@>=
+ nf: D_font_ptr ;
+ {The number of fonts so far defined. These will be numbered |0..nf-1| }
+ @!font_num, {external font numbers}
+ @!font_space, {boundary between ``small'' and ``large'' spaces}
+ @!scheme, {pointer into |codes|}
+ @!first_ch, {First character in the font}
+ @!last_ch: {and last}
+ array [D_font_ptr] of integer;
+ D_width: array[D_font_ptr, D_char_ptr ] of integer ;
+ {character widths, as given in \.{TFM} file, should be in \.{DVI} units}
+ @!D_check, {the font checksum must be global for HPGF}
+ thin_space, D_font, cur_scheme: integer ; {The current values}
+
+@ @<Type...@>=
+ D_font_ptr = 0..max_D_fonts;
+ D_char_ptr = 0..max_D_char;
+
+@ The size of the tables can be altered at compile time to extend or reduce
+\.{Crudetype}'s capacity.
+
+@<Constants...@>=
+ @!max_D_fonts=100; {maximum number of distinct fonts per \.{DVI} file}
+ @!max_D_char = 255; {max. value of a \TeX\ character in a \TeX\ font}
+
+@ Initially, all these tables are blank.
+
+@<Set init...@>=
+ nf:=0;
+ for in_i := 0 to max_D_fonts do
+ begin
+ font_num[in_i ] := 0 ;
+ scheme[in_i ] := 0 ;
+ first_ch[in_i ] := 0 ;
+ last_ch[in_i ] := 0 ;
+ font_space[in_i]:= 0 ;
+ end;
+
+@ @<Set up an empty page...@>=
+ thin_space := 0 ;
+ D_font := nf ;
+ cur_scheme := 0 ;
+
+@ @<Medium...@>=
+ procedure change_font (D_new: integer);
+ begin
+ D_font := 0 ;
+ font_num[nf]:=D_new;
+ while( font_num[D_font]<>D_new) do incr(D_font);
+ if D_font = nf then
+ warn('Undefined font called for, number ', D_new:1 );
+ @.Error: Undefined font@>
+ cur_scheme := scheme[D_font] ;
+ thin_space := font_space[D_font] ;
+ end;
+
+@ The following procedure is called whenever we read a |font_def| command from
+the \.{DVI} file. In general, any error while defining a font causes a jump to
+label |bad_font|, leaving the new font undefined. |good_font| is a hook for the
+HP change file.
+
+@d bad_font = 9999
+@d good_font = 9998
+@d font_error(#) == begin
+ string_show( font_name) ; display(' ---- ') ;
+ warn( #);
+ goto bad_font ;
+end
+
+@<Medium...@>=
+ procedure define_font (D_new:integer );
+ label bad_font , good_font ;
+ var @<|font_def| vars@>
+ begin
+ @<Read the font parameters from the \.{DVI} file,
+ calculate scaling factors@>;
+ @<Try to load the new font, unless there are problems@>;
+ good_font:
+ @<Final checks; various mild errors which often are symptoms of bugs@>
+ incr(nf) ; {the new font is officially present}
+ bad_font: if font_ok then close_binary(tfm_file);
+ end;
+
+@ First we read the parameters from the \.{DVI} file. Whatever errors are
+found, we must try to do this, or we lose place in the file.
+
+@<|font_def| vars@>=
+ scale_size, design_size, k, f : integer;
+ dir_len, {length of the area/directory spec}
+ nam_len:byte; {length of the font name proper}
+ font_mag: real_number;
+
+@ @<Read the font parameters...@>=
+ @!D_check := get_integer(dvi)(-4) ;
+ scale_size:= get_integer(dvi)( -4) ;
+ design_size:= get_integer(dvi)(-4) ;
+ dir_len:= get_integer(dvi)(1) ;
+ nam_len:= get_integer(dvi)(1) ;
+ nam_len := nam_len + dir_len ;
+ if nam_len = 0 then
+ warn('Null font name! ')
+ @.Error: Null font name@>
+ else if nam_len >= max_string then
+ font_error('Too-long font name! length = ', nam_len:1 ) ;
+ @.Error: Too-long font name@>
+ tfm_name := blank ;
+ for k:=1 to nam_len do begin
+ tfm_name.data[k] := zchr(get_byte(dvi)) ;
+ end;
+ tfm_name.len := nam_len ;
+ font_name := tfm_name ;
+
+@ Next, check that the sizes are reasonable:
+
+@<Read the font parameters...@>=
+ if (scale_size<=0)or(scale_size>=@'1000000000) then
+ font_error('Bad scale (',scale_size:1,')!')
+ @.Error: Bad scale@>
+ else if (design_size<=0)or(design_size>=@'1000000000) then
+ font_error('Bad design size (',design_size:1,')!') ;
+ @.Error: Bad design size@>
+ font_mag := scale_size/design_size ;
+ if (font_mag > 1000) or (font_mag < 0.001) then
+ font_error('Way-out font magnification!!! ', font_mag) ;
+ @.Error: Way-out font mag...@>
+ if nf=max_D_fonts then
+ abort('Capacity exceeded (max fonts=', max_D_fonts:1,')!');
+ @.Fatal: Capacity exceeded...@>
+ font_num[nf]:=D_new; f:=0;
+ while( font_num[f]<>D_new) do incr(f);
+ if f<nf then font_error('Font was already defined!');
+ @.Error: Font already defined@>
+ font_space[nf] := scale_size div 6 ; {a `thin space' }
+
+@* Loading the font file.
+
+See \.{TFTOPL} or \TeX 82 for details of the \.{TFM} file format. The
+description given in \.{TUGboat} (Vol.2, no. 1) is apparently no longer
+accurate. The only difference that I have seen is that all words of the font
+header array after the first 2 are now apparently regarded as optional.
+@.TFTOPL@> @.TeX82@> @.TUGboat@>
+
+@<Try to load...@>=
+ @<Open font file@>
+ if not font_ok then
+ font_error('TFM file can''t be opened!');
+ @.Error: TFM file cant be opened@>
+ @<Read past the header data, leave the file pointer just after the header@>
+ @<Read the character-width indices@>
+ @<Read the widths, copy them into the font array@>
+
+@ @<|font_def| vars@>=
+ @!font_ok: boolean ;
+ @!TFM_check,
+ @!lh, {length of the header data, in four-byte words}
+ @!nw:integer; {number of words in the width table}
+
+@ @<Read past the header...@>=
+ skip(tfm)(2); lh:= get_integer(tfm)(2);
+ first_ch[nf]:=get_integer(tfm)(2); last_ch[nf]:=get_integer(tfm)(2);
+ if (last_ch[nf]<first_ch[nf]) or (last_ch[nf] > max_D_char) then
+ font_error(
+ 'Illegal values for first_char and/or last_char, first_char = ',
+ first_ch[nf]:1 , ' last_char = ', last_ch[nf]:1 );
+ @.Error: Illegal value@>
+ nw:=get_integer(tfm)(2);
+ if (nw=0)or(nw>256) then
+ font_error('Illegal value for nw, nw= ', nw );
+ @.Error: Illegal value@>
+ skip(tfm)(14);
+ TFM_check := get_integer(tfm)(-4);
+ skip(tfm)(4);
+ @<Get coding scheme and re-align file, then see if the printer knows it@>
+
+@ The header contains |4*lh| bytes, of which 8 have been read so far. If it
+conforms to the \.{TUGboat} format, then the next byte (|@!ck|, say) is the
+number of bytes in the coding scheme name. So, first we must try to see if a
+scheme is present; if so, then we will read |ck+1| bytes and chuck the rest.
+If no coding scheme is present, we simply skip the rest of the header.
+Internally, scheme names are represented by |var_string|s.
+
+@<Get cod...@>=
+ tfm_scheme := blank ;
+ if lh < 2 then font_error( 'Header must have at least 2 words')
+ @.Error: Header...@>
+ else if lh = 2 then do_nothing
+ else begin
+ ck := get_byte(tfm);
+ if ( ck >= 40 ) or ( ck > 4*lh - 9) then
+ skip(tfm)(4*lh - 9)
+ {there is something here, but not a coding scheme}
+ else begin
+ tfm_scheme.len := ck ;
+ for k := 1 to ck do
+ tfm_scheme.data[ k] := zchr(get_byte(tfm)) ;
+ skip(tfm)(4*lh - ck - 9);
+ upcase(tfm_scheme) ;
+ end;
+ end;
+
+@ @<|font_def| vars@>=
+ f_n , ck : byte ;
+ try_name, tfm_scheme: var_string ; {coding scheme of current font}
+
+@ Now we can start reading the character widths.
+
+@<|font_def| vars@>=
+ @!in_width:array[byte] of integer; {\.{TFM} width data in \.{DVI} units}
+ @!wid_ptr: array[byte] of byte ; {pointers into |in_width|}
+ b3,b2,b1,b0: byte; {bytes from \.{TFM} file}
+ @!alpha,@!beta, @!z :integer;
+
+@ @<Read the character-width indices...@>=
+ for k:=first_ch[nf] to last_ch[nf] do
+ begin wid_ptr[k] := get_byte(tfm); skip(tfm)(3);
+ if wid_ptr[k] > nw then font_error('Impossible width ' , wid_ptr[k]);
+ end;
+ @.Error: Impossible width@>
+
+@ Here is the width computation. This code is copied from \.{DVItype}. See
+that program for an explanation.
+
+@<Read the font parameters...@>=
+ z := scale_size ;
+ alpha:=16*z; beta:=16;
+ while( z>=@'40000000) do
+ begin z:=z div 2; beta:=beta div 2;
+ end;
+
+@ @<Read the widths...@>=
+ for k:=0 to nw-1 do
+ begin
+ b0 := get_byte(tfm); b1 := get_byte(tfm);
+ b2 := get_byte(tfm); b3 := get_byte(tfm);
+ in_width[k]:=
+ (((((b3*z)div@'400)+(b2*z))div@'400)+(b1*z))div beta;
+ if b0 = 255 then in_width[k]:=in_width[k]-alpha
+ else if b0 <> 0 then
+ font_error('Out-of-bounds value for b0') ;
+ @.Error: Out-of-bounds |b0|@>
+ end ;
+
+@ Rounding widths. This bit of \.{DVItype} is changed, because \.{Crudetype}
+has to calculate rounded positions by a completely different method.
+
+@<Read the widths...@>=
+ if in_width[0]<>0 then font_error('First width should be zero ');
+ @.Error: First width...@>
+ for k:= first_ch[nf] to last_ch[nf] do
+ D_width[nf, k] := in_width[ wid_ptr[k]] ;
+
+@ Then there are various erroneous states that do not necessarily show that
+the font is corrupt, but may indicate bugs in the program. In principle, a
+character might have negative width, but I do not believe it.
+
+@d bad_char = -32766 {Indicates an unprintable character}
+@d foot == 50000000 {about a foot}
+
+@<Final checks...@>=
+ for k:= first_ch[nf] to last_ch[nf] do
+ if (D_width[nf, k] < 0) or (D_width[nf, k] > foot) then begin
+ warn('Way-out width = ', D_width[nf,k]:1,
+ 'DVI units, character number ', k:1 );
+ codes[ scheme[nf], k].breadth := bad_char ;
+ end;
+ if (D_check<>0)and(TFM_check<>0)and(D_check<>TFM_check) then
+ begin warn('Check sums do not agree!');
+ @.Error: Check sums...@>
+ display_ln('DVI check was: ', D_check, ' TFM check was: ', TFM_check);
+ display(' ');
+ end;
+ font_mag := (font_mag -1) * 100.0 ;
+ if not quiet then begin
+ display_ln( ' ');
+ string_show( font_name);
+ display( ' --- loaded at ',scale_size:1,' DVI units');
+ if abs(font_mag) > 1 then
+ display(' ( magnified ', round(font_mag):1,'%)');
+ display_ln(' ');
+ end;
+ @.loaded at ...@>
+ @.magnified...@>@.Error: Way-out width@>
+
+@* Coding schemes.
+
+In this section we describe the mapping from \TeX\ fonts to the printer's
+fonts. These are presumably much fewer because all characters on a crude
+printer are the same size. The mapping is defined in an array called |codes|.
+Each entry of this gives the printer's equivalent for a \TeX\ character.
+
+@<Glob...@>=
+ @!known_schemes: array[code_ptr] of var_string ;
+ @!scheme_map: array [code_ptr] of code_ptr ;
+ @!codes: array[code_ptr, D_char_ptr] of code_object;
+ no_char: code_object ;
+ scheme_top: code_ptr;
+
+@ If |c| is a |code_object|, then |c.breadth| will usually be its printed
+width in |h_steps|. |c.breadth = bad_char| indicates that the character is
+unprintable. |bad_char| can be any large negative value. Other negative values
+of |@!breadth| indicate other types of peculiar characters.
+
+@d down_loaded = -32765
+
+@<Types...@>=
+ code_object = packed record
+ breadth: i_word ;
+ case boolean of
+ true: (IM_font: byte ; IM_char: byte );
+ {Printers font and character}
+ false: (multi: i_word) ;
+ end;
+ code_ptr = 0..max_codes;
+ {0 is a coding scheme the printer doesnt know about}
+
+@ Initially, all these tables are blank.
+
+@<Set init...@>=
+ no_char.breadth := bad_char ;
+ no_char.IM_font := 0 ;
+ no_char.IM_char := 0 ;
+ scheme_top := 0 ;
+ for in_i := 0 to max_codes do begin
+ known_schemes[in_i] := blank ;
+ scheme_map[in_i] := 0 ;
+ for in_j := 0 to max_D_char do begin
+ codes[in_i, in_j] := no_char ;
+ end;
+ end;
+
+@ This procedure sets a character. The character to be set is number |@!c_num|
+in the current font. I have deleted the bit of \.{DVItype} that deals with
+oriental fonts, as I dont believe that crude printers can support them.
+
+@<Medium...@>=
+ procedure set_character(c_num: integer );
+ var cod: code_object;
+ d_i : integer; {Used for downloading}
+ begin
+ if cur_scheme = 0 then
+ else if (c_num < first_ch[D_font] ) or (c_num > last_ch[D_font] )
+ then begin
+ warn('Character ',c_num:1,' invalid in font number ',
+ font_num[ D_font]:1 );
+ @.Error: Character invalid...@>
+ end
+ else begin
+ cod := codes[ cur_scheme, c_num];
+ if cod.breadth <> bad_char then begin
+ round_IM_h( c_num) ;
+ if cod.breadth = down_loaded then
+ @<Enter a download request for |cod| and adjust its |breadth|@> ;
+ do_set_char(IM_v, IM_h, cod ) ;
+ @<Do messy things to adjust the positions |D_h|, |IM_h|, etc@>;
+ end;
+ end;
+ end;
+@#
+ procedure do_set_char ;
+ var k_i, k_k, temp_v, temp_h: i_word ;
+ m_c: code_object ;
+ k_ptr: 1..max_ligs;
+ begin
+ if cod.breadth >= 0 then begin
+ @<Check the position@>
+ @<Add the record to the page image@>
+ end
+ else if cod.breadth = bad_char then do_nothing
+ else @<Set multi-character command@> ;
+ end;
+
+@ @<Forw...@>=
+ procedure do_set_char(Set_v, Set_h: i_word; cod: code_object ); forward;
+
+@ So when a font is read in, we try to find its coding scheme by comparing
+the font with the list of |known_schemes|. If the printer is not absolutely
+crude, then it might have italic or bold fonts. Then we might want a coding
+scheme to correspond to a single \TeX\ font. But if the printer is
+|fixed_width|, then all fonts of the same face are the same size. So first we
+look at the actual font name and see if that matches any of the
+|known_schemes|. If that fails, drop the font size digits off the end of the
+name and try again. Then try again with the scheme given in the \.{TFM} file.
+If the font matches |known_schemes[ s]| then |scheme_map[ s]| will point to
+the relevant row of |codes|.
+
+@<Read the font parameters...@>=
+ try_name := tfm_name ;
+ upcase( try_name) ;
+
+@ @<Get cod...@>=
+ f_n := name_search( try_name) ;
+ if ( f_n = 0) then begin
+ k := try_name.len ;
+ while ((zord(try_name.data[k]) >= "0" ) and
+ (zord(try_name.data[k]) <= "9" )) do begin
+ try_name.data[ k] := ' ' ;
+ decr( k) ;
+ end;
+ try_name.len := k ;
+ f_n := name_search( try_name) ;
+ if ( f_n = 0) then
+ f_n := name_search( tfm_scheme) ;
+ end;
+
+@ If all these tries fail, then try if we can download the font. If that
+fails print a warning and try using the TEX TEXT scheme -- this may have
+some odd effects but it's worth a try.
+
+@<Get cod...@>=
+ if (f_n = 0) and can_dl_font then
+ @<Download a whole font@>
+ else if ( f_n = 0) then begin
+ string_show( font_name) ;
+ display_ln( ':');
+ if ( tfm_scheme.len > 0) then
+ warn( 'Unknown coding scheme, using TEX TEXT instead')
+ else
+ warn( 'No coding scheme, using TEX TEXT instead (examine NOSCHEME.ADD) ') ;
+ scheme [ nf] := scheme_map[ 3] ;
+ end
+ else scheme[ nf] := scheme_map[ f_n];
+ @.Error: Unknown coding scheme@>
+ @.Error: No coding scheme@>
+
+@ @<Lowest...@>=
+ function name_search( ss: var_string): code_ptr;
+ var i: code_ptr;
+ begin i := scheme_top;
+ while (( i > 0) and ( not equals( ss, known_schemes[ i]))) do decr( i) ;
+ if ( i=0) then name_search := 0
+ else name_search := i ;
+ end;
+
+@ This creates a scheme name. It gets used in the combination:
+|be_string( 'QUEER SCHEME' ); set_scheme (123);|
+
+@<Lowest...@>=
+ procedure set_scheme( ix: code_ptr) ;
+ begin
+ incr( scheme_top) ;
+ upcase( buffer);
+ known_schemes[ scheme_top] := buffer ;
+ scheme_map[ scheme_top] := ix ;
+ end;
+
+@* Multiple-character commands.
+
+Several crude printers (e.g. daisy-wheels) have only a limited set of
+characters, which cannot be extended. Sometimes you can generate more
+characters by overstriking. \.{Crudetype} can be programmed to do this, by
+placing suitable entries into a table called |ligatures|. The name is chosen
+by analogy with the |lig_kern| programs in \.{TFM} files, but the data is
+completely different. When one \TeX\ character maps onto several printer
+characters, we call the image a `multi-character' command.
+
+@<Const...@>=
+ max_ligs = 10000 ;
+
+@ @<Glob...@>=
+ ligatures : array[1..max_ligs] of lig_thing;
+ top_of_ligs: 0..max_ligs ; {highest used point in |ligatures|}
+
+@ @<Types...@>=
+ trio = 1..3 ;
+ lig_thing = packed record
+ case trio of
+ 1: (v_move: i_word ;
+ h_move: i_word) ;
+ 2: (symbol: code_object) ;
+ 3: (num : i_word ;
+ guard : i_word) ;
+ end;
+
+@ @<Set init...@>=
+ top_of_ligs := 0;
+ for in_i := 1 to max_ligs do ligatures[ in_i].symbol := no_char ;
+
+@ The |code_object| addresses a multiple character when its |breadth| is
+negative, and not one of the special classes defined above. It must then be
+the |false| variant, and its |multi| field (which must be |>0|) points to the
+corresponding entry in |ligatures|. Suppose that field is |c| . Then
+|ligatures[c]| is the last entry of a string of items that defines the
+replacement text of the |code|. It should be of the third variant; The |num|
+field of this entry counts the number of characters that |code| expands into.
+The |guard| field is an arbitrary impossible value called |sentry| to give a
+check on the data in |ligatures| .
+
+@d sentry = -32767
+
+@<Set multi...@>=
+ begin
+ if (cod.multi <= 0) or (cod.multi > top_of_ligs) then
+ warn('Illegal value of char in multi-character command')
+ @.Error: Illegal value@>
+ else begin
+ k_ptr := cod.multi ;
+ if (ligatures[k_ptr].guard <> sentry) then
+ warn('Sentry not found in Kerns ' ) ;
+ @.Error: Sentry ...@>
+ k_i := ligatures[k_ptr].num ;
+ k_ptr := k_ptr - 2*k_i ;
+ if (k_i <= 0) or (k_ptr < 0 ) then
+ warn('Illegal value of k_i in multi-character command');
+ @.Error: illegal value@>
+ for k_k := 1 to k_i do
+ @<Get that character and write it@>;
+ end;
+ end
+
+@ Each character of a multi-character command needs 2 entries in |ligatures|.
+The first defines the position, the second defines the character. |v_move| and
+|h_move| are relative to the current (rounded) position |Set_v, Set_h| and use
+the same units. A multi-character command can call another one recursively.
+
+@<Get that character ...@>=
+ begin
+ temp_v := Set_v + ligatures[k_ptr].v_move ;
+ temp_h := Set_h + ligatures[k_ptr].h_move ;
+ incr(k_ptr);
+ m_c := ligatures[k_ptr].symbol ;
+ do_set_char(temp_v, temp_h, m_c ) ;
+ incr(k_ptr);
+ end;
+
+@* Getting data into the |codes| array.
+
+This is clearly a very long and error-prone job, so the next procedures are put
+in to reduce this. First suppose that: in the \TeX\ coding scheme with number
+|s|, a run of |length| characters starting from |start| maps onto a run of
+consecutive characters in printer font |PR_font|, starting at |PR_first|. This
+procedure will enter the whole run at one go.
+
+@<Lowest...@>=
+ procedure alphabet
+ (start, length: byte; s: code_ptr ; PR_font, PR_first : byte );
+ var i:integer; ccc:code_object;
+ begin @<Check alphabet data@>;
+ ccc.IM_font := PR_font ;
+ ccc.breadth := char_width ;
+ for i := 0 to length-1 do begin
+ ccc.IM_char := PR_first +i;
+ codes[s, start+i] := ccc ;
+ end; end;
+
+@ @<Check alph...@>=
+ if (s < 1) then abort('Alphabet: scheme < 1 ')
+ else if (s > max_codes) then abort('Alphabet: scheme too large')
+ else if (PR_first < 0) then abort('Alphabet: negative first')
+ else if (start < 0) then abort('Alphabet: negative start')
+ else if (length < 0) then abort('Alphabet: negative length')
+ else if (start + length -1 > max_D_char) then abort('Alphabet: overflow')
+ @.Fatal: Alphabet...@>
+
+@ Clearly, |alphabet| will only cover a very small part of the problem. The
+next procedure enters data into a subset of the |codes| array corresponding to
+a single row of a \TeX\ font. In the standard font tables, row number |m| is
+the subrange |8*m..8*m+7| of a font. We hope that when the calls of |row| are
+written out in a program, the result will be (just about) legible, whereas a
+flood of statements like \begintt
+ codes[i,j].IM_font := 121; \endtt
+is certainly not legible.
+
+Because \PASCAL\ has no decent string handling, we cannot call |row|
+in any sensible way. It must be used in combination:
+| be_string( 'row-spec') ; row( scheme, row_num, first_font);|
+The |@!row_spec| is a character string that specifies what characters
+are to go into the row; the |be_string| is needed to turn the
+|row_spec| into a |var_string|. |@!scheme | is the number assigned to
+the \TeX\ coding scheme within the program. |@!row_num | is the number
+of the row in that scheme (starting from 0). |@!first_font| is the
+initial printer font. The diagnostics of |row| are known to be poor,
+but they are really intended for the installer rather than the
+end-user; so I have not tried to improve them.
+
+@<Top...@>=
+ procedure row ( scheme, row_num: integer; first_font: i_word );
+ label exit ;
+ var n :integer; codd: code_object;
+ begin
+ row_font := first_font ;
+ finger := 0 ;
+ for n := 8*row_num to 8*row_num + 7 do begin
+ row_char (0 ,codd);
+ if ( codd.breadth = bad_char) then do_nothing
+ else codes[ scheme, n ] := codd ;
+ end;
+ exit:
+ end;
+
+@ @<Glob...@>=
+ row_font: i_word; {printer font being addressed during the |row| procedure}
+
+@ The overall format of the |row_spec| is a set of 8 character specifiers
+separated by one or more spaces. The procedure |row_char| reads one character
+specifier from the |row_string|, and constructs the specified |code_object|.
+Logically, |row_char| should be a function and return that |code_object| as
+its value. \PASCAL\ does not permit this. So we assemble the result in the
+variable parameter |value|.
+
+@<Medium...@>=
+ procedure row_char(context: integer; var value: code_object);
+ label exit ;
+ const @<|Row_char| constants@>
+ var @<Row locals@>
+ begin
+ value.breadth := char_width ; {default}
+ value.IM_font := row_font ; {default font}
+ get_char ;
+ if ( context=0) and ( ch <> " " ) and ( ch <> "Z" ) then
+ string_warn('Character specifiers must start with at least one space') ;
+ while (inside and space) do get_char;
+ if not inside then string_warn ( 'Fallen off row') ;
+ @<Escape sequences in the |row_spec|@>
+ else value.IM_char := ch ;
+ exit:
+ end;
+ @.Error: Character spec...@>@.Error: Fallen off row@>
+
+@ There are several escape sequences that need to go into the |rowstring|.
+Since all the PLAIN.TEX coding schemes (except the math extension one) have
+the upper case Roman characters in their ASCII positions, these characters
+will surely be inserted into |codes| by the |alphabet| procedure. So they are
+available as flag characters. But the brackets are also used as flags, as they
+are so much more perspicuous than anything else. Here is a list of the
+characters currently used as escapes: \begintt
+
+A C D E F K L M N S Q U W Z \endtt
+
+This list should be updated if other escapes are added .
+@^Escape sequences@>@.ASCII@>
+
+@ Some characters, called `bad', have most undesirable effects when used in
+\.{WEB} strings. So the following upper-case letters stand for them. The
+actual characters may not be used, so they generate errors.
+
+@<Esc...@>=
+ if ( ch = "A") then value.IM_char := 64 {at sign}
+ else if ( ch = "S") then value.IM_char := 32 {a space}
+ else if ( ch = "Q") then value.IM_char := 39 { a single quote char}
+ else if ( ch = "W") then value.IM_char := 34 { a double quote char }
+ else if ( ch = "E") then value.IM_char := 127 { a delete char }
+ else if (ch = "'") or (ch = """") or (ch = "@@") or (ch = 127)
+ then string_warn( 'Bad character---Rejected' )
+ else if (ch = " ")
+ then string_warn('Space found out of context')
+ @.Error: Bad character@>@.Error: Space found...@>
+
+@ Then the `Z' escape is provided to generate a do-nothing code. This would
+be used if a previous call (say, of |alphabet|) had left a row partly
+incorrect. Then you might issue a call of |row| to change that row. Typing `Z'
+at the positions occupied by correct characters would leave them alone.
+
+@<Esc...@>=
+ else if ( ch = "Z") then value.breadth := bad_char
+
+@ Since many letters and brackets are used as escapes, the `L' escape is
+needed to enable them to be used Literally. `LL' generates `L'.
+
+@<Esc...@>=
+ else if ( ch = "L") then begin
+ get_char; value.IM_char := ch ; end
+
+@ In order to address printer characters in the range 0..32, where ASCII has
+no graphics, here is a Control escape. This simply reads the next character
+from the |row_spec| and reduces it modulo 32. It is best to use the lower case
+alphabet (the range 95..126) as this avoids all the `bad' characters (and
+their escapes). So control-A should be typed `Ca' , not `CA' .
+
+Then the Meta escape addresses meta-characters, i.e. those in the range
+128..255. We cannot just read a character and add 128, as we might want to
+Mutate the ASCII controls, or the `bad' characters. So `M' must read a complete
+|code_object| (respecting the escapes given above) and add 128 to its |IM_char|
+field. So we must say `MS' for `meta-space' = 160 , and `MLS' for `meta-S'
+= 211 .
+@.ASCII@>
+
+@d M_con == 250
+ {Context while reading a Meta character}
+
+@<Esc...@>=
+ else if ( ch = "C") then begin
+ get_char; value.IM_char := ch mod 32 ; end
+ else if ( context >= M_con) then value.IM_char := ch
+ {During a Meta, forbid any of the later escapes}
+ else if ( ch = "M") then
+ begin
+ row_char(M_con , value ) ;
+ value.IM_char := value.IM_char + 128 ;
+ end
+
+@ A |narrow| character is one with zero width. To generate one, precede it
+with an `N' . To mark a character as down-loadable, precede it with `D'. A
+character cannot be both narrow and down-loadable.
+
+@d N_con == 230
+ {Context while reading a Narrow or |down_loaded| character}
+
+@<Esc...@>=
+ else if ((ch = "N" ) or (ch = "D" )) and (context >= N_con) then
+ string_warn('Narrow or Down escape out of context')
+ @.Error: Narrow escape...@>
+ else if ( ch = "N") then
+ begin
+ row_char(N_con, value ) ;
+ value.breadth := 0 ;
+ end
+ else if ( ch = "D") then
+ begin
+ row_char(N_con, value ) ;
+ value.breadth := down_loaded ;
+ end
+
+@ Changing printer fonts in the middle of a |row| is done by inserting an `F'
+character, followed by an integer. This is the printer font to be used, from
+now on till the next `F' . Note that the initial font was passed as the 3rd
+parameter to |row|.
+
+@<Esc...@>=
+ else if ( ch = "F") then begin
+ row_font := s_to_i ( 0, true);
+ if ( context = 0) then row_char(1, value)
+ else row_char(context, value);
+ end
+
+@* Assembling a multi-character in |row|.
+
+Now we come to the difficult part, which is assembling a multiple-character
+command into the |ligatures| array. For this purpose, we use brackets. Curly
+brackets mean that the characters inside are to be overstruck, square brackets
+mean they are to be typed horizontally, and angle brackets mean that they are
+to be typed vertically above each other. Finally the `U' escape (which must
+come immediately after a |<| ) means to raise the (logical) cursor before
+starting the vertical list.
+
+ Warning!! I use the numerical (\.{ASCII}) values of these chars
+@^System dependencies@>@.ASCII@>
+
+@<|Row_char| const...@>=
+ o_bra = "{" ; o_ket = "}" ;
+ h_bra = "[" ; h_ket = "]" ;
+ v_bra = "<" ; v_ket = ">" ;
+ {`o' means overstrike, `h' means horizontal, and `v' vertical}
+
+@ So if we want to generate a Macsyma style summation sign, which looks like
+this: \begintt
+. ====
+. \
+. >
+. /
+. ====
+\endtt
+we have to insert the following mess into the |row_spec| string: \begintt
+ <S[====]\[SL>]/[====]>
+\endtt
+The `S' is needed to get correct vertical alignment. The `L' is needed to
+prevent the following |>| being taken as a |ket|. See the end of this file
+for examples.
+
+@ In order to keep some control over all these escape sequences, I have made a
+special rule of syntax. The escape sequences in |row_char| may only be nested
+in a definite order. That order is: (bad characters or Control or Literal)
+inside Meta inside (Narrow or Down-loadable) inside Font inside |o-list|s
+inside |h_list|s inside |v_list|s. The parameter |context| keeps track of
+this. The innermost constructions have the highest values of |context|. If
+these rules are broken the user should get an error message.
+
+@<Esc...@>=
+ else if (ch = o_bra) or (ch = h_bra) or (ch = v_bra)
+ then begin
+ if ( context >= ch) then
+ string_warn('Illegal nesting of brackets in row_spec');
+ @.Error: Illegal nesting@>
+ @<Assemble characters into |lig_buff| until we read the matching |ket|@>;
+ @<Copy |lig_buff| into |ligatures| and return a pointer to it@>;
+ end
+
+@ |hoister| and |ender| are arbitrarily selected impossible classes for a
+character, indicating respectively that a |v_list| has to be raised one
+|char_ht| or that a |ket| has been read.
+
+@d hoister = -32764
+@d ender = -32763
+
+@<Assemble char...@>=
+ for i := 1 to max_buf do lig_buff[ i].symbol := no_char ;
+ buf_len := 0; delta_h := 0; delta_v := 0;
+ bra := ch ;
+ repeat
+ row_char( bra, row_cod ) ;
+ @<Do suitable action if |row_cod| is peculiar@>
+ else begin
+ incr(buf_len);
+ lig_buff[buf_len].v_move := delta_v ;
+ lig_buff[buf_len].h_move := delta_h ;
+ incr(buf_len);
+ lig_buff[buf_len].symbol := row_cod ;
+ if ( bra = v_bra) then delta_v := delta_v + char_ht;
+ if ( ( bra = h_bra) or ( batch_view and ( bra = o_bra)))
+ then delta_h := delta_h + char_width ;
+ end;
+ until ( row_cod.breadth = ender) or not inside;
+
+@ @<Row loc...@>=
+ lig_buff: array[1..max_buf] of lig_thing ;
+ buf_num: 0..max_buf ;
+ {Number of characters (or multi-characters) in current list}
+ buf_len: 0..max_buf ;
+ {Number of used locations in |lig_buff|: should be |2*buf_num|}
+ delta_h, delta_v: i_word;
+ ch, bra: byte;
+ i: integer;
+ row_cod: code_object ;
+
+@ @<Const...@>=
+ max_buf = 201;
+
+@ @<Do suitable action...@>=
+ if ( row_cod.breadth = hoister) then delta_v := delta_v - char_ht
+ else if ( row_cod.breadth = ender) then
+ else if ( buf_len + 3 > max_buf) then
+ abort('Overflowed lig_buff array')
+ @.Fatal: Overflowed |lig_buff|@>
+
+@ @<Esc...@>=
+ else if (ch = "U" ) and (context = v_bra) then value.breadth := hoister
+ else if (ch = "U" ) then
+ string_warn('U escape out of context')
+ @.Error: U escape...@>
+ else if ((ch = o_ket) or (ch = h_ket) or (ch = v_ket)) and (context = ch-2)
+ then value.breadth := ender
+ else if (ch = o_ket) or (ch = h_ket) or (ch = v_ket)
+ then string_warn('Mismatching brackets ')
+ @.Error: Mismatching brackets@>
+
+@ Yet another escape is the |kern| escape. If the printer has reasonable
+positioning resolution, we may want to move the parts of a multi-character
+about to make them fit together better. So a |kern| takes an integer parameter
+and moves the next component of the current list by that many |steps| against
+the current direction. The reason for going back is that one can easily move
+forwards by setting a blank space.
+
+@d h_kern = -32762
+@d v_kern = -32761
+
+@<Esc...@>=
+ else if (ch = "K") and (context = h_bra) then value.breadth := h_kern
+ else if (ch = "K") and (context = v_bra) then value.breadth := v_kern
+ else if (ch = "K")
+ then string_warn('Kern escape out of context' )
+ @.Error: Kern escape@>
+
+@ @<Do suitable action...@>=
+ else if ( row_cod.breadth = h_kern)
+ then delta_h := delta_h - s_to_i ( 0, true)
+ else if ( row_cod.breadth = v_kern)
+ then delta_v := delta_v - s_to_i ( 0, true)
+
+@ @<Copy...@>=
+ buf_num := 0 ;
+ if ( buf_len = 0) then value.breadth := bad_char
+ else if ( top_of_ligs + buf_len + 1 >= max_ligs) then
+ abort ('Ligature array overflowed, must recompile with larger array')
+ @.Fatal: Ligature array overflowed@>
+ else begin
+ for i := 1 to buf_len do
+ ligatures[ top_of_ligs + i ] := lig_buff[i] ;
+ top_of_ligs := top_of_ligs + buf_len + 1 ;
+ buf_num := buf_len div 2 ;
+ ligatures[top_of_ligs].num:= buf_num ;
+ ligatures[top_of_ligs].guard := sentry ;
+ value.multi := top_of_ligs ;
+ value.breadth := -20000 ;
+ {Provisional: a nonsense value to make sure the correct value does get
+ inserted later}
+ end;
+
+@* Character strings.
+
+In this section I have tried to provide some tolerable string-handling
+facilities in despite of the restrictions of \PASCAL. This does not seem to
+belong in any particular place in the program, but in view of the horrible
+gruesome things that will happen in the next section, it seemed a good idea to
+give some light relief. That is why this section is inserted here.
+
+The |var_string| type is principally used for file names and to send command
+sequences to the printer. Logically, these procedures should all be functions
+and return the results, but stupid \PASCAL\ does not allow this. It would of
+course be much cleaner to use the VMS |varying| type, but that would make the
+program non-portable.
+
+@<Const...@>= max_string = 100 ; {a guess, of course}
+
+@ @<Types...@>=
+ s_ptr = 0..max_string ;
+ fix_string = packed array[ 1..max_string ] of char ;
+ var_string= packed record
+ len: byte;
+ data: fix_string ;
+ end ;
+
+@ |@!blank| is used for initialising strings. It should not be altered
+anywhere but here. |buffer| is used for terminal input, etc.
+
+@<Set |blank|@>=
+ blank.len := 0 ;
+ for in_i := 1 to max_string do
+ blank.data[in_i] := pad_char ;
+
+@ @<Glob...@>=
+ ch: byte ;
+ hack: fix_string ;
+ buffer, blank: var_string ;
+ thumb, finger: s_ptr ;
+
+@ This procedure converts an explicit quoted string into a |var_string|.
+
+@<Lowest...@>=
+ procedure set_string ;
+ var i, j: byte ;
+ begin
+ result := blank ;
+ set_j_to_length ;
+ if padded then begin
+ while (( j > first ) and ( ss[j] = pad_char)) do decr(j) ;
+ if ( j = first ) and ( ss[j] = pad_char) then decr(j) ;
+ end;
+ j := j - first + 1 ;
+ if ( j >max_string) then
+ warn( 'String too long')
+ else begin
+ result.len := j ;
+ for i := 1 to j do
+ result.data[i] := ss[ first + i - 1 ] ;
+ end;
+ end;
+ @.Error: String too long@>
+
+@ @<Forw...@>=
+ procedure substring( var result: var_string;
+ ss:var_string; start, length: integer); forward;
+ procedure append( var head: var_string; tail: var_string); forward;
+ procedure add_char(var s: var_string; c: char) ; forward;
+ function equals( s, t: var_string): boolean; forward ;
+ procedure splice (
+ var out: var_string; source: var_string; nn: integer); forward ;
+ procedure print_string( var f: text; ss: var_string; control: char); forward;
+ procedure int_string(
+ var result: var_string; n: integer; cc: char ) ; forward ;
+ procedure int_base(
+ var result: var_string; nn: integer; s: byte) ; forward ;
+ function s_search( s: var_string;
+ target: char; go: integer): s_ptr; forward;
+ procedure upcase( var ss: var_string); forward;
+ function s_to_i( default: integer; insist: boolean): integer; forward ;
+ procedure get_name( var val: var_string); forward;
+
+@ @<Low...@>=
+ procedure substring ;
+ var i : s_ptr ;
+ begin
+ result := blank ;
+ if ((start <= 0) or ( length < 0) or ( start + length > ss.len+1 )) then
+ warn( 'Impossible substring')
+ else begin
+ result.len := length ;
+ for i := 1 to length do
+ result.data[ i] := ss.data[ i - 1 + start] ;
+ end;
+ end;
+ @.Error: Impossible substring@>
+@#
+ procedure append ;
+ var k: integer;
+ begin
+ if (head.len + tail.len > max_string )
+ then warn('string too long')
+ else begin
+ for k := 1 to tail.len do
+ head.data[ k + head.len] := tail.data[ k] ;
+ head.len := head.len + tail.len ;
+ end;
+ end;
+ @.Error: string too long@>
+
+@#
+ procedure add_char ;
+ begin
+ if s.len >= max_string then warn('string too long')
+ else begin
+ incr(s.len) ;
+ s.data[s.len] := c ;
+ end;
+ end;
+ @.Error: String too long@>
+
+@#
+ function equals ;
+ begin if ( s.len <> t.len ) then equals := false
+ else equals := ( s.data = t.data) ;
+ end;
+
+@ Printer commands usually have the format (prefix)(parameter)(suffix). In
+order to generate these in a clean fashion, the next procedure |splice| puts
+the value into the marked position in the |source| string. The position is
+marked by the |@!amp_and| character, and the next character |cc| indicates what
+type of number is to be inserted. If there is no |amp_and|, the number is
+ignored.
+
+@<Lowest...@>=
+ procedure print_command(
+ pattern: var_string; val: integer; control: char) ;
+ var ss: var_string;
+ begin
+ splice( ss, pattern, val);
+ print_string( printfile, ss, control) ;
+ end;
+
+@ Also, printer commands usually contain unprintable characters. In my
+experience, these are always ASCII controls, i.e. in the range |0..31|. So
+|print_string| has a |control| escape character passed to it. Normally this is
+|@!ctrl_mark|, which is |'^'|. This replaces the next character by its control
+character, (i.e. reduced modulo 32) except: if |control| is a space, nothing is
+changed; and 2 consecutive |control|s get replaced by one.
+
+@<Lowest...@>=
+ procedure print_string ;
+ var i: s_ptr ; is_con: boolean ; cc: char ;
+ begin
+ is_con := false ;
+ for i := 1 to ss.len do
+ begin
+ cc := ss.data[ i] ;
+ if is_con then begin
+ if ( cc <> control) then
+ cc := zchr( zord( cc) mod 32) ;
+ is_con := false ;
+ write( f, cc) ;
+ end
+ else if (( cc = control) and ( control <> ' ' )) then
+ is_con := true
+ else write( f, cc) ;
+ end;
+ end;
+
+@ This procedure inserts a parameter.
+
+@<Lowest...@>=
+ procedure splice ;
+ var i: integer; cc: char ;
+ tail: var_string;
+ begin
+ i := s_search( source, amp_and, 1);
+ if ( i=0) then out := source
+ else begin
+ substring( out, source, 1, i-1);
+ substring( tail, source, i+2, source.len - i - 1 );
+ cc := source.data[ i+1] ;
+ int_string( out, nn, cc);
+ append( out, tail);
+ end;
+ end;
+
+@ |cc| (as above) is one character, and may have the values
+`B'(yte), `D'(ecimal), `H'(exadecimal), `O'(ctal), or `W' (a 16-bit signed
+word, in twos-complement notation).
+
+@<Lowest...@>=
+ procedure int_string ;
+ var nn: integer ;
+ begin if (cc = 'O') then int_base( result, n, 8)
+ else if (cc = 'H') then int_base( result, n, 16)
+ else if (cc = 'D') then int_base( result, n, 10 )
+ else if (cc = 'B') and (n >= 0) and (n <= 255)
+ then add_char( result, zchr(n))
+ else if (cc = 'B') then warn('Out-of-range byte')
+ else if (cc='W') then begin
+ if (n>= 0) and (n <= 32767) then begin
+ add_char( result, zchr(n div 256));
+ add_char( result, zchr(n mod 256));
+ end
+ else if (n<0 ) and (n> -32768) then begin
+ nn := n + 65536 ;
+ add_char( result, zchr(nn div 256));
+ add_char( result, zchr(nn mod 256));
+ end
+ else warn('Out-of-range word') ;
+ end
+ @<Hook for weird parameter types@>
+ else warn('Int_string called with illegal type') ;
+ end;
+ @.Error: Out-of-range...@> @.Error: Int_string called...@>
+
+@#
+ procedure int_base ;
+ var nh : integer ;
+ begin
+ nh := nn ;
+ if nh < 0 then begin add_char( result, '-'); nh := - nh ; end ;
+ if nh >= s then begin
+ int_base( result, nh div s, s) ;
+ nh := nh mod s ;
+ end ;
+ if nh >= 10 then add_char( result, zchr(nh - 10 + "A" ))
+ else add_char( result, zchr(nh + "0" )) ;
+ end;
+
+@ @<Hook for weird ...@>=
+
+@ The next macros and routines are for parsing strings. In these, the string
+being parsed is called |buffer|. |finger| points to the next character that
+is due to be read, and |ch| is the ordinal of this character. When an error
+is found, |thumb| should point to the first wrong character.
+
+@d get_char == begin incr( finger); ch := zord( buffer.data[finger]) ; end
+@d inside == ( finger <= buffer.len)
+@d digit == (( ch >= "0") and (ch <= "9" ))
+@d lo == (( ch >= "a") and (ch <= "z" ))
+@d cap == (( ch >= "A") and (ch <= "Z" ))
+@d equal_sign == ( ch = "=")
+@d is_prefix == ( ch = prefix )
+@d space == ( ch = " " )
+@d letter == lo or cap
+@d up(#) == # + "A" - "a"
+@d small(#) == # - "A" + "a"
+
+@d string_warn(#) == begin
+ warn(#);
+ string_show( buffer) ;
+ display_ln(' ');
+ display_ln('^' : thumb) ;
+ return;
+end
+
+@<Lowest...@>=
+ procedure upcase ;
+ var i: s_ptr; ch: byte;
+ begin
+ for i := 1 to ss.len do begin
+ ch:= zord( ss.data[i]) ;
+ if lo then
+ ss.data[i] := zchr( up( ch )) ;
+ end;
+ end;
+
+@ This function tries to read an integer from the |buffer|, starting at
+position |finger+1|. The integer may be signed and may be preceded by spaces.
+If there is no integer, return the |default|; error if |insist| is true.
+
+V3: A rather crude addition. In Unix the |prefix| is `{\tt -}', and the
+{\tt /i} key wants an optional integer arg. So the system will tend to confuse
+a prefix `{\tt -}' with a negative arg. So in suitable cases |s_to_i| will
+backspace.
+
+@d prev_char == if (finger > 1) then
+ begin decr( finger); ch := zord( buffer.data[finger]) ; end
+
+@<Low...@>=
+ function s_to_i ;
+ label exit ;
+ var value, sig : integer;
+ begin
+ value := default ;
+ sig := 1;
+ while (inside and space) do get_char;
+ if ( ch = "+" ) then get_char
+ else if ( ch = "-" ) then begin
+ sig := -1; get_char; end;
+ thumb := finger ;
+ if inside and digit then begin
+ value := 0 ;
+ while (inside and digit) do begin
+ value := value * 10 + ( zord( ch) - "0") ; get_char; end;
+ value := value * sig ;
+ end
+ else if insist then string_warn( 'Integer expected ')
+ else if ((sig = -1) and (prefix = "-")) then prev_char ;
+ exit: s_to_i := value;
+ end;
+ @.Error: Integer expected@>
+
+@ When parsing a command string, this procedure tries to read a filename
+starting from |finger|. Various things might go wrong: |finger| might be
+pointing at nothing; a qualifier; an integer argument; or a valid name
+mis-spelled. I dont see any plausible way to distinguish these; so I continue
+regardless.
+
+@<Low...@>=
+ procedure get_name ;
+ begin
+ while (inside and (space or equal_sign)) do get_char;
+ thumb := finger ;
+ while (inside and not (space or is_prefix)) do get_char;
+ substring( val, buffer, thumb, finger - thumb ) ;
+ end;
+
+@ This function searches for character |target| in a string, starting from
+position |go|. Return 0 if not found. If |go < 0| search backwards from |-go|.
+Error if |go = 0| or if |go| is out-of-bounds.
+
+@<Lowest...@>=
+ function s_search ;
+ label exit ;
+ var nn, gg: integer;
+ begin
+ gg := abs( go);
+ nn := 0 ;
+ if (gg > s.len ) or (go =0 ) then warn ( 'Impossible search')
+ else begin
+ if ( go > 0 ) then begin
+ for nn := gg to s.len do if ( s.data[ nn] = target) then return ; end
+ else begin
+ for nn := gg downto 1 do if ( s.data[ nn] = target) then return ; end ;
+ nn := 0 ;
+ end;
+ exit: s_search := nn ;
+ end;
+ @.Error: Impossible search@>
+
+@ This is the Standard part of the procedure that parses a command line. When
+a |key| requires a value, some people will probably be used to typing {\tt
+key = value} or perhaps {\tt key <space> value} so |parse_command| must allow
+these constructions.
+
+@<Med...@>=
+ procedure parse_command;
+ label exit ;
+ var key: byte;
+ begin
+ buffer := command ; finger := 0 ; get_char;
+ while inside do begin
+ while (inside and space) do get_char ;
+ if inside and ( ch = prefix) then begin
+ get_char ; thumb := finger ;
+ if lo then ch := up( ch) ; key := ch ; get_char ;
+ while (inside and ( space or equal_sign)) do get_char ;
+ @<If the |key| is valid, do the corresponding command@>
+ else string_warn( 'Unknown command ') ;
+ end
+ else if inside then begin
+ if ( dvi_name.len > 0) then begin
+ warn( 'Two filenames. Previous name will be ignored, it was:' ) ;
+ string_show( dvi_name) ;
+ display_ln(' ') ;
+ end;
+ get_name( dvi_name) ;
+ end;
+ exit: end;
+ end;
+ @.Error: Unknown command@>
+ @.Error: Two filenames...@>
+
+@* Translating the device-independent file, 5: Movements.
+
+This section considers the problem of deciding where each character has to be
+printed on the printer's page. This is by far and away the most difficult (and
+unsatisfactory) part of \.{Crudetype}. The current version is not a properly
+designed algorithm; it is merely a bodge, obtained by a lot of trial and
+error. It does seem to give tolerable results on \.{WEB} files, lineprinter,
+and VMS. The main variables are: |@!D_h| is `\TeX's cursor'. It gives the
+`exact' horizontal position (in \.{DVI} units) generated by \.{DVI} commands.
+This is always updated exactly as in \.{DVItype}. |@!IM_h| is the `page
+image's cursor'. It marks the position (in |h_steps|) where the next character
+will be set.
+
+The procedure |round_IM_h| is called immediately before we set a character or
+a rule. We have to take account of all the movements that occurred since the
+last previous character was set.
+
+@<Forw...@>= procedure round_IM_h( code: byte); forward ;
+
+@ @<Lowest...@>=
+ procedure round_IM_h ;
+ var
+ s_top, diff, n, m,
+ delta, new_IM_h, rounded_h : integer ;
+ begin
+ @<Find the new position |new_IM_h|@>
+ IM_h := new_IM_h ;
+ end;
+
+@ The obvious method is to multiply |D_h| by a factor |h_conv| and round to
+nearest integer. This gives extremely bad results, because the characters in
+\TeX\ fonts vary enormously in width, while many crude printers have
+|fixed_width| characters. If |h_conv| is too large, then you get spaces in the
+middle of words. If |h_conv| is too small, then successive characters in a
+word get printed on top of each other. With an intermediate value of |h_conv|,
+you get both effects at once; in other words, the characters in \TeX\ fonts
+vary so much in width that the `too large' and `too small' values of |h_conv|
+overlap. In this situation, a great deal of jiggery-pokery is needed to get a
+tolerable result (sometimes! I have not been able to make this code work in
+general.)
+ For a start, here is the algorithm used in \.{DVItype}. |D_h_right| and
+|IM_h_right| give the latest value of |D_h| and |IM_h| after the latest
+previous character or rule was set. If the horizontal motion is small, like a
+kern, |IM_h| changes by rounding the kern; but when the motion is large,
+|IM_h| changes by rounding the true position |D_h| so that accumulated
+rounding errors disappear. Also, we insist that the total amount of drift is
+bounded.
+
+@d h_step_round(#) == round(h_conv*( # ))
+@d max_drift == 2
+
+@<Find the new position |new_IM_h|@>=
+ rounded_h := h_step_round(D_h + D_l_margin) ;
+ delta := D_h - D_h_right ;
+ if (delta > thin_space) or (delta <= -4*thin_space) then
+ new_IM_h := rounded_h
+ else new_IM_h := IM_h_right + h_step_round(delta);
+ if not fixed_width then begin
+ if (new_IM_h > rounded_h + max_drift)
+ then new_IM_h := rounded_h + max_drift
+ else if (new_IM_h < rounded_h - max_drift)
+ then new_IM_h := rounded_h - max_drift ;
+ end else
+
+@ Calculating |IM_h| on a |fixed_width| printer is very hairy. If we are not
+careful, then the spaces between words will sometimes get rounded to 0. Since
+we round `large' movements by rounding |D_h|, the space may even get rounded to
+a negative value, if there was previously a lot of drift. So we must re-round
+|new_IM_h|. The next idea is that whenever \TeX\ moves right by an amount that
+seems large enough to be a space between words, we force |IM_h| to increase.
+
+@<Find the new position |new_IM_h|@>=
+ if (delta > thin_space) and (new_IM_h < IM_h_right + gap_width)
+ @<Except in some special cases@>
+ then new_IM_h := IM_h_right + gap_width
+ else if (delta > - 2*thin_space) then begin
+ if (new_IM_h < IM_h_right)
+ then new_IM_h := IM_h_right; end
+ else
+
+@ Here are two little fudges which improve the result. First, when \TeX\ puts
+out a thin space, it sometimes is a bit too small to be recognised as such. So
+we reduce the |font_space| when a font is defined.
+
+@<Read the font parameters...@>=
+ font_space[nf] := round(font_space[nf] * 0.99 ) ;
+
+@ The next fudge is needed to handle tables of contents. \TeX\ prints these by
+putting out long streams of dots with small spaces in between. If these spaces
+all get expanded to a whole character width, the right hand columns get thrown
+right off the paper. So dont expand if the next character is a stop or comma.
+
+@<Except in some special cases@>=
+ and not ( ( ( code = ".") or ( code = ",") ) and
+ ( ( cur_scheme > 0) and ( cur_scheme <= max_plain )))
+
+@ When these alternatives fail, we have lost contact between |D_h| and
+|D_h_right|. This happens when \TeX\ makes a large backspace; in fact \TeX\
+seems nearly always to do large backspaces by |pop| rather than an explicit
+move left. \TeX\ often expresses boxes by a sequence like this:
+
+\centerline{\tt{
+PUS\markarrow{H} Move right ------------>
+\markarrow{[}set characters] \markarrow{P}OP }}
+
+followed by zero or more |push|es, then by a move either to one of the
+positions marked by the arrows, or close by. I try to deal with this by
+dropping markers at each of the arrowed positions. The markers are labelled
+|D_h_right|, etc, and each marker has a corresponding value of |IM_h|
+attached.
+
+@<Glob...@>=
+ D_h_left, IM_h_left, D_h_mid, IM_h_mid, D_h_right, IM_h_right, {the markers}
+ IM_h, IM_v, D_dis, IM_dis, H_shunt: integer;
+ IM_h_stack, IM_v_stack:
+ array [0..max_stack+2] of integer; {pushed down values }
+
+@ Suppose that we are about to set a character, and |D_h-D_h_right| is large
+and negative. Then we compare the current value of |D_h| with all the markers.
+Let |m| be the closest of these, and |mm| the corresponding rounded value.
+Then we re-round |new_IM_h| to force it to lie on the `correct' side of |mm|.
+This seems to work fairly often, but it does sometimes slip. First put the
+markers on top of the stack...
+
+@<Find the new position |new_IM_h|@>=
+ begin s_top := stack_ht ;
+ D_h_stack[s_top] := D_h_left;
+ IM_h_stack[s_top] := IM_h_left;
+ incr(s_top) ;
+ D_h_stack[s_top] := D_h_mid;
+ IM_h_stack[s_top] := IM_h_mid;
+ incr(s_top) ;
+ D_h_stack[s_top] := D_h_right;
+ IM_h_stack[s_top] := IM_h_right;
+
+@ ...then look for the stacked value closest to |D_h|...
+
+@<Find the new position |new_IM_h|@>=
+ m := s_top ;
+ for n := s_top downto 1 do begin
+ diff := D_h - D_h_stack[n] ;
+ if abs(diff) <= abs(delta) then
+ begin m := n ; delta := diff; end ;
+ end;
+
+@ ...then adjust |new_IM_h| by reference to this point on the stack.
+
+@<Find the new position |new_IM_h|@>=
+ if (delta > thin_space ) and ( new_IM_h < IM_h_stack[m] + gap_width) then
+ new_IM_h := IM_h_stack[m] + gap_width
+ else if (delta < -thin_space )
+ and ( new_IM_h > IM_h_stack[m] - gap_width)
+ then new_IM_h := IM_h_stack[m] - gap_width
+ else if abs(delta) <= thin_space then new_IM_h := IM_h_stack[m];
+end;
+
+@ We must assign values to these markers. When we start a page, all the
+markers that were left over from the previous page are irrelevant. So we reset
+them. This is a good place to consider margins. The standard arrangement given
+in the \TeX book (Chapter 23) is that \.{DVI} point $(0,0)$ is about an inch
+in from the top and left edges of the paper. But a negative {\tt \BS hoffset}
+allows \.{DVI} to address points with negative coordinates, which should still
+be on the paper. It seems that the least messy way to implement this is by
+adding |l_margin| to |IM_h|, whenever this is set to an absolute value.
+
+Least messy, but wrong. It seems that first: we must alter not the scaled units
+but the \.{DVI} units before scaling. Also to overcome the confusion of a
+negative {\tt \BS hoffset} we must start each page by pushing a position
+corresponding to the edge of the paper. |@!l_margin| is the assumed margin in
+inches. |@!D_l_margin| is the equivalent in \.{DVI} units.
+@^\TeX book@>@^Margins@>
+
+@<Set up an empty page...@>=
+ D_h := - D_l_margin ; D_v := - D_top_margin ;
+ IM_h := 0 ; IM_v := 0 ;
+ D_h_left := - D_l_margin ; IM_h_left := 0 ;
+ D_h_mid := - D_l_margin; IM_h_mid := 0 ;
+ D_h_right := - D_l_margin ; IM_h_right := 0 ;
+ push ;
+ D_h := 0 ; D_v := 0 ;
+ H_shunt := 100000000 ; {any absurd value}
+
+@ Unfortunately the various fudge factors we have introduced expand this
+inch of margin to about 3 inches; this will probably push some printed
+characters off the right hand edge of the paper. So we must shift all
+printed chars left by an amount |@!H_shunt|, defined as $-3 +$ the least value
+of |IM_h| for any character set on the page.
+
+@<Add the record...@>=
+ if H_shunt > (Set_h - 3)
+ then H_shunt := (Set_h - 3) ;
+
+@ So now we consider the three arrows in turn. The left hand arrow will be
+marked by |@!D_h_left|. It records the latest horizontal position to be
+|push|ed. There might have been a |pop| since then, so it is not necessarily
+the value at the top of the stack. If we just record |IM_h| whenever we
+|push|, that would give a wrong value whenever there was a sequence
+|push..move_right..push|. So we must rectify the pushed value of |IM_h|.
+
+@<Some adjustments...@>=
+ IM_h_stack[stack_ht]:=IM_h;
+ IM_v_stack[stack_ht]:=IM_v;
+ if just_pushed and (stack_ht > 0) then begin
+ x := h_conv*(D_h_stack[stack_ht] - D_h_stack[stack_ht - 1] );
+ if abs(x) > 1.5 {a guess!} then
+ IM_h_stack[stack_ht] := IM_h_stack[stack_ht] + round(x) ;
+ end;
+ D_h_left := D_h ;
+ IM_h_left := IM_h_stack[stack_ht] ;
+
+@ The centre arrow will be marked by |@!D_h_mid|. This is defined as the value
+of |D_h| just before setting the first character after the latest |push|.
+
+@<Find the new position |new_IM_h|@>=
+ if just_pushed then begin
+ D_h_mid := D_h ;
+ IM_h_mid := new_IM_h;
+ just_pushed := false;
+ end;
+
+@ The right hand arrow is marked by |@!D_h_right|. At any time, this is
+defined as the right hand edge of the latest previous character (or rule) that
+has just been set. This equals |D_h + D_dis|, where |D_dis| is the \TeX\ width
+of the character. Usually there will follow a |move_right| that updates |D_h|,
+but |D_h_right| must be updated even if there is no |move_right|. Now
+|@!IM_h_right| must be aligned with the right hand edge of the printed
+representation of the character. The idea is that this will usually be the
+exact place where the next character has to be set. We hope that all the
+characters in each word will be correctly placed next to one another and the
+accumulated drift will appear in spaces between the words. So whenever a
+character is set, we must assign values to |D_dis| and |IM_dis|. The character
+is described by |cod|, and its printed width is written into its |breadth|
+field; but if it is a multiple character, then the |breadth| is the negative
+of the width.
+
+@<Do messy things...@>=
+ D_dis := D_width[D_font, c_num] ;
+ if cod.breadth = bad_char then IM_dis := 0
+ else IM_dis := abs(cod.breadth) ;
+ @<Set |rail_base|@>
+ D_h_right := D_h + D_dis ;
+ IM_h_right := IM_h + IM_dis ;
+
+@ So the procedure |row| must give the |breadth| field the right value when
+assembling a |multi| character. Recall that that character can be either an
+|o_list| or an |h_list| or a |v_list|, and |bra| tells us which it is. An
+|o_list| is assumed to have a width of one |char_width| and the width of a
+|v_list| is the width of its widest component. The width of a |h_list| gets
+accumulated in |delta_h| as the list is assembled.
+
+@<Copy |lig_buff|...@>=
+ if ( bra = o_bra) then print_width := char_width
+ else if ( bra = h_bra) then print_width := delta_h
+ else begin
+ print_width := char_width ;
+ for i := 1 to buf_num do
+ with lig_buff[2*i].symbol do
+ if (print_width < -breadth ) and (breadth > -30000 )
+ then print_width := -breadth ;
+ end;
+ value.breadth := - print_width ;
+
+@ @<Row locals...@>=
+ print_width: integer ;
+
+@ We must do the same thing when setting a rule.
+
+@<|Post| set...@>=
+ D_dis := D_rul_width ;
+ IM_dis := hn * post_width ;
+ D_h_right := D_h + D_dis ;
+ IM_h_right := IM_h + IM_dis ;
+
+@ @<|Rail| set...@>=
+ D_dis := D_rul_width ;
+ IM_dis := hn * rail_width ;
+ D_h_right := D_h + D_dis ;
+ IM_h_right := IM_h + IM_dis ;
+
+@ \.{DVItype} handles vertical motion in the same sort of way as horizontal.
+
+@d v_step_round(#) == round(v_conv*( # ))
+
+@<Medium...@>=
+ procedure move_down(ddd: integer);
+ var new_IM_v , delta : integer;
+ begin
+ D_v:=D_v+ddd;
+ delta := v_step_round(ddd) ;
+ @<Find a vertical position |new_IM_v|@>
+ end;
+
+@ @<Find a vert...@>=
+ if delta >= big_drop then begin
+ new_IM_v := v_step_round(D_v + D_top_margin) ;
+ if (new_IM_v < IM_v + big_drop) then
+ IM_v := IM_v + big_drop
+ else IM_v := new_IM_v ;
+ rail_base := IM_v * rail_types ;
+ end
+ else if (delta <= -big_drop) then begin
+ new_IM_v := v_step_round(D_v + D_top_margin) ;
+ if (new_IM_v > IM_v - big_drop) then
+ IM_v := IM_v - big_drop
+ else IM_v := new_IM_v ;
+ rail_base := IM_v * rail_types ;
+ end else
+
+@ The above calculation fails for small motions. Because \TeX\ expects
+subscripts to be about half the size of the main line, it drops them by only a
+small amount; with a crude printer, this small amount gets rounded to zero. If
+the move is smaller than |@!tiny_drop| \.{DVI} units, we ignore it. If not,
+then we force the new value of |IM_v| to be different from the old.
+
+@<Find a vert...@>=
+ begin
+ IM_v := IM_v + delta ;
+ rail_base := rail_base + v_step_round(ddd * rail_types) ;
+ if (ddd > tiny_drop) and ( delta = 0) then IM_v := IM_v + 1
+ else if (ddd < -tiny_drop) and ( delta = 0) then IM_v := IM_v - 1
+ else rail_base := IM_v * rail_types ;
+ end;
+
+@ The next bit is put in to help catch bugs. Sometimes the \.{DVI} file really
+does try to address an absurd position; for example, I contrived to make \TeX\
+generate a {\tt \BS hbox} that was 9000 points wide. More often, nonsense
+positions are created by bugs. If we do nothing about this, \.{Crudetype} will
+probably crash with an arithmetic error, which is unacceptable. So any
+character falling outside the limits |h_min..h_max| and |v_min..v_max| will
+generate an error report.
+
+@<Check the position@>=
+ if (Set_h < h_min)
+ then begin
+ warn('Out of bounds --left') ;
+ Set_h := 0 ;
+ {Chuck the character somewhere, hopefully out of the way}
+ end else if ( Set_h > h_max )
+ then begin
+ warn('Out of bounds --right') ;
+ Set_h := h_max ;
+ {Chuck the character somewhere, hopefully out of the way}
+ end ;
+ if (Set_v < v_min) or ( Set_v > v_max )
+ then begin
+ warn('Out of bounds -- vertical ') ;
+ Set_v := v_max ;
+ end;
+ @.Error: Out of bounds@>
+
+@ @<Set init...@>=
+ h_max := h_resolution * 100 ;
+ v_max := v_resolution * 100 ;
+ h_min := 0 ;
+ v_min := 0 ;
+
+@ Note that since the position fields of a |page_record| are subranges,
+|h_max| etc. must be of the same type.
+
+@<Glob...@>= h_max, v_max , h_min, v_min : i_word ;
+
+@* Sorting the page.
+
+Once we have assembled the complete page image, we must sort it. The method
+used here is a merge sort based on the country dance called Grand March.
+
+@<Sort the page@>=
+ @<The dancers form a long line up the middle of the hall and march
+ up towards the Presence@>
+ repeat
+ @<At the top they split, and alternate groups go to the left and right and
+ march down the sides@>
+ @<At the bottom of the hall, each group coming from the right hand side
+ merges with a group from the left side, and they go up again@>
+ until sorted;
+
+@ Since the data being sorted is of unpredictable size and sequentially
+processed, it logically ought to be a |file|. But this turned out to make the
+program spectacularly slow. So I use linked lists instead--- a sacrifice of
+logic to economy. But I continue to use file-like language.
+
+@d send_one_set_to( #)==
+ copy_from( mid ) ( # )
+
+@<At the top...@>=
+ L_reset( mid) ;
+ L_rewrite( left) ;
+ L_rewrite( right) ;
+ repeat
+ send_one_set_to( left) ;
+ if not L_eof( mid) then
+ send_one_set_to( right) ;
+ until L_eof( mid);
+
+@ Eventually everybody comes together in one enormous set and the dance is
+finished. The easiest way to detect this is to let it go round one more time.
+Then the left side of the hall will be full and the right hand side empty.
+
+ @<At the bottom...@>=
+ L_rewrite( mid) ;
+ L_reset( left) ;
+ L_reset( right) ;
+ sorted := L_eof( right) ;
+ if sorted then
+ cur_pge_ptr := son( next( left))
+ else repeat
+ if L_eof( right) then copy_from( left) ( mid)
+ else if L_eof( left) then copy_from( right) ( mid)
+ else @<Merge one group from each side@>
+ until L_eof( left) and L_eof( right) ;
+
+@ The natural way to assemble the page image is to throw everything into one
+huge list, then start sorting. But the code for merging two simple lists was
+horribly complicated. (The code given here merely merges two runs.) So the
+page image is a list of lists (another sacrifice of logic to economy). Each
+top-level entry has a |son|, which points to a sub-list. This is a sorted
+subset (a ``run'') of the data. One advantage of the list-of-lists structure
+is that we can take advantage of the fact that \TeX\ output is very ``runny''.
+I found that this made \.{Crudetype} run at least 3 times faster than before.
+
+@d Add_run == new_tail( mid_ptr) ; son( mid_ptr) := run_ptr ;
+
+@<Merge one group...@>=
+ begin
+ L_rewrite( run) ;
+ L_run_ptr := son( left_ptr) ;
+ R_run_ptr := son( right_ptr) ;
+ repeat
+ if @<The person on the left is more eligible@>
+ then copy_from( L_run) ( run)
+ else copy_from( R_run) ( run) ;
+ until L_eof( R_run) and L_eof( L_run) ;
+ step_wipe( left_ptr) ;
+ step_wipe( right_ptr) ;
+ L_reset( run) ;
+ Add_run ;
+ end;
+
+@ So while the page image is being assembled, it must be divided into runs.
+
+@<Add the record...@>=
+ begin
+ if out_of_sequence then begin {create a new run}
+ L_reset( run) ;
+ Add_run ;
+ L_rewrite( run) ;
+ end;
+ new_tail( run_ptr ) ;
+ with image( run_ptr) do begin {write the data into it}
+ hpos := Set_h ; Old_h := Set_h ;
+ vpos := Set_v ; Old_v := Set_v ;
+ symbol := cod ;
+ end;
+ incr(page_size) ;
+ if page_size >= page_max then abort(
+ 'Overflowed page: either a bug, or recompile with larger page_max' ) ;
+ end
+ @.Fatal: Overflowed page@>
+
+@ Once the lists are all assembled, we must |reset| them before sorting.
+
+@<The dancers...@>=
+ sorted := false;
+ L_reset( run) ;
+ Add_run ;
+
+@ Now we must specify the desired order!! That is: increasing |vpos| and
+|hpos|, |vpos| is more significant.
+
+@d out_of_sequence ==
+ ( ( Old_v > Set_v) or ( ( Old_v = Set_v) and ( Old_h > Set_h)))
+
+@<The person on the left is more eligible@>=
+ ( ( image( L_run_ptr).vpos < image( R_run_ptr).vpos) or
+ ( ( image( L_run_ptr).vpos = image( R_run_ptr).vpos)
+ and ( image( L_run_ptr).hpos <= image( R_run_ptr).hpos)))
+
+@ And here we get it all started. Since |garbage| wipes out everything in the
+|pool| array above |zzz|, the following code effectively makes |mid..run|
+permanent.
+
+@<Set init...@>=
+ first_cell ;
+ make_new( mid );
+ make_new( left );
+ make_new( right );
+ make_new( run );
+ make_new( zzz );
+ image(zzz).vpos := max_half;
+ next(zzz) := zzz ;
+ mid_ptr := zzz ;
+ run_ptr := zzz ;
+
+@ @<Set up an empty page...@>=
+ garbage ;
+ L_rewrite( mid) ;
+ L_rewrite( run) ;
+ page_size := 0 ;
+ Old_v := -max_half ;
+
+@ @<Glob...@>=
+ zzz, cell, tempp, cur_pge_ptr,
+ mid, mid_ptr, run, run_ptr,
+ left, left_ptr, L_run_ptr ,
+ right, right_ptr, R_run_ptr : link;
+ page_size: page_i ;
+ Old_v, Old_h : i_word ;
+ sorted: boolean ;
+ declare_pool
+
+@ Now we must define lots of machinery for handling lists. We could represent
+a list by either a big array or dynamic storage. Neither is ideal, because an
+array is bound to be either too big or too small; and some \PASCAL s
+apparently do not implement pointers. So I have expressed everything in terms
+of certain macros, defined in the system dependent part of the program. In
+theory, you can switch \.{Crudetype} from array to heap merely by redefining
+these as follows:
+\begintt
+ define image(#) == #^
+ define create == new(cell)
+ define first_cell == do_nothing
+ define link_type == ^page_record
+ define wipe_out(#) == dispose(#) ; { release data piecemeal}
+ define garbage == do_nothing
+ define declare_pool == do_nothing
+\endtt
+
+Both array and heap seem to work in VMS. I prefer to use an array because in
+VMS, there seems to be no shortage of store, and an array is easier to debug.
+Assuming these lowest-level macros, here is some machinery for handling lists.
+We must deallocate cells after use. When using arrays, the |garbage| command
+does it all in one go. Pointers must be |dispose|d one at a time, and the
+obvious time is just after the data was used.
+
+@d next(#) == image(#).prox
+@d advance(#) == # := next(#)
+@d make_new( #) == create; # := cell ;
+@d new_tail( #) ==
+ create; next( #) := cell; # := cell ;
+@d step_wipe( #) ==
+ tempp := # ; advance( #) ; wipe_out( tempp)
+
+@ Suppose |L| is a list; then the actual variable |L| points to a permanently-
+allocated cell which in turn points to the head of the list. |L_ptr| points to
+the active end. After the list has been assembled, we first mark the tail, by
+attaching a special element called |zzz|. Then we move the |L_ptr| round to
+the head. |copy_from| must be used in the combination
+{\tt copy\_from(A)(B)}. It copies one element from the head of |A| to the
+tail of |B|.
+
+@d L_rewrite( #) ==
+ #@&ptr := # ; next( #) := zzz
+@d L_reset( #) ==
+ next ( # @& ptr) := zzz ; #@&ptr := next( #)
+@d L_eof( #) ==
+ ( # @& ptr = zzz)
+@d copy_end( #) ==
+ next( #@&ptr) := tempp ; advance( #@&ptr) ; end
+@d copy_from( #)==
+begin
+ tempp := #@&ptr ;
+ advance( #@&ptr ) ;
+ copy_end
+
+@ Each top-level entry has the |false| type below; the |prox| field points to
+the next top-level entry and the |down| field to a sub-list.
+
+@d son(#) == image(#).down
+
+@<Types...@>=
+ page_i = 0..page_max ;
+ link = link_type ;
+ page_record = packed record
+ prox: link ;
+ case boolean of
+ true: ( hpos : i_word;
+ vpos: i_word;
+ symbol: code_object ) ;
+ false: ( down : link) ;
+ end;
+
+@* Processing a page of output.
+
+The output of \.{Crudetype} is done by the procedure |Send_page|, which takes
+the page and translates it for the printer. We shall process it a `line' at a
+time, meaning all |page_records| with the same |vpos|. Initially |PR_font|
+gets an impossible value so as to force an explicit |set_PR_font|.
+
+@<Top level...@>=
+ procedure Send_page;
+ var line: link ;
+ begin
+ PR_font := sentry;
+ PR_h := 0;
+ PR_v := 0;
+ while (not L_eof( cur_pge))
+ do begin
+ line := read_line ;
+ do_line( line, 0);
+ end ;
+ end;
+
+@ The function |read_line| runs along the page image until the vertical
+position changes. It returns a pointer to a sublist which is the next line on
+the page. As side effects, it advances |cur_pge_ptr| to the first record of
+the next line, and updates |PR_v_next|.
+
+@<Medium...@>=
+ function read_line : link ;
+ var head, tail: link ; size: integer;
+ begin
+ head := cur_pge_ptr ;
+ size := 0 ;
+ PR_v_next := image(cur_pge_ptr).vpos ;
+ repeat
+ tail := cur_pge_ptr ;
+ advance(cur_pge_ptr) ;
+ incr(size) ;
+ if size = max_line_size then
+ warn('Excessively long line ') ;
+ @.Error: Excessively long line@>
+ until ( ( L_eof( cur_pge) )
+ or (PR_v_next <> image(cur_pge_ptr).vpos ) ) ;
+ next(tail) := zzz ;
+ read_line := head ;
+ end;
+
+@ These bounds are put in to catch runaway arguments.
+
+@<Const...@>=
+ page_max = 30000 ;
+ max_line_size = 1000;
+ left_stop = 0 ;
+ deepest = 10 ;
+
+@ These variables all denote the printer fonts, etc.
+
+@<Glob...@>=
+ PR_v, PR_v_next,
+ PR_h, PR_h_next,
+ PR_font : i_word ;
+
+@ This procedure tries to print a line. The main difficulties are: we dont
+want to |Backfeed| unless absolutely necessary; and we may have to deal with
+overstruck characters. One possible way is to shunt them aside somewhere, then
+print the |overflow| after the main line has been printed.
+
+@<Medium...@>=
+ procedure do_line (line_ptr: link; depth: integer);
+ var overflow : link;
+ begin
+ @<Move printer vertically to |PR_v_next|, update |PR_v|@>;
+ overflow := zzz ;
+ while (line_ptr<>zzz) do
+ @<Process the character that |line_ptr| points to, and |advance| to
+ the next@>;
+ if ( overflow = zzz) then
+ begin @<End the line, trying very hard not to over-feed the paper@> end
+ else begin @<Print the |overflow|@> end;
+ @<Reset printer at end of line, if necessary@>
+ end;
+
+@ We are actually getting almost in sight of the printer!!! Before we can
+actually print a character, we must first check if it has to go to the
+|overflow|...
+
+@<Process the char...@>=
+ with image(line_ptr) do begin
+ PR_h_next := hpos - H_shunt ;
+ if not b_space_absolute and not b_space_by_string and
+ (PR_h_next < PR_h) then
+ begin
+ if (PR_h < left_stop) then warn ('Negative H-pos') ;
+ if not batch_view then begin
+ next(overflow) := line_ptr ;
+ advance(overflow) ;
+ end;
+ advance(line_ptr) ;
+ end
+ else begin
+ @<Set horizontal position for the next character@>;
+ if symbol.IM_font <> PR_font then set_PR_font(symbol.IM_font);
+ print(zchr(symbol.IM_char )) ;
+ PR_h := PR_h + symbol.breadth ;
+ step_wipe(line_ptr ) ;
+ end ; end;
+ @.Error: Negative H-pos@>
+
+@ If the |overflow| is non-empty, we print it by calling |do_line| recursively
+on it. But sometimes |do_line| tries to recurse to infinite depth (this is a
+bug), so we perform a check first.
+
+@<Print the |overflow|@>=
+ @<Return@> ;
+ if (depth < deepest) then begin
+ next(overflow) := zzz ;
+ overflow := next(zzz) ;
+ do_line( overflow, depth + 1);
+ end else warn( 'I am out of my depth') ;
+ @.Error: I am out of my depth@>
+
+@* Downloading. Not started yet.
+
+@<Download a whole font@>= do_nothing
+
+@ @<Enter a download...@>=
+
+@* Carriage control.
+
+Once the superior software has decided where the printer has to move to next,
+this section has the job of translating the desired position into elementary
+printer commands. Clearly this mapping depends very much on the range of
+functions that the printer can perform. So this section is controlled by
+several booleans; each asserts that the printer can do the
+corresponding action. Here is a list of the most important ones:\item
+|@!cr_feed_dist| is the distance in |v_steps| by which a carriage-return
+feeds the paper.\item
+|@!wl_feed_dist| ditto, |write_ln|. Similarly for the other |dist|
+values.\item
+|@!feed_absolute| says the printer has an absolute position command that takes
+a parameter |IM_y|, say, and moves to position |IM_y v_steps| down the
+page.\item
+|@!b_feed_absolute| ditto, backfeeding.\item
+|@!b_feed_by_string| says the printer has a |Backfeed| character that moves it
+back by a fixed number |b_feed_dist| of |v_steps|. These booleans should not
+be set true unless the printer can backfeed reliably.\item
+|@!space_absolute| etc., Ditto, horizontal moves.\item
+|@!abs_is_incr| says that in the absolute position commands, the parameter is
+actually an incremental move.\item
+|@!wl_does_cr| says that |write_ln| forces a carriage return.
+
+In Version 3, I have changed all these constants into variables. I
+hope this will make it easier to support devices that closely resemble
+lineprinters without a lot of messy recompilation. As mentioned
+above, it is essential to avoid premature line feeds as much as
+possible. Also, many operating systems will choke if the output record
+gets too long, so we must do a |print_ln| at intervals. This program
+tries to accommodate various types of carriage control, some of which
+are not in use at our site. This means that several pieces of
+code have not been tested. Installers must expect to find that the procedures
+defined here will need to be carefully studied in conjunction with the
+I/O section of their \PASCAL\ manual.
+
+Now consider what happens at the end of each line. We will want to do a
+subset of the following things: carriage-return, print the |overflow|, line
+feed, split output records. We must keep a clear separation between these
+tasks, and we want to do them in the stated order (but not if |fortran|). This
+order puts most of the carriage controls to the ends of the output records,
+and (on our machine) makes it easier to examine the output file with an editor.
+So first: do we want to do carriage-return? If so, then the natural way is to
+print a carriage-return, but not if it will over-feed the paper.
+
+@<End the line...@>=
+ if( (not wl_does_cr) {Return is compulsory}
+ or feed_absolute
+ or ((not want_split) {We can choose C-R or W-L}
+ and (b_space_absolute
+ or ( cr_feed_dist < wl_feed_dist)) {and C-R is preferable}))
+ then begin @<Return@> end;
+
+@ @<Reset printer...@>= {hook}
+
+@ Now we decide whether to do any |line_feed|s. But first, we may have to
+attempt to |Backfeed|. Sometimes the program will fail; it should not do so
+unless the \.{DVI} file calls for overstruck characters and the printer
+genuinely cannot do them. If |b_feed_scream|, then print an error message.
+
+@<Move printer...@>=
+ if (PR_v_next < PR_v) then begin
+ if b_feed_absolute then set_v_abs(PR_v_next)
+ else if b_feed_by_string then
+ while (PR_v_next < PR_v) do @<Backfeed@>
+ else if b_feed_scream then begin
+ warn('Printer cant feed backwards');
+ @.Error: Printer cant...@>
+ display_ln('approximate vertical position is: ', PR_v_next);
+ display_ln(' printing over-fed line on line below');
+ display_ln(' ');
+ PR_v := PR_v_next;
+ end;
+ end;
+
+@ If we avoided over-feeding, we may want to feed forwards.
+
+@<Move printer...@>=
+ if list or fortran or (wl_feed_dist > 0 ) then
+ while (PR_v + wl_feed_dist <= PR_v_next) do
+ begin print_ln;
+ @<Check pause@>
+ if fortran then print( feed_char) ;
+ if wl_does_cr then PR_h := 0 ;
+ PR_v := PR_v + wl_feed_dist ;
+ if squash then PR_v := PR_v_next ;
+ end
+ else if feed_absolute then set_v_abs(PR_v_next)
+ else begin
+ while (PR_v_next >= PR_v + feed_dist) do @<Line feed@>;
+ print_ln ;
+ if wl_does_cr then PR_h := 0 ;
+ end;
+ while (PR_v_next > PR_v) do @<Tiny feed@> ;
+
+@ We set the horizontal position in a similar way, but we do not need to be so
+paranoid about backspacing as about back-feeding.
+
+@<Set horiz...@>=
+ if PR_h_next = PR_h then
+ else begin
+ if (PR_h_next < PR_h) then begin
+ if b_space_absolute then set_h_abs(PR_h_next)
+ else if b_space_by_string then
+ while (PR_h_next < PR_h) do @<Backspace@>;
+ end;
+ if space_absolute and (PR_h_next > PR_h )
+ then set_h_abs(PR_h_next)
+ else begin
+ while (PR_h_next >= PR_h + space_dist) do @<Space@>;
+ while (PR_h_next > PR_h) do @<Tiny space@> ;
+ end;
+ end;
+
+@* Low level modules for printer control.
+
+Now we have to translate these elementary printer commands into actual strings
+of characters to be put into |printfile|. Here is the command for setting a
+new printer's font.
+
+@<Lowest...@>=
+ procedure set_PR_font(new_font:integer) ;
+ begin
+ if (new_font = PR_font) or only_one_font then
+ else
+ begin
+ print_command( font_command, new_font, ctrl_flag) ;
+ PR_font := new_font ;
+ end;
+ end;
+
+@ Now for |absolute| movements, if the printer can do them. The procedure
+|set_v_abs| moves the printer to position |mm h_steps| below the top of the
+paper. If |abs_is_incr| then the printers `absolute' command is actually an
+incremental command. So the parameter sent to the printer must be decreased by
+|PR_v|.
+
+@<Forward...@>=
+ procedure set_v_abs(mm: integer) ; forward ;
+ procedure set_h_abs(mm: integer) ; forward ;
+
+@ @<Lowest...@>=
+ procedure set_v_abs;
+ var new_pos :integer ;
+ begin
+ if abs_is_incr then
+ new_pos := mm - PR_v
+ else new_pos := mm ;
+ print_command( v_abs_com, new_pos, ctrl_flag) ;
+ PR_v := mm ;
+ end;
+
+@#
+ procedure set_h_abs;
+ var new_pos :integer ;
+ begin
+ if abs_is_incr then
+ new_pos := mm - PR_h
+ else new_pos := mm ;
+ print_command( h_abs_com, new_pos, ctrl_flag) ;
+ PR_h := mm ;
+ end;
+
+@ Now consider commands for printers that can only do simple movements. A
+|tiny| movement is usually a movement of one |h_step| or |v_step|. All these
+modules should be protected, so they cannot be called unless the printer can
+actually do the stated movement. Normally, the command strings for these are
+only simple characters, so we can just |print| them.
+
+If |run_on| is false, we want a formfeed between two pages. |@!page_gap| will
+be true after the end of the first printed page.
+
+@<Maybe a formfeed@>=
+ if run_on then begin
+ write_ln(printfile);
+ write(printfile,'------ PAGE ', counter[0]:1,' ');
+ write(printfile,'----------------------------------');
+ write(printfile,'----------------------------------');
+ write_ln(printfile);
+ end
+ else if page_gap then
+ page(printfile)
+ else page_gap := true ;
+ if is_header then
+ string_print (page_top);
+
+@ @<Backfeed@>=
+ begin string_print(b_feed_string);
+ PR_v:=PR_v - b_feed_dist;
+ end
+
+@ @<Line feed@>=
+ begin
+ print(feed_char);
+ if squash then PR_v := PR_v_next
+ else PR_v:=PR_v+feed_dist;
+ end;
+
+@ @<Tiny feed@>=
+ begin print(t_feed_char); PR_v:=PR_v+t_feed_dist; end;
+
+@ @<Return@>=
+ if fortran then begin
+ print_ln ; print( cr_char) ; PR_h := 0;
+ PR_v := PR_v + cr_feed_dist ; end
+ else if (b_space_absolute and
+ ((cr_feed_dist > 0) or (l_margin > 0)) )
+ then set_h_abs(0)
+ else begin
+ print(cr_char);
+ PR_h := 0;
+ PR_v := PR_v + cr_feed_dist ;
+ end ;
+
+@ @<Backspace@>=
+ begin print (b_space_char); PR_h:=PR_h - b_space_dist; end;
+
+@ @<Space@>=
+ begin print (space_char); PR_h:=PR_h+space_dist; end;
+
+@ @<Tiny space@>=
+ begin print (t_space_char); PR_h:=PR_h+t_space_dist; end;
+
+@* Default declarations for printer.
+
+This section defines masses of data to describe how the printer behaves.
+Previously this was all in the lineprinter change file. However most Change
+files are for lineprinters, so I moved this stuff into the main program. In V3 I
+changed most of these constants into variables. The assumed characteristics of
+a lineprinter are as follows:
+
+1. A lineprinter can print all the printable ASCII characters, and no others.
+
+2. Each character is one |step| high and one |step| wide.
+
+3. Printer will act correctly if it receives the following ASCII controls:
+line feed, carriage return, space, and form feed. More precisely, the Standard
+specifies that the \PASCAL\ procedure |page| does something that advances
+the printer by one page.
+
+4. Backspacing and backfeeding are assumed impossible ; also we do not use
+tabs.
+
+The first lot of data describes the printer's overall style of carriage control.
+|fortran| means that the carriage control character gets put at the start of the
+line, and it is here assumed that it must be inserted explicitly. |feed| means
+a vertical movement and |space| horizontal. Each |thing_char| is the character
+needed to make the printer do the named action. Owing to the rules of
+\.{TANGLE}, the words |back| and |tiny| have to be abbreviated (to avoid
+identifier clashes).
+@.ASCII@>
+
+@<Glob...@>=
+ @!device_ID : packed array[1..12] of char ; {Name of device}
+@#
+ list, fortran, b_feed_absolute, b_feed_by_string, feed_absolute,
+ b_feed_scream, b_space_absolute, b_space_by_string, space_absolute,
+ abs_is_incr, wl_does_cr, want_split, is_header, do_pause, inspection: boolean ;
+ {These say whether the printer can do the named action}
+@#
+ wl_feed_dist, cr_feed_dist, feed_dist, t_feed_dist, b_feed_dist,
+ tiny_drop, big_drop, space_dist, t_space_dist, b_space_dist,
+ pause_i, pause_steps: integer ;
+ {Distances that various actions move}
+@#
+ feed_char, t_feed_char, cr_char, space_char, t_space_char,
+ b_space_char : char ;
+ start_stuff, stop_stuff, page_top, b_feed_string, font_command,
+ v_abs_com, h_abs_com, pause_after: var_string ;
+ {Command chars and strings}
+
+@ So here are their default values. We believe they are all appropriate for
+lineprinters on VMS machines. Note that the program makes no attempt to check
+these values for consistency.
+
+@<Set init...@>=
+ device_ID := 'Lineprinter '; {Pad to 12 chars}
+ list := false ;
+ fortran := false ;
+ b_feed_absolute := false ;
+ b_feed_by_string := false ;
+ feed_absolute := false ;
+ b_feed_scream := true ;
+ b_space_absolute := false ;
+ b_space_by_string := false ;
+ space_absolute := false ;
+ abs_is_incr := false ;
+ wl_does_cr := false ;
+ want_split := true ;
+ is_header := false ; {each page needs a header}
+ do_pause := false ;
+ inspection := false ;
+@#
+ wl_feed_dist := 0 ;
+ cr_feed_dist := 0 ;
+ feed_dist := 1 ;
+ t_feed_dist := 1;
+ b_feed_dist := 0;
+ tiny_drop := 50000 ; {slightly less than a point}
+ big_drop := 4 ;
+ space_dist := 1;
+ t_space_dist := 1;
+ b_space_dist := 1;
+ pause_i:=0 ;
+ pause_steps := 20 ;
+@#
+ feed_char := chr(10) ;
+ t_feed_char := chr(10);
+ cr_char := chr(13);
+ space_char := chr(32) ;
+ t_space_char := chr(32) ;
+ b_space_char := chr(8);
+@#
+ start_stuff := blank ;
+ stop_stuff := blank ;
+ page_top := blank ;
+ b_feed_string := blank ;
+ font_command:= blank ;
+ v_abs_com:= blank ;
+ h_abs_com:= blank ;
+ pause_after := blank ;
+
+@ The general run of \TeX\ characters are narrower than line-printer chars. So
+we spread them out to make them fit.
+
+@<Set init...@>=
+ l_margin := 1.0 ; {Normal left margin, in inches}
+ top_margin := 1.0 ; {Top ditto}
+ h_fudge := 7.227 {number of points per |h_step|}
+ / 5.25 ; {A typical design width}
+ v_fudge := 2.0 ;
+ { Force double-spacing, in hope that suffixes will come out right}
+
+@ @<Glob...@>=
+ h_fudge, v_fudge, l_margin, top_margin: real_number ;
+
+@ Of course, these will have to be changed if |fortran|, or on a system
+that does not use ASCII codes.
+ @.ASCII@>
+
+@<Set up for...@>=
+ if inspection then begin
+ batch_view := true ;
+ quiet := true ;
+ do_pause := (pause_steps > 0) ;
+ end;
+ if batch_view then begin
+ device_ID := 'screenview '; {Pad to 12 chars}
+ run_on := true ;
+ fortran := false ;
+ list := true ;
+ end;
+ if fortran then begin
+ wl_does_cr := true ;
+ wl_feed_dist := 1;
+ feed_char := ' ' ;
+ t_feed_char := ' ' ;
+ cr_char := '+' ;
+ end;
+ if list then begin
+ wl_feed_dist := 1;
+ cr_feed_dist := 1 ;
+ cr_char := ' ' ;
+ wl_does_cr := true ;
+ l_margin := 0 ;
+ top_margin := 0 ;
+ end ;
+
+@ |start_stuff| and |stop_stuff| get written into the start and end of
+|printfile|. They are intended to: set printer into correct state for \TeX\
+output, and reset printer to standard state afterwards. If the printer needs
+to be re-initialised in any way at the top of each page, then set |@!page_top|
+to the necessary data and set |is_header| to |true|.
+
+@<Open |printfile|@>=
+ string_print(start_stuff) ;
+ print_ln ;
+
+@ @<Clean up afterwards@>=
+ string_print(stop_stuff);
+ print_ln ;
+ if not quiet then begin
+ display ('Output written to file: ');
+ string_show(print_name);
+ end;
+ display_ln(' ') ;
+ @.Output written...@>
+
+@ This batch is concerned with distances and resolutions.
+
+@<Const...@>=
+ h_resolution = 10 ; {|h_steps| per inch}
+ v_resolution = 6 ; {|v_steps| per inch}
+ fixed_width = true ; {printers characters are fixed width}
+ char_width = 1 ;
+ {all printer characters are this width, in units of |h_step|. Normally,
+ |space_dist| will be equal to this, but some printers are not normal!}
+ gap_width = 1 ; {Intended minimum space between words}
+ char_ht = 1 ;
+
+@ Next, some constants for rule-setting.
+
+@<Rule setting const...@>=
+ rail_width = 1 ; {Height and width of rule chars, in steps}
+ rail_height = 1 ;
+ post_width = 1 ;
+ post_height = 1 ;
+ rail_types = 2 ;
+
+@ @<Set rule characters@>=
+ rail_chars[1] := codes[ 1, 95 ] ;
+ rail_chars[2] := codes[ 1, 45 ] ;
+ post_char := codes[ 1, 124] ;
+
+
+@ The next batch are concerned with fonts.
+
+@<Const...@>=
+ min_font = 1 ;
+ {smallest and largest number of printers resident fonts}
+ max_font = 1 ;
+ only_one_font = true ;
+ can_dl_font = false ;
+ min_dl_font = 0 ;
+ max_dl_font = 0 ; {printers down-loadable fonts}
+ max_codes = 60 ; {no. of known \TeX\ coding schemes}
+ max_plain = 4 ; {Max number of a plain text font}
+
+@ Here is a first attempt at a screenview version based on code by J. Warbrick,
+A. Trevorrow and others. In principle this shows how to switch \.{Crudetype}
+between different devices by flags in the command line.
+
+@<If the |key| is valid, do the corresponding command@>=
+ else if ( key = "B") then @!batch_view := true
+ else if ( key = "I") then begin
+ @!inspection := true ;
+ pause_i := s_to_i( pause_steps, false) ;
+ if ((pause_i < 0) or (pause_i > 200) ) then
+ string_warn ('Illegal value for I flag')
+ else pause_steps := pause_i ;
+ pause_i:=0 ;
+ end
+ @.Error: Illegal value@>
+
+@* Character code data for the printer.
+
+Here we actually put data into the |codes| array. In general, I have merely
+replaced each character in the PLAIN.TEX coding schemes by the nearest
+equivalent in ASCII, when a reasonable one exists. For each scheme in turn,
+first give the scheme names, then the character codes. Scheme 1 is EXTENDED
+ASCII.
+
+@<Define Lineprinter codes@>=
+ be_string('TEX EXTENDED ASCII' ); set_scheme(1) ;
+ alphabet( 32, 95, 1, 1, 32) ;
+ be_string( ' . {|v} Z Z & ~ {LC-} Z ') ;
+ row( 1,0,1) ;
+ be_string( ' Z Z Z {^|} {+_} {LO+} Z Z ') ;
+ row( 1,1,1) ;
+ be_string( ' Z Z Z Z Z Z {LOx} Z ') ;
+ row( 1,2,1) ;
+ be_string( ' [{L<-}-] [-{-L>}] {=/} Z {L<_} {L>_} {=_} [or] ') ;
+ row( 1,3,1) ;
+
+@ Now do scheme 2 = TYPEWRITER. Unfortunately, \.{TANGLE} imposes a limit of 69
+on the length of quoted strings. This causes difficulty because several multi-
+character commands are too long for 8 of them to fit neatly into a string of
+that length. So I use the Z command to ( effectively) split any complicated
+|row_spec| into two.
+
+@<Define Lineprinter codes@>=
+ be_string('TEX TYPEWRITER TEXT' ); set_scheme(2) ;
+ alphabet( 32, 95, 2, 1, 32) ;
+ codes[2, 127].IM_char:= 34 ;
+ be_string( ' Z [{/_}{_\}] {0-} [/\] Z Z Z Z ') ;
+ row( 2,0,1) ;
+ {first half row}
+ be_string( ' Z Z Z Z <U_{-_}> <U[__][||]> <U_{L>_}> LY ') ;
+ row( 2,0,1) ;
+ {and second}
+ be_string( ' {oI} {u|} Z {^|} {v|} Q ! ? ') ;
+ row( 2,1,1) ;
+ be_string( ' i j ` Q Z Z <U_> <U.> ') ;
+ row( 2,2,1) ;
+ be_string( ' , {LB_} [ae] [oe] {o/} [LALE] [LOLE] {LO/} ') ;
+ row( 2,3,1) ;
+
+@ The TEX TEXT scheme is nearly the same, so we start by copying it.
+
+@<Define Lineprinter codes@>=
+ be_string('TEX TEXT' ); set_scheme(3) ;
+ for in_i := 0 to 127 do codes [3, in_i] := codes [2, in_i] ;
+ be_string( ' Z Z Z [ff] [fi] [fl] [ffi] [ffl] ') ;
+ row( 3,1,1) ;
+ be_string( ' Z Z Z Z ! Z ? Z ') ;
+ row( 3,7,1) ;
+ be_string( ' Z Z Z Z W Z Z <U.> ') ;
+ row( 3,11,1) ;
+ be_string( ' Z Z Z - [--] W ~ W ') ;
+ row( 3,15,1) ;
+
+@ Recently there has appeared a scheme, called TEX TEXT WITHOUT F-LIGATURES.
+
+@<Define Lineprinter codes@>=
+ be_string('TEX TEXT WITHOUT F-LIGATURES' ); set_scheme(4) ;
+ for in_i := 0 to 127 do codes [4, in_i] := codes [3, in_i] ;
+ be_string( ' {oI} {u|} Z {^|} {v|} Q ! ? ') ;
+ row( 4,1,1) ;
+
+@ and AEFMNOT ONLY (for the Metafont logo).
+
+@<Define Lineprinter codes@>=
+ be_string('AEFMNOT ONLY' ); set_scheme(5) ;
+ be_string( ' Z LA Z Z Z LE LF Z ') ;
+ row( 5,8,1) ;
+ be_string( ' Z Z Z Z Z LM LN LO ') ;
+ row( 5,9,1) ;
+ be_string( ' Z Z Z Z LT Z Z Z ') ;
+ row( 5,10,1) ;
+
+@ The MATH ITALIC scheme is almost impossible.
+
+@<Define Lineprinter codes@>=
+ be_string('TEX MATH ITALIC' ); set_scheme(6) ;
+ for in_i := 0 to 9 do codes [6, in_i] := codes [2, in_i] ;
+ alphabet( 48, 43, 6, 1, 48) ;
+ alphabet( 97, 26, 6, 1, 97) ;
+ be_string( ' Z Z . , Z / Z * ') ;
+ row( 6,7,1) ;
+
+@ MATH SYMBOLS are messy, and no doubt the results will look unpleasant.
+
+@<Define Lineprinter codes@>=
+ be_string('TEX MATH SYMBOLS' ); set_scheme(7) ;
+ alphabet( 65, 26, 7, 1, 65) ;
+ be_string( ' - . {\/} * {-:} Z {+_} <U_+> ') ;
+ row( 7,0,1) ;
+ be_string( ' {LO+} {LO-} {LOx} {LO/} LO LO o o ') ;
+ row( 7,1,1) ;
+ be_string( ' Z {=_} Z Z {L<_} {L>_} {L<_} {L>_} ') ;
+ row( 7,2,1) ;
+ be_string( ' ~ <U~~> Z Z [L<L<] [L>L>] L< L> ') ;
+ row( 7,3,1) ;
+ be_string( ' [{L<-}-] [-{L>-}] {|^} {|v} Z Z Z Z ') ;
+ row( 7,4,1) ;
+ be_string( ' Z Z Z Z [{L<-}{-L>}] / \ {~_} ') ;
+ row( 7,4,1) ;
+ be_string( ' [{L<=}=] [={L>=}] {|^} {|v} Z Z Z Z ') ;
+ row( 7,5,1) ;
+ be_string( ' Z Z Z Z [{L<=}{=L>}] Z Z Z ') ;
+ row( 7,5,1) ;
+ be_string( ' Q [oo] {L(-} {-L)} Z Z Z Z ') ;
+ row( 7,6,1) ;
+ be_string( ' Z Z Z Z [{/_}{_\}] <U[__][\/]> / Q ') ;
+ row( 7,6,1) ;
+ be_string( ' [{\-}{-/}] <U_[{-_}|]> ~ {0/} LR LT <U_|> {|_}') ;
+ row( 7,7,1) ;
+ be_string( ' Z Z Z LU Z {LU+} & [or] ') ;
+ row( 7,11,1) ;
+ be_string( ' [{|-}-] [-{-|}] Z Z Z Z L{ L} ') ;
+ row( 7,12,1) ;
+ be_string( ' L< L> | [||] {^|v} {^|v} \ Z ') ;
+ row( 7,13,1) ;
+ be_string( ' <[S_]{v/}> [{LI_}{LI_}] <U[__][\/]> <U/|/> Z Z Z Z ') ;
+ row( 7,14,1) ;
+ be_string( ' {LS*} {|-} {|-_} {9|} Z Z Z Z ') ;
+ row( 7,15,1) ;
+
+@ And here is a first attempt at the MATH EXTENSION scheme. These codes look
+rather peculiar because characters in the Extension font (unlike all others)
+have their reference points at the top. Here the restriction of string length
+to 69 is a real pain. It seemed that the least bad way to arrange these |row|s
+was by splitting each into 2 halves; then most half-rows do fit into one
+|row_string|. Here are the left hand halves.
+
+@<Define Lineprinter codes@>=
+ be_string('TEX MATH EXTENSION' ); set_scheme(8) ;
+ be_string(' <SL(L(> <SL)L)> <SL[L[> <SL]L]> ZZZZ') ;
+ row( 8,0,1);
+ be_string(' <SL{L{> <SL}L}> <S/\> <S\/> ZZZZ') ;
+ row( 8,1,1);
+ be_string(' <SL(L(L(> <SL)L)L)> <SL(L(L(L(> <SL)L)L)L)> ZZZZ') ;
+ row( 8,2,1);
+ be_string(' <SL[|||> <SL]|||> <SL{/\L{> <SL}\/L}> ZZZZ') ;
+ row( 8,3,1);
+ be_string(' <SL(L(L(L(L(> <SL)L)L)L)L)> <SL[|||L[> <SL]|||L]> ZZZZ') ;
+ row( 8,4,1);
+ be_string(' <SL{L|L<|L{> <SL}|L>|L}> <S[S/]/\[S\]> <S\[S\][S/]/> ZZZZ') ;
+ row( 8,5,1);
+ be_string(' <S/||> <S\||> <SL[||> <SL]||> ZZZZ') ;
+ row( 8,6,1);
+ be_string(' <S[S/]|> <S\[S|]> <S|[S\]> <S[S|]/> ZZZZ') ;
+ row( 8,7,1);
+ be_string(' <S||\> <S||/> <S|> <S|> ZZZZ') ;
+ row( 8,8,1);
+ be_string(' <[__]\[{/_}_]> <[__][LILI]> </|/> <S[||][\/]> ZZZZ') ;
+ row( 8,10,1);
+ be_string(' <S[{|_}{|_}]> <S[|S|][{|_}_{_|}]> <U_> <U[__]> ZZZZ') ;
+ row( 8,12,1);
+ be_string(' <SL[L[L[> <SL]L]L]> <S||L[> <S||L]> ZZZZ') ;
+ row( 8,13,1);
+ be_string(' <S{|^}> <S{|v}> / \ ZZZZ') ;
+ row( 8,15,1);
+
+@ Here are the right hand halves.
+
+@<Define Lineprinter codes@>=
+ be_string('ZZZZ <S|L[> <S|L]> <SL[|> <SL]|> ') ;
+ row( 8,0,1);
+ be_string('ZZZZ <S|> <S[||]> <S[S/]/> <Z\[S\]> ') ;
+ row( 8,1,1);
+ be_string('ZZZZ <SL[L[L[L[> <SL]L]L]L]> <S|||L[> <S|||L]> ') ;
+ row( 8,2,1);
+ be_string('ZZZZ <S[S/]/\[S\]> <S\[S\][S/]/> <S[S/][S/]//> <S\\[S\][S\]> ') ;
+ row( 8,3,1);
+ be_string('ZZZZ <S||||L[> <S||||L]> <SL[||||> <SL]||||> ') ;
+ row( 8,4,1);
+ be_string('ZZZZ <S[S/][S/]//> <S\\[S\][S\]> <S[SS/][S/]/> <S\[S\][SS\]> ') ;
+ row( 8,5,1);
+ be_string('ZZZZ <S||L[> <S||L]> <S|> <S|> ') ;
+ row( 8,6,1);
+ be_string('ZZZZ <S[S|]L<[S|]> <S|[SL>]|> <S|> <S|> ') ;
+ row( 8,7,1);
+ be_string('ZZZZ <S[S/]L<[S\]> <S\[SL>]/> <S[{|_}{|_}]> <S[|S|][{|_}S{|_}]> ') ;
+ row( 8,8,1);
+ be_string('ZZZZ <S[/\][||]> <S[|+|][\_/]> <S[/\]> <S[\/]> ') ;
+ row( 8,10,1);
+ be_string('ZZZZ <U[___]> <U~> <U[~~]> <U[~~~]> ') ;
+ row( 8,12,1);
+ be_string('ZZZZ <SL[||> <SL]||> <SL{L{L{> <SL}L}L}> ') ;
+ row( 8,13,1);
+ be_string('ZZZZ \ / <S{|^}> <S{|v}> ') ;
+ row( 8,15,1);
+
+@ And here are the half rows that are so long that even half a row must be
+further split.
+
+@<Define Lineprinter codes@>=
+ be_string(' </{|O}/> <S/{|O}|/> <S[/\][\/]> <S[S_][/.\][\_/]> ZZZZ') ;
+ row( 8,9,1);
+ be_string('ZZZZ <S[{/_}{\_}][\/]> <S[S_][{/_}{|_}{_\}][\{|_}/]> ZZ') ;
+ row( 8,9,1);
+ be_string('ZZZZZZ <S[{\/}{/\}][{\/}{/\}]> <[S_][{\/}S{/\}][|{\/}|][{/\}_{/\}]> ') ;
+ row( 8,9,1);
+
+@#
+ be_string(' <[___]\[SL>][{/_}__]> <[___][|S|][|S|][|S|]> <S/||/> ZZZZZ') ;
+ row( 8,11,1);
+ be_string('ZZZ <S[|S|][|S|][\_/]> <[S_][/S\][|S|][|S|]> ZZZ') ;
+ row( 8,11,1);
+ be_string('ZZZZZ <S[|S|][|+|][\_/]> <SS[S/\][/SS\]> <SS[\SS/][S\/]> ') ;
+ row( 8,11,1);
+
+@#
+ be_string(' <S[_S|][S\|]> <S[SS|][_S|][S\|]> <S[SS|][SS|][_S|][S\|]> ZZZZZ') ;
+ row( 8,14,1);
+ be_string('ZZZ <S[SS|][SS|][SS|][_S|][S\|]> <S[SS|][_S|][S\|]> ZZZ') ;
+ row( 8,14,1);
+ be_string('ZZZZZ <S|> <U_|> <S[||]> ') ;
+ row( 8,14,1);
+
+@ The LATEX SYMBOL and LATEX CIRCLE schemes are really only included to stop
+the silly error messages that appear when processing LaTeX documents if they
+are omitted. But having said that, there are one or two characters that we
+can do: (This LATEX and ADOBE stuff by courtesy of J.Warbrick.)
+
+@<Define Lineprinter codes@>=
+ be_string( 'LATEX SYMBOLS' ); set_scheme(9) ;
+ be_string( 'LATEX CIRCLE' ); set_scheme(10) ;
+ be_string(' Z [L<|] [{L<_}|] [|L>] [|{L>_}] Z Z Z ') ;
+ row( 9, 0,1) ;
+ be_string(' [L<] [L>] Z Z Z Z Z Z ') ;
+ row( 9, 5,1) ;
+ be_string(' Z Z ~ ~ Z Z Z Z ') ;
+ row( 9, 7,1) ;
+
+@ LATEX LINE is much the same, except we can try more of the characters.
+Since the line segments will not line up correctly, the results of using this
+will probably be nasty
+
+@<Define Lineprinter codes@>=
+ be_string( 'LATEX LINE' ); set_scheme( 11) ;
+ be_string(' / | | | | | Z Z ') ;
+ row( 11, 0,1) ;
+ be_string(' / L< / v | v ^ v ') ;
+ row( 11, 1,1) ;
+ be_string(' / / L> / / ^ Z ^ ') ;
+ row( 11, 2,1) ;
+ be_string(' / L< / L< / L< L> Z ') ;
+ row( 11, 3,1) ;
+ be_string(' / / / / Z / Z Z ') ;
+ row( 11, 4,1) ;
+ be_string(' _ L< L> L< / L> Z L< ') ;
+ row( 11, 5,1) ;
+ be_string(' Z L> Z L> Z Z ^ L> ') ;
+ row( 11, 6,1) ;
+ be_string(' Z L< L> Z Z L< L> v ') ;
+ row( 11, 7,1) ;
+ be_string(' \ | | | | | Z Z ') ;
+ row( 11, 8,1) ;
+ be_string(' \ L< \ ^ | ^ v ^ ') ;
+ row( 11, 9,1) ;
+ be_string(' \ \ L> \ \ v Z v ') ;
+ row( 11,10,1) ;
+ be_string(' \ L< \ L< \ L< L> Z ') ;
+ row( 11,11,1) ;
+ be_string(' \ \ \ \ Z \ Z Z ') ;
+ row( 11,12,1) ;
+ be_string(' _ L< L> L< \ L> Z L< ') ;
+ row( 11,13,1) ;
+ be_string(' Z L> Z L> Z Z Z L> ') ;
+ row( 11,14,1) ;
+ be_string(' Z L< L> Z Z L< L> Z ') ;
+ row( 11,15,1) ;
+
+@ Next comes ADOBESTANDARDENCODING for PostScript text fonts. This assumes
+that your PostScript font TFM's use this as the coding scheme name for the
+font. AdobeStandardEncoding is what Adobe call their text encoding, so you
+will be OK if this got copied across.
+
+@<Define Lineprinter codes@>=
+ be_string( 'ADOBESTANDARDENCODING' ); set_scheme( 12) ;
+ alphabet(32,95,12,1,32);
+ be_string(' Z ! {LC/} $ / {Y=} f {LS*} ') ;
+ row( 12,20,1) ;
+ be_string(' * Q W [L<L<] L< L> [fi] [fl] ') ;
+ row( 12,21,1) ;
+ be_string(' Z - {|-} {|-_} . Z {9|} . ') ;
+ row( 12,22,1) ;
+ be_string(' , [,,] W [L>L>] [...] [%.] Z ? ') ;
+ row( 12,23,1) ;
+ be_string(' Z ` Q ^ ~ <U_> Z <U.> ') ;
+ row( 12,24,1) ;
+ be_string(' <U[..]> Z <U.> , Z W , Z ') ;
+ row( 12,25,1) ;
+ be_string(' [--] Z Z Z Z Z Z Z ') ;
+ row( 12,26,1) ;
+ be_string(' Z [LALE] Z <U{a_}> Z Z Z Z ') ;
+ row( 12,28,1) ;
+ be_string(' L {O/} [OLE] <U{o_}> Z Z Z Z ') ;
+ row( 12,29,1) ;
+ be_string(' Z [ae] Z Z Z i Z Z ') ;
+ row( 12,30,1) ;
+ be_string(' l {O/} [oe] {B_} Z Z Z Z ') ;
+ row( 12,31,1) ;
+
+@ And then ADOBESYMBOLENCODING for PostScript symbols. Adobe flag the coding
+scheme for Symbol as FontSpecific, but we can do better than this, so I have
+changed the scheme in the TFM's to this name.
+
+@<Define Lineprinter codes@>=
+ be_string( 'ADOBESYMBOLENCODING' ); set_scheme( 13) ;
+ alphabet(32,48,13,1,32);
+ be_string(' Z Z [{\-}{-/}] Z <U_[{-_}|]> Z Z {)-}$ ') ;
+ row( 13, 4,1) ;
+ be_string(' {~=} Z Z X [{/_}{_\}] Z {oI} S ') ;
+ row( 13, 8,1) ;
+ be_string(' Z Z v Z [/\] Z Z Z ') ;
+ row( 13, 9,1) ;
+ be_string(' <U[__][||]> {O-} P <U_{L>_}> T Y Z Z ') ;
+ row( 13,10,1) ;
+ be_string(' <U_{-_}> {u|} LZ L[ <U[S.][.S.]> L] {|_} _ ') ;
+ row( 13,11,1) ;
+ be_string(' <U[S_]> Z Z Z Z Z Z Z ') ;
+ row( 13,12,1) ;
+ be_string(' Z Z Z L{ | L} ~ Z ') ;
+ row( 13,15,1) ;
+ be_string(' Z Z Q {L<_} / [oo] f Z ') ;
+ row( 13,20,1) ;
+ be_string(' Z Z Z [{L<-}{-L>}] [{L<-}-] {^|} [-{-L>}] {|v} ') ;
+ row( 13,21,1) ;
+ be_string(' o {+_} W {L>_} x Z d o ') ;
+ row( 13,22,1) ;
+ be_string(' {-:} {=/} {=_} <U~~> [...] <U||> [---] Z ') ;
+ row( 13,23,1) ;
+ be_string(' Z Z Z Z {Ox} {O+} {O/} Z ') ;
+ row( 13,24,1) ;
+ be_string(' LU Z Z Z Z Z {(-} {(-/} ') ;
+ row( 13,25,1) ;
+ be_string(' {/_} <U[__][\/]> {Or} {Oc} [TLM] <U[__][||]> <U[S_]{v/}> . ') ;
+ row( 13,26,1) ;
+ be_string(' ~ & [or] [{L<=}{=L>}] [{L<=}=] {^|} [={=L>}] {|v} ') ;
+ row( 13,27,1) ;
+ be_string(' Z <U/\> {Or} {Oc} [TLM] <U_{L>_}> <U[S/]|> <U||> ') ;
+ row( 13,28,1) ;
+ be_string(' <U|[S\]> <UL[|> <U||> <U|L[> <U[S/]|> <U||> <U|[S\]> <U||> ') ;
+ row( 13,29,1) ;
+ be_string(' Z <U\/> <U[S/][S|]/> <U[S/]|> <U||> <U[S|]/> <U\[S|]> <U||> ') ;
+ row( 13,30,1) ;
+ be_string(' <U[S|]/> <UL]|> <U||> <U|L]> <U\[S|]> <U||> <U[S|]/> Z ') ;
+ row( 13,31,1) ;
+
+@ At our site (RHBNC) we have a set of text and symbol fonts. These were clearly
+made by people who didnt understand what a coding scheme was. The text fonts
+have all sorts of coding schemes written in their files, like `HELVETICA BOLD'
+etc., but in fact they nearly all actually use TEX TEXT. Some of the symbol
+fonts have the same scheme written into their files as the Zapf fonts, which are
+entirely different. In order to make some sense out of this mess, we arrange
+that an unknown scheme will default to TEX TEXT. This deals with all the text
+fonts. We will use the actual font names for some of the symbol fonts.
+
+Also our local \TeX\ is V2; it can only handle 128 char fonts. The PSYMML font
+is the first 128 chars of the symbol font; so we just give it the same scheme
+number. But PSYMMU is the other 128 chars offset by -128. (i.e. char 50 of
+PSYMMU = char 178 of SYMBOL).
+
+@<Define Lineprinter codes@>=
+ be_string( 'SYMBOL' ); set_scheme( 13) ;
+ be_string( 'PSSYML' ); set_scheme( 13) ;
+ be_string( 'PSSYMU' ); set_scheme( 14) ;
+ for in_i := 0 to 127 do
+ codes [14, in_i] := codes [13, in_i + 128] ;
+
+@ For the Screenview version we fudge some of these rows:
+
+@<Define Lineprinter codes@>=
+ if batch_view then begin
+ be_string(' Z Z [\=] Z [L<=] [L>=] [==] [or] ') ;
+ row( 1,3,1) ;
+ be_string(' Z [==] Z Z [L<=] [L>=] [L<=] [L>=] ') ;
+ row( 7,2,1) ;
+ end ;
+
+@ This peculiar arrangement is intended to allow the HPGF change file
+to make changes.
+
+@<Assign char...@>=
+ @<Define Lineprinter codes@>
+ @<Set rule characters@>
+
+@* Printer changes can be put here.
+
+*** Attach printer change file here ***
+
+@* Index.
+
+Pointers to error messages appear here under ``error" or ``Fatal" together with
+the section numbers where each identifier is used.
diff --git a/dviware/crudetype/version3/hp.ch b/dviware/crudetype/version3/hp.ch
new file mode 100644
index 0000000000..3ffd6863e9
--- /dev/null
+++ b/dviware/crudetype/version3/hp.ch
@@ -0,0 +1,689 @@
+% hp.ch -*-mode: change; webfile: crudetype.web version 3.01;-*-
+% HP.CH Provisional change file for the HP Laserjet...
+% NOTE the system change file must normally be inserted above this point.
+% This file reads PXL files, so cannot be tested at our site
+%
+
+@x Module 41; Lines 822 -- 839
+When this module starts, the \.{DVI} file should be positioned at or before a
+BOP.
+
+@<For each page...@>=
+ read_BOP;
+ if (counter[0] >= first_page) then start := true ;
+ if start and (count_pages > 0 )
+ then begin
+ @<Maybe a formfeed@>
+ decr(count_pages);
+ if not quiet then display('[', counter[0]:1 ); {Progress report}
+ Read_one_page ;
+ @<Sort the page@>
+ Send_page ;
+ if not quiet then display( ']' );
+ end
+ else if ( count_pages > 0) then Skip_page
+ else time_to_stop := true;
+@y
+When this module starts, the \.{DVI} file should be positioned at or before a
+BOP.
+
+This is where the printer change file proper begins. This change file goes
+with \.{Crudetype} version 2. First, it should be explained that the HP is not
+at all a "crude" printer, and the mechanisms of \.{Crudetype} are not really
+suitable for it. It is really stretching the program a very long way from its
+intended purpose. In particular, some changes have to be spliced into the
+middle of the program, instead of going at the end as printer changes ought
+to. It seems that the only reasonable way to drive a HP is by downloading all
+the required characters. As stated in \.{Crudetype}, the problems of
+downloading are extremely difficult and I have not solved them in any
+satisfactory manner. The code given below manages downloading in the simplest
+and crudest way possible.
+
+First, I have added flags to print either even or odd pages only. In
+principle, this will allow double sided printing. Also, we do not sort the
+page as the HP can jump about.
+
+@<For each page...@>=
+ read_BOP;
+ if (counter[0] >= first_page) then start := true ;
+ if start and (count_pages > 0 ) and (
+ ( odd( counter[0]) = odds) or (( not evens) and ( not odds)) )
+ then begin
+ decr(count_pages);
+ if not quiet then display('[', counter[0]:1 ); {Progress report}
+ Read_one_page ;
+ @<Dont sort the page but |reset| it @>
+ Send_page ;
+ @<Formfeed@>;
+ if not quiet then display( ']' );
+ end
+ else if ( count_pages > 0) then Skip_page
+ else time_to_stop := true;
+@z
+
+% Next, the HP has its own rule-setting commands.
+@x Module 57; Lines 1126 -- 1136
+ procedure set_rule;
+ var D_p,D_q: integer;
+ begin
+ D_p:=get_integer(dvi) (-4);
+ D_q:=get_integer(dvi)(-4);
+ if (D_p<=0)or(D_q<=0) then
+ {an invisible rule! Dont ask me why \TeX\ wants to do this}
+ else if (D_p*v_conv <= post_height/2)
+ then do_rail(D_p, D_q)
+ else do_post(D_p, D_q);
+ end;
+@y
+ procedure set_rule;
+ var D_p,D_q: integer;
+ rule_h, rule_v, rule_ht, rule_wid: integer ; {all in pixels}
+ begin
+ D_p:=get_integer(dvi) (-4);
+ D_q:=get_integer(dvi)(-4);
+ if (D_p<=0)or(D_q<=0) then
+ {an invisible rule! Dont ask me why \TeX\ wants to do this}
+ else begin @<Find the pixel sizes and reference point@>
+ @<Send it to the printer@>
+ end;
+ end;
+@z
+
+@x Module 174; Lines 2958 -- 2959
+@d out_of_sequence ==
+ ( ( Old_v > Set_v) or ( ( Old_v = Set_v) and ( Old_h > Set_h)))
+@y
+Since we do not sort, we will not separate the characters into runs.
+
+@d out_of_sequence == false
+@z
+
+@x Module 206; Lines 3419 -- 3457
+@* Default declarations for printer.
+
+This section defines masses of data to describe how the printer behaves.
+Previously this was all in the lineprinter change file. However most Change
+files are for lineprinters, so I moved this stuff into the main program. In V3 I
+changed most of these constants into variables. The assumed characteristics of
+a lineprinter are as follows:
+
+1. A lineprinter can print all the printable ASCII characters, and no others.
+
+2. Each character is one |step| high and one |step| wide.
+
+3. Printer will act correctly if it receives the following ASCII controls:
+line feed, carriage return, space, and form feed. More precisely, the Standard
+specifies that the \PASCAL\ procedure |page| does something that advances
+the printer by one page.
+
+4. Backspacing and backfeeding are assumed impossible ; also we do not use
+tabs.
+
+The first lot of data describes the printer's overall style of carriage control.
+|fortran| means that the carriage control character gets put at the start of the
+line, and it is here assumed that it must be inserted explicitly. |feed| means
+a vertical movement and |space| horizontal. Each |thing_char| is the character
+needed to make the printer do the named action. Owing to the rules of
+\.{TANGLE}, the words |back| and |tiny| have to be abbreviated (to avoid
+identifier clashes).
+@.ASCII@>
+
+@<Glob...@>=
+ @!device_ID : packed array[1..12] of char ; {Name of device}
+@#
+ list, fortran, b_feed_absolute, b_feed_by_string, feed_absolute,
+ b_feed_scream, b_space_absolute, b_space_by_string, space_absolute,
+ abs_is_incr, wl_does_cr, want_split, is_header, do_pause, inspection: boolean ;
+ {These say whether the printer can do the named action}
+@#
+ wl_feed_dist, cr_feed_dist, feed_dist, t_feed_dist, b_feed_dist,
+ tiny_drop, big_drop, space_dist, t_space_dist, b_space_dist,
+@y
+@* Printer dependent data.
+
+This section defines masses of data to describe how the printer behaves.
+Previously this was all in the Line printer change file. However most Change
+files are for lineprinters, so I moved this stuff into the main program. The
+assumed characteristics of a lineprinter are as follows:
+
+1. A lineprinter can print all the printable ASCII characters, and no others.
+
+2. Each character is one |step| high and one |step| wide.
+
+3. Printer will act correctly if it receives the following ASCII controls:
+line feed, carriage return, space, and form feed. More precisely, the Standard
+specifies that the \PASCAL\ procedure |page| does something that advances
+the printer by one page.
+
+4. Backspacing and backfeeding are assumed impossible ; also we do not use
+tabs.
+
+@ The first lot of data describes the HP's overall style of carriage
+control. Many of them are completely irrelevant to the HP, but still needed in
+order for the program to compile.
+
+@<Set init...@>=
+ device_ID := 'Laserjet + '; {Pad to 12 chars}
+ list := false ;
+ b_feed_absolute := true ;
+ b_feed_by_string := false ;
+ feed_absolute := true ;
+ b_feed_scream := true ;
+ b_space_absolute := true ;
+ b_space_by_string :=false ;
+ space_absolute := true ;
+ space_absolute := false ;
+ abs_is_incr := false ;
+ w_l_does_c_r := false ;
+ want_split := true ;
+ is_header := false ; {each page needs a header}
+@z
+
+@x Module 207; Lines 3472 -- 3472
+ device_ID := 'Lineprinter '; {Pad to 12 chars}
+@y
+ device_ID := 'Laserjet + ';
+@z
+
+@x Module 208; Lines 3518 -- 3527
+@ The general run of \TeX\ characters are narrower than line-printer chars. So
+we spread them out to make them fit.
+
+@<Set init...@>=
+ l_margin := 1.0 ; {Normal left margin, in inches}
+ top_margin := 1.0 ; {Top ditto}
+ h_fudge := 7.227 {number of points per |h_step|}
+ / 5.25 ; {A typical design width}
+ v_fudge := 2.0 ;
+ { Force double-spacing, in hope that suffixes will come out right}
+@y
+@ The general run of \TeX\ characters are narrower than line-printer chars.
+But the HP prints them at their proper widths.
+
+@<Set init...@>=
+ l_margin := 1.0 ; {Normal left margin, in inches}
+ top_margin := 1.0 ; {Top ditto}
+ h_fudge := 1.0 ;
+ v_fudge := 1.0 ;
+@z
+
+@x Module 213; Lines 3587 -- 3594
+ h_resolution = 10 ; {|h_steps| per inch}
+ v_resolution = 6 ; {|v_steps| per inch}
+ fixed_width = true ; {printers characters are fixed width}
+ char_width = 1 ;
+ {all printer characters are this width, in units of |h_step|. Normally,
+ |space_dist| will be equal to this, but some printers are not normal!}
+ gap_width = 1 ; {Intended minimum space between words}
+ char_ht = 1 ;
+@y
+ h_resolution = 300 ; {|h_steps| per inch}
+ v_resolution = 300 ; {|v_steps| per inch}
+ fixed_width = false ;
+ char_width = 30 ; {default char. sizes in |h_steps| -- a guess}
+ gap_width = 5 ; {Intended minimum space between words}
+ char_ht = 42 ;
+@z
+
+@x Module 216; Lines 3611 -- 3623
+@ The next batch are concerned with fonts.
+
+@<Const...@>=
+ min_font = 1 ;
+ {smallest and largest number of printers resident fonts}
+ max_font = 1 ;
+ only_one_font = true ;
+ can_dl_font = false ;
+ min_dl_font = 0 ;
+ max_dl_font = 0 ; {printers down-loadable fonts}
+ max_codes = 60 ; {no. of known \TeX\ coding schemes}
+ max_plain = 4 ; {Max number of a plain text font}
+
+@y
+@ The next batch are concerned with fonts.
+
+@<Const...@>=
+ min_font = 1 ;
+ {smallest & largest number of printers resident fonts}
+ max_font = 40 ;
+ only_one_font = false ;
+ can_dl_font = true ;
+ min_dl_font = 8 ;
+ max_dl_font = 40 ; {printers down-loadable fonts. The HP allows up to 32}
+ max_codes = 40 ; {no. of possible \TeX\ coding schemes}
+ max_plain = 3 ; {Max number of a plain text font}
+@z
+
+@x Module 234; Lines 4022 -- 4024
+@<Assign char...@>=
+ @<Define Lineprinter codes@>
+ @<Set rule characters@>
+@y
+ @<Assign char...@>= do_nothing
+@z
+
+@x Module 235; Lines 4028 -- 4028
+*** Attach printer change file here ***
+@y
+
+@ The remaining changes can all go at the end of the program. Before getting
+onto the hardest task (namely, downloading) lets clear up the loose ends that
+were left lying about in the body of the program. First, there are a number of
+extra command options:
+
+@<If the |key|...@>=
+ else if ( key = "O") then odds := true {Print odd-numbered pages only}
+ else if ( key = "E") then evens := true {Even ditto}
+ else if ( key = "L") then begin
+ land := true ; {Print Landscape}
+ start_stuff.data[ 6] := '1' ;
+ end
+
+@ @<Glob...@>=
+ land, odds, evens: boolean ;
+
+@ @<Set init...@>=
+ land := false ;
+ odds := false ;
+ evens := false ;
+
+@ Where will the printed file go to?
+
+@<Set init...@>=
+ be_string( '.HPL' ) ; print_ex := buffer ;
+
+@ @<Dont sort the page but |reset| it @>=
+ L_reset( run) ;
+ Add_run ;
+ L_reset( mid) ;
+ page_ptr := son( next( mid) ) ;
+
+@ Now lets dispose of rule-setting. \TeX\ puts the reference point of a rule
+at bottom left, the HP at top left. Sizes must be rounded up.
+
+@<Find the pixel sizes and reference point@>=
+ rule_ht := round(v_conv*D_p + 0.5) ;
+ rule_wid := round(h_conv*D_q + 0.5) ;
+ D_dis := D_q ;
+ IM_dis := rule_wid ;
+ round_IM_h ( 0);
+ rule_h := IM_h ;
+ rule_v := IM_v - rule_ht ;
+
+@ @<Send it to the printer@>=
+ set_v_abs(rule_v) ;
+ set_h_abs(rule_h) ;
+ print(chr(27), '*c', rule_ht:1, 'B') ;
+ print(chr(27), '*c', rule_wid:1, 'A') ;
+ print(chr(27), '*c0P') ;
+ print_ln;
+
+@ Consider command strings.
+
+@<Set init...@>=
+ be_string ( '^[E^[&l0O' ) ; start_stuff := buffer ;
+ {Reset everything to default state}
+ be_string ( '^[(&DX' ) ; font_command := buffer ;
+ be_string ( '^[*p&DY' ) ; v_abs_com := buffer ;
+ be_string ( '^[*p&DX ' ) ; h_abs_com := buffer ;
+ stop_stuff := start_stuff ;
+ page_top := blank ;
+ pause_after := blank ;
+
+@ On the HP, we must explicitly start a new page at a set position. Also since
+rules get set before any characters, we must then reset the position.
+
+@<Set up an empty page image@>=
+ set_v_abs(0) ;
+ set_h_abs(0) ;
+
+@ @<Pause reset@>=
+ set_v_abs(0) ;
+ set_h_abs(0) ;
+
+@* Downloading a font.
+
+The simplest and crudest way this could possibly be done is: read the \.{PXL}
+file and load the entire font, as soon as the |font_def| command is read from
+the \.{DVI} file. On VAX/VMS, this turned out to be unbearably slow. So it is
+here changed as follows: When a |font_def| command is read, we read the whole
+pixel file into a very large array. Then download each character before
+trying to print it. This `lazy downloading' makes the program run much faster,
+at the price of an enormous |pixels| array. See \.{TUG}boat (Vol.2, No.3) for
+a description of the \.{PXL} file format.
+ @^\.{TUG}boat@>
+
+@<Download a whole font@>=
+ begin
+ @<Prepare to read the |raster_file|@>
+ @<Read the pixel file into |pixels|, checking for errors @>
+ @<Get the overall font parameters and send font header@>
+ @<Make the coding scheme point to the new font@>
+ goto good_font; {Bypass the rest of the \.{TFM} file }
+ end
+
+@ First we have to determine the file name.
+
+@<Prepare to read...@>=
+ raster_mag := round( 1500 * font_mag * magnification ) ;
+ if not hunt_for_size( font_name, raster_mag)
+ then font_error('cannot load this font') ;
+ @.Error: cannot load@>
+
+@ @<Medium...@>=
+ function open_font(
+ name: var_string; mag: integer; ask: boolean ): boolean;
+ begin
+ splice( raster_name, raster_def, mag) ;
+ open_font := open_and_ask(
+ raster_file, raster_indx, name, raster_name, ask) ;
+ end;
+
+@ @<Set init...@>=
+ be_string( 'TEX$PXL:.&DPXL' ) ; raster_def := buffer ;
+
+@ Frequently the {\.DVI} file calls for a font at a magnification that is
+almost but not quite one of the standard sizes. So we try a few steps up or
+down before giving up. |range| is the maximum percentage that we allow the
+magnification to vary.
+
+@<Forw...@>=
+ function hunt_for_size (
+ name: var_string; mag: integer): boolean; forward ;
+
+@ @<Medium...@>= function hunt_for_size ;
+ label exit ;
+ const range = 5 ;
+ var try_mag, n , max : integer; hh: boolean;
+ begin
+ max := round( raster_mag* range / 100);
+ n := 0 ;
+ while ( n <= max) do begin
+ try_mag := mag + n ;
+ hh := open_font( name, try_mag, false) ;
+ if hh then return
+ else if ( n>0) then n:= -n
+ else n := 1 - n ;
+ end;
+ hh := open_font( name, mag, true) ;
+ exit: hunt_for_size := hh;
+ end;
+
+@ Then we actually read the file into an array called |pixels|. In VMS, the
+short block at the end of the file ought to be padded with zeroes, but
+actually seems to be full of garbage. So we must do a fudge to find the true
+end of the file.
+
+@<Read the pixel...@>=
+ pxl_start [ nf] := pxl_end ;
+ repeat
+ pixels[ pxl_end] := get_byte( raster) ;
+ incr( pxl_end);
+ if pxl_end = max_pixels then
+ font_error('overflowed pixel array');
+ @.error: font: overflowed pixel array@>
+ until eof(raster_file) ;
+ while (pixels[ pxl_end] <> pixels[ pxl_start[ nf]+3]) or
+ (pixels[ pxl_end-1] <> pixels[ pxl_start[ nf]+2]) or
+ (pixels[ pxl_end-2] <> pixels[ pxl_start[ nf]+1]) or
+ (pixels[ pxl_end-3] <> pixels[ pxl_start[ nf]])
+ do decr(pxl_end) ;
+ close_binary(raster_file) ;
+ @.System dependencies@>
+
+@ |pxl_end| is the highest used point in |pixels|; the fonts will be piled in
+on top of one another and |pxl_start[n]| points to the start of font n .
+
+@<Glob...@>=
+ pixels: packed array[1..max_pixels] of byte ;
+ pxl_mag, pxl_check, pxl_end, dir_ptr : integer;
+ pxl_start, dir_start: array [D_font_ptr] of integer ;
+ raster_mag: integer;
+
+@ @<Set init...@>= pxl_end := 1 ;
+
+@ @<Const...@>= max_pixels = 1000000 ;
+
+@ @<|font_def| vars@>=
+ font_i, tex_chr : byte ;
+
+@ This is of course a guess, and perhaps we may want to refine it.
+
+@<Clean...@>=
+ display_ln
+ ('Used ', pxl_end:1, ' bytes of pixel memory out of ', max_pixels:1) ;
+
+@ Now |pxl_end| should be pointing to the very last byte of the file; so we
+will do some checking. |next_half| gets a 16-bit half word from the file, and
+|two_comp| negates it in twos-complement.
+
+@d next_half ==
+ pixels[dir_ptr] * 256 + pixels[dir_ptr+1] ;
+ dir_ptr := dir_ptr +2
+
+@d two_comp(#) == if # > 32767 then # := # - 65536 ;
+
+@<Read the pixel...@>=
+ if pxl_end < 2000 + pxl_start[ nf] then
+ font_error('Pixel file truncated!');
+ dir_ptr := pxl_end - 19 ;
+ pxl_check := next_half ;
+ two_comp(pxl_check) ;
+ pxl_check := pxl_check * 65536 + next_half ;
+ if pxl_check <> TFM_check then begin
+ warn('pixel checksum disagrees with TFM checksum') ;
+ display('pixel sum is', pxl_check) ;
+ end;
+ @.error: pixel checksum@>
+ @.error: font: Pixel file truncated@>
+
+@ Next, look at the directory pointer.
+
+@<Read the pixel...@>=
+ dir_ptr := pxl_end - 7 ;
+ dir_start[ nf] := next_half ;
+ dir_start[ nf] := dir_start[ nf] * 65536 + next_half ;
+ dir_start[ nf] := dir_start[ nf] * 4 + pxl_start[ nf] ;
+ {we count bytes, not words}
+ if dir_start[ nf] + 2067 <> pxl_end then
+ warn('pixel directory pointer disagrees with file size') ;
+ @.Error: pixel directory pointer@>
+
+@ Finally, does the printer have enough room for the font? The HP allows 32
+fonts per job and 395 KB memory. I have not checked the restriction of only 16
+fonts per page.
+
+@<Read the pixel...@>=
+ incr(PR_dl_font ) ;
+ if PR_dl_font > max_dl_font then
+ font_error('tried to load too many fonts') ;
+ @.Error: font: tried to load@>
+ @.Error: font: overflowed printer memory@>
+
+@ @<Set init...@>= PR_dl_font := min_dl_font ;
+ PR_mem_used := 0 ;
+ PR_max_mem := 395000;
+
+@ @<Glob...@>= PR_dl_font, PR_max_mem, PR_mem_used: integer ;
+
+@ If the error tests succeed, then we come here. Before we can load any
+characters, we have to send a command to the printer to declare the new font.
+This section assembles the necessary information. |dir_start[ nf]| should be
+pointing to the start of the font directory. The main task is that the printer
+must be given the size of a character cell; this must be large enough to
+contain all the characters.
+
+@<Get the overall font...@>=
+ cell_bot := 0 ;
+ cell_top := 0 ;
+ cell_wid := 0 ;
+ dir_ptr := dir_start[ nf] ;
+ for tex_chr := 0 to 127 do begin
+ @<Stretch the cell to make the character fit inside, and adjust the
+ characters width@>
+ end;
+ cell_ht := cell_bot + cell_top ; {FUDGE}
+
+@ @<Stretch...@>=
+ C_pxl_w := next_half ;
+ C_pxl_h := next_half ;
+ C_h_off := next_half ;
+ C_v_off := next_half ;
+ two_comp(C_h_off) ;
+ two_comp(C_v_off) ;
+ if C_h_off < 0 then C_pxl_w := C_pxl_w - C_h_off ;
+ if C_pxl_w > cell_wid then cell_wid := C_pxl_w ;
+ if C_v_off > cell_top then cell_top := C_v_off ;
+ if C_v_off < 0 then C_pxl_h := C_pxl_h - C_v_off ;
+ if C_pxl_h > cell_bot then cell_bot := C_pxl_h ;
+
+@ @<Glob...@>=
+ C_width, cell_ht, cell_top, cell_bot, cell_wid, C_pxl_w, C_pxl_h,
+ C_h_off, C_v_off : integer;
+
+@ Next, consider the character's width. This must be calculated exactly as in
+\.{DVItype}, for the reasons given there.
+
+@<Stretch...@>=
+ dir_ptr := dir_ptr + 4 ;
+ b0 := pixels[ dir_ptr ]; b1 := pixels[ dir_ptr + 1];
+ b2 := pixels[ dir_ptr + 2]; b3 := pixels[ dir_ptr + 3];
+ dir_ptr := dir_ptr + 4 ;
+ C_width:= (((((b3*z)div@'400)+(b2*z))div@'400)+(b1*z))div beta;
+ if b0 = 255 then C_width:=C_width - alpha
+ else if b0 <> 0 then
+ font_error('Out-of-bounds value for b0') ;
+ @.error: font: Out-of-bounds |b0|@>
+ D_width[ nf, tex_chr] := C_width ;
+
+@ We can now send stuff to declare the font. First we specify the font ID.
+This is a number by which the printer will refer to the font after loading it.
+
+@<Get the overall font...@>=
+ print(chr(27), '*c', PR_dl_font:1, 'D');
+ {Specify printers font identifier}
+ print(chr(27), ')s26W' );
+ {Start a create font command}
+ prw(26);
+ prw(1) ; { 8 bit chars}
+ prw(0) ;
+ prw(cell_top) ;
+ prw(cell_wid) ;
+ prw(cell_ht ) ;
+ prw(1) ; { portrait, proportional spaced}
+ prw(277) ;
+ for font_i := 1 to 5 do prw(0) ;
+ {The HP needs these parameters, but they dont serve any purpose known to me}
+
+@ Finally, we must establish the map from \TeX\ characters to printers
+characters in the new font.
+
+@<Make the coding scheme point to the new font@>=
+ incr(top_code) ; {get a new coding scheme}
+ scheme[ nf] := top_code ;
+ alphabet(0, 33, top_code, PR_dl_font, 190);
+ alphabet(33, 95, top_code, PR_dl_font, 33);
+ for tex_chr := 0 to max_D_char do
+ codes[ top_code, tex_chr].breadth := down_loaded ;
+
+@ @<Glob...@>= top_code: integer ;
+
+@ @<Set init...@>= top_code := 1 ;
+
+@* Downloading, part2: Lazy downloading.
+
+The idea is to load only those characters in each font that actually will be
+printed. It is obviously essential to ensure that each character gets loaded
+before being printed, and only once. This is done in the procedure
+|set_character|. The \TeX\ character is number |c_num| in font |D_font|,
+but the printer character is addressed by |cod|.
+
+The first job is to assemble the size parameters for the character.
+
+@<Enter a download...@>=
+ begin
+ dir_ptr := dir_start[D_font] + c_num * 16 ;
+ C_pxl_w := next_half ;
+ C_pxl_h := next_half ;
+ C_h_off := next_half ;
+ C_v_off := next_half ;
+ two_comp(C_h_off) ;
+ two_comp(C_v_off) ;
+ pxl_ptr := next_half ;
+ pxl_ptr := pxl_ptr * 65536 + next_half ;
+ pxl_ptr := pxl_ptr * 4 + pxl_start[D_font] ;
+ Tex_bytes := (C_pxl_w + 31) div 32 ;
+ Tex_bytes := Tex_bytes * 4 ; {Bytes per row in PXL file}
+ PR_bytes := (C_pxl_w + 7) div 8 ;{Ditto, in HP fonts}
+ C_length := PR_bytes * C_pxl_h + 16 ;
+
+@ @<Glob...@>=
+ pxl_ptr, Tex_bytes, PR_bytes, C_length, C_delta : integer;
+
+@ Now we must not let the character get downloaded twice, so we put the
+correct value into its |breadth|; we must also update the current |cod|.
+
+@<Enter a download...@>=
+ C_width := D_width[ D_font, c_num] ;
+ C_delta := round(C_width * h_conv) ;
+ codes[ cur_scheme, c_num].breadth := C_delta ;
+ cod.breadth := C_delta ;
+ PR_mem_used := PR_mem_used + C_length + 64 ; {approximate}
+ if PR_mem_used > PR_max_mem then
+ warn('overflowed printer memory, will try to proceed regardless') ;
+ @.Error: overflowed printer memory@>
+
+@ Now we send the character header. First, tell the printer which character
+will be downloaded. \TeX\ fonts usually have 128 characters and HP fonts have
+either 96 or 192. The permitted values for HP characters are 33..127 and
+160..255 according to the manual but appendix B says 160 and some others are
+undefined. So we map \TeX\ characters 0..32 onto 190..222 .
+
+@<Enter a download...@>=
+ print(chr(27), '*c', cod.IM_font:1, 'D');
+ {Specify printers font identifier}
+ print(chr(27), '*c') ;
+ print(cod.IM_char:1 ) ;
+ print('E');
+ print(chr(27), '(s', C_length:1, 'W' ) ;
+ prw(1024);
+ prw(14*256 + 1);
+ prw(0);
+ prw(- C_h_off) ; {\TeX\ and the HP measure this in opposite directions}
+ prw(C_v_off);
+ prw(C_pxl_w) ;
+ prw(C_pxl_h) ;
+ prw(4 * C_delta) ;
+
+@ And at long last we can send the pixels!! This is the only pleasant part of
+the whole messy business. We need not shuffle bits because the H-P wants them
+in almost the exact order that they appear in the PXL file. Only difference is
+that H-P packs with zero bits to the next 8-bit byte, while PXL files pack to
+next 32 bits. That is the reason for the odd-loking calculation of |Tex_bytes|
+above.
+
+@<Enter a download...@>=
+ for d_i:= 1 to C_pxl_h do begin
+ for d_j:= 1 to PR_bytes do begin
+ print(chr(pixels[ pxl_ptr ] )) ;
+ incr(pxl_ptr) ;
+ end ;
+ pxl_ptr := pxl_ptr + Tex_bytes - PR_bytes ;
+ end;
+ print_ln ;
+end;
+
+@ Nearly all the HP's arguments come as signed 16-bit words, to be printed in
+two-complement notation. This procedure prints them.
+
+@<Low...@>=
+ procedure prw( n: i_word);
+ var nn: integer ;
+ begin
+ if (n>= 0) then nn := n
+ else nn := n + 65536 ;
+ print( zchr(nn div 256));
+ print( zchr(nn mod 256));
+ end ;
+@z
+
diff --git a/dviware/crudetype/version3/hpgf.ch b/dviware/crudetype/version3/hpgf.ch
new file mode 100644
index 0000000000..c1a5734d2c
--- /dev/null
+++ b/dviware/crudetype/version3/hpgf.ch
@@ -0,0 +1,832 @@
+% hpgf.ch -*-mode: change; webfile: crudetype.web version 3.01;-*-
+% HPGF.CH Provisional change file for the HP Laserjet...
+% NOTE the system change file must normally be inserted above this point.
+% SEE HPGF.DOC for users document--which must be rewritten for any new
+% system.
+% BUGFIX 19-dec-1990 Bug spoilt Landscape mode.
+%
+
+@x Module 41; Lines 822 -- 839
+When this module starts, the \.{DVI} file should be positioned at or before a
+BOP.
+
+@<For each page...@>=
+ read_BOP;
+ if (counter[0] >= first_page) then start := true ;
+ if start and (count_pages > 0 )
+ then begin
+ @<Maybe a formfeed@>
+ decr(count_pages);
+ if not quiet then display('[', counter[0]:1 ); {Progress report}
+ Read_one_page ;
+ @<Sort the page@>
+ Send_page ;
+ if not quiet then display( ']' );
+ end
+ else if ( count_pages > 0) then Skip_page
+ else time_to_stop := true;
+@y
+When this module starts, the \.{DVI} file should be positioned at or before a
+BOP.
+
+This is where the printer change file proper begins. This change file goes
+with \.{Crudetype} version 2. First, it should be explained that the HP is not
+at all a "crude" printer, and the mechanisms of \.{Crudetype} are not really
+suitable for it. It is really stretching the program a very long way from its
+intended purpose. In particular, some changes have to be spliced into the
+middle of the program, instead of going at the end as printer changes ought
+to. It seems that the only reasonable way to drive a HP is by downloading all
+the required characters. As stated in \.{Crudetype}, the problems of
+downloading are extremely difficult and I have not solved them in any
+satisfactory manner. The code given below manages downloading in the simplest
+and crudest way possible.
+
+First, I have added flags to print either even or odd pages only. In
+principle, this will allow double sided printing. Also, we do not sort the
+page as the HP can jump about.
+
+@<For each page...@>=
+ read_BOP;
+ if (counter[0] >= first_page) then start := true ;
+ if start and (count_pages > 0 ) and (
+ ( odd( counter[0]) = odds) or (( not evens) and ( not odds)) )
+ then begin
+ decr(count_pages);
+ if not quiet then display('[', counter[0]:1 ); {Progress report}
+ Read_one_page ;
+ @<Dont sort the page but |reset| it @>
+ Send_page ;
+ @<Maybe a formfeed@>
+ if not quiet then display( ']' );
+ end
+ else if ( count_pages > 0) then Skip_page
+ else time_to_stop := true;
+@z
+
+% Next, the HP has its own rule-setting commands.
+@x Module 57; Lines 1126 -- 1136
+ procedure set_rule;
+ var D_p,D_q: integer;
+ begin
+ D_p:=get_integer(dvi) (-4);
+ D_q:=get_integer(dvi)(-4);
+ if (D_p<=0)or(D_q<=0) then
+ {an invisible rule! Dont ask me why \TeX\ wants to do this}
+ else if (D_p*v_conv <= post_height/2)
+ then do_rail(D_p, D_q)
+ else do_post(D_p, D_q);
+ end;
+@y
+ procedure set_rule;
+ var D_p,D_q: integer;
+ rule_h, rule_v, rule_ht, rule_wid: integer ; {all in pixels}
+ begin
+ D_p:=get_integer(dvi) (-4);
+ D_q:=get_integer(dvi)(-4);
+ if (D_p<=0)or(D_q<=0) then
+ {an invisible rule! Dont ask me why \TeX\ wants to do this}
+ else begin @<Find the pixel sizes and reference point@>
+ @<Send it to the printer@>
+ end;
+ end;
+@z
+
+% Dont shunt on a fine printer
+@x Module 154; Lines 2678 -- 2679
+ if H_shunt > (Set_h - 3)
+ then H_shunt := (Set_h - 3) ;
+@y
+ do_nothing ;
+@z
+
+@x Module 174; Lines 2958 -- 2959
+@d out_of_sequence ==
+ ( ( Old_v > Set_v) or ( ( Old_v = Set_v) and ( Old_h > Set_h)))
+@y
+Since we do not sort, we will not separate the characters into runs.
+
+@d out_of_sequence == false
+@z
+
+% Again, shunting is only appropriate for line printers.
+@x Module 186; Lines 3157 -- 3157
+ PR_h_next := hpos - H_shunt ;
+@y
+ PR_h_next := hpos ;
+@z
+
+@x Module 207; Lines 3467 -- 3484
+@ So here are their default values. We believe they are all appropriate for
+lineprinters on VMS machines. Note that the program makes no attempt to check
+these values for consistency.
+
+@<Set init...@>=
+ device_ID := 'Lineprinter '; {Pad to 12 chars}
+ list := false ;
+ fortran := false ;
+ b_feed_absolute := false ;
+ b_feed_by_string := false ;
+ feed_absolute := false ;
+ b_feed_scream := true ;
+ b_space_absolute := false ;
+ b_space_by_string := false ;
+ space_absolute := false ;
+ abs_is_incr := false ;
+ wl_does_cr := false ;
+ want_split := true ;
+@y
+@ The first lot of data describes the HP's overall style of carriage
+control. Many of them are completely irrelevant to the HP, but still needed in
+order for the program to compile.
+
+@<Set init...@>=
+ device_ID := 'Laserjet + ';
+ list := false ;
+ fortran := false ;
+ b_feed_absolute := true ;
+ b_feed_by_string := false ;
+ feed_absolute := true ;
+ b_feed_scream := true ;
+ b_space_absolute := true ;
+ b_space_by_string :=false ;
+ space_absolute := true ;
+ abs_is_incr := false ;
+ wl_does_cr := false ;
+ want_split := true ;
+ is_header := false ; {each page needs a header}
+@z
+
+@x Module 208; Lines 3518 -- 3527
+@ The general run of \TeX\ characters are narrower than line-printer chars. So
+we spread them out to make them fit.
+
+@<Set init...@>=
+ l_margin := 1.0 ; {Normal left margin, in inches}
+ top_margin := 1.0 ; {Top ditto}
+ h_fudge := 7.227 {number of points per |h_step|}
+ / 5.25 ; {A typical design width}
+ v_fudge := 2.0 ;
+ { Force double-spacing, in hope that suffixes will come out right}
+@y
+@ The general run of \TeX\ characters are narrower than line-printer chars.
+But the HP prints them at their proper widths.
+
+@<Set init...@>=
+ l_margin := 1.0 ; {Normal left margin, in inches}
+ top_margin := 1.0 ; {Top ditto}
+ h_fudge := 1.0 ;
+ v_fudge := 1.0 ;
+@z
+
+@x Module 213; Lines 3584 -- 3594
+@ This batch is concerned with distances and resolutions.
+
+@<Const...@>=
+ h_resolution = 10 ; {|h_steps| per inch}
+ v_resolution = 6 ; {|v_steps| per inch}
+ fixed_width = true ; {printers characters are fixed width}
+ char_width = 1 ;
+ {all printer characters are this width, in units of |h_step|. Normally,
+ |space_dist| will be equal to this, but some printers are not normal!}
+ gap_width = 1 ; {Intended minimum space between words}
+ char_ht = 1 ;
+@y
+@ This batch is concerned with distances and resolutions.
+
+@<Const...@>=
+ h_resolution = 300 ; {|h_steps| per inch}
+ v_resolution = 300 ; {|v_steps| per inch}
+ fixed_width = false ;
+ char_width = 30 ; {default char. sizes in |h_steps| -- a guess}
+ gap_width = 5 ; {Intended minimum space between words}
+ char_ht = 42 ;
+@z
+
+@x Module 216; Lines 3616 -- 3620
+ max_font = 1 ;
+ only_one_font = true ;
+ can_dl_font = false ;
+ min_dl_font = 0 ;
+ max_dl_font = 0 ; {printers down-loadable fonts}
+@y
+ max_font = 40 ;
+ only_one_font = false ;
+ can_dl_font = true ;
+ min_dl_font = 8 ;
+ max_dl_font = 40 ; {printers down-loadable fonts. The HP allows up to 32}
+@z
+
+@x Module 234; Lines 4022 -- 4024
+@<Assign char...@>=
+ @<Define Lineprinter codes@>
+ @<Set rule characters@>
+@y
+ @<Assign char...@>= do_nothing
+@z
+
+@x Module 235; Lines 4028 -- 4028
+*** Attach printer change file here ***
+@y
+
+@ The remaining changes can all go at the end of the program. Before getting
+onto the hardest task (namely, downloading) lets clear up the loose ends that
+were left lying about in the body of the program. First, there are a number of
+extra command options:
+
+@<If the |key|...@>=
+ else if ( key = "O") then odds := true {Print odd-numbered pages only}
+ else if ( key = "E") then evens := true {Even ditto}
+ else if ( key = "L") then begin
+ land := true ; {Print Landscape}
+ start_stuff.data[ 8] := '1' ; {bugfix, 19-dec-1990, previously 6}
+ end
+
+@ @<Glob...@>=
+ land, odds, evens: boolean ;
+
+@ @<Set init...@>=
+ land := false ;
+ odds := false ;
+ evens := false ;
+
+@ Where will the printed file go to?
+
+@<Set init...@>=
+ be_string( '.HPL') ; print_ex := buffer ;
+
+@ @<Dont sort the page but |reset| it @>=
+ L_reset( run) ;
+ Add_run ;
+ L_reset( mid) ;
+ cur_pge_ptr := son( next( mid) ) ;
+
+@ Now lets dispose of rule-setting. \TeX\ puts the reference point of a rule
+at bottom left, the HP at top left. Sizes must be rounded up.
+
+@<Find the pixel sizes and reference point@>=
+ rule_ht := round(v_conv*D_p + 0.5) ;
+ rule_wid := round(h_conv*D_q + 0.5) ;
+ D_dis := D_q ;
+ IM_dis := rule_wid ;
+ round_IM_h ( 0);
+ rule_h := IM_h ;
+ rule_v := IM_v - rule_ht ;
+
+@ @<Send it to the printer@>=
+ set_v_abs(rule_v) ;
+ set_h_abs(rule_h) ;
+ print(chr(27), '*c', rule_ht:1, 'B') ;
+ print(chr(27), '*c', rule_wid:1, 'A') ;
+ print(chr(27), '*c0P') ;
+ print_ln;
+
+@ Consider command strings.
+
+@<Set init...@>=
+ be_string ( '^[E^[&l0O' ) ; start_stuff := buffer ;
+ {Reset everything to default state}
+ be_string ( '^[(&DX' ) ; font_command := buffer ;
+ be_string ( '^[*p&DY' ) ; v_abs_com := buffer ;
+ be_string ( '^[*p&DX ' ) ; h_abs_com := buffer ;
+ stop_stuff := start_stuff ;
+ page_top := blank ;
+ pause_after := blank ;
+
+@ On the HP, we must explicitly start a new page at a set position. Also since
+rules get set before any characters, we must then reset the position.
+
+@<Set up an empty page...@>=
+ set_v_abs(0) ;
+ set_h_abs(0) ;
+
+@ @<Pause reset@>=
+ set_v_abs(0) ;
+ set_h_abs(0) ;
+
+@* Downloading, 1: reading the font file.
+
+The simplest and crudest way this could possibly be done is: read the raster
+file and load the entire font, as soon as the |font_def| command is read from
+the \.{DVI} file. On VAX/VMS, this turned out to be unbearably slow. So it is
+here changed as follows: When a |font_def| command is read, we read the whole
+raster file into an array. Then download each character before trying to print
+it. This `lazy downloading' makes the program run much faster, at the price of
+a large use of memory.
+ @^\.{TUG}boat@>
+
+@<Download a whole font@>=
+ begin
+ @<Prepare to read the |raster_file|@>
+ repeat
+ @<Get \.{GF} command |GF_com|, and do it@>
+ until GF_com = 248;
+ close_binary( raster_file) ;
+ @<Establish the new font in memory@>
+ end
+
+@ First we have to determine the file name.
+
+@<Prepare to read...@>=
+ raster_mag := round(300 * font_mag * magnification ) ;
+ if not hunt_for_size( font_name, raster_mag)
+ then font_error('cannot load this font') ;
+ @.Error: cannot load@>
+
+@ @<Medium...@>=
+ function open_font(
+ name: var_string; mag: integer; ask: boolean ): boolean;
+ begin
+ splice( raster_name, raster_def, mag) ;
+ open_font := open_and_ask(
+ raster_file, raster_indx, name, raster_name, ask) ;
+ end;
+
+@ Frequently the {\.DVI} file calls for a font at a magnification that is
+almost but not quite one of the standard sizes. So we try a few steps up or
+down before giving up. |range| is the maximum percentage that we allow the
+magnification to vary.
+
+@<Forw...@>=
+ function hunt_for_size (
+ name: var_string; mag: integer): boolean; forward ;
+
+@ @<Medium...@>= function hunt_for_size ;
+ label exit ;
+ const range = 5 ;
+ var try_mag, n , max : integer; hh: boolean;
+ begin
+ max := round( raster_mag* range / 100);
+ n := 0 ;
+ while ( n <= max) do begin
+ try_mag := mag + n ;
+ hh := open_font( name, try_mag, false) ;
+ if hh then return
+ else if ( n>0) then n:= -n
+ else n := 1 - n ;
+ end;
+ hh := open_font( name, mag, true) ;
+ exit: hunt_for_size := hh;
+ end;
+
+@ Then read the file; a horrible mess.
+
+@<Get \.{GF} command...@>=
+ GF_com := get_byte( raster) ;
+ if GF_com <= 63 then paint( GF_com)
+ else if ( GF_com >= 74) and ( GF_com <= 238) then
+ new_row( GF_com - 74 )
+ else
+
+@ Then we have the usual messy |case| statement:
+
+@d three_cases(#)==
+ #,#+1,#+2 : begin GF_par := get_integer( raster)( GF_com - # + 1 );
+ four_case_end
+
+@<Get \.{GF} command...@>=
+ case GF_com of
+ three_cases( 64)( paint( GF_par));
+ 67, 68: boc;
+ 69: eoc;
+ 70: miss_row( 0);
+ three_cases( 71)( miss_row( GF_par));
+ three_cases( 239)( skip( raster)( GF_par));
+ 242: skip( raster)( get_integer( raster)( -4)) ;
+ 243: skip( raster)( 4);
+ 244:;
+ 247: preamble;
+ 248: postamble ;
+ 245,246,249,250,251,252,253,254,255:
+ warn( 'illegal GF command, will try to continue');
+ end;
+ @.illegal GF command@>
+
+@ Now there follow lots of procedures to deal with the commands.
+
+@<Lowest...@>=
+ procedure preamble;
+ var p: byte;
+ begin
+ p:=get_byte( raster);
+ p:=get_byte( raster);
+ skip( raster)( p) ; {the introductory comment}
+ with Font_box do begin
+ L := pixel_R ;
+ R := pixel_L ;
+ T := pixel_B ;
+ B := pixel_T ;
+ end;
+ end;
+
+@#
+ procedure postamble;
+ var GF_check: integer ;
+ begin
+ skip( raster)( 8);
+ GF_check := get_integer( raster)( -4) ;
+ if (D_check<>0)and(GF_check<>0)and(D_check<>GF_check) then
+ begin warn('check sums do not agree!');
+ @.error: check sums...@>
+ display_ln('DVI check was: ', D_check, ' GF check was: ', GF_check);
+ display(' ');
+ end;
+ end;
+
+@#
+ procedure boc;
+ var q : byte; mm, nn: i_word;
+ begin
+ if GF_com = 67 then
+ begin GF_char := get_integer( raster)( 4) mod 256 ;
+ skip( raster) ( 4);
+ Boc_box.L:=get_integer( raster)( -4);
+ Boc_box.R:=get_integer( raster)( -4);
+ Boc_box.B:=get_integer( raster)( -4);
+ Boc_box.T:=get_integer( raster)( -4);
+ end
+ else begin GF_char:=get_byte( raster);
+ q:=get_byte( raster); Boc_box.R:=get_byte( raster);
+ Boc_box.L:=Boc_box.R-q;
+ q:=get_byte( raster); Boc_box.T:=get_byte( raster);
+ Boc_box.B:=Boc_box.T-q;
+ end;
+ @<Clear the image@>
+ end;
+
+@ Now lets assign names to variables. In order to try to clear up the muddle
+of boundaries for character cells, I introduce a concept of a ``box'', not the
+same as a \TeX\ box. The fields represent the boundaries that must contain all
+the black pixels of any character.
+
+@<Const...@>=
+ pixel_L = -300; pixel_R = 700; pixel_B = -300; pixel_T = 700;
+
+@ @<Types...@>=
+ @!x_coord=pixel_L..pixel_R;
+ @!y_coord=pixel_B..pixel_T;
+ box = packed record
+ L,R: x_coord;
+ T,B: y_coord;
+ end;
+ dir_entry = packed record
+ point: integer;
+ h_offset, v_offset, wid, ht : i_word;
+ end;
+
+@ @<Glob...@>=
+ Boc_box, {Limits of char. cell declared in |BOC| command}
+ char_box, {actual boundaries of char. cell}
+ Font_box: box; {The font cell. This is the smallest cell that
+ contains the reference point and any char. cell in the font}
+ GF_com, GF_par, GF_char : byte;
+ glyphs: packed array[1..max_glyph] of byte ;
+ glyph_ptr: integer;
+ raster_mag: integer;
+ directory : array[D_font_ptr, D_char_ptr ] of dir_entry ;
+ C_width : integer;
+
+@ @<Set init...@>=
+ glyph_ptr := 1 ;
+ for in_i := 0 to max_D_fonts do
+ for in_j := 0 to max_D_char do
+ directory[ in_i, in_j].point := sentry ;
+ {Mark everything as unprintable}
+
+@ The definition of \.{GF} files refers to two registers, $(G_m,G_n)$, which
+hold row and column numbers. We also need to remember |paint_switch|, which
+is either |black| or |white|.
+
+@<Glob...@>=
+ @!pixels: packed array [y_coord,x_coord] of pixel;
+ @!G_m: x_coord;
+ @!G_n: y_coord; {current state values}
+ @!paint_switch: pixel;
+
+@ We'll need a big array of pixels to hold the character image. Each pixel
+should be represented as a single bit in order to save space. Different
+systems may prefer the following definitions, while others may do better using
+the |boolean| type and constants.
+ @^system dependencies@>
+
+@d white==false
+@d black==true
+@d swop == paint_switch:=not paint_switch
+{could also be |if paint_switch=black then paint_switch:=white
+else paint_switch:=black|}
+
+@<Types...@>=
+@!pixel=boolean ;
+ {could also be |white..black|}
+
+@ Maybe there's a faster way to do this on your system. Note that the only
+part of the |image_array| that we clear is the part that the current character
+may use. Thus, the rest of this program may not look outside the area
+delimited by |Boc_box| and expect to see anything but junk.
+@^system dependencies@>
+
+@<Clear the image@>=
+ begin
+ for nn := Boc_box.B to Boc_box.T do
+ for mm := Boc_box.L to Boc_box.R do
+ pixels[nn,mm] := white;
+ G_n := Boc_box.T ;
+ G_m := Boc_box.L ;
+ char_box.L := pixel_R ;
+ char_box.R := pixel_L ;
+ char_box.B := pixel_T ;
+ char_box.T := pixel_B ;
+ directory[ nf, GF_char].point := 0 ;
+ {Indicates a blank character}
+ end
+
+@ @<Lowest...@>=
+ procedure paint( p: integer);
+ var m, k: integer;
+ begin
+ if G_m+p> pixel_R then
+ warn('character extends too far to the right')
+ @.character extends...@>
+ else if paint_switch = white then
+ else begin
+ m := G_m + p -1 ;
+ if char_box.T < G_n then char_box.T := G_n ;
+ if char_box.B > G_n then char_box.B := G_n ;
+ if char_box.L > G_m then char_box.L := G_m ;
+ for k:= G_m to m do
+ pixels[G_n, k] := black ;
+ if char_box.R < m then char_box.R := m ;
+ end;
+ swop;
+ G_m := G_m +p ;
+ end;
+
+@#
+procedure new_row( p:integer);
+ begin
+ decr(G_n);
+ G_m:=Boc_box.L + p;
+ paint_switch:=black;
+ end;
+
+@# procedure miss_row( p: integer);
+ begin
+ G_n:=G_n - p ;
+ G_m:= Boc_box.L;
+ paint_switch:=white;
+ end;
+
+@* Downloading, 2: Transfer characters into memory.
+
+After we have read the character, we must transfer it into memory. First,
+stretch the Font box to include the current characters box.
+
+@<Lowest...@>=
+ procedure eoc;
+ var x, y : integer;
+ cur_byt: byte ;
+ q: i_word ;
+ begin
+ if char_box.R >= char_box.L {If not, the character is unprintable}
+ then begin
+ if char_box.L < Font_box.L then Font_box.L := char_box.L ;
+ if char_box.B < Font_box.B then Font_box.B := char_box.B ;
+ if char_box.R > Font_box.R then Font_box.R := char_box.R ;
+ if char_box.T > Font_box.T then Font_box.T := char_box.T ;
+ @<Transfer the dimensions of the character@>
+ @<Transfer the |pixels| into |glyphs|@>
+ end;
+ end;
+
+@ In landscape mode, the character must be rotated. The |directory| will
+contain the dimensions to be downloaded; these do depend on orientation.
+|char_box| describes the logical character which does not depend on
+orientation.
+
+@<Transfer the dimensions...@>=
+ with directory[nf, GF_char] do begin
+ point := glyph_ptr;
+ if land then begin
+ h_offset := - char_box.T ;
+ v_offset := char_box.R ;
+ ht := char_box.R - char_box.L +1 ;
+ wid := char_box.T - char_box.B +1 ;
+ end else begin
+ h_offset := char_box.L ;
+ {\TeX\ and the HP measure this in opposite directions}
+ v_offset := char_box.T ;
+ wid := char_box.R - char_box.L +1 ;
+ ht := char_box.T - char_box.B +1 ;
+ end;
+ end;
+
+@ Likewise the |glyphs| array will contain the pixels to be downloaded; these
+also depend on orientation. Looking at the logical character, |x| is the
+horizontal coordinate and |y| the vertical. In portrait mode the pixels must
+be sent starting at the top left corner and going left to right along the top
+row. In Landscape mode you must start at the top right corner and go down the
+right hand column. Each row or column must be padded to |8n| bits.
+
+@<Transfer the |pixels|...@>=
+ if land then begin
+ for x := char_box.R downto char_box.L do begin
+ cur_byt := 0 ;
+ q := 0 ;
+ for y := char_box.T downto char_box.B do begin
+ if pixels[ y, x] then cur_byt := cur_byt + powers[q] ;
+ if q < 7 then incr( q)
+ else begin
+ glyphs[glyph_ptr] := cur_byt ; incr( glyph_ptr) ; cur_byt := 0;
+ q := 0 ;
+ end;
+ end;
+ if q > 0 then
+ begin
+ glyphs[glyph_ptr] := cur_byt ; incr( glyph_ptr) ; cur_byt := 0;
+ end;
+ end;
+ end else
+
+@ @<Transfer the |pixels|...@>=
+ begin
+ for y := char_box.T downto char_box.B do begin
+ cur_byt := 0 ;
+ q := 0 ;
+ for x := char_box.L to char_box.R do begin
+ if pixels[ y, x] then cur_byt := cur_byt + powers[q] ;
+ if q < 7 then incr( q)
+ else begin
+ glyphs[glyph_ptr] := cur_byt ; incr( glyph_ptr) ; cur_byt := 0;
+ q := 0 ;
+ end;
+ end;
+ if q > 0 then
+ begin
+ glyphs[glyph_ptr] := cur_byt ; incr( glyph_ptr) ; cur_byt := 0;
+ end;
+ end;
+ end ;
+
+@ @<Set init...@>=
+ powers[0] := 128 ;
+ for in_i := 1 to 7 do powers[in_i] := powers[in_i-1] div 2 ;
+
+@ @<Glob...@>= powers: array[0..7] of byte ;
+
+@ @<Const...@>= max_glyph = 1000000 ;
+
+@ @<Clean...@>=
+ display_ln
+ ('Used ', glyph_ptr:1, ' bytes of font memory out of ', max_glyph:1);
+
+@ Finally, does the printer have enough room for the font? The HP allows 32
+fonts per job and 395 KB memory. I have not checked the restriction of only 16
+fonts per page.
+
+@<Establish...@>=
+ incr(PR_dl_font ) ;
+ if PR_dl_font > max_dl_font then
+ font_error('tried to load too many fonts') ;
+ @.Error: tried to load@>
+
+@ @<Set init...@>=
+ PR_dl_font := min_dl_font ;
+ PR_mem_used := 0 ;
+ PR_max_mem := 395000;
+ be_string( '^[*c&DD' ) ; font_start := buffer ;
+
+@ @<Glob...@>= PR_dl_font, PR_max_mem, PR_mem_used: integer ;
+ font_start: var_string ;
+
+@ If the error tests succeed, then we come here. Before we can load any
+characters, we have to send a command to the printer to declare the new font.
+This section assembles the necessary information. |dir_start[ nf]| should be
+pointing to the start of the font directory. The main task is that the printer
+must be given the size of a character cell; this must be large enough to
+contain all the characters. First we specify the font ID. This is a number by
+which the printer will refer to the font after loading it.
+
+@<Establish...@>=
+ print_command( font_start, PR_dl_font, '^') ;
+ print(chr(27), ')s26W' );
+ {A create font command}
+ prw(26);
+ prw(1) ; { 8 bit chars}
+ prw(0) ;
+ with Font_box do begin
+ if L > 0 then L := 0 ;
+ if B > 0 then B := 0 ;
+ if R < 0 then R := 0 ;
+ if T < 0 then T := 0 ; {Stretch the Font box to include the ref. point}
+ prw( T) ;
+ prw( R - L + 1) ; {width}
+ prw( T - B + 1) ; {height}
+ end;
+ if land then prw( 257) else prw(1) ; {proportional spaced}
+ prw(277) ;
+ for font_i := 1 to 5 do prw(0) ;
+ {The HP needs these parameters, but they serve no purpose known to me}
+
+@ Finally, we must establish the map from \TeX\ characters to printers
+characters in the new font.
+
+@<Establish...@>=
+ incr(top_code) ; {get a new coding scheme}
+ scheme[ nf] := top_code ;
+ alphabet(0, 33, top_code, PR_dl_font, 190);
+ alphabet(33, 95, top_code, PR_dl_font, 33);
+ for tex_chr := 0 to max_D_char do
+ codes[ top_code, tex_chr].breadth := down_loaded ;
+
+@ @<Glob...@>= top_code: integer ;
+
+@ @<|font_def| vars@>= tex_chr, font_i: integer;
+
+@ @<Set init...@>= top_code := 1 ;
+
+@* Downloading, 3: Lazy downloading.
+
+The idea is to load only those characters in each font that actually will be
+printed. It is obviously essential to ensure that each character gets loaded
+before being printed, and only once. This is done in the procedure
+|set_character|. The \TeX\ character is number |c_num| in font |D_font|,
+but the printer character is addressed by |cod|.
+
+The first job is to update the directory info. for the character, and assemble
+its size parameters.
+
+@<Enter a download...@>=
+ with directory [ D_font, c_num] do begin
+ if point < 0 then begin warn(
+ 'tried to print a non-existent character, number: ' , c_num:1) ;
+ codes[ cur_scheme, c_num].breadth := bad_char ;
+ end else begin
+ C_length := ht * (( wid + 7) div 8) ; {length of data}
+ C_width := D_width[ D_font, c_num] ;
+ C_delta := round(C_width * h_conv) ;
+ codes[ cur_scheme, c_num].breadth := C_delta ;
+ cod.breadth := C_delta ;
+ PR_mem_used := PR_mem_used + C_length + 64 ; {approximate}
+ if PR_mem_used > PR_max_mem then
+ warn('overflowed printer memory, will try to proceed regardless') ;
+ @.Error: overflowed printer memory@>
+ @.Error: tried to print...@>
+
+@ @<Clean...@>=
+ display_ln
+ ('Used ', PR_mem_used:1, ' bytes of printers memory out of ',
+ PR_max_mem:1) ;
+
+@ @<Glob...@>=
+ C_length, C_delta : integer;
+ char_start, char_head: var_string ;
+
+@ @<Set init...@>=
+ be_string( '^[*c&DE' ) ; char_start := buffer ;
+ be_string( '^[(s&DW' ) ; char_head := buffer ;
+
+@ Now we must not let the character get downloaded twice, so we put the
+correct value into its |breadth|; we must also update the current |cod|.
+
+@ Now we send the character header. First, tell the printer which character
+will be downloaded. \TeX\ fonts usually have 128 characters and HP fonts have
+either 96 or 192. The permitted values for HP characters are 33..127 and
+160..255 according to the manual but appendix B says 160 and some others are
+undefined. So we map \TeX\ characters 0..32 onto 190..222 .
+
+@<Enter a download...@>=
+ { N.B. still |with directory [ D_font, c_num]| }
+ print_command( font_start, cod.IM_font, '^') ;
+ {Specify printers font identifier}
+ print_command( char_start, cod.IM_char, '^') ;
+ print_command( char_head, (C_length + 16), '^') ;
+ {and the character}
+ prw(1024);
+ prw(14*256 + 1);
+ if land then prw( 256 ) else prw(0);
+ prw(h_offset) ;
+ prw(v_offset);
+ prw(wid) ;
+ prw(ht) ;
+ prw(4 * C_delta) ;
+
+@ And at long last we can send the pixels!!
+
+@<Enter a download...@>=
+ for d_i := point to point+C_length-1 do
+ print(chr(glyphs[ d_i] )) ;
+ print_ln ;
+end; end;
+
+@ Nearly all the HP's arguments come as signed 16-bit words, to be printed in
+two-complement notation. This procedure prints them.
+
+@<Low...@>=
+ procedure prw( n: i_word);
+ var nn: integer ;
+ begin
+ if (n>= 0) then nn := n
+ else nn := n + 65536 ;
+ print( zchr(nn div 256));
+ print( zchr(nn mod 256));
+ end ;
+@z
diff --git a/dviware/crudetype/version3/makefile b/dviware/crudetype/version3/makefile
new file mode 100644
index 0000000000..45e6206802
--- /dev/null
+++ b/dviware/crudetype/version3/makefile
@@ -0,0 +1,238 @@
+# Makefile for Unix version of CRUDETYPE.
+#
+# {{ Originally written by P.King, much altered by RMD}}
+
+#
+# COPYRIGHT ( C ) P. King, Heriot-Watt University, 1988.
+#
+# Permission is given to any person to make and distribute copies of this
+# software, subject to the following conditions:
+#
+# 1. All copies of the software must carry an exact copy of this notice.
+#
+# 2. This software is distributed free of charge, "AS IS" with absolutely no
+# guarantee of performance. Any persons receiving or using this software must do
+# so entirely at their own risk. Neither the authors nor their institutions
+# accept any liability for any defects of this software, or for any consequential
+# loss or damage however caused.
+#
+# 3. Any person who changes this software must clearly mark it as modified and
+# add a note describing the changes made.
+#
+#
+# They depend on the Berkeley implementation of Pascal, and have only been tried
+# on BSD4.2 UNIX.
+#
+#
+#
+#
+#
+# Makefile:
+# --------------------------------
+#
+# Adapted from:
+# Makefile for TeX82 distribution, subdirectory `=TeXware'
+# version for 4.2 bsd
+#
+# This file makes CRUDETYPE from its WEB source.
+#
+# Note: The -J option on the 'pc' commands below is the only way to
+# 'pc' to use the -J option to the assembler (which makes it
+# do the sensible thing with branches). This flag is not
+# documented, which is correct, since 'pc' should really be
+# using it all of the time... (Grrr..)
+#
+# Note: several parts of this Makefile are unsatisfactory; I could
+# not get them to work.
+#
+#
+# Before using this makefile, change these macros to conform to
+# local practice:
+
+################################################################
+# Which image(s) do you want to build? See README for some names
+################################################################
+
+all: $(IMAGES)
+
+POSSIBLE_IMAGES= crudetype crude-p noscheme-p noscheme-c hpgf
+
+IMAGES =
+
+################################################################
+# Where does the S-ware live? In TEX version3 there are files:
+# site.h and defaults.h in the top level directory of TEX that
+# describe your machine.
+################################################################
+
+SITEDIR= /tex/ver3
+SITE_H=$(SITEDIR)/site.h
+DEFT_H=$(SITEDIR)/defaults.h
+
+# I had to rewrite common.defines
+
+COMMONDIR= .
+COMM_DEFS=$(COMMONDIR)/w2c.defines
+
+# Where to install things
+
+BINDIR=/tex
+MANDIR=/usr/man/manl
+
+################################################################
+# Compiler options
+################################################################
+
+OPT= -O
+CFLAGS=$(OPT) -I$(SITEDIR)
+PFLAGS= -J -g -C
+LDFLAGS= $(OPT)
+INSTALL = cp -m 555
+
+################################################################
+# Names of compilers etc
+################################################################
+
+CC = cc
+PC = pc
+TANGLE=-tangle
+RM=/bin/rm
+YACC=yacc # You can substitute "bison -y" for "yacc" if you like
+LEX=lex # Note: If you're going to use flex, compile web2cl.c with "-DFLEX"
+
+
+.c.o:
+ $(CC) $(CFLAGS) -c $*.c
+
+.p.o:
+ $(PC) $(PFLAGS) -c $*.p
+
+
+################################################################
+# This is what I regard as the 'normal' version of Crudetype, using
+# my modified web2c.
+################################################################
+
+CRUDE_C_OBJS= crude-c.o w2c-ext.o w2c-main.o
+
+crudetype: $(CRUDE_C_OBJS)
+ cc $(LDFLAGS) -o $@ $(CRUDE_C_OBJS)
+
+$(CRUDE_C_OBJS): $(SITE_H) $(DEFT_H)
+
+crude-c.c: crude-c.p w2c $(COMM_DEFS)
+ w2c -d$(COMM_DEFS) <crude-c.p >crude-c.c
+
+crude-c.p: crudetype.web unix-c.ch
+ $(TANGLE) crudetype unix-c
+ mv crudetype.p crude-c.p
+
+
+################################################################
+#Compile w2c itself
+################################################################
+
+WC_OBJS= w2cy.o w2cl.o w2c.o
+
+
+w2c: $(WC_OBJS)
+ $(CC) $(LDFLAGS) -o w2c $(WC_OBJS) -ll
+
+$(WC_OBJS): w2c-symtab.h w2cy.h w2c.h
+
+w2cl.c: w2c.lex $(SITE_H) $(DEFT_H)
+ $(LEX) w2c.lex
+ mv -f lex.yy.c w2cl.c
+
+w2cy.c: w2c.yacc $(SITE_H) $(DEFT_H)
+ $(YACC) -d w2c.yacc
+ mv -f y.tab.c w2cy.c
+ -cmp y.tab.h w2cy.h || cp y.tab.h w2cy.h
+
+################################################################
+# Version using pc is called crude-p
+################################################################
+
+
+crude-p: crude-p.o unixext.o
+ $(PC) $(PFLAGS) -o $@ crude-p.o unixext.o $(PCLIB)
+
+crude-p.p: crudetype.web unix-pas.ch
+ $(TANGLE) crudetype unix-pas
+ mv crudetype.p crude-p.p
+
+
+################################################################
+# YEUCHY mess for no coding schemes
+################################################################
+
+noscheme-p: noscheme-p.o unixext.o
+ $(PC) $(PFLAGS) -o $@ noscheme-p.o unixext.o $(PCLIB)
+
+noscheme-p.p: noscheme.web unix-pas.ch
+ $(TANGLE) noscheme unix-pas
+ mv noscheme.p noscheme-p.p
+
+noscheme.web: crudetype.web noscheme.add
+ cat crudetype.web noscheme.add > $@
+
+################################################################
+# More mess. Noscheme compiled with W2C
+#
+################################################################
+
+NOSC_OBJS= noscheme-c.o w2c-ext.o w2c-main.o
+
+noscheme-c: $(NOSC_OBJS)
+ cc $(LDFLAGS) -o $@ $(NOSC_OBJS)
+
+$(NOSC_OBJS): $(SITE_H) $(DEFT_H)
+
+noscheme-c.c: noscheme-c.p w2c $(COMM_DEFS)
+ w2c -d$(COMM_DEFS) <noscheme-c.p >noscheme-c.c
+
+noscheme-c.p: noscheme.web unix-c.ch
+ $(TANGLE) noscheme unix-c
+ mv noscheme.p noscheme-c.p
+
+
+################################################################
+# Typical example of a printer changefile
+################################################################
+
+
+hpgf: hpgf.o unixext.o
+ $(PC) $(PFLAGS) -o hpgf hpgf.o unixext.o $(PCLIB)
+
+hpgf.p: crudetype.web unixhp.ch
+ $(TANGLE) crudetype unixhp
+ mv crudetype.p hpgf.p
+
+unixhp.ch: unix-pas.ch hpgf.ch
+ cat unix-pas.ch hpgf.ch > $@
+
+
+################################################################
+# Install etc. You probably want to alter the installed names.
+################################################################
+
+install: $(IMAGES)
+ for i in $(POSSIBLE_IMAGES) ; do\
+ if -i $$i \
+ $(INSTALL) $$i $(BINDIR); \
+ fi \
+ done
+ $(INSTALL) unixcru.man $(MANDIR)crudetype.l
+
+
+veryclean: clean
+ $(RM) -f crude-c.c noscheme-c.c
+
+clean:
+ $(RM) -f *.p *.o $(POSSIBLE_IMAGES) \
+ y.* lex.* w2c w2cy.c w2cy.h w2cl.c coerce.h \
+ noscheme.web unixhp.ch \
+ answers.tex index.tex \
+ *.dvi *.lpr *.log *~ *#
+
+
diff --git a/dviware/crudetype/version3/mytangle.ch b/dviware/crudetype/version3/mytangle.ch
new file mode 100644
index 0000000000..13870c7caf
--- /dev/null
+++ b/dviware/crudetype/version3/mytangle.ch
@@ -0,0 +1,413 @@
+TANGLE change file for Vax/VMS
+Copyright (C) 1983 by David Fuchs. All rights are reserved.
+
+MODIFICATION RECORD
+~~~~~~~~~~~~~~~~~~~
+21-NOV-1988 CNK <tex@cran.rmcs>
+ Set |last_text_char| = 255 (from 127).
+ See TeXhax vol. 88, no. 100
+01-DEC-1988 CNK <tex@cran.rmcs>
+ Increase max_toks to 55000
+12-DEC-1988 BHK <tex@cran.rmcs>
+ Emit VMS exit status
+14-AUG-1989 Alien@ESSEX.ESE
+ Modify for tangle 2.9.
+ Default extension for pool file now .POOL
+29-AUG-1989 BHK <tex@cran.rmcs>
+ Increase max_names to 5000
+28-SEP-1989 BHK <tex@cran.rmcs>
+ Modify for tangle 3
+03-NOV-1989 BHK <tex@cran.rmcs>
+ Modify for tangle 4 (eight-bit ASCII, etc)
+24-SEP-1990 BHK <tex@cran.rmcs>
+ Modify for tangle v4.1
+
+@x
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\title{TANGLE changes for Vax/VMS}
+@z
+
+@x <<<<<Modified 04-NOV-1989 by BHK <tex@uk.ac.cran.rmcs> for V4>>>>>
+@d banner=='This is TANGLE, Version 4.1'
+@y
+@d banner=='This is TANGLE, Vax/VMS Version 4.1'
+@z
+
+@x
+and the string pool output goes to file |pool|.
+@y
+and the string pool output goes to file |pool|.
+VMS requires us to mention |input| and |output| in the program header, too.
+They are used for terminal input and output.
+@z
+
+@x
+program TANGLE(@!web_file,@!change_file,@!Pascal_file,@!pool);
+@y
+program TANGLE(@!input,@!output,@!web_file,@!change_file,@!Pascal_file,
+ @!pool);
+@z
+
+@x
+@<Compiler directives@>=
+@{@&$C-,A+,D-@} {no range check, catch arithmetic overflow, no debug overhead}
+@!debug @{@&$C+,D+@}@+ gubed {but turn everything on when debugging}
+@y
+On Vax/VMS, things are a bit different.
+
+@<Compiler directives@>=
+@=[check(none),inherit('sys$library:starlet')]@> {no debug overhead, but...}
+debug @=[check(all),inherit('sys$library:starlet')]@> gubed {turn everything on when debugging}
+@z
+
+@x
+@d othercases == others: {default for cases not listed explicitly}
+@y
+@d othercases == otherwise {Vax/VMS default for cases not listed
+ explicitly}
+@z
+
+@x <<<<< Added 01-DEC-1988 by CNK, modified 29-AUG-1989 by BHK <tex@cran.rmcs> >>>>>
+@!max_toks=50000; {|1/zz| times the number of bytes in compressed \PASCAL\ code;
+ must be less than 65536}
+@!max_names=4000; {number of identifiers, strings, module names;
+ must be less than 10240}
+@y
+@!max_toks=55000; {|1/zz| times the number of bytes in compressed \PASCAL\ code;
+ must be less than 65536}
+@!max_names=5000; {number of identifiers, strings, module names;
+ must be less than 10240}
+@z
+
+@x
+@!text_file=packed file of text_char;
+@y
+@!text_file=text;
+@z
+
+@x
+@d print_ln(#)==write_ln(term_out,#) {`|print|' and then start new line}
+@d new_line==write_ln(term_out) {start new line}
+@y
+@d print_ln(#)==write_ln(term_out,#,chr(13),chr(10))
+ {`|print|' and then start new line}
+@d new_line==write_ln(term_out,chr(13),chr(10)) {start new line}
+@z
+
+@x
+rewrite(term_out,'TTY:'); {send |term_out| output to the terminal}
+@y
+open(term_out,'SYS$OUTPUT',@=carriage_control:=none@>);
+rewrite(term_out);
+@z
+
+@x
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+@y
+@d update_terminal == write_ln(term_out) {empty the terminal output buffer}
+@z
+
+@x
+@ The following code opens |Pascal_file| and |pool|.
+Since these files were listed in the program header, we assume that the
+\PASCAL\ runtime system has checked that suitable external file names have
+been given.
+@^system dependencies@>
+
+@<Set init...@>=
+rewrite(Pascal_file); rewrite(pool);
+@y
+@ The following code opens |Pascal_file| and |pool|.
+Acutally, on Vax/VMS this task is put off until later.
+@^system dependencies@>
+@z
+
+@x
+@ Input goes into an array called |buffer|.
+
+@<Globals...@>=@!buffer: array[0..buf_size] of ASCII_code;
+@y
+@ Input goes into an array called |buffer|.
+Actually, it is first read into |temp_buffer|.
+@<Glob...@>=
+@!buffer: array[0..buf_size] of ASCII_code;
+@!temp_buffer: varying [buf_size] of char;
+@z
+
+@x
+@p function input_ln(var f:text_file):boolean;
+ {inputs a line or returns |false|}
+var final_limit:0..buf_size; {|limit| without trailing blanks}
+begin limit:=0; final_limit:=0;
+if eof(f) then input_ln:=false
+else begin while not eoln(f) do
+ begin buffer[limit]:=xord[f^]; get(f);
+ incr(limit);
+ if buffer[limit-1]<>" " then final_limit:=limit;
+ if limit=buf_size then
+ begin while not eoln(f) do get(f);
+ decr(limit); {keep |buffer[buf_size]| empty}
+ if final_limit>limit then final_limit:=limit;
+ print_nl('! Input line too long'); loc:=0; error;
+@.Input line too long@>
+ end;
+ end;
+ read_ln(f); limit:=final_limit; input_ln:=true;
+ end;
+end;
+@y
+On Vax/VMS we first read a line into |temp_buffer|, since that's faster.
+
+@p function input_ln(var f:text_file):boolean;
+ {inputs a line or returns |false|}
+var i,@!l:0..buf_size;
+begin limit:=0;
+if eof(f) then input_ln:=false
+else begin
+ read(f,temp_buffer);
+ l:=temp_buffer.@=length@>;
+ for i:=1 to l do begin
+ buffer[i-1]:=xord[temp_buffer[i]];
+ if buffer[i-1]<>" " then limit:=i;
+ end;
+ if not eoln(f) then begin
+ print_nl('! Input line too long'); error;
+@.Input line too long@>
+ end
+ else read_ln(f);
+ input_ln:=true;
+ end;
+end;
+@z
+
+@x
+@d ww=2 {we multiply the byte capacity by approximately this amount}
+@y
+@d ww=3 {we multiply the byte capacity by approximately this amount}
+@z
+
+@x
+for k:=1 to break_ptr do write(Pascal_file,xchr[out_buf[k-1]]);
+write_ln(Pascal_file); incr(line);
+@y
+for k:=1 to break_ptr do out_temp_buffer[k]:=xchr[out_buf[k-1]];
+write_ln(Pascal_file,substr(out_temp_buffer,1,break_ptr)); incr(line);
+@z
+
+@x
+@!term_in:text_file; {the user's terminal as an input file}
+@y
+@z
+
+@x
+@<Set init...@>=
+@y
+@d term_in==input
+
+@<Set init...@>=
+@z
+
+@x
+reset(term_in,'TTY:','/I'); {open |term_in| as the terminal, don't do a |get|}
+@y
+@z
+
+@x save pool and Pascal files only if they were written to.
+if string_ptr>256 then @<Finish off the string pool file@>;
+stat @<Print statistics about memory usage@>;@+tats@;@/
+@t\4\4@>{here files should be closed if the operating system requires it}
+@y
+if history<fatal_message then begin
+ if string_ptr>256 then begin @<Finish off the string pool file@>;
+ close(pool,@=disposition:=save@>,@=error:=continue@>);
+ end;
+ close(Pascal_file,@=disposition:=save@>,@=error:=continue@>);
+ end;
+stat @<Print statistics about memory usage@>;@+tats@;@/
+@z
+
+
+@x <<<<< Added 12-DEC-1988 by BHK <tex@cran.rmcs> >>>>>
+@ Some implementations may wish to pass the |history| value to the
+operating system so that it can be used to govern whether or not other
+programs are started. Here we simply report the history to the user.
+@^system dependencies@>
+
+@<Print the job |history|@>=
+case history of
+spotless: print_nl('(No errors were found.)');
+harmless_message: print_nl('(Did you see the warning message above?)');
+error_message: print_nl('(Pardon me, but I think I spotted something wrong.)');
+fatal_message: print_nl('(That was a fatal error, my friend.)');
+end {there are no other cases}
+@y
+@ This implementation passes the |history| value to the
+operating system so that it can be used to govern whether or not other
+programs are started; we also report the history to the user here.
+@^system dependencies@>
+
+@d VAX_exit==@=$exit@>
+@d VAX_ss_normal==@= sts$k_success @>
+@d VAX_ss_warning==@= sts$k_warning + sts$m_inhib_msg @>
+@d VAX_ss_error==@= sts$k_error + sts$m_inhib_msg @>
+@d VAX_ss_fatal==@= sts$k_severe + sts$m_inhib_msg @>
+
+@<Print the job |history|@>=
+case history of
+spotless: begin print_nl('(No errors were found.)');
+ VAX_exit(VAX_ss_normal) end; { Everything OK! }
+harmless_message: begin print_nl('(Did you see the warning message above?)');
+ VAX_exit(VAX_ss_warning) end;
+error_message: begin
+ print_nl('(Pardon me, but I think I spotted something wrong.)');
+ VAX_exit(VAX_ss_error) end;
+fatal_message: begin print_nl('(That was a fatal error, my friend.)');
+ VAX_exit(VAX_ss_fatal) end {there are no other cases}
+end;
+@z
+
+@x
+This module should be replaced, if necessary, by changes to the program
+that are necessary to make \.{TANGLE} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous modules preserve the module numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new modules, can be inserted here; then only the index
+itself will get a new module number.
+@y
+Here are the remaining changes to the program
+that are necessary to make \.{TANGLE} work on Vax/VMS.
+
+
+@ This variable is for speeding up the output routine.
+
+@<Glob...@>=
+@!out_temp_buffer:packed array [1..out_buf_size] of char;
+
+@ On Vax/VMS we need the following special definitions, types, variables
+and procedures to be able to get the file name from the command line,
+or to prompt for them. We also define here those symbols required to be
+able to emit status on exit.
+
+@d VAX_volatile==@=volatile@>
+@d VAX_immed==@=%immed @>
+@d VAX_external==@=external@>
+@d VAX_stdescr==@=%stdescr @>
+@d VAX_lib_get_foreign==@= lib$get_foreign@>
+@d VAX_length==@=length @>
+
+@ @<Local...@>=
+@!command_line:packed array[1..300] of char;
+@!cmd_len:sixteen_bits;
+@!cmd_i:integer;
+@!file_name,@!default_file_name:varying [300] of char;
+@!ask,@!got_file_name: boolean;
+
+@ Here is the library procedure that gets the user's command line.
+
+@<Error...@>=
+[VAX_external] function VAX_lib_get_foreign(
+ VAX_stdescr cmdlin:[VAX_volatile] packed array [$l1..$u1:integer] of char
+ := VAX_immed 0;
+ VAX_stdescr prompt:[VAX_volatile] packed array [$l2..$u2:integer] of char
+ := VAX_immed 0;
+ var len : [VAX_volatile] sixteen_bits := VAX_immed 0;
+ var flag : [VAX_volatile] integer := VAX_immed 0)
+ :integer; extern;
+
+@ We get the external file names, and then call |open|
+to associate an external file with each file variable.
+
+@<Set init...@>=
+cmd_i:=0;
+cmd_len := 0 ;
+VAX_lib_get_foreign(command_line,,cmd_len,cmd_i);
+cmd_i:=1; while (cmd_i<=cmd_len) and (command_line[cmd_i]=' ') do incr(cmd_i);
+got_file_name:=cmd_i<=cmd_len;
+if got_file_name then
+ default_file_name:=substr(command_line,cmd_i,cmd_len-cmd_i+1);
+
+if got_file_name then begin
+ file_name:=default_file_name+'.WEB';
+ open(web_file,file_name,@=readonly@>,@=error:=continue@>);
+ ask:=status(web_file)<>0;
+ if ask then write_ln('Couldn''t open ',file_name);
+ end
+else ask:=true;
+while ask do begin
+ got_file_name:=false;
+ write('Web file: ');
+ if eof then begin mark_fatal; jump_out; end;
+ read_ln(file_name);
+ open(web_file,file_name,@=readonly@>,@=error:=continue@>);
+ ask:=status(web_file)<>0;
+ if ask then write_ln('Couldn''t open ',file_name);
+ end;
+
+if got_file_name then begin
+ file_name:=default_file_name+'.CH';
+ open(change_file,file_name,@=readonly@>,@=error:=continue@>);
+ ask:=status(change_file)>0; {can be empty}
+ if ask then write_ln('Couldn''t open ',file_name);
+ end
+else ask:=true;
+while ask do begin
+ write('Change file: ');
+ if eof then begin mark_fatal; jump_out; end;
+ read_ln(file_name);
+ if file_name.VAX_length=0 then file_name:='NL:';
+ open(change_file,file_name,@=readonly@>,@=error:=continue@>);
+ ask:=status(change_file)>0;
+ if ask then write_ln('Couldn''t open ',file_name);
+ end;
+
+if got_file_name then begin
+ cmd_i:=1;
+ for cmd_len:=1 to default_file_name.VAX_length do
+ if (default_file_name[cmd_len]=']')
+ or (default_file_name[cmd_len]=':')
+ then cmd_i:=cmd_len+1;
+ if cmd_i<=default_file_name.VAX_length then
+ default_file_name:=substr(default_file_name,cmd_i,
+ default_file_name.VAX_length-cmd_i+1);
+ end;
+
+if got_file_name then begin
+ file_name:=default_file_name+'.PAS';
+ open(Pascal_file,file_name,@=new,disposition:=delete@>,
+ @=error:=continue@>);
+ ask:=status(Pascal_file)>0;
+ if ask then write_ln('Couldn''t open ',file_name);
+ end
+else ask:=true;
+while ask do begin
+ write('Pascal file: ');
+ if eof then begin mark_fatal; jump_out; end;
+ read_ln(file_name);
+ open(Pascal_file,file_name,@=new,disposition:=delete@>,
+ @=error:=continue@>);
+ ask:=status(Pascal_file)>0;
+ if ask then write_ln('Couldn''t open ',file_name);
+ end;
+
+if got_file_name then begin
+ file_name:=default_file_name+'.POOL';
+ open(pool,file_name,@=new,disposition:=delete@>,@=error:=continue@>);
+ ask:=status(pool)>0;
+ if ask then write_ln('Couldn''t open ',file_name);
+ end
+else ask:=true;
+while ask do begin
+ write('Pool file: ');
+ if eof then begin mark_fatal; jump_out; end;
+ read_ln(file_name);
+ open(pool,file_name,@=new,disposition:=delete@>,@=error:=continue@>);
+ ask:=status(pool)>0;
+ if ask then write_ln('Couldn''t open ',file_name);
+ end;
+
+rewrite(Pascal_file); rewrite(pool);
+@z
diff --git a/dviware/crudetype/version3/mytangle.web b/dviware/crudetype/version3/mytangle.web
new file mode 100644
index 0000000000..131fa1b19b
--- /dev/null
+++ b/dviware/crudetype/version3/mytangle.web
@@ -0,0 +1,3513 @@
+% This program by D. E. Knuth is not copyrighted and can be used freely.
+% Version 0 was released in December, 1981.
+% Version 1 was released in September, 1982, with version 0 of TeX.
+% Slight changes were made in October, 1982, for version 0.6 of TeX.
+% Version 1.2 added @@= and @@\ and introduced {:nnn} comments (December, 1982).
+% Version 1.4 added "history" (February, 1983).
+% Version 1.5 conformed to TeX version 0.96 and fixed @@\ (March, 1983).
+% Version 1.7 introduced the new change file format (June, 1983).
+% Version 2.0 was released in July, 1983, with version 0.999 of TeX.
+% Version 2.5 was released in November, 1983, with version 1.0 of TeX.
+% Version 2.6 fixed a bug: force-line-break after a constant (August, 1984).
+% Version 2.7 fixed the definition of check_sum_prime (May, 1985).
+% Version 2.8 fixed a bug in change_buffer movement (August, 1985).
+% Version 2.9 allows nonnumeric macros before their def (December, 1988).
+% Version 3, for Sewell's book, fixed long-line bug in input_ln (March, 1989).
+% Version 4 was major change to allow 8-bit input (September, 1989).
+% RMD's changes for improved diagnostics (Sept 1990).
+
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\indent\ignorespaces}
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like SAIL
+\def\PASCAL{Pascal}
+\def\pb{$\.|\ldots\.|$} % Pascal brackets (|...|)
+\def\v{\.{\char'174}} % vertical (|) in typewriter font
+\mathchardef\BA="3224 % double arrow
+\def\({} % kludge for alphabetizing certain module names
+
+\def\title{TANGLE}
+\def\contentspagenumber{123} % should be odd
+\def\topofcontents{\null\vfill
+ \titlefalse % include headline on the contents page
+ \def\rheader{\mainfont Appendix E\hfil \contentspagenumber}
+ \centerline{\titlefont The {\ttitlefont TANGLE} processor}
+ \vskip 15pt
+ \centerline{(Version 4)}
+ \vfill}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+@* Introduction.
+This program converts a \.{WEB} file to a \PASCAL\ file. It was written
+by D. E. Knuth in September, 1981; a somewhat similar {\mc SAIL} program had
+been developed in March, 1979. Since this program describes itself, a
+bootstrapping process involving hand-translation had to be used to get started.
+
+For large \.{WEB} files one should have a large memory, since \.{TANGLE} keeps
+all the \PASCAL\ text in memory (in an abbreviated form). The program uses
+a few features of the local \PASCAL\ compiler that may need to be changed in
+other installations:
+
+\yskip\item{1)} Case statements have a default.
+\item{2)} Input-output routines may need to be adapted for use with a particular
+character set and/or for printing messages on the user's terminal.
+
+\yskip\noindent
+These features are also present in the \PASCAL\ version of \TeX, where they
+are used in a similar (but more complex) way. System-dependent portions
+of \.{TANGLE} can be identified by looking at the entries for `system
+dependencies' in the index below.
+@!@^system dependencies@>
+
+The ``banner line'' defined here should be changed whenever \.{TANGLE}
+is modified.
+
+@d banner=='This is TANGLE, Version 4.1'
+
+@ The program begins with a fairly normal header, made up of pieces that
+@^system dependencies@>
+will mostly be filled in later. The \.{WEB} input comes from files |web_file|
+and |change_file|, the \PASCAL\ output goes to file |Pascal_file|,
+and the string pool output goes to file |pool|.
+
+If it is necessary to abort the job because of a fatal error, the program
+calls the `|jump_out|' procedure, which goes to the label |end_of_TANGLE|.
+
+@d end_of_TANGLE = 9999 {go here to wrap it up}
+
+@p @t\4@>@<Compiler directives@>@/
+program TANGLE(@!web_file,@!change_file,@!Pascal_file,@!pool);
+label end_of_TANGLE; {go here to finish}
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+@<Error handling procedures@>@/
+procedure initialize;
+ var @<Local variables for initialization@>@/
+ begin @<Set initial values@>@/
+ end;
+
+@ Some of this code is optional for use when debugging only;
+such material is enclosed between the delimiters |debug| and $|gubed|$.
+Other parts, delimited by |stat| and $|tats|$, are optionally included if
+statistics about \.{TANGLE}'s memory usage are desired.
+
+@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging}
+@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging}
+@f debug==begin
+@f gubed==end
+@#
+@d stat==@{ {change this to `$\\{stat}\equiv\null$'
+ when gathering usage statistics}
+@d tats==@t@>@} {change this to `$\\{tats}\equiv\null$'
+ when gathering usage statistics}
+@f stat==begin
+@f tats==end
+
+@ The \PASCAL\ compiler used to develop this system has ``compiler
+directives'' that can appear in comments whose first character is a dollar sign.
+In production versions of \.{TANGLE} these directives tell the compiler that
+@^system dependencies@>
+it is safe to avoid range checks and to leave out the extra code it inserts
+for the \PASCAL\ debugger's benefit, although interrupts will occur if
+there is arithmetic overflow.
+
+@<Compiler directives@>=
+@{@&$C-,A+,D-@} {no range check, catch arithmetic overflow, no debug overhead}
+@!debug @{@&$C+,D+@}@+ gubed {but turn everything on when debugging}
+
+@ Labels are given symbolic names by the following definitions. We insert
+the label `|exit|:' just before the `\ignorespaces|end|\unskip' of a
+procedure in which we have used the `|return|' statement defined below;
+the label `|restart|' is occasionally used at the very beginning of a
+procedure; and the label `|reswitch|' is occasionally used just prior to
+a \&{case} statement in which some cases change the conditions and we wish to
+branch to the newly applicable case.
+Loops that are set up with the \&{loop} construction defined below are
+commonly exited by going to `|done|' or to `|found|' or to `|not_found|',
+and they are sometimes repeated by going to `|continue|'.
+
+@d exit=10 {go here to leave a procedure}
+@d restart=20 {go here to start a procedure again}
+@d reswitch=21 {go here to start a case statement again}
+@d continue=22 {go here to resume a loop}
+@d done=30 {go here to exit a loop}
+@d found=31 {go here when you've found it}
+@d not_found=32 {go here when you've found something else}
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@d loop == @+ while true do@+ {repeat over and over until a |goto| happens}
+@d do_nothing == {empty statement}
+@d return == goto exit {terminate a procedure call}
+@f return == nil
+@f loop == xclause
+
+@ We assume that |case| statements may include a default case that applies
+if no matching label is found. Thus, we shall use constructions like
+@^system dependencies@>
+$$\vbox{\halign{#\hfil\cr
+|case x of|\cr
+1: $\langle\,$code for $x=1\,\rangle$;\cr
+3: $\langle\,$code for $x=3\,\rangle$;\cr
+|othercases| $\langle\,$code for |x<>1| and |x<>3|$\,\rangle$\cr
+|endcases|\cr}}$$
+since most \PASCAL\ compilers have plugged this hole in the language by
+incorporating some sort of default mechanism. For example, the compiler
+used to develop \.{WEB} and \TeX\ allows `|others|:' as a default label,
+and other \PASCAL s allow syntaxes like `\ignorespaces|else|\unskip' or
+`\&{otherwise}' or `\\{otherwise}:', etc. The definitions of |othercases|
+and |endcases| should be changed to agree with local conventions. (Of
+course, if no default mechanism is available, the |case| statements of
+this program must be extended by listing all remaining cases. The author
+would have taken the trouble to modify \.{TANGLE} so that such extensions
+were done automatically, if he had not wanted to encourage \PASCAL\
+compiler writers to make this important change in \PASCAL, where it belongs.)
+
+@d othercases == others: {default for cases not listed explicitly}
+@d endcases == @+end {follows the default case in an extended |case| statement}
+@f othercases == else
+@f endcases == end
+
+@ The following parameters are set big enough to handle \TeX, so they
+should be sufficient for most applications of \.{TANGLE}.
+
+@<Constants...@>=
+@!buf_size=100; {maximum length of input line}
+@!max_bytes=45000; {|1/ww| times the number of bytes in identifiers,
+ strings, and module names; must be less than 65536}
+@!max_toks=50000; {|1/zz| times the number of bytes in compressed \PASCAL\ code;
+ must be less than 65536}
+@!max_names=4000; {number of identifiers, strings, module names;
+ must be less than 10240}
+@!max_texts=2000; {number of replacement texts, must be less than 10240}
+@!hash_size=353; {should be prime}
+@!longest_name=400; {module names shouldn't be longer than this}
+@!line_length=72; {lines of \PASCAL\ output have at most this many characters}
+@!out_buf_size=144; {length of output buffer, should be twice |line_length|}
+@!stack_size=50; {number of simultaneous levels of macro expansion}
+@!max_id_length=12; {long identifiers are chopped to this length, which must
+ not exceed |line_length|}
+@!unambig_length=7; {identifiers must be unique if chopped to this length}
+ {note that 7 is more strict than \PASCAL's 8, but this can be varied}
+
+@ A global variable called |history| will contain one of four values
+at the end of every run: |spotless| means that no unusual messages were
+printed; |harmless_message| means that a message of possible interest
+was printed but no serious errors were detected; |error_message| means that
+at least one error was found; |fatal_message| means that the program
+terminated abnormally. The value of |history| does not influence the
+behavior of the program; it is simply computed for the convenience
+of systems that might want to use such information.
+
+@d spotless=0 {|history| value for normal jobs}
+@d harmless_message=1 {|history| value when non-serious info was printed}
+@d error_message=2 {|history| value when an error was noted}
+@d fatal_message=3 {|history| value when we had to stop prematurely}
+@#
+@d mark_harmless==@t@>@+if history=spotless then history:=harmless_message
+@d mark_error==history:=error_message
+@d mark_fatal==history:=fatal_message
+
+@<Glob...@>=@!history:spotless..fatal_message; {how bad was this run?}
+
+@ @<Set init...@>=history:=spotless;
+
+@* The character set.
+One of the main goals in the design of \.{WEB} has been to make it readily
+portable between a wide variety of computers. Yet \.{WEB} by its very
+nature must use a greater variety of characters than most computer
+programs deal with, and character encoding is one of the areas in which
+existing machines differ most widely from each other.
+
+To resolve this problem, all input to \.{WEAVE} and \.{TANGLE} is converted
+to an internal eight-bit code that is essentially standard ASCII, the ``American
+Standard Code for Information Interchange.'' The conversion is done
+immediately when each character is read in. Conversely, characters are
+converted from ASCII to the user's external representation just before
+they are output. (The original ASCII code was seven bits only; \.{WEB} now
+allows eight bits in an attempt to keep up with modern times.)
+
+Such an internal code is relevant to users of \.{WEB} only because it is
+the code used for preprocessed constants like \.{"A"}. If you are writing
+a program in \.{WEB} that makes use of such one-character constants, you
+should convert your input to ASCII form, like \.{WEAVE} and \.{TANGLE} do.
+Otherwise \.{WEB}'s internal coding scheme does not affect you.
+@^ASCII code@>
+
+Here is a table of the standard visible ASCII codes:
+$$\def\:{\char\count255\global\advance\count255 by 1}
+\count255='40
+\vbox{
+\hbox{\hbox to 40pt{\it\hfill0\/\hfill}%
+\hbox to 40pt{\it\hfill1\/\hfill}%
+\hbox to 40pt{\it\hfill2\/\hfill}%
+\hbox to 40pt{\it\hfill3\/\hfill}%
+\hbox to 40pt{\it\hfill4\/\hfill}%
+\hbox to 40pt{\it\hfill5\/\hfill}%
+\hbox to 40pt{\it\hfill6\/\hfill}%
+\hbox to 40pt{\it\hfill7\/\hfill}}
+\vskip 4pt
+\hrule
+\def\^{\vrule height 10.5pt depth 4.5pt}
+\halign{\hbox to 0pt{\hskip -24pt\O{#0}\hfill}&\^
+\hbox to 40pt{\tt\hfill#\hfill\^}&
+&\hbox to 40pt{\tt\hfill#\hfill\^}\cr
+04&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+05&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+06&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+07&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+10&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+11&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+12&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+13&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+14&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+15&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+16&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+17&\:&\:&\:&\:&\:&\:&\:\cr}
+\hrule width 280pt}$$
+(Actually, of course, code @'040 is an invisible blank space.) Code @'136
+was once an upward arrow (\.{\char'13}), and code @'137 was
+once a left arrow (\.^^X), in olden times when the first draft
+of ASCII code was prepared; but \.{WEB} works with today's standard
+ASCII in which those codes represent circumflex and underline as shown.
+
+@<Types...@>=
+@!ASCII_code=0..255; {eight-bit numbers, a subrange of the integers}
+
+@ The original \PASCAL\ compiler was designed in the late 60s, when six-bit
+character sets were common, so it did not make provision for lowercase
+letters. Nowadays, of course, we need to deal with both capital and small
+letters in a convenient way, so \.{WEB} assumes that it is being used
+with a \PASCAL\ whose character set contains at least the characters of
+standard ASCII as listed above. Some \PASCAL\ compilers use the original
+name |char| for the data type associated with the characters in text files,
+while other \PASCAL s consider |char| to be a 64-element subrange of a larger
+data type that has some other name.
+
+In order to accommodate this difference, we shall use the name |text_char|
+to stand for the data type of the characters in the input and output
+files. We shall also assume that |text_char| consists of the elements
+|chr(first_text_char)| through |chr(last_text_char)|, inclusive. The
+following definitions should be adjusted if necessary.
+@^system dependencies@>
+
+@d text_char == char {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=255 {ordinal number of the largest element of |text_char|}
+
+@<Types...@>=
+@!text_file=packed file of text_char;
+
+@ The \.{WEAVE} and \.{TANGLE} processors convert between ASCII code and
+the user's external character set by means of arrays |xord| and |xchr|
+that are analogous to \PASCAL's |ord| and |chr| functions.
+
+@<Globals...@>=
+@!xord: array [text_char] of ASCII_code;
+ {specifies conversion of input characters}
+@!xchr: array [ASCII_code] of text_char;
+ {specifies conversion of output characters}
+
+@ If we assume that every system using \.{WEB} is able to read and write the
+visible characters of standard ASCII (although not necessarily using the
+ASCII codes to represent them), the following assignment statements initialize
+most of the |xchr| array properly, without needing any system-dependent
+changes. For example, the statement \.{xchr[@@\'101]:=\'A\'} that appears
+in the present \.{WEB} file might be encoded in, say, {\mc EBCDIC} code
+on the external medium on which it resides, but \.{TANGLE} will convert from
+this external code to ASCII and back again. Therefore the assignment
+statement \.{XCHR[65]:=\'A\'} will appear in the corresponding \PASCAL\ file,
+and \PASCAL\ will compile this statement so that |xchr[65]| receives the
+character \.A in the external (|char|) code. Note that it would be quite
+incorrect to say \.{xchr[@@\'101]:="A"}, because |"A"| is a constant of
+type |integer|, not |char|, and because we have $|"A"|=65$ regardless of
+the external character set.
+
+@<Set init...@>=
+xchr[@'40]:=' ';
+xchr[@'41]:='!';
+xchr[@'42]:='"';
+xchr[@'43]:='#';
+xchr[@'44]:='$';
+xchr[@'45]:='%';
+xchr[@'46]:='&';
+xchr[@'47]:='''';@/
+xchr[@'50]:='(';
+xchr[@'51]:=')';
+xchr[@'52]:='*';
+xchr[@'53]:='+';
+xchr[@'54]:=',';
+xchr[@'55]:='-';
+xchr[@'56]:='.';
+xchr[@'57]:='/';@/
+xchr[@'60]:='0';
+xchr[@'61]:='1';
+xchr[@'62]:='2';
+xchr[@'63]:='3';
+xchr[@'64]:='4';
+xchr[@'65]:='5';
+xchr[@'66]:='6';
+xchr[@'67]:='7';@/
+xchr[@'70]:='8';
+xchr[@'71]:='9';
+xchr[@'72]:=':';
+xchr[@'73]:=';';
+xchr[@'74]:='<';
+xchr[@'75]:='=';
+xchr[@'76]:='>';
+xchr[@'77]:='?';@/
+xchr[@'100]:='@@';
+xchr[@'101]:='A';
+xchr[@'102]:='B';
+xchr[@'103]:='C';
+xchr[@'104]:='D';
+xchr[@'105]:='E';
+xchr[@'106]:='F';
+xchr[@'107]:='G';@/
+xchr[@'110]:='H';
+xchr[@'111]:='I';
+xchr[@'112]:='J';
+xchr[@'113]:='K';
+xchr[@'114]:='L';
+xchr[@'115]:='M';
+xchr[@'116]:='N';
+xchr[@'117]:='O';@/
+xchr[@'120]:='P';
+xchr[@'121]:='Q';
+xchr[@'122]:='R';
+xchr[@'123]:='S';
+xchr[@'124]:='T';
+xchr[@'125]:='U';
+xchr[@'126]:='V';
+xchr[@'127]:='W';@/
+xchr[@'130]:='X';
+xchr[@'131]:='Y';
+xchr[@'132]:='Z';
+xchr[@'133]:='[';
+xchr[@'134]:='\';
+xchr[@'135]:=']';
+xchr[@'136]:='^';
+xchr[@'137]:='_';@/
+xchr[@'140]:='`';
+xchr[@'141]:='a';
+xchr[@'142]:='b';
+xchr[@'143]:='c';
+xchr[@'144]:='d';
+xchr[@'145]:='e';
+xchr[@'146]:='f';
+xchr[@'147]:='g';@/
+xchr[@'150]:='h';
+xchr[@'151]:='i';
+xchr[@'152]:='j';
+xchr[@'153]:='k';
+xchr[@'154]:='l';
+xchr[@'155]:='m';
+xchr[@'156]:='n';
+xchr[@'157]:='o';@/
+xchr[@'160]:='p';
+xchr[@'161]:='q';
+xchr[@'162]:='r';
+xchr[@'163]:='s';
+xchr[@'164]:='t';
+xchr[@'165]:='u';
+xchr[@'166]:='v';
+xchr[@'167]:='w';@/
+xchr[@'170]:='x';
+xchr[@'171]:='y';
+xchr[@'172]:='z';
+xchr[@'173]:='{';
+xchr[@'174]:='|';
+xchr[@'175]:='}';
+xchr[@'176]:='~';@/
+xchr[0]:=' '; xchr[@'177]:=' '; {these ASCII codes are not used}
+
+@ Some of the ASCII codes below @'40 have been given symbolic names in
+\.{WEAVE} and \.{TANGLE} because they are used with a special meaning.
+
+@d and_sign=@'4 {equivalent to `\.{and}'}
+@d not_sign=@'5 {equivalent to `\.{not}'}
+@d set_element_sign=@'6 {equivalent to `\.{in}'}
+@d tab_mark=@'11 {ASCII code used as tab-skip}
+@d line_feed=@'12 {ASCII code thrown away at end of line}
+@d form_feed=@'14 {ASCII code used at end of page}
+@d carriage_return=@'15 {ASCII code used at end of line}
+@d left_arrow=@'30 {equivalent to `\.{:=}'}
+@d not_equal=@'32 {equivalent to `\.{<>}'}
+@d less_or_equal=@'34 {equivalent to `\.{<=}'}
+@d greater_or_equal=@'35 {equivalent to `\.{>=}'}
+@d equivalence_sign=@'36 {equivalent to `\.{==}'}
+@d or_sign=@'37 {equivalent to `\.{or}'}
+
+@ When we initialize the |xord| array and the remaining parts of |xchr|,
+it will be convenient to make use of an index variable, |i|.
+
+@<Local variables for init...@>=
+@!i:0..255;
+
+@ Here now is the system-dependent part of the character set.
+If \.{WEB} is being implemented on a garden-variety \PASCAL\ for which
+only standard ASCII codes will appear in the input and output files, you
+don't need to make any changes here. But if you have, for example, an extended
+character set like the one in Appendix~C of {\sl The \TeX book}, the first
+line of code in this module should be changed to
+$$\hbox{|for i:=1 to @'37 do xchr[i]:=chr(i);|}$$
+\.{WEB}'s character set is essentially identical to \TeX's, even with respect to
+characters less than @'40.
+@^system dependencies@>
+
+Changes to the present module will make \.{WEB} more friendly on computers
+that have an extended character set, so that one can type things like
+\.^^Z\ instead of \.{<>}. If you have an extended set of characters that
+are easily incorporated into text files, you can assign codes arbitrarily
+here, giving an |xchr| equivalent to whatever characters the users of
+\.{WEB} are allowed to have in their input files, provided that unsuitable
+characters do not correspond to special codes like |carriage_return|
+that are listed above.
+
+(The present file \.{TANGLE.WEB} does not contain any of the non-ASCII
+characters, because it is intended to be used with all implementations of
+\.{WEB}. It was originally created on a Stanford system that has a
+convenient extended character set, then ``sanitized'' by applying another
+program that transliterated all of the non-standard characters into
+standard equivalents.)
+
+@<Set init...@>=
+for i:=1 to @'37 do xchr[i]:=' ';
+for i:=@'200 to @'377 do xchr[i]:=' ';
+
+@ The following system-independent code makes the |xord| array contain a
+suitable inverse to the information in |xchr|.
+
+@<Set init...@>=
+for i:=first_text_char to last_text_char do xord[chr(i)]:=" ";
+for i:=1 to @'377 do xord[xchr[i]]:=i;
+xord[' ']:=" ";
+
+@* Input and output.
+The input conventions of this program are intended to be very much like those
+of \TeX\ (except, of course, that they are much simpler, because much less
+needs to be done). Furthermore they are identical to those of \.{WEAVE}.
+Therefore people who need to make modifications to all three systems
+should be able to do so without too many headaches.
+
+We use the standard \PASCAL\ input/output procedures in several places that
+\TeX\ cannot, since \.{TANGLE} does not have to deal with files that are named
+dynamically by the user, and since there is no input from the terminal.
+
+@ Terminal output is done by writing on file |term_out|, which is assumed to
+consist of characters of type |text_char|:
+@^system dependencies@>
+
+@d print(#)==write(term_out,#) {`|print|' means write on the terminal}
+@d print_ln(#)==write_ln(term_out,#) {`|print|' and then start new line}
+@d new_line==write_ln(term_out) {start new line}
+@d print_nl(#)== {print information starting on a new line}
+ begin new_line; print(#);
+ end
+
+@<Globals...@>=
+@!term_out:text_file; {the terminal as an output file}
+
+@ Different systems have different ways of specifying that the output on a
+certain file will appear on the user's terminal. Here is one way to do this
+on the \PASCAL\ system that was used in \.{TANGLE}'s initial development:
+@^system dependencies@>
+
+@<Set init...@>=
+rewrite(term_out,'TTY:'); {send |term_out| output to the terminal}
+
+@ The |update_terminal| procedure is called when we want
+to make sure that everything we have output to the terminal so far has
+actually left the computer's internal buffers and been sent.
+@^system dependencies@>
+
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+
+@ The main input comes from |web_file|; this input may be overridden
+by changes in |change_file|. (If |change_file| is empty, there are no changes.)
+
+@<Globals...@>=
+@!web_file:text_file; {primary input}
+@!change_file:text_file; {updates}
+
+@ The following code opens the input files. Since these files were listed
+in the program header, we assume that the \PASCAL\ runtime system has
+already checked that suitable file names have been given; therefore no
+additional error checking needs to be done.
+@^system dependencies@>
+
+@p procedure open_input; {prepare to read |web_file| and |change_file|}
+begin reset(web_file); reset(change_file);
+end;
+
+@ The main output goes to |Pascal_file|, and string pool constants are
+written to the |pool| file.
+
+@<Globals...@>=
+@!Pascal_file: text_file;
+@!pool: text_file;
+
+@ The following code opens |Pascal_file| and |pool|.
+Since these files were listed in the program header, we assume that the
+\PASCAL\ runtime system has checked that suitable external file names have
+been given.
+@^system dependencies@>
+
+@<Set init...@>=
+rewrite(Pascal_file); rewrite(pool);
+
+@ Input goes into an array called |buffer|.
+
+@<Globals...@>=@!buffer: array[0..buf_size] of ASCII_code;
+
+@ The |input_ln| procedure brings the next line of input from the specified
+file into the |buffer| array and returns the value |true|, unless the file has
+already been entirely read, in which case it returns |false|. The conventions
+of \TeX\ are followed; i.e., |ASCII_code| numbers representing the next line
+of the file are input into |buffer[0]|, |buffer[1]|, \dots,
+|buffer[limit-1]|; trailing blanks are ignored;
+and the global variable |limit| is set to the length of the
+@^system dependencies@>
+line. The value of |limit| must be strictly less than |buf_size|.
+
+We assume that none of the |ASCII_code| values
+of |buffer[j]| for |0<=j<limit| is equal to 0, @'177, |line_feed|, |form_feed|,
+or |carriage_return|.
+
+@p function input_ln(var f:text_file):boolean;
+ {inputs a line or returns |false|}
+var final_limit:0..buf_size; {|limit| without trailing blanks}
+begin limit:=0; final_limit:=0;
+if eof(f) then input_ln:=false
+else begin while not eoln(f) do
+ begin buffer[limit]:=xord[f^]; get(f);
+ incr(limit);
+ if buffer[limit-1]<>" " then final_limit:=limit;
+ if limit=buf_size then
+ begin while not eoln(f) do get(f);
+ decr(limit); {keep |buffer[buf_size]| empty}
+ if final_limit>limit then final_limit:=limit;
+ print_nl('! Input line too long'); loc:=0; error;
+@.Input line too long@>
+ end;
+ end;
+ read_ln(f); limit:=final_limit; input_ln:=true;
+ end;
+end;
+
+@* Reporting errors to the user.
+The \.{TANGLE} processor operates in two phases: first it inputs the source
+file and stores a compressed representation of the program, then it produces
+the \PASCAL\ output from the compressed representation.
+
+The global variable |phase_one| tells whether we are in Phase I or not.
+
+@<Globals...@>=
+@!phase_one: boolean; {|true| in Phase I, |false| in Phase II}
+
+@ If an error is detected while we are debugging,
+we usually want to look at the contents of memory.
+A special procedure will be declared later for this purpose.
+
+@<Error handling...@>=
+@!debug @+ procedure debug_help; forward;@+ gubed
+@<Declare |print_id|@>
+
+@ During the first phase, syntax errors are reported to the user by saying
+$$\hbox{`|err_print('! Error message')|'},$$
+followed by `|jump_out|' if no recovery from the error is provided.
+This will print the error message followed by an indication of where the error
+was spotted in the source file. Note that no period follows the error message,
+since the error routine will automatically supply a period.
+
+Errors that are noticed during the second phase are reported to the user
+in the same fashion, but the error message will be
+followed by an indication of where the error was spotted in the output file.
+
+The actual error indications are provided by a procedure called |error|.
+
+@d err_print(#)==begin new_line; print(#); error;
+ end
+
+@<Error handling...@>=
+procedure error; {prints '\..' and location of error message}
+var j: 0..out_buf_size; {index into |out_buf|}
+@!k,@!l: 0..buf_size; {indices into |buffer|}
+begin if phase_one then @<Print error location based on input buffer@>
+else @<Print error location based on output buffer@>;
+update_terminal; mark_error;
+@!debug debug_help;@+gubed
+end;
+
+@ The error locations during Phase I can be indicated by using the global
+variables |loc|, |line|, and |changing|, which tell respectively the first
+unlooked-at position in |buffer|, the current line number, and whether or not
+the current line is from |change_file| or |web_file|.
+This routine should be modified on systems whose standard text editor
+has special line-numbering conventions.
+@^system dependencies@>
+
+@<Print error location based on input buffer@>=
+begin if changing then print('. (change file ')@+else print('. (');
+print_ln('l.', line:1, ')');
+if loc>=limit then l:=limit else l:=loc;
+for k:=1 to l do
+ if buffer[k-1]=tab_mark then print(' ')
+ else print(xchr[buffer[k-1]]); {print the characters already read}
+new_line;
+for k:=1 to l do print(' '); {space out the next line}
+for k:=l+1 to limit do print(xchr[buffer[k-1]]); {print the part not yet read}
+print(' '); {this space separates the message from future asterisks}
+end
+
+@ The position of errors detected during the second phase can be indicated
+by outputting the partially-filled output buffer, which contains |out_ptr|
+entries. This is not very helpful, so print the name of the current module
+or macro as well.
+
+@<Print error location based on output...@>=
+begin print_ln('. (l.',line:1,')');
+for j:=1 to out_ptr do print(xchr[out_buf[j-1]]); {print current partial line}
+print_ln('... '); {indicate that this information is partial}
+if cur_name > 0 then
+print( 'Expanding: '); print_id( cur_name) ;new_line ;
+end
+
+@ The |jump_out| procedure just cuts across all active procedure levels
+and jumps out of the program. This is the only non-local |goto| statement
+in \.{TANGLE}. It is used when no recovery from a particular error has
+been provided.
+
+Some \PASCAL\ compilers do not implement non-local |goto| statements.
+@^system dependencies@>
+In such cases the code that appears at label |end_of_TANGLE| should be
+copied into the |jump_out| procedure, followed by a call to a system procedure
+that terminates the program.
+
+@d fatal_error(#)==begin new_line; print(#); error; mark_fatal; jump_out;
+ end
+
+@<Error handling...@>=
+procedure jump_out;
+begin goto end_of_TANGLE;
+end;
+
+@ Sometimes the program's behavior is far different from what it should be,
+and \.{TANGLE} prints an error message that is really for the \.{TANGLE}
+maintenance person, not the user. In such cases the program says
+|confusion('indication of where we are')|.
+
+@d confusion(#)==fatal_error('! This can''t happen (',#,')')
+@.This can't happen@>
+
+@ An overflow stop occurs if \.{TANGLE}'s tables aren't large enough.
+
+@d overflow(#)==fatal_error('! Sorry, ',#,' capacity exceeded')
+@.Sorry, x capacity exceeded@>
+
+
+@* Data structures.
+Most of the user's \PASCAL\ code is packed into eight-bit integers
+in two large arrays called |byte_mem| and |tok_mem|.
+The |byte_mem| array holds the names of identifiers, strings, and modules;
+the |tok_mem| array holds the replacement texts
+for macros and modules. Allocation is sequential, since things are deleted only
+during Phase II, and only in a last-in-first-out manner.
+
+Auxiliary arrays |byte_start| and |tok_start| are used as directories to
+|byte_mem| and |tok_mem|, and the |link|, |ilk|, |equiv|, and |text_link|
+arrays give further information about names. These auxiliary arrays
+consist of sixteen-bit items.
+
+@<Types...@>=
+@!eight_bits=0..255; {unsigned one-byte quantity}
+@!sixteen_bits=0..65535; {unsigned two-byte quantity}
+
+@ \.{TANGLE} has been designed to avoid the need for indices that are more
+than sixteen bits wide, so that it can be used on most computers. But
+there are programs that need more than 65536 tokens, and some programs
+even need more than 65536 bytes; \TeX\ is one of these. To get around
+this problem, a slight complication has been added to the data structures:
+|byte_mem| and |tok_mem| are two-dimensional arrays, whose first index is
+either 0 or 1. (For generality, the first index is actually allowed to run
+between 0 and |ww-1| in |byte_mem|, or between 0 and |zz-1| in |tok_mem|,
+where |ww| and |zz| are set to 2 and~3; the program will work for any
+positive values of |ww| and |zz|, and it can be simplified in obvious ways
+if |ww=1| or |zz=1|.)
+
+@d ww=2 {we multiply the byte capacity by approximately this amount}
+@d zz=3 {we multiply the token capacity by approximately this amount}
+
+@<Globals...@>=
+@!byte_mem: packed array [0..ww-1,0..max_bytes] of ASCII_code;
+ {characters of names}
+@!tok_mem: packed array [0..zz-1,0..max_toks] of eight_bits; {tokens}
+@!byte_start: array [0..max_names] of sixteen_bits; {directory into |byte_mem|}
+@!tok_start: array [0..max_texts] of sixteen_bits; {directory into |tok_mem|}
+@!link: array [0..max_names] of sixteen_bits; {hash table or tree links}
+@!ilk: array [0..max_names] of sixteen_bits; {type codes or tree links}
+@!equiv: array [0..max_names] of sixteen_bits; {info corresponding to names}
+@!text_link: array [0..max_texts] of sixteen_bits; {relates replacement texts}
+
+@ The names of identifiers are found by computing a hash address |h| and
+then looking at strings of bytes signified by |hash[h]|, |link[hash[h]]|,
+|link[link[hash[h]]]|, \dots, until either finding the desired name
+or encountering a zero.
+
+A `|name_pointer|' variable, which signifies a name, is an index into
+|byte_start|. The actual sequence of characters in the name pointed to by
+|p| appears in positions |byte_start[p]| to |byte_start[p+ww]-1|, inclusive,
+in the segment of |byte_mem| whose first index is |p mod ww|. Thus, when
+|ww=2| the even-numbered name bytes appear in |byte_mem[0,@t$*$@>]|
+and the odd-numbered ones appear in |byte_mem[1,@t$*$@>]|.
+The pointer 0 is used for undefined module names; we don't
+want to use it for the names of identifiers, since 0 stands for a null
+pointer in a linked list.
+
+Strings are treated like identifiers; the first character (a double-quote)
+distinguishes a string from an alphabetic name, but for \.{TANGLE}'s purposes
+strings behave like numeric macros. (A `string' here refers to the
+strings delimited by double-quotes that \.{TANGLE} processes. \PASCAL\
+string constants delimited by single-quote marks are not given such special
+treatment; they simply appear as sequences of characters in the \PASCAL\
+texts.) The total number of strings in the string
+pool is called |string_ptr|, and the total number of names in |byte_mem|
+is called |name_ptr|. The total number of bytes occupied in
+|byte_mem[w,@t$*$@>]| is called |byte_ptr[w]|.
+
+We usually have |byte_start[name_ptr+w]=byte_ptr[(name_ptr+w) mod ww]|
+for |0<=w<ww|, since these are the starting positions for the next |ww|
+names to be stored in |byte_mem|.
+
+@d length(#)==byte_start[#+ww]-byte_start[#] {the length of a name}
+
+@<Types...@>=
+@!name_pointer=0..max_names; {identifies a name}
+
+@ @<Global...@>=
+@!name_ptr:name_pointer; {first unused position in |byte_start|}
+@!string_ptr:name_pointer; {next number to be given to a string of length |<>1|}
+@!byte_ptr:array [0..ww-1] of 0..max_bytes;
+ {first unused position in |byte_mem|}
+@!pool_check_sum:integer; {sort of a hash for the whole string pool}
+
+@ @<Local variables for init...@>=
+@!wi: 0..ww-1; {to initialize the |byte_mem| indices}
+
+@ @<Set init...@>=
+for wi:=0 to ww-1 do
+ begin byte_start[wi]:=0; byte_ptr[wi]:=0;
+ end;
+byte_start[ww]:=0; {this makes name 0 of length zero}
+name_ptr:=1; string_ptr:=256; pool_check_sum:=271828;
+
+@ Replacement texts are stored in |tok_mem|, using similar conventions.
+A `|text_pointer|' variable is an index into |tok_start|, and the
+replacement text that corresponds to |p| runs from positions
+|tok_start[p]| to |tok_start[p+zz]-1|, inclusive, in the segment of
+|tok_mem| whose first index is |p mod zz|. Thus, when |zz=2| the
+even-numbered replacement texts appear in |tok_mem[0,@t$*$@>]| and the
+odd-numbered ones appear in |tok_mem[1,@t$*$@>]|. Furthermore,
+|text_link[p]| is used to connect pieces of text that have the same name,
+as we shall see later. The pointer 0 is used for undefined replacement
+texts.
+
+The first position of |tok_mem[z,@t$*$@>]| that is unoccupied by
+replacement text is called |tok_ptr[z]|, and the first unused location of
+|tok_start| is called |text_ptr|. We usually have the identity
+|tok_start[text_ptr+z]=tok_ptr[(text_ptr+z) mod zz]|, for |0<=z<zz|, since
+these are the starting positions for the next |zz| replacement texts to
+be stored in |tok_mem|.
+
+@<Types...@>=
+@!text_pointer=0..max_texts; {identifies a replacement text}
+
+@ It is convenient to maintain a variable |z| that is equal to |text_ptr
+mod zz|, so that we always insert tokens into segment |z| of |tok_mem|.
+
+@<Glob...@>=
+@t\hskip1em@>@!text_ptr:text_pointer; {first unused position in |tok_start|}
+@t\hskip1em@>@!tok_ptr:array[0..zz-1] of 0..max_toks;
+ {first unused position in a given segment of |tok_mem|}
+@t\hskip1em@>@!z:0..zz-1; {current segment of |tok_mem|}
+stat @!max_tok_ptr:array[0..zz-1] of 0..max_toks;
+ {largest values assumed by |tok_ptr|}
+tats
+
+@ @<Local variables for init...@>=
+@!zi:0..zz-1; {to initialize the |tok_mem| indices}
+
+@ @<Set init...@>=
+for zi:=0 to zz-1 do
+ begin tok_start[zi]:=0; tok_ptr[zi]:=0;
+ end;
+tok_start[zz]:=0; {this makes replacement text 0 of length zero}
+text_ptr:=1; z:=1 mod zz;
+
+@ Four types of identifiers are distinguished by their |ilk|:
+
+\yskip\hang |normal| identifiers will appear in the \PASCAL\ program as
+ordinary identifiers since they have not been defined to be macros; the
+corresponding value in the |equiv| array
+for such identifiers is a link in a secondary hash table that
+is used to check whether any two of them agree in their first |unambig_length|
+characters after underline symbols are removed and lowercase letters are
+changed to uppercase.
+
+\yskip\hang |numeric| identifiers have been defined to be numeric macros;
+their |equiv| value contains the corresponding numeric value plus $2^{15}$.
+Strings are treated as numeric macros.
+
+\yskip\hang |simple| identifiers have been defined to be simple macros;
+their |equiv| value points to the corresponding replacement text.
+
+\yskip\hang |parametric| identifiers have been defined to be parametric macros;
+like simple identifiers, their |equiv| value points to the replacement text.
+
+@d normal=0 {ordinary identifiers have |normal| ilk}
+@d numeric=1 {numeric macros and strings have |numeric| ilk}
+@d simple=2 {simple macros have |simple| ilk}
+@d parametric=3 {parametric macros have |parametric| ilk}
+
+@ The names of modules are stored in |byte_mem| together
+with the identifier names, but a hash table is not used for them because
+\.{TANGLE} needs to be able to recognize a module name when given a prefix of
+that name. A conventional binary seach tree is used to retrieve module names,
+with fields called |llink| and |rlink| in place of |link| and |ilk|. The
+root of this tree is |rlink[0]|. If |p| is a pointer to a module name,
+|equiv[p]| points to its replacement text, just as in simple and parametric
+macros, unless this replacement text has not yet been defined (in which case
+|equiv[p]=0|).
+
+@d llink==link {left link in binary search tree for module names}
+@d rlink==ilk {right link in binary search tree for module names}
+
+@<Set init...@>=
+rlink[0]:=0; {the binary search tree starts out with nothing in it}
+equiv[0]:=0; {the undefined module has no replacement text}
+
+@ Here is a little procedure that prints the text of a given name. We chop the
+name at |max_name_length| to stop it overflowing the line.
+
+@d max_name_length= 70
+
+@<Declare |print_id|@>=
+procedure print_id(@!p:name_pointer); {print identifier or module name}
+var k,l:0..max_bytes; {index into |byte_mem|}
+@!w:0..ww-1; {segment of |byte_mem|}
+begin if p>=name_ptr then print('IMPOSSIBLE')
+ else begin w:=p mod ww;
+ l := length( p) ;
+ if l > max_name_length then l := max_name_length ;
+ for k:=byte_start[p] to byte_start[ p] + l-1 do print(xchr[byte_mem[w,k]]);
+ end;
+ if l = max_name_length then print( '...') ;
+end;
+
+@* Searching for identifiers.
+The hash table described above is updated by the |id_lookup| procedure,
+which finds a given identifier and returns a pointer to its index in
+|byte_start|. If the identifier was not already present, it is inserted with
+a given |ilk| code; and an error message is printed if the identifier is being
+doubly defined.
+
+Because of the way \.{TANGLE}'s scanning mechanism works, it is most convenient
+to let |id_lookup| search for an identifier that is present in the |buffer|
+array. Two other global variables specify its position in the buffer: the
+first character is |buffer[id_first]|, and the last is |buffer[id_loc-1]|.
+Furthermore, if the identifier is really a string, the global variable
+|double_chars| tells how many of the characters in the buffer appear
+twice (namely \.{@@@@} and \.{""}), since this additional information makes
+it easy to calculate the true length of the string. The final double-quote
+of the string is not included in its ``identifier,'' but the first one is,
+so the string length is |id_loc-id_first-double_chars-1|.
+
+We have mentioned that |normal| identifiers belong to two hash tables,
+one for their true names as they appear in the \.{WEB} file and the other
+when they have been reduced to their first |unambig_length| characters.
+The hash tables are kept by the method of simple chaining, where the
+heads of the individual lists appear in the |hash| and |chop_hash| arrays.
+If |h| is a hash code, the primary hash table list starts at |hash[h]| and
+proceeds through |link| pointers; the secondary hash table list starts at
+|chop_hash[h]| and proceeds through |equiv| pointers. Of course, the same
+identifier will probably have two different values of |h|.
+
+The |id_lookup| procedure uses an auxiliary array called |chopped_id| to
+contain up to |unambig_length| characters of the current identifier, if
+it is necessary to compute the secondary hash code. (This array could be
+declared local to |id_lookup|, but in general we are making all array
+declarations global in this program, because some compilers and some machine
+architectures make dynamic array allocation inefficient.)
+
+@<Glob...@>=
+@!id_first:0..buf_size; {where the current identifier begins in the buffer}
+@!id_loc:0..buf_size; {just after the current identifier in the buffer}
+@!double_chars:0..buf_size; {correction to length in case of strings}
+@#
+@!hash,@!chop_hash:array [0..hash_size] of sixteen_bits; {heads of hash lists}
+@!chopped_id:array [0..unambig_length] of ASCII_code; {chopped identifier}
+
+@ Initially all the hash lists are empty.
+
+@<Local variables for init...@>=
+@!h:0..hash_size; {index into hash-head arrays}
+
+@ @<Set init...@>=
+for h:=0 to hash_size-1 do
+ begin hash[h]:=0; chop_hash[h]:=0;
+ end;
+
+@ Here now is the main procedure for finding identifiers (and strings).
+The parameter |t| is set to |normal| except when the identifier is
+a macro name that is just being defined; in the latter case, |t| will be
+|numeric|, |simple|, or |parametric|.
+
+@p function id_lookup(@!t:eight_bits):name_pointer; {finds current identifier}
+label found, not_found;
+var c:eight_bits; {byte being chopped}
+@!i:0..buf_size; {index into |buffer|}
+@!h:0..hash_size; {hash code}
+@!k:0..max_bytes; {index into |byte_mem|}
+@!w:0..ww-1; {segment of |byte_mem|}
+@!l:0..buf_size; {length of the given identifier}
+@!p,@!q:name_pointer; {where the identifier is being sought}
+@!s:0..unambig_length; {index into |chopped_id|}
+begin l:=id_loc-id_first; {compute the length}
+@<Compute the hash code |h|@>;
+@<Compute the name location |p|@>;
+if (p=name_ptr)or(t<>normal) then
+ @<Update the tables and check for possible errors@>;
+id_lookup:=p;
+end;
+
+@ A simple hash code is used: If the sequence of
+ASCII codes is $c_1c_2\ldots c_m$, its hash value will be
+$$(2^{n-1}c_1+2^{n-2}c_2+\cdots+c_n)\,\bmod\,|hash_size|.$$
+
+@<Compute the hash...@>=
+h:=buffer[id_first]; i:=id_first+1;
+while i<id_loc do
+ begin h:=(h+h+buffer[i]) mod hash_size; incr(i);
+ end
+
+@ If the identifier is new, it will be placed in position |p=name_ptr|,
+otherwise |p| will point to its existing location.
+
+@<Compute the name location...@>=
+p:=hash[h];
+while p<>0 do
+ begin if length(p)=l then
+ @<Compare name |p| with current identifier, |goto found| if equal@>;
+ p:=link[p];
+ end;
+p:=name_ptr; {the current identifier is new}
+link[p]:=hash[h]; hash[h]:=p; {insert |p| at beginning of hash list}
+found:
+
+@ @<Compare name |p|...@>=
+begin i:=id_first; k:=byte_start[p]; w:=p mod ww;
+while (i<id_loc)and(buffer[i]=byte_mem[w,k]) do
+ begin incr(i); incr(k);
+ end;
+if i=id_loc then goto found; {all characters agree}
+end
+
+@ @<Update the tables...@>=
+begin if ((p<>name_ptr)and(t<>normal)and(ilk[p]=normal)) or
+ ((p=name_ptr)and(t=normal)and(buffer[id_first]<>"""")) then
+ @<Compute the secondary hash code |h| and put the first characters
+ into the auxiliary array |chopped_id|@>;
+if p<>name_ptr then
+ @<Give double-definition error, if necessary, and change |p| to type |t|@>
+else @<Enter a new identifier into the table at position |p|@>;
+end
+
+@ The following routine, which is called into play when it is necessary to
+look at the secondary hash table, computes the same hash function as before
+(but on the chopped data), and places a zero after the chopped identifier
+in |chopped_id| to serve as a convenient sentinel.
+
+@<Compute the secondary...@>=
+begin i:=id_first; s:=0; h:=0;
+while (i<id_loc)and(s<unambig_length) do
+ begin if buffer[i]<>"_" then
+ begin if buffer[i]>="a" then chopped_id[s]:=buffer[i]-@'40
+ else chopped_id[s]:=buffer[i];
+ h:=(h+h+chopped_id[s]) mod hash_size; incr(s);
+ end;
+ incr(i);
+ end;
+chopped_id[s]:=0;
+end
+
+@ If a nonnumeric macro has appeared before it was defined, \.{TANGLE}
+will still work all right; after all, such behavior is typical of the
+replacement texts for modules, which act very much like macros.
+However, an undefined numeric macro may not be used on the right-hand
+side of another numeric macro definition, so \.{TANGLE} finds it
+simplest to make a blanket rule that numeric macros should be defined
+before they are used. The following routine gives an error message and
+also fixes up any damage that may have been caused.
+
+@<Give double...@>= {now |p<>name_ptr| and |t<>normal|}
+begin if ilk[p]=normal then
+ begin if t=numeric then err_print('! This identifier has already appeared');
+@.This identifier has already...@>
+ @<Remove |p| from secondary hash table@>;
+ end
+else err_print('! This identifier was defined before');
+@.This identifier was defined...@>
+ilk[p]:=t;
+end
+
+@ When we have to remove a secondary hash entry, because a |normal| identifier
+is changing to another |ilk|, the hash code |h| and chopped identifier have
+already been computed.
+
+@<Remove |p| from secondary...@>=
+q:=chop_hash[h];
+if q=p then chop_hash[h]:=equiv[p]
+else begin while equiv[q]<>p do q:=equiv[q];
+ equiv[q]:=equiv[p];
+ end
+
+@ The following routine could make good use of a generalized |pack| procedure
+that puts items into just part of a packed array instead of the whole thing.
+
+@<Enter a new identifier...@>=
+begin if (t=normal)and(buffer[id_first]<>"""") then
+ @<Check for ambiguity and update secondary hash@>;
+w:=name_ptr mod ww; k:=byte_ptr[w];
+if k+l>max_bytes then overflow('byte memory');
+if name_ptr>max_names-ww then overflow('name');
+i:=id_first; {get ready to move the identifier into |byte_mem|}
+while i<id_loc do
+ begin byte_mem[w,k]:=buffer[i]; incr(k); incr(i);
+ end;
+byte_ptr[w]:=k; byte_start[name_ptr+ww]:=k; incr(name_ptr);
+if buffer[id_first]<>"""" then ilk[p]:=t
+else @<Define and output a new string of the pool@>;
+end
+
+@ @<Check for ambig...@>=
+begin q:=chop_hash[h];
+while q<>0 do
+ begin @<Check if |q| conflicts with |p|@>;
+ q:=equiv[q];
+ end;
+equiv[p]:=chop_hash[h]; chop_hash[h]:=p; {put |p| at front of secondary list}
+end
+
+@ @<Check if |q| conflicts...@>=
+begin k:=byte_start[q]; s:=0; w:=q mod ww;
+while (k<byte_start[q+ww]) and (s<unambig_length) do
+ begin c:=byte_mem[w,k];
+ if c<>"_" then
+ begin if c>="a" then c:=c-@'40; {merge lowercase with uppercase}
+ if chopped_id[s]<>c then goto not_found;
+ incr(s);
+ end;
+ incr(k);
+ end;
+if (k=byte_start[q+ww])and(chopped_id[s]<>0) then goto not_found;
+print_nl('! Identifier conflict with ');
+@.Identifier conflict...@>
+for k:=byte_start[q] to byte_start[q+ww]-1 do print(xchr[byte_mem[w,k]]);
+error; q:=0; {only one conflict will be printed, since |equiv[0]=0|}
+ print_nl( ' (missing module-start)?' );
+ @.Missing module-start?@>
+ @<Show last checkpoint@>;
+not_found:
+end
+
+@ We compute the string pool check sum by working modulo a prime number
+that is large but not so large that overflow might occur.
+
+@d check_sum_prime==@'3777777667 {$2^{29}-73$}
+@^preprocessed strings@>
+
+@<Define and output a new string...@>=
+begin ilk[p]:=numeric; {strings are like numeric macros}
+if l-double_chars=2 then {this string is for a single character}
+ equiv[p]:=buffer[id_first+1]+@'100000
+else begin equiv[p]:=string_ptr+@'100000;
+ l:=l-double_chars-1;
+ if l>99 then err_print('! Preprocessed string is too long');
+@.Preprocessed string is too long@>
+ incr(string_ptr);
+ write(pool,xchr["0"+l div 10],xchr["0"+l mod 10]); {output the length}
+ pool_check_sum:=pool_check_sum+pool_check_sum+l;
+ while pool_check_sum>check_sum_prime do
+ pool_check_sum:=pool_check_sum-check_sum_prime;
+ i:=id_first+1;
+ while i<id_loc do
+ begin write(pool,xchr[buffer[i]]); {output characters of string}
+ pool_check_sum:=pool_check_sum+pool_check_sum+buffer[i];
+ while pool_check_sum>check_sum_prime do
+ pool_check_sum:=pool_check_sum-check_sum_prime;
+ if (buffer[i]="""") or (buffer[i]="@@") then
+ i:=i+2 {omit second appearance of doubled character}
+ else incr(i);
+ end;
+ write_ln(pool);
+ end;
+end
+
+@* Searching for module names.
+The |mod_lookup| procedure finds the module name |mod_text[1..l]| in the
+search tree, after inserting it if necessary, and returns a pointer to
+where it was found.
+
+@<Glob...@>=
+@!mod_text:array [0..longest_name] of ASCII_code; {name being sought for}
+
+@ According to the rules of \.{WEB}, no module name
+should be a proper prefix of another, so a ``clean'' comparison should
+occur between any two names. The result of |mod_lookup| is 0 if this
+prefix condition is violated. An error message is printed when such violations
+are detected during phase two of \.{WEAVE}.
+
+@d less=0 {the first name is lexicographically less than the second}
+@d equal=1 {the first name is equal to the second}
+@d greater=2 {the first name is lexicographically greater than the second}
+@d prefix=3 {the first name is a proper prefix of the second}
+@d extension=4 {the first name is a proper extension of the second}
+
+@p function mod_lookup(@!l:sixteen_bits):name_pointer; {finds module name}
+label found;
+var c:less..extension; {comparison between two names}
+@!j:0..longest_name; {index into |mod_text|}
+@!k:0..max_bytes; {index into |byte_mem|}
+@!w:0..ww-1; {segment of |byte_mem|}
+@!p:name_pointer; {current node of the search tree}
+@!q:name_pointer; {father of node |p|}
+begin c:=greater; q:=0; p:=rlink[0]; {|rlink[0]| is the root of the tree}
+while p<>0 do
+ begin @<Set \(|c| to the result of comparing the given name to
+ name |p|@>;
+ q:=p;
+ if c=less then p:=llink[q]
+ else if c=greater then p:=rlink[q]
+ else goto found;
+ end;
+@<Enter a new module name into the tree@>;
+found: if c<>equal then
+ begin err_print('! Incompatible section names'); p:=0;
+@.Incompatible module names@>
+ end;
+mod_lookup:=p;
+end;
+
+@ @<Enter a new module name...@>=
+w:=name_ptr mod ww; k:=byte_ptr[w];
+if k+l>max_bytes then overflow('byte memory');
+if name_ptr>max_names-ww then overflow('name');
+p:=name_ptr;
+if c=less then llink[q]:=p else rlink[q]:=p;
+llink[p]:=0; rlink[p]:=0; c:=equal; equiv[p]:=0;
+for j:=1 to l do byte_mem[w,k+j-1]:=mod_text[j];
+byte_ptr[w]:=k+l; byte_start[name_ptr+ww]:=k+l; incr(name_ptr);
+
+@ @<Set \(|c|...@>=
+begin k:=byte_start[p]; w:=p mod ww; c:=equal; j:=1;
+while (k<byte_start[p+ww]) and (j<=l) and (mod_text[j]=byte_mem[w,k]) do
+ begin incr(k); incr(j);
+ end;
+if k=byte_start[p+ww] then
+ if j>l then c:=equal
+ else c:=extension
+else if j>l then c:=prefix
+else if mod_text[j]<byte_mem[w,k] then c:=less
+else c:=greater;
+end
+
+@ The |prefix_lookup| procedure is supposed to find exactly one module
+name that has |mod_text[1..l]| as a prefix. Actually the algorithm silently
+accepts also the situation that some module name is a prefix of
+|mod_text[1..l]|, because the user who painstakingly typed in more than
+necessary probably doesn't want to be told about the wasted effort.
+
+@p function prefix_lookup(@!l:sixteen_bits):name_pointer; {finds name extension}
+var c:less..extension; {comparison between two names}
+@!count:0..max_names; {the number of hits}
+@!j:0..longest_name; {index into |mod_text|}
+@!k:0..max_bytes; {index into |byte_mem|}
+@!w:0..ww-1; {segment of |byte_mem|}
+@!p:name_pointer; {current node of the search tree}
+@!q:name_pointer; {another place to resume the search after one branch is done}
+@!r:name_pointer; {extension found}
+begin q:=0; p:=rlink[0]; count:=0; r:=0; {begin search at root of tree}
+while p<>0 do
+ begin @<Set \(|c|...@>;
+ if c=less then p:=llink[p]
+ else if c=greater then p:=rlink[p]
+ else begin r:=p; incr(count); q:=rlink[p]; p:=llink[p];
+ end;
+ if p=0 then
+ begin p:=q; q:=0;
+ end;
+ end;
+if count<>1 then
+ if count=0 then err_print('! Name does not match')
+@.Name does not match@>
+ else err_print('! Ambiguous prefix');
+@.Ambiguous prefix@>
+prefix_lookup:=r; {the result will be 0 if there was no match}
+end;
+
+@* Tokens.
+Replacement texts, which represent \PASCAL\ code in a compressed format,
+appear in |tok_mem| as mentioned above. The codes in
+these texts are called `tokens'; some tokens occupy two consecutive
+eight-bit byte positions, and the others take just one byte.
+
+If $p>0$ points to a replacement text, |tok_start[p]| is the |tok_mem| position
+of the first eight-bit code of that text. If |text_link[p]=0|,
+this is the replacement text for a macro, otherwise it is the replacement
+text for a module. In the latter case |text_link[p]| is either equal to
+|module_flag|, which means that there is no further text for this module, or
+|text_link[p]| points to a
+continuation of this replacement text; such links are created when
+several modules have \PASCAL\ texts with the same name, and they also
+tie together all the \PASCAL\ texts of unnamed modules.
+The replacement text pointer for the first unnamed module
+appears in |text_link[0]|, and the most recent such pointer is |last_unnamed|.
+
+@d module_flag==max_texts {final |text_link| in module replacement texts}
+
+@<Glob...@>=
+@!last_unnamed:text_pointer; {most recent replacement text of unnamed module}
+
+@ @<Set init...@>= last_unnamed:=0; text_link[0]:=0;
+
+@ If the first byte of a token is less than @'200, the token occupies a
+single byte. Otherwise we make a sixteen-bit token by combining two consecutive
+bytes |a| and |b|. If |@'200<=a<@'250|, then $(a-@'200)\times2^8+b$ points
+to an identifier; if |@'250<=a<@'320|, then
+$(a-@'250)\times2^8+b$ points to a module name; otherwise, i.e., if
+|@'320<=a<@'400|, then $(a-@'320)\times2^8+b$ is the number of the module
+in which the current replacement text appears.
+
+Codes less than @'200 are 7-bit ASCII codes that represent themselves.
+In particular, a single-character identifier like `|x|' will be a one-byte
+token, while all longer identifiers will occupy two bytes.
+
+Some of the 7-bit ASCII codes will not be present, however, so we can
+use them for special purposes. The following symbolic names are used:
+
+\yskip\hang |param| denotes insertion of a parameter. This occurs only in
+the replacement texts of parametric macros, outside of single-quoted strings
+in those texts.
+
+\hang |begin_comment| denotes \.{@@\{}, which will become either
+\.{\{} or \.{[}.
+
+\hang |end_comment| denotes \.{@@\}}, which will become either
+\.{\}} or \.{]}.
+
+\hang |octal| denotes the \.{@@\'} that precedes an octal constant.
+
+\hang |hex| denotes the \.{@@"} that precedes a hexadecimal constant.
+
+\hang |check_sum| denotes the \.{@@\char'44} that denotes the string pool
+check sum.
+
+\hang |join| denotes the concatenation of adjacent items with no
+space or line breaks allowed between them (the \.{@@\&} operation of \.{WEB}).
+
+\hang |double_dot| denotes `\.{..}' in \PASCAL.
+
+\hang |verbatim| denotes the \.{@@=} that begins a verbatim \PASCAL\ string.
+It is also used for the end of the string.
+
+\hang |force_line| denotes the \.{@@\\} that forces a new line in the
+\PASCAL\ output.
+@^ASCII code@>
+
+@d param=0 {ASCII null code will not appear}
+@d verbatim=@'2 {extended ASCII alpha should not appear}
+@d force_line=@'3 {extended ASCII beta should not appear}
+@d begin_comment=@'11 {ASCII tab mark will not appear}
+@d end_comment=@'12 {ASCII line feed will not appear}
+@d octal=@'14 {ASCII form feed will not appear}
+@d hex=@'15 {ASCII carriage return will not appear}
+@d double_dot=@'40 {ASCII space will not appear except in strings}
+@d check_sum=@'175 {will not be confused with right brace}
+@d join=@'177 {ASCII delete will not appear}
+
+@ The following procedure is used to enter a two-byte value into
+|tok_mem| when a replacement text is being generated.
+
+@p procedure store_two_bytes(@!x:sixteen_bits);
+ {stores high byte, then low byte}
+begin if tok_ptr[z]+2>max_toks then overflow('token');
+tok_mem[z,tok_ptr[z]]:=x div@'400; {this could be done by a shift command}
+tok_mem[z,tok_ptr[z]+1]:=x mod@'400; {this could be done by a logical and}
+tok_ptr[z]:=tok_ptr[z]+2;
+end;
+
+@ When \.{TANGLE} is being operated in debug mode, it has a procedure to display
+a replacement text in symbolic form. This procedure has not been spruced up to
+generate a real great format, but at least the results are not as bad as a
+memory dump. (RMD) The original version of this used to crash because it tried
+to print everything on one line. On VMS, it is a fatal error whenever a line of
+output exceeds the maximum length. So I altered it to insert a newline from time
+to time.
+
+@p @!debug procedure print_repl(@!p:text_pointer);
+const max_line = 80 ;
+var @!line_l : integer ; {Conjectured length of a line of output}
+k:0..max_toks; {index into |tok_mem|}
+@!a: sixteen_bits; {current byte(s)}
+@!zp: 0..zz-1; {segment of |tok_mem| being accessed}
+begin
+new_line ; line_l := 0 ;
+if p>=text_ptr then print('BAD')
+else begin k:=tok_start[p]; zp:=p mod zz;
+ while k<tok_start[p+zz] do
+ begin a:=tok_mem[zp,k];
+ if a>= @'200 then @<Display two-byte token starting with |a|@>
+ else @<Display one-byte token |a|@>;
+ incr(k);
+ end;
+ if line_l > max_line then begin new_line; line_l := 0; end ;
+ end;
+end;
+gubed
+
+@ |print_repl| does not try to keep exact track of what it prints; instead it
+uses the |length| of identifiers and names; everything else is assumed to be
+about 3 characters.
+
+@<Display two-byte...@>=
+ begin incr(k);
+ a:=(a- @'100 )* @'200 +tok_mem[zp,k];
+ if a<min_mod then {identifier or string}
+ begin
+ if byte_mem[a mod ww,byte_start[a]]="""" then print('"') ;
+ line_l := line_l + length( a) ;
+ if line_l > max_line then begin new_line; line_l := length( a) ; end;
+ print_id(a);
+ if byte_mem[a mod ww,byte_start[a]]="""" then print('"')
+ else print(' ');
+ end
+ else if a<max_mod then {module name}
+ begin
+ a := a - min_mod ;
+ line_l := line_l + length( a) ;
+ if line_l > max_line then begin new_line; line_l := length( a) ; end;
+ print('@@<'); print_id( a) ;
+ print('@@>');
+ end
+ else begin a:=a- max_mod ; {module number}
+ print('@@',xchr["{"],a:1,'@@',xchr["}"]);
+ {can't use right brace between \&{debug} and \&{gubed}}
+ line_l := line_l + 6 ;
+ end;
+ end
+
+@ (RMD) This module had a bug; several cases were missing.
+
+@<Display one-byte...@>=
+begin case a of
+ begin_comment: print('@@',xchr["{"]);
+ end_comment: print('@@',xchr["}"]);
+ {can't use right brace between \&{debug} and \&{gubed}}
+ octal: print('@@''');
+ hex: print('@@"');
+ double_dot: print( '..') ;
+ check_sum: print('@@$');
+ param: print('#');
+ "@@": print('@@@@');
+ verbatim: print('@@=');
+ force_line: print('@@\');
+ and_sign: print('&');
+ not_sign: print(' not ');
+ set_element_sign: print(' in ');
+ left_arrow: print(' := ');
+ not_equal: print(' <> ');
+ less_or_equal: print(' <= ');
+ greater_or_equal: print(' >= ');
+ equivalence_sign: print(' == ');
+ or_sign: print(' or ');
+ othercases print(xchr[a]) ;
+ endcases;
+ line_l := line_l + 3 ;
+end
+
+@* Stacks for output.
+Let's make sure that our data structures contain enough information to
+produce the entire \PASCAL\ program as desired, by working next on the
+algorithms that actually do produce that program.
+
+@ The output process uses a stack to keep track of what is going on at
+different ``levels'' as the macros are being expanded.
+Entries on this stack have five parts:
+
+\yskip\hang |end_field| is the |tok_mem| location where the replacement
+text of a particular level will end;
+
+\hang |byte_field| is the |tok_mem| location from which the next token
+on a particular level will be read;
+
+\hang |name_field| points to the name corresponding to a particular level;
+
+\hang |repl_field| points to the replacement text currently being read
+at a particular level.
+
+\hang |mod_field| is the module number, or zero if this is a macro.
+
+\yskip\noindent The current values of these five quantities are referred to
+quite frequently, so they are stored in a separate place instead of in
+the |stack| array. We call the current values |cur_end|, |cur_byte|,
+|cur_name|, |cur_repl|, and |cur_mod|.
+
+The global variable |stack_ptr| tells how many levels of output are
+currently in progress. The end of all output occurs when the stack is
+empty, i.e., when |stack_ptr=0|.
+
+@<Types...@>=
+@t\4@>@!output_state=record
+ @!end_field: sixteen_bits; {ending location of replacement text}
+ @!byte_field: sixteen_bits; {present location within replacement text}
+ @!name_field: name_pointer; {|byte_start| index for text being output}
+ @!repl_field: text_pointer; {|tok_start| index for text being output}
+ @!mod_field: 0..@'27777; {module number or zero if not a module}
+ end;
+
+@ @d cur_end==cur_state.end_field {current ending location in |tok_mem|}
+@d cur_byte==cur_state.byte_field {location of next output byte in |tok_mem|}
+@d cur_name==cur_state.name_field {pointer to current name being expanded}
+@d cur_repl==cur_state.repl_field {pointer to current replacement text}
+@d cur_mod==cur_state.mod_field {current module number being expanded}
+
+@<Globals...@>=
+@!cur_state : output_state; {|cur_end|, |cur_byte|, |cur_name|, |cur_repl|}
+@!stack : array [1..stack_size] of output_state; {info for non-current levels}
+@!stack_ptr: 0..stack_size; {first unused location in the output state stack}
+
+@ It is convenient to keep a global variable |zo| equal to |cur_repl mod zz|.
+
+@<Glob...@>=
+@!zo:0..zz-1; {the segment of |tok_mem| from which output is coming}
+
+@ Parameters must also be stacked. They are placed in
+|tok_mem| just above the other replacement texts, and dummy parameter
+`names' are placed in |byte_start| just after the other names.
+The variables |text_ptr| and |tok_ptr[z]| essentially serve as parameter
+stack pointers during the output phase, so there is no need for a separate
+data structure to handle this problem.
+
+@ There is an implicit stack corresponding to meta-comments that are output
+via \.{@@\{} and \.{@@\}}. But this stack need not be represented in detail,
+because we only need to know whether it is empty or not. A global variable
+|brace_level| tells how many items would be on this stack if it were present.
+
+@<Globals...@>=
+@!brace_level: eight_bits; {current depth of $\.{@@\{}\ldots\.{@@\}}$ nesting}
+
+@ To get the output process started, we will perform the following
+initialization steps. We may assume that |text_link[0]| is nonzero, since it
+points to the \PASCAL\ text in the first unnamed module that generates
+code; if there are no such modules, there is nothing to output, and an
+error message will have been generated before we do any of the initialization.
+
+@<Initialize the output stacks@>=
+stack_ptr:=1; brace_level:=0; cur_name:=0; cur_repl:=text_link[0];
+zo:=cur_repl mod zz; cur_byte:=tok_start[cur_repl];
+cur_end:=tok_start[cur_repl+zz]; cur_mod:=0;
+
+@ When the replacement text for name |p| is to be inserted into the output,
+the following subroutine is called to save the old level of output and get
+the new one going.
+
+@p procedure push_level(@!p:name_pointer); {suspends the current level}
+begin if stack_ptr=stack_size then overflow('stack')
+else begin stack[stack_ptr]:=cur_state; {save |cur_end|, |cur_byte|, etc.}
+ incr(stack_ptr);
+ cur_name:=p; cur_repl:=equiv[p]; zo:=cur_repl mod zz;
+ cur_byte:=tok_start[cur_repl]; cur_end:=tok_start[cur_repl+zz];
+ cur_mod:=0;
+ end;
+end;
+
+@ When we come to the end of a replacement text, the |pop_level| subroutine
+does the right thing: It either moves to the continuation of this replacement
+text or returns the state to the most recently stacked level. Part of this
+subroutine, which updates the parameter stack, will be given later when we
+study the parameter stack in more detail.
+
+@p procedure pop_level; {do this when |cur_byte| reaches |cur_end|}
+label exit;
+begin if text_link[cur_repl]=0 then {end of macro expansion}
+ begin if ilk[cur_name]=parametric then
+ @<Remove a parameter from the parameter stack@>;
+ end
+else if text_link[cur_repl]<module_flag then {link to a continuation}
+ begin cur_repl:=text_link[cur_repl]; {we will stay on the same level}
+ zo:=cur_repl mod zz;
+ cur_byte:=tok_start[cur_repl]; cur_end:=tok_start[cur_repl+zz];
+ return;
+ end;
+decr(stack_ptr); {we will go down to the previous level}
+if stack_ptr>0 then
+ begin cur_state:=stack[stack_ptr]; zo:=cur_repl mod zz;
+ end;
+exit: end;
+
+@ The heart of the output procedure is the |get_output| routine, which produces
+the next token of output that is not a reference to a macro. This procedure
+handles all the stacking and unstacking that is necessary. It returns the
+value |number| if the next output has a numeric value (the value of a
+numeric macro or string), in which case |cur_val| has been set to the
+number in question. The procedure also returns the value |module_number|
+if the next output begins or ends the replacement text of some module,
+in which case |cur_val| is that module's number (if beginning) or the
+negative of that value (if ending). And it returns the value |identifier|
+if the next output is an identifier of length two or more, in which case
+|cur_val| points to that identifier name.
+
+@d number=@'200 {code returned by |get_output| when next output is numeric}
+@d module_number=@'201 {code returned by |get_output| for module numbers}
+@d identifier=@'202 {code returned by |get_output| for identifiers}
+
+@<Globals...@>=
+@!cur_val:integer; {additional information corresponding to output token}
+
+@ If |get_output| finds that no more output remains, it returns the value zero.
+
+@p function get_output:sixteen_bits; {returns next token after macro expansion}
+label restart, done, found;
+var a:sixteen_bits; {value of current byte}
+@!b:eight_bits; {byte being copied}
+@!bal:sixteen_bits; {excess of \.( versus \.) while copying a parameter}
+@!k:0..max_bytes; {index into |byte_mem|}
+@!w:0..ww-1; {segment of |byte_mem|}
+begin restart: if stack_ptr=0 then
+ begin a:=0; goto found;
+ end;
+if cur_byte=cur_end then
+ begin cur_val:=-cur_mod; pop_level;
+ if cur_val=0 then goto restart;
+ a:=module_number; goto found;
+ end;
+a:=tok_mem[zo,cur_byte]; incr(cur_byte);
+if a<@'200 then {one-byte token}
+ if a=param then
+ @<Start scanning current macro parameter, |goto restart|@>
+ else goto found;
+a:=(a-@'200)*@'400+tok_mem[zo,cur_byte]; incr(cur_byte);
+if a<@'24000 then {|@'24000=(@'250-@'200)*@'400|}
+ @<Expand macro |a| and |goto found|, or |goto restart| if no output found@>;
+if a<@'50000 then {|@'50000=(@'320-@'200)*@'400|}
+ @<Expand module |a-@'24000|, |goto restart|@>;
+cur_val:=a-@'50000; a:=module_number; cur_mod:=cur_val;
+found:
+@!debug if trouble_shooting then debug_help;@;@+gubed@/
+get_output:=a;
+end;
+
+@ The user may have forgotten to give any \PASCAL\ text for a module name,
+or the \PASCAL\ text may have been associated with a different name by mistake.
+
+@<Expand module |a-...@>=
+begin a:=a-@'24000;
+if equiv[a]<>0 then push_level(a)
+else if a<>0 then
+ begin print_nl('! Not present: <'); print_id(a); print('>'); error;
+@.Not present: <section name>@>
+ end;
+goto restart;
+end
+
+@ @<Expand macro ...@>=
+begin case ilk[a] of
+normal: begin cur_val:=a; a:=identifier;
+ end;
+numeric: begin cur_val:=equiv[a]-@'100000; a:=number;
+ end;
+simple: begin push_level(a); goto restart;
+ end;
+parametric: begin @<Put a parameter on the parameter stack,
+ or |goto restart| if error occurs@>;
+ push_level(a); goto restart;
+ end;
+othercases confusion('output')
+endcases;@/
+goto found;
+end
+
+@ We come now to the interesting part, the job of putting a parameter on
+the parameter stack. First we pop the stack if necessary until getting to
+a level that hasn't ended. Then the next character must be a `\.(';
+and since parentheses are balanced on each level, the entire parameter must
+be present, so we can copy it without difficulty.
+
+@<Put a parameter...@>=
+while (cur_byte=cur_end)and(stack_ptr>0) do pop_level;
+if (stack_ptr=0)or(tok_mem[zo,cur_byte]<>"(") then
+ begin print_nl('! No parameter given for '); print_id(a); error;
+@.No parameter given for macro@>
+ goto restart;
+ end;
+@<Copy the parameter into |tok_mem|@>;
+equiv[name_ptr]:=text_ptr; ilk[name_ptr]:=simple; w:=name_ptr mod ww;
+k:=byte_ptr[w];
+@!debug if k=max_bytes then overflow('byte memory');
+byte_mem[w,k]:="#"; incr(k); byte_ptr[w]:=k;
+gubed {this code has set the parameter identifier for debugging printouts}
+if name_ptr>max_names-ww then overflow('name');
+byte_start[name_ptr+ww]:=k; incr(name_ptr);
+if text_ptr>max_texts-zz then overflow('text');
+text_link[text_ptr]:=0; tok_start[text_ptr+zz]:=tok_ptr[z];
+incr(text_ptr);
+z:=text_ptr mod zz
+
+@ The |pop_level| routine undoes the effect of parameter-pushing when
+a parameter macro is finished:
+
+@<Remove a parameter...@>=
+begin decr(name_ptr); decr(text_ptr);
+z:=text_ptr mod zz;
+stat if tok_ptr[z]>max_tok_ptr[z] then max_tok_ptr[z]:=tok_ptr[z];
+tats {the maximum value of |tok_ptr| occurs just before parameter popping}
+tok_ptr[z]:=tok_start[text_ptr];
+@!debug decr(byte_ptr[name_ptr mod ww]);@+gubed
+end
+
+@ When a parameter occurs in a replacement text, we treat it as a simple
+macro in position (|name_ptr-1|):
+
+@<Start scanning...@>=
+begin push_level(name_ptr-1); goto restart;
+end
+
+@ Similarly, a |param| token encountered as we copy a parameter is converted
+into a simple macro call for |name_ptr-1|.
+Some care is needed to handle cases like \\{macro}|(#; print('#)'))|; the
+\.{\#} token will have been changed to |param| outside of strings, but we
+still must distinguish `real' parentheses from those in strings.
+
+@d app_repl(#)==begin if tok_ptr[z]=max_toks then overflow('token');
+ tok_mem[z,tok_ptr[z]]:=#; incr(tok_ptr[z]); end
+
+@<Copy the parameter...@>=
+bal:=1; incr(cur_byte); {skip the opening `\.('}
+loop@+ begin b:=tok_mem[zo,cur_byte]; incr(cur_byte);
+ if b=param then store_two_bytes(name_ptr+@'77777)
+ else begin if b>=@'200 then
+ begin app_repl(b);
+ b:=tok_mem[zo,cur_byte]; incr(cur_byte);
+ end
+ else case b of
+ "(": incr(bal);
+ ")": begin decr(bal);
+ if bal=0 then goto done;
+ end;
+ "'": repeat app_repl(b);
+ b:=tok_mem[zo,cur_byte]; incr(cur_byte);
+ until b="'"; {copy string, don't change |bal|}
+ othercases do_nothing
+ endcases;
+ app_repl(b);
+ end;
+ end;
+done:
+
+@* Producing the output.
+The |get_output| routine above handles most of the complexity of output
+generation, but there are two further considerations that have a nontrivial
+effect on \.{TANGLE}'s algorithms.
+
+First, we want to make sure that the output is broken into lines not
+exceeding |line_length| characters per line, where these breaks occur at
+valid places (e.g., not in the middle of a string or a constant or an
+identifier, not between `\.<' and `\.>', not at a `\.{@@\&}' position
+where quantities are being joined together). Therefore we assemble the
+output into a buffer before deciding where the line breaks will appear.
+However, we make very little attempt to make ``logical'' line breaks that
+would enhance the readability of the output; people are supposed to read
+the input of \.{TANGLE} or the \TeX ed output of \.{WEAVE}, but not the
+tangled-up output. The only concession to readability is that a break after
+a semicolon will be made if possible, since commonly used ``pretty
+printing'' routines give better results in such cases.
+
+Second, we want to decimalize non-decimal constants, and to combine integer
+quantities that are added or subtracted, because \PASCAL\ doesn't allow
+constant expressions in subrange types or in case labels. This means we
+want to have a procedure that treats a construction like \.{(E-15+17)}
+as equivalent to `\.{(E+2)}', while also leaving `\.{(1E-15+17)}' and
+`\.{(E-15+17*y)}' untouched. Consider also `\.{-15+17.5}' versus
+`\.{-15+17..5}'. We shall not combine integers preceding or following
+\.*, \./, \.{div}, \.{mod}, or \.{@@\&}. Note that if |y| has been defined
+to equal $-2$, we must expand `\.{x*y}' into `\.{x*(-2)}'; but `\.{x-y}'
+can expand into `\.{x+2}' and we can even change `\.{x - y mod z}' to
+@^mod@>
+`\.{x + 2 mod z}' because \PASCAL\ has a nonstandard \&{mod} operation!
+
+The following solution to these problems has been adopted: An array
+|out_buf| contains characters that have been generated but not yet output,
+and there are three pointers into this array. One of these, |out_ptr|, is
+the number of characters currently in the buffer, and we will have
+|1<=out_ptr<=line_length| most of the time. The second is |break_ptr|,
+which is the largest value |<=out_ptr| such that we are definitely entitled
+to end a line by outputting the characters |out_buf[1..(break_ptr-1)]|;
+we will always have |break_ptr<=line_length|. Finally, |semi_ptr| is either
+zero or the largest known value of a legal break after a semicolon or comment
+on the current line; we will always have |semi_ptr<=break_ptr|.
+
+@<Globals...@>=
+@!out_buf: array [0..out_buf_size] of ASCII_code; {assembled characters}
+@!out_ptr: 0..out_buf_size; {first available place in |out_buf|}
+@!break_ptr: 0..out_buf_size; {last breaking place in |out_buf|}
+@!semi_ptr: 0..out_buf_size; {last semicolon breaking place in |out_buf|}
+
+@ Besides having those three pointers,
+the output process is in one of several states:
+
+\yskip\hang |num_or_id| means that the last item in the buffer is a number or
+identifier, hence a blank space or line break must be inserted if the next
+item is also a number or identifier.
+
+\yskip\hang |unbreakable| means that the last item in the buffer was followed
+by the \.{@@\&} operation that inhibits spaces between it and the next item.
+
+\yskip\hang |sign| means that the last item in the buffer is to be followed
+by \.+ or \.-, depending on whether |out_app| is positive or negative.
+
+\yskip\hang |sign_val| means that the decimal equivalent of
+$\vert|out_val|\vert$ should be appended to the buffer. If |out_val<0|,
+or if |out_val=0| and |last_sign<0|, the number should be preceded by a minus
+sign. Otherwise it should be preceded by the character |out_sign| unless
+|out_sign=0|; the |out_sign| variable is either 0 or \.{"\ "} or \.{"+"}.
+
+\yskip\hang |sign_val_sign| is like |sign_val|, but also append \.+ or \.-
+afterwards, depending on whether |out_app| is positive or negative.
+
+\yskip\hang |sign_val_val| is like |sign_val|, but also append the decimal
+equivalent of |out_app| including its sign, using |last_sign| in case
+|out_app=0|.
+
+\yskip\hang |misc| means none of the above.
+
+\yskip\noindent
+For example, the output buffer and output state run through the following
+sequence as we generate characters from `\.{(x-15+19-2)}':
+$$\vbox{\halign{$\hfil#\hfil$\quad&#\hfil&\quad\hfil#\hfil&\quad
+\hfil#\hfil&\quad\hfil#\hfil&\quad\hfil#\hfil\quad&\hfil#\hfil\cr
+output&|out_buf|&|out_state|&|out_sign|&|out_val|&|out_app|&|last_sign|\cr
+\noalign{\vskip 3pt}
+(&\.(&|misc|\cr
+x&\.{(x}&|num_or_id|\cr
+-&\.{(x}&|sign|&&&$-1$&$-1$\cr
+15&\.{(x}&|sign_val|&\.{"+"}&$-15$&&$-15$\cr
++&\.{(x}&|sign_val_sign|&\.{"+"}&$-15$&$+1$&$+1$\cr
+19&\.{(x}&|sign_val_val|&\.{"+"}&$-15$&$+19$&$+1$\cr
+-&\.{(x}&|sign_val_sign|&\.{"+"}&$+4$&$-1$&$-1$\cr
+2&\.{(x}&|sign_val_val|&\.{"+"}&$+4$&$-2$&$-2$\cr
+)&\.{(x+2)}&|misc|\cr}}$$
+At each stage we have put as much into the buffer as possible without
+knowing what is coming next. Examples like `\.{x-0.1}' indicate why
+|last_sign| is needed to associate the proper sign with an output of zero.
+
+In states |num_or_id|, |unbreakable|, and |misc| the last item in the buffer
+lies between |break_ptr| and |out_ptr-1|, inclusive; in the other states we
+have |break_ptr=out_ptr|.
+
+The numeric values assigned to |num_or_id|, etc., have been chosen to
+shorten some of the program logic; for example, the program makes use of
+the fact that |sign+2=sign_val_sign|.
+
+@d misc=0 {state associated with special characters}
+@d num_or_id=1 {state associated with numbers and identifiers}
+@d sign=2 {state associated with pending \.+ or \.-}
+@d sign_val=num_or_id+2 {state associated with pending sign and value}
+@d sign_val_sign=sign+2 {|sign_val| followed by another pending sign}
+@d sign_val_val=sign_val+2 {|sign_val| followed by another pending value}
+@d unbreakable=sign_val_val+1 {state associated with \.{@@\&}}
+
+@<Globals...@>=
+@!out_state:eight_bits; {current status of partial output}
+@!out_val,@!out_app:integer; {pending values}
+@!out_sign:ASCII_code; {sign to use if appending |out_val>=0|}
+@!last_sign:-1..+1; {sign to use if appending a zero}
+
+@ During the output process, |line| will equal the number of the next line
+to be output.
+
+@<Initialize the output buffer@>=
+out_state:=misc; out_ptr:=0; break_ptr:=0; semi_ptr:=0; out_buf[0]:=0; line:=1;
+
+@ Here is a routine that is invoked when |out_ptr>line_length|
+or when it is time to flush out the final line. The |flush_buffer| procedure
+often writes out the line up to the current |break_ptr| position, then moves the
+remaining information to the front of |out_buf|. However, it prefers to
+write only up to |semi_ptr|, if the residual line won't be too long.
+
+@d check_break==if out_ptr>line_length then flush_buffer
+
+@p procedure flush_buffer; {writes one line to output file}
+var k:0..out_buf_size; {index into |out_buf|}
+@!b:0..out_buf_size; {value of |break_ptr| upon entry}
+begin b:=break_ptr;
+if (semi_ptr<>0)and(out_ptr-semi_ptr<=line_length) then break_ptr:=semi_ptr;
+for k:=1 to break_ptr do write(Pascal_file,xchr[out_buf[k-1]]);
+write_ln(Pascal_file); incr(line);
+if line mod 100 = 0 then
+ begin print('.');
+ if line mod 500 = 0 then print(line:1);
+ update_terminal; {progress report}
+ end;
+if break_ptr<out_ptr then
+ begin if out_buf[break_ptr]=" " then
+ begin incr(break_ptr); {drop space at break}
+ if break_ptr>b then b:=break_ptr;
+ end;
+ for k:=break_ptr to out_ptr-1 do out_buf[k-break_ptr]:=out_buf[k];
+ end;
+out_ptr:=out_ptr-break_ptr; break_ptr:=b-break_ptr; semi_ptr:=0;
+if out_ptr>line_length then
+ begin err_print('! Long line must be truncated'); out_ptr:=line_length;
+@.Long line must be truncated@>
+ end;
+end;
+
+@ @<Empty the last line from the buffer@>=
+break_ptr:=out_ptr; semi_ptr:=0; flush_buffer;
+if brace_level<>0 then
+ err_print('! Program ended at brace level ',brace_level:1);
+@.Program ended at brace level n@>
+
+@ Another simple and useful routine appends the decimal equivalent of
+a nonnegative integer to the output buffer.
+
+@d app(#)==begin out_buf[out_ptr]:=#; incr(out_ptr); {append a single character}
+ end
+
+@p procedure app_val(@!v:integer); {puts |v| into buffer, assumes |v>=0|}
+var k:0..out_buf_size; {index into |out_buf|}
+begin k:=out_buf_size; {first we put the digits at the very end of |out_buf|}
+repeat out_buf[k]:=v mod 10; v:=v div 10; decr(k);
+until v=0;
+repeat incr(k); app(out_buf[k]+"0");
+until k=out_buf_size; {then we append them, most significant first}
+end;
+
+@ The output states are kept up to date by the output routines, which are
+called |send_out|, |send_val|, and |send_sign|. The |send_out| procedure
+has two parameters: |t| tells the type of information being sent and
+|v| contains the information proper. Some information may also be passed
+in the array |out_contrib|.
+
+\yskip\hang If |t=misc| then |v| is a character to be output.
+
+\hang If |t=str| then |v| is the length of a string or something like `\.{<>}'
+in |out_contrib|.
+
+\hang If |t=ident| then |v| is the length of an identifier in |out_contrib|.
+
+\hang If |t=frac| then |v| is the length of a fraction and/or exponent in
+|out_contrib|.
+
+@d str=1 {|send_out| code for a string}
+@d ident=2 {|send_out| code for an identifier}
+@d frac=3 {|send_out| code for a fraction}
+
+@<Glob...@>=
+@!out_contrib:array[1..line_length] of ASCII_code; {a contribution to |out_buf|}
+
+@ A slightly subtle point in the following code is that the user may ask
+for a |join| operation (i.e., \.{@@\&}) following whatever is being sent
+out. We will see later that |join| is implemented in part by calling
+|send_out(frac,0)|.
+
+@p procedure send_out(@!t:eight_bits; @!v:sixteen_bits);
+ {outputs |v| of type |t|}
+label restart;
+var k: 0..line_length; {index into |out_contrib|}
+begin @<Get the buffer ready for appending the new information@>;
+if t<>misc then for k:=1 to v do app(out_contrib[k])
+else app(v);
+check_break;
+if (t=misc)and((v=";")or(v="}")) then
+ begin semi_ptr:=out_ptr; break_ptr:=out_ptr;
+ end;
+if t>=ident then out_state:=num_or_id {|t=ident| or |frac|}
+else out_state:=misc {|t=str| or |misc|}
+end;
+
+@ Here is where the buffer states for signs and values collapse into simpler
+states, because we are about to append something that doesn't combine with
+the previous integer constants.
+
+We use an ASCII-code trick: Since |","-1="+"| and |","+1="-"|, we have
+|","-c=@t sign of $c$@>|, when $\vert c\vert=1$.
+
+@<Get the buffer ready...@>=
+restart: case out_state of
+num_or_id: if t<>frac then
+ begin break_ptr:=out_ptr;
+ if t=ident then app(" ");
+ end;
+sign: begin app(","-out_app); check_break; break_ptr:=out_ptr;
+ end;
+sign_val,sign_val_sign: begin @<Append \(|out_val| to buffer@>;
+ out_state:=out_state-2; goto restart;
+ end;
+sign_val_val: @<Reduce |sign_val_val| to |sign_val| and |goto restart|@>;
+misc: if t<>frac then break_ptr:=out_ptr;@/
+othercases do_nothing {this is for |unbreakable| state}
+endcases
+
+@ @<Append \(|out_val|...@>=
+if (out_val<0)or((out_val=0)and(last_sign<0)) then app("-")
+else if out_sign>0 then app(out_sign);
+app_val(abs(out_val)); check_break;
+
+@ @<Reduce |sign_val_val|...@>=
+begin if (t=frac)or(@<Contribution is \.* or \./ or \.{DIV} or \.{MOD}@>) then
+ begin @<Append \(|out_val| to buffer@>;
+ out_sign:="+"; out_val:=out_app;
+ end
+else out_val:=out_val+out_app;
+out_state:=sign_val; goto restart;
+end
+
+@ @<Contribution is \.*...@>=
+((t=ident)and(v=3)and@|
+ (((out_contrib[1]="D")and(out_contrib[2]="I")and(out_contrib[3]="V")) or@|
+ ((out_contrib[1]="M")and(out_contrib[2]="O")and(out_contrib[3]="D")) ))or@|
+@^uppercase@>
+ ((t=misc)and((v="*")or(v="/")))
+
+@ The following routine is called with $v=\pm1$ when a plus or minus sign is
+appended to the output. It extends \PASCAL\ to allow repeated signs
+(e.g., `\.{--}' is equivalent to `\.+'), rather than to give an error message.
+The signs following `\.E' in real constants are treated as part of a fraction,
+so they are not seen by this routine.
+
+@p procedure send_sign(@!v:integer);
+begin case out_state of
+sign, sign_val_sign: out_app:=out_app*v;
+sign_val:begin out_app:=v; out_state:=sign_val_sign;
+ end;
+sign_val_val: begin out_val:=out_val+out_app; out_app:=v;
+ out_state:=sign_val_sign;
+ end;
+othercases begin break_ptr:=out_ptr; out_app:=v; out_state:=sign;
+ end
+endcases;@/
+last_sign:=out_app;
+end;
+
+@ When a (signed) integer value is to be output, we call |send_val|.
+
+@d bad_case=666 {this is a label used below}
+
+@p procedure send_val(@!v:integer); {output the (signed) value |v|}
+label bad_case, {go here if we can't keep |v| in the output state}
+ exit;
+begin case out_state of
+num_or_id: begin @<If previous output was \.{DIV} or \.{MOD}, |goto bad_case|@>;
+ out_sign:=" "; out_state:=sign_val; out_val:=v; break_ptr:=out_ptr;
+ last_sign:=+1;
+ end;
+misc: begin @<If previous output was \.* or \./, |goto bad_case|@>;
+ out_sign:=0; out_state:=sign_val; out_val:=v; break_ptr:=out_ptr;
+ last_sign:=+1;
+ end;
+@t\4@>@<Handle cases of |send_val| when |out_state| contains a sign@>@;
+othercases goto bad_case
+endcases;@/
+return;
+bad_case: @<Append the decimal value of |v|, with parentheses if negative@>;
+exit: end;
+
+@ @<Handle cases of |send_val|...@>=
+sign: begin out_sign:="+"; out_state:=sign_val; out_val:=out_app*v;
+ end;
+sign_val: begin out_state:=sign_val_val; out_app:=v;
+ err_print('! Two numbers occurred without a sign between them');
+ end;
+sign_val_sign: begin out_state:=sign_val_val; out_app:=out_app*v;
+ end;
+sign_val_val: begin out_val:=out_val+out_app; out_app:=v;
+ err_print('! Two numbers occurred without a sign between them');
+@.Two numbers occurred...@>
+ end;
+
+@ @<If previous output was \.*...@>=
+if (out_ptr=break_ptr+1)and((out_buf[break_ptr]="*")or(out_buf[break_ptr]="/"))
+ then goto bad_case
+
+@ @<If previous output was \.{DIV}...@>=
+if (out_ptr=break_ptr+3)or
+ ((out_ptr=break_ptr+4)and(out_buf[break_ptr]=" ")) then
+@^uppercase@>
+ if ((out_buf[out_ptr-3]="D")and(out_buf[out_ptr-2]="I")and
+ (out_buf[out_ptr-1]="V"))or @/
+ ((out_buf[out_ptr-3]="M")and(out_buf[out_ptr-2]="O")and
+ (out_buf[out_ptr-1]="D")) then@/ goto bad_case
+
+@ @<Append the decimal value...@>=
+if v>=0 then
+ begin if out_state=num_or_id then
+ begin break_ptr:=out_ptr; app(" ");
+ end;
+ app_val(v); check_break; out_state:=num_or_id;
+ end
+else begin app("("); app("-"); app_val(-v); app(")"); check_break;
+ out_state:=misc;
+ end
+
+@* The big output switch.
+To complete the output process, we need a routine that takes the results
+of |get_output| and feeds them to |send_out|, |send_val|, or |send_sign|.
+This procedure `|send_the_output|' will be invoked just once, as follows:
+
+@<Phase II: Output the contents of the compressed tables@>=
+if text_link[0]=0 then
+ begin print_nl('! No output was specified.'); mark_harmless;
+@.No output was specified@>
+ end
+else begin print_nl('Writing the output file'); update_terminal;@/
+ @<Initialize the output stacks@>;
+ @<Initialize the output buffer@>;
+ send_the_output;@/
+ @<Empty the last line...@>;
+ print_nl('Done.');
+ end
+
+@ A many-way switch is used to send the output:
+
+@d get_fraction=2 {this label is used below}
+
+@p procedure send_the_output;
+label get_fraction, {go here to finish scanning a real constant}
+ reswitch, continue;
+var cur_char:eight_bits; {the latest character received}
+ @!k:0..line_length; {index into |out_contrib|}
+ @!j:0..max_bytes; {index into |byte_mem|}
+ @!w:0..ww-1; {segment of |byte_mem|}
+ @!n:integer; {number being scanned}
+begin while stack_ptr>0 do
+ begin cur_char:=get_output;
+ reswitch:
+ @<Semicolon-else test@>;
+ case cur_char of
+ 0: do_nothing; {this case might arise if output ends unexpectedly}
+ @t\4@>@<Cases related to identifiers@>@;
+ @t\4@>@<Cases related to constants, possibly leading to
+ |get_fraction| or |reswitch|@>@;
+ "+","-": send_sign(","-cur_char);
+ @t\4@>@<Cases like \.{<>} and \.{:=}@>@;
+ "'": @<Send a string, |goto reswitch|@>;
+ @<Other printable characters@>: send_out(misc,cur_char);
+ @t\4@>@<Cases involving \.{@@\{} and \.{@@\}}@>@;
+ join: begin send_out(frac,0); out_state:=unbreakable;
+ end;
+ verbatim: @<Send verbatim string@>;
+ force_line: @<Force a line break@>;
+ othercases err_print('! Can''t output ASCII code ',cur_char:1)
+@.Can't output ASCII code n@>
+ endcases;@/
+ goto continue;
+ get_fraction: @<Special code to finish real constants@>;
+ continue: end;
+end;
+
+@ @<Cases like \.{<>}...@>=
+and_sign: begin out_contrib[1]:="A"; out_contrib[2]:="N"; out_contrib[3]:="D";
+@^uppercase@>
+ send_out(ident,3);
+ end;
+not_sign: begin out_contrib[1]:="N"; out_contrib[2]:="O"; out_contrib[3]:="T";
+ send_out(ident,3);
+ end;
+set_element_sign: begin out_contrib[1]:="I"; out_contrib[2]:="N";
+ send_out(ident,2);
+ end;
+or_sign: begin out_contrib[1]:="O"; out_contrib[2]:="R"; send_out(ident,2);
+ end;
+left_arrow: begin out_contrib[1]:=":"; out_contrib[2]:="="; send_out(str,2);
+ end;
+not_equal: begin out_contrib[1]:="<"; out_contrib[2]:=">"; send_out(str,2);
+ end;
+less_or_equal: begin out_contrib[1]:="<"; out_contrib[2]:="="; send_out(str,2);
+ end;
+greater_or_equal: begin out_contrib[1]:=">"; out_contrib[2]:="=";
+ send_out(str,2);
+ end;
+equivalence_sign: begin out_contrib[1]:="="; out_contrib[2]:="=";
+ send_out(str,2);
+ end;
+double_dot: begin out_contrib[1]:="."; out_contrib[2]:="."; send_out(str,2);
+ end;
+
+@ Please don't ask how all of the following characters can actually get
+through \.{TANGLE} outside of strings. It seems that |""""| and |"{"|
+cannot actually occur at this point of the program, but they have
+been included just in case \.{TANGLE} changes.
+
+If \.{TANGLE} is producing code for a \PASCAL\ compiler that uses `\.{(.}'
+and `\.{.)}' instead of square brackets (e.g., on machines with {\mc EBCDIC}
+code), one should remove |"["| and |"]"| from this list and put them into
+the preceding module in the appropriate way. Similarly, some compilers
+want `\.\^' to be converted to `\.{@@}'.
+@^system dependencies@>@^EBCDIC@>
+
+@<Other printable characters@>=
+"!","""","#","$","%","&","(",")","*",",","/",":",";","<","=",">","?",
+"@@","[","\","]","^","_","`","{","|"
+
+@ Single-character identifiers represent themselves, while longer ones
+appear in |byte_mem|. All must be converted to uppercase,
+with underlines removed. Extremely long identifiers must be chopped.
+
+(Some \PASCAL\ compilers work with lowercase letters instead of
+uppercase. If this module of \.{TANGLE} is changed, it's also necessary
+to change from uppercase to lowercase in the modules that are
+listed in the index under ``uppercase''.)
+@^system dependencies@>
+@^uppercase@>
+
+@d up_to(#)==#-24,#-23,#-22,#-21,#-20,#-19,#-18,#-17,#-16,#-15,#-14,
+ #-13,#-12,#-11,#-10,#-9,#-8,#-7,#-6,#-5,#-4,#-3,#-2,#-1,#
+
+@<Cases related to identifiers@>=
+"A",up_to("Z"): begin out_contrib[1]:=cur_char; send_out(ident,1);
+ end;
+"a",up_to("z"): begin out_contrib[1]:=cur_char-@'40; send_out(ident,1);
+ end;
+identifier: begin k:=0; j:=byte_start[cur_val]; w:=cur_val mod ww;
+ while (k<max_id_length)and(j<byte_start[cur_val+ww]) do
+ begin incr(k); out_contrib[k]:=byte_mem[w,j]; incr(j);
+ if out_contrib[k]>="a" then out_contrib[k]:=out_contrib[k]-@'40
+ else if out_contrib[k]="_" then decr(k);
+ end;
+ send_out(ident,k);
+ end;
+
+@ After sending a string, we need to look ahead at the next character, in order
+to see if there were two consecutive single-quote marks. Afterwards we go to
+|reswitch| to process the next character.
+
+@<Send a string...@>=
+begin k:=1; out_contrib[1]:="'";
+repeat if k<line_length then incr(k);
+out_contrib[k]:=get_output;
+until (out_contrib[k]="'")or(stack_ptr=0);
+if k=line_length then err_print('! String too long');
+@.String too long@>
+send_out(str,k); cur_char:=get_output;
+if cur_char="'" then out_state:=unbreakable;
+goto reswitch;
+end
+
+@ Sending a verbatim string is similar, but we don't have to look ahead.
+
+@<Send verbatim string@>=
+begin k:=0;
+repeat if k<line_length then incr(k);
+out_contrib[k]:=get_output;
+until (out_contrib[k]=verbatim)or(stack_ptr=0);
+if k=line_length then err_print('! Verbatim string too long');
+@.Verbatim string too long@>
+send_out(str,k-1);
+end
+
+@ In order to encourage portable software, \.{TANGLE} complains
+if the constants get dangerously close to the largest value representable
+on a 32-bit computer ($2^{31}-1$).
+
+@d digits=="0","1","2","3","4","5","6","7","8","9"
+
+@<Cases related to constants...@>=
+digits: begin n:=0;
+ repeat cur_char:=cur_char-"0";
+ if n>=@'1463146314 then err_print('! Constant too big')
+@.Constant too big@>
+ else n:=10*n+cur_char;
+ cur_char:=get_output;
+ until (cur_char>"9")or(cur_char<"0");
+ send_val(n); k:=0;
+ if cur_char="e" then cur_char:="E";
+@^uppercase@>
+ if cur_char="E" then goto get_fraction
+ else goto reswitch;
+ end;
+check_sum: send_val(pool_check_sum);
+octal: begin n:=0; cur_char:="0";
+ repeat cur_char:=cur_char-"0";
+ if n>=@'2000000000 then err_print('! Constant too big')
+ else n:=8*n+cur_char;
+ cur_char:=get_output;
+ until (cur_char>"7")or(cur_char<"0");
+ send_val(n); goto reswitch;
+ end;
+hex: begin n:=0; cur_char:="0";
+ repeat if cur_char>="A" then cur_char:=cur_char+10-"A"
+ else cur_char:=cur_char-"0";
+ if n>=@"8000000 then err_print('! Constant too big')
+ else n:=16*n+cur_char;
+ cur_char:=get_output;
+ until (cur_char>"F")or(cur_char<"0")or@|
+ ((cur_char>"9")and(cur_char<"A"));
+ send_val(n); goto reswitch;
+ end;
+number: send_val(cur_val);
+".": begin k:=1; out_contrib[1]:="."; cur_char:=get_output;
+ if cur_char="." then
+ begin out_contrib[2]:="."; send_out(str,2);
+ end
+ else if (cur_char>="0")and(cur_char<="9") then goto get_fraction
+ else begin send_out(misc,"."); goto reswitch;
+ end;
+ end;
+
+@ The following code appears at label `|get_fraction|', when we want to
+scan to the end of a real constant. The first |k| characters of a fraction
+have already been placed in |out_contrib|, and |cur_char| is the next character.
+
+@<Special code...@>=
+repeat if k<line_length then incr(k);
+out_contrib[k]:=cur_char; cur_char:=get_output;
+if (out_contrib[k]="E")and((cur_char="+")or(cur_char="-")) then
+@^uppercase@>
+ begin if k<line_length then incr(k);
+ out_contrib[k]:=cur_char; cur_char:=get_output;
+ end
+else if cur_char="e" then cur_char:="E";
+until (cur_char<>"E")and((cur_char<"0")or(cur_char>"9"));
+if k=line_length then err_print('! Fraction too long');
+@.Fraction too long@>
+send_out(frac,k); goto reswitch
+
+@ Some \PASCAL\ compilers do not recognize comments in braces, so the
+comments must be delimited by `\.{(*}' and `\.{*)}'.
+@^system dependencies@>
+In such cases the statement `|send_out(misc,"{")|' that appears here should
+be replaced by `\ignorespaces|begin out_contrib[1]:="("; out_contrib[2]:="*";
+send_out(str,2); end|', and a similar change should be made to
+`|send_out(misc,"}")|'.
+
+@<Cases involving \.{@@\{} and \.{@@\}}@>=
+begin_comment: begin if brace_level=0 then send_out(misc,"{")
+ else send_out(misc,"[");
+ incr(brace_level);
+ end;
+end_comment: if brace_level>0 then
+ begin decr(brace_level);
+ if brace_level=0 then send_out(misc,"}")
+ else send_out(misc,"]");
+ end
+ else err_print('! Extra @@}');
+@.Extra \AT!\}@>
+module_number: begin if brace_level=0 then send_out(misc,"{")
+ else send_out(misc,"[");
+ if cur_val<0 then
+ begin send_out(misc,":"); send_val(-cur_val);
+ end
+ else begin send_val(cur_val); send_out(misc,":");
+ end;
+ if brace_level=0 then send_out(misc,"}")
+ else send_out(misc,"]");
+ end;
+
+@ @<Force a line break@>=
+begin send_out(str,0); {normalize the buffer}
+while out_ptr>0 do
+ begin if out_ptr<=line_length then break_ptr:=out_ptr;
+ flush_buffer;
+ end;
+out_state:=misc;
+end
+
+@* Introduction to the input phase.
+We have now seen that \.{TANGLE} will be able to output the full
+\PASCAL\ program, if we can only get that program into the byte memory in
+the proper format. The input process is something like the output process
+in reverse, since we compress the text as we read it in and we expand it
+as we write it out.
+
+There are three main input routines. The most interesting is the one that gets
+the next token of a \PASCAL\ text; the other two are used to scan rapidly past
+\TeX\ text in the \.{WEB} source code. One of the latter routines will jump to
+the next token that starts with `\.{@@}', and the other skips to the end
+of a \PASCAL\ comment.
+
+@ But first we need to consider the low-level routine |get_line|
+that takes care of merging |change_file| into |web_file|. The |get_line|
+procedure also updates the line numbers for error messages.
+
+@<Globals...@>=
+@!line:integer; {the number of the current line in the current file}
+@!other_line:integer; {the number of the current line in the input file that
+ is not currently being read}
+@!temp_line:integer; {used when interchanging |line| with |other_line|}
+@!limit:0..buf_size; {the last character position occupied in the buffer}
+@!loc:0..buf_size; {the next character position to be read from the buffer}
+@!input_has_ended: boolean; {if |true|, there is no more input}
+@!changing: boolean; {if |true|, the current line is from |change_file|}
+
+@ As we change |changing| from |true| to |false| and back again, we must
+remember to swap the values of |line| and |other_line| so that the |err_print|
+routine will be sure to report the correct line number.
+
+@d change_changing==
+ changing := not changing;
+ temp_line:=other_line; other_line:=line; line:=temp_line
+ {|line @t$\null\BA\null$@> other_line|}
+
+@ When |changing| is |false|, the next line of |change_file| is kept in
+|change_buffer[0..change_limit]|, for purposes of comparison with the next
+line of |web_file|. After the change file has been completely input, we
+set |change_limit:=0|, so that no further matches will be made.
+
+@<Globals...@>=
+@!change_buffer:array[0..buf_size] of ASCII_code;
+@!change_limit:0..buf_size; {the last position occupied in |change_buffer|}
+
+@ Here's a simple function that checks if the two buffers are different.
+
+@p function lines_dont_match:boolean;
+label exit;
+var k:0..buf_size; {index into the buffers}
+begin lines_dont_match:=true;
+if change_limit<>limit then return;
+if limit>0 then
+ for k:=0 to limit-1 do if change_buffer[k]<>buffer[k] then return;
+lines_dont_match:=false;
+exit: end;
+
+@ Procedure |prime_the_change_buffer| sets |change_buffer| in preparation
+for the next matching operation. Since blank lines in the change file are
+not used for matching, we have |(change_limit=0)and not changing| if and
+only if the change file is exhausted. This procedure is called only
+when |changing| is true; hence error messages will be reported correctly.
+
+@p procedure prime_the_change_buffer;
+label continue, done, exit;
+var k:0..buf_size; {index into the buffers}
+begin change_limit:=0; {this value will be used if the change file ends}
+@<Skip over comment lines in the change file; |return| if end of file@>;
+@<Skip to the next nonblank line; |return| if end of file@>;
+@<Move |buffer| and |limit| to |change_buffer| and |change_limit|@>;
+exit: end;
+
+@ While looking for a line that begins with \.{@@x} in the change file,
+we allow lines that begin with \.{@@}, as long as they don't begin with
+\.{@@y} or \.{@@z} (which would probably indicate that the change file is
+fouled up).
+
+@<Skip over comment lines in the change file...@>=
+loop@+ begin incr(line);
+ if not input_ln(change_file) then return;
+ if limit<2 then goto continue;
+ if buffer[0]<>"@@" then goto continue;
+ if (buffer[1]>="X")and(buffer[1]<="Z") then
+ buffer[1]:=buffer[1]+"z"-"Z"; {lowercasify}
+ if buffer[1]="x" then goto done;
+ if (buffer[1]="y")or(buffer[1]="z") then
+ begin loc:=2; err_print('! Where is the matching @@x?');
+@.Where is the match...@>
+ end;
+continue: end;
+done:
+
+@ Here we are looking at lines following the \.{@@x}.
+
+@<Skip to the next nonblank line...@>=
+repeat incr(line);
+ if not input_ln(change_file) then
+ begin err_print('! Change file ended after @@x');
+@.Change file ended...@>
+ return;
+ end;
+until limit>0;
+
+@ @<Move |buffer| and |limit| to |change_buffer| and |change_limit|@>=
+begin change_limit:=limit;
+if limit>0 then for k:=0 to limit-1 do change_buffer[k]:=buffer[k];
+end
+
+@ The following procedure is used to see if the next change entry should
+go into effect; it is called only when |changing| is false.
+The idea is to test whether or not the current
+contents of |buffer| matches the current contents of |change_buffer|.
+If not, there's nothing more to do; but if so, a change is called for:
+All of the text down to the \.{@@y} is supposed to match. An error
+message is issued if any discrepancy is found. Then the procedure
+prepares to read the next line from |change_file|.
+
+@p procedure check_change; {switches to |change_file| if the buffers match}
+label exit;
+var n:integer; {the number of discrepancies found}
+@!k:0..buf_size; {index into the buffers}
+begin if lines_dont_match then return;
+n:=0;
+loop@+ begin change_changing; {now it's |true|}
+ incr(line);
+ if not input_ln(change_file) then
+ begin err_print('! Change file ended before @@y');
+@.Change file ended...@>
+ change_limit:=0; change_changing; {|false| again}
+ return;
+ end;
+ @<If the current line starts with \.{@@y},
+ report any discrepancies and |return|@>;
+ @<Move |buffer| and |limit|...@>;
+ change_changing; {now it's |false|}
+ incr(line);
+ if not input_ln(web_file) then
+ begin err_print('! WEB file ended during a change');
+@.WEB file ended...@>
+ input_has_ended:=true; return;
+ end;
+ if lines_dont_match then incr(n);
+ end;
+exit: end;
+
+@ @<If the current line starts with \.{@@y}...@>=
+if limit>1 then if buffer[0]="@@" then
+ begin if (buffer[1]>="X")and(buffer[1]<="Z") then
+ buffer[1]:=buffer[1]+"z"-"Z"; {lowercasify}
+ if (buffer[1]="x")or(buffer[1]="z") then
+ begin loc:=2; err_print('! Where is the matching @@y?');
+@.Where is the match...@>
+ end
+ else if buffer[1]="y" then
+ begin if n>0 then
+ begin loc:=2; err_print('! Hmm... ',n:1,
+ ' of the preceding lines failed to match');
+@.Hmm... n of the preceding...@>
+ end;
+ return;
+ end;
+ end
+
+@ @<Initialize the input system@>=
+open_input; line:=0; other_line:=0;@/
+changing:=true; prime_the_change_buffer; change_changing;@/
+limit:=0; loc:=1; buffer[0]:=" "; input_has_ended:=false;
+
+@ The |get_line| procedure is called when |loc>limit|; it puts the next
+line of merged input into the buffer and updates the other variables
+appropriately. A space is placed at the right end of the line.
+
+@p procedure get_line; {inputs the next line}
+label restart;
+begin restart: if changing then
+ @<Read from |change_file| and maybe turn off |changing|@>;
+if not changing then
+ begin @<Read from |web_file| and maybe turn on |changing|@>;
+ if changing then goto restart;
+ end;
+loc:=0; buffer[limit]:=" ";
+end;
+
+@ @<Read from |web_file|...@>=
+begin incr(line);
+if not input_ln(web_file) then input_has_ended:=true
+else if limit=change_limit then
+ if buffer[0]=change_buffer[0] then
+ if change_limit>0 then check_change;
+end
+
+@ @<Read from |change_file|...@>=
+begin incr(line);
+if not input_ln(change_file) then
+ begin err_print('! Change file ended without @@z');
+@.Change file ended...@>
+ buffer[0]:="@@"; buffer[1]:="z"; limit:=2;
+ end;
+if limit>1 then {check if the change has ended}
+ if buffer[0]="@@" then
+ begin if (buffer[1]>="X")and(buffer[1]<="Z") then
+ buffer[1]:=buffer[1]+"z"-"Z"; {lowercasify}
+ if (buffer[1]="x")or(buffer[1]="y") then
+ begin loc:=2; err_print('! Where is the matching @@z?');
+@.Where is the match...@>
+ end
+ else if buffer[1]="z" then
+ begin prime_the_change_buffer; change_changing;
+ end;
+ end;
+end
+
+@ At the end of the program, we will tell the user if the change file
+had a line that didn't match any relevant line in |web_file|.
+
+@<Check that all changes have been read@>=
+if change_limit<>0 then {|changing| is false}
+ begin for loc:=0 to change_limit do buffer[loc]:=change_buffer[loc];
+ limit:=change_limit; changing:=true; line:=other_line; loc:=change_limit;
+ err_print('! Change file entry did not match');
+@.Change file entry did not match@>
+ end
+
+@ Important milestones are reached during the input phase when certain
+control codes are sensed.
+
+Control codes in \.{WEB} begin with `\.{@@}', and the next character
+identifies the code. Some of these are of interest only to \.{WEAVE},
+so \.{TANGLE} ignores them; the others are converted by \.{TANGLE} into
+internal code numbers by the |control_code| function below. The ordering
+of these internal code numbers has been chosen to simplify the program logic;
+larger numbers are given to the control codes that denote more significant
+milestones.
+
+@d ignore=0 {control code of no interest to \.{TANGLE}}
+@d control_text=@'203 {control code for `\.{@@t}', `\.{@@\^}', etc.}
+@d format=@'204 {control code for `\.{@@f}'}
+@d definition=@'205 {control code for `\.{@@d}'}
+@d begin_Pascal=@'206 {control code for `\.{@@p}'}
+@d module_name=@'207 {control code for `\.{@@<}'}
+@d new_module=@'210 {control code for `\.{@@\ }' and `\.{@@*}'}
+
+@p function control_code(@!c:ASCII_code):eight_bits; {convert |c| after \.{@@}}
+begin case c of
+"@@": control_code:="@@"; {`quoted' at sign}
+"'": control_code:=octal; {precedes octal constant}
+"""": control_code:=hex; {precedes hexadecimal constant}
+"$": control_code:=check_sum; {string pool check sum}
+" ",tab_mark: control_code:=new_module; {beginning of a new module}
+"*": begin print('*',module_count+1:1);
+ update_terminal; {print a progress report}
+ control_code:=new_module; {beginning of a new module}
+ end;
+"D","d": control_code:=definition; {macro definition}
+"F","f": control_code:=format; {format definition}
+"{": control_code:=begin_comment; {begin-comment delimiter}
+"}": control_code:=end_comment; {end-comment delimiter}
+"P","p": control_code:=begin_Pascal; {\PASCAL\ text in unnamed module}
+"T","t","^",".",":": control_code:=control_text; {control text to be ignored}
+"&": control_code:=join; {concatenate two tokens}
+"<": control_code:=module_name; {beginning of a module name}
+"=": control_code:=verbatim; {beginning of \PASCAL\ verbatim mode}
+"\": control_code:=force_line; {force a new line in \PASCAL\ output}
+",", ">", "!", "?", "|", "/", "#", "+", ";", "0","1","2":
+ control_code:=ignore; {Codes used by \.{WEAVE} but ignored by .{TANGLE}}
+othercases
+begin err_print('! Unknown control code: ', '@@', xchr[c]);
+ @.Unknown control code@>
+ control_code:=ignore;
+end;
+endcases;
+end;
+
+@ The |skip_ahead| procedure reads through the input at fairly high speed
+until finding the next non-ignorable control code, which it returns.
+
+@p function skip_ahead:eight_bits; {skip to next control code}
+label done;
+var c:eight_bits; {control code found}
+begin loop begin if loc>limit then
+ begin get_line;
+ if input_has_ended then
+ begin c:=new_module; goto done;
+ end;
+ end;
+ buffer[limit+1]:="@@";
+ while buffer[loc]<>"@@" do incr(loc);
+ if loc<=limit then
+ begin loc:=loc+2; c:=control_code(buffer[loc-1]);
+ if (c<>ignore)or(buffer[loc-1]=">") then goto done;
+ end;
+ end;
+done: skip_ahead:=c;
+end;
+
+@ The |skip_comment| procedure reads through the input at somewhat high speed
+until finding the first unmatched right brace or until coming to the end
+of the file. It ignores characters following `\.\\' characters, since all
+braces that aren't nested are supposed to be hidden in that way. For
+example, consider the process of skipping the first comment below,
+where the string containing the right brace has been typed as \.{\`\\.\\\}\'}
+in the \.{WEB} file.
+
+@p procedure skip_comment; {skips to next unmatched `\.\}'}
+label exit;
+var bal:eight_bits; {excess of left braces}
+@!c:ASCII_code; {current character}
+begin bal:=0;
+loop@+ begin if loc>limit then
+ begin get_line;
+ if input_has_ended then
+ begin err_print('! Input ended in mid-comment');
+@.Input ended in mid-comment@>
+ return;
+ end;
+ end;
+ c:=buffer[loc]; incr(loc);
+ @<Do special things when |c="@@", "\", "{", "}"|; |return| at end@>;
+ end;
+exit:end;
+
+@ @<Do special things when |c="@@"...@>=
+if c="@@" then
+ begin c:=buffer[loc];
+ if (c<>" ")and(c<>tab_mark)and(c<>"*")and(c<>"z")and(c<>"Z") then incr(loc)
+ else begin err_print('! Section ended in mid-comment');
+@.Section ended in mid-comment@>
+ decr(loc); return;
+ end
+ end
+else if (c="\")and(buffer[loc]<>"@@") then incr(loc)
+else if c="{" then incr(bal)
+else if c="}" then
+ begin if bal=0 then return;
+ decr(bal);
+ end
+
+@* Inputting the next token.
+As stated above, \.{TANGLE}'s most interesting input procedure is the
+|get_next| routine that inputs the next token. However, the procedure
+isn't especially difficult.
+
+In most cases the tokens output by |get_next| have the form used in
+replacement texts, except that two-byte tokens are not produced.
+An identifier that isn't one letter long is represented by the
+output `|identifier|', and in such a case the global variables
+|id_first| and |id_loc| will have been set to the appropriate values
+needed by the |id_lookup| procedure. A string that begins with a
+double-quote is also considered an |identifier|, and in such a case
+the global variable |double_chars| will also have been set appropriately.
+Control codes produce the corresponding output of the |control_code|
+function above; and if that code is |module_name|, the value of |cur_module|
+will point to the |byte_start| entry for that module name.
+
+Another global variable, |scanning_hex|, is |true| during the time that
+the letters \.A through \.F should be treated as if they were digits.
+
+@<Globals...@>=
+@!cur_module: name_pointer; {name of module just scanned}
+@!scanning_hex: boolean; {are we scanning a hexadecimal constant?}
+
+@ @<Set init...@>=
+scanning_hex:=false;
+
+@ At the top level, |get_next| is a multi-way switch based on the next
+character in the input buffer. A |new_module| code is inserted at the
+very end of the input file.
+
+@p function get_next:eight_bits; {produces the next input token}
+label restart,done,found;
+var c:eight_bits; {the current character}
+@!d:eight_bits; {the next character}
+@!j,@!k:0..longest_name; {indices into |mod_text|}
+begin restart: if loc>limit then
+ begin get_line;
+ if input_has_ended then
+ begin c:=new_module; goto found;
+ end;
+ end;
+c:=buffer[loc]; incr(loc);
+if scanning_hex then @<Go to |found| if |c| is a hexadecimal digit,
+ otherwise set |scanning_hex:=false|@>;
+case c of
+"A",up_to("Z"),"a",up_to("z"): @<Get an identifier@>;
+"""": @<Get a preprocessed string@>;
+"@@": @<Get control code and possible module name@>;
+@t\4@>@<Compress two-symbol combinations like `\.{:=}'@>@;
+" ",tab_mark: goto restart; {ignore spaces and tabs}
+"{": begin skip_comment; goto restart;
+ end;
+othercases if c>=128 then goto restart {ignore nonstandard characters}
+ else do_nothing
+endcases;
+found:@!debug if trouble_shooting then debug_help;@;@+gubed@/
+get_next:=c;
+end;
+
+@ @<Go to |found| if |c| is a hexadecimal digit...@>=
+if ((c>="0")and(c<="9"))or((c>="A")and(c<="F")) then goto found
+else scanning_hex:=false
+
+@ Note that the following code substitutes \.{@@\{} and \.{@@\}} for the
+respective combinations `\.{(*}' and `\.{*)}'. Explicit braces should be used
+for \TeX\ comments in \PASCAL\ text.
+
+@d compress(#)==begin if loc<=limit then begin c:=#; incr(loc); end; end
+
+@<Compress two-symbol...@>=
+".": if buffer[loc]="." then compress(double_dot)
+ else if buffer[loc]=")" then compress("]");
+":": if buffer[loc]="=" then compress(left_arrow);
+"=": if buffer[loc]="=" then compress(equivalence_sign);
+">": if buffer[loc]="=" then compress(greater_or_equal);
+"<": if buffer[loc]="=" then compress(less_or_equal)
+ else if buffer[loc]=">" then compress(not_equal);
+"(": if buffer[loc]="*" then compress(begin_comment)
+ else if buffer[loc]="." then compress("[");
+"*": if buffer[loc]=")" then compress(end_comment);
+
+@ We have to look at the preceding character to make sure this isn't part
+of a real constant, before trying to find an identifier starting with
+`\.e' or `\.E'.
+
+@<Get an identifier@>=
+begin if ((c="e")or(c="E"))and(loc>1) then
+ if (buffer[loc-2]<="9")and(buffer[loc-2]>="0") then c:=0;
+if c<>0 then
+ begin decr(loc); id_first:=loc;
+ repeat incr(loc); d:=buffer[loc];
+ until ((d<"0")or((d>"9")and(d<"A"))or((d>"Z")and(d<"a"))or(d>"z")) and
+ (d<>"_");
+ if loc>id_first+1 then
+ begin c:=identifier; id_loc:=loc;
+ end;
+ end
+else c:="E"; {exponent of a real constant}
+end
+
+@ A string that starts and ends with double-quote marks is converted into
+an identifier that behaves like a numeric macro by means of the following
+piece of the program.
+@^preprocessed strings@>
+
+@<Get a preprocessed string@>=
+begin double_chars:=0; id_first:=loc-1;
+repeat d:=buffer[loc]; incr(loc);
+ if (d="""")or(d="@@") then
+ if buffer[loc]=d then
+ begin incr(loc); d:=0; incr(double_chars);
+ end
+ else begin if d="@@" then err_print('! Double @@ sign missing')
+@.Double \AT! sign missing@>
+ end
+ else if loc>limit then
+ begin err_print('! String constant didn''t end'); d:="""";
+@.String constant didn't end@>
+ end;
+until d="""";
+id_loc:=loc-1; c:=identifier;
+end
+
+@ After an \.{@@} sign has been scanned, the next character tells us
+whether there is more work to do.
+
+@<Get control code and possible module name@>=
+begin c:=control_code(buffer[loc]); incr(loc);
+if c=ignore then goto restart
+else if c=hex then scanning_hex:=true
+else if c=module_name then
+ @<Scan the \(module name and make |cur_module| point to it@>
+else if c=control_text then
+ begin repeat c:=skip_ahead;
+ until c<>"@@";
+ if buffer[loc-1]<>">" then
+ err_print('! Improper @@ within control text');
+@.Improper \AT! within control text@>
+ goto restart;
+ end;
+end
+
+@ @<Scan the \(module name...@>=
+begin @<Put module name into |mod_text[1..k]|@>;
+if k>3 then
+ begin if (mod_text[k]=".")and(mod_text[k-1]=".")and(mod_text[k-2]=".") then
+ cur_module:=prefix_lookup(k-3)
+ else cur_module:=mod_lookup(k);
+ end
+else cur_module:=mod_lookup(k);
+end
+
+@ Module names are placed into the |mod_text| array with consecutive spaces,
+tabs, and carriage-returns replaced by single spaces. There will be no
+spaces at the beginning or the end. (We set |mod_text[0]:=" "| to facilitate
+this, since the |mod_lookup| routine uses |mod_text[1]| as the first
+character of the name.)
+
+@<Set init...@>=mod_text[0]:=" ";
+
+@ @<Put module name...@>=
+k:=0;
+loop@+ begin if loc>limit then
+ begin get_line;
+ if input_has_ended then
+ begin err_print('! Input ended in section name');
+@.Input ended in section name@>
+ goto done;
+ end;
+ end;
+ d:=buffer[loc];
+ @<If end of name, |goto done|@>;
+ incr(loc); if k<longest_name-1 then incr(k);
+ if (d=" ")or(d=tab_mark) then
+ begin d:=" "; if mod_text[k-1]=" " then decr(k);
+ end;
+ mod_text[k]:=d;
+ end;
+done: @<Check for overlong name@>;
+if (mod_text[k]=" ")and(k>0) then decr(k);
+
+@ @<If end of name,...@>=
+if d="@@" then
+ begin d:=buffer[loc+1];
+ if d=">" then
+ begin loc:=loc+2; goto done;
+ end;
+ if (d=" ")or(d=tab_mark)or(d="*") then
+ begin err_print('! Section name didn''t end'); goto done;
+@.Section name didn't end@>
+ end;
+ incr(k); mod_text[k]:="@@"; incr(loc); {now |d=buffer[loc]| again}
+ end
+
+@ @<Check for overlong name@>=
+if k>=longest_name-2 then
+ begin print_nl('! Section name too long: ');
+@.Section name too long@>
+ for j:=1 to 25 do print(xchr[mod_text[j]]);
+ print('...'); mark_harmless;
+ end
+
+@* Scanning a numeric definition.
+When \.{TANGLE} looks at the \PASCAL\ text following the `\.=' of a numeric
+macro definition, it calls on the precedure |scan_numeric(p)|, where |p|
+points to the name that is to be defined. This procedure evaluates the
+right-hand side, which must consist entirely of integer constants and
+defined numeric macros connected with \.+ and \.- signs (no parentheses).
+It also sets the global variable |next_control| to the control code that
+terminated this definition.
+
+A definition ends with the control codes |definition|, |format|, |module_name|,
+|begin_Pascal|, and |new_module|, all of which can be recognized
+by the fact that they are the largest values |get_next| can return.
+
+@d end_of_definition(#)==(#>=format)
+ {is |#| a control code ending a definition?}
+
+@<Global...@>=
+@!next_control:eight_bits; {control code waiting to be acted upon}
+
+@ The evaluation of a numeric expression makes use of two variables called the
+|accumulator| and the |next_sign|. At the beginning, |accumulator| is zero and
+|next_sign| is $+1$. When a \.+ or \.- is scanned, |next_sign| is multiplied
+by the value of that sign. When a numeric value is scanned, it is multiplied by
+|next_sign| and added to the |accumulator|, then |next_sign| is reset to $+1$.
+
+@d add_in(#)==begin accumulator:=accumulator+next_sign*(#); next_sign:=+1;
+ end
+
+@p procedure scan_numeric(@!p:name_pointer); {defines numeric macros}
+label reswitch, done;
+var accumulator:integer; {accumulates sums}
+@!next_sign:-1..+1; {sign to attach to next value}
+@!q:name_pointer; {points to identifiers being evaluated}
+@!val:integer; {constants being evaluated}
+begin @<Set \(|accumulator| to the value of the right-hand side@>;
+if abs(accumulator)>=@'100000 then
+ begin err_print('! Value too big: ',accumulator:1); accumulator:=0;
+@.Value too big@>
+ end;
+equiv[p]:=accumulator+@'100000; {name |p| now is defined to equal |accumulator|}
+end;
+
+@ @<Set \(|accumulator| to the value of the right-hand side@>=
+accumulator:=0; next_sign:=+1;
+loop@+ begin next_control:=get_next;
+ reswitch: case next_control of
+ digits: begin @<Set |val| to value of decimal constant, and
+ set |next_control| to the following token@>;
+ add_in(val); goto reswitch;
+ end;
+ octal: begin @<Set |val| to value of octal constant, and
+ set |next_control| to the following token@>;
+ add_in(val); goto reswitch;
+ end;
+ hex: begin @<Set |val| to value of hexadecimal constant, and
+ set |next_control| to the following token@>;
+ add_in(val); goto reswitch;
+ end;
+ identifier: begin q:=id_lookup(normal);
+ if ilk[q]<>numeric then
+ begin next_control:="*"; goto reswitch; {leads to error}
+ end;
+ add_in(equiv[q]-@'100000);
+ end;
+ "+": do_nothing;
+ "-": next_sign:=-next_sign;
+ format, definition, module_name, begin_Pascal, new_module: goto done;
+ ";": err_print('! Omit semicolon in numeric definition');
+@.Omit semicolon in numeric def...@>
+ othercases @<Signal error, flush rest of the definition@>
+ endcases;
+ end;
+done:
+
+@ @<Signal error, flush rest...@>=
+begin err_print('! Improper numeric definition will be flushed');
+@.Improper numeric definition...@>
+repeat next_control:=skip_ahead
+until end_of_definition(next_control);
+if next_control=module_name then
+ begin {we want to scan the module name too}
+ loc:=loc-2; next_control:=get_next;
+ end;
+accumulator:=0; goto done;
+end
+
+@ @<Set |val| to value of decimal...@>=
+val:=0;
+repeat val:=10*val+next_control-"0"; next_control:=get_next;
+until (next_control>"9")or(next_control<"0")
+
+@ @<Set |val| to value of octal...@>=
+val:=0; next_control:="0";
+repeat val:=8*val+next_control-"0"; next_control:=get_next;
+until (next_control>"7")or(next_control<"0")
+
+@ @<Set |val| to value of hex...@>=
+val:=0; next_control:="0";
+repeat if next_control>="A" then next_control:=next_control+"0"+10-"A";
+val:=16*val+next_control-"0"; next_control:=get_next;
+until (next_control>"F")or(next_control<"0")or@|
+ ((next_control>"9")and(next_control<"A"))
+
+@* Scanning a macro definition.
+The rules for generating the replacement texts corresponding to simple
+macros, parametric macros, and \PASCAL\ texts of a module are almost
+identical, so a single procedure is used for all three cases. The
+differences are that
+
+\yskip\item{a)} The sign |#| denotes a parameter only when it appears
+outside of strings in a parametric macro; otherwise it stands for the
+ASCII character |#|. (This is not used in standard \PASCAL, but some
+\PASCAL s allow, for example, `\.{/\#}' after a certain kind of file name.)
+
+\item{b)}Module names are not allowed in simple macros or parametric macros;
+in fact, the appearance of a module name terminates such macros and denotes
+the name of the current module.
+
+\item{c)}The symbols \.{@@d} and \.{@@f} and \.{@@p} are not allowed after
+module names, while they terminate macro definitions.
+
+@ Therefore there is a procedure |scan_repl| whose parameter |t| specifies
+either |simple| or |parametric| or |module_name|. After |scan_repl| has
+acted, |cur_repl_text| will point to the replacement text just generated, and
+|next_control| will contain the control code that terminated the activity.
+
+@<Globals...@>=
+@!cur_repl_text:text_pointer; {replacement text formed by |scan_repl|}
+
+@ @p procedure scan_repl(@!t:eight_bits); {creates a replacement text}
+label continue, done, found;
+var a:sixteen_bits; {the current token}
+@!b:ASCII_code; {a character from the buffer}
+@!bal:eight_bits; {left parentheses minus right parentheses}
+begin bal:=0;
+loop@+ begin continue: a:=get_next;
+ case a of
+ "(": incr(bal);
+ ")": if bal=0 then err_print('! Extra )')
+@.Extra )@>
+ else decr(bal);
+ "'": @<Copy a string from the buffer to |tok_mem|@>;
+ "#": if t=parametric then a:=param;
+ @t\4@>@<In cases that |a| is a non-ASCII token (|identifier|,
+ |module_name|, etc.), either process it and change |a| to a byte
+ that should be stored, or |goto continue| if |a| should be ignored,
+ or |goto done| if |a| signals the end of this replacement text@>@;
+ othercases do_nothing
+ endcases;@/
+ app_repl(a); {store |a| in |tok_mem|}
+ end;
+done: next_control:=a;
+@<Make sure the parentheses balance@>;
+if text_ptr>max_texts-zz then overflow('text');
+cur_repl_text:=text_ptr; tok_start[text_ptr+zz]:=tok_ptr[z];
+incr(text_ptr);
+if z=zz-1 then z:=0@+else incr(z);
+end;
+
+@ @<Make sure the parentheses balance@>=
+if bal>0 then
+ begin if bal=1 then err_print('! Missing )')
+ else err_print('! Missing ',bal:1,' )''s');
+@.Missing n )@>
+ while bal>0 do
+ begin app_repl(")"); decr(bal);
+ end;
+ end
+
+@ @<In cases that |a| is...@>=
+identifier: begin a:=id_lookup(normal); app_repl((a div @'400)+@'200);
+ a:=a mod @'400;
+ end;
+module_name: if t<>module_name then goto done
+ else
+ begin @<Was an `@@ ' missed here? @>;
+ app_repl((cur_module div @'400)+@'250);
+ a:=cur_module mod @'400;
+ end;
+verbatim: @<Copy verbatim string from the buffer to |tok_mem|@>;
+definition, format, begin_Pascal: if t<>module_name then goto done
+ else begin err_print('! @@',xchr[buffer[loc-1]],
+@.\AT!p is ignored in PASCAL text@>
+@.\AT!d is ignored in PASCAL text@>
+@.\AT!f is ignored in PASCAL text@>
+ ' is ignored in PASCAL text: missing module-start?');
+ @.Missing module-start?@>
+ @<Show last checkpoint@>;
+ goto continue;
+ end;
+new_module: goto done;
+
+@ @<Copy a string...@>=
+begin b:="'";
+loop@+ begin app_repl(b);
+ if b="@@" then
+ if buffer[loc]="@@" then incr(loc) {store only one \.{@@}}
+ else err_print('! You should double @@ signs in strings');
+@.You should double \AT! signs@>
+ if loc=limit then
+ begin err_print('! String didn''t end');
+@.String didn't end@>
+ buffer[loc]:="'"; buffer[loc+1]:=0;
+ end;
+ b:=buffer[loc]; incr(loc);
+ if b="'" then
+ begin if buffer[loc]<>"'" then goto found
+ else begin incr(loc); app_repl("'");
+ end;
+ end;
+ end;
+found: end {now |a| holds the final |"'"| that will be stored}
+
+@ @<Copy verbatim string...@>=
+begin app_repl(verbatim);
+buffer[limit+1]:="@@";
+while buffer[loc]<>"@@" do
+ begin app_repl(buffer[loc]);
+ incr(loc);
+ if loc<limit then
+ if (buffer[loc]="@@") and (buffer[loc+1]="@@") then
+ begin app_repl("@@");
+ loc:=loc+2;
+ end;
+ end;
+if loc>=limit then err_print('! Verbatim string didn''t end')
+@.Verbatim string didn't end@>
+else if buffer[loc+1]<>">" then
+ err_print('! You should double @@ signs in verbatim strings');
+@.You should double \AT! signs@>
+loc:=loc+2;
+end {another |verbatim| byte will be stored, since |a=verbatim|}
+
+@ The following procedure is used to define a simple or parametric macro,
+just after the `\.{==}' of its definition has been scanned.
+
+@p procedure define_macro(@!t:eight_bits);
+var p:name_pointer; {the identifier being defined}
+begin p:=id_lookup(t); scan_repl(t);@/
+equiv[p]:=cur_repl_text; text_link[cur_repl_text]:=0;
+end;
+
+@* Scanning a module.
+The |scan_module| procedure starts when `\.{@@\ }' or `\.{@@*}' has been
+sensed in the input, and it proceeds until the end of that module. It
+uses |module_count| to keep track of the current module number; with luck,
+\.{WEAVE} and \.{TANGLE} will both assign the same numbers to modules.
+
+@<Globals...@>=
+@!module_count:0..@'27777; {the current module number}
+
+@ The top level of |scan_module| is trivial.
+@p procedure scan_module;
+label continue, done, exit;
+var p:name_pointer; {module name for the current module}
+begin incr(module_count);
+@<Scan the \(definition part of the current module@>;
+@<Scan the \PASCAL\ part of the current module@>;
+exit: end;
+
+@ @<Scan the \(definition part...@>=
+next_control:=0;
+loop@+ begin continue: while next_control<=format do
+ begin next_control:=skip_ahead;
+ if next_control=module_name then
+ begin {we want to scan the module name too}
+ loc:=loc-2; next_control:=get_next;
+ end;
+ end;
+ if next_control<>definition then goto done;
+ next_control:=get_next; {get identifier name}
+ if next_control<>identifier then
+ begin err_print('! Definition flushed, must start with ',
+@.Definition flushed...@>
+ 'identifier of length > 1'); goto continue;
+ end;
+ next_control:=get_next; {get token after the identifier}
+ if next_control="=" then
+ begin scan_numeric(id_lookup(numeric)); goto continue;
+ end
+ else if next_control=equivalence_sign then
+ begin define_macro(simple); goto continue;
+ end
+ else @<If the next text is `|(#)==|', call |define_macro|
+ and |goto continue|@>;
+ err_print('! Definition flushed since it starts badly');
+@.Definition flushed...@>
+ end;
+done:
+
+@ @<If the next text is `|(#)==|'...@>=
+if next_control="(" then
+ begin next_control:=get_next;
+ if next_control="#" then
+ begin next_control:=get_next;
+ if next_control=")" then
+ begin next_control:=get_next;
+ if next_control="=" then
+ begin err_print('! Use == for macros');
+@.Use == for macros@>
+ next_control:=equivalence_sign;
+ end;
+ if next_control=equivalence_sign then
+ begin define_macro(parametric); goto continue;
+ end;
+ end;
+ end;
+ end;
+
+@ @<Scan the \PASCAL...@>=
+case next_control of
+begin_Pascal:p:=0;
+module_name: begin p:=cur_module;
+ @<Check that |=| or |==| follows this module name, otherwise |return|@>;
+ end;
+othercases return
+endcases;@/
+@<Insert the module number into |tok_mem|@>;
+scan_repl(module_name); {now |cur_repl_text| points to the replacement text}
+@<Update the data structure so that the replacement text is accessible@>;
+
+@ @<Check that |=|...@>=
+repeat next_control:=get_next;
+until next_control<>"+"; {allow optional `\.{+=}'}
+if (next_control<>"=")and(next_control<>equivalence_sign) then
+ begin err_print('! Pascal text flushed, = sign is missing');
+@.Pascal text flushed...@>
+ repeat next_control:=skip_ahead;
+ until next_control=new_module;
+ return;
+ end
+
+@ @<Insert the module number...@>=
+store_two_bytes(@'150000+module_count); {|@'150000=@'320*@'400|}
+
+@ @<Update the data...@>=
+if p=0 then {unnamed module}
+ begin text_link[last_unnamed]:=cur_repl_text; last_unnamed:=cur_repl_text;
+ end
+else if equiv[p]=0 then equiv[p]:=cur_repl_text {first module of this name}
+else begin p:=equiv[p];
+ while text_link[p]<module_flag do p:=text_link[p]; {find end of list}
+ text_link[p]:=cur_repl_text;
+ end;
+text_link[cur_repl_text]:=module_flag;
+ {mark this replacement text as a nonmacro}
+
+@* Debugging.
+The \PASCAL\ debugger with which \.{TANGLE} was developed allows breakpoints
+to be set, and variables can be read and changed, but procedures cannot be
+executed. Therefore a `|debug_help|' procedure has been inserted in the main
+loops of each phase of the program; when |ddt| and |dd| are set to appropriate
+values, symbolic printouts of various tables will appear.
+
+The idea is to set a breakpoint inside the |debug_help| routine, at the
+place of `\ignorespaces|breakpoint:|\unskip' below. Then when
+|debug_help| is to be activated, set |trouble_shooting| equal to |true|.
+The |debug_help| routine will prompt you for values of |ddt| and |dd|,
+discontinuing this when |ddt<=0|; thus you type $2n+1$ integers, ending
+with zero or a negative number. Then control either passes to the
+breakpoint, allowing you to look at and/or change variables (if you typed
+zero), or to exit the routine (if you typed a negative value).
+
+Another global variable, |debug_cycle|, can be used to skip silently
+past calls on |debug_help|. If you set |debug_cycle>1|, the program stops
+only every |debug_cycle| times |debug_help| is called; however,
+any error stop will set |debug_cycle| to zero.
+
+@<Globals...@>=
+@!debug@!trouble_shooting:boolean; {is |debug_help| wanted?}
+@!ddt:integer; {operation code for the |debug_help| routine}
+@!dd:integer; {operand in procedures performed by |debug_help|}
+@!debug_cycle:integer; {threshold for |debug_help| stopping}
+@!debug_skipped:integer; {we have skipped this many |debug_help| calls}
+@!term_in:text_file; {the user's terminal as an input file}
+gubed
+
+@ The debugging routine needs to read from the user's terminal.
+@^system dependencies@>
+@<Set init...@>=
+@!debug trouble_shooting:=true; debug_cycle:=1; debug_skipped:=0;@/
+trouble_shooting:=false; debug_cycle:=99999; {use these when it almost works}
+reset(term_in,'TTY:','/I'); {open |term_in| as the terminal, don't do a |get|}
+gubed
+
+@ @d breakpoint=888 {place where a breakpoint is desirable}
+@^system dependencies@>
+
+@p @!debug procedure debug_help; {routine to display various things}
+label breakpoint,exit;
+var k:integer; {index into various arrays}
+begin incr(debug_skipped);
+if debug_skipped<debug_cycle then return;
+debug_skipped:=0;
+loop@+ begin new_line; write(term_out,'#'); update_terminal; {prompt}
+ read(term_in,ddt); {read a list of integers}
+ if ddt<0 then return
+ else if ddt=0 then
+ begin goto breakpoint;@\ {go to every label at least once}
+ breakpoint: ddt:=0;@\
+ end
+ else begin read(term_in,dd);
+ case ddt of
+ 1: print_id(dd);
+ 2: print_repl(dd);
+ 3: for k:=1 to dd do print(xchr[buffer[k]]);
+ 4: for k:=1 to dd do print(xchr[mod_text[k]]);
+ 5: for k:=1 to out_ptr do print(xchr[out_buf[k]]);
+ 6: for k:=1 to dd do print(xchr[out_contrib[k]]);
+ othercases print('?')
+ endcases;
+ end;
+ end;
+exit:end;
+gubed
+
+@* The main program.
+We have defined plenty of procedures, and it is time to put the last
+pieces of the puzzle in place. Here is where \.{TANGLE} starts, and where
+it ends.
+@^system dependencies@>
+
+@p begin initialize;
+@<Initialize the input system@>;
+print_ln(banner); {print a ``banner line''}
+@<Phase I: Read all the user's text and compress it into |tok_mem|@>;
+stat for zo:=0 to zz-1 do max_tok_ptr[zo]:=tok_ptr[zo];@+tats@;@/
+@<Phase II:...@>;
+end_of_TANGLE:
+if string_ptr>256 then @<Finish off the string pool file@>;
+stat @<Print statistics about memory usage@>;@+tats@;@/
+@t\4\4@>{here files should be closed if the operating system requires it}
+@<Print the job |history|@>;
+end.
+
+@ @<Phase I:...@>=
+phase_one:=true;
+module_count:=0;
+repeat next_control:=skip_ahead;
+until next_control=new_module;
+while not input_has_ended do scan_module;
+@<Check that all changes have been read@>;
+phase_one:=false;
+
+@ @<Finish off the string pool file@>=
+begin print_nl(string_ptr-256:1, ' strings written to string pool file.');
+write(pool,'*');
+for string_ptr:=1 to 9 do
+ begin out_buf[string_ptr]:=pool_check_sum mod 10;
+ pool_check_sum:=pool_check_sum div 10;
+ end;
+for string_ptr:=9 downto 1 do write(pool,xchr["0"+out_buf[string_ptr]]);
+write_ln(pool);
+end
+
+@ @<Glob...@>=
+stat @!wo:0..ww-1; {segment of memory for which statistics are being printed}
+tats
+
+@ @<Print statistics about memory usage@>=
+print_nl('Memory usage statistics:');
+print_nl(name_ptr:1, ' names, ', text_ptr:1, ' replacement texts;');
+print_nl(byte_ptr[0]:1);
+for wo:=1 to ww-1 do print('+',byte_ptr[wo]:1);
+print(' bytes, ', max_tok_ptr[0]:1);
+for zo:=1 to zz-1 do print('+',max_tok_ptr[zo]:1);
+print(' tokens.');
+
+@ Some implementations may wish to pass the |history| value to the
+operating system so that it can be used to govern whether or not other
+programs are started. Here we simply report the history to the user.
+@^system dependencies@>
+
+@<Print the job |history|@>=
+case history of
+spotless: print_nl('(No errors were found.)');
+harmless_message: print_nl('(Did you see the warning message above?)');
+error_message: print_nl('(Pardon me, but I think I spotted something wrong.)');
+fatal_message: print_nl('(That was a fatal error, my friend.)');
+end {there are no other cases}
+
+@* Error detection.
+This section is an attempt to improve \.{TANGLE} by making it detect certain
+errors. Most of the additional code goes in here, so as not to disturb the
+module numbers of the rest of the program.
+
+First: two consecutive modules in a \.{WEB} program must be separated by the
+string `@@ ' . If this is omitted, this error usually damages the \.{Pascal}
+output. If \.{TANGLE} does not detect this error, then the user will probably
+try to compile the damaged output. The likeliest result is that the compiler
+becomes confused, and prints lots of error reports that bear no clear relation
+to the cause of the trouble.
+
+In order to try to detect this error, \.{TANGLE} now enforces an extra rule of
+syntax: if the replacement text of one module includes a call of a second
+module, then that call may not be immediately followed (on the same input
+line) by `=' or `+=' . This rule is not really valid for \.{WEB} programs: one
+might want to say:
+
+$$ \hbox{if \AT!<the variable we are interested in \AT!>= 0 then...} $$
+
+but this construction seems unlikely in \.{Pascal}, and it can still be used
+if you put the equals sign on the next line.
+
+@ Here is the code that performs the test. We have just read a module name
+within the replacement text of a module. |loc| should be pointing to the next
+character after the `@@>' that ends the module name. Note that we must look
+ahead without actually moving forward in the input file.
+
+@<Was an `@@ ' missed here? @>=
+ try_loc := loc;
+ while (buffer[try_loc] = " " ) and (try_loc < limit) do incr(try_loc);
+ if (buffer[try_loc] = "+" ) and (try_loc < limit) then incr(try_loc);
+ while (buffer[try_loc] = " " ) and (try_loc < limit) do incr(try_loc);
+ if (buffer[try_loc] = "=" ) then
+ begin
+ err_print('Nested module definitions (missing module-start?)');
+ @.Nested module...@>
+ @.Missing module-start?@>
+ @<Show last checkpoint@>;
+ end;
+
+@ This module will be called when \.{TANGLE} thinks it has found a missing
+`@@ '. It tries to help the programmer by indicating where the missing `@@ '
+should have been. It is not possible to tell the exact position, so \.{TANGLE}
+will only indicate a range of line numbers. The formal error is an illegal
+construction within the \.{Pascal} code of the current module, and \.{TANGLE}
+says where it thinks that module started.
+
+@<Show last checkpoint@>=
+ print_nl (' Pascal part began at line ' , last_line:1 );
+ if was_changing then print(' in change file');
+ print_ln ( ' ');
+ @.Pascal part began...@>
+
+@ The checkpoint is set at the start of the \.{Pascal} code of each module,
+also at the beginning of the program.
+
+@<Scan the \(definition part...@>=
+ last_line := line ;
+ was_changing := changing;
+
+@ @<Set init...@>=
+ last_line := 0; {place where current module started}
+ was_changing := false;
+
+@ @<Glob...@>=
+ last_line, try_loc: integer ;
+ was_changing: boolean;
+
+@ Another error is that of writing a program containing the sequence
+`|; else|', which \.{Pascal} does not allow. This is easy to do, especially
+if the semicolon and the |else| come from different modules. Although there is
+absolutely no reason why you cannot say `|; else|' in \.{WEB}, it is still
+desirable that \.{TANGLE} should detect this, as (on some machines) \.{TANGLE}
+runs much faster than the \.{Pascal} compiler. To detect this error requires
+quite a bit of ``cookery''. The first step is to put an |else| into the
+|byte_mem|.
+
+@<Glob...@>=
+point_else: name_pointer;
+semi_last: boolean ; {the last output was a semicolon}
+
+@ @<Initialize the input system@>=
+ buffer[0] := "e" ; buffer[1] := "l" ;
+ buffer[2] := "s" ; buffer[3] := "e" ;
+ id_first := 0;
+ id_loc := 4 ;
+ point_else := id_lookup( normal);
+ buffer[0] := " " ;
+ semi_last := false ;
+
+@ Then |send_the_output| tests for `|; else|' . This test is crude; it will
+not recognise `ELSE' or `Else' or the output from `el \@\& se'.
+
+@<Semicolon-else test@>=
+ if (cur_char = begin_comment) or (cur_char = join )
+ or (cur_char = module_number) or (cur_char = 0 )
+ or (cur_char = force_line) or (brace_level > 0 )
+ then do_nothing
+ else if cur_char = ";" then semi_last := true
+ else if semi_last and (cur_char = identifier) and (cur_val = point_else)
+ then err_print ('! semicolon-ELSE found')
+ @.semicolon-ELSE found@>
+ else semi_last := false;
+
+@ Now suppose the programmer has made a circular definition, either of modules
+or of macros. Then when \.{TANGLE} tries to expand the definition, the |stack|
+will overflow. Left to itself, \.{TANGLE} prints an unhelpful diagnostic. So
+first we climb down the stack...
+
+@<Look for circular definition@>=
+ bot := stack_size - 1 ;
+ while ( bot > 0) and ( stack[bot].name_field <> cur_name )
+ do decr( bot) ;
+ if bot = 0 then overflow( 'stack' )
+ else begin
+
+@ Now we know there was a circular definition. We locate the outermost circle,
+and print a list of the offending names.
+
+@<Look for circular definition@>=
+ top := stack_size ;
+ while ( bot > 0) and ( stack[bot].name_field = stack[top].name_field )
+ do begin decr( bot) ; decr( top) ; end ;
+ new_line ;
+ print_ln ( 'Circular definition, involving: ') ;
+ @.Circular definition@>
+ for k := bot + 1 to top do begin
+ print_id ( stack[k].name_field ) ;
+ new_line ;
+ end;
+
+@ Although a circular definition is a bad error because it guarantees that we
+cannot recover a correct \.{Pascal} text, we must still try to fix things and
+keep going. It is a well known principle that any decent compiler must try to
+find as many errors per pass as possible; hence, it must not stop if there is
+any way it can continue. So first we clear the rubbish off the stack, then
+forcibly break the circle.
+
+@<Look for circular definition@>=
+ while stack_ptr >= bot + 1 do pop_level ;
+ equiv[ stack[bot+1].name_field ] := 0 ;
+ mark_fatal ; error;
+ end;
+
+@* System-dependent changes.
+This module should be replaced, if necessary, by changes to the program
+that are necessary to make \.{TANGLE} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous modules preserve the module numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new modules, can be inserted here; then only the index
+itself will get a new module number.
+@^system dependencies@>
+
+@* Index.
+Here is a cross-reference table for the \.{TANGLE} processor.
+All modules in which an identifier is
+used are listed with that identifier, except that reserved words are
+indexed only when they appear in format definitions, and the appearances
+of identifiers in module names are not indexed. Underlined entries
+correspond to where the identifier was declared. Error messages and
+a few other things like ``ASCII code'' are indexed here too.
diff --git a/dviware/crudetype/version3/nasty.tex b/dviware/crudetype/version3/nasty.tex
new file mode 100644
index 0000000000..9b9df6c5bb
--- /dev/null
+++ b/dviware/crudetype/version3/nasty.tex
@@ -0,0 +1,167 @@
+\input webmac
+
+% NASTY.TEX. Designed to catch bugs in Crudetype device driver
+% Here is TeX material that gets inserted after \input webmac
+
+\message{!! For lineprinter, magnify me to 115 percent !!}
+
+\def\hang{\hangindent 3em\indent\ignorespaces}
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like PASCAL
+\def\PASCAL{{\mc PASCAL}}
+\def\pb{$\.|\ldots\.|$} % pascal brackets (|...|)
+\def\v{\.{\char'174}} % vertical (|) in typewriter font
+\mathchardef\BA="3224 % double arrow
+\def\({} % kludge for alphabetizing certain module names
+
+\def\title{TANGLE}
+\def\contentspagenumber{0}
+\def\topofcontents{\null\vfill
+ \titlefalse % include headline on the contents page
+ \def\rheader{\mainfont Appendix E\hfil \contentspagenumber}
+ \centerline{\titlefont The {\ttitlefont TANGLE} processor}
+ \vskip 15pt
+ \centerline{(Version 2.5)}
+ \vfill}
+\pageno=\contentspagenumber \advance\pageno by 1
+\def\title{TANGLE changes for \AA Vax/VMS}
+
+
+\N199\*. System-dependent \AA changes.
+Here are the remaining changes to the program
+that are necessary to make \.{TANGLE} work on Vax/VMS.
+
+
+\fi
+
+\M1. \P$\X1:\X\S$\6
+$\\{store\_two\_bytes}(\O{150000}+\\{module\_count})$;\C{$\O{150000}=\O{320}%
+\ast\O{400}$}\par
+\fi
+
+\M200\*. This variable is for speeding up the output routine.
+
+\Y\P$\4\X9:Globals in the outer block\X\mathrel{+}\S$\6
+\4\\{out\_temp\_buffer}: \37\&{packed} \37\&{array} $[1\to\\{out\_buf\_size}]$ %
+\1\&{of}\5
+\\{char};\2\par
+\fi
+
+\M201\*. On Vax/VMS we need the following special definitions, types, variables
+and procedures to be able to get the file name from the command line,
+or to prompt for them.
+
+\Y\P\D \37$\\{VAX\_volatile}\S\={volatile}$\par
+\P\D \37$\\{VAX\_lib\_get\_foreign}\S\={\ lib\$get\_foreign}$\par
+\P\D \37$\\{VAX\_length}\S\={length\ }$\par
+\fi
+
+\M143. Inputting the next token.
+As stated above, \.{TANGLE}'s most interesting input procedure is the
+\\{get\_next} routine that inputs the next token. However, the procedure
+isn't especially difficult.
+
+Another global variable, \\{scanning\_hex}, is \\{true} during the time that
+the letters \.A through \.F should be treated as if they were digits.
+
+\Y\P$\4\X9:Globals in the outer block\X\mathrel{+}\S$\6
+\4\\{cur\_module}: \37\\{name\_pointer};\C{name of module just scanned}\6
+\4\\{scanning\_hex}: \37\\{boolean};\C{are we scanning a hexadecimal constant?}%
+\par
+\fi
+
+\M144. \P$\X10:Set initial values\X\mathrel{+}\S$\6
+$\\{scanning\_hex}\K\\{false}$;\par
+\fi
+
+\M146. \P$\X146:Go to \\{found} if \|c is a hexadecimal digit, otherwise set $%
+\\{scanning\_hex}\K\\{false}$\X\S$\6
+\&{if} $((\|c\G\.{"0"})\W(\|c\L\.{"9"}))\V((\|c\G\.{"A"})\W(\|c\L\.{"F"}))$ \1%
+\&{then}\5
+\&{goto} \37\\{found}\6
+\4\&{else} $\\{scanning\_hex}\K\\{false}$\2\par
+\U section~145.\fi
+
+\def \<{\lbrack} \def \>{\rbrack}
+\def \nl{\hfill\break}
+\font\stt=cmtt9
+\font\rr=cmr10
+\def\cstok#1{\leavevmode\thinspace\hbox{\vrule\vtop{\vbox{\hrule\kern1pt
+ \hbox{\vphantom{\stt/}\thinspace{\stt#1}\thinspace}}
+ \kern1pt\hrule}\vrule}\thinspace} % control sequence token
+
+
+
+% %\def \boxit#1{\vbox{\hrule\hbox{\vrule\kern3pt
+% % \vbox{\kern3pt#1\kern3pt}\kern3pt\vrule}\hrule}}
+% \rr
+\vskip 0.5in
+\centerline{EXAM MARKING PROGRAM}
+
+1. When the program types a question mark, it is asking you for input.
+All input must be terminated by typing the \cstok{RETURN} key.
+
+2. Whenever you do not know what to do next ALWAYS start by typing a question
+mark, or {\tt H}
+ (stands for HELP) (followed by \cstok{RETURN}). This should give a help
+message.
+
+\vskip 0.5in
+ \centerline{Method of use}
+\vskip 0.4in
+
+ Whenever the program types a question mark, it is asking you for input.
+All input must be terminated by typing the \cstok{RETURN} key. On some
+terminals this is labelled \cstok{ENTER}, on others it has a bent arrow. You
+cannot type ahead. You have to type 1 line at a time \& wait for the program
+to digest it. This line-at-a-time mode of operation is very old fashioned and
+clumsy, but I did not think it would be practical to attempt anything better
+with the present combination of a slow VAX, and VMS, and bug-eaten network.
+
+
+
+\N206\*. Index.
+
+
+\ch 1\*, 2\*, 3\*, 4\*, 7\*, 12\*, 20\*, 21\*, 22\*, 26\*, 27\*, 28\*, 38\*, 97%
+\*, 179\*, 180\*, 182\*, 187\*, 199\*, 200\*, 201\*, 202\*, 203\*, 204\*, 205%
+\*, 206\*.
+\inx
+\:\.{ Nested named module }, 189.
+\:\.{\AT!d is ignored in PASCAL text}, 167.
+\:\.{\AT!f is ignored in PASCAL text}, 167.
+\:\.{\AT!p is ignored in PASCAL text}, 167.
+\:\|{a}, \[74], \[87], \[165].
+\:\\{abs}, 103, 157.
+\:\\{accumulator}, \[157], 158, 159.
+\:\\{add\_in}, \[157], 158.
+\:\.{Ambiguous prefix}, 69.
+\:\\{and\_sign}, \[15], 76, 114.
+\:\\{app}, \[99], 101, 102, 103, 111.
+\:\\{app\_repl}, \[93], 165, 166, 167, 168, 169.
+\:\\{app\_val}, \[99], 103, 111.
+\:{ASCII code}, 11, 72.
+\:\\{ASCII\_code}, \[11], 13, 27\*, 28\*, 38\*, 50, 65, 94, 95, 100, 126, 139,
+141, 165, 198.
+\:\\{ask}, \[203\*], 205\*.
+\:\|{b}, \[87], \[97\*], \[165].
+\:\.{bad character in input...}, 197.
+\:\\{bad\_case}, \[107], 109, 110.
+\:\\{bal}, \[87], 93, \[141], 142, \[165], 166.
+\:\\{banner}, \[1\*], 182\*.
+\:\&{begin}, 3\*.
+\:\\{begin\_comment}, \[72], 76, 121, 139, 147, 196.
+\:\\{begin\_pascal}, \[139], 156, 158, 167, 175.
+\:\\{boolean}, 28\*, 29, 124, 127, 143, 179\*, 193, 194, 203\*.
+\:\\{brace\_level}, \[82], 83, 98, 121, 196.
+\:\\{cur\_module}, \[143], 151, 167, 175.
+\:\\{cur\_name}, 78, \[79], 83, 84, 85.
+\:\\{cur\_repl}, 78, \[79], 80, 83, 84, 85.
+\:\\{cur\_repl\_text}, \[164], 165, 170, 175, 178.
+\:\\{cur\_state}, \[79], 84, 85.
+\:\\{cur\_val}, \[86], 87, 89, 116, 119, 121, 196.
+
+
+
+
+\par\vfil\end
diff --git a/dviware/crudetype/version3/noscheme-c.c b/dviware/crudetype/version3/noscheme-c.c
new file mode 100644
index 0000000000..04bd01adc5
--- /dev/null
+++ b/dviware/crudetype/version3/noscheme-c.c
@@ -0,0 +1,3679 @@
+#include "w2c-ext.h"
+/*732*/
+#define padded true
+#define padchar ' '
+#define ampand '&'
+#define ctrlflag '^'
+#define pauseask "PAUSED. Type <return> to continue"
+#define railwidth 1
+#define railheight 1
+#define postwidth 1
+#define postheight 1
+#define railtypes 2
+#define maxDfonts 100
+#define maxDchar 255
+#define maxligs 10000
+#define maxbuf 201
+#define maxstring 100
+#define pagemax 30000
+#define maxlinesize 1000
+#define leftstop 0
+#define deepest 10
+#define hresolution 10
+#define vresolution 6
+#define fixedwidth true
+#define charwidth 1
+#define gapwidth 1
+#define charht 1
+#define minfont 1
+#define maxfont 1
+#define onlyonefont true
+#define candlfont false
+#define mindlfont 0
+#define maxdlfont 0
+#define maxcodes 60
+#define maxplain 4
+typedef unsigned char byte;
+typedef schar bite;
+typedef short iword;
+typedef text /* file of bite*/bytefile;
+typedef schar Dfontptr;
+typedef unsigned char Dcharptr;
+typedef struct{iword breadth;
+ byte IMfont;
+ byte IMchar;
+ iword multi;
+}codeobject;
+typedef schar codeptr;
+typedef schar trio;
+typedef struct{iword vmove;
+ iword hmove;
+ codeobject symbol;
+ iword num;
+ iword guard;
+}ligthing;
+typedef schar sptr;
+typedef char fixstring[maxstring + 1];
+typedef struct{byte len;
+ fixstring data;
+}varstring;
+typedef short pagei;
+typedef pagei link;
+typedef struct{link prox;
+ iword hpos;
+ iword vpos;
+ codeobject symbol;
+ link down;
+}pagerecord;
+integer ini,inj;
+boolean usestdin;
+varstring command;
+boolean squash,runon,quiet,batchview;
+integer magnify,hmag,vmag,firstpage,countpages;
+bytefile dvifile,tfmfile,rasterfile;
+integer dviindx,tfmindx,rasterindx;
+varstring dviname,tfmname,rastername,printname,dvidef,tfmdef,rasterdef,printex
+;
+varstring fontname,pn,pd,pex;
+text printfile;
+boolean start,timetostop,pagegap;
+integer counter[10];
+integer Dh,Dv,Dw,Dx,Dy,Dz;
+integer Dhstack[203],Dvstack[203],Dwstack[203],Dxstack[203],Dystack[203],
+Dzstack[203];
+unsigned char stackht;
+boolean justpushed;
+real dvifactor,hconv,vconv,magnification;
+integer Dlmargin,Dtopmargin,nnn;
+byte bbb;
+codeobject railchars[railtypes + 1];
+integer railbase;
+codeobject postchar;
+Dfontptr nf;
+integer fontnum[maxDfonts + 1],fontspace[maxDfonts + 1],scheme[maxDfonts + 1],
+firstch[maxDfonts + 1],lastch[maxDfonts + 1];
+integer Dwidth[maxDfonts + 1][maxDchar + 1];
+integer Dcheck,thinspace,Dfont,curscheme;
+varstring knownschemes[maxcodes + 1];
+codeptr schememap[maxcodes + 1];
+codeobject codes[maxcodes + 1][maxDchar + 1];
+codeobject nochar;
+codeptr schemetop;
+ligthing ligatures[maxligs + 1];
+short topofligs;
+iword rowfont;
+byte ch;
+fixstring hack;
+varstring buffer,blank;
+sptr thumb,finger;
+integer Dhleft,IMhleft,Dhmid,IMhmid,Dhright,IMhright,IMh,IMv,Ddis,IMdis,Hshunt
+;
+integer IMhstack[203],IMvstack[203];
+iword hmax,vmax,hmin,vmin;
+link zzz,cell,tempp,curpgeptr,mid,midptr,run,runptr,left,leftptr,Lrunptr,right
+,rightptr,Rrunptr;
+pagei pagesize;
+iword Oldv,Oldh;
+boolean sorted;
+pagerecord pool[pagemax + 1];
+iword PRv,PRvnext,PRh,PRhnext,PRfont;
+char deviceID[13];
+boolean list,xwzfortran,bfeedabsolute,bfeedbystring,feedabsolute,bfeedscream,
+bspaceabsolute,bspacebystring,spaceabsolute,absisincr,wldoescr,wantsplit,
+isheader,dopause,inspection;
+integer wlfeeddist,crfeeddist,feeddist,tfeeddist,bfeeddist,tinydrop,bigdrop,
+spacedist,tspacedist,bspacedist,pausei,pausesteps;
+char feedchar,tfeedchar,crchar,spacechar,tspacechar,bspacechar;
+varstring startstuff,stopstuff,pagetop,bfeedstring,fontcommand,vabscom,habscom
+,pauseafter;
+real hfudge,vfudge,lmargin,topmargin;
+
+#include "coerce.h"
+
+#ifdef ANSI
+void error(void)
+#else /* not ANSI*/
+void error()
+#endif /* ANSI*/
+{ ;
+ }
+
+#ifdef ANSI
+void crash(void)
+#else /* not ANSI*/
+void crash()
+#endif /* ANSI*/
+{ real u;
+ u = -1;
+ error();
+ if((u<0))
+ uexit(1);
+ }
+
+#ifdef ANSI
+void zparsefile( varstring name, varstring *dir, varstring *nam, varstring *ex
+)
+#else /* not ANSI*/
+void zparsefile( name, dir, nam, ex)
+ varstring name;
+ varstring *dir;
+ varstring *nam;
+ varstring *ex;
+#endif /* ANSI*/
+{ sptr p,r,s;
+ dir[0] = blank;
+ nam[0] = blank;
+ ex[0] = blank;
+ s = name.len;
+ if((s>0))
+ {
+ p = ssearch(name,'/',- (integer)s);
+ if((p>0))
+ substring(dir[0],name,1,p);
+ r = ssearch(name,'.',- (integer)s);
+ if((r>p))
+ substring(ex[0],name,r,s-r+1);
+ else r = s+1;
+ substring(nam[0],name,p+1,r-p-1);
+ }
+ }
+
+#ifdef ANSI
+void znameof( fixstring result, varstring name)
+#else /* not ANSI*/
+void znameof( result, name)
+ fixstring result;
+ varstring name;
+#endif /* ANSI*/
+{ integer n,i;
+ n = name.len;
+ if((n>maxstring))
+ n = maxstring;
+ {register integer for_end;i=1;for_end=n; if (i<=for_end)do
+ result[i] = name.data[i];
+ while(i++ < for_end);}
+ {register integer for_end;i=n+1;for_end=maxstring; if (i<=for_end)do
+ result[i] = ' ';
+ while(i++ < for_end);}
+ }
+
+#ifdef ANSI
+boolean zopenbinary( bytefile ff, varstring *name, integer searchpath)
+#else /* not ANSI*/
+boolean zopenbinary( ff, name, searchpath)
+ bytefile ff;
+ varstring *name;
+ integer searchpath;
+#endif /* ANSI*/
+{ register boolean Result;ccharpointer curname;
+ curname = name[0].data;
+ if(testreadaccess(curname,searchpath))
+ {
+ reset(ff,curname);
+ Result = true;
+ }
+ else Result = false;
+ return(Result);
+ }
+
+#ifdef ANSI
+void getcommand(void)
+#else /* not ANSI*/
+void getcommand()
+#endif /* ANSI*/
+{ fixstring ss;
+ integer nn;
+ varstring tt;
+ ccharpointer cc;
+ command = blank;
+ {register integer for_end;nn=1;for_end=argc-1; if (nn<=for_end)do
+ {
+ argv(nn,ss);
+ cc = ss;
+ cc = cc+1;
+ setstring(cc,buffer);
+ tt = buffer;
+ append(command,tt);
+ command.len = command.len+1;
+ }
+ while(nn++ < for_end);}
+ }
+
+#ifdef ANSI
+void readterminal(void)
+#else /* not ANSI*/
+void readterminal()
+#endif /* ANSI*/
+{ byte k;
+ buffer = blank;
+ if(!eof(input))
+ {
+ if(eoln(input))
+ readln(input);
+ k = 0;
+ while((!eoln(input))){
+ k = k+1;
+ read(input,buffer.data[k]);
+ }
+ buffer.len = k;
+ finger = 0;
+ {
+ finger = finger+1;
+ ch = ord(buffer.data[finger]);
+ }
+ }
+ }
+
+#ifdef ANSI
+byte zreadbyte( bytefile ffile, integer *findx)
+#else /* not ANSI*/
+byte zreadbyte( ffile, findx)
+ bytefile ffile;
+ integer *findx;
+#endif /* ANSI*/
+{ register byte Result;bite x;
+ if(eof(ffile))
+ {
+ {
+ fprintf( *output, "%s%s%c", "Error: ", "End of file", '\n');
+ error();
+ }
+ Result = 0;
+ }
+ else{
+ read(ffile,x);
+ if(x<0)
+ Result = x+256;
+ else Result = x;
+ findx[0] = findx[0]+1;
+ }
+ return(Result);
+ }
+
+#ifdef ANSI
+void zskipbytes( bytefile ffile, integer *findx, integer n)
+#else /* not ANSI*/
+void zskipbytes( ffile, findx, n)
+ bytefile ffile;
+ integer *findx;
+ integer n;
+#endif /* ANSI*/
+{ integer k;
+ bite x;
+ if(n<0)
+ {
+ fprintf( *output, "%s%s%c",
+ "Fatal: ", "skip_bytes called with negative number", '\n');
+ crash();
+ }
+ findx[0] = findx[0]+n;
+ {register integer for_end;k=1;for_end=n; if (k<=for_end)do
+ {
+ if(eof(ffile))
+ {
+ fprintf( *output, "%s%s%c", "Error: ", "End of file", '\n');
+ error();
+ }
+ else read(ffile,x);
+ }
+ while(k++ < for_end);}
+ }
+
+#ifdef ANSI
+integer zreadinteger( bytefile ffile, integer *findx, integer k)
+#else /* not ANSI*/
+integer zreadinteger( ffile, findx, k)
+ bytefile ffile;
+ integer *findx;
+ integer k;
+#endif /* ANSI*/
+{ register integer Result;byte a,i;
+ integer n;
+ n = readbyte(ffile,findx[0]);
+ if((k<0)&&(n>127))
+ n = n-256;
+ {register integer for_end;i=1;for_end=abs(k)-1; if (i<=for_end)do
+ {
+ a = readbyte(ffile,findx[0]);
+ n = n*256+a;
+ }
+ while(i++ < for_end);}
+ Result = n;
+ return(Result);
+ }
+
+#ifdef ANSI
+void push(void)
+#else /* not ANSI*/
+void push()
+#endif /* ANSI*/
+{ real x;
+ if(stackht==200)
+ {
+ fprintf( *output, "%s%s%*d%c%c",
+ "Fatal: ", "Capacity exceeded (stack size=", 1, 200, ')', '\n');
+ crash();
+ }
+ else{
+ Dhstack[stackht] = Dh;
+ Dvstack[stackht] = Dv;
+ Dwstack[stackht] = Dw;
+ Dxstack[stackht] = Dx;
+ Dystack[stackht] = Dy;
+ Dzstack[stackht] = Dz;
+ IMhstack[stackht] = IMh;
+ IMvstack[stackht] = IMv;
+ if(justpushed&&(stackht>0))
+ {
+ x = hconv*(Dhstack[stackht]-Dhstack[stackht-1]);
+ if(abs(x)>1.5)
+ IMhstack[stackht] = IMhstack[stackht]+round(x);
+ }
+ Dhleft = Dh;
+ IMhleft = IMhstack[stackht];
+ stackht = stackht+1;
+ justpushed = true;
+ }
+ }
+
+#ifdef ANSI
+void pop(void)
+#else /* not ANSI*/
+void pop()
+#endif /* ANSI*/
+{ if(stackht==0)
+ {
+ fprintf( *output, "%s%s%c", "Error: ", "POP illegal at level zero", '\n')
+ ;
+ error();
+ }
+ else{
+ stackht = stackht-1;
+ Dh = Dhstack[stackht];
+ Dv = Dvstack[stackht];
+ Dw = Dwstack[stackht];
+ Dx = Dxstack[stackht];
+ Dy = Dystack[stackht];
+ Dz = Dzstack[stackht];
+ IMh = IMhstack[stackht];
+ IMv = IMvstack[stackht];
+ railbase = IMv*railtypes;
+ }
+ }
+
+#ifdef ANSI
+void zdopost( integer Drulht, integer Drulwidth)
+#else /* not ANSI*/
+void zdopost( Drulht, Drulwidth)
+ integer Drulht;
+ integer Drulwidth;
+#endif /* ANSI*/
+{ integer vn,vi,hn,hi,postv,rulehp;
+ codeobject rulecod;
+ roundIMh(0);
+ hn = round(Drulwidth*hconv/ ((double)postwidth));
+ vn = round(Drulht*vconv/ ((double)postheight));
+ if(hn<=0)
+ hn = 1;
+ if(vn<=0)
+ vn = 1;
+ rulecod = postchar;
+ Ddis = Drulwidth;
+ IMdis = hn*postwidth;
+ Dhright = Dh+Ddis;
+ IMhright = IMh+IMdis;
+ {register integer for_end;vi=vn-1;for_end=0; if (vi>=for_end)do
+ {
+ postv = IMv-vi*postheight;
+ {register integer for_end;hi=1;for_end=hn; if (hi<=for_end)do
+ {
+ rulehp = IMh+(hi-1)*postwidth;
+ dosetchar(postv,rulehp,rulecod);
+ }
+ while(hi++ < for_end);}
+ }
+ while(vi-- > for_end);}
+ }
+
+#ifdef ANSI
+void zdorail( integer Drulht, integer Drulwidth)
+#else /* not ANSI*/
+void zdorail( Drulht, Drulwidth)
+ integer Drulht;
+ integer Drulwidth;
+#endif /* ANSI*/
+{ integer vn,vi,hn,hi,railv,charvp,rulehp;
+ codeobject rulecod;
+ schar chari;
+ roundIMh(0);
+ hn = round(Drulwidth*hconv/ ((double)railwidth));
+ vn = round(Drulht*vconv*railtypes/ ((double)railheight));
+ if(hn<=0)
+ hn = 1;
+ if(vn<=0)
+ vn = 1;
+ Ddis = Drulwidth;
+ IMdis = hn*railwidth;
+ Dhright = Dh+Ddis;
+ IMhright = IMh+IMdis;
+ {register integer for_end;vi=vn-1;for_end=0; if (vi>=for_end)do
+ {
+ railv = railbase-vi;
+ charvp = ((railv-1)/railtypes)+1;
+ chari = railtypes-((railv-1)%railtypes);
+ rulecod = railchars[chari];
+ {register integer for_end;hi=1;for_end=hn; if (hi<=for_end)do
+ {
+ rulehp = IMh+(hi-1)*railwidth;
+ dosetchar(charvp,rulehp,rulecod);
+ }
+ while(hi++ < for_end);}
+ }
+ while(vi-- > for_end);}
+ }
+
+#ifdef ANSI
+codeptr znamesearch( varstring ss)
+#else /* not ANSI*/
+codeptr znamesearch( ss)
+ varstring ss;
+#endif /* ANSI*/
+{ register codeptr Result;codeptr i;
+ i = schemetop;
+ while(((i>0)&&(!equals(ss,knownschemes[i]))))i = i-1;
+ if((i==0))
+ Result = 0;
+ else Result = i;
+ return(Result);
+ }
+
+#ifdef ANSI
+void zsetscheme( codeptr ix)
+#else /* not ANSI*/
+void zsetscheme( ix)
+ codeptr ix;
+#endif /* ANSI*/
+{ schemetop = schemetop+1;
+ upcase(buffer);
+ knownschemes[schemetop] = buffer;
+ schememap[schemetop] = ix;
+ }
+
+#ifdef ANSI
+void zalphabet( byte start, byte length, codeptr s, byte PRfont, byte PRfirst
+)
+#else /* not ANSI*/
+void zalphabet( start, length, s, PRfont, PRfirst)
+ byte start;
+ byte length;
+ codeptr s;
+ byte PRfont;
+ byte PRfirst;
+#endif /* ANSI*/
+{ integer i;
+ codeobject ccc;
+ if((s<1))
+ {
+ fprintf( *output, "%s%s%c", "Fatal: ", "Alphabet: scheme < 1 ", '\n');
+ crash();
+ }
+ else if((s>maxcodes))
+ {
+ fprintf( *output, "%s%s%c",
+ "Fatal: ", "Alphabet: scheme too large", '\n');
+ crash();
+ }
+ else if((PRfirst<0))
+ {
+ fprintf( *output, "%s%s%c", "Fatal: ", "Alphabet: negative first", '\n');
+ crash();
+ }
+ else if((start<0))
+ {
+ fprintf( *output, "%s%s%c", "Fatal: ", "Alphabet: negative start", '\n')
+ ;
+ crash();
+ }
+ else if((length<0))
+ {
+ fprintf( *output, "%s%s%c", "Fatal: ", "Alphabet: negative length", '\n')
+ ;
+ crash();
+ }
+ else if((start+length-1>maxDchar))
+ {
+ fprintf( *output, "%s%s%c", "Fatal: ", "Alphabet: overflow", '\n');
+ crash();
+ }
+ ccc.IMfont = PRfont;
+ ccc.breadth = charwidth;
+ {register integer for_end;i=0;for_end=length-1; if (i<=for_end)do
+ {
+ ccc.IMchar = PRfirst+i;
+ codes[s][start+i] = ccc;
+ }
+ while(i++ < for_end);}
+ }
+
+#ifdef ANSI
+void zsetstring( ccharpointer ss, varstring *result)
+#else /* not ANSI*/
+void zsetstring( ss, result)
+ ccharpointer ss;
+ varstring *result;
+#endif /* ANSI*/
+{ byte i,j;
+ result[0] = blank;
+ j = strlen(ss)-1;
+ if(padded)
+ {
+ while(((j>0)&&(ss[j]==padchar)))j = j-1;
+ if((j==0)&&(ss[j]==padchar))
+ j = j-1;
+ }
+ j = j+1;
+ if((j>maxstring))
+ {
+ fprintf( *output, "%s%s%c", "Error: ", "String too long", '\n');
+ error();
+ }
+ else{
+ result[0].len = j;
+ {register integer for_end;i=1;for_end=j; if (i<=for_end)do
+ result[0].data[i] = ss[0+i-1];
+ while(i++ < for_end);}
+ }
+ }
+
+#ifdef ANSI
+void zsubstring( varstring *result, varstring ss, integer start,
+ integer length)
+#else /* not ANSI*/
+void zsubstring( result, ss, start, length)
+ varstring *result;
+ varstring ss;
+ integer start;
+ integer length;
+#endif /* ANSI*/
+{ sptr i;
+ result[0] = blank;
+ if(((start<=0)||(length<0)||(start+length>ss.len+1)))
+ {
+ fprintf( *output, "%s%s%c", "Error: ", "Impossible substring", '\n');
+ error();
+ }
+ else{
+ result[0].len = length;
+ {register integer for_end;i=1;for_end=length; if (i<=for_end)do
+ result[0].data[i] = ss.data[i-1+start];
+ while(i++ < for_end);}
+ }
+ }
+
+#ifdef ANSI
+void zappend( varstring *head, varstring tail)
+#else /* not ANSI*/
+void zappend( head, tail)
+ varstring *head;
+ varstring tail;
+#endif /* ANSI*/
+{ integer k;
+ if((head[0].len+tail.len>maxstring))
+ {
+ fprintf( *output, "%s%s%c", "Error: ", "string too long", '\n');
+ error();
+ }
+ else{
+ {register integer for_end;k=1;for_end=tail.len; if (k<=for_end)do
+ head[0].data[k+head[0].len] = tail.data[k];
+ while(k++ < for_end);}
+ head[0].len = head[0].len+tail.len;
+ }
+ }
+
+#ifdef ANSI
+void zaddchar( varstring *s, char c)
+#else /* not ANSI*/
+void zaddchar( s, c)
+ varstring *s;
+ char c;
+#endif /* ANSI*/
+{ if(s[0].len>=maxstring)
+ {
+ fprintf( *output, "%s%s%c", "Error: ", "string too long", '\n');
+ error();
+ }
+ else{
+ s[0].len = s[0].len+1;
+ s[0].data[s[0].len] = c;
+ }
+ }
+
+#ifdef ANSI
+boolean zequals( varstring s, varstring t)
+#else /* not ANSI*/
+boolean zequals( s, t)
+ varstring s;
+ varstring t;
+#endif /* ANSI*/
+{ register boolean Result;ccharpointer c,d;
+ c = s.data;
+ c = c+1;
+ d = t.data;
+ d = d+1;
+ if((s.len!=t.len))
+ Result = false;
+ else Result = (strncmp(c,d,s.len)==0);
+ return(Result);
+ }
+
+#ifdef ANSI
+void zprintcommand( varstring pattern, integer val, char control)
+#else /* not ANSI*/
+void zprintcommand( pattern, val, control)
+ varstring pattern;
+ integer val;
+ char control;
+#endif /* ANSI*/
+{ varstring ss;
+ splice(ss,pattern,val);
+ printstring(printfile,ss,control);
+ }
+
+#ifdef ANSI
+void zprintstring( text f, varstring ss, char control)
+#else /* not ANSI*/
+void zprintstring( f, ss, control)
+ text f;
+ varstring ss;
+ char control;
+#endif /* ANSI*/
+{ sptr i;
+ boolean iscon;
+ char cc;
+ iscon = false;
+ {register integer for_end;i=1;for_end=ss.len; if (i<=for_end)do
+ {
+ cc = ss.data[i];
+ if(iscon)
+ {
+ if((cc!=control))
+ cc = chr(ord(cc)%32);
+ iscon = false;
+ fprintf( *f, "%c", cc);
+ }
+ else if(((cc==control)&&(control!=' ')))
+ iscon = true;
+ else fprintf( *f, "%c", cc);
+ }
+ while(i++ < for_end);}
+ }
+
+#ifdef ANSI
+void zsplice( varstring *out, varstring source, integer nn)
+#else /* not ANSI*/
+void zsplice( out, source, nn)
+ varstring *out;
+ varstring source;
+ integer nn;
+#endif /* ANSI*/
+{ integer i;
+ char cc;
+ varstring tail;
+ i = ssearch(source,ampand,1);
+ if((i==0))
+ out[0] = source;
+ else{
+ substring(out[0],source,1,i-1);
+ substring(tail,source,i+2,source.len-i-1);
+ cc = source.data[i+1];
+ intstring(out[0],nn,cc);
+ append(out[0],tail);
+ }
+ }
+
+#ifdef ANSI
+void zintstring( varstring *result, integer n, char cc)
+#else /* not ANSI*/
+void zintstring( result, n, cc)
+ varstring *result;
+ integer n;
+ char cc;
+#endif /* ANSI*/
+{ integer nn;
+ if((cc=='O'))
+ intbase(result[0],n,8);
+ else if((cc=='H'))
+ intbase(result[0],n,16);
+ else if((cc=='D'))
+ intbase(result[0],n,10);
+ else if((cc=='B')&&(n>=0)&&(n<=255))
+ addchar(result[0],chr(n));
+ else if((cc=='B'))
+ {
+ fprintf( *output, "%s%s%c", "Error: ", "Out-of-range byte", '\n');
+ error();
+ }
+ else if((cc=='W'))
+ {
+ if((n>=0)&&(n<=32767))
+ {
+ addchar(result[0],chr(n/256));
+ addchar(result[0],chr(n%256));
+ }
+ else if((n<0)&&(n>-32768L))
+ {
+ nn = n+65536L;
+ addchar(result[0],chr(nn/256));
+ addchar(result[0],chr(nn%256));
+ }
+ else{
+ fprintf( *output, "%s%s%c", "Error: ", "Out-of-range word", '\n');
+ error();
+ }
+ }
+ else{
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Int_string called with illegal type", '\n');
+ error();
+ }
+ }
+
+#ifdef ANSI
+void zintbase( varstring *result, integer nn, byte s)
+#else /* not ANSI*/
+void zintbase( result, nn, s)
+ varstring *result;
+ integer nn;
+ byte s;
+#endif /* ANSI*/
+{ integer nh;
+ nh = nn;
+ if(nh<0)
+ {
+ addchar(result[0],'-');
+ nh = - (integer)nh;
+ }
+ if(nh>=s)
+ {
+ intbase(result[0],nh/s,s);
+ nh = nh%s;
+ }
+ if(nh>=10)
+ addchar(result[0],chr(nh+55));
+ else addchar(result[0],chr(nh+48));
+ }
+
+#ifdef ANSI
+void zupcase( varstring *ss)
+#else /* not ANSI*/
+void zupcase( ss)
+ varstring *ss;
+#endif /* ANSI*/
+{ sptr i;
+ byte ch;
+ {register integer for_end;i=1;for_end=ss[0].len; if (i<=for_end)do
+ {
+ ch = ord(ss[0].data[i]);
+ if(((ch>=97)&&(ch<=122)))
+ ss[0].data[i] = chr(ch-32);
+ }
+ while(i++ < for_end);}
+ }
+
+#ifdef ANSI
+integer zstoi( integer xwzdefault, boolean insist)
+#else /* not ANSI*/
+integer zstoi( xwzdefault, insist)
+ integer xwzdefault;
+ boolean insist;
+#endif /* ANSI*/
+{ register integer Result;/*732*/integer value,sig;
+ value = xwzdefault;
+ sig = 1;
+ while(((finger<=buffer.len)&&(ch==32))){
+ finger = finger+1;
+ ch = ord(buffer.data[finger]);
+ }
+ if((ch==43))
+ {
+ finger = finger+1;
+ ch = ord(buffer.data[finger]);
+ }
+ else if((ch==45))
+ {
+ sig = -1;
+ {
+ finger = finger+1;
+ ch = ord(buffer.data[finger]);
+ }
+ }
+ thumb = finger;
+ if((finger<=buffer.len)&&((ch>=48)&&(ch<=57)))
+ {
+ value = 0;
+ while(((finger<=buffer.len)&&((ch>=48)&&(ch<=57)))){
+ value = value*10+(ord(ch)-48);
+ {
+ finger = finger+1;
+ ch = ord(buffer.data[finger]);
+ }
+ }
+ value = value*sig;
+ }
+ else if(insist)
+ {
+ {
+ fprintf( *output, "%s%s%c", "Error: ", "Integer expected ", '\n');
+ error();
+ }
+ printstring(output,buffer,' ');
+ fprintf( *output, "%c%c", ' ', '\n');
+ fprintf( *output, "%*c%c", thumb, '^', '\n');
+ goto lab732;
+ }
+ else if(((sig==-1)&&(45==45)))
+ if((finger>1))
+ {
+ finger = finger-1;
+ ch = ord(buffer.data[finger]);
+ }
+ lab732:Result = value;
+ return(Result);
+ }
+
+#ifdef ANSI
+void zgetname( varstring *val)
+#else /* not ANSI*/
+void zgetname( val)
+ varstring *val;
+#endif /* ANSI*/
+{ while(((finger<=buffer.len)&&((ch==32)||(ch==61)))){
+ finger = finger+1;
+ ch = ord(buffer.data[finger]);
+ }
+ thumb = finger;
+ while(((finger<=buffer.len)&&!((ch==32)||(ch==45)))){
+ finger = finger+1;
+ ch = ord(buffer.data[finger]);
+ }
+ substring(val[0],buffer,thumb,finger-thumb);
+ }
+
+#ifdef ANSI
+sptr zssearch( varstring s, char target, integer go)
+#else /* not ANSI*/
+sptr zssearch( s, target, go)
+ varstring s;
+ char target;
+ integer go;
+#endif /* ANSI*/
+{ register sptr Result;/*732*/integer nn,gg;
+ gg = abs(go);
+ nn = 0;
+ if((gg>s.len)||(go==0))
+ {
+ fprintf( *output, "%s%s%c", "Error: ", "Impossible search", '\n');
+ error();
+ }
+ else{
+ if((go>0))
+ {
+ {register integer for_end;nn=gg;for_end=s.len; if (nn<=for_end)do
+ if((s.data[nn]==target))
+ goto lab732;
+ while(nn++ < for_end);}
+ }
+ else{
+ {register integer for_end;nn=gg;for_end=1; if (nn>=for_end)do
+ if((s.data[nn]==target))
+ goto lab732;
+ while(nn-- > for_end);}
+ }
+ nn = 0;
+ }
+ lab732:Result = nn;
+ return(Result);
+ }
+
+#ifdef ANSI
+void zroundIMh( byte code)
+#else /* not ANSI*/
+void zroundIMh( code)
+ byte code;
+#endif /* ANSI*/
+{ integer stop,diff,n,m,delta,newIMh,roundedh;
+ roundedh = round(hconv*(Dh+Dlmargin));
+ delta = Dh-Dhright;
+ if((delta>thinspace)||(delta<=-4*thinspace))
+ newIMh = roundedh;
+ else newIMh = IMhright+round(hconv*(delta));
+ if(!fixedwidth)
+ {
+ if((newIMh>roundedh+2))
+ newIMh = roundedh+2;
+ else if((newIMh<roundedh-2))
+ newIMh = roundedh-2;
+ }
+ else if((delta>thinspace)&&(newIMh<IMhright+gapwidth)&&!(((code==46)||(code
+ ==44))&&((curscheme>0)&&(curscheme<=maxplain))))
+ newIMh = IMhright+gapwidth;
+ else if((delta>-2*thinspace))
+ {
+ if((newIMh<IMhright))
+ newIMh = IMhright;
+ }
+ else{
+ stop = stackht;
+ Dhstack[stop] = Dhleft;
+ IMhstack[stop] = IMhleft;
+ stop = stop+1;
+ Dhstack[stop] = Dhmid;
+ IMhstack[stop] = IMhmid;
+ stop = stop+1;
+ Dhstack[stop] = Dhright;
+ IMhstack[stop] = IMhright;
+ m = stop;
+ {register integer for_end;n=stop;for_end=1; if (n>=for_end)do
+ {
+ diff = Dh-Dhstack[n];
+ if(abs(diff)<=abs(delta))
+ {
+ m = n;
+ delta = diff;
+ }
+ }
+ while(n-- > for_end);}
+ if((delta>thinspace)&&(newIMh<IMhstack[m]+gapwidth))
+ newIMh = IMhstack[m]+gapwidth;
+ else if((delta<- (integer)thinspace)&&(newIMh>IMhstack[m]-gapwidth))
+ newIMh = IMhstack[m]-gapwidth;
+ else if(abs(delta)<=thinspace)
+ newIMh = IMhstack[m];
+ }
+ if(justpushed)
+ {
+ Dhmid = Dh;
+ IMhmid = newIMh;
+ justpushed = false;
+ }
+ IMh = newIMh;
+ }
+
+#ifdef ANSI
+void zsetPRfont( integer newfont)
+#else /* not ANSI*/
+void zsetPRfont( newfont)
+ integer newfont;
+#endif /* ANSI*/
+{ if((newfont==PRfont)||onlyonefont)
+ ;
+ else{
+ printcommand(fontcommand,newfont,ctrlflag);
+ PRfont = newfont;
+ }
+ }
+
+#ifdef ANSI
+void zsetvabs( integer mm)
+#else /* not ANSI*/
+void zsetvabs( mm)
+ integer mm;
+#endif /* ANSI*/
+{ integer newpos;
+ if(absisincr)
+ newpos = mm-PRv;
+ else newpos = mm;
+ printcommand(vabscom,newpos,ctrlflag);
+ PRv = mm;
+ }
+
+#ifdef ANSI
+void zsethabs( integer mm)
+#else /* not ANSI*/
+void zsethabs( mm)
+ integer mm;
+#endif /* ANSI*/
+{ integer newpos;
+ if(absisincr)
+ newpos = mm-PRh;
+ else newpos = mm;
+ printcommand(habscom,newpos,ctrlflag);
+ PRh = mm;
+ }
+
+#ifdef ANSI
+boolean zopenandask( bytefile ff, integer *fc, varstring *name,
+ varstring *xwzdefault, boolean ask)
+#else /* not ANSI*/
+boolean zopenandask( ff, fc, name, xwzdefault, ask)
+ bytefile ff;
+ integer *fc;
+ varstring *name;
+ varstring *xwzdefault;
+ boolean ask;
+#endif /* ANSI*/
+{ register boolean Result;boolean success,fail;
+ varstring defdir,defnam,defex,trydir,trynam,tryex;
+ success = false;
+ fail = false;
+ do{parsefile(xwzdefault[0],defdir,defnam,defex);
+ parsefile(name[0],trydir,trynam,tryex);
+ if((trydir.len==0))
+ name[0] = defdir;
+ else name[0] = trydir;
+ append(name[0],trynam);
+ if((tryex.len==0))
+ append(name[0],defex);
+ else append(name[0],tryex);
+ success = openbinary(ff,name[0],fc[0]);
+ if(success)
+ fc[0] = 0;
+ else if(ask)
+ {
+ fprintf( *output, "%s", "Couldnt open file: ");
+ printstring(output,name[0],' ');
+ fprintf( *output, "%c%c", ' ', '\n');
+ if(true)
+ {
+ {
+ fprintf( *output, "%s%c",
+ "Please type a replacement or NO to abandon search", '\n');
+ readterminal();
+ }
+ name[0] = buffer;
+ if(((name[0].len==2)&&((name[0].data[1]=='N')||(name[0].data[1]=='n'))
+ &&((name[0].data[2]=='O')||(name[0].data[2]=='o'))))
+ fail = true;
+ }
+ else fail = true;
+ }
+ else fail = true;
+ }while( ! (success||fail) );
+ Result = success;
+ return(Result);
+ }
+
+#ifdef ANSI
+real zrrreadreal( bytefile ffile, integer *findx)
+#else /* not ANSI*/
+real zrrreadreal( ffile, findx)
+ bytefile ffile;
+ integer *findx;
+#endif /* ANSI*/
+{ register real Result;integer a,b;
+ a = readinteger(ffile,findx[0],-4);
+ b = readinteger(ffile,findx[0],-4);
+ if(b<=0)
+ {
+ {
+ fprintf( *output, "%s%s%c", "Error: ", "Denominator <= 0! ", '\n');
+ error();
+ }
+ Result = 1;
+ }
+ else Result = a/ ((double)b);
+ return(Result);
+ }
+
+#ifdef ANSI
+void setrule(void)
+#else /* not ANSI*/
+void setrule()
+#endif /* ANSI*/
+{ integer Dp,Dq;
+ Dp = readinteger(dvifile,dviindx,-4);
+ Dq = readinteger(dvifile,dviindx,-4);
+ if((Dp<=0)||(Dq<=0))
+ ;
+ else if((Dp*vconv<=postheight/ ((double)2)))
+ dorail(Dp,Dq);
+ else dopost(Dp,Dq);
+ }
+
+#ifdef ANSI
+void zchangefont( integer Dnew)
+#else /* not ANSI*/
+void zchangefont( Dnew)
+ integer Dnew;
+#endif /* ANSI*/
+{ Dfont = 0;
+ fontnum[nf] = Dnew;
+ while((fontnum[Dfont]!=Dnew))Dfont = Dfont+1;
+ if(Dfont==nf)
+ {
+ fprintf( *output, "%s%s%*d%c",
+ "Error: ", "Undefined font called for, number ", 1, Dnew, '\n');
+ error();
+ }
+ curscheme = scheme[Dfont];
+ thinspace = fontspace[Dfont];
+ }
+
+#ifdef ANSI
+void zdefinefont( integer Dnew)
+#else /* not ANSI*/
+void zdefinefont( Dnew)
+ integer Dnew;
+#endif /* ANSI*/
+{ /*9999 9998*/integer scalesize,designsize,k,f;
+ byte dirlen,namlen;
+ real fontmag;
+ boolean fontok;
+ integer TFMcheck,lh,nw;
+ byte fn,ck;
+ varstring tryname,tfmscheme;
+ integer inwidth[256];
+ byte widptr[256];
+ byte b3,b2,b1,b0;
+ integer alpha,beta,z;
+ Dcheck = readinteger(dvifile,dviindx,-4);
+ scalesize = readinteger(dvifile,dviindx,-4);
+ designsize = readinteger(dvifile,dviindx,-4);
+ dirlen = readinteger(dvifile,dviindx,1);
+ namlen = readinteger(dvifile,dviindx,1);
+ namlen = namlen+dirlen;
+ if(namlen==0)
+ {
+ fprintf( *output, "%s%s%c", "Error: ", "Null font name! ", '\n');
+ error();
+ }
+ else if(namlen>=maxstring)
+ {
+ printstring(output,fontname,' ');
+ fprintf( *output, "%s", " ---- ");
+ {
+ fprintf( *output, "%s%s%*d%c",
+ "Error: ", "Too-long font name! length = ", 1, namlen, '\n');
+ error();
+ }
+ goto lab9999;
+ }
+ tfmname = blank;
+ {register integer for_end;k=1;for_end=namlen; if (k<=for_end)do
+ {
+ tfmname.data[k] = chr(readbyte(dvifile,dviindx));
+ }
+ while(k++ < for_end);}
+ tfmname.len = namlen;
+ fontname = tfmname;
+ if((scalesize<=0)||(scalesize>=134217728L))
+ {
+ printstring(output,fontname,' ');
+ fprintf( *output, "%s", " ---- ");
+ {
+ fprintf( *output, "%s%s%*d%s%c",
+ "Error: ", "Bad scale (", 1, scalesize, ")!", '\n');
+ error();
+ }
+ goto lab9999;
+ }
+ else if((designsize<=0)||(designsize>=134217728L))
+ {
+ printstring(output,fontname,' ');
+ fprintf( *output, "%s", " ---- ");
+ {
+ fprintf( *output, "%s%s%*d%s%c",
+ "Error: ", "Bad design size (", 1, designsize, ")!", '\n');
+ error();
+ }
+ goto lab9999;
+ }
+ fontmag = scalesize/ ((double)designsize);
+ if((fontmag>1000)||(fontmag<0.001))
+ {
+ printstring(output,fontname,' ');
+ fprintf( *output, "%s", " ---- ");
+ {
+ fprintf( *output, "%s%s%E%c",
+ "Error: ", "Way-out font magnification!!! ", fontmag, '\n');
+ error();
+ }
+ goto lab9999;
+ }
+ if(nf==maxDfonts)
+ {
+ fprintf( *output, "%s%s%*d%s%c",
+ "Fatal: ", "Capacity exceeded (max fonts=", 1, maxDfonts, ")!", '\n');
+ crash();
+ }
+ fontnum[nf] = Dnew;
+ f = 0;
+ while((fontnum[f]!=Dnew))f = f+1;
+ if(f<nf)
+ {
+ printstring(output,fontname,' ');
+ fprintf( *output, "%s", " ---- ");
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Font was already defined!", '\n');
+ error();
+ }
+ goto lab9999;
+ }
+ fontspace[nf] = scalesize/6;
+ z = scalesize;
+ alpha = 16*z;
+ beta = 16;
+ while((z>=8388608L)){
+ z = z/2;
+ beta = beta/2;
+ }
+ tryname = tfmname;
+ upcase(tryname);
+ fontspace[nf] = round(fontspace[nf]*0.99);
+ tfmindx = TFMFILEPATH;
+ fontok = openandask(tfmfile,tfmindx,tfmname,tfmdef,true);
+ if(!fontok)
+ {
+ printstring(output,fontname,' ');
+ fprintf( *output, "%s", " ---- ");
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "TFM file can't be opened!", '\n');
+ error();
+ }
+ goto lab9999;
+ }
+ skipbytes(tfmfile,tfmindx,2);
+ lh = readinteger(tfmfile,tfmindx,2);
+ firstch[nf] = readinteger(tfmfile,tfmindx,2);
+ lastch[nf] = readinteger(tfmfile,tfmindx,2);
+ if((lastch[nf]<firstch[nf])||(lastch[nf]>maxDchar))
+ {
+ printstring(output,fontname,' ');
+ fprintf( *output, "%s", " ---- ");
+ {
+ fprintf( *output, "%s%s%*d%s%*d%c",
+ "Error: ", "Illegal values for first_char and/or last_char, first_char = ", 1, firstch[nf], " last_char = ", 1, lastch[nf], '\n')
+ ;
+ error();
+ }
+ goto lab9999;
+ }
+ nw = readinteger(tfmfile,tfmindx,2);
+ if((nw==0)||(nw>256))
+ {
+ printstring(output,fontname,' ');
+ fprintf( *output, "%s", " ---- ");
+ {
+ fprintf( *output, "%s%s%d%c",
+ "Error: ", "Illegal value for nw, nw= ", nw, '\n');
+ error();
+ }
+ goto lab9999;
+ }
+ skipbytes(tfmfile,tfmindx,14);
+ TFMcheck = readinteger(tfmfile,tfmindx,-4);
+ skipbytes(tfmfile,tfmindx,4);
+ tfmscheme = blank;
+ if(lh<2)
+ {
+ printstring(output,fontname,' ');
+ fprintf( *output, "%s", " ---- ");
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Header must have at least 2 words", '\n');
+ error();
+ }
+ goto lab9999;
+ }
+ else if(lh==2)
+ ;
+ else{
+ ck = readbyte(tfmfile,tfmindx);
+ if((ck>=40)||(ck>4*lh-9))
+ skipbytes(tfmfile,tfmindx,4*lh-9);
+ else{
+ tfmscheme.len = ck;
+ {register integer for_end;k=1;for_end=ck; if (k<=for_end)do
+ tfmscheme.data[k] = chr(readbyte(tfmfile,tfmindx));
+ while(k++ < for_end);}
+ skipbytes(tfmfile,tfmindx,4*lh-ck-9);
+ upcase(tfmscheme);
+ }
+ }
+ fn = namesearch(tryname);
+ if((fn==0))
+ {
+ k = tryname.len;
+ while(((ord(tryname.data[k])>=48)&&(ord(tryname.data[k])<=57))){
+ tryname.data[k] = ' ';
+ k = k-1;
+ }
+ tryname.len = k;
+ fn = namesearch(tryname);
+ if((fn==0))
+ fn = namesearch(tfmscheme);
+ }
+ if((fn==0)&&candlfont)
+ ;
+ else if((fn==0))
+ {
+ printstring(output,fontname,' ');
+ fprintf( *output, "%c%c", ':', '\n');
+ if((tfmscheme.len>0))
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Unknown coding scheme, using TEX TEXT instead", '\n');
+ error();
+ }
+ else{
+ fprintf( *output, "%s%s%c",
+ "Error: ", "No coding scheme, using TEX TEXT instead (examine NOSCHEME.ADD) ", '\n')
+ ;
+ error();
+ }
+ scheme[nf] = schememap[3];
+ }
+ else scheme[nf] = schememap[fn];
+ {register integer for_end;k=firstch[nf];for_end=lastch[nf]; if (k<=for_end)
+ do
+ {
+ widptr[k] = readbyte(tfmfile,tfmindx);
+ skipbytes(tfmfile,tfmindx,3);
+ if(widptr[k]>nw)
+ {
+ printstring(output,fontname,' ');
+ fprintf( *output, "%s", " ---- ");
+ {
+ fprintf( *output, "%s%s%d%c",
+ "Error: ", "Impossible width ", widptr[k], '\n');
+ error();
+ }
+ goto lab9999;
+ }
+ }
+ while(k++ < for_end);}
+ {register integer for_end;k=0;for_end=nw-1; if (k<=for_end)do
+ {
+ b0 = readbyte(tfmfile,tfmindx);
+ b1 = readbyte(tfmfile,tfmindx);
+ b2 = readbyte(tfmfile,tfmindx);
+ b3 = readbyte(tfmfile,tfmindx);
+ inwidth[k] = (((((b3*z)/256)+(b2*z))/256)+(b1*z))/beta;
+ if(b0==255)
+ inwidth[k] = inwidth[k]-alpha;
+ else if(b0!=0)
+ {
+ printstring(output,fontname,' ');
+ fprintf( *output, "%s", " ---- ");
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Out-of-bounds value for b0", '\n');
+ error();
+ }
+ goto lab9999;
+ }
+ }
+ while(k++ < for_end);}
+ if(inwidth[0]!=0)
+ {
+ printstring(output,fontname,' ');
+ fprintf( *output, "%s", " ---- ");
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "First width should be zero ", '\n');
+ error();
+ }
+ goto lab9999;
+ }
+ {register integer for_end;k=firstch[nf];for_end=lastch[nf]; if (k<=for_end)
+ do
+ Dwidth[nf][k] = inwidth[widptr[k]];
+ while(k++ < for_end);}
+ lab9998:{register integer for_end;k=firstch[nf];for_end=lastch[nf]; if (k<=
+ for_end)do
+ if((Dwidth[nf][k]<0)||(Dwidth[nf][k]>50000000L))
+ {
+ {
+ fprintf( *output, "%s%s%*d%s%*d%c",
+ "Error: ", "Way-out width = ", 1, Dwidth[nf][k], "DVI units, character number ", 1, k, '\n')
+ ;
+ error();
+ }
+ codes[scheme[nf]][k].breadth = -32766;
+ }
+ while(k++ < for_end);}
+ if((Dcheck!=0)&&(TFMcheck!=0)&&(Dcheck!=TFMcheck))
+ {
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Check sums do not agree!", '\n');
+ error();
+ }
+ fprintf( *output, "%s%d%s%d%c",
+ "DVI check was: ", Dcheck, " TFM check was: ", TFMcheck, '\n');
+ fprintf( *output, "%s", " ");
+ }
+ fontmag = (fontmag-1)*100.0;
+ if(!quiet)
+ {
+ fprintf( *output, "%c%c", ' ', '\n');
+ printstring(output,fontname,' ');
+ fprintf( *output, "%s%*d%s",
+ " --- loaded at ", 1, scalesize, " DVI units");
+ if(abs(fontmag)>1)
+ fprintf( *output, "%s%*d%s", " ( magnified ", 1, round(fontmag), "%)");
+ fprintf( *output, "%c%c", ' ', '\n');
+ }
+ nf = nf+1;
+ lab9999:if(fontok)
+ ;
+ }
+
+#ifdef ANSI
+void zsetcharacter( integer cnum)
+#else /* not ANSI*/
+void zsetcharacter( cnum)
+ integer cnum;
+#endif /* ANSI*/
+{ codeobject cod;
+ integer di;
+ if(curscheme==0)
+ ;
+ else if((cnum<firstch[Dfont])||(cnum>lastch[Dfont]))
+ {
+ {
+ fprintf( *output, "%s%s%*d%s%*d%c",
+ "Error: ", "Character ", 1, cnum, " invalid in font number ", 1, fontnum[Dfont], '\n')
+ ;
+ error();
+ }
+ }
+ else{
+ cod = codes[curscheme][cnum];
+ if(cod.breadth!=-32766)
+ {
+ roundIMh(cnum);
+ if(cod.breadth==-32765)
+ ;
+ dosetchar(IMv,IMh,cod);
+ Ddis = Dwidth[Dfont][cnum];
+ if(cod.breadth==-32766)
+ IMdis = 0;
+ else IMdis = abs(cod.breadth);
+ railbase = IMv*railtypes;
+ Dhright = Dh+Ddis;
+ IMhright = IMh+IMdis;
+ }
+ }
+ }
+
+#ifdef ANSI
+void zdosetchar( iword Setv, iword Seth, codeobject cod)
+#else /* not ANSI*/
+void zdosetchar( Setv, Seth, cod)
+ iword Setv;
+ iword Seth;
+ codeobject cod;
+#endif /* ANSI*/
+{ iword ki,kk,tempv,temph;
+ codeobject mc;
+ short kptr;
+ if(cod.breadth>=0)
+ {
+ if((Seth<hmin))
+ {
+ {
+ fprintf( *output, "%s%s%c", "Error: ", "Out of bounds --left", '\n');
+ error();
+ }
+ Seth = 0;
+ }
+ else if((Seth>hmax))
+ {
+ {
+ fprintf( *output, "%s%s%c", "Error: ", "Out of bounds --right", '\n')
+ ;
+ error();
+ }
+ Seth = hmax;
+ }
+ if((Setv<vmin)||(Setv>vmax))
+ {
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Out of bounds -- vertical ", '\n');
+ error();
+ }
+ Setv = vmax;
+ }
+ if(Hshunt>(Seth-3))
+ Hshunt = (Seth-3);
+ {
+ if(((Oldv>Setv)||((Oldv==Setv)&&(Oldh>Seth))))
+ {
+ pool[runptr].prox = zzz;
+ runptr = pool[run].prox;
+ cell = cell+1;
+ pool[midptr].prox = cell;
+ midptr = cell;
+ pool[midptr].down = runptr;
+ runptr = run;
+ pool[run].prox = zzz;
+ }
+ cell = cell+1;
+ pool[runptr].prox = cell;
+ runptr = cell;
+ {
+ pool[runptr].hpos = Seth;
+ Oldh = Seth;
+ pool[runptr].vpos = Setv;
+ Oldv = Setv;
+ pool[runptr].symbol = cod;
+ }
+ pagesize = pagesize+1;
+ if(pagesize>=pagemax)
+ {
+ fprintf( *output, "%s%s%c",
+ "Fatal: ", "Overflowed page: either a bug, or recompile with larger page_max", '\n')
+ ;
+ crash();
+ }
+ }
+ }
+ else if(cod.breadth==-32766)
+ ;
+ else{
+ if((cod.multi<=0)||(cod.multi>topofligs))
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Illegal value of char in multi-character command", '\n');
+ error();
+ }
+ else{
+ kptr = cod.multi;
+ if((ligatures[kptr].guard!=-32767))
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Sentry not found in Kerns ", '\n');
+ error();
+ }
+ ki = ligatures[kptr].num;
+ kptr = kptr-2*ki;
+ if((ki<=0)||(kptr<0))
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Illegal value of k_i in multi-character command", '\n');
+ error();
+ }
+ {register integer for_end;kk=1;for_end=ki; if (kk<=for_end)do
+ {
+ tempv = Setv+ligatures[kptr].vmove;
+ temph = Seth+ligatures[kptr].hmove;
+ kptr = kptr+1;
+ mc = ligatures[kptr].symbol;
+ dosetchar(tempv,temph,mc);
+ kptr = kptr+1;
+ }
+ while(kk++ < for_end);}
+ }
+ }
+ }
+
+#ifdef ANSI
+void zrowchar( integer context, codeobject *value)
+#else /* not ANSI*/
+void zrowchar( context, value)
+ integer context;
+ codeobject *value;
+#endif /* ANSI*/
+{ /*732*/
+#define obra 123
+#define oket 125
+#define hbra 91
+#define hket 93
+#define vbra 60
+#define vket 62
+ ligthing ligbuff[maxbuf + 1];
+ unsigned char bufnum;
+ unsigned char buflen;
+ iword deltah,deltav;
+ byte ch,bra;
+ integer i;
+ codeobject rowcod;
+ integer printwidth;
+ value[0].breadth = charwidth;
+ value[0].IMfont = rowfont;
+ {
+ finger = finger+1;
+ ch = ord(buffer.data[finger]);
+ }
+ if((context==0)&&(ch!=32)&&(ch!=90))
+ {
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Character specifiers must start with at least one space", '\n')
+ ;
+ error();
+ }
+ printstring(output,buffer,' ');
+ fprintf( *output, "%c%c", ' ', '\n');
+ fprintf( *output, "%*c%c", thumb, '^', '\n');
+ goto lab732;
+ }
+ while(((finger<=buffer.len)&&(ch==32))){
+ finger = finger+1;
+ ch = ord(buffer.data[finger]);
+ }
+ if(!(finger<=buffer.len))
+ {
+ {
+ fprintf( *output, "%s%s%c", "Error: ", "Fallen off row", '\n');
+ error();
+ }
+ printstring(output,buffer,' ');
+ fprintf( *output, "%c%c", ' ', '\n');
+ fprintf( *output, "%*c%c", thumb, '^', '\n');
+ goto lab732;
+ }
+ if((ch==65))
+ value[0].IMchar = 64;
+ else if((ch==83))
+ value[0].IMchar = 32;
+ else if((ch==81))
+ value[0].IMchar = 39;
+ else if((ch==87))
+ value[0].IMchar = 34;
+ else if((ch==69))
+ value[0].IMchar = 127;
+ else if((ch==39)||(ch==34)||(ch==64)||(ch==127))
+ {
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Bad character---Rejected", '\n');
+ error();
+ }
+ printstring(output,buffer,' ');
+ fprintf( *output, "%c%c", ' ', '\n');
+ fprintf( *output, "%*c%c", thumb, '^', '\n');
+ goto lab732;
+ }
+ else if((ch==32))
+ {
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Space found out of context", '\n');
+ error();
+ }
+ printstring(output,buffer,' ');
+ fprintf( *output, "%c%c", ' ', '\n');
+ fprintf( *output, "%*c%c", thumb, '^', '\n');
+ goto lab732;
+ }
+ else if((ch==90))
+ value[0].breadth = -32766;
+ else if((ch==76))
+ {
+ {
+ finger = finger+1;
+ ch = ord(buffer.data[finger]);
+ }
+ value[0].IMchar = ch;
+ }
+ else if((ch==67))
+ {
+ {
+ finger = finger+1;
+ ch = ord(buffer.data[finger]);
+ }
+ value[0].IMchar = ch%32;
+ }
+ else if((context>=250))
+ value[0].IMchar = ch;
+ else if((ch==77))
+ {
+ rowchar(250,value[0]);
+ value[0].IMchar = value[0].IMchar+128;
+ }
+ else if(((ch==78)||(ch==68))&&(context>=230))
+ {
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Narrow or Down escape out of context", '\n');
+ error();
+ }
+ printstring(output,buffer,' ');
+ fprintf( *output, "%c%c", ' ', '\n');
+ fprintf( *output, "%*c%c", thumb, '^', '\n');
+ goto lab732;
+ }
+ else if((ch==78))
+ {
+ rowchar(230,value[0]);
+ value[0].breadth = 0;
+ }
+ else if((ch==68))
+ {
+ rowchar(230,value[0]);
+ value[0].breadth = -32765;
+ }
+ else if((ch==70))
+ {
+ rowfont = stoi(0,true);
+ if((context==0))
+ rowchar(1,value[0]);
+ else rowchar(context,value[0]);
+ }
+ else if((ch==obra)||(ch==hbra)||(ch==vbra))
+ {
+ if((context>=ch))
+ {
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Illegal nesting of brackets in row_spec", '\n');
+ error();
+ }
+ printstring(output,buffer,' ');
+ fprintf( *output, "%c%c", ' ', '\n');
+ fprintf( *output, "%*c%c", thumb, '^', '\n');
+ goto lab732;
+ }
+ {register integer for_end;i=1;for_end=maxbuf; if (i<=for_end)do
+ ligbuff[i].symbol = nochar;
+ while(i++ < for_end);}
+ buflen = 0;
+ deltah = 0;
+ deltav = 0;
+ bra = ch;
+ do{rowchar(bra,rowcod);
+ if((rowcod.breadth==-32764))
+ deltav = deltav-charht;
+ else if((rowcod.breadth==-32763))
+ ;
+ else if((buflen+3>maxbuf))
+ {
+ fprintf( *output, "%s%s%c",
+ "Fatal: ", "Overflowed lig_buff array", '\n');
+ crash();
+ }
+ else if((rowcod.breadth==-32762))
+ deltah = deltah-stoi(0,true);
+ else if((rowcod.breadth==-32761))
+ deltav = deltav-stoi(0,true);
+ else{
+ buflen = buflen+1;
+ ligbuff[buflen].vmove = deltav;
+ ligbuff[buflen].hmove = deltah;
+ buflen = buflen+1;
+ ligbuff[buflen].symbol = rowcod;
+ if((bra==vbra))
+ deltav = deltav+charht;
+ if(((bra==hbra)||(batchview&&(bra==obra))))
+ deltah = deltah+charwidth;
+ }
+ }while( ! ((rowcod.breadth==-32763)||!(finger<=buffer.len)) );
+ bufnum = 0;
+ if((buflen==0))
+ value[0].breadth = -32766;
+ else if((topofligs+buflen+1>=maxligs))
+ {
+ fprintf( *output, "%s%s%c",
+ "Fatal: ", "Ligature array overflowed, must recompile with larger array", '\n')
+ ;
+ crash();
+ }
+ else{
+ {register integer for_end;i=1;for_end=buflen; if (i<=for_end)do
+ ligatures[topofligs+i] = ligbuff[i];
+ while(i++ < for_end);}
+ topofligs = topofligs+buflen+1;
+ bufnum = buflen/2;
+ ligatures[topofligs].num = bufnum;
+ ligatures[topofligs].guard = -32767;
+ value[0].multi = topofligs;
+ value[0].breadth = -20000;
+ }
+ if((bra==obra))
+ printwidth = charwidth;
+ else if((bra==hbra))
+ printwidth = deltah;
+ else{
+ printwidth = charwidth;
+ {register integer for_end;i=1;for_end=bufnum; if (i<=for_end)do
+ if((printwidth<- (integer)ligbuff[2*i].symbol.breadth)&&(ligbuff[2*i]
+ .symbol.breadth>-30000))
+ printwidth = - (integer)ligbuff[2*i].symbol.breadth;
+ while(i++ < for_end);}
+ }
+ value[0].breadth = - (integer)printwidth;
+ }
+ else if((ch==85)&&(context==vbra))
+ value[0].breadth = -32764;
+ else if((ch==85))
+ {
+ {
+ fprintf( *output, "%s%s%c", "Error: ", "U escape out of context", '\n')
+ ;
+ error();
+ }
+ printstring(output,buffer,' ');
+ fprintf( *output, "%c%c", ' ', '\n');
+ fprintf( *output, "%*c%c", thumb, '^', '\n');
+ goto lab732;
+ }
+ else if(((ch==oket)||(ch==hket)||(ch==vket))&&(context==ch-2))
+ value[0].breadth = -32763;
+ else if((ch==oket)||(ch==hket)||(ch==vket))
+ {
+ {
+ fprintf( *output, "%s%s%c", "Error: ", "Mismatching brackets ", '\n');
+ error();
+ }
+ printstring(output,buffer,' ');
+ fprintf( *output, "%c%c", ' ', '\n');
+ fprintf( *output, "%*c%c", thumb, '^', '\n');
+ goto lab732;
+ }
+ else if((ch==75)&&(context==hbra))
+ value[0].breadth = -32762;
+ else if((ch==75)&&(context==vbra))
+ value[0].breadth = -32761;
+ else if((ch==75))
+ {
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Kern escape out of context", '\n');
+ error();
+ }
+ printstring(output,buffer,' ');
+ fprintf( *output, "%c%c", ' ', '\n');
+ fprintf( *output, "%*c%c", thumb, '^', '\n');
+ goto lab732;
+ }
+ else value[0].IMchar = ch;
+ lab732:;
+ }
+
+#ifdef ANSI
+void parsecommand(void)
+#else /* not ANSI*/
+void parsecommand()
+#endif /* ANSI*/
+{ /*732*/byte key;
+ buffer = command;
+ finger = 0;
+ {
+ finger = finger+1;
+ ch = ord(buffer.data[finger]);
+ }
+ while((finger<=buffer.len)){
+ while(((finger<=buffer.len)&&(ch==32))){
+ finger = finger+1;
+ ch = ord(buffer.data[finger]);
+ }
+ if((finger<=buffer.len)&&(ch==45))
+ {
+ {
+ finger = finger+1;
+ ch = ord(buffer.data[finger]);
+ }
+ thumb = finger;
+ if(((ch>=97)&&(ch<=122)))
+ ch = ch-32;
+ key = ch;
+ {
+ finger = finger+1;
+ ch = ord(buffer.data[finger]);
+ }
+ while(((finger<=buffer.len)&&((ch==32)||(ch==61)))){
+ finger = finger+1;
+ ch = ord(buffer.data[finger]);
+ }
+ if((key==81))
+ quiet = true;
+ else if((key==83))
+ squash = true;
+ else if((key==82))
+ runon = true;
+ else if((key==80))
+ getname(printname);
+ else if((key==68))
+ getname(tfmdef);
+ else if((key==70))
+ firstpage = stoi(firstpage,true);
+ else if((key==67))
+ countpages = stoi(countpages,true);
+ else if((key==77))
+ magnify = stoi(magnify,true);
+ else if((key==88))
+ hmag = stoi(hmag,true);
+ else if((key==89))
+ vmag = stoi(vmag,true);
+ else if((key==66))
+ batchview = true;
+ else if((key==73))
+ {
+ inspection = true;
+ pausei = stoi(pausesteps,false);
+ if(((pausei<0)||(pausei>200)))
+ {
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Illegal value for I flag", '\n');
+ error();
+ }
+ printstring(output,buffer,' ');
+ fprintf( *output, "%c%c", ' ', '\n');
+ fprintf( *output, "%*c%c", thumb, '^', '\n');
+ goto lab732;
+ }
+ else pausesteps = pausei;
+ pausei = 0;
+ }
+ else{
+ {
+ fprintf( *output, "%s%s%c", "Error: ", "Unknown command ", '\n');
+ error();
+ }
+ printstring(output,buffer,' ');
+ fprintf( *output, "%c%c", ' ', '\n');
+ fprintf( *output, "%*c%c", thumb, '^', '\n');
+ goto lab732;
+ }
+ }
+ else if((finger<=buffer.len))
+ {
+ if((dviname.len>0))
+ {
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Two filenames. Previous name will be ignored, it was:", '\n')
+ ;
+ error();
+ }
+ printstring(output,dviname,' ');
+ fprintf( *output, "%c%c", ' ', '\n');
+ }
+ getname(dviname);
+ }
+ lab732:;
+ }
+ }
+
+#ifdef ANSI
+void zmovedown( integer ddd)
+#else /* not ANSI*/
+void zmovedown( ddd)
+ integer ddd;
+#endif /* ANSI*/
+{ integer newIMv,delta;
+ Dv = Dv+ddd;
+ delta = round(vconv*(ddd));
+ if(delta>=bigdrop)
+ {
+ newIMv = round(vconv*(Dv+Dtopmargin));
+ if((newIMv<IMv+bigdrop))
+ IMv = IMv+bigdrop;
+ else IMv = newIMv;
+ railbase = IMv*railtypes;
+ }
+ else if((delta<=- (integer)bigdrop))
+ {
+ newIMv = round(vconv*(Dv+Dtopmargin));
+ if((newIMv>IMv-bigdrop))
+ IMv = IMv-bigdrop;
+ else IMv = newIMv;
+ railbase = IMv*railtypes;
+ }
+ else{
+ IMv = IMv+delta;
+ railbase = railbase+round(vconv*(ddd*railtypes));
+ if((ddd>tinydrop)&&(delta==0))
+ IMv = IMv+1;
+ else if((ddd<- (integer)tinydrop)&&(delta==0))
+ IMv = IMv-1;
+ else railbase = IMv*railtypes;
+ }
+ }
+
+#ifdef ANSI
+link readline(void)
+#else /* not ANSI*/
+link readline()
+#endif /* ANSI*/
+{ register link Result;link head,tail;
+ integer size;
+ head = curpgeptr;
+ size = 0;
+ PRvnext = pool[curpgeptr].vpos;
+ do{tail = curpgeptr;
+ curpgeptr = pool[curpgeptr].prox;
+ size = size+1;
+ if(size==maxlinesize)
+ {
+ fprintf( *output, "%s%s%c", "Error: ", "Excessively long line ", '\n');
+ error();
+ }
+ }while( ! ((((curpgeptr==zzz))||(PRvnext!=pool[curpgeptr].vpos))) );
+ pool[tail].prox = zzz;
+ Result = head;
+ return(Result);
+ }
+
+#ifdef ANSI
+void zdoline( link lineptr, integer depth)
+#else /* not ANSI*/
+void zdoline( lineptr, depth)
+ link lineptr;
+ integer depth;
+#endif /* ANSI*/
+{ link overflow;
+ if((PRvnext<PRv))
+ {
+ if(bfeedabsolute)
+ setvabs(PRvnext);
+ else if(bfeedbystring)
+ while((PRvnext<PRv)){
+ printstring(printfile,bfeedstring,ctrlflag);
+ PRv = PRv-bfeeddist;
+ }
+ else if(bfeedscream)
+ {
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Printer cant feed backwards", '\n');
+ error();
+ }
+ fprintf( *output, "%s%d%c",
+ "approximate vertical position is: ", PRvnext, '\n');
+ fprintf( *output, "%s%c",
+ " printing over-fed line on line below", '\n');
+ fprintf( *output, "%c%c", ' ', '\n');
+ PRv = PRvnext;
+ }
+ }
+ if(list||xwzfortran||(wlfeeddist>0))
+ while((PRv+wlfeeddist<=PRvnext)){
+ fprintf( *printfile, "%c", '\n');
+ if(inspection)
+ flush(printfile);
+ if(dopause)
+ {
+ pausei = pausei+1;
+ if((pausei>=pausesteps))
+ {
+ {
+ fprintf( *printfile, "%c", '\n');
+ if(inspection)
+ flush(printfile);
+ fprintf( *output, "%c%c", ' ', '\n');
+ }
+ fprintf( *output, "%s", pauseask);
+ readln(input);
+ printstring(output,pauseafter,' ');
+ pausei = 0;
+ }
+ }
+ if(xwzfortran)
+ fprintf( *printfile, "%c", feedchar);
+ if(wldoescr)
+ PRh = 0;
+ PRv = PRv+wlfeeddist;
+ if(squash)
+ PRv = PRvnext;
+ }
+ else if(feedabsolute)
+ setvabs(PRvnext);
+ else{
+ while((PRvnext>=PRv+feeddist)){
+ fprintf( *printfile, "%c", feedchar);
+ if(squash)
+ PRv = PRvnext;
+ else PRv = PRv+feeddist;
+ }
+ fprintf( *printfile, "%c", '\n');
+ if(inspection)
+ flush(printfile);
+ if(wldoescr)
+ PRh = 0;
+ }
+ while((PRvnext>PRv)){
+ fprintf( *printfile, "%c", tfeedchar);
+ PRv = PRv+tfeeddist;
+ }
+ overflow = zzz;
+ while((lineptr!=zzz)){
+ PRhnext = pool[lineptr].hpos-Hshunt;
+ if(!bspaceabsolute&&!bspacebystring&&(PRhnext<PRh))
+ {
+ if((PRh<leftstop))
+ {
+ fprintf( *output, "%s%s%c", "Error: ", "negative H-pos", '\n');
+ error();
+ }
+ if(!batchview)
+ {
+ pool[overflow].prox = lineptr;
+ overflow = pool[overflow].prox;
+ }
+ lineptr = pool[lineptr].prox;
+ }
+ else{
+ if(PRhnext==PRh)
+ ;
+ else{
+ if((PRhnext<PRh))
+ {
+ if(bspaceabsolute)
+ sethabs(PRhnext);
+ else if(bspacebystring)
+ while((PRhnext<PRh)){
+ fprintf( *printfile, "%c", bspacechar);
+ PRh = PRh-bspacedist;
+ }
+ }
+ if(spaceabsolute&&(PRhnext>PRh))
+ sethabs(PRhnext);
+ else{
+ while((PRhnext>=PRh+spacedist)){
+ fprintf( *printfile, "%c", spacechar);
+ PRh = PRh+spacedist;
+ }
+ while((PRhnext>PRh)){
+ fprintf( *printfile, "%c", tspacechar);
+ PRh = PRh+tspacedist;
+ }
+ }
+ }
+ if(pool[lineptr].symbol.IMfont!=PRfont)
+ setPRfont(pool[lineptr].symbol.IMfont);
+ fprintf( *printfile, "%c", chr(pool[lineptr].symbol.IMchar));
+ PRh = PRh+pool[lineptr].symbol.breadth;
+ tempp = lineptr;
+ lineptr = pool[lineptr].prox;
+ }
+ }
+ if((overflow==zzz))
+ {
+ if(((!wldoescr)||feedabsolute||((!wantsplit)&&(bspaceabsolute||(crfeeddist
+ <wlfeeddist)))))
+ {
+ if(xwzfortran)
+ {
+ fprintf( *printfile, "%c", '\n');
+ if(inspection)
+ flush(printfile);
+ fprintf( *printfile, "%c", crchar);
+ PRh = 0;
+ PRv = PRv+crfeeddist;
+ }
+ else if((bspaceabsolute&&((crfeeddist>0)||(lmargin>0))))
+ sethabs(0);
+ else{
+ fprintf( *printfile, "%c", crchar);
+ PRh = 0;
+ PRv = PRv+crfeeddist;
+ }
+ }
+ }
+ else{
+ if(xwzfortran)
+ {
+ fprintf( *printfile, "%c", '\n');
+ if(inspection)
+ flush(printfile);
+ fprintf( *printfile, "%c", crchar);
+ PRh = 0;
+ PRv = PRv+crfeeddist;
+ }
+ else if((bspaceabsolute&&((crfeeddist>0)||(lmargin>0))))
+ sethabs(0);
+ else{
+ fprintf( *printfile, "%c", crchar);
+ PRh = 0;
+ PRv = PRv+crfeeddist;
+ }
+ if((depth<deepest))
+ {
+ pool[overflow].prox = zzz;
+ overflow = pool[zzz].prox;
+ doline(overflow,depth+1);
+ }
+ else{
+ fprintf( *output, "%s%s%c", "Error: ", "I am out of my depth", '\n');
+ error();
+ }
+ }
+ }
+
+#ifdef ANSI
+void Readonepage(void)
+#else /* not ANSI*/
+void Readonepage()
+#endif /* ANSI*/
+{ byte Dcom;
+ integer Dpar;
+ boolean endpage;
+ endpage = false;
+ Dw = 0;
+ Dx = 0;
+ Dy = 0;
+ Dz = 0;
+ stackht = 0;
+ railbase = 0;
+ justpushed = false;
+ thinspace = 0;
+ Dfont = nf;
+ curscheme = 0;
+ Dh = - (integer)Dlmargin;
+ Dv = - (integer)Dtopmargin;
+ IMh = 0;
+ IMv = 0;
+ Dhleft = - (integer)Dlmargin;
+ IMhleft = 0;
+ Dhmid = - (integer)Dlmargin;
+ IMhmid = 0;
+ Dhright = - (integer)Dlmargin;
+ IMhright = 0;
+ push();
+ Dh = 0;
+ Dv = 0;
+ Hshunt = 100000000L;
+ cell = zzz;
+ midptr = mid;
+ pool[mid].prox = zzz;
+ runptr = run;
+ pool[run].prox = zzz;
+ pagesize = 0;
+ Oldv = -32767;
+ do{Ddis = 0;
+ IMdis = 0;
+ Dcom = readbyte(dvifile,dviindx);
+ if(Dcom<128)
+ {
+ setcharacter(Dcom);
+ Dh = Dh+Ddis;
+ IMh = IMh+IMdis;
+ }
+ else if((Dcom>=171)&&(Dcom<=234))
+ changefont(Dcom-171);
+ else switch(Dcom)
+ {case 128:
+ case 129:
+ case 130:
+ case 131:
+ {
+ Dpar = readinteger(dvifile,dviindx,Dcom-127);
+ setcharacter(Dpar);
+ Dh = Dh+Ddis;
+ IMh = IMh+IMdis;
+ }
+ break;
+ case 132:
+ {
+ setrule();
+ Dh = Dh+Ddis;
+ IMh = IMh+IMdis;
+ }
+ break;
+ case 133:
+ case 134:
+ case 135:
+ case 136:
+ {
+ Dpar = readinteger(dvifile,dviindx,Dcom-132);
+ setcharacter(Dpar);
+ }
+ break;
+ case 137:
+ setrule();
+ break;
+ case 138:
+ ;
+ break;
+ case 140:
+ endpage = true;
+ break;
+ case 141:
+ push();
+ break;
+ case 142:
+ pop();
+ break;
+ case 143:
+ case 144:
+ case 145:
+ case 146:
+ {
+ Dpar = readinteger(dvifile,dviindx,143-Dcom-1);
+ Dh = Dh+Dpar;
+ }
+ break;
+ case 147:
+ Dh = Dh+Dw;
+ break;
+ case 148:
+ case 149:
+ case 150:
+ case 151:
+ {
+ Dpar = readinteger(dvifile,dviindx,148-Dcom-1);
+ Dw = Dpar;
+ Dh = Dh+Dw;
+ }
+ break;
+ case 152:
+ Dh = Dh+Dx;
+ break;
+ case 153:
+ case 154:
+ case 155:
+ case 156:
+ {
+ Dpar = readinteger(dvifile,dviindx,153-Dcom-1);
+ Dx = Dpar;
+ Dh = Dh+Dx;
+ }
+ break;
+ case 157:
+ case 158:
+ case 159:
+ case 160:
+ {
+ Dpar = readinteger(dvifile,dviindx,157-Dcom-1);
+ movedown(Dpar);
+ }
+ break;
+ case 161:
+ movedown(Dy);
+ break;
+ case 162:
+ case 163:
+ case 164:
+ case 165:
+ {
+ Dpar = readinteger(dvifile,dviindx,162-Dcom-1);
+ Dy = Dpar;
+ movedown(Dy);
+ }
+ break;
+ case 166:
+ movedown(Dz);
+ break;
+ case 167:
+ case 168:
+ case 169:
+ case 170:
+ {
+ Dpar = readinteger(dvifile,dviindx,167-Dcom-1);
+ Dz = Dpar;
+ movedown(Dz);
+ }
+ break;
+ case 235:
+ case 236:
+ case 237:
+ case 238:
+ {
+ Dpar = readinteger(dvifile,dviindx,Dcom-234);
+ changefont(Dpar);
+ }
+ break;
+ case 243:
+ case 244:
+ case 245:
+ case 246:
+ {
+ Dpar = readinteger(dvifile,dviindx,Dcom-242);
+ definefont(Dpar);
+ }
+ break;
+ case 239:
+ case 240:
+ case 241:
+ case 242:
+ {
+ Dpar = readinteger(dvifile,dviindx,Dcom-238);
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Cant do Special commands", '\n');
+ error();
+ }
+ skipbytes(dvifile,dviindx,Dpar);
+ }
+ break;
+ case 139:
+ case 247:
+ case 248:
+ case 249:
+ {
+ fprintf( *output, "%s%s%s%*d%s%c",
+ "Fatal: ", "Bad DVI file: ", "Byte: ", 1, Dcom, " out of context inside page", '\n')
+ ;
+ crash();
+ }
+ break;
+ case 250:
+ case 251:
+ case 252:
+ case 253:
+ case 254:
+ case 255:
+ {
+ fprintf( *output, "%s%s%s%d%c",
+ "Fatal: ", "Bad DVI file: ", "Illegal command byte, ", Dcom, '\n');
+ crash();
+ }
+ break;
+ }
+ }while( ! (endpage) );
+ pop();
+ }
+
+#ifdef ANSI
+void Skippage(void)
+#else /* not ANSI*/
+void Skippage()
+#endif /* ANSI*/
+{ byte Dcom;
+ integer Dpar;
+ boolean endpage;
+ endpage = false;
+ do{Dcom = readbyte(dvifile,dviindx);
+ if((Dcom<128)||((Dcom<=234)&&(Dcom>=171)))
+ ;
+ else switch(Dcom)
+ {case 128:
+ case 129:
+ case 130:
+ case 131:
+ skipbytes(dvifile,dviindx,Dcom-127);
+ break;
+ case 132:
+ case 137:
+ skipbytes(dvifile,dviindx,8);
+ break;
+ case 133:
+ case 134:
+ case 135:
+ case 136:
+ skipbytes(dvifile,dviindx,Dcom-132);
+ break;
+ case 138:
+ ;
+ break;
+ case 140:
+ endpage = true;
+ break;
+ case 141:
+ case 142:
+ ;
+ break;
+ case 143:
+ case 144:
+ case 145:
+ case 146:
+ skipbytes(dvifile,dviindx,Dcom-142);
+ break;
+ case 147:
+ ;
+ break;
+ case 148:
+ case 149:
+ case 150:
+ case 151:
+ skipbytes(dvifile,dviindx,Dcom-147);
+ break;
+ case 152:
+ ;
+ break;
+ case 153:
+ case 154:
+ case 155:
+ case 156:
+ skipbytes(dvifile,dviindx,Dcom-152);
+ break;
+ case 157:
+ case 158:
+ case 159:
+ case 160:
+ skipbytes(dvifile,dviindx,Dcom-156);
+ break;
+ case 161:
+ ;
+ break;
+ case 162:
+ case 163:
+ case 164:
+ case 165:
+ skipbytes(dvifile,dviindx,Dcom-161);
+ break;
+ case 166:
+ ;
+ break;
+ case 167:
+ case 168:
+ case 169:
+ case 170:
+ skipbytes(dvifile,dviindx,Dcom-166);
+ break;
+ case 235:
+ case 236:
+ case 237:
+ case 238:
+ skipbytes(dvifile,dviindx,Dcom-234);
+ break;
+ case 243:
+ case 244:
+ case 245:
+ case 246:
+ {
+ Dpar = readinteger(dvifile,dviindx,Dcom-242);
+ definefont(Dpar);
+ }
+ break;
+ case 239:
+ case 240:
+ case 241:
+ case 242:
+ {
+ Dpar = readinteger(dvifile,dviindx,Dcom-238);
+ {
+ fprintf( *output, "%s%s%c",
+ "Error: ", "Cant do Special commands", '\n');
+ error();
+ }
+ skipbytes(dvifile,dviindx,Dpar);
+ }
+ break;
+ case 139:
+ case 247:
+ case 248:
+ case 249:
+ {
+ fprintf( *output, "%s%s%s%*d%s%c",
+ "Fatal: ", "Bad DVI file: ", "Byte: ", 1, Dcom, " out of context inside page", '\n')
+ ;
+ crash();
+ }
+ break;
+ case 250:
+ case 251:
+ case 252:
+ case 253:
+ case 254:
+ case 255:
+ {
+ fprintf( *output, "%s%s%s%d%c",
+ "Fatal: ", "Bad DVI file: ", "Illegal command byte, ", Dcom, '\n');
+ crash();
+ }
+ break;
+ }
+ }while( ! (endpage) );
+ }
+
+#ifdef ANSI
+void readBOP(void)
+#else /* not ANSI*/
+void readBOP()
+#endif /* ANSI*/
+{ byte k;
+ integer Dpar;
+ do{k = readbyte(dvifile,dviindx);
+ if((k>=243)&&(k<=246))
+ {
+ Dpar = readinteger(dvifile,dviindx,k-242);
+ definefont(Dpar);
+ k = 138;
+ }
+ }while( ! (k!=138) );
+ if(k==248)
+ countpages = -1;
+ else if(k!=139)
+ {
+ fprintf( *output, "%s%s%s%c",
+ "Fatal: ", "Bad DVI file: ", "Byte is not BOP", '\n');
+ crash();
+ }
+ else{
+ {register integer for_end;k=0;for_end=9; if (k<=for_end)do
+ counter[k] = readinteger(dvifile,dviindx,-4);
+ while(k++ < for_end);}
+ skipbytes(dvifile,dviindx,4);
+ }
+ }
+
+#ifdef ANSI
+void zrow( integer scheme, integer rownum, iword firstfont)
+#else /* not ANSI*/
+void zrow( scheme, rownum, firstfont)
+ integer scheme;
+ integer rownum;
+ iword firstfont;
+#endif /* ANSI*/
+{ /*732*/integer n;
+ codeobject codd;
+ rowfont = firstfont;
+ finger = 0;
+ {register integer for_end;n=8*rownum;for_end=8*rownum+7; if (n<=for_end)do
+ {
+ rowchar(0,codd);
+ if((codd.breadth==-32766))
+ ;
+ else codes[scheme][n] = codd;
+ }
+ while(n++ < for_end);}
+ lab732:;
+ }
+
+#ifdef ANSI
+void Sendpage(void)
+#else /* not ANSI*/
+void Sendpage()
+#endif /* ANSI*/
+{ link line;
+ PRfont = -32767;
+ PRh = 0;
+ PRv = 0;
+ while((!(curpgeptr==zzz))){
+ line = readline();
+ doline(line,0);
+ }
+ }
+void main_body() {*input = stdin;
+*output = stdout;
+ blank.len = 0;
+ {register integer for_end;ini=1;for_end=maxstring; if (ini<=for_end)do
+ blank.data[ini] = padchar;
+ while(ini++ < for_end);}
+ setstring(".dvi",buffer);
+ dvidef = buffer;
+ setstring("/tex/fonts/.tfm",buffer);
+ tfmdef = buffer;
+ setstring("/tex/gfdir/.&Dgf",buffer);
+ rasterdef = buffer;
+ setstring(".lpr",buffer);
+ printex = buffer;
+ quiet = false;
+ runon = false;
+ squash = false;
+ magnify = 100;
+ hmag = 100;
+ vmag = 100;
+ batchview = false;
+ firstpage = -1000000L;
+ countpages = 1000000L;
+ printname = blank;
+ start = false;
+ timetostop = false;
+ pagegap = false;
+ {register integer for_end;ini=0;for_end=9; if (ini<=for_end)do
+ counter[ini] = 0;
+ while(ini++ < for_end);}
+ nf = 0;
+ {register integer for_end;ini=0;for_end=maxDfonts; if (ini<=for_end)do
+ {
+ fontnum[ini] = 0;
+ scheme[ini] = 0;
+ firstch[ini] = 0;
+ lastch[ini] = 0;
+ fontspace[ini] = 0;
+ }
+ while(ini++ < for_end);}
+ nochar.breadth = -32766;
+ nochar.IMfont = 0;
+ nochar.IMchar = 0;
+ schemetop = 0;
+ {register integer for_end;ini=0;for_end=maxcodes; if (ini<=for_end)do
+ {
+ knownschemes[ini] = blank;
+ schememap[ini] = 0;
+ {register integer for_end;inj=0;for_end=maxDchar; if (inj<=for_end)do
+ {
+ codes[ini][inj] = nochar;
+ }
+ while(inj++ < for_end);}
+ }
+ while(ini++ < for_end);}
+ topofligs = 0;
+ {register integer for_end;ini=1;for_end=maxligs; if (ini<=for_end)do
+ ligatures[ini].symbol = nochar;
+ while(ini++ < for_end);}
+ hmax = hresolution*100;
+ vmax = vresolution*100;
+ hmin = 0;
+ vmin = 0;
+ cell = 0;
+ cell = cell+1;
+ mid = cell;
+ cell = cell+1;
+ left = cell;
+ cell = cell+1;
+ right = cell;
+ cell = cell+1;
+ run = cell;
+ cell = cell+1;
+ zzz = cell;
+ pool[zzz].vpos = 32767;
+ pool[zzz].prox = zzz;
+ midptr = zzz;
+ runptr = zzz;
+ vstrcpy(deviceID,"Lineprinter ");
+ list = false;
+ xwzfortran = false;
+ bfeedabsolute = false;
+ bfeedbystring = false;
+ feedabsolute = false;
+ bfeedscream = true;
+ bspaceabsolute = false;
+ bspacebystring = false;
+ spaceabsolute = false;
+ absisincr = false;
+ wldoescr = false;
+ wantsplit = true;
+ isheader = false;
+ dopause = false;
+ inspection = false;
+ wlfeeddist = 1;
+ crfeeddist = 0;
+ feeddist = 1;
+ tfeeddist = 1;
+ bfeeddist = 0;
+ tinydrop = 50000L;
+ bigdrop = 4;
+ spacedist = 1;
+ tspacedist = 1;
+ bspacedist = 1;
+ pausei = 0;
+ pausesteps = 20;
+ feedchar = chr(10);
+ tfeedchar = chr(10);
+ crchar = chr(13);
+ spacechar = chr(32);
+ tspacechar = chr(32);
+ bspacechar = chr(8);
+ startstuff = blank;
+ stopstuff = blank;
+ pagetop = blank;
+ bfeedstring = blank;
+ fontcommand = blank;
+ vabscom = blank;
+ habscom = blank;
+ pauseafter = blank;
+ lmargin = 1.0;
+ topmargin = 1.0;
+ hfudge = 7.227/ ((double)5.25);
+ vfudge = 2.0;
+ setpaths(TFMFILEPATHBIT+TEXINPUTPATHBIT);
+ wlfeeddist = 1;
+ wldoescr = true;
+ command = blank;
+ getcommand();
+ dviname = blank;
+ if((argc>1))
+ parsecommand();
+ if(true&&(dviname.len==0))
+ do{{
+ fprintf( *output, "%s%c", "DVI file name? ", '\n');
+ readterminal();
+ }
+ getname(dviname);
+ }while( ! ((dviname.len>0)) );
+ dviindx = TEXINPUTPATH;
+ if(!openandask(dvifile,dviindx,dviname,dvidef,true))
+ {
+ fprintf( *output, "%s%s%c", "Fatal: ", "couldnt open DVI file", '\n');
+ crash();
+ }
+ if(!(argc>1))
+ if(true)
+ {
+ buffer = blank;
+ {
+ fprintf( *output, "%s%c",
+ "First page? (default = print ALL pages) ", '\n');
+ readterminal();
+ }
+ if((buffer.len>0))
+ firstpage = stoi(firstpage,true);
+ {
+ fprintf( *output, "%s%c",
+ "Maximum no. of pages? (default = 1000000) ", '\n');
+ readterminal();
+ }
+ if((buffer.len>0))
+ countpages = stoi(countpages,true);
+ {
+ fprintf( *output, "%s%c",
+ "What magnification? (integer, percent, default=100%=DVI file mag)1", '\n')
+ ;
+ readterminal();
+ }
+ if((buffer.len>0))
+ magnify = stoi(magnify,true);
+ }
+ setstring("TEX EXTENDED ASCII",buffer);
+ setscheme(1);
+ alphabet(32,95,1,1,32);
+ setstring(
+ " . {|v} Z Z & ~ {LC-} Z ",
+ buffer);
+ row(1,0,1);
+ setstring(
+ " Z Z Z {^|} {+_} {LO+} Z Z ",
+ buffer);
+ row(1,1,1);
+ setstring(
+ " Z Z Z Z Z Z {LOx} Z ",
+ buffer);
+ row(1,2,1);
+ setstring(
+ " [{L<-}-] [-{-L>}] {=/} Z {L<_} {L>_} {=_} [or] ",
+ buffer);
+ row(1,3,1);
+ setstring("TEX TYPEWRITER TEXT",buffer);
+ setscheme(2);
+ alphabet(32,95,2,1,32);
+ codes[2][127].IMchar = 34;
+ setstring(
+ " Z [{/_}{_\\}] {0-} [/\\] Z Z Z Z ",
+ buffer);
+ row(2,0,1);
+ setstring(
+ " Z Z Z Z <U_{-_}> <U[__][||]> <U_{L>_}> LY ",
+ buffer);
+ row(2,0,1);
+ setstring(
+ " {oI} {u|} Z {^|} {v|} Q ! ? ",
+ buffer);
+ row(2,1,1);
+ setstring(
+ " i j ` Q Z Z <U_> <U.> ",
+ buffer);
+ row(2,2,1);
+ setstring(
+ " , {LB_} [ae] [oe] {o/} [LALE] [LOLE] {LO/} ",
+ buffer);
+ row(2,3,1);
+ setstring("TEX TEXT",buffer);
+ setscheme(3);
+ {register integer for_end;ini=0;for_end=127; if (ini<=for_end)do
+ codes[3][ini] = codes[2][ini];
+ while(ini++ < for_end);}
+ setstring(
+ " Z Z Z [ff] [fi] [fl] [ffi] [ffl] ",
+ buffer);
+ row(3,1,1);
+ setstring(
+ " Z Z Z Z ! Z ? Z ",
+ buffer);
+ row(3,7,1);
+ setstring(
+ " Z Z Z Z W Z Z <U.> ",
+ buffer);
+ row(3,11,1);
+ setstring(
+ " Z Z Z - [--] W ~ W ",
+ buffer);
+ row(3,15,1);
+ setstring("TEX TEXT WITHOUT F-LIGATURES",buffer);
+ setscheme(4);
+ {register integer for_end;ini=0;for_end=127; if (ini<=for_end)do
+ codes[4][ini] = codes[3][ini];
+ while(ini++ < for_end);}
+ setstring(
+ " {oI} {u|} Z {^|} {v|} Q ! ? ",
+ buffer);
+ row(4,1,1);
+ setstring("AEFMNOT ONLY",buffer);
+ setscheme(5);
+ setstring(
+ " Z LA Z Z Z LE LF Z ",
+ buffer);
+ row(5,8,1);
+ setstring(
+ " Z Z Z Z Z LM LN LO ",
+ buffer);
+ row(5,9,1);
+ setstring(
+ " Z Z Z Z LT Z Z Z ",
+ buffer);
+ row(5,10,1);
+ setstring("TEX MATH ITALIC",buffer);
+ setscheme(6);
+ {register integer for_end;ini=0;for_end=9; if (ini<=for_end)do
+ codes[6][ini] = codes[2][ini];
+ while(ini++ < for_end);}
+ alphabet(48,43,6,1,48);
+ alphabet(97,26,6,1,97);
+ setstring(
+ " Z Z . , Z / Z * ",
+ buffer);
+ row(6,7,1);
+ setstring("TEX MATH SYMBOLS",buffer);
+ setscheme(7);
+ alphabet(65,26,7,1,65);
+ setstring(
+ " - . {\\/} * {-:} Z {+_} <U_+> ",
+ buffer);
+ row(7,0,1);
+ setstring(
+ " {LO+} {LO-} {LOx} {LO/} LO LO o o ",
+ buffer);
+ row(7,1,1);
+ setstring(
+ " Z {=_} Z Z {L<_} {L>_} {L<_} {L>_} ",
+ buffer);
+ row(7,2,1);
+ setstring(
+ " ~ <U~~> Z Z [L<L<] [L>L>] L< L> ",
+ buffer);
+ row(7,3,1);
+ setstring(
+ " [{L<-}-] [-{L>-}] {|^} {|v} Z Z Z Z ",
+ buffer);
+ row(7,4,1);
+ setstring(
+ " Z Z Z Z [{L<-}{-L>}] / \\ {~_} ",
+ buffer);
+ row(7,4,1);
+ setstring(
+ " [{L<=}=] [={L>=}] {|^} {|v} Z Z Z Z ",
+ buffer);
+ row(7,5,1);
+ setstring(
+ " Z Z Z Z [{L<=}{=L>}] Z Z Z ",
+ buffer);
+ row(7,5,1);
+ setstring(
+ " Q [oo] {L(-} {-L)} Z Z Z Z ",
+ buffer);
+ row(7,6,1);
+ setstring(
+ " Z Z Z Z [{/_}{_\\}] <U[__][\\/]> / Q ",
+ buffer);
+ row(7,6,1);
+ setstring(
+ " [{\\-}{-/}] <U_[{-_}|]> ~ {0/} LR LT <U_|> {|_}",
+ buffer);
+ row(7,7,1);
+ setstring(
+ " Z Z Z LU Z {LU+} & [or] ",
+ buffer);
+ row(7,11,1);
+ setstring(
+ " [{|-}-] [-{-|}] Z Z Z Z L{ L} ",
+ buffer);
+ row(7,12,1);
+ setstring(
+ " L< L> | [||] {^|v} {^|v} \\ Z ",
+ buffer);
+ row(7,13,1);
+ setstring(
+ " <[S_]{v/}> [{LI_}{LI_}] <U[__][\\/]> <U/|/> Z Z Z Z ",
+ buffer);
+ row(7,14,1);
+ setstring(
+ " {LS*} {|-} {|-_} {9|} Z Z Z Z ",
+ buffer);
+ row(7,15,1);
+ setstring("TEX MATH EXTENSION",buffer);
+ setscheme(8);
+ setstring(
+ " <SL(L(> <SL)L)> <SL[L[> <SL]L]> ZZZZ",
+ buffer);
+ row(8,0,1);
+ setstring(
+ " <SL{L{> <SL}L}> <S/\\> <S\\/> ZZZZ",
+ buffer);
+ row(8,1,1);
+ setstring(
+ " <SL(L(L(> <SL)L)L)> <SL(L(L(L(> <SL)L)L)L)> ZZZZ",
+ buffer);
+ row(8,2,1);
+ setstring(
+ " <SL[|||> <SL]|||> <SL{/\\L{> <SL}\\/L}> ZZZZ",
+ buffer);
+ row(8,3,1);
+ setstring(
+ " <SL(L(L(L(L(> <SL)L)L)L)L)> <SL[|||L[> <SL]|||L]> ZZZZ",
+ buffer);
+ row(8,4,1);
+ setstring(
+ " <SL{L|L<|L{> <SL}|L>|L}> <S[S/]/\\[S\\]> <S\\[S\\][S/]/> ZZZZ",
+ buffer);
+ row(8,5,1);
+ setstring(
+ " <S/||> <S\\||> <SL[||> <SL]||> ZZZZ",
+ buffer);
+ row(8,6,1);
+ setstring(
+ " <S[S/]|> <S\\[S|]> <S|[S\\]> <S[S|]/> ZZZZ",
+ buffer);
+ row(8,7,1);
+ setstring(
+ " <S||\\> <S||/> <S|> <S|> ZZZZ",
+ buffer);
+ row(8,8,1);
+ setstring(
+ " <[__]\\[{/_}_]> <[__][LILI]> </|/> <S[||][\\/]> ZZZZ",
+ buffer);
+ row(8,10,1);
+ setstring(
+ " <S[{|_}{|_}]> <S[|S|][{|_}_{_|}]> <U_> <U[__]> ZZZZ",
+ buffer);
+ row(8,12,1);
+ setstring(
+ " <SL[L[L[> <SL]L]L]> <S||L[> <S||L]> ZZZZ",
+ buffer);
+ row(8,13,1);
+ setstring(
+ " <S{|^}> <S{|v}> / \\ ZZZZ",
+ buffer);
+ row(8,15,1);
+ setstring(
+ "ZZZZ <S|L[> <S|L]> <SL[|> <SL]|> ",
+ buffer);
+ row(8,0,1);
+ setstring(
+ "ZZZZ <S|> <S[||]> <S[S/]/> <Z\\[S\\]> ",
+ buffer);
+ row(8,1,1);
+ setstring(
+ "ZZZZ <SL[L[L[L[> <SL]L]L]L]> <S|||L[> <S|||L]> ",
+ buffer);
+ row(8,2,1);
+ setstring(
+ "ZZZZ <S[S/]/\\[S\\]> <S\\[S\\][S/]/> <S[S/][S/]//> <S\\\\[S\\][S\\]> "
+ ,buffer);
+ row(8,3,1);
+ setstring(
+ "ZZZZ <S||||L[> <S||||L]> <SL[||||> <SL]||||> ",
+ buffer);
+ row(8,4,1);
+ setstring(
+ "ZZZZ <S[S/][S/]//> <S\\\\[S\\][S\\]> <S[SS/][S/]/> <S\\[S\\][SS\\]> "
+ ,buffer);
+ row(8,5,1);
+ setstring(
+ "ZZZZ <S||L[> <S||L]> <S|> <S|> ",
+ buffer);
+ row(8,6,1);
+ setstring(
+ "ZZZZ <S[S|]L<[S|]> <S|[SL>]|> <S|> <S|> ",
+ buffer);
+ row(8,7,1);
+ setstring(
+ "ZZZZ <S[S/]L<[S\\]> <S\\[SL>]/> <S[{|_}{|_}]> <S[|S|][{|_}S{|_}]> ",
+ buffer);
+ row(8,8,1);
+ setstring(
+ "ZZZZ <S[/\\][||]> <S[|+|][\\_/]> <S[/\\]> <S[\\/]> ",
+ buffer);
+ row(8,10,1);
+ setstring(
+ "ZZZZ <U[___]> <U~> <U[~~]> <U[~~~]> ",
+ buffer);
+ row(8,12,1);
+ setstring(
+ "ZZZZ <SL[||> <SL]||> <SL{L{L{> <SL}L}L}> ",
+ buffer);
+ row(8,13,1);
+ setstring(
+ "ZZZZ \\ / <S{|^}> <S{|v}> ",
+ buffer);
+ row(8,15,1);
+ setstring(
+ " </{|O}/> <S/{|O}|/> <S[/\\][\\/]> <S[S_][/.\\][\\_/]> ZZZZ",
+ buffer);
+ row(8,9,1);
+ setstring(
+ "ZZZZ <S[{/_}{\\_}][\\/]> <S[S_][{/_}{|_}{_\\}][\\{|_}/]> ZZ",
+ buffer);
+ row(8,9,1);
+ setstring(
+ "ZZZZZZ <S[{\\/}{/\\}][{\\/}{/\\}]> <[S_][{\\/}S{/\\}][|{\\/}|][{/\\}_{/\\}]> "
+ ,buffer);
+ row(8,9,1);
+ setstring(
+ " <[___]\\[SL>][{/_}__]> <[___][|S|][|S|][|S|]> <S/||/> ZZZZZ",
+ buffer);
+ row(8,11,1);
+ setstring(
+ "ZZZ <S[|S|][|S|][\\_/]> <[S_][/S\\][|S|][|S|]> ZZZ",
+ buffer);
+ row(8,11,1);
+ setstring(
+ "ZZZZZ <S[|S|][|+|][\\_/]> <SS[S/\\][/SS\\]> <SS[\\SS/][S\\/]> "
+ ,buffer);
+ row(8,11,1);
+ setstring(
+ " <S[_S|][S\\|]> <S[SS|][_S|][S\\|]> <S[SS|][SS|][_S|][S\\|]> ZZZZZ",
+ buffer);
+ row(8,14,1);
+ setstring(
+ "ZZZ <S[SS|][SS|][SS|][_S|][S\\|]> <S[SS|][_S|][S\\|]> ZZZ",
+ buffer);
+ row(8,14,1);
+ setstring(
+ "ZZZZZ <S|> <U_|> <S[||]> ",
+ buffer);
+ row(8,14,1);
+ setstring("LATEX SYMBOLS",buffer);
+ setscheme(9);
+ setstring("LATEX CIRCLE",buffer);
+ setscheme(10);
+ setstring(
+ " Z [L<|] [{L<_}|] [|L>] [|{L>_}] Z Z Z ",
+ buffer);
+ row(9,0,1);
+ setstring(
+ " [L<] [L>] Z Z Z Z Z Z ",
+ buffer);
+ row(9,5,1);
+ setstring(
+ " Z Z ~ ~ Z Z Z Z ",
+ buffer);
+ row(9,7,1);
+ setstring("LATEX LINE",buffer);
+ setscheme(11);
+ setstring(
+ " / | | | | | Z Z ",
+ buffer);
+ row(11,0,1);
+ setstring(
+ " / L< / v | v ^ v ",
+ buffer);
+ row(11,1,1);
+ setstring(
+ " / / L> / / ^ Z ^ ",
+ buffer);
+ row(11,2,1);
+ setstring(
+ " / L< / L< / L< L> Z ",
+ buffer);
+ row(11,3,1);
+ setstring(
+ " / / / / Z / Z Z ",
+ buffer);
+ row(11,4,1);
+ setstring(
+ " _ L< L> L< / L> Z L< ",
+ buffer);
+ row(11,5,1);
+ setstring(
+ " Z L> Z L> Z Z ^ L> ",
+ buffer);
+ row(11,6,1);
+ setstring(
+ " Z L< L> Z Z L< L> v ",
+ buffer);
+ row(11,7,1);
+ setstring(
+ " \\ | | | | | Z Z ",
+ buffer);
+ row(11,8,1);
+ setstring(
+ " \\ L< \\ ^ | ^ v ^ ",
+ buffer);
+ row(11,9,1);
+ setstring(
+ " \\ \\ L> \\ \\ v Z v ",
+ buffer);
+ row(11,10,1);
+ setstring(
+ " \\ L< \\ L< \\ L< L> Z ",
+ buffer);
+ row(11,11,1);
+ setstring(
+ " \\ \\ \\ \\ Z \\ Z Z "
+ ,buffer);
+ row(11,12,1);
+ setstring(
+ " _ L< L> L< \\ L> Z L< ",
+ buffer);
+ row(11,13,1);
+ setstring(
+ " Z L> Z L> Z Z Z L> ",
+ buffer);
+ row(11,14,1);
+ setstring(
+ " Z L< L> Z Z L< L> Z ",
+ buffer);
+ row(11,15,1);
+ setstring("ADOBESTANDARDENCODING",buffer);
+ setscheme(12);
+ alphabet(32,95,12,1,32);
+ setstring(
+ " Z ! {LC/} $ / {Y=} f {LS*} ",
+ buffer);
+ row(12,20,1);
+ setstring(
+ " * Q W [L<L<] L< L> [fi] [fl] ",
+ buffer);
+ row(12,21,1);
+ setstring(
+ " Z - {|-} {|-_} . Z {9|} . ",
+ buffer);
+ row(12,22,1);
+ setstring(
+ " , [,,] W [L>L>] [...] [%.] Z ? ",
+ buffer);
+ row(12,23,1);
+ setstring(
+ " Z ` Q ^ ~ <U_> Z <U.> ",
+ buffer);
+ row(12,24,1);
+ setstring(
+ " <U[..]> Z <U.> , Z W , Z ",
+ buffer);
+ row(12,25,1);
+ setstring(
+ " [--] Z Z Z Z Z Z Z ",
+ buffer);
+ row(12,26,1);
+ setstring(
+ " Z [LALE] Z <U{a_}> Z Z Z Z ",
+ buffer);
+ row(12,28,1);
+ setstring(
+ " L {O/} [OLE] <U{o_}> Z Z Z Z ",
+ buffer);
+ row(12,29,1);
+ setstring(
+ " Z [ae] Z Z Z i Z Z ",
+ buffer);
+ row(12,30,1);
+ setstring(
+ " l {O/} [oe] {B_} Z Z Z Z ",
+ buffer);
+ row(12,31,1);
+ setstring("ADOBESYMBOLENCODING",buffer);
+ setscheme(13);
+ alphabet(32,48,13,1,32);
+ setstring(
+ " Z Z [{\\-}{-/}] Z <U_[{-_}|]> Z Z {)-}$ ",
+ buffer);
+ row(13,4,1);
+ setstring(
+ " {~=} Z Z X [{/_}{_\\}] Z {oI} S ",
+ buffer);
+ row(13,8,1);
+ setstring(
+ " Z Z v Z [/\\] Z Z Z ",
+ buffer);
+ row(13,9,1);
+ setstring(
+ " <U[__][||]> {O-} P <U_{L>_}> T Y Z Z ",
+ buffer);
+ row(13,10,1);
+ setstring(
+ " <U_{-_}> {u|} LZ L[ <U[S.][.S.]> L] {|_} _ ",
+ buffer);
+ row(13,11,1);
+ setstring(
+ " <U[S_]> Z Z Z Z Z Z Z ",
+ buffer);
+ row(13,12,1);
+ setstring(
+ " Z Z Z L{ | L} ~ Z ",
+ buffer);
+ row(13,15,1);
+ setstring(
+ " Z Z Q {L<_} / [oo] f Z ",
+ buffer);
+ row(13,20,1);
+ setstring(
+ " Z Z Z [{L<-}{-L>}] [{L<-}-] {^|} [-{-L>}] {|v} ",
+ buffer);
+ row(13,21,1);
+ setstring(
+ " o {+_} W {L>_} x Z d o ",
+ buffer);
+ row(13,22,1);
+ setstring(
+ " {-:} {=/} {=_} <U~~> [...] <U||> [---] Z ",
+ buffer);
+ row(13,23,1);
+ setstring(
+ " Z Z Z Z {Ox} {O+} {O/} Z ",
+ buffer);
+ row(13,24,1);
+ setstring(
+ " LU Z Z Z Z Z {(-} {(-/} ",
+ buffer);
+ row(13,25,1);
+ setstring(
+ " {/_} <U[__][\\/]> {Or} {Oc} [TLM] <U[__][||]> <U[S_]{v/}> . ",
+ buffer);
+ row(13,26,1);
+ setstring(
+ " ~ & [or] [{L<=}{=L>}] [{L<=}=] {^|} [={=L>}] {|v} ",
+ buffer);
+ row(13,27,1);
+ setstring(
+ " Z <U/\\> {Or} {Oc} [TLM] <U_{L>_}> <U[S/]|> <U||> ",
+ buffer);
+ row(13,28,1);
+ setstring(
+ " <U|[S\\]> <UL[|> <U||> <U|L[> <U[S/]|> <U||> <U|[S\\]> <U||> ",
+ buffer);
+ row(13,29,1);
+ setstring(
+ " Z <U\\/> <U[S/][S|]/> <U[S/]|> <U||> <U[S|]/> <U\\[S|]> <U||> ",
+ buffer);
+ row(13,30,1);
+ setstring(
+ " <U[S|]/> <UL]|> <U||> <U|L]> <U\\[S|]> <U||> <U[S|]/> Z ",
+ buffer);
+ row(13,31,1);
+ setstring("SYMBOL",buffer);
+ setscheme(13);
+ setstring("PSSYML",buffer);
+ setscheme(13);
+ setstring("PSSYMU",buffer);
+ setscheme(14);
+ {register integer for_end;ini=0;for_end=127; if (ini<=for_end)do
+ codes[14][ini] = codes[13][ini+128];
+ while(ini++ < for_end);}
+ if(batchview)
+ {
+ setstring(
+ " Z Z [\\=] Z [L<=] [L>=] [==] [or] ",
+ buffer);
+ row(1,3,1);
+ setstring(
+ " Z [==] Z Z [L<=] [L>=] [L<=] [L>=] ",
+ buffer);
+ row(7,2,1);
+ }
+ setstring("CMTEX",buffer);
+ setscheme(1);
+ setstring("CMTT",buffer);
+ setscheme(2);
+ setstring("CMSLTT",buffer);
+ setscheme(2);
+ setstring("CMCSC",buffer);
+ setscheme(2);
+ setstring("CMTCSC",buffer);
+ setscheme(2);
+ setstring("CMITT",buffer);
+ setscheme(2);
+ setstring("CMB",buffer);
+ setscheme(3);
+ setstring("CMBX",buffer);
+ setscheme(3);
+ setstring("CMBXSL",buffer);
+ setscheme(3);
+ setstring("CMBXTI",buffer);
+ setscheme(3);
+ setstring("CMDUNH",buffer);
+ setscheme(3);
+ setstring("CMFF",buffer);
+ setscheme(3);
+ setstring("CMFI",buffer);
+ setscheme(3);
+ setstring("CMFIB",buffer);
+ setscheme(3);
+ setstring("CMINCH",buffer);
+ setscheme(3);
+ setstring("CMR",buffer);
+ setscheme(3);
+ setstring("CMSL",buffer);
+ setscheme(3);
+ setstring("CMSS",buffer);
+ setscheme(3);
+ setstring("CMSSBX",buffer);
+ setscheme(3);
+ setstring("CMSSDC",buffer);
+ setscheme(3);
+ setstring("CMSSI",buffer);
+ setscheme(3);
+ setstring("CMSSQ",buffer);
+ setscheme(3);
+ setstring("CMSSQI",buffer);
+ setscheme(3);
+ setstring("CMTI",buffer);
+ setscheme(3);
+ setstring("CMU",buffer);
+ setscheme(3);
+ setstring("CMVTT",buffer);
+ setscheme(3);
+ setstring("CMCSC10",buffer);
+ setscheme(4);
+ setstring("CMR5",buffer);
+ setscheme(4);
+ setstring("CMR5",buffer);
+ setscheme(4);
+ setstring("LOGO",buffer);
+ setscheme(5);
+ setstring("LOGOBF",buffer);
+ setscheme(5);
+ setstring("LOGOSL",buffer);
+ setscheme(5);
+ setstring("CMMI",buffer);
+ setscheme(6);
+ setstring("CMMIB",buffer);
+ setscheme(6);
+ setstring("CMBSY",buffer);
+ setscheme(7);
+ setstring("CMSY",buffer);
+ setscheme(7);
+ setstring("CMEX",buffer);
+ setscheme(8);
+ setstring("LASY",buffer);
+ setscheme(9);
+ setstring("LASYB",buffer);
+ setscheme(9);
+ setstring("CIRCLE",buffer);
+ setscheme(10);
+ setstring("CIRCLEW",buffer);
+ setscheme(10);
+ railchars[1] = codes[1][95];
+ railchars[2] = codes[1][45];
+ postchar = codes[1][124];
+ if(inspection)
+ {
+ batchview = true;
+ quiet = true;
+ dopause = (pausesteps>0);
+ }
+ if(batchview)
+ {
+ vstrcpy(deviceID,"screenview ");
+ runon = true;
+ xwzfortran = false;
+ list = true;
+ }
+ if(xwzfortran)
+ {
+ wldoescr = true;
+ wlfeeddist = 1;
+ feedchar = ' ';
+ tfeedchar = ' ';
+ crchar = '+';
+ }
+ if(list)
+ {
+ wlfeeddist = 1;
+ crfeeddist = 1;
+ crchar = ' ';
+ wldoescr = true;
+ lmargin = 0;
+ topmargin = 0;
+ }
+ if(!quiet)
+ fprintf( *output, "%s%s%s%c",
+ "This is Crudetype, Version 3.01, copyright, experimental WEB2C", " --- ", deviceID, '\n')
+ ;
+ if((printname.len==0))
+ {
+ parsefile(dviname,pd,pn,pex);
+ if(true)
+ printname = pd;
+ else printname = blank;
+ append(printname,pn);
+ append(printname,printex);
+ }
+ if(inspection)
+ {
+ setstring("/dev/tty",buffer);
+ printname = buffer;
+ }
+ rewrite(printfile,printname.data);
+ printstring(printfile,startstuff,ctrlflag);
+ fprintf( *printfile, "%c", '\n');
+ if(inspection)
+ flush(printfile);
+ bbb = readbyte(dvifile,dviindx);
+ if(bbb!=247)
+ {
+ fprintf( *output, "%s%s%s%c",
+ "Fatal: ", "Bad DVI file: ", "First byte isn't start of preamble!", '\n')
+ ;
+ crash();
+ }
+ bbb = readbyte(dvifile,dviindx);
+ if(bbb!=2)
+ {
+ fprintf( *output, "%s%s%*d%s%*d%c",
+ "Error: ", "Identification byte should be ", 1, 2, ", it is actually", 1, bbb, '\n')
+ ;
+ error();
+ }
+ dvifactor = rrreadreal(dvifile,dviindx)/ ((double)254000.0);
+ Dlmargin = round(lmargin/ ((double)dvifactor));
+ Dtopmargin = round(topmargin/ ((double)dvifactor));
+ magnification = readinteger(dvifile,dviindx,4)/ ((double)1000);
+ dvifactor = dvifactor*magnification;
+ dvifactor = dvifactor*magnify/ ((double)100.0);
+ hconv = dvifactor*hresolution*hfudge*hmag/ ((double)100.0);
+ vconv = dvifactor*vresolution*vfudge*vmag/ ((double)100.0);
+ bbb = readbyte(dvifile,dviindx);
+ if(quiet)
+ skipbytes(dvifile,dviindx,bbb);
+ else{
+ {register integer for_end;nnn=1;for_end=bbb; if (nnn<=for_end)do
+ fprintf( *output, "%c", chr(readbyte(dvifile,dviindx)));
+ while(nnn++ < for_end);}
+ fprintf( *output, "%c%c", ' ', '\n');
+ }
+ do{readBOP();
+ if((counter[0]>=firstpage))
+ start = true;
+ if(start&&(countpages>0))
+ {
+ if(runon)
+ {
+ fprintf( *printfile, "%c", '\n');
+ fprintf( *printfile, "%s%*d%c", "------ PAGE ", 1, counter[0], ' ');
+ fprintf( *printfile, "%s", "----------------------------------");
+ fprintf( *printfile, "%s", "----------------------------------");
+ fprintf( *printfile, "%c", '\n');
+ }
+ else if(pagegap)
+ page(printfile);
+ else pagegap = true;
+ if(isheader)
+ printstring(printfile,pagetop,ctrlflag);
+ countpages = countpages-1;
+ if(!quiet)
+ fprintf( *output, "%c%*d", '[', 1, counter[0]);
+ Readonepage();
+ sorted = false;
+ pool[runptr].prox = zzz;
+ runptr = pool[run].prox;
+ cell = cell+1;
+ pool[midptr].prox = cell;
+ midptr = cell;
+ pool[midptr].down = runptr;
+ do{pool[midptr].prox = zzz;
+ midptr = pool[mid].prox;
+ leftptr = left;
+ pool[left].prox = zzz;
+ rightptr = right;
+ pool[right].prox = zzz;
+ do{{
+ tempp = midptr;
+ midptr = pool[midptr].prox;
+ pool[leftptr].prox = tempp;
+ leftptr = pool[leftptr].prox;
+ }
+ if(!(midptr==zzz))
+ {
+ tempp = midptr;
+ midptr = pool[midptr].prox;
+ pool[rightptr].prox = tempp;
+ rightptr = pool[rightptr].prox;
+ }
+ }while( ! ((midptr==zzz)) );
+ midptr = mid;
+ pool[mid].prox = zzz;
+ pool[leftptr].prox = zzz;
+ leftptr = pool[left].prox;
+ pool[rightptr].prox = zzz;
+ rightptr = pool[right].prox;
+ sorted = (rightptr==zzz);
+ if(sorted)
+ curpgeptr = pool[pool[left].prox].down;
+ else do{if((rightptr==zzz))
+ {
+ tempp = leftptr;
+ leftptr = pool[leftptr].prox;
+ pool[midptr].prox = tempp;
+ midptr = pool[midptr].prox;
+ }
+ else if((leftptr==zzz))
+ {
+ tempp = rightptr;
+ rightptr = pool[rightptr].prox;
+ pool[midptr].prox = tempp;
+ midptr = pool[midptr].prox;
+ }
+ else{
+ runptr = run;
+ pool[run].prox = zzz;
+ Lrunptr = pool[leftptr].down;
+ Rrunptr = pool[rightptr].down;
+ do{if(((pool[Lrunptr].vpos<pool[Rrunptr].vpos)||((pool[Lrunptr]
+ .vpos==pool[Rrunptr].vpos)&&(pool[Lrunptr].hpos<=pool[Rrunptr]
+ .hpos))))
+ {
+ tempp = Lrunptr;
+ Lrunptr = pool[Lrunptr].prox;
+ pool[runptr].prox = tempp;
+ runptr = pool[runptr].prox;
+ }
+ else{
+ tempp = Rrunptr;
+ Rrunptr = pool[Rrunptr].prox;
+ pool[runptr].prox = tempp;
+ runptr = pool[runptr].prox;
+ }
+ }while( ! ((Rrunptr==zzz)&&(Lrunptr==zzz)) );
+ tempp = leftptr;
+ leftptr = pool[leftptr].prox;
+ tempp = rightptr;
+ rightptr = pool[rightptr].prox;
+ pool[runptr].prox = zzz;
+ runptr = pool[run].prox;
+ cell = cell+1;
+ pool[midptr].prox = cell;
+ midptr = cell;
+ pool[midptr].down = runptr;
+ }
+ }while( ! ((leftptr==zzz)&&(rightptr==zzz)) );
+ }while( ! (sorted) );
+ Sendpage();
+ if(!quiet)
+ fprintf( *output, "%c", ']');
+ }
+ else if((countpages>0))
+ Skippage();
+ else timetostop = true;
+ }while( ! (timetostop) );
+ printstring(printfile,stopstuff,ctrlflag);
+ fprintf( *printfile, "%c", '\n');
+ if(inspection)
+ flush(printfile);
+ if(!quiet)
+ {
+ fprintf( *output, "%s", "Output written to file: ");
+ printstring(output,printname,' ');
+ }
+ fprintf( *output, "%c%c", ' ', '\n');
+ lab732:;
+ }
diff --git a/dviware/crudetype/version3/noscheme.add b/dviware/crudetype/version3/noscheme.add
new file mode 100644
index 0000000000..6d9c98e30e
--- /dev/null
+++ b/dviware/crudetype/version3/noscheme.add
@@ -0,0 +1,88 @@
+% NOSCHEME.ADD
+%
+
+@* Missing coding schemes.
+
+This file goes with \.{Crudetype} version 2. It allows \.{Crudetype} to
+handle \.{TFM} files with no coding schemes. It stinks -- but much less than
+before. To use this, append it to CRUDETYPE.WEB.
+
+The font files that come on tapes from Stanford contain a piece of data called
+a `coding scheme'. Essentially, this tells you what letter to expect to find
+in each cell of the font table, if you ignore topological differences of
+slant, blackness etc. Each table in Appendix F of the \TeX book gives a
+different scheme; and there are a few more schemes in fonts in common use.
+Unfortunately, some font designers have been producing fonts with this
+information lacking. It is not actually illegal to omit the coding scheme
+because the specification for \.{TFM} files describes the coding scheme as
+optional. But in my opinion this is a very bad and slovenly practice. If a
+site cannot provide file space for every conceivable font, they will probably
+want to save space by some form of font-substitution. The coding scheme is an
+essential tool for trying to decide whether Font A is an acceptable substitute
+for B.
+
+You need one line for each type face you expect to use. The first argument is
+the name of the font, usually with size digits omitted. A name with the size
+digits present will take precedence, e.g. {\tt CMR5} over {\tt CMR}. The
+second argument is the number of the corresponding coding scheme. So this is
+essentially just a list of all the font names I happen to have seen in one
+particular distriibution. This code will of course fail if somebody starts
+distributing font files of the same names with different schemes. To use this
+file, it must be appended to the regular CRUDETYPE.WEB. My reasons for not
+incorporating this code in all versions are: 1: I believe that Stanford have
+now definitely decided to include coding schemes in all font tapes and 2: I
+believe that using the scheme as recorded in the TFM file is much safer than
+relying on a conjectured map from font names to schemes which might change.
+This map has changed in the past: for example all CMR fonts used to be scheme 3.
+
+@<Define Lineprinter codes@>=
+ be_string('CMTEX' ); set_scheme(1 ) ;
+@#
+ be_string('CMTT' ); set_scheme(2 ) ;
+ be_string('CMSLTT' ); set_scheme(2 ) ;
+ be_string('CMCSC' ); set_scheme(2 ) ;
+ be_string('CMTCSC' ); set_scheme(2 ) ;
+ be_string('CMITT' ); set_scheme(2 ) ;
+@#
+ be_string('CMB' ); set_scheme(3 ) ;
+ be_string('CMBX' ); set_scheme(3 ) ;
+ be_string('CMBXSL' ); set_scheme(3 ) ;
+ be_string('CMBXTI' ); set_scheme(3 ) ;
+ be_string('CMDUNH' ); set_scheme(3 ) ;
+ be_string('CMFF' ); set_scheme(3 ) ;
+ be_string('CMFI' ); set_scheme(3 ) ;
+ be_string('CMFIB' ); set_scheme(3 ) ;
+ be_string('CMINCH' ); set_scheme(3 ) ;
+ be_string('CMR' ); set_scheme(3 ) ;
+ be_string('CMSL' ); set_scheme(3 ) ;
+ be_string('CMSS' ); set_scheme(3 ) ;
+ be_string('CMSSBX' ); set_scheme(3 ) ;
+ be_string('CMSSDC' ); set_scheme(3 ) ;
+ be_string('CMSSI' ); set_scheme(3 ) ;
+ be_string('CMSSQ' ); set_scheme(3 ) ;
+ be_string('CMSSQI' ); set_scheme(3 ) ;
+ be_string('CMTI' ); set_scheme(3 ) ;
+ be_string('CMU' ); set_scheme(3 ) ;
+ be_string('CMVTT' ); set_scheme(3 ) ;
+@#
+ be_string('CMCSC10' ); set_scheme(4 ) ; {dont ask me why, I didnt design the font}
+ be_string('CMR5' ); set_scheme(4 ) ;
+ be_string('CMR5' ); set_scheme(4 ) ;
+@#
+ be_string('LOGO' ); set_scheme(5 ) ;
+ be_string('LOGOBF' ); set_scheme(5 ) ;
+ be_string('LOGOSL' ); set_scheme(5 ) ;
+@#
+ be_string('CMMI' ); set_scheme(6 ) ;
+ be_string('CMMIB' ); set_scheme(6 ) ;
+@#
+ be_string('CMBSY' ); set_scheme(7 ) ;
+ be_string('CMSY' ); set_scheme(7 ) ;
+@#
+ be_string('CMEX' ); set_scheme(8 ) ;
+@#
+ be_string('LASY' ); set_scheme(9 ) ;
+ be_string('LASYB' ); set_scheme(9 ) ;
+@#
+ be_string('CIRCLE' ); set_scheme(10) ;
+ be_string('CIRCLEW' ); set_scheme(10) ;
diff --git a/dviware/crudetype/version3/nosve.ch b/dviware/crudetype/version3/nosve.ch
new file mode 100644
index 0000000000..71b13b561d
--- /dev/null
+++ b/dviware/crudetype/version3/nosve.ch
@@ -0,0 +1,263 @@
+% nosve.ch -*-mode: change; webfile: crudetype.web version 3.01;-*-
+ % LINEPRINTER Change file for Crudetype
+% NOS/VE Version 1.0 changed by Matthias Rawohl Sept./Okt. 1987
+% Altered by RMD to fit Crudetype version 1 , May 1988.
+% Altered by RMD to fit Crudetype version 2, Oct 1988.
+% Altered by RMD to fit Crudetype version 3, Oct 1990.
+%
+% COPYRIGHT ( C ) G-H Knauf, 1988.
+%
+% Permission is given to any person to make and distribute copies of this
+% software, subject to the following conditions:
+%
+% 1. All copies of the software must carry an exact copy of this notice.
+%
+% 2. This software is distributed free of charge, "AS IS" with absolutely no
+% guarantee of performance. Any persons receiving or using this software must
+% do so entirely at their own risk. Neither the authors nor their institutions
+% accept any liability for defects of this software, or for any consequential
+% loss or damage however caused.
+%
+% 3. Any person who changes this software must clearly mark it as modified and
+% add a note describing the changes made.
+%
+
+
+% WEAVE: New title
+@x Module 0; Lines 42 -- 42
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\def\title{Crudetype for {\mc NOS-VE}}
+@z
+
+@x Module 4; Lines 213 -- 216
+@d banner=='This is Crudetype, Version 3.01, copyright, experimental'
+{printed when the program starts}
+
+@p program crudetype
+@y
+The identifier |value| is a reserved word in NOS/VE Pascal, so we have to
+change this into the word |values|.
+@d value ==values
+@d banner=='This is Crudetype, NOS/VE Version 3.01, modified by MR'
+{printed when the program starts}
+
+@p program crudetype@&_@&module
+@z
+
+@x Module 6; Lines 250 -- 250
+ @<Read \.{DVI} preamble@>
+@y
+ @<Read \.{DVI} preamble@>
+ page( printfile) ;
+@z
+
+@x Module 14; Lines 360 -- 361
+@<Lowest...@>=
+ {Declare |parse_file|}
+@y
+@<Lowest...@>=
+ procedure parse_file( name: var_string; var dir, nam, ex: var_string) ;
+ var p,q,r,s: s_ptr ;
+ begin
+ dir := blank; nam := blank; ex := blank;
+ s := name.len ;
+ if ( s>0) then begin
+ p := s_search( name, '.', -s);
+ if ( p>0) then substring( dir, name, 1, p) ;
+ r := s_search( name, '_', -s);
+ if ( r>p) then substring( ex, name, r, s-r+1)
+ else r := s +1 ;
+ substring( nam, name, p+1, r-p-1) ;
+ end;
+ end;
+@z
+
+@x Module 17; Lines 418 -- 420
+@ As an initial attempt at downloading, we declare a |@!raster_file|.
+
+@<Files@>= term_in, term_out, printfile, dvi_file, tfm_file, raster_file
+@y
+@ Instead of reading a command line, NOS-VE Pascal declares its parameters in
+the program header. This is an excellent system, except there is apparently no
+way to specify defaults. As an initial attempt at downloading, we declare a
+|@!raster_file|.
+
+@<Files@>= term_in, term_out, printfile, dvi_file, tfm_file, raster_file,
+ quiet, run_on, squash, first_page, count_pages, magnify, h_mag, v_mag,
+ batch_view, inspection
+@z
+
+@x Module 18; Lines 429 -- 436
+@d block_length = 512
+@d same_dir == false
+
+@<Set init...@>=
+ be_string( '.DVI' ) ; dvi_def := buffer ;
+ be_string( 'TEX$FONTS:.TFM' ) ; tfm_def := buffer ;
+ be_string( 'TEX$GF:.&DGF' ) ; raster_def := buffer ;
+ be_string( '.PRI' ) ; print_ex := buffer ;
+@y
+@d block_length = 16
+@d same_dir == false
+
+@<Set init...@>=
+ be_string( '_DVI' ) ; dvi_def := buffer ;
+ be_string( ':$LIB.PUBLIC.TEX.TFM._TFM' ) ; tfm_def := buffer ;
+ be_string( '$LIB.PUBLIC.TEX.GFDIR._&DGF' ) ; raster_def := buffer ;
+ be_string( '_LST' ) ; print_ex := buffer ;
+@z
+
+@x Module 19; Lines 442 -- 443
+@<Lowest...@>=
+ {Declare |open_binary|}
+@y
+
+In NOS/VE you have two choices: you may use either the NOS/VE Pascal extension
+|bindingtype| or the Cybil routines developed by Norbert Schwarz for his \TeX\
+implementation for NOS/VE. Norbert's routines are smarter if a TFM file is
+missing.
+
+RMD: I hope to distribute N.Schwarz's routines in the file NOSVEBIND.CYB.
+Dont ask me how these work, I have no idea. The next lot of macro definitions
+is rather messy; I have tried to clean them up. To switch from Cybil binding
+to (NOS) Pascal binding, swop the curly brackets in the next two definitions.
+
+@d PASCL ==@{ {Open curly for Cybil binding}
+@d CYBIL ==@} {Close curly for Cybil binding}
+
+@d close_binary(#)==
+ close_read (#)
+
+@<Lowest...@>=
+ @{ CYBIL
+
+@#
+ procedure close_read(var f_f:byte_file); external;
+
+@#
+ function open_binary (
+ var f_f: byte_file; name: var_string ): boolean;
+ type string_type=string(64);
+ var s: integer;
+ long_name_of_file, effectiv_file_name : string_type;
+ procedure open_read(
+ var f_f:byte_file; given_name:string_type;
+ is_text_file:boolean;
+ var effectiv_file_name: string_type;
+ var open_error:integer);
+ external;
+ begin
+ close_binary(f_f );
+ {in case the file was left open}
+ long_name_of_file := substr( name.data,1,64);
+ open_read(f_f,long_name_of_file, false,effectiv_file_name,s);
+ if s <> 0 then open_binary := false
+ else begin
+ reset(f_f );
+ open_binary := true ;
+ end;
+ end;
+
+@#
+ PASCL PASCL
+
+@#
+ procedure close_read(var f_f:byte_file); begin unbind(f_f) end;
+
+@#
+ function open_binary (
+ var f_f: byte_file; name: var_string; ): boolean;
+ var file_bind : @=bindingtype@> ; { a predefined type in NOS/VE-Pascal}
+ begin
+ file_bind:=binding(f_f);
+ if file_bind.bound then unbind(f_f);
+ {in case the file was left open}
+ file_bind.name := substr( name.data,1,string_length);
+ bind(f_f,file_bind);
+ file_bind:= binding(f_f);
+ open_binary := file_bind.bound;
+ if file_bind.bound then reset(f_f);
+ end;
+
+@#
+ CYBIL @}
+@z
+
+@x Module 23; Lines 495 -- 500
+@<Determine operating parameters@>=
+ command := blank ; get_command ;
+ dvi_name := blank ;
+ if got_cl then parse_command ;
+ @<Get \.{DVI} file name and open it@> ;
+ if not got_cl then @<Ask the user@> ;
+@y
+NOS/VE uses a quite different mechanism; the parameters are passed in as
+arguments to the |PROGRAM| statement.
+
+@<Determine operating parameters@>=
+ reset( dvi_file) ; dvi_indx := 0 ;
+ rewrite(printfile) ;
+ display_ln(' ',banner, ' --- ', device_ID) ;
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% change for Crudetype NOS/VE Version 2.1
+% MR 10.4.89
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x Module 24; Lines 525 -- 535
+@<Set init...@>=
+ quiet := false ;
+ run_on := false ;
+ squash := false ;
+ magnify := 100 ;
+ h_mag := 100 ;
+ v_mag := 100 ;
+ batch_view := false ;
+ first_page := -1000000 ;
+ count_pages := 1000000 ;
+ print_name := blank ;
+@y
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% change for Crudetype NOS/VE Version 2.1
+% MR 1.4.89
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x Module 86; Lines 1510 -- 1517
+ if not quiet then begin
+ display_ln( ' ');
+ string_show( font_name);
+ display( ' --- loaded at ',scale_size:1,' DVI units');
+ if abs(font_mag) > 1 then
+ display(' ( magnified ', round(font_mag):1,'%)');
+ display_ln(' ');
+ end;
+@y
+
+@z
+
+@x Module 207; Lines 3474 -- 3474
+ fortran := false ;
+@y
+ fortran := true ;
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% change for Crudetype NOS/VE Version 2.1
+% MR 1.4.89
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x Module 212; Lines 3577 -- 3580
+ if not quiet then begin
+ display ('Output written to file: ');
+ string_show(print_name);
+ end;
+@y
+ { display ('Output written to file: ');
+ ====> task moved to SCL Command file }
+@z
+
+
+
+
diff --git a/dviware/crudetype/version3/nosve.com b/dviware/crudetype/version3/nosve.com
new file mode 100644
index 0000000000..0b9e865c2e
--- /dev/null
+++ b/dviware/crudetype/version3/nosve.com
@@ -0,0 +1,34 @@
+proc crudetype (
+ file,f : file = $required
+ starting_page,sp : integer = $optional
+ maximum_pages,mp : integer = $optional
+ page_numbers,pn : boolean = true
+ extra_magnification,em : integer = 100
+ status)
+
+filename= $path($fname($string($value(file))),catalog)//..
+ '.'//$path($fname($string($value(file))),last)
+if $strlen(filename) >=4 and ..
+ $substr(filename,$strlen(filename)-3,4)='_DVI' then
+else
+ filename=filename//'_DVI'
+ifend
+filename2=$substr(filename,1,$strlen(filename)-3)//'LST'
+copy_file $fname(filename) $null " checks if file exists "
+
+if $specified(starting_page) then; starting_variable=$value(starting_page)
+else; starting_variable=0; ifend
+
+if $specified(maximum_pages) then; max_pages_variable=$value(maximum_pages)
+else; max_pages_variable=1000000; ifend
+
+exet f=:$lib.public.tex.bin.tex_library ..
+ m=crudetype_module ..
+ l=:$lib.public.tex.bin.tex_library ..
+ pv=zero ..
+ p= ..
+',,,printfile=$fname(filename2),dvifile=$fname(filename),tfm_file,pxlfile,'//..
+'PAGENUMBERS=$value(pn),FIRSTPAGE=starting_variable,'//..
+'MAXPAGES=max_pages_variable,VAREXTRAMAG=$value(em)'
+procend
+
diff --git a/dviware/crudetype/version3/nosve.doc b/dviware/crudetype/version3/nosve.doc
new file mode 100644
index 0000000000..551ffee588
--- /dev/null
+++ b/dviware/crudetype/version3/nosve.doc
@@ -0,0 +1,77 @@
+CRUDENOS.DOC.
+This file is the documentation for the NOS/VE version of Crudetype.
+
+The files:
+
+NOSVE.DOC This document.
+
+NOSVE.CH change file for NOS/VE, by courtesy of G-H Knauf
+ and M.Rawohl, University of Hannover.
+ (Provisional. Please send bug reports to RMD)
+
+NOSVE.COM a NOS/VE system procedure to call this program
+NVEBIND.CYB CYBIL routines for file handling (N.Schwarz, Ruhr
+ University Bochum).
+
+
+Installation
+============
+
+Edit the NOSVE.CH file to specify the directory of the TFM files.
+Add the NOSCHEME.ADD file at the end of CRUDETYPE.WEB.
+Take the CRUDETYPE.WEB file and the NOSVE.CH file, tangle them,
+compile and put the result into an object library. Then adapt the
+NOSVE procedure to your local needs, i.e. change the name of
+the libraries in the EXET-statement to where they reside in your
+system. Note that you must include PV=ZERO if you use Norbert Schwarz's
+routines (see below).
+
+In the changefile you can choose between two kinds of dynamic
+file handling. One uses the NOS/VE-Pascal bindingtype, the other
+uses CYBIL routines developed by Norbert Schwarz of
+Ruhr Universitaet Bochum, who ported TeX to NOS/VE. Norbert's routines are
+better because the program does not abort if a TFM-file is missing, so they
+should be used if possible.
+
+The program parameters are not supplied interactively in the NOS/VE
+version, but are command line parameters (NOS/VE Pascal makes this easily
+possible). The reason why there is a command langauge procedure around
+the program is to supply default values for parameters not specified.
+
+USE
+===
+
+Use the CRUDETYPE procedure to call the program. It's first parameter
+is a filename. CRUDETYPE reads from that file (with extension _DVI)
+and writes to a file (same name, but extension _LST). This is an
+ordinary print file, using Fortran type carriage controls (1 = new
+page, + = overprinting). You can send this file to a printer or
+load it into the NOS/VE editor to preview.
+
+There are further parameters first_page and count_pages as usual.
+
+If you define page_numbers as true, NOS/VE CRUDETYPE writes lines like
+
+ 1--- (page number) ----------------------------------------------
+
+at the start of each page. So you can use the Locate_All function
+key in the NOS/VE editor, looking for 1---, and so locate each page
+very quickly.
+
+TeX output lines are often longer then 80 characters. So you should use
+a terminal which can show 132 characters a line when previewing. Otherwise
+you have to use the ALIGN_SCREEN command of the NOS/VE editor.
+
+There is a last parameter extra_magnification in CRUDENVE (see RMD's
+remarks in file AAAREAD.ME). A value of 120 or 125 seems to give best
+results in 10 pt unmagnified text (nearly straight right margin).
+
+
+Send comment regarding the NOS/VE version of CRUDETYPE to
+
+Gerd-H. Knauf
+RRZN Universitaet Hannover
+Schlosswender Str. 5
+3000 Hannover 1
+ZZKNAUF@DHVRRZN1.BITNET
+
diff --git a/dviware/crudetype/version3/nosvebind.cyb b/dviware/crudetype/version3/nosvebind.cyb
new file mode 100644
index 0000000000..a047f4d7b8
--- /dev/null
+++ b/dviware/crudetype/version3/nosvebind.cyb
@@ -0,0 +1,1450 @@
+Here you find Norbert Schwarz's cybil routines for dynamic file
+binding in Pascal which he devoloped for his NOS/VE TeX
+implementation. There are four files combined into this file:
+ASSOCIATE_FILE_CYBIL and UTM_OPEN2_CYBIL are the Cybil sources,
+BINCOR_PAS is a program to do a binary correction to the compiled
+output and MAKE_UTM_OPEN2_LIB the installation procedure (study it
+to find out what's going on). The binary correction is likely to
+change at new system releases.
+
+THe software is by
+
+Norbert Schwarz
+Ruhr-Universitaet Bochum, Rechenzentrum
+Postfach 102148
+D-4630 Bochum 1
+P920012 at DBORUB01.BITNET
+
+%%%%%%%%%%%%%%%%% MAKE_UTM_OPEN2_LIB %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+proc make_utm_open2_lib (ergebnis : file = $required ;
+ debug : name = all );
+create_variable ss kind=status;
+
+copy_file $user.tex122.utm_open2_exp_cybil $local.compile
+DELETE_FILE $local.UTM_OPEN status=ss
+CYBIL $local.COMPILE DA=$value(debug) B=$local.UTM_OPEN l=$local.cybil_liste
+" ---> correct the debug match information (loader problem)
+" 06c7... is the old declaration matching value
+" To get the required new one, use DISPLAY_OBJECT_TEXT
+
+" for the module PAM$$FILE_TABLE_ROUTINE in $SYSTEM.PASCAL.PAF$LIBRARY
+collect_text $local.DATEN
+UTM_OPEN
+06C764D1A410E3EB*
+0AAD64BCC195277B*
+**
+old_catalog=$string($catalog)
+set_working_catalog $local
+.zztv.tex122.bincor $local.DATEN
+set_working_catalog $fname(old_catalog)
+create_object_library
+ add_module $local.utm_open
+ generate_library $value(ergebnis)
+ quit
+put_line ' utm_open_lib erstellt in'//$string($value(ergebnis))
+PROCEND;
+
+%%%%%%%%%%%%%%%%% BINCOR_PAS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+program bincor (input, output);
+
+type byte = 0..255;
+ t_p = packed array[1..100000] of byte;
+ t_packed = ^t_p;
+ twochar = packed array[1..2] of char;
+ string31 = packed array[1..31] of char;
+ string_type = packed array[1..17] of char;
+ word_type = array[1..8] of 0..255;
+
+var infile,outfile : t_packed;
+ status : integer;
+
+ i,j,position : integer;
+
+ corr_file_name : string31;
+ old_wordstring : string_type;
+ new_wordstring : string_type;
+
+ old_word : word_type;
+ new_word : word_type;
+
+ old_lng : integer;
+ new_lng :integer;
+
+procedure get_string(var instring : string_type);
+var i: integer;
+ c:char;
+begin
+ for i:=1 to 17 do instring[i] := '*';
+ i:=0;
+ repeat
+ if eoln(input) then readln(input);
+ read(c);
+ if (c<>'*') and (c<>' ') then begin i:=i+1; instring[i]:=c; end;
+ until (i=17) or (c='*');
+end;
+
+function tobin(c2 : twochar) : integer;
+var c: char; i1,i2 : integer;
+begin
+ c :=c2[1];
+ if (c>='A') then i1:=10+ord(c)-ord('A') else i1:= ord(c)-ord('0');
+ c :=c2[2];
+ if (c>='A') then i2:=10+ord(c)-ord('A') else i2:= ord(c)-ord('0');
+ tobin := i1*16 + i2;
+end;
+
+
+procedure string_value (instring : string_type; var count : integer;
+ var bytes : word_type);
+var i,k : integer; c: char;
+ c2 : twochar;
+begin
+ count:=0;
+ i:=1;
+ while (i<=17) and (instring[i]<>'*') do
+ begin
+ c2[1] := instring[i];
+ c2[2] := instring[i+1];
+ i:=i+2;
+ count:=count+1;
+ bytes[count] := tobin(c2);
+ end;
+end;
+
+procedure tohex(i:byte; var erg : twochar);
+var hilf : byte;
+begin
+ hilf := i div 16;
+ if hilf>9 then erg[1] := chr(ord('A')+hilf-10)
+ else erg[1] := chr(ord('0')+hilf);
+ hilf:= i mod 16;
+ if hilf>9 then erg[2] := chr(ord('A')+hilf-10)
+ else erg[2] := chr(ord('0')+hilf);
+end;
+
+
+procedure search_string(f : t_packed; to_search : word_type; lng : integer;
+ var found : integer);
+const max_search =20000;
+var i,k,l : integer;
+ gefunden : boolean;
+begin
+ i:=0;
+ found := -1;
+ while (i<max_search) do
+ begin
+ i:=i+1;
+ gefunden := true;
+ j:=0;
+ while (gefunden) and (j<lng) do
+ begin if f^[i+j]<> to_search[j+1] then gefunden := false;
+ j:=j+1;
+ end;
+ if gefunden then begin
+ found := i;
+ i:= max_search+1;
+ end;
+ end;
+end;
+
+procedure dump(f : t_packed);
+var b :byte;
+ c2 : twochar;
+ column : integer;
+ i:integer;
+begin
+ column :=0;
+ write(' ');
+ for i:=1 to 300 do
+ begin
+ tohex(f^[i],c2);
+ write(output,c2);
+ column :=column + 2;
+ if column=40 then begin column:= 0; writeln(output); write(' ') end;
+ end;
+end;
+
+procedure associate_file(f:string31;var ff : t_packed; var ii :integer);
+external;
+
+begin
+ for i:=1 to 31 do corr_file_name[i] := ' ';
+ write(' FILE to be changed: ');
+ i:=1;
+while (not eoln(input)) and (i<32) do begin read(corr_file_name[i]); i:=i+1 end;
+ readln;
+ status:=0;
+ associate_file(corr_file_name,infile,status);
+ writeln(' Assoziation - status ',status);
+ dump(infile);
+ get_string(old_wordstring); get_string(new_wordstring);
+
+
+
+ string_value(old_wordstring,old_lng,old_word);
+ string_value(new_wordstring,new_lng,new_word);
+
+ write(' to replace >');
+ for i:=1 to 2*old_lng do write(old_wordstring[i]);
+ write(' (',old_lng:1,') ');
+ write('< by the new >');
+ write(' (',new_lng:1,')');
+ for i:=1 to 2*new_lng do write(new_wordstring[i]);
+ writeln('<');
+
+
+ search_string(infile, old_word,old_lng,position);
+ writeln(' Position ',position);
+ if position > 0 then
+ begin
+ for i:=1 to new_lng do
+ infile^[position-1+i] := new_word[i];
+ end;
+end .
+
+%%%%%%%%%%%%%%%%% ASSOCIATE_FILE_CYBIL %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+module nsm_associate_file;
+
+*copyc AMP$OPEN
+*copyc AMP$GET_SEGMENT_POINTER
+
+procedure [XDCL] associate_file (file_name : ost$name;
+ var file_pointer : ^cell;
+ var status : integer);
+
+var local_file_name : ost$name;
+var file_id : amt$file_identifier;
+var status1,status2 : ost$status;
+var segment_pointer : amt$segment_pointer;
+
+ local_file_name := file_name;
+
+ amp$open ( local_file_name, amc$segment, NIL, file_id,status1);
+
+ if status1.normal then
+
+ amp$get_segment_pointer ( file_id,
+ amc$cell_pointer,
+ segment_pointer,
+ status2);
+
+ file_pointer := segment_pointer.cell_pointer;
+ if status2.normal then status := 0 else
+ status := status2.condition;
+ ifend;
+ else
+ status := status1.condition;
+ ifend;
+
+procend ;
+
+*copyc AMP$GET_FILE_ATTRIBUTES
+
+procedure [XDCL] get_file_length (file_name : ost$name;
+ var length : integer );
+
+var attributes : ^amt$get_attributes;
+var local : boolean;
+var old_file : boolean;
+var non_empty : boolean;
+var status : ost$status;
+
+
+ PUSH attributes : [1..1];
+
+ attributes^[1].key := amc$file_length;
+
+ amp$get_file_attributes(file_name,attributes^,local,old_file,
+ non_empty,status);
+
+ if status.normal then
+ length := attributes^[1].file_length;
+ else
+ length := -1;
+ ifend;
+
+procend get_file_length;
+modend;
+%%%%%%%%%%%%%%%%% UTM_OPEN2_CYBIL %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+module utm_open_module;
+
+{ This routines looks into the file-table-area of the PASCAL-runtime system
+{ an searches an entry with an matching "file-variable"-pointer.
+{ It is found the file-name will be replaced by the given one of
+{ the proceure call }
+
+{ Very very important: As the parameter definition is not known
+{ of the corresponding CYBIL-routines of
+{ PAF$LIBRARY there has a binary correction
+{ of the matching value for the entry
+{ PAV$FILE_TABLE_PTR to be done !!!}
+
+{ -------- last change 21.11.1986 Ruhr Universitaet Bochum, Germany
+{ Norbert Schwarz }
+
+{ change 12.06.86 included the function }
+{ }
+{ if a "file-name" begins with a '<' character }
+{ then the part between '<' and '>' will be inter- }
+{ preted as a SCL string-name, which contains }
+{ the catalog/file name }
+{ the SCL-string may be an array of strings then }
+{ a hierarchical search will be done. }
+{ }
+{ 16.06.1986 splitting of various open functions in }
+{ 'open,openread,openwrite,openintern' }
+
+{ 20.01.1987 introduction of opensegmented / closesegmented }
+
+{ 12.03.1987 introduction of PUT_PARTIAL }
+
+*copyc FSP$OPEN_FILE
+*copyc FSP$CLOSE_FILE
+*copyc AMP$get_segment_pointer
+*copyc AMP$SET_SEGMENT_EOI
+*copyc AMP$PUT_NEXT
+*copyc AMP$PUT_PARTIAL
+*copyc CLP$PUSH_PARAMETERS
+*copyc CLP$POP_PARAMETERS
+*copyc CLP$SCAN_PARAMETER_LIST
+*copyc CLP$GET_VALUE
+*copyc CLP$GET_PATH_DESCRIPTION
+*copyc CLP$CONVERT_INTEGER_TO_STRING
+*copyc AMP$CLOSE
+*copyc AMP$GET_FILE_ATTRIBUTES
+{*copyc IFP$STORE_TERMINAL }
+*copyc CLP$READ_VARIABLE
+*copyc PMP$ABORT
+*copyc PMP$EXIT
+
+type eightbit_range = 0..255;
+
+type two_word = array[1..2] of integer;
+type two_word_id = record
+ case boolean of
+ = true = int : two_word,
+ =false = id : amt$file_identifier,
+ casend,
+ recend;
+
+
+
+ var PAV$FILE_TABLE_PTR : [XREF,READ] ^cell;
+
+
+
+
+ procedure [XDCL] set_pascal_name
+
+ ( VAR file_variable : cell;
+ file_name : string(31) );
+
+ type table_entry = packed record
+ file_adress : ^cell,
+ new_name : string(31),
+ old_name : string(31),
+ rest1 : string(6),
+ buffer_ptr : ^cell,
+ rest2 : string(64),
+ recend;
+ type table_type = packed array[1..100] of table_entry;
+
+ var hilf_ptr : ^table_type;
+ var i : integer;
+ hilf_ptr := PAV$FILE_TABLE_PTR;
+ for i:=1 to 100 do
+ if hilf_ptr^[i].file_adress=^file_variable then
+ hilf_ptr^[i].new_name := file_name;
+ EXIT set_pascal_name;
+ ifend;
+ forend;
+
+ PROCEND set_pascal_name;
+
+
+{ This routine looks into the file_table and searches an entry
+{ with an matching file name. Then it replaces the adress of
+{ the file-variable by the new given file-variable }
+
+ procedure [XDCL] set_file_variable
+
+ ( VAR file_variable : cell;
+ file_name : string(31) );
+
+ type table_entry = packed record
+ file_adress : ^cell,
+ new_name : string(31),
+ old_name : string(31),
+ rest1 : string(6),
+ buffer_ptr : ^cell,
+ rest2 : string(64),
+ recend;
+ type table_type = packed array[1..100] of table_entry;
+
+ var hilf_ptr : ^table_type;
+ var i : integer;
+ hilf_ptr := PAV$FILE_TABLE_PTR;
+ for i:=1 to 100 do
+ if hilf_ptr^[i].new_name = file_name then
+ hilf_ptr^[i].file_adress:=^file_variable ;
+ EXIT set_file_variable;
+ ifend;
+ forend;
+
+ PROCEND set_file_variable;
+
+
+{ This procedure inserts a new file_name and a new_pointer into }
+{ the file-table ! }
+
+
+ procedure [XDCL] insert_file_variable
+
+ ( VAR file_variable : cell;
+ file_name : string(31) ;
+ textfile : boolean );
+
+type byte6 = packed array[1..6] of eightbit_range;
+type byte64 = packed array[1..64] of eightbit_range;
+
+type file_ref = packed record
+ case boolean of
+ = true = file_adress : ^cell,
+ = false = file_adress_bin : byte6,
+ casend,
+ recend;
+
+ type table_entry = packed record
+ file_pt : file_ref,
+ new_name : string(31),
+ old_name : string(31),
+ rest1 : byte6,
+ buffer_ptr : ^cell,
+ rest3 : byte64,
+ recend;
+ type table_type = packed array[1..100] of table_entry;
+
+ var hilf_ptr : ^table_type;
+ var nil_test : ^cell;
+ var i : integer;
+ var k : integer;
+ var file_adress_bin : integer;
+
+ nil_test :=NIL;
+ hilf_ptr := PAV$FILE_TABLE_PTR;
+ FOR i:=1 to 100 DO
+ IF hilf_ptr^[i].file_pt.file_adress_bin[1]=0
+ THEN
+ for k:=1 to 6 do hilf_ptr^[i].rest1[k] :=0; forend;
+ for k:=1 to 64 do hilf_ptr^[i].rest3[k] :=0; forend;
+ hilf_ptr^[i].file_pt.file_adress:=^file_variable ;
+ hilf_ptr^[i].old_name:=file_name ;
+ hilf_ptr^[i].new_name:=file_name;
+ hilf_ptr^[i].rest1[6] := 050(16);
+ hilf_ptr^[i].buffer_ptr := NIL;
+ hilf_ptr^[i].rest3[16] := 0;
+ IF textfile THEN
+ hilf_ptr^[i].rest3[17] := 1;
+ ELSE
+ hilf_ptr^[i].rest3[17] := 0;
+ IFEND;
+ hilf_ptr^[i].rest3[23] := 1;
+ hilf_ptr^[i].rest3[56] := 1;
+ EXIT insert_file_variable;
+ ELSE
+ IF hilf_ptr^[i].file_pt.file_adress = ^file_variable THEN
+ for k:=1 to 6 do hilf_ptr^[i].rest1[k] :=0; forend;
+ for k:=1 to 64 do hilf_ptr^[i].rest3[k] :=0; forend;
+ hilf_ptr^[i].old_name:=file_name ;
+ hilf_ptr^[i].new_name:=file_name;
+ hilf_ptr^[i].rest1[6] := 050(16);
+ hilf_ptr^[i].buffer_ptr := NIL;
+ hilf_ptr^[i].rest3[16] := 0;
+ hilf_ptr^[i].rest3[56] := 1;
+ IF textfile THEN
+ hilf_ptr^[i].rest3[17] := 1;
+ ELSE
+ hilf_ptr^[i].rest3[17] := 0;
+ IFEND;
+ hilf_ptr^[i].rest3[23] := 1;
+ EXIT insert_file_variable;
+ IFEND
+ IFEND;
+ FOREND;
+
+ PROCEND insert_file_variable;
+
+{ ====================================================================== }
+{ }
+{ There are 4 'open' interfaces with different handling of existing files: }
+{ }
+{ open,openread,openwrite,openintern }
+{ }
+{ The parameter 'long_name_of_file' may contain a 'path-description' }
+{ in '<' and '>' at the beginning of the name. The name betweeen < and > }
+{ will be interpreted as a name of a SCL (!) - variable of kind string }
+{ which contains a catalog reference }
+{ }
+{ For example: in SCL CREATE_VARIABLE MY_BASE K=STRING D=1..4 }
+{ MY_BASE(1)='$CATALOG' }
+{ MY_BASE(2)='$LOCAL' }
+{ MY_BASE(3)='$USER.BASE_CATALOG' }
+{ MY_BASE(4)=':NVE.SMITH.FRIEND_CATALOG' }
+{ }
+{ then a content of 'long_name_of_file' like }
+{ }
+{ '<MY_BASE>DATA' }
+{ }
+{ will be expanded to (1.) '$CATALOG.DATA' }
+{ (2.) '$LOCAL.DATA' }
+{ (3.) '$USER.BASE_CATALOG.DATA' }
+{ (4.) ':NVE.SMITH.FRIEND_CATALOG.DATA' }
+{ }
+{ if 'must_be_old'=true !!! }
+{ }
+{ Then the file, which is found first, will be used. }
+{ }
+{ if 'must_be_old=false' then the first element only will be used. }
+{ }
+{ ----------------------------------------------------------------------- }
+{ }
+{ The procedure 'open' will use only the first element of an }
+{ SCL-array and returns if that required file exists. }
+{ }
+{ The procedure 'openread' requires an existing file and gives }
+{ an error if it does an exist. It will will take a search. }
+{ }
+{ The procedure 'openwrite' uses the first element of an existing }
+{ SCL-reference. There is no error return, if that file does not exit. }
+{ }
+{ The procedure 'openintern' is the internally called routine. }
+{ and is given as an outer interface. }
+{ }
+{ open openread openwrite openintern }
+{ ---------------------------------------------------------------------------- }
+{ var file_variable : cell X X X X }
+{ long_name_of_file : string(64) X X X X }
+{ textfile : boolean X X X X }
+{ var effektiv_file_name : string(64) X X X X }
+{ must_be_old : boolean (false) (true) (false) X }
+{ var is_old_file : boolean X - - X }
+{ var error : integer X X X X }
+{ }
+{ parameter-description: }
+{ }
+{ file_variable : PASCAL file variable e.g. file of char }
+{ long_name_of_file : name of the file }
+{ textfile : true if the file is of type 'text' }
+{ : That is needed in PASCAL (buffering handling) }
+{ must_be_old : true, if the file m u s t exist. }
+{ If 'true' then an hierarchically search will }
+{ be done }
+{ is_old_file : returns if the file exists }
+{ error : <>0 then an error has happened }
+{ }
+{------------------------------------------------------------------------------}
+
+const string_length = 64;
+type string_type = string(string_length);
+
+
+PROCEDURE [XDCL] openread (var file_variable : cell;
+ long_name_of_file : string_type;
+ textfile : boolean;
+ var effektiv_file_name : string_type;
+ var error : integer);
+var is_old_file : boolean;
+ openintern (file_variable,long_name_of_file,textfile,
+ effektiv_file_name, true ,is_old_file, error)
+PROCEND;
+
+
+PROCEDURE [XDCL] openwrite(var file_variable : cell;
+ long_name_of_file : string_type;
+ textfile : boolean;
+ var effektiv_file_name : string_type;
+ var error : integer);
+var is_old_file : boolean;
+ openintern (file_variable,long_name_of_file,textfile,
+ effektiv_file_name, false , is_old_file, error)
+PROCEND ;
+
+
+PROCEDURE [XDCL] open (var file_variable : cell;
+ long_name_of_file : string_type;
+ textfile : boolean;
+ var effektiv_file_name : string_type;
+ var is_old_file : boolean;
+ var error : integer);
+ openintern (file_variable,long_name_of_file,textfile,
+ effektiv_file_name, false , is_old_file, error)
+PROCEND ;
+
+
+procedure [XDCL] openintern (var file_variable : cell;
+ long_name_of_file : string_type;
+ textfile : boolean;
+ var effektiv_file_name : string_type;
+ must_be_old : boolean;
+ var is_old_file : boolean;
+ var error : integer);
+
+ var i : integer;
+
+
+
+{ pdt file_pdt ( f : file = $required )
+
+?? PUSH (LISTEXT := ON) ??
+
+ VAR
+ file_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table
+ := [^file_pdt_names, ^file_pdt_params];
+
+ VAR
+ file_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults]
+ array [1 .. 1] of clt$parameter_name_descriptor := [['F', 1]];
+
+ VAR
+ file_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 1]
+ of clt$parameter_descriptor := [
+
+{ F }
+ [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
+ clc$file_value]]];
+
+?? POP ??
+
+
+VAR k : integer;
+VAR old_file : boolean;
+VAR status : ost$status;
+var status1,status2,status3,status4 : ost$status;
+VAR parameter_pt : ^clt$parameter_list;
+VAR value : clt$value;
+VAR string_pt : ^ost$string;
+var param1 : [STATIC] string(1) := 'F';
+var laenge : integer;
+var file_reference : clt$file_reference;
+var path_container : clt$path_container;
+var path : ^pft$path;
+var cycle_selector : clt$cycle_selector;
+var open_position : clt$open_position;
+var local_file : clt$file;
+var file_length : integer;
+var position : integer;
+var expanded_name_of_file: string_type;
+var more : boolean;
+
+ error :=0;
+
+ PUSH parameter_pt : [[ost$string]];
+ RESET parameter_pt;
+ NEXT string_pt IN parameter_pt;
+
+ position := 1;
+
+ /expand/
+ WHILE TRUE DO
+ expand_file_name(long_name_of_file, position,
+ expanded_name_of_file,more);
+
+ IF NOT more THEN
+ error := -1;
+ is_old_file := false;
+ RETURN;
+ IFEND;
+
+ position := position + 1; { prepare for next cycle }
+
+ string_pt^.value := expanded_name_of_file;
+ string_pt^.size := string_length;
+
+ CLP$PUSH_PARAMETERS (status1);
+
+ CLP$SCAN_PARAMETER_LIST(parameter_pt^,file_pdt,status2);
+
+ if not status2.normal then
+ error := status2.condition;
+ PMP$ABORT(status2);
+ ifend;
+
+ CLP$GET_VALUE(param1,1,1,clc$LOW,value,status3);
+
+ CLP$POP_PARAMETERS (status4);
+
+ if not status3.normal then
+ error := status3.condition;
+ PMP$ABORT(status3);
+ ifend;
+
+ CLP$GET_PATH_DESCRIPTION(value.file,
+ file_reference,
+ path_container,
+ path,
+ cycle_selector,
+ open_position,
+ status3);
+
+ if status3.normal then
+ effektiv_file_name :=
+ file_reference.path_name(1,file_reference.path_name_size);
+ else
+ error := status3.condition;
+ cycle /expand/;
+ ifend;
+
+ get_file_length (value.file.local_file_name,file_length,old_file);
+
+ IF old_file or NOT must_be_old THEN
+ insert_file_variable (file_variable,value.file.local_file_name,
+ textfile);
+ is_old_file := old_file ;
+ RETURN;
+ IFEND;
+
+ WHILEND;
+
+procend;
+
+procedure [XDCL] buildfname (var file_variable : cell;
+ long_name_of_file : string_type;
+ textfile : boolean;
+ var effektiv_file_name : string_type;
+ must_be_old : boolean;
+ var is_old_file : boolean;
+ var error : integer);
+
+ var i : integer;
+
+
+
+{ pdt file_pdt ( f : file = $required )
+
+?? PUSH (LISTEXT := ON) ??
+
+ VAR
+ file_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table
+ := [^file_pdt_names, ^file_pdt_params];
+
+ VAR
+ file_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults]
+ array [1 .. 1] of clt$parameter_name_descriptor := [['F', 1]];
+
+ VAR
+ file_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 1]
+ of clt$parameter_descriptor := [
+
+{ F }
+ [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
+ clc$file_value]]];
+
+?? POP ??
+
+
+VAR k : integer;
+VAR old_file : boolean;
+VAR status : ost$status;
+var status1,status2,status3,status4 : ost$status;
+VAR parameter_pt : ^clt$parameter_list;
+VAR value : clt$value;
+VAR string_pt : ^ost$string;
+var param1 : [STATIC] string(1) := 'F';
+var laenge : integer;
+var file_reference : clt$file_reference;
+var path_container : clt$path_container;
+var path : ^pft$path;
+var cycle_selector : clt$cycle_selector;
+var open_position : clt$open_position;
+var local_file : clt$file;
+var file_length : integer;
+var position : integer;
+var expanded_name_of_file: string_type;
+var more : boolean;
+
+ error :=0;
+
+ PUSH parameter_pt : [[ost$string]];
+ RESET parameter_pt;
+ NEXT string_pt IN parameter_pt;
+
+ position := 1;
+
+ /expand/
+ WHILE TRUE DO
+ expand_file_name(long_name_of_file, position,
+ expanded_name_of_file,more);
+
+ IF NOT more THEN
+ error := -1;
+ is_old_file := false;
+ RETURN;
+ IFEND;
+
+ position := position + 1; { prepare for next cycle }
+
+ string_pt^.value := expanded_name_of_file;
+ string_pt^.size := string_length;
+
+ CLP$PUSH_PARAMETERS (status1);
+
+ CLP$SCAN_PARAMETER_LIST(parameter_pt^,file_pdt,status2);
+
+ if not status2.normal then
+ error := status2.condition;
+ PMP$ABORT(status2);
+ ifend;
+
+ CLP$GET_VALUE(param1,1,1,clc$LOW,value,status3);
+
+ CLP$POP_PARAMETERS (status4);
+
+ if not status3.normal then
+ error := status3.condition;
+ PMP$ABORT(status3);
+ ifend;
+
+ CLP$GET_PATH_DESCRIPTION(value.file,
+ file_reference,
+ path_container,
+ path,
+ cycle_selector,
+ open_position,
+ status3);
+
+ if status3.normal then
+ effektiv_file_name :=
+ file_reference.path_name(1,file_reference.path_name_size);
+ else
+ error := status3.condition;
+ cycle /expand/;
+ ifend;
+
+ get_file_length (value.file.local_file_name,file_length,old_file);
+
+ IF old_file or NOT must_be_old THEN
+ is_old_file := old_file ;
+ RETURN;
+ IFEND;
+
+ WHILEND;
+
+procend;
+
+procedure get_file_length (file_name : ost$name;
+ var length : integer ;
+ var old_file : boolean);
+
+var attributes : ^amt$get_attributes;
+var local : boolean;
+var non_empty : boolean;
+var status : ost$status;
+
+
+ PUSH attributes : [1..1];
+
+ attributes^[1].key := amc$file_length;
+
+ amp$get_file_attributes(file_name,attributes^,local,old_file,
+ non_empty,status);
+
+ if status.normal then
+ length := attributes^[1].file_length;
+ else
+ length := -1;
+ ifend;
+
+procend get_file_length;
+
+
+
+
+ procedure [XDCL] closeread
+
+ ( VAR file_variable : cell );
+
+type byte2 = packed array[1..2] of eightbit_range;
+type byte6 = packed array[1..6] of eightbit_range;
+type byte64 = packed array[1..64] of eightbit_range;
+
+type file_ref = packed record
+ case boolean of
+ = true = file_adress : ^cell,
+ = false = file_adress_bin : byte6,
+ casend,
+ recend;
+
+ type table_entry = packed record
+ file_pt : file_ref,
+ new_name : string(31),
+ old_name : string(31),
+ file_id : amt$file_identifier,
+ rest1 : byte2,
+ buffer_ptr : ^cell,
+ rest3 : byte64,
+ recend;
+
+ type table_type = packed array[1..100] of table_entry;
+
+ var hilf_ptr : ^table_type;
+ var nil_test : ^cell;
+ var i : integer;
+ var k : integer;
+ var file_adress_bin : integer;
+ var status : ost$status;
+
+ hilf_ptr := PAV$FILE_TABLE_PTR;
+ FOR i:=1 to 100 DO
+ IF hilf_ptr^[i].file_pt.file_adress_bin[1]=0 THEN
+ ELSE
+ IF hilf_ptr^[i].file_pt.file_adress = ^file_variable THEN
+ AMP$CLOSE(hilf_ptr^[i].file_id,status);
+ hilf_ptr^[i].file_id.ordinal := 0;
+ hilf_ptr^[i].file_id.sequence:= 1;
+ hilf_ptr^[i].rest1[1] := 0;
+ hilf_ptr^[i].rest1[2] :=50(16);
+ for k:=1 to 64 do hilf_ptr^[i].rest3[k] :=0; forend;
+ hilf_ptr^[i].buffer_ptr := NIL;
+ hilf_ptr^[i].rest3[16] := 0;
+ hilf_ptr^[i].rest3[17] := 1;
+ hilf_ptr^[i].rest3[23] := 1;
+ EXIT closeread;
+ IFEND
+ IFEND;
+ FOREND;
+
+PROCEND closeread;
+
+ procedure [XDCL] get_file_id
+
+ ( VAR file_variable : cell;
+ VAR file_id : amt$file_identifier );
+
+type byte2 = packed array[1..2] of eightbit_range;
+type byte6 = packed array[1..6] of eightbit_range;
+type byte64 = packed array[1..64] of eightbit_range;
+
+type file_ref = packed record
+ case boolean of
+ = true = file_adress : ^cell,
+ = false = file_adress_bin : byte6,
+ casend,
+ recend;
+
+ type table_entry = packed record
+ file_pt : file_ref,
+ new_name : string(31),
+ old_name : string(31),
+ file_id : amt$file_identifier,
+ rest1 : byte2,
+ buffer_ptr : ^cell,
+ rest3 : byte64,
+ recend;
+
+ type table_type = packed array[1..100] of table_entry;
+
+ var hilf_ptr : ^table_type;
+ var nil_test : ^cell;
+ var i : integer;
+ var k : integer;
+ var file_adress_bin : integer;
+ var status : ost$status;
+
+ hilf_ptr := PAV$FILE_TABLE_PTR;
+ FOR i:=1 to 100 DO
+ IF hilf_ptr^[i].file_pt.file_adress = ^file_variable THEN
+ file_id := hilf_ptr^[i].file_id;
+ EXIT get_file_id;
+ IFEND
+ FOREND;
+
+PROCEND get_file_id;
+
+{ get the local file name of the file }
+
+ procedure [XDCL] get_local_file_name
+
+ ( VAR file_variable : cell;
+ VAR file_name : amt$local_file_name );
+
+type byte2 = packed array[1..2] of eightbit_range;
+type byte6 = packed array[1..6] of eightbit_range;
+type byte64 = packed array[1..64] of eightbit_range;
+
+type file_ref = packed record
+ case boolean of
+ = true = file_adress : ^cell,
+ = false = file_adress_bin : byte6,
+ casend,
+ recend;
+
+ type table_entry = packed record
+ file_pt : file_ref,
+ new_name : amt$local_file_name, {string(31)}
+ old_name : amt$local_file_name, {string(31)}
+ file_id : amt$file_identifier,
+ rest1 : byte2,
+ buffer_ptr : ^cell,
+ rest3 : byte64,
+ recend;
+
+ type table_type = packed array[1..100] of table_entry;
+
+ var hilf_ptr : ^table_type;
+ var nil_test : ^cell;
+ var i : integer;
+ var k : integer;
+ var file_adress_bin : integer;
+ var status : ost$status;
+
+ hilf_ptr := PAV$FILE_TABLE_PTR;
+ FOR i:=1 to 100 DO
+ IF hilf_ptr^[i].file_pt.file_adress = ^file_variable THEN
+ file_name:= hilf_ptr^[i].new_name;
+ EXIT get_local_file_name;
+ IFEND
+ FOREND;
+
+PROCEND get_local_file_name;
+
+
+PROCEDURE [XDCL] put_next (var file_id : amt$file_identifier;
+ var buffer : cell;
+ number_of_bytes : amt$working_storage_length);
+
+VAR status : ost$status;
+VAR adress : amt$file_byte_address;
+
+ AMP$put_next(file_id,^buffer,number_of_bytes,adress,status);
+
+PROCEND put_next;
+
+{ Ausgabe eines mittleren Satzstueckes }
+
+PROCEDURE [XDCL] put_partial (var file_id : amt$file_identifier;
+ var buffer : cell;
+ number_of_bytes : amt$working_storage_length);
+
+VAR status : ost$status;
+VAR adress : amt$file_byte_address;
+
+ AMP$put_partial(file_id,^buffer,number_of_bytes,adress,
+ amc$continue,status);
+
+PROCEND put_partial;
+
+{ Ausgabe des ersten Teilsatzes }
+
+PROCEDURE [XDCL] put_f_partial (var file_id : amt$file_identifier;
+ var buffer : cell;
+ number_of_bytes : amt$working_storage_length);
+
+VAR status : ost$status;
+VAR adress : amt$file_byte_address;
+
+ AMP$put_partial(file_id,^buffer,number_of_bytes,adress,
+ amc$start ,status);
+
+PROCEND put_f_partial;
+
+
+{ Ausgabe des letzten Teilsatzes }
+
+PROCEDURE [XDCL] put_l_partial (var file_id : amt$file_identifier;
+ var buffer : cell;
+ number_of_bytes : amt$working_storage_length);
+
+VAR status : ost$status;
+VAR adress : amt$file_byte_address;
+
+ AMP$put_partial(file_id,^buffer,number_of_bytes,adress,
+ amc$terminate ,status);
+
+PROCEND put_l_partial;
+
+
+PROCEDURE expand_file_name ( file_name : string_type;
+ position : integer; {immer von 1}
+ var new_file_name : string_type;
+ var ok : boolean);
+
+var SCL_string_name : string(string_length);
+var i,j,k : integer;
+var SCL_variable : clt$variable_reference;
+var status : ost$status;
+var actual_name : string_type;
+var curpos : integer;
+var begin_of_name : integer;
+var test_length : integer;
+var test_oldfile : boolean;
+var string_position : ost$string;
+var string_ptr : ^ ost$string;
+
+{ 1. test of old version without '<' }
+
+ IF file_name(1) <> '<' THEN
+ ok := position = 1;
+ new_file_name := file_name;
+ RETURN;
+ IFEND;
+ { get the part between '< ... >' }
+ i:=1;
+ REPEAT
+ i:=i+1;
+ UNTIL ( file_name(i)='>') or (i=string_length);
+
+ begin_of_name := i+ 1; { first character of rest name }
+
+ SCL_string_name := file_name(2,begin_of_name-3);
+
+ CLP$CONVERT_INTEGER_TO_STRING(position,10,FALSE,string_position,status);
+
+ SCL_string_name(begin_of_name-2) := '(';
+ SCL_string_name(begin_of_name-1,*) :=
+ string_position.value(1,string_position.size);
+ SCL_string_name(begin_of_name-1+string_position.size) := ')';
+
+ CLP$READ_VARIABLE ( SCL_string_name,SCL_variable,status);
+
+ IF NOT status.normal THEN
+ ok := FALSE;
+ RETURN;
+ IFEND;
+
+ string_ptr:=^ SCL_variable.value.string_value^[1];
+ actual_name:=string_ptr^.value;
+ curpos := string_ptr^.size+1;
+ actual_name(curpos) := '.';
+ actual_name(curpos+1,*) := file_name(begin_of_name,*);
+ ok := TRUE;
+ new_file_name := actual_name;
+
+PROCEND expand_file_name;
+
+{ The opensegmented/opensegment-routines give the pointer }
+{ to the beginning of the file-information usable as a pascal }
+{ referenz. }
+{ }
+{ You can define (in PASCAL) }
+{ file_refenz : ^packed array[0..???] of 0..255; }
+{ }
+{ Then you can do input easily by array references. }
+{ Hint: A file of record type "VARIABLE" begins with 14 bytes }
+{ header informations }
+{ }
+{ (There is one "if file_length=0..." with inhibits Output, but }
+{ without this, you can do output in the same way. }
+{ }
+{ in PASCAL }
+{ }
+{ type byte = 0..255; }
+{ two_word = array[1..2] of integer; }
+{ byte_ref = ^byte; }
+{ string_type = packed array[1..64] of char; }
+{ }
+{ procedure opensegmented (long_name_of_file }
+{ var current_adress : byte_ref; }
+{ var effektiv_file_name : string_type; }
+{ var is_old_file : boolean; }
+{ var file_length : integer; }
+{ var file_identifier : two_word; }
+{ var error : integer; }
+
+procedure [XDCL] opensegmented (long_name_of_file : string_type;
+ var file_variable : ^cell;
+ var effektiv_file_name : string_type;
+ var is_old_file : boolean;
+ var file_length : integer;
+ var file_identifier : amt$file_identifier;
+ var error : integer);
+
+ var i : integer;
+
+
+{ pdt file_pdt ( f : file = $required )
+
+?? PUSH (LISTEXT := ON) ??
+
+ VAR
+ file_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table
+ := [^file_pdt_names, ^file_pdt_params];
+
+ VAR
+ file_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults]
+ array [1 .. 1] of clt$parameter_name_descriptor := [['F', 1]];
+
+ VAR
+ file_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 1]
+ of clt$parameter_descriptor := [
+
+{ F }
+ [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
+ clc$file_value]]];
+
+?? POP ??
+
+
+VAR k : integer;
+VAR old_file : boolean;
+VAR status : ost$status;
+var status1,status2,status3,status4 : ost$status;
+var segment_pointer : amt$segment_pointer;
+VAR parameter_pt : ^clt$parameter_list;
+VAR value : clt$value;
+VAR string_pt : ^ost$string;
+var param1 : [STATIC] string(1) := 'F';
+var laenge : integer;
+var file_reference : clt$file_reference;
+var path_container : clt$path_container;
+var path : ^pft$path;
+var cycle_selector : clt$cycle_selector;
+var open_position : clt$open_position;
+var local_file : clt$file;
+var position : integer;
+var expanded_name_of_file : string_type;
+var more : boolean;
+
+ error :=0;
+
+ PUSH parameter_pt : [[ost$string]];
+ RESET parameter_pt;
+ NEXT string_pt IN parameter_pt;
+
+ position := 1;
+
+ /expand/
+ WHILE TRUE DO
+ expand_file_name(long_name_of_file, position,
+ expanded_name_of_file,more);
+
+ IF NOT more THEN
+ error := -1;
+ is_old_file := false;
+ RETURN;
+ IFEND;
+
+ position := position + 1; { prepare for next cycle }
+
+ string_pt^.value := expanded_name_of_file;
+ string_pt^.size := string_length;
+
+ CLP$PUSH_PARAMETERS (status1);
+
+ CLP$SCAN_PARAMETER_LIST(parameter_pt^,file_pdt,status2);
+
+ if not status2.normal then
+ error := status2.condition;
+ PMP$ABORT(status2);
+ ifend;
+
+ CLP$GET_VALUE(param1,1,1,clc$LOW,value,status3);
+
+ CLP$POP_PARAMETERS (status4);
+
+ if not status3.normal then
+ error := status3.condition;
+ PMP$ABORT(status3);
+ ifend;
+
+ CLP$GET_PATH_DESCRIPTION(value.file,
+ file_reference,
+ path_container,
+ path,
+ cycle_selector,
+ open_position,
+ status3);
+
+ if status3.normal then
+ effektiv_file_name :=
+ file_reference.path_name(1,file_reference.path_name_size);
+ else
+ error := status3.condition;
+ cycle /expand/;
+ ifend;
+
+ get_file_length (value.file.local_file_name,file_length,old_file);
+
+ if file_length=0 then
+ cycle /expand/;
+ ifend;
+
+ FSP$OPEN_FILE (value.file.local_file_name,
+ amc$segment,
+ NIL, { file_attachment }
+ NIL, { default_creation_attributes }
+ NIL, { mandated_creation_attributes }
+ NIL, { attribute_validation }
+ NIL, { attribute_override }
+ file_identifier,status4);
+
+ if status4.normal then
+ amp$get_segment_pointer(file_identifier,
+ amc$cell_pointer,
+ segment_pointer,
+ status4);
+ file_variable := segment_pointer.cell_pointer;
+ if status4.normal then
+ RETURN;
+ ifend;
+ ifend;
+ WHILEND;
+ error:=1;
+
+procend opensegmented;
+
+
+{ set the file_size of a segmented file : the second parameter must }
+{ contain the address of the byte behind the last byte of the file }
+
+procedure [XDCL] setsegmenteoi (
+ file_identifier : two_word_id;
+ var byte_behind_the_last : cell);
+
+var segment_pointer : amt$segment_pointer;
+var file_id : amt$file_identifier;
+var status : ost$status;
+file_id := file_identifier.id;
+segment_pointer.kind := amc$cell_pointer;
+segment_pointer.cell_pointer := ^byte_behind_the_last;
+AMP$SET_SEGMENT_EOI(file_id,segment_pointer,status);
+if not status.normal then
+PMP$ABORT(status);
+ifend;
+procend setsegmenteoi;
+
+{ close the segmented opened file }
+
+procedure [XDCL] closesegmented (file_identifier : two_word_id);
+var file_id : amt$file_identifier;
+var status : ost$status;
+ file_id := file_identifier.id;
+ FSP$CLOSE_FILE(file_id,status);
+
+
+procend closesegmented;
+
+{ alias definition --- needed as the tangle program shortens the }
+{ names to 12 characters }
+
+procedure [XDCL] opensegmente (long_name_of_file : string_type;
+ var file_variable : ^cell;
+ var effektiv_file_name : string_type;
+ var is_old_file : boolean;
+ var file_length : integer;
+ var file_identifier : amt$file_identifier;
+ var error : integer);
+
+ opensegmented (long_name_of_file ,
+ file_variable ,
+ effektiv_file_name ,
+ is_old_file ,
+ file_length ,
+ file_identifier ,
+ error )
+
+
+procend opensegmente;
+
+procedure [XDCL] closesegment (file_identifier : two_word_id);
+ closesegmented(file_identifier);
+procend closesegment;
+
+{ to display any status message for control usage of the job }
+
+procedure [XDCL] display_status ( text : string_type);
+var status : ost$status;
+*COPYC OFP$DISPLAY_STATUS_MESSAGE
+OFP$DISPLAY_STATUS_MESSAGE(text,status);
+RETURN;
+procend display_status;
+
+{ condition handler for user break two }
+
+{ It must be called with the parameter 'flag' and the name of }
+{ a procedure which will be executed with condition handling }
+
+{ PROCEDURE NONBREAK_RUN (VAR FLAG : INTEGER; PROCEDURE P); EXTERNAL; }
+
+{ Then 'P' will be called. 'FLAG' will receive the value '1', if an }
+{ user break 2 has occurred. 'FLAG' should be global to 'P', then }
+{ 'P' can examince the current value of 'FLAG' }
+
+*copyc pmp$establish_condition_handler
+
+type two_pointer = packed record
+ binding : ^cell,
+ static_link : ^cell,
+ recend;
+
+PROCEDURE [XDCL] nonbreak_run (VAR flag : integer;
+ main1 : integer; main2 : integer);
+VAR routine : record
+ case boolean of
+ =true= proc : ^procedure,
+ =false= cellar : record
+ int1 : integer,
+ int2 : integer,
+ recend,
+ casend,
+ recend,
+ interactive_break : [STATIC] pmt$condition :=
+ [ifc$interactive_condition, ifc$terminate_break],
+ interactive_break_descriptor: pmt$established_handler,
+ status: ost$status;
+
+ PROCEDURE ib_handler
+ ( condition: pmt$condition;
+ condition_descriptor: ^pmt$condition_information;
+ save_area: ^ost$stack_frame_save_area;
+ VAR c_status: ost$status);
+
+
+ c_status.normal := TRUE;
+ CASE condition.interactive_condition OF
+ = ifc$pause_break =
+ RETURN;
+ = ifc$terminate_break =
+ if flag>0 then
+ pmp$exit(c_status);
+ ifend;
+ flag := 1;
+ RETURN;
+ = ifc$terminal_connection_broken =
+ RETURN;
+ = ifc$job_reconnect =
+ RETURN;
+
+ CASEND;
+ PROCEND ib_handler;
+
+ flag := 0;
+ pmp$establish_condition_handler (interactive_break, ^ib_handler,
+ ^interactive_break_descriptor, status);
+ IF NOT status.normal THEN
+ PMP$ABORT(status);
+ IFEND;
+ routine.cellar.int1 := main1;
+ routine.cellar.int2 := main2;
+
+ routine.proc^;
+ PROCEND nonbreak_run;
+
+*copyc RMP$GET_DEVICE_CLASS
+
+PROCEDURE [XDCL] terminal_device ( VAR pascal_file_id : cell;
+ VAR terminal : boolean );
+VAR file_name : amt$local_file_name,
+ device_class : rmt$device_class,
+ device_assigned : boolean,
+ status : ost$status;
+
+get_local_file_name ( pascal_file_id, file_name);
+RMP$GET_DEVICE_CLASS (file_name,device_assigned,device_class, status);
+terminal := status.normal AND
+ device_assigned AND (device_class<> RMC$MASS_STORAGE_DEVICE)
+ AND (device_class<> RMC$MAGNETIC_TAPE_DEVICE);
+procend terminal_device;
+
+modend;
+
diff --git a/dviware/crudetype/version3/philips.ch b/dviware/crudetype/version3/philips.ch
new file mode 100644
index 0000000000..746a88c95b
--- /dev/null
+++ b/dviware/crudetype/version3/philips.ch
@@ -0,0 +1,256 @@
+% philips.ch -*-mode: change; webfile: crudetype.web version 3.01;-*-
+% PHILIPS. Change file for Philips printer
+% NOTE the system change file must normally be inserted above this point.
+% This file became obsolete when its printer was removed.
+%
+
+
+@x Module 235; Lines 4028 -- 4028
+*** Attach printer change file here ***
+@y
+
+This is a change file for a particular model of Philips, with a particular set
+of resident fonts. It cannot be assumed that this file will work on other
+Philipses, or on the same model with a different operating system. I have
+tried to adapt this to \.{Crudetype} version 2, but I have no way to test it.
+
+@<Const...@>= device_ID = 'Philips';
+
+@ Where will the printed file go to?
+
+@<Set init...@>=
+ be_string( '.PHI' ) ; print_ex := buffer ;
+
+@ The first batch of constants describes the printer's style of carriage
+control. |fortran| means that the carriage control character gets put at the
+start of the line, and it is here assumed that it must be inserted explicitly.
+Note also that the program makes no attempt to check all these values for
+consistency.
+
+@<Carriage control constants@>=
+ fortran = false ;
+ list = false ;
+ b_feed_absolute = false ;
+ b_feed_by_string = false ;
+ feed_absolute = true ;
+ b_feed_scream = true ;
+ b_space_absolute = true ;
+ b_space_by_string =false ;
+ space_absolute = true ;
+ abs_is_incr = false ;
+ w_l_does_c_r = false ;
+ want_split = true ;
+ is_header = false ; {each page needs a header}
+ param_type = 'D' ;
+
+@ This batch is concerned with distances and resolutions.
+
+@<Const...@>=
+ l_margin = 10 ;
+ top_margin = 24 ;
+ h_resolution = 72 ; {h_steps per inch}
+ v_resolution = 48 ; {v_steps per inch}
+ fixed_width = true ; {printer's characters are fixed width}
+ h_fudge = 1.4 ;
+ {Trial and error. May need to be adjusted}
+ v_fudge = 1 ;
+ char_width = 6 ;
+ {all printer characters are this width, in units of |h_step|. Normally,
+ space_dist will be equal to this, but some printers are not normal!}
+ gap_width = 2 ; {Intended minimum space between words}
+ char_ht = 8 ;
+
+@ Next, some constants for rule-setting.
+
+@<Rule setting const...@>=
+ rail_width = 6 ; {Height and width of rule chars, in steps}
+ rail_height = 1 ;
+ post_width = 1 ;
+ post_height = 6 ;
+ rail_types = 1 ;
+
+@ @<Set rule characters@>=
+ rail_chars[1] := codes[ 1, 95 ] ;
+ post_char := codes[ 1, 124] ;
+
+@ @<Pause constants...@>=
+ do_pause = false ;
+ pause_steps = 20 ;
+ pause_ask = 'PAUSED. Type <return> to continue' ;
+
+@ The next batch are concerned with the printers fonts.
+
+@<Const...@>=
+ min_font = 1 ;
+ {smallest & largest number of printers resident fonts}
+ max_font = 5 ;
+ only_one_font = false ;
+ can_dl_font = false ;
+ min_dl_font = 0 ;
+ max_dl_font = 0 ; {printers down-loadable fonts}
+ max_codes = 8 ; {no. of known \TeX\ coding schemes}
+ max_char = 127 ; {max. no. of chars per \TeX\ font}
+ max_plain = 4 ; {Max number of a plain text font}
+
+@ Finally, consider command strings. These are intended to set various
+options. In the |start_stuff| below, each `^[' will be translated into ASCII
+escape. Taking these escape sequences in order, they: select portrait paper,
+clear all tabs and margin, select initial font and pitch, set step size |1/6|
+character pitch (that was why we had to select a font), and set line spacing
+at 48 per inch .
+
+@<Set init...@>=
+ be_string ( '^[[22h^[[3g^[[2;2x^[;^[[4y^[[48{ ' ) ;
+ start_stuff := buffer ;
+ be_string ( '^[[&D;2x' ) ; font_command := buffer ;
+ be_string ( '^[[&Dd' ) ; v_abs_command := buffer ;
+ be_string ('^[[&D`' ) ; h_abs_command := buffer ;
+ stop_stuff := blank ;
+ page_top := blank ;
+ pause_after := blank ;
+
+@* Character code data for the printer.
+
+Here we actually put data into the |codes| array. In general, I have merely
+replaced each character in the PLAIN.TEX coding schemes by the nearest equiv-
+alent in ASCII, when any reasonable equivalent exists ; I have not tried to
+tackle either AMSY or AMATHEX ; clearly there will be some scope for doing so.
+First we give the scheme names, ( padded to |code_len|) then do stuff for each
+name in turn. On the Philips ( as set up here) there are essentially 2 useful
+fonts ; 2 is a Roman font, 5 is a simple math symbol font.
+
+@<Assign char...@>=
+ be_string( ' ' ) ; set_scheme( 0 ) ;
+ be_string( 'TEX EXTENDED ASCII' ) ; set_scheme( 1 ) ;
+ be_string( 'TEX TYPEWRITER TEXT' ) ; set_scheme( 2 ) ;
+ be_string( 'TEX TEXT' ) ; set_scheme( 3 ) ;
+ be_string( 'TEX TEXT WITHOUT F-LIGATURES' ) ; set_scheme( 4 ) ;
+ be_string( 'AEFMNOT ONLY' ) ; set_scheme( 5 ) ;
+ be_string( 'TEX MATH ITALIC' ) ; set_scheme( 6 ) ;
+ be_string( 'TEX MATH SYMBOLS' ) ; set_scheme( 7 ) ;
+ be_string( 'TEX MATH EXTENSION' ) ; set_scheme( 8 ) ;
+
+@ Now do scheme 1 = EXTENDED ASCII
+
+@<Assign char...@>=
+ alphabet( 32, 95, 1, 2, 32) ;
+ be_string( ' o & a b LL ~ e p ') ;
+ row( 1,0,5) ;
+ be_string( ' l g d ^ # {LQ|} LT LB ') ;
+ row( 1,1,5) ;
+ be_string( ' Z Z Z Z Z Z ` \ ') ;
+ row( 1,2,5) ;
+ be_string( ' : ; ? Z LM LN LI [F2or] ') ;
+ row( 1,3,5) ;
+ codes[1,127].IM_font := 2 ;
+ codes[1,127].IM_char := "Z" ;
+
+@ Now do scheme 2 = TYPEWRITER. Unfortunately, \.TANGLE imposes a limit of 69
+on the length of quoted strings. This causes difficulty because several multi-
+character commands are too long for 8 of them to fit neatly into a string of
+that length. So I use the Z command to ( effectively) split any complicated
+|row_spec| into two.
+
+@<Assign char...@>=
+ alphabet( 32, 95, 2, 2, 32) ;
+ codes[2, 127].IM_char := 34 ;
+ be_string( ' LG LD LQ LL LI LP LS LU ') ;
+ row( 2,0,5) ;
+ be_string( ' LF LY LW ^ & F2Q ! ? ') ;
+ row( 1,1,5) ;
+ be_string( ' i j ` Q Z Z <U_> <U.> ') ;
+ row( 2,2,2) ;
+ be_string( ' , {LB_} [aK3e] [oK3e] {o/} [LAK3LE] [LOK3LE] {LO/} ') ;
+ row( 2,3,2) ;
+
+
+@ The TEX TEXT scheme is nearly the same, so we start by copying it.
+
+@<Assign char...@>=
+ for in_i := 0 to 127 do codes [3, in_i] := codes [2, in_i] ;
+ be_string( ' Z Z Z [ff] [fi] [fl] [ffi] [ffl] ') ;
+ row( 3,1,2) ;
+ be_string( ' Z Z Z Z ! Z ? Z ') ;
+ row( 3,7,2) ;
+ be_string( ' Z Z Z Z W Z Z <U.> ') ;
+ row( 3,11,2) ;
+ be_string( ' Z Z Z - [--] W ~ W ') ;
+ row( 3,15,2) ;
+
+@ Recently there has appeared a scheme, called TEX TEXT WITHOUT F-LIGATURES.
+
+@<Assign char...@>=
+ for in_i := 0 to 127 do codes [4, in_i] := codes [3, in_i] ;
+ be_string( ' {oI} {u|} Z {^|} {v|} Q ! ? ') ;
+ row( 4,1,2) ;
+
+@ and AEFMNOT ONLY (for the Metafont logo).
+
+@<Assign char...@>=
+ be_string( ' Z LA Z Z Z LE LF Z ') ;
+ row( 5,8,2) ;
+ be_string( ' Z Z Z Z Z LM LN LO ') ;
+ row( 5,9,2) ;
+ be_string( ' Z Z Z Z LT Z Z Z ') ;
+ row( 5,10,2) ;
+
+@ Now the MATH ITALIC scheme. The Philips can try to do quite a lot of this.
+As before, a lot of this is indistinguishable from the TEXT scheme, so we copy
+
+@<Assign char...@>=
+ for in_i := 0 to 10 do codes [6, in_i] := codes [2, in_i] ;
+ for in_i := 48 to 122 do codes [6, in_i] := codes [2, in_i] ;
+ {Next the lower-case Greek letters in rows 1..4}
+ be_string( ' Z Z Z a b g d e ') ;
+ row( 6,1,5) ;
+ be_string( ' z h q j k l m n ') ;
+ row( 6,2,5) ;
+ be_string( ' c p r s t n f x ') ;
+ row( 6,3,5) ;
+ be_string( ' y w e q w r z f ') ;
+ row( 6,4,5) ;
+ be_string( ' [:-] [:-] [-;] [-;] Z Z Z Z ') ;
+ row( 6,5,5) ;
+ be_string( ' Z Z . , Z / Z * ') ;
+ row( 6,7,2) ;
+ be_string( ' Z Z Z i j p <UF5;> Z ') ;
+ row( 6,15,2) ;
+
+@ MATH SYMBOLS are messy, and no doubt the results will look unpleasant.
+
+@<Assign char...@>=
+ alphabet( 65, 26, 7, 1, 65) ;
+ be_string( ' - . {\/} * {-:} Z {+_} <U_+> ') ;
+ row( 7,0,2) ;
+ be_string( ' {LO+} {LO-} {LOx} {LO/} LO LO o o ') ;
+ row( 7,1,2) ;
+ be_string( ' Z {=_} Z Z {L<_} {L>_} {L<_} {L>_} ') ;
+ row( 7,2,2) ;
+ be_string( ' ~ <U~~> Z Z [L<L<] [L>L>] L< L> ') ;
+ row( 7,3,2) ;
+ be_string( ' [{L<-}-] [{L>-}-] {|^} {|v} Z Z Z Z ') ;
+ row( 7,4,2) ;
+ be_string( ' Z Z Z Z [{L<-}{-L>}] / \ {~_} ') ;
+ row( 7,4,2) ;
+ be_string( ' [{L<=}=] [{L>=}=] Z Z Z Z Z Z ') ;
+ row( 7,5,2) ;
+ be_string( ' Z Z Z Z [{L<=}{=L>}] Z Z Z ') ;
+ row( 7,5,2) ;
+ be_string( ' Q [oo] {L(-} {-L)} Z Z Z Z ') ;
+ row( 7,6,2) ;
+ be_string( ' Z Z Z Z [{/_}{_\}] <U[__][\/]> / Q ') ;
+ row( 7,6,2) ;
+ be_string( ' [{\-}{-/}] <U_[{-_}|]> ~ {0/} LR LT <U_|> {|_}') ;
+ row( 7,7,2) ;
+ be_string( ' Z Z Z LU Z {LU+} & [or] ') ;
+ row( 7,11,2) ;
+ be_string( ' [{|-}-] [-{-|}] Z Z Z Z L{ L} ') ;
+ row( 7,12,2) ;
+ be_string( ' L< L> | [||] {^|v} {^|v} \ Z ') ;
+ row( 7,13,2) ;
+ be_string( ' <Z{-v/}> [{I_}{_I}] <U[__][\/]> Z Z Z Z Z ') ;
+ row( 7,14,2) ;
+
+@<Set rule characters@>
+
+@z
diff --git a/dviware/crudetype/version3/primos.ch b/dviware/crudetype/version3/primos.ch
new file mode 100644
index 0000000000..5540200e89
--- /dev/null
+++ b/dviware/crudetype/version3/primos.ch
@@ -0,0 +1,317 @@
+% primos.ch -*-mode: change; webfile: crudetype.web version 3.01;-*-
+%CRUDETYPE change file for the Primos Operating System.
+%
+%All PRIMOS changes Copyright (C) 1989 Jon Warbrick and Polytechnic South West.
+%Permission is granted to use, copy and distribute copies of this file under
+%the conditions that apply to the distribution of the CRUDETYPE program
+%itself.
+%
+%This file modified by RMD for Crudetype version 2 --- and fixed by JW!
+%Modified for V3
+%
+
+% Fix the title
+@x Module 0; Lines 42 -- 42
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\def\title{Crudetype for {\mc PRIMOS}}
+@z
+
+@x Module 1; Lines 83 -- 86
+This is an experimental version and no guarantee of performance is given.
+I would like to receive bug reports, same address or electronic mail to
+DAMERELL at UK.AC.NSFNET-RELAY (From the USA, I believe that site is
+NSFNET-RELAY.AC.UK). \par\vskip 0.5in
+@y
+This is an experimental version and no guarantee of performance is given.
+I would like to receive bug reports, same address or electronic mail to
+DAMERELL at UK.AC.NSFNET-RELAY (From the USA, I believe that site is
+NSFNET-RELAY.AC.UK. \par\vskip 0.5in
+
+The PRIMOS change file for this program was developed by Jon Warbrick, of
+the Polytechnic South West (formally Plymouth Polytechnic) Computing
+Service, Plymouth, UK. Permission is granted to use, copy and distribute
+copies of this PRIMOS version under the conditions that apply to
+distrbution of the CRUDETYPE program itself. Please report any bugs that
+relate to the PRIMOS implementation, either by post or by electronic mail
+to J.Warbrick at UK.AC.PLYMOUTH
+
+This change file much modified by RMD to adapt it (I hope) to Crudetype
+version 3. Many of the changes originally made by JW and others have been
+incorporated into the basic program. I have asked the author to check it.
+\par\vskip 0.5in
+@z
+
+@x Module 4; Lines 213 -- 213
+@d banner=='This is Crudetype, Version 3.01, copyright, experimental'
+@y
+@d banner=='This is Crudetype, Primos PSW Version 3'
+@z
+
+@x Module 12; Lines 330 -- 334
+the macros and constants defined here. See various change files for examples.
+
+@d zchr == chr
+@d zord == ord
+@d Q_string == packed array[ first..last:integer] of char
+@y
+the macros and constants defined here. See various change files for examples.
+
+PRIMOS \PASCAL does not have conformant arrays so we have to resort to
+using |strings|, which are basically the same as VMS |varying|.
+
+@d zchr == chr
+@d zord == ord
+@d Q_string == string
+@d first = 1
+@d last == length( ss)
+@z
+
+@x Module 14; Lines 360 -- 361
+@<Lowest...@>=
+ {Declare |parse_file|}
+@y
+@<Lowest...@>=
+ procedure parse_file( name: var_string; var dir, nam, ex: var_string) ;
+ var p,q,r,s: s_ptr ;
+ begin
+ dir := blank; nam := blank; ex := blank;
+ s := name.len ;
+ if ( s>0) then begin
+ p := s_search( name, '>', -s);
+ if ( p>0) then substring( dir, name, 1, p) ;
+ r := s_search( name, '.', -s);
+ if ( r>p) then substring( ex, name, r, s-r+1)
+ else r := s +1 ;
+ substring( nam, name, p+1, r-p-1) ;
+ end;
+ end;
+@z
+
+@x Module 18; Lines 432 -- 436
+@<Set init...@>=
+ be_string( '.DVI' ) ; dvi_def := buffer ;
+ be_string( 'TEX$FONTS:.TFM' ) ; tfm_def := buffer ;
+ be_string( 'TEX$GF:.&DGF' ) ; raster_def := buffer ;
+ be_string( '.PRI' ) ; print_ex := buffer ;
+@y
+@<Set init...@>=
+ be_string( '.DVI' ) ; dvi_def := buffer ;
+ be_string( 'TEX>FONTS>.TFM' ) ; tfm_def := buffer ;
+ be_string( 'TEX>GFDIR>.&DGF' ) ; raster_def := buffer ;
+ be_string( '.LPT' ) ; print_ex := buffer ;
+@z
+
+@x Module 19; Lines 442 -- 443
+@<Lowest...@>=
+ {Declare |open_binary|}
+@y
+
+In Primos, some condition handling stuff is used to see if the file got opened
+OK.
+
+@d close_binary(#)==
+ close(#)
+
+@<Lowest...@>=
+ function open_binary
+ (var f_f: byte_file; name: var_string ): boolean;
+ label exit;
+ @<Define |open_io_onunit|@>
+ begin
+ close_binary(f_f );
+ {in case the file was left open}
+ open_binary := false;
+ on('IO_ERROR',open_io_onunit);
+ reset(f_f, name.data);
+ open_binary := true;
+ exit: { come here after error opening file } ;
+ end;
+@z
+
+@x Module 20; Lines 445 -- 446
+@ @<Open |printfile|@>=
+ rewrite(printfile) ;
+@y
+@ Primos makes it fairly easy to open the print file. We define a condition
+handler so that the program will fail fairly neatly if we can't open the file,
+or if we have problems writing to it in the future.
+
+@<Open |printfile|@>=
+ on('IO_ERROR', print_io_onunit);
+ rewrite(printfile, print_name.data) ;
+@z
+
+@x Module 21; Lines 448 -- 466
+@ \.{Crudetype} tries to read a ``command line''. |@!read_command_line| should
+be the procedure that actually reads the line, and these macros extract pieces
+of it. The code below should work on systems that cannot read command lines.
+
+@d get_val( #) == # := s_to_i( #, true)
+@d prefix == "/"
+@d got_cl == ( command.len > 0)
+@d read_command_line( #) == do_nothing
+
+@<Lowest...@>=
+ {Declare |read_command_line| }
+@#
+ procedure get_command ;
+ var ss: fix_string ;
+ begin
+ ss := blank.data ;
+ read_command_line( ss) ;
+ be_string( ss ) ; command := buffer ;
+ end;
+@y
+@ \.{Crudetype} tries to read a ``command line''. |@!read_command_line| should
+be the procedure that actually reads the line, and these macros extract pieces
+of it. The code below will work under Primos, providing that the program is
+loaded as an EPF.
+
+@d get_val( #) == # := s_to_i( #, true)
+@d prefix == "-"
+@d got_cl == ( command.len > 0)
+@d read_command_line( #) == @= epfargs@> ( #)
+
+@<Lowest...@>=
+ procedure get_command ;
+ var ss: Q_string ;
+ begin
+ read_command_line( ss) ;
+ be_string( ss ) ; command := buffer ;
+ end;
+@z
+
+@x Module 198; Lines 3377 -- 3377
+ page(printfile)
+@y
+ begin
+ print_ln ;
+ print ('1') ;
+ print_ln ;
+ end
+@z
+
+@x Module 206; Lines 3464 -- 3464
+ v_abs_com, h_abs_com, pause_after: var_string ;
+@y
+ v_abs_com, h_abs_com, pause_after: var_string ;
+ bodge : packed record case boolean of
+ true : (word : shortint);
+ false: (chars : packed array[1..2] of char);
+ end;
+@z
+
+@x Module 207; Lines 3474 -- 3474
+ fortran := false ;
+@y
+ fortran := true ;
+@z
+
+@x Module 207; Lines 3509 -- 3509
+ start_stuff := blank ;
+@y
+ be_string ( '1' ) ; start_stuff := buffer ;
+@z
+
+@x Module 211; Lines 3570 -- 3572
+@<Open |printfile|@>=
+ string_print(start_stuff) ;
+ print_ln ;
+@y
+@<Open |printfile|@>=
+ bodge.word := @"0101 ;
+ print(bodge.chars);
+ print_ln ;
+ string_print(start_stuff) ;
+ print_ln ;
+@z
+
+@x Module 235; Lines 4028 -- 4028
+*** Attach printer change file here ***
+@y
+@* Additional Primos modules.
+
+Some extra modules for the Primos version are included here to avoid
+re-numbering all of the existing ones.
+@.System dependencies@>
+
+@ First some error handling: we use conditional handlers (or on-units) to
+trap various IO errors, either on opening the \.{DVI} file or on writing
+the output.
+
+Errors on opening input files are trapped by |open_io_onunit|. We do some
+devious Sheffield pascal programming to see that the error was caused by a
+|reset|, and if it was we jump to the exit label. If it wasn't, then we just
+return, leaving it to the system to see what to do next.
+
+@<Define |open_io_onunit|@>=
+ procedure open_io_onunit ( cfptr : integer ) ;
+ var
+ er_ptr: ptrerror;
+ begin
+ p$errptr(cfptr,er_ptr);
+ with er_ptr^ do
+ if (name_string = 'RESET ') and
+ (func_string = 'opening ') then
+ goto exit;
+ end ;
+
+@ Just before we open the output file we nominate |print_io_onunit| to handle
+output errors. We use some devious bits of Sheffield Pascal system
+programming to find out what operation caused the problem, and print a
+suitable error message before failing if we recognise the error. If we dont
+then we can just return and let the system handle it.
+
+@<Lowest...@>=
+ procedure print_io_onunit (cfptr: integer);
+ var
+ er_ptr: ptrerror;
+ begin
+ p$errptr(cfptr,er_ptr);
+ with er_ptr^ do
+ if (name_string = 'REWRITE ') then
+ abort ('unable to open output file')
+ @.fatal: unable to open...@>
+ else if (name_string = 'PUT ') or
+ (name_string = 'WRTBUF ') then
+ abort ('error writing to output file -- disc storage may be full');
+ @.fatal: error writing...@>
+ end ;
+
+@ @<Types...@>=
+ ptrerror = ^io_error_struct;
+ io_error_struct = record
+ file_block : integer;
+ err_code : shortint;
+ error_value : integer;
+ error_len : shortint;
+ error_string : packed array [1..128] of char;
+ name_le : shortint;
+ name_string : packed array [1..8] of char;
+ func_len : shortint;
+ func_string : packed array [1..20] of char;
+ caller_address : integer
+ end;
+
+@ @<Forw...@>=
+ procedure p$errptr(cfptr:integer; var er_ptr:ptrerror); extern;
+
+@ Turn off Pascal system interupt handling. The pascal run-time library
+routine |p$break| can be used to turn on or off handling of interupts. So
+we turn it off so that the program will fail quietly.
+
+@<Set initial...@>=
+ p$break (false);
+
+@ @<Forw...@>=
+ procedure p$break (onoroff : boolean ) ; extern;
+
+@ In screenview the output file name must be different.
+
+@<Set up for...@>=
+ if inspection or batch_view then begin
+ be_string( '.TEXT' ) ; print_ex := buffer ; end;
+@z
+
diff --git a/dviware/crudetype/version3/primos.cpl b/dviware/crudetype/version3/primos.cpl
new file mode 100644
index 0000000000..3eecfc68e8
--- /dev/null
+++ b/dviware/crudetype/version3/primos.cpl
@@ -0,0 +1,37 @@
+
+/* PRIMOS.CPL
+/* CPL Macro to tangle, compile and load Crudetype for Primos
+/* Jon Warbrick, 06/88
+
+/*************************************************
+
+/* You will have to change the next three lines
+/* to give the correct commands to run TANGLE
+/* and the Sheffield Pascal Compiler on your
+/* system, and to give the name of the Pascal
+/* library.
+
+&s tangle_command := R TEX>CMDNC0>TANGLE
+&s pascal_command := PASCAL
+&s pascal_library := PASCAL
+
+/*************************************************
+
+&args program = PRIMOS
+
+COMO CRUDETYPE.COMO
+%tangle_command% CRUDETYPE.WEB %program%.CH
+COMO -E
+
+&if ^ [query 'OK to go on' TRUE] &then &stop
+
+%pascal_command% %program% -BIG -EPF_ARGS
+
+&data BIND
+lo %program%
+li %pascal_library%
+li
+file CRUDETYPE.RUN
+&end
+
+&return
diff --git a/dviware/crudetype/version3/pro-pas.ch b/dviware/crudetype/version3/pro-pas.ch
new file mode 100644
index 0000000000..18032db59a
--- /dev/null
+++ b/dviware/crudetype/version3/pro-pas.ch
@@ -0,0 +1,201 @@
+% pro-pas.ch -*-mode: change; webfile: crudetype.web version 3.01;-*-
+% Attempted changefile for PRO-pascal for MS-DOS, RMD.
+% Doesnt work; unfortunately the disgnostics of pro-pascal are so vague
+% that I cannot tell what is wrong
+%
+% COPYRIGHT ( C ) R.M.Damerell,1990
+%
+% This may be distributed on the same terms as the main Crudetype program.
+%
+% 1. All copies of the software must carry an exact copy of this notice.
+%
+% 2. This software is distributed free of charge, "AS IS" with absolutely no
+% guarantee of performance. Any persons receiving or using this software must do
+% so entirely at their own risk. Neither the authors nor their institutions
+% accept any liability for any defects of this software, or for any consequential
+% loss or damage however caused.
+%
+% 3. Any person who changes this software must clearly mark it as modified and
+% add a note describing the changes made.
+%
+
+% WEAVE: print changes only
+@x Module 0; Lines 42 -- 42
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\def\title{Crudetype for {\mc MS-Dos } }
+@z
+
+@x Module 4; Lines 213 -- 213
+@d banner=='This is Crudetype, Version 3.01, copyright, experimental'
+@y
+@d banner=='This is Crudetype, Version 3.01, copyright, experimental MS-DOS'
+@z
+
+@x Module 5; Lines 234 -- 234
+ var @<Globals in the outer block@>
+@y
+ common @<Common variables@>
+ var @<Globals in the outer block@>
+@z
+
+@x Module 11; Lines 312 -- 312
+ i_word = -max_half-1 .. max_half ;
+@y
+ i_word = -max_half-1 .. max_half ;
+ var_str_type = string[100];
+@z
+
+@x Module 12; Lines 334 -- 334
+@d Q_string == packed array[ first..last:integer] of char
+@y
+@d Q_string == var_str_type
+@d first = 1
+@d last == length( ss)
+@z
+
+@x Module 14; Lines 360 -- 361
+@<Lowest...@>=
+ {Declare |parse_file|}
+@y
+@<Lowest...@>=
+ procedure parse_file( name: var_string; var dir, nam, ex: var_string) ;
+ var p,r,s: s_ptr ;
+ begin
+ dir := blank; nam := blank; ex := blank;
+ s := name.len ;
+ if ( s>0) then begin
+ p := s_search( name, '\', -s);
+ if ( p>0) then substring( dir, name, 1, p) ;
+ r := s_search( name, '.', -s);
+ if ( r>p) then substring( ex, name, r, s-r+1)
+ else r := s +1 ;
+ substring( nam, name, p+1, r-p-1) ;
+ end;
+ end;
+@z
+
+% Mess-DOS filenames
+% lower case file names, default to putting the .lpr file in the
+% same directory as the .dvi file
+@x Module 18; Lines 433 -- 435
+ be_string( '.DVI' ) ; dvi_def := buffer ;
+ be_string( 'TEX$FONTS:.TFM' ) ; tfm_def := buffer ;
+ be_string( 'TEX$GF:.&DGF' ) ; raster_def := buffer ;
+@y
+ be_string( '.DVI' ) ; dvi_def := buffer ;
+ be_string( 'TEX\FONTS\' ) ; tfm_def := buffer ;
+ be_string( 'TEX\GFDIR\.&DGF' ) ; raster_def := buffer ;
+@z
+
+@x Module 19; Lines 442 -- 443
+@<Lowest...@>=
+ {Declare |open_binary|}
+@y
+
+@d close_binary(#)== do_nothing ;
+
+@<Lowest...@>=
+ function open_binary (var f_f: byte_file; name: var_string ): boolean;
+ begin
+ if fstat( name.data) then
+ begin
+ assign (f_f, name.data);
+ reset( f_f) ;
+ open_binary := true
+ end
+ else
+ open_binary := false
+ end;
+@z
+
+@x Module 20; Lines 446 -- 446
+ rewrite(printfile) ;
+@y
+ if inspection then
+ assign(printfile, 'CON' )
+ else assign(printfile, print_name.data ) ;
+ rewrite(printfile ) ;
+@z
+
+@x Module 21; Lines 453 -- 455
+@d prefix == "/"
+@d got_cl == ( command.len > 0)
+@d read_command_line( #) == do_nothing
+@y
+@d prefix == "-"
+@d got_cl == ( command.len > 0)
+@d read_command_line( #) == getcomm( #)
+@z
+
+@x Module 22; Lines 468 -- 477
+@ Here are macros for the adaptable merge sort. See the section on sorting for
+explanation.
+
+@d image(#) == pool[#]
+@d create == incr(cell)
+@d link_type == page_i
+@d first_cell == cell := 0
+@d wipe_out(#) ==
+@d declare_pool == pool: array [page_i] of page_record;
+@d garbage == cell := zzz ;
+@y
+@ Here are macros for the adaptable merge sort. See the section on sorting for
+explanation. Pro-Pascal craps out on large arrays.
+
+@d image(#) == #^
+@d create == new(cell)
+@d first_cell == do_nothing
+@d link_type == ^page_record
+@d wipe_out(#) == dispose(#) ; { release data piecemeal}
+@d garbage == do_nothing
+@d declare_pool == do_nothing
+@z
+
+% Binary file types.
+@x Module 33; Lines 675 -- 676
+ @!byte_block=packed array [0..block_length-1] of byte ;
+ @!byte_file= packed file of byte_block;
+@y
+ @!byte_file= packed file of byte;
+@z
+
+@x Module 38; Lines 753 -- 758
+ read_byte := f_file^[f_indx] ;
+ incr(f_indx);
+ if f_indx =block_length then begin
+ get(f_file );
+ f_indx:=0;
+ end;
+@y
+ read_byte := f_file^ ;
+ incr(f_indx);
+ get(f_file );
+@z
+
+@x Module 38; Lines 768 -- 773
+ while( f_indx >= block_length) do
+ begin
+ if eof(f_file) then
+ warn('End of file' )
+ else get(f_file );
+ f_indx := f_indx - block_length ;
+@y
+ while( n > 0) do
+ begin
+ if eof(f_file) then
+ warn('End of file' )
+ else get(f_file );
+ decr(n) ;
+@z
+
+@x Module 98; Lines 1696 -- 1698
+@ @<Glob...@>=
+ ligatures : array[1..max_ligs] of lig_thing;
+ top_of_ligs: 0..max_ligs ; {highest used point in |ligatures|}
+@y
+@ @<Common...@>=
+ ligatures : array[1..max_ligs] of lig_thing;
+ top_of_ligs: 0..max_ligs ; {highest used point in |ligatures|}
+@z
diff --git a/dviware/crudetype/version3/rado.tex b/dviware/crudetype/version3/rado.tex
new file mode 100644
index 0000000000..cfccd49e46
--- /dev/null
+++ b/dviware/crudetype/version3/rado.tex
@@ -0,0 +1,64 @@
+%This is for the maths printer
+\magnification = \magstephalf
+\vsize=10 truein \hsize=170truemm
+\voffset=0truein \hoffset=0truecm
+
+\parskip = 1ex plus .5ex minus .1ex
+\parindent 3em
+\nopagenumbers
+
+\font\Byg = cmr10 at 17.28 truept
+\font\byg = cmr10 at 14.40 truept
+\font\menu = cmti10 at 10.00 truept
+\font\small = cmr10 at 10.00 truept
+\font\bold = cmb10
+\font\bcaps = cmssbx10
+\font\pfont = cmu10
+\font\tiny = cmr6 at 6 truept
+\def\pound{{\pfont \$}}
+
+\centerline{{\byg MA21}}
+\vskip .75 truein
+\centerline{{\bold Sheet Ten}}
+\vskip 0.2 truein
+{\menu (To be handed in to the box outside McCrea 232 on
+the morning of the first lecturing day of next Term i.e.{\bold
+Wednesday 13th January}).}
+\hfill\break
+\vfill
+\noindent
+(1) \quad Evaluate
+$$\int\limits_{y=0}^1dy\,\int\limits_{x=3y}^3 e^{x^2}dx.$$
+(Hint: first find the region over which the integral is taken, and then
+reverse the order of integration.)
+\hfill
+\bigskip
+\noindent
+(2) \quad Show that
+$$\int\!\!\!\int_Rxy^2 dx\,dy$$
+where $R$ is the smaller segment of the circle $x^2+y^2=a^2$ cut off by the
+line $x+y=a$ is equal to $\displaystyle{a^5\over 20}$.
+\bigskip
+\noindent
+(3) \quad Evaluate
+$$\int\!\!\!\int_Rxy dx\,dy$$
+where $R$ is the quadrant of the circle $x^2+y^2=a^2$ for which $x>0$, $y>0$.
+\hfill\break
+(Hint: use polar coordinates.)
+\hfill
+\bigskip
+\noindent
+(4) \quad Evaluate
+$$\int\!\!\!\int_Re^{-\left(x^2+y^2\right)}dx\,dy$$
+where $R$ is the infinite quadrant given by $x>0$, $y>0$, by substituting
+plane polar coordinates.
+\par
+Let $I=\int\limits _0^\infty e^{-x^2}dx$. Evaluate $I^2$. (Hint: remember
+that $\int\limits _0^\infty e^{-x^2}dx$ is equal to
+$\int\limits _0^\infty e^{-y^2}dy$, and use the result of the first part.)
+\par
+Hence show that
+$$\int_0^\infty e^{-x^2}dx={1\over 2}\sqrt\pi.$$
+\vfill
+\rightline{Peter Rado}
+\end
diff --git a/dviware/crudetype/version3/sample.tex b/dviware/crudetype/version3/sample.tex
new file mode 100644
index 0000000000..c8f5f53ad8
--- /dev/null
+++ b/dviware/crudetype/version3/sample.tex
@@ -0,0 +1,124 @@
+% SAMPLE.TEX. Original comes from Stanford tape
+
+
+\message{ !! For lineprinter, reduce magnification to 90 percent or so !! }
+
+\font \rom=cmr10
+\font \testfont=cmr10 % change this for another font
+
+
+\hsize 350pt \vsize 600pt
+\def\\{\vskip6pt}
+\hbox to 350pt{\hskip30pt
+\hbox to 40pt{\hfill\rom0\hfill}\ignorespaces
+\hbox to 40pt{\hfill\rom1\hfill}\ignorespaces
+\hbox to 40pt{\hfill\rom2\hfill}\ignorespaces
+\hbox to 40pt{\hfill\rom3\hfill}\ignorespaces
+\hbox to 40pt{\hfill\rom4\hfill}\ignorespaces
+\hbox to 40pt{\hfill\rom5\hfill}\ignorespaces
+\hbox to 40pt{\hfill\rom6\hfill}\ignorespaces
+\hbox to 40pt{\hfill\rom7\hfill}}
+\\
+\hbox to 350pt{\hskip30pt
+\vrule\hfill\vrule\hfill\vrule\hfill\vrule\hfill
+\vrule\hfill\vrule\hfill\vrule\hfill\vrule\hfill\vrule
+\hskip-320pt\vbox{\halign{\hbox to 0pt{\hskip-30pt\hfill\rom
+ \char'47 #\hfill}&\ignorespaces
+\hbox to 40pt{\hfill\testfont\char'#\hfill}&\ignorespaces
+\hbox to 40pt{\hfill\testfont\char'#\hfill}&\ignorespaces
+\hbox to 40pt{\hfill\testfont\char'#\hfill}&\ignorespaces
+\hbox to 40pt{\hfill\testfont\char'#\hfill}&\ignorespaces
+\hbox to 40pt{\hfill\testfont\char'#\hfill}&\ignorespaces
+\hbox to 40pt{\hfill\testfont\char'#\hfill}&\ignorespaces
+\hbox to 40pt{\hfill\testfont\char'#\hfill}&\ignorespaces
+\hbox to 40pt{\hfill\testfont\char'#\hfill}\cr\noalign{\hrule\\}
+000&000&001&002&003&004&005&006&007\cr\noalign{\\\hrule\\}
+010&010&011&012&013&014&015&016&017\cr\noalign{\\\hrule\\}
+020&020&021&022&023&024&025&026&027\cr\noalign{\\\hrule\\}
+030&030&031&032&033&034&035&036&037\cr\noalign{\\\hrule\\}
+040&040&041&042&043&044&045&046&047\cr\noalign{\\\hrule\\}
+050&050&051&052&053&054&055&056&057\cr\noalign{\\\hrule\\}
+060&060&061&062&063&064&065&066&067\cr\noalign{\\\hrule\\}
+070&070&071&072&073&074&075&076&077\cr\noalign{\\\hrule\\}
+100&100&101&102&103&104&105&106&107\cr\noalign{\\\hrule\\}
+110&110&111&112&113&114&115&116&117\cr\noalign{\\\hrule\\}
+120&120&121&122&123&124&125&126&127\cr\noalign{\\\hrule\\}
+130&130&131&132&133&134&135&136&137\cr\noalign{\\\hrule\\}
+140&140&141&142&143&144&145&146&147\cr\noalign{\\\hrule\\}
+150&150&151&152&153&154&155&156&157\cr\noalign{\\\hrule\\}
+160&160&161&162&163&164&165&166&167\cr\noalign{\\\hrule\\}
+170&170&171&172&173&174&175&176&177\cr}
+\\\hrule\vskip-.5pt}}
+\vskip 12pt\setbox0\vbox{\hbox{\testfont(}\vskip1.5pt}\baselineskip 1\ht0
+
+\testfont Mathematics books and journals do not look as beautiful as they
+used to. It is not that their mathematical content is unsatisfactory,
+rather that the old and well developed traditions of typesetting have
+become too expensive. Fortunately, it now appears that mathematics itself
+can be used to solve this problem, in spite of the fact that the first
+edition of \AE sop's \OE uvres is often na\"\i ve vis-\`a-vis the r\^ole
+of efficient co\hbox{\hskip .03em\"o}p\-er\-a\-tive ripping off of
+flawless souffl\'es. Mu\ss\ ich falle an d\ae mon diarrh\oe a zur\"uck?
+THE QUICK BROWN DOG JUMPED OVER 854.9176302 LAZY FOXES!
+
+\par\vfill\eject
+
+
+\font \testfont=cmtt10 % change this for another font
+
+
+\hsize 350pt \vsize 600pt
+\def\\{\vskip6pt}
+\hbox to 350pt{\hskip30pt
+\hbox to 40pt{\hfill\rom0\hfill}\ignorespaces
+\hbox to 40pt{\hfill\rom1\hfill}\ignorespaces
+\hbox to 40pt{\hfill\rom2\hfill}\ignorespaces
+\hbox to 40pt{\hfill\rom3\hfill}\ignorespaces
+\hbox to 40pt{\hfill\rom4\hfill}\ignorespaces
+\hbox to 40pt{\hfill\rom5\hfill}\ignorespaces
+\hbox to 40pt{\hfill\rom6\hfill}\ignorespaces
+\hbox to 40pt{\hfill\rom7\hfill}}
+\\
+\hbox to 350pt{\hskip30pt
+\vrule\hfill\vrule\hfill\vrule\hfill\vrule\hfill
+\vrule\hfill\vrule\hfill\vrule\hfill\vrule\hfill\vrule
+\hskip-320pt\vbox{\halign{\hbox to 0pt{\hskip-30pt\hfill\rom
+ \char'47 #\hfill}&\ignorespaces
+\hbox to 40pt{\hfill\testfont\char'#\hfill}&\ignorespaces
+\hbox to 40pt{\hfill\testfont\char'#\hfill}&\ignorespaces
+\hbox to 40pt{\hfill\testfont\char'#\hfill}&\ignorespaces
+\hbox to 40pt{\hfill\testfont\char'#\hfill}&\ignorespaces
+\hbox to 40pt{\hfill\testfont\char'#\hfill}&\ignorespaces
+\hbox to 40pt{\hfill\testfont\char'#\hfill}&\ignorespaces
+\hbox to 40pt{\hfill\testfont\char'#\hfill}&\ignorespaces
+\hbox to 40pt{\hfill\testfont\char'#\hfill}\cr\noalign{\hrule\\}
+000&000&001&002&003&004&005&006&007\cr\noalign{\\\hrule\\}
+010&010&011&012&013&014&015&016&017\cr\noalign{\\\hrule\\}
+020&020&021&022&023&024&025&026&027\cr\noalign{\\\hrule\\}
+030&030&031&032&033&034&035&036&037\cr\noalign{\\\hrule\\}
+040&040&041&042&043&044&045&046&047\cr\noalign{\\\hrule\\}
+050&050&051&052&053&054&055&056&057\cr\noalign{\\\hrule\\}
+060&060&061&062&063&064&065&066&067\cr\noalign{\\\hrule\\}
+070&070&071&072&073&074&075&076&077\cr\noalign{\\\hrule\\}
+100&100&101&102&103&104&105&106&107\cr\noalign{\\\hrule\\}
+110&110&111&112&113&114&115&116&117\cr\noalign{\\\hrule\\}
+120&120&121&122&123&124&125&126&127\cr\noalign{\\\hrule\\}
+130&130&131&132&133&134&135&136&137\cr\noalign{\\\hrule\\}
+140&140&141&142&143&144&145&146&147\cr\noalign{\\\hrule\\}
+150&150&151&152&153&154&155&156&157\cr\noalign{\\\hrule\\}
+160&160&161&162&163&164&165&166&167\cr\noalign{\\\hrule\\}
+170&170&171&172&173&174&175&176&177\cr}
+\\\hrule\vskip-.5pt}}
+\vskip 12pt\setbox0\vbox{\hbox{\testfont(}\vskip1.5pt}\baselineskip 1\ht0
+
+\testfont Mathematics books and journals do not look as beautiful as they
+used to. It is not that their mathematical content is unsatisfactory,
+rather that the old and well developed traditions of typesetting have
+become too expensive. Fortunately, it now appears that mathematics itself
+can be used to solve this problem, in spite of the fact that the first
+edition of \AE sop's \OE uvres is often na\"\i ve vis-\`a-vis the r\^ole
+of efficient co\hbox{\hskip .03em\"o}p\-er\-a\-tive ripping off of
+flawless souffl\'es. Mu\ss\ ich falle an d\ae mon diarrh\oe a zur\"uck?
+THE QUICK BROWN DOG JUMPED OVER 854.9176302 LAZY FOXES!
+
+\bye
diff --git a/dviware/crudetype/version3/small.tex b/dviware/crudetype/version3/small.tex
new file mode 100644
index 0000000000..41badd1a16
--- /dev/null
+++ b/dviware/crudetype/version3/small.tex
@@ -0,0 +1,65 @@
+\input webmac
+% ADAPTED from DVITYPE, version 2.6.
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\indent\ignorespaces}
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like PASCAL
+\def\PASCAL{{\mc PASCAL}}
+
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index
+
+\def\title{Crudetype}
+\def\contentspagenumber{1}
+\def\topofcontents{\null
+ \def\titlepage{F} % include headline on the contents page
+ \def\rheader{\mainfont\hfil \contentspagenumber}
+ \vfill
+ \centerline{\titlefont Crudetype}
+ \vskip 15pt
+ \centerline{An adaptable device driver (Version 0, 1986)}
+ \vfill}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+
+% These macros for verbatim scanning are Copied from MANMAC.TEX. But we cant
+% use the vertical bar for a temporary escape character as WEAVE catches it.
+% So we will use ! instead and hope for the best
+\chardef\other=12
+\def\ttverbatim{\begingroup
+ \catcode`\\=\other \catcode`\{=\other \catcode`\}=\other \catcode`\$=%
+\other
+ \catcode`\&=\other \catcode`\#=\other \catcode`\%=\other \catcode`\~=%
+\other
+ \catcode`\_=\other \catcode`\^=\other
+ \obeyspaces \obeylines \tt}
+
+\outer\def\begintt{$$\let\par=\endgraf \ttverbatim \parskip=0pt
+ \catcode`\!=0 \rightskip-5pc \ttfinish}
+{\catcode`\!=0 !catcode`!\=\other % ! is temporary escape character
+ !obeylines % end of line is active
+ !gdef!ttfinish#1^^M#2\endtt{#1!vbox{#2}!endgroup$$}}
+
+
+
+\M133. Clearly, \\{alphabet} will only cover a very
+small part of the problem.
+The
+next procedure enters data into a subset of the \\{codes} array corresponding
+to
+a single row of a \TeX\ font. In the standard font tables, row number \|m is
+the subrange $8\ast\|m\to8\ast\|m+7$ of a font. It is hoped that when the calls
+of
+procedure \\{row} are written out in a program, the result will be (just about)
+legible, whereas a string of statements like \par\qquad
+$\\{codes}[\|i,\|j].\\{font}\K\\{something}$\par
+is certainly not legible.
+
+The parameters are: \item
+\\{row\_spec} specifies what characters are to go into the row.
+\\{scheme}= number assigned to the \TeX\ coding scheme within the program,\item
+\\{row\_num}= number of the row in that scheme. (starting from 0),\item
+\\{font} = initial printer font, \par
+
+\Y\P$\4\X50:Medium level procedures\X\mathrel{+}\S$\6
diff --git a/dviware/crudetype/version3/tables.tex b/dviware/crudetype/version3/tables.tex
new file mode 100644
index 0000000000..ac4a404461
--- /dev/null
+++ b/dviware/crudetype/version3/tables.tex
@@ -0,0 +1,202 @@
+% These macros cribbed from the macros for The TeXbook
+%
+%
+
+\newcount\charno
+\font\tentex=cmtex10
+\font\amssy=msym10
+\font\bigtenex=cmex10 scaled\magstep1
+\font\bigfiv=cmr5 scaled\magstep5
+\postdisplaypenalty=0
+\def\oct#1{\hbox{\rm\'{}\kern-.2em\it#1\/\kern.05em}} % octal constant
+\def\hex#1{\hbox{\rm\H{}\tt#1}} % hexadecimal constant
+
+% macros for font tables
+\def\oddline#1{\cr
+ \noalign{\nointerlineskip}
+ \multispan{19}\hrulefill&
+ \setbox0=\hbox{\lower 2.3pt\hbox{\hex{#1x}}}\smash{\box0}\cr
+ \noalign{\nointerlineskip}}
+\def\evenline{\cr\noalign{\hrule}}
+\def\chartstrut{\lower4.5pt\vbox to14pt{}}
+\def\beginchart#1{$$ \global\charno=0 #1
+ \halign to\hsize\bgroup
+ \chartstrut##\tabskip0pt plus10pt&
+ &\hfil##\hfil&\vrule##\cr
+ \lower6.5pt\null
+ &&&\oct0&&\oct1&&\oct2&&\oct3&&\oct4&&\oct5&&\oct6&&\oct7&\evenline}
+\def\endchart{\raise11.5pt\null&&&\hex 8&&\hex 9&&\hex A&&\hex B&
+ &\hex C&&\hex D&&\hex E&&\hex F&\cr\egroup$$}
+\def\:{\setbox0=\hbox{\char\charno}%
+ \ifdim\ht0>7.5pt\reposition
+ \else\ifdim\dp0>2.5pt\reposition\fi\fi
+ \box0\global\advance\charno by1 }
+\def\reposition{\setbox0=\hbox{$\vcenter{\kern2pt\box0\kern2pt}$}}
+\def\normalchart{%
+ &\oct{00x}&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\oddline0
+ &\oct{01x}&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\:&\evenline
+ &\oct{02x}&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\oddline1
+ &\oct{03x}&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\:&\evenline
+ &\oct{04x}&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\oddline2
+ &\oct{05x}&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\:&\evenline
+ &\oct{06x}&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\oddline3
+ &\oct{07x}&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\:&\evenline
+ &\oct{10x}&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\oddline4
+ &\oct{11x}&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\:&\evenline
+ &\oct{12x}&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\oddline5
+ &\oct{13x}&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\:&\evenline
+ &\oct{14x}&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\oddline6
+ &\oct{15x}&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\:&\evenline
+ &\oct{16x}&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\oddline7
+ &\oct{17x}&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\:&\evenline}
+
+
+
+\medskip\vfill
+\noindent {\bf Figure 1.\enspace}
+\rm
+Here is a chart that shows ASCII codes in such a way that octal and
+hexadecimal equivalents can easily be read off:
+\beginchart{\global\charno='41\tentt
+ \def\chartstrut{\lower4.3pt\vbox to13.6pt{}}}
+&\oct{00x}&&NUL&&SOH&&STX&&ETX&&EOT&&ENQ&&ACK&&BEL&&\oddline0
+&\oct{01x}&&BS&&HT&&LF&&VT&&FF&&CR&&SO&&SI&\evenline
+&\oct{02x}&&DLE&&DC1&&DC2&&DC3&&DC4&&NAK&&SYN&&ETB&&\oddline1
+&\oct{03x}&&CAN&&EM&&SUB&&ESC&&FS&&GS&&RS&&US&\evenline
+&\oct{04x}&&SP&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\oddline2
+&\oct{05x}&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\:&\evenline
+&\oct{06x}&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\oddline3
+&\oct{07x}&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\:&\evenline
+&\oct{10x}&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\oddline4
+&\oct{11x}&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\:&\evenline
+&\oct{12x}&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\oddline5
+&\oct{13x}&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\:&\evenline
+&\oct{14x}&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\oddline6
+&\oct{15x}&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\:&\evenline
+&\oct{16x}&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\oddline7
+&\oct{17x}&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&DEL&\evenline
+\endchart
+\vfill
+
+
+\medskip\vfill
+\noindent {\bf Figure 2.\enspace}
+this chart shows how to address ASCII controls using the up-arrow:
+\beginchart{\def\?{\char`^\char`^\:}\global\charno='100 \tentt}
+&\oct{00x}&&\?&&\?&&\?&&\?&&\?&&\?&&\?&&\?&&\oddline0
+&\oct{01x}&&\?&&\?&&\?&&\?&&\?&&\?&&\?&&\?&\evenline
+&\oct{02x}&&\?&&\?&&\?&&\?&&\?&&\?&&\?&&\?&&\oddline1
+&\oct{03x}&&\?&&\?&&\?&&\?&&\?&&\?&&\?&&\?&\evenline
+&\global\charno='40
+\oct{04x}&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\oddline2
+&\oct{05x}&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\:&\evenline
+&\oct{06x}&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\oddline3
+&\oct{07x}&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\:&\evenline
+&\oct{10x}&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\oddline4
+&\oct{11x}&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\:&\evenline
+&\oct{12x}&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\oddline5
+&\oct{13x}&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\:&\evenline
+&\oct{14x}&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\oddline6
+&\oct{15x}&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\:&\evenline
+&\oct{16x}&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\oddline7
+&\oct{17x}&&\:&&\:&&\:&&\:&&\:&&\:&&\:&&\char`^\char`^?&\evenline
+\endchart
+\vfill
+
+\noindent {\bf Figure 3.\enspace}The
+extended character codes for luxury keyboards:
+\beginchart\tentex
+\normalchart
+\endchart
+\vfill
+
+
+
+
+\medskip\vfill
+\noindent {\bf Figure 4.\enspace}Text roman font layout,
+showing |cmr10|
+\beginchart\tenrm
+\normalchart
+\endchart
+\vfill
+
+
+\medskip\vfill
+\noindent {\bf Figure 5.\enspace}Text roman font layout, without F-Ligatures
+showing |cmr5|
+\beginchart\fiverm
+\normalchart
+\endchart
+\vfill
+
+
+
+\medskip\vfill
+\noindent {\bf Figure 6.\enspace}Text roman font layout, without F-Ligatures
+showing |cmr5| magnified so I can read it
+\beginchart\bigfiv
+\normalchart
+\endchart
+\vfill
+
+
+\medskip\vfill
+\noindent {\bf Figure 7.\enspace}Text italic font layout,
+showing |cmti10|
+\beginchart\tenit
+\normalchart
+\endchart
+\vfill
+
+\medskip\vfill
+\noindent {\bf Figure 8.\enspace} Math italic font layout,
+showing |cmmi10|
+\beginchart\teni
+\normalchart
+\endchart
+\vfill
+
+
+\medskip\vfill
+\noindent {\bf Figure 9.\enspace}Typewriter text font layout,
+showing |cmtt10|
+\beginchart\tentt
+\normalchart
+\endchart
+\vfill
+
+
+\medskip\vfil
+\noindent {\bf Figure 10.\enspace}Math symbol font layout,
+showing |cmsy10|
+\beginchart\tensy
+\normalchart
+\endchart
+\vfill
+\medskip\vfil
+
+\noindent {\bf Figure 10.\enspace}AMS symbol font layout,
+showing |msym10|
+\beginchart\amssy
+\normalchart
+\endchart
+\vfill
+
+\medskip\vfil
+\noindent {\bf Figure 11.\enspace} {Math extension font} layout,
+showing |cmex10|
+\beginchart\tenex
+\normalchart
+\endchart
+\vfill
+
+\medskip\vfil
+\noindent {\bf Figure 11.\enspace} {Math extension font} layout,
+showing |cmex10| scaled up
+\beginchart\bigtenex
+\normalchart
+\endchart
+\vfill
+
+\bye
diff --git a/dviware/crudetype/version3/tiny.dmp b/dviware/crudetype/version3/tiny.dmp
new file mode 100644
index 0000000000..1845534812
--- /dev/null
+++ b/dviware/crudetype/version3/tiny.dmp
@@ -0,0 +1,77 @@
+
+Dump of file UHAH:[208.CRUDE]TINY.HPL;5 on 19-DEC-1990 10:50:36.21
+File ID (6490,8,0) End of file block 3 / Allocated 3
+
+Record number 1 (00000001), 7 (0007) bytes
+
+ 4F306C 261B451B .E.&l0O......................... 000000
+
+Record number 2 (00000002), 193 (00C1) bytes
+
+ 002C001E 00000001 001A0057 36327329 1B443963 2A1B5830 702A1B59 30702A1B .*p0Y.*p0X.*c9D.)s26W.........,. 000000
+ 38323173 281B4534 38632A1B 4439632A 1B000000 00000000 00000015 0101002A *...............*c9D.*c84E.(s128 000020
+ 010F70C0 030F78C0 FFFF7FC0 FFFF7F78 001C001B 001B0001 00000001 0E000457 W...............x...À...Àx..Àp.. 000040
+ 000F0000 000F0060 000FC060 000FC060 000FC060 000FC0E0 000FE0C0 000F60C0 À`..Àà..àÀ..`À..`À..`À..`....... 000060
+ 000F0000 000F0000 000F0000 000F0000 000F0000 000F0000 000F0000 000F0000 ................................ 000080
+ FCFF0300 FCFF0300 000F0000 000F0000 000F0000 000F0000 000F0000 000F0000 ...........................ü...ü 0000A0
+ 00 ................................ 0000C0
+
+Record number 3 (00000003), 118 (0076) bytes
+
+ 1C001800 1B000200 0000010E 00045730 30317328 1B453936 632A1B44 39632A1B .*c9D.*c69E.(s100W.............. 000000
+ 06030F06 030F0603 0F06000F 0E000F0C 000F1C00 0F7C000F FCFFFFFC FFFF7000 .p..ü..ü..|..................... 000020
+ 000F0300 0F03030F 03030F00 030F0003 0F00070F 00FF0F00 FF0F0007 0F00030F ................................ 000040
+ FCFF FFFCFFFF 7C000F1E 000F0E00 0F06000F 06000F06 ...............|..ü..ü.......... 000060
+
+Record number 4 (00000004), 146 (0092) bytes
+
+ 1C001C00 1B000100 0000010E 00045738 32317328 1B453838 632A1B44 39632A1B .*c9D.*c88E.(s128W.............. 000000
+ F0000060 F0010070 E0010030 E0030038 C003007E C007C0FF F07FC0FF F07F7C00 .|.ð.À.ð.À.À~..À8..à0..àp..ð`..ð 000020
+ 1F000080 0F000000 0F000000 1F000000 1F000000 3F000080 7D0000C0 790000C0 À..yÀ..}...?.................... 000040
+ 0003007C 80010078 C00100F8 C00000F0 610000E0 710000E0 330000C0 3B000080 ...;À..3à..qà..að..Àø..Àx...|... 000060
+ F0FF E0FFF0FF E0FF001F 800F001E 0007003C <..........à.ð.à.ð.............. 000080
+
+Record number 5 (00000005), 100 (0064) bytes
+
+ 00000000 15010100 16001B00 0F000000 01001A00 57363273 291B4430 31632A1B .*c10D.)s26W.................... 000000
+ 02000000 010E0004 57343473 281B4535 36632A1B 44303163 2A1B0000 00000000 .......*c10D.*c65E.(s44W........ 000020
+ 3818F81F F81F700C 700CF00E E006E006 C003C003 C0038001 50000E00 10000D00 .......P...À.À.À.à.à.ð.p.p.ø.ø.8 000040
+ 7FFC7FFC ü.ü............................. 000060
+
+Record number 6 (00000006), 62 (003E) bytes
+
+ 0E000F00 0D000200 0000010E 00045734 3473281B 45363663 2A1B4430 31632A1B .*c10D.*c66E.(s44W.............. 000000
+ F0FF FCFF1E38 0E380E38 0E383C38 F03F3838 1C381C38 3C38F8FF E0FF4C00 .L.à.ø8<8.8.88?ð8<8.8.8.8..ü.ð.. 000020
+
+Record number 7 (00000007), 62 (003E) bytes
+
+ 0E001000 0D000200 0000010E 00045734 3473281B 45373663 2A1B4430 31632A1B .*c10D.*c67E.(s44W.............. 000000
+ F807 FE1F0F3E 077803F0 00E000E0 00E000E0 03F00778 0F3EFF1F FB075000 .P.û..>.x.ð.à.à.à.à.ð.x.>..þ.ø.. 000020
+
+Record number 8 (00000008), 76 (004C) bytes
+
+ 0E001100 0D000200 0000010E 00045738 3573281B 45383663 2A1B4430 31632A1B .*c10D.*c68E.(s58W.............. 000000
+ 00033880 03388003 38800338 80033800 03380007 38001E38 00FCFF00 F0FF5400 .T.ð..ü.8..8..8..8..8..8..8..8.. 000020
+ 00F0FF00 FCFF000E 38000738 8..8...ü..ð..................... 000040
+
+Record number 9 (00000009), 62 (003E) bytes
+
+ 0E000F00 0D000200 0000010E 00045734 3473281B 45393663 2A1B4430 31632A1B .*c10D.*c69E.(s44W.............. 000000
+ FCFF FCFF1C38 0C386638 6638E63F E03F6638 66380E38 1C38FCFF FCFF4C00 .L.ü.ü8.8.8f8f?à?æ8f8f8.8..ü.ü.. 000020
+
+Dump of file UHAH:[208.CRUDE]TINY.HPL;5 on 19-DEC-1990 10:50:36.21
+File ID (6490,8,0) End of file block 3 / Allocated 3
+
+Record number 10 (0000000A), 87 (0057) bytes
+
+ 001B000D 001A0004 00000001 0E000457 30377328 1B453934 632A1B44 39632A1B .*c9D.*c49E.(s70W............... 000000
+ 07800780 07800780 07800780 07800780 07800780 0780C780 FF803F80 03800154 T....?...Ç...................... 000020
+ F8FFF8 FF800780 07800780 07800780 07800780 07800780 ....................ø.ø......... 000040
+
+Record number 11 (0000000B), 133 (0085) bytes
+
+ 1B593035 33702A1B 5830702A 1B545839 281B5833 3833702A 1B593234 33702A1B .*p342Y.*p383X.(9XT.*p0X.*p350Y. 000000
+ 39323470 2A1B5932 3433702A 1B593234 33702A1B 5830702A 1B455836 3034702A *p406XE.*p0X.*p342Y.*p342Y.*p429 000020
+ 1B454443 42415833 3835702A 1B454443 42415830 31281B58 34373470 2A1B5858 XX.*p474X.(10XABCDE.*p583XABCDE. 000040
+ 451B5830 702A1B31 5839281B 58353632 31702A1B 59303730 33702A1B 5830702A *p0X.*p3070Y.*p1265X.(9X1.*p0X.E 000060
+ 4F 306C261B .&l0O........................... 000080
diff --git a/dviware/crudetype/version3/tiny.tex b/dviware/crudetype/version3/tiny.tex
new file mode 100644
index 0000000000..df397558c4
--- /dev/null
+++ b/dviware/crudetype/version3/tiny.tex
@@ -0,0 +1,5 @@
+\font \try=cmr5
+\TeX\
+\try
+ABCDE ABCDE
+\bye
diff --git a/dviware/crudetype/version3/unix-c.ch b/dviware/crudetype/version3/unix-c.ch
new file mode 100644
index 0000000000..1ae4a3a6f7
--- /dev/null
+++ b/dviware/crudetype/version3/unix-c.ch
@@ -0,0 +1,564 @@
+% unix-c.ch -*-mode: change; webfile: crudetype.web version 3.01;-*-
+% UNIX changes by Peter King for Berkeley Pascal
+% modified by RMD for Crudetype version 2 and 3
+%
+% COPYRIGHT ( C ) P.King, Heriot-Watt University, 1988.
+%
+% Permission is given to any person to make and distribute copies of this
+% software, subject to the following conditions:
+%
+% 1. All copies of the software must carry an exact copy of this notice.
+%
+% 2. This software is distributed free of charge, "AS IS" with absolutely no
+% guarantee of performance. Any persons receiving or using this software must do
+% so entirely at their own risk. Neither the authors nor their institutions
+% accept any liability for any defects of this software, or for any consequential
+% loss or damage however caused.
+%
+% 3. Any person who changes this software must clearly mark it as modified and
+% add a note describing the changes made.
+
+
+% [0] WEAVE: print changes only
+@x Module 0; Lines 42 -- 42
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\def\title{Crudetype for {\mc UNIX } }
+@z
+
+@x Module 4; Lines 213 -- 213
+@d banner=='This is Crudetype, Version 3.01, copyright, experimental'
+@y
+@d banner=='This is Crudetype, Version 3.01, copyright, experimental WEB2C'
+@z
+
+@x Module 6; Lines 242 -- 242
+ @<Set initial values@>
+@y
+ @<Set initial values@>
+ setpaths(TFMFILEPATHBIT+TEXINPUTPATHBIT); { set up the correct search path for fonts }
+ wl_feed_dist := 1 ;
+ wl_does_cr := true ;
+@z
+
+% add variables for runtime arguments, and to suppress all the non-error
+% information messages
+% use_stdin is not yet used, but is a handle for an extension to read from
+% input ( a UNIX pipe )
+% The filenames used by |test_access| are added here.
+@x Module 7; Lines 253 -- 253
+ in_i, in_j :integer; {loop index for initializations}
+@y
+ in_i, in_j :integer; {loop index for initializations}
+ use_stdin : boolean; { read from standard input }
+@z
+
+@x Module 9; Lines 281 -- 281
+ if ( u<0) then goto exit ;
+@y
+ if ( u<0) then @= uexit(1) @> ;
+@z
+
+% Change the types
+@x Module 11; Lines 310 -- 312
+@<Types...@>=
+ byte = 0..255 ;
+ i_word = -max_half-1 .. max_half ;
+@y
+@<Types...@>=
+ byte = 0..255 ;
+ bite = -128..127 ; { signed ! }
+ i_word = -max_half-1..max_half ;
+@z
+
+@x Module 12; Lines 330 -- 336
+the macros and constants defined here. See various change files for examples.
+
+@d zchr == chr
+@d zord == ord
+@d Q_string == packed array[ first..last:integer] of char
+@d be_string(#) == set_string( #, buffer)
+@d set_j_to_length == j := last
+@y
+the macros and constants defined here.
+
+Here we have to allow for the difference between Pascal strings (which start with
+index 1) and C strings (index 0). The argument passed to |set_string| is a quoted
+string constant, so it is a C string.
+
+@d zchr == chr
+@d zord == ord
+@d Q_string == ccharpointer
+@d first = 0
+@d last == max_string
+@d be_string(#) == set_string( #, buffer)
+@d set_j_to_length == j := strlen( ss) -1
+@z
+
+@x Module 14; Lines 361 -- 361
+ {Declare |parse_file|}
+@y
+ procedure parse_file( name: var_string; var dir, nam, ex: var_string) ;
+ var p,r,s: s_ptr ;
+ begin
+ dir := blank; nam := blank; ex := blank;
+ s := name.len ;
+ if ( s>0) then begin
+ p := s_search( name, '/', -s);
+ if ( p>0) then substring( dir, name, 1, p) ;
+ r := s_search( name, '.', -s);
+ if ( r>p) then substring( ex, name, r, s-r+1)
+ else r := s +1 ;
+ substring( nam, name, p+1, r-p-1) ;
+ end;
+ end;
+@z
+
+@x Module 16; Lines 408 -- 408
+@d print_ln ==write_ln(printfile )
+@y
+@d print_ln == write_ln(printfile );
+ if inspection then flush(printfile )
+@z
+
+% Changes to incorporate UNIX conventions
+% lower case file names, default to putting the .lpr file in the
+% same directory as the .dvi file
+@x Module 18; Lines 429 -- 436
+@d block_length = 512
+@d same_dir == false
+
+@<Set init...@>=
+ be_string( '.DVI' ) ; dvi_def := buffer ;
+ be_string( 'TEX$FONTS:.TFM' ) ; tfm_def := buffer ;
+ be_string( 'TEX$GF:.&DGF' ) ; raster_def := buffer ;
+ be_string( '.PRI' ) ; print_ex := buffer ;
+@y
+
+The Unix version of \.{Crudetype} uses ``paths''.
+
+@d block_length = 1
+@d same_dir == true
+
+@<Set init...@>=
+ be_string( '.dvi'); dvi_def := buffer ;
+ be_string( '/tex/fonts/.tfm') ; tfm_def := buffer ;
+ be_string( '/tex/gfdir/.&Dgf' ) ; raster_def := buffer ;
+ be_string ( '.lpr' ) ; print_ex := buffer ;
+@z
+
+% More of the UNIX simple minded view of files.
+% but including the (optional) directory search for .tfm files
+@x Module 19; Lines 442 -- 443
+@<Lowest...@>=
+ {Declare |open_binary|}
+@y
+@d read_access_mode=4 {``read'' mode for |test_access|}
+@d write_access_mode=2 {``write'' mode for |test_access|}
+@d default == xwzdefault {|default| is reserved in C}
+@d fortran == xwzfortran {and apparently so is |fortran|}
+
+@d close_binary(#)== do_nothing ;
+
+@<Lowest...@>=
+ function open_binary (var f_f: byte_file; var name: var_string;
+ search_path: integer ): boolean;
+ var cur_name: ccharpointer ;
+ begin
+ cur_name := name.data ;
+ if test_read_access(cur_name, search_path) then
+ begin
+ reset(f_f, cur_name);
+ open_binary := true
+ end
+ else
+ open_binary := false
+ end;
+@z
+
+@x Module 20; Lines 445 -- 446
+@ @<Open |printfile|@>=
+ rewrite(printfile) ;
+@y
+@ @<Open |printfile|@>=
+ if inspection then begin
+ be_string ('/dev/tty') ;
+ print_name := buffer ;
+ end ;
+ rewrite(printfile, print_name.data ) ;
+@z
+
+@x Module 21; Lines 452 -- 466
+@d get_val( #) == # := s_to_i( #, true)
+@d prefix == "/"
+@d got_cl == ( command.len > 0)
+@d read_command_line( #) == do_nothing
+
+@<Lowest...@>=
+ {Declare |read_command_line| }
+@#
+ procedure get_command ;
+ var ss: fix_string ;
+ begin
+ ss := blank.data ;
+ read_command_line( ss) ;
+ be_string( ss ) ; command := buffer ;
+ end;
+@y
+
+Unix \P\ does not supply a command line; instead it chops it up and supplies
+the pieces using two predeclared procedures |argc| and |argv|. It seemed to me
+that the least messy way to fit this onto the rest of the program is to
+re-assemble the command line.
+
+@d get_val( #) == # := s_to_i( #, true)
+@d prefix == "-"
+@d got_cl == ( argc > 1)
+@d read_command_line( #) == do_nothing
+
+@<Lowest...@>=
+ procedure get_command ;
+ var ss: fix_string ; nn: integer ; tt: var_string ;
+ cc: ccharpointer ;
+ begin
+ command := blank ;
+ for nn := 1 to argc-1 do begin
+ argv( nn, ss) ;
+ cc := ss ;
+ incr(cc);
+ be_string( cc ) ; tt := buffer ;
+ append( command, tt) ;
+ incr( command.len) ;
+ end;
+ end;
+@z
+
+@x Module 27; Lines 560 -- 572
+@ If there was no command line, try to send messages to the user at a
+terminal. This requires nonstandard \PASCAL\ constructions to handle the
+online interaction. So it may be necessary on some systems to omit the dialog.
+First, the \.{DVI} file name.
+
+@<Get \.{DVI} file name and open it@>=
+ if can_interact and ( dvi_name.len = 0) then repeat
+ ask_prompt('DVI file name? ') ;
+ get_name( dvi_name) ;
+ until ( dvi_name.len > 0) ;
+ if not open_and_ask(dvi_file, dvi_indx, dvi_name, dvi_def, true)
+ then abort('Couldnt open DVI file')
+ @.Fatal: Couldnt open@>
+@y
+@ If there was no command line, try to send messages to the user at a
+terminal. This requires nonstandard \PASCAL\ constructions to handle the
+online interaction. So it may be necessary on some systems to omit the dialog.
+First, the (\.{DVI}) file name. This part is altered to use Unix style path
+searching.
+
+@<Get \.{DVI} file name and open it@>=
+ if can_interact and ( dvi_name.len = 0) then repeat
+ ask_prompt('DVI file name? ') ;
+ get_name( dvi_name) ;
+ until ( dvi_name.len > 0) ;
+ dvi_indx := TEX_INPUT_PATH ;
+ if not open_and_ask(dvi_file, dvi_indx, dvi_name, dvi_def, true)
+ then abort('couldnt open DVI file')
+ @.Fatal: couldnt open@> @.Opening DVI file@>
+@z
+
+@x Module 28; Lines 574 -- 577
+@ But when we come to open a font file, we merely report a failure:
+
+@<Open font file@>=
+ font_ok := open_and_ask (tfm_file, tfm_indx, tfm_name, tfm_def, true) ;
+@y
+@ When we try to open a font file, we search the path specified by the user's
+environment variable before we report a failure:
+
+@<Open font file@>=
+ tfm_indx := TFM_FILE_PATH ;
+ font_ok := open_and_ask (tfm_file, tfm_indx, tfm_name, tfm_def, true) ;
+@z
+
+@x Module 30; Lines 631 -- 631
+ begin incr(k); buffer.data[k]:=term_in^; get(term_in);
+@y
+ begin incr(k); read( term_in, buffer.data[k]) ;
+@z
+
+% Binary file handling
+@x Module 33; Lines 661 -- 671
+The main input file is the \.{DVI} file. Logically, this is just a stream of
+8-bit bytes, with no record or block structure. However VMS \PASCAL\
+apparently cannot handle files of this type; so I have adopted the blocking
+scheme (due to D.R.Fuchs) from the VMS \.{DVItype} change file. But a lot of
+the code has been rewritten. Some other operating systems use similar
+blocking schemes; so this code may possibly work without much change. The
+program deals with two binary file variables: |@!dvi_file| is the main input
+file that we are printing, and |@!tfm_file| the current font metric file from
+which character-width information is being read. Each of these has a name and
+a counter, declared here; also a default name (system dependent, and so
+declared previously).
+@y
+The main input file is the \.{DVI} file. Logically, this is just a stream of
+8-bit bytes, with no record or block structure. UNIX \PASCAL\ can happily
+handle these, except that it treats each byte as a signed quantity, so we do
+some fudging to make them unsigned. The program deals with two binary file
+variables: |@!dvi_file| is the main input file that we are printing, and
+|@!tfm_file| the current font metric file from which character-width
+information is being read. Each of these has a name declared here.
+@z
+
+% Binary file types
+@x Module 33; Lines 675 -- 676
+ @!byte_block=packed array [0..block_length-1] of byte ;
+ @!byte_file= packed file of byte_block;
+@y
+ @!byte_file= file of bite;
+@z
+
+% Open_and_ask must pass the search path into open_binary
+@x Module 35; Lines 701 -- 701
+ success := open_binary(f_f, name ) ;
+@y
+ success := open_binary(f_f, name, f_c ) ;
+@z
+
+% P. King deleted all the VMS indx stuff, since all the files are (logically)
+% read one character at a time. I have re-instated it because it is very
+% useful when debugging.
+%
+@x Module 38; Lines 745 -- 776
+@d get_real(#) == read_real(# @& file, # @& indx)
+
+@<Lowest...@>=
+ function read_byte(var f_file: byte_file; var f_indx: integer) : byte;
+ begin
+ if eof(f_file) then
+ warn('End of file' )
+ else begin
+ read_byte := f_file^[f_indx] ;
+ incr(f_indx);
+ if f_indx =block_length then begin
+ get(f_file );
+ f_indx:=0;
+ end;
+ end;
+ end ;
+
+@#
+ procedure skip_bytes(var f_file: byte_file; var f_indx: integer; n:integer);
+ {discard n bytes from |f_file|}
+ begin
+ if n < 0 then abort('Skip_bytes called with negative number');
+ f_indx := f_indx + n;
+ while( f_indx >= block_length) do
+ begin
+ if eof(f_file) then
+ warn('End of file' )
+ else get(f_file );
+ f_indx := f_indx - block_length ;
+ end ;
+ end;
+ @.Error: End of file@> @.Fatal: Skip_bytes...@>
+@y
+@d read_real == rr_read_real {|read_real| is Unix \Pascal\ procedure}
+@d get_real(#) == read_real(# @& file, # @& indx)
+
+@<Lowest...@>=
+ function read_byte(var f_file: byte_file; var f_indx: integer) : byte;
+ var x:bite;
+ begin
+ if eof(f_file) then begin
+ warn('End of file' ) ;
+ read_byte := 0 ; { return some value }
+ end
+ else begin
+ read(f_file,x);
+ if x < 0 then read_byte := x + 256
+ else read_byte := x ;
+ incr(f_indx);
+ end;
+ end;
+
+@#
+ procedure skip_bytes(var f_file: byte_file; var f_indx: integer; n:integer);
+ {discard n bytes from |f_file|}
+ var k:integer;
+ x:bite;
+ begin
+ if n < 0 then abort('skip_bytes called with negative number');
+ f_indx := f_indx + n;
+ for k:=1 to n do
+ begin
+ if eof(f_file) then
+ warn('End of file' )
+ else read(f_file, x );
+ end ;
+ end;
+ @.Error: End of file@> @.Fatal: Skip_bytes...@>
+@z
+
+% SIGH!! variant records
+@x Module 88; Lines 1543 -- 1549
+ code_object = packed record
+ breadth: i_word ;
+ case boolean of
+ true: (IM_font: byte ; IM_char: byte );
+ {Printers font and character}
+ false: (multi: i_word) ;
+ end;
+@y
+ code_object = packed record
+ breadth: i_word ;
+ IM_font: byte ;
+ IM_char: byte;
+ {Printers font and character}
+ multi: i_word ;
+ end;
+@z
+
+@x Module 99; Lines 1701 -- 1709
+ trio = 1..3 ;
+ lig_thing = packed record
+ case trio of
+ 1: (v_move: i_word ;
+ h_move: i_word) ;
+ 2: (symbol: code_object) ;
+ 3: (num : i_word ;
+ guard : i_word) ;
+ end;
+@y
+ trio = 1..3 ;
+ lig_thing = packed record
+ v_move: i_word ;
+ h_move: i_word;
+ symbol: code_object;
+ num : i_word ;
+ guard : i_word;
+ end;
+@z
+
+@x Module 132; Lines 2235 -- 2236
+ begin if ( s.len <> t.len ) then equals := false
+ else equals := ( s.data = t.data) ;
+@y
+ var c, d: ccharpointer ;
+ begin
+ c := s.data; incr(c) ;
+ d := t.data; incr(d) ;
+ if ( s.len <> t.len ) then equals := false
+ else equals := (strncmp(c,d, s.len) = 0) ;
+@z
+
+% SIGH! with statements
+@x Module 158; Lines 2745 -- 2747
+ with lig_buff[2*i].symbol do
+ if (print_width < -breadth ) and (breadth > -30000 )
+ then print_width := -breadth ;
+@y
+ if (print_width < -lig_buff[2*i].symbol.breadth )
+ and (lig_buff[2*i].symbol.breadth > -30000 )
+ then print_width := -lig_buff[2*i].symbol.breadth ;
+@z
+
+@x Module 172; Lines 2937 -- 2941
+ with image( run_ptr) do begin {write the data into it}
+ hpos := Set_h ; Old_h := Set_h ;
+ vpos := Set_v ; Old_v := Set_v ;
+ symbol := cod ;
+ end;
+@y
+ begin {write the data into it}
+ image( run_ptr).hpos := Set_h ; Old_h := Set_h ;
+ image( run_ptr).vpos := Set_v ; Old_v := Set_v ;
+ image( run_ptr).symbol := cod ;
+ end;
+@z
+
+@x Module 180; Lines 3061 -- 3068
+ page_record = packed record
+ prox: link ;
+ case boolean of
+ true: ( hpos : i_word;
+ vpos: i_word;
+ symbol: code_object ) ;
+ false: ( down : link) ;
+ end;
+@y
+ page_record = packed record
+ prox: link ;
+ hpos : i_word;
+ vpos: i_word;
+ symbol: code_object;
+ down : link ;
+ end;
+@z
+
+@x Module 186; Lines 3156 -- 3175
+ with image(line_ptr) do begin
+ PR_h_next := hpos - H_shunt ;
+ if not b_space_absolute and not b_space_by_string and
+ (PR_h_next < PR_h) then
+ begin
+ if (PR_h < left_stop) then warn ('Negative H-pos') ;
+ if not batch_view then begin
+ next(overflow) := line_ptr ;
+ advance(overflow) ;
+ end;
+ advance(line_ptr) ;
+ end
+ else begin
+ @<Set horizontal position for the next character@>;
+ if symbol.IM_font <> PR_font then set_PR_font(symbol.IM_font);
+ print(zchr(symbol.IM_char )) ;
+ PR_h := PR_h + symbol.breadth ;
+ step_wipe(line_ptr ) ;
+ end ; end;
+ @.Error: Negative H-pos@>
+@y
+ begin
+ PR_h_next := image(line_ptr).hpos - H_shunt ;
+ if not b_space_absolute and not b_space_by_string and
+ (PR_h_next < PR_h) then
+ begin
+ if (PR_h < left_stop) then warn ('negative H-pos') ;
+ if not batch_view then begin
+ next(overflow) := line_ptr ;
+ advance(overflow) ;
+ end ;
+ advance(line_ptr) ;
+ end
+ else begin
+ @<Set horizontal position for the next character@>;
+ if image(line_ptr).symbol.IM_font <> PR_font
+ then set_PR_font( image(line_ptr).symbol.IM_font);
+ print(zchr( image(line_ptr).symbol.IM_char )) ;
+ PR_h := PR_h + image(line_ptr).symbol.breadth ;
+ step_wipe(line_ptr ) ;
+ end ; end;
+ @.negative H-pos@>
+@z
+
+% UNIX writeln moves you down a line
+@x Module 207; Lines 3472 -- 3472
+ device_ID := 'Lineprinter '; {Pad to 12 chars}
+@y
+ vstrcpy (device_ID, 'Lineprinter ' ); {Pad to 12 chars}
+@z
+
+@x Module 207; Lines 3489 -- 3489
+ wl_feed_dist := 0 ;
+@y
+ wl_feed_dist := 1 ;
+@z
+
+@x Module 210; Lines 3543 -- 3543
+ device_ID := 'screenview '; {Pad to 12 chars}
+@y
+ vstrcpy (device_ID, 'screenview ' ); {Pad to 12 chars}
+@z
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% END OF FILE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
diff --git a/dviware/crudetype/version3/unix-default.h b/dviware/crudetype/version3/unix-default.h
new file mode 100644
index 0000000000..68d1364554
--- /dev/null
+++ b/dviware/crudetype/version3/unix-default.h
@@ -0,0 +1,34 @@
+/* Sample of DEFAULTS.H. But you should normally use the one in your
+ top-level TEX directory.
+
+ More configuration definitions for web2c. Unlike those in site.h,
+ you need not and should not change these. If you do, then (a) tell
+ the people listed in README why you need to change them, and (b) be
+ prepared for everything to fail. */
+
+/* Define if you're running under MS-DOS with Microsoft C. (This port
+ is not complete.) */
+#ifndef MS_DOS
+#undef MS_DOS
+#endif
+
+/* These types can be basically anything, so they don't need to be put in
+ site.h. Despite the dire warning above, probably nothing bad will
+ happen if you change them -- but you shouldn't need to. */
+typedef char boolean;
+typedef double real;
+
+/* The maximum length of a filename including a directory specifier. */
+#define FILENAMESIZE 512
+
+
+/* Hack to get around High C on an IBM RT treating `char' differently
+ than normal compilers, etc. */
+
+#if defined(__HIGHC__) && defined(ibm032)
+pragma Off(Char_default_unsigned);
+pragma On(Char_is_rep);
+pragma On(Parm_warnings);
+pragma On(Pointers_compatible);
+pragma On(Pointers_compatible_with_ints);
+#endif /* __HIGHC__ && ibm032 */
diff --git a/dviware/crudetype/version3/unix-pas.ch b/dviware/crudetype/version3/unix-pas.ch
new file mode 100644
index 0000000000..898d7af4ef
--- /dev/null
+++ b/dviware/crudetype/version3/unix-pas.ch
@@ -0,0 +1,391 @@
+% unix-pas.ch -*-mode: change; webfile: crudetype.web version 3.01;-*-
+% UNIX changes by Peter King for Berkeley Pascal
+% modified by RMD for Crudetype version 2 and for v3
+%
+%
+% COPYRIGHT ( C ) P.King, Heriot-Watt University, 1988.
+%
+% Permission is given to any person to make and distribute copies of this
+% software, subject to the following conditions:
+%
+% 1. All copies of the software must carry an exact copy of this notice.
+%
+% 2. This software is distributed free of charge, "AS IS" with absolutely no
+% guarantee of performance. Any persons receiving or using this software must do
+% so entirely at their own risk. Neither the authors nor their institutions
+% accept any liability for any defects of this software, or for any consequential
+% loss or damage however caused.
+%
+% 3. Any person who changes this software must clearly mark it as modified and
+% add a note describing the changes made.
+%
+
+% WEAVE: print changes only
+@x Module 0; Lines 42 -- 42
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\def\title{Crudetype for {\mc UNIX } }
+@z
+
+@x Module 4; Lines 213 -- 213
+@d banner=='This is Crudetype, Version 3.01, copyright, experimental'
+@y
+@d banner=='This is Crudetype, Version 3.01, copyright, experimental UNIX'
+@z
+
+% UNIX writeln moves you down a line
+% Suppress unwanted control-M's at ends of lines
+@x Module 6; Lines 242 -- 242
+ @<Set initial values@>
+@y
+ @<Set initial values@>
+ setpaths; { set up the correct search path for fonts }
+ wl_feed_dist := 1 ;
+ wl_does_cr := true ;
+@z
+
+% add variables for runtime arguments, and to suppress all the non-error
+% information messages
+% stdin is not yet used, but is a handle for an extension to read from
+% input ( a UNIX pipe )
+@x Module 7; Lines 253 -- 253
+ in_i, in_j :integer; {loop index for initializations}
+@y
+ in_i, in_j :integer; {loop index for initializations}
+ stdin : boolean; { read from standard input }
+@z
+
+% Change the types
+@x Module 11; Lines 310 -- 312
+@<Types...@>=
+ byte = 0..255 ;
+ i_word = -max_half-1 .. max_half ;
+@y
+@<Types...@>=
+ byte = 0..255 ;
+ bite = -128..127 ; { signed ! }
+ i_word = -max_half-1..max_half ;
+@z
+
+@x Module 12; Lines 334 -- 336
+@d Q_string == packed array[ first..last:integer] of char
+@d be_string(#) == set_string( #, buffer)
+@d set_j_to_length == j := last
+@y
+@d Q_string == fix_string
+@d be_string(#) == hack := # ; set_string( hack, buffer)
+@d set_j_to_length == j := max_string
+@d first = 1
+@z
+
+@x Module 14; Lines 360 -- 361
+@<Lowest...@>=
+ {Declare |parse_file|}
+@y
+@<Lowest...@>=
+ procedure parse_file( name: var_string; var dir, nam, ex: var_string) ;
+ var p,r,s: s_ptr ;
+ begin
+ dir := blank; nam := blank; ex := blank;
+ s := name.len ;
+ if ( s>0) then begin
+ p := s_search( name, '/', -s);
+ if ( p>0) then substring( dir, name, 1, p) ;
+ r := s_search( name, '.', -s);
+ if ( r>p) then substring( ex, name, r, s-r+1)
+ else r := s +1 ;
+ substring( nam, name, p+1, r-p-1) ;
+ end;
+ end;
+@z
+
+@x Module 16; Lines 408 -- 408
+@d print_ln ==write_ln(printfile )
+@y
+@d print_ln == write_ln(printfile );
+ if inspection then flush(printfile )
+@z
+
+% Changes to incorporate UNIX conventions
+% lower case file names, default to putting the .lpr file in the
+% same directory as the .dvi file
+@x Module 18; Lines 429 -- 436
+@d block_length = 512
+@d same_dir == false
+
+@<Set init...@>=
+ be_string( '.DVI' ) ; dvi_def := buffer ;
+ be_string( 'TEX$FONTS:.TFM' ) ; tfm_def := buffer ;
+ be_string( 'TEX$GF:.&DGF' ) ; raster_def := buffer ;
+ be_string( '.PRI' ) ; print_ex := buffer ;
+@y
+
+The Unix version of \.{Crudetype} uses ``paths''.
+
+@d block_length = 1
+@d same_dir == true
+
+@<Set init...@>=
+ be_string( '.dvi' ) ; dvi_def := buffer ;
+ be_string( '.tfm' ) ; tfm_def := buffer ;
+ be_string( '/tex/gfdir/.&Dgf' ) ; raster_def := buffer ;
+ be_string( '.lpr' ) ; print_ex := buffer ;
+@z
+
+% More of the UNIX simple minded view of files.
+% but including the (optional) directory search for .tfm files
+@x Module 19; Lines 442 -- 443
+@<Lowest...@>=
+ {Declare |open_binary|}
+@y
+@d read_access_mode=4 {``read'' mode for |test_access|}
+@d write_access_mode=2 {``write'' mode for |test_access|}
+
+@d close_binary(#)== do_nothing ;
+
+@<Lowest...@>=
+ procedure setpaths;
+ external;
+ function test_access(
+ accessmode:integer; filepath:integer;
+ var name, realname: fixstring ) : boolean;
+ external;
+@#
+ function open_binary (var f_f: byte_file; name: var_string;
+ search_path: integer ): boolean;
+ begin
+ cur_name := name.data ; real_name := blank.data ;
+ if test_access(read_access_mode,search_path, cur_name, real_name) then
+ begin
+ reset(f_f, real_name);
+ be_string( real_name ) ; name := buffer ;
+ open_binary := true
+ end
+ else
+ open_binary := false
+ end;
+@z
+
+@x Module 20; Lines 446 -- 446
+ rewrite(printfile) ;
+@y
+ if inspection then
+ rewrite(printfile, '/dev/tty' )
+ else rewrite(printfile, print_name.data ) ;
+@z
+
+@x Module 21; Lines 452 -- 466
+@d get_val( #) == # := s_to_i( #, true)
+@d prefix == "/"
+@d got_cl == ( command.len > 0)
+@d read_command_line( #) == do_nothing
+
+@<Lowest...@>=
+ {Declare |read_command_line| }
+@#
+ procedure get_command ;
+ var ss: fix_string ;
+ begin
+ ss := blank.data ;
+ read_command_line( ss) ;
+ be_string( ss ) ; command := buffer ;
+ end;
+@y
+
+Unix \P\ does not supply a command line; instead it chops it up and supplies
+the pieces using two predeclared procedures |argc| and |argv|. It seemed to me
+that the least messy way to fit this onto the rest of the program is to
+re-assemble the command line.
+
+@d get_val( #) == # := s_to_i( #, true)
+@d prefix == "-"
+@d got_cl == ( argc > 1)
+@d read_command_line( #) == do_nothing
+
+@<Lowest...@>=
+ procedure get_command ;
+ var ss: fix_string ; nn: integer ; tt: var_string ;
+ begin
+ command := blank ;
+ for nn := 1 to argc-1 do begin
+ ss := blank.data ;
+ argv( nn, ss) ;
+ be_string( ss ) ; tt := buffer ;
+ append( command, tt) ;
+ incr( command.len) ;
+ end;
+ end;
+@z
+
+@x Module 27; Lines 560 -- 572
+@ If there was no command line, try to send messages to the user at a
+terminal. This requires nonstandard \PASCAL\ constructions to handle the
+online interaction. So it may be necessary on some systems to omit the dialog.
+First, the \.{DVI} file name.
+
+@<Get \.{DVI} file name and open it@>=
+ if can_interact and ( dvi_name.len = 0) then repeat
+ ask_prompt('DVI file name? ') ;
+ get_name( dvi_name) ;
+ until ( dvi_name.len > 0) ;
+ if not open_and_ask(dvi_file, dvi_indx, dvi_name, dvi_def, true)
+ then abort('Couldnt open DVI file')
+ @.Fatal: Couldnt open@>
+@y
+@ If there was no command line, try to send messages to the user at a
+terminal. This requires nonstandard \PASCAL\ constructions to handle the
+online interaction. So it may be necessary on some systems to omit the dialog.
+First, the (\.{DVI}) file name. This part is altered to use Unix style path
+searching.
+
+@d no_file_path=0 {no path searching should be done}
+@d font_file_path=3 {path specifier for \.{TFM} files}
+
+@<Get \.{DVI} file name and open it@>=
+ if can_interact and ( dvi_name.len = 0) then repeat
+ ask_prompt('DVI file name? ') ;
+ get_name( dvi_name) ;
+ until ( dvi_name.len > 0) ;
+ dvi_indx := no_file_path ;
+ if not open_and_ask(dvi_file, dvi_indx, dvi_name, dvi_def, true)
+ then abort('Couldnt open DVI file')
+ @.Fatal: Couldnt open@>
+@z
+
+@x Module 28; Lines 574 -- 577
+@ But when we come to open a font file, we merely report a failure:
+
+@<Open font file@>=
+ font_ok := open_and_ask (tfm_file, tfm_indx, tfm_name, tfm_def, true) ;
+@y
+@ When we try to open a font file, we search the path specified by the user's
+environment variable before we report a failure:
+
+@<Open font file@>=
+ tfm_indx := font_file_path ;
+ font_ok := open_and_ask (tfm_file, tfm_indx, tfm_name, tfm_def, true) ;
+@z
+
+% Binary file handling
+@x Module 33; Lines 661 -- 671
+The main input file is the \.{DVI} file. Logically, this is just a stream of
+8-bit bytes, with no record or block structure. However VMS \PASCAL\
+apparently cannot handle files of this type; so I have adopted the blocking
+scheme (due to D.R.Fuchs) from the VMS \.{DVItype} change file. But a lot of
+the code has been rewritten. Some other operating systems use similar
+blocking schemes; so this code may possibly work without much change. The
+program deals with two binary file variables: |@!dvi_file| is the main input
+file that we are printing, and |@!tfm_file| the current font metric file from
+which character-width information is being read. Each of these has a name and
+a counter, declared here; also a default name (system dependent, and so
+declared previously).
+@y
+The main input file is the \.{DVI} file. Logically, this is just a stream of
+8-bit bytes, with no record or block structure. UNIX \PASCAL\ can happily
+handle these, except that it treats each byte as a signed quantity, so we do
+some fudging to make them unsigned. The program deals with two binary file
+variables: |@!dvi_file| is the main input file that we are printing, and
+|@!tfm_file| the current font metric file from which character-width
+information is being read. Each of these has a name declared here.
+@z
+
+% Binary file types
+@x Module 33; Lines 675 -- 676
+ @!byte_block=packed array [0..block_length-1] of byte ;
+ @!byte_file= packed file of byte_block;
+@y
+ @!byte_file= file of bite;
+@z
+
+% The filenames used by |test_access| are added here.
+@x Module 34; Lines 685 -- 685
+ printfile: text ;
+@y
+ printfile: text ;
+ @!cur_name,@!real_name:fix_string ;
+ {external name}
+@z
+
+% open_and_ask must pass the search path into open_binary
+@x Module 35; Lines 701 -- 701
+ success := open_binary(f_f, name ) ;
+@y
+ success := open_binary(f_f, name, f_c ) ;
+@z
+
+% P. King deleted all the VMS indx stuff, since all the files are (logically)
+% read one character at a time. I have re-instated it because it is very
+% useful when debugging.
+%
+@x Module 38; Lines 745 -- 776
+@d get_real(#) == read_real(# @& file, # @& indx)
+
+@<Lowest...@>=
+ function read_byte(var f_file: byte_file; var f_indx: integer) : byte;
+ begin
+ if eof(f_file) then
+ warn('End of file' )
+ else begin
+ read_byte := f_file^[f_indx] ;
+ incr(f_indx);
+ if f_indx =block_length then begin
+ get(f_file );
+ f_indx:=0;
+ end;
+ end;
+ end ;
+
+@#
+ procedure skip_bytes(var f_file: byte_file; var f_indx: integer; n:integer);
+ {discard n bytes from |f_file|}
+ begin
+ if n < 0 then abort('Skip_bytes called with negative number');
+ f_indx := f_indx + n;
+ while( f_indx >= block_length) do
+ begin
+ if eof(f_file) then
+ warn('End of file' )
+ else get(f_file );
+ f_indx := f_indx - block_length ;
+ end ;
+ end;
+ @.Error: End of file@> @.Fatal: Skip_bytes...@>
+@y
+@d read_real == rr_read_real {|read_real| is Unix \PASCAL\ procedure}
+@d get_real(#) == read_real(# @& file, # @& indx)
+
+@<Lowest...@>=
+ function read_byte(var f_file: byte_file; var f_indx: integer) : byte;
+ var x:bite;
+ begin
+ if eof(f_file) then begin
+ warn('End of file' ) ;
+ read_byte := 0 ; { return some value }
+ end
+ else begin
+ read(f_file,x);
+ if x < 0 then read_byte := x + 256
+ else read_byte := x ;
+ incr(f_indx);
+ end;
+ end;
+
+@#
+ procedure skip_bytes(var f_file: byte_file; var f_indx: integer; n:integer);
+ {discard n bytes from |f_file|}
+ var k:integer;
+ x:bite;
+ begin
+ if n < 0 then abort('Skip_bytes called with negative number');
+ f_indx := f_indx + n;
+ for k:=1 to n do
+ begin
+ if eof(f_file) then
+ warn('End of file' )
+ else read(f_file, x );
+ end ;
+ end;
+ @.Error: End of file@> @.Fatal: Skip_bytes...@>
+@z
+
diff --git a/dviware/crudetype/version3/unix-site.hp b/dviware/crudetype/version3/unix-site.hp
new file mode 100644
index 0000000000..fc916719ab
--- /dev/null
+++ b/dviware/crudetype/version3/unix-site.hp
@@ -0,0 +1,168 @@
+/* Master configuration file for WEB to C. Almost all the definitions
+ are wrapped with #ifndef's, so that you can override them from the
+ command line, if you want to. */
+
+/* Altered by RMD. Original in site.h_dist */
+
+#ifndef __WEB2C_SITE_H
+#define __WEB2C_SITE_H
+
+/* Define if you're running on 4.2 or 4.3 BSD-based system. */
+#ifndef BSD
+#undef BSD
+#endif
+
+/* Define if you're running on System V-based system. */
+#ifndef SYSV
+#define SYSV
+#endif
+
+/* Define if you're running on an HP-based system (also define BSD). */
+#ifndef HP
+#define HP
+#endif
+
+/* Define if you're running on an AIX-based system. */
+#ifndef AIX
+#undef AIX
+#endif
+
+/* Define this if the system will be compiled with an ANSI C compiler,
+ and never with a non-ANSI compiler. It changes web2c so that it
+ produces ANSI C as its output. This is a perhaps good idea, but you
+ don't necessarily gain anything in the production programs by doing
+ it. */
+#ifndef ANSI
+#undef ANSI
+#endif
+
+/* Define these according to your local setup. It doesn't hurt anything
+ to have `.' in all the paths, but since most users do not have their
+ own fonts or format files, it only slows things down. (And most
+ users never run initex or inimf, so it doesn't hurt to have `.' in
+ the pool paths; if you take . out, `make fmts' and `make bases' will
+ not work properly.)
+
+ Do not put a leading or trailing colon in these paths, or double a
+ colon in the middle. That might lead to infinite recursion. */
+/*RMD; we dont have Metafont */
+
+
+#define TEXINPUTS ".:/tex/inputs"
+#define TEXFONTS "/tex/fonts"
+#define TEXFORMATS "/tex/formats"
+#define TEXPOOL "/tex/formats"
+#define MFBASES "/usr/local/lib/mf/bases"
+#define MFINPUTS ".:/usr/local/lib/mf/macros:/nfs/src/other/TeX+MF/typefaces"
+#define MFPOOL ".:/usr/local/lib/mf"
+
+/* BibTeX search path for .bib files. BibTeX uses TEXINPUTS to search
+ for .bst files. */
+#define BIBINPUTS ".:/tex/bibtex"
+
+/* Metafont window support: More than one may be defined, as long as you
+ don't try to have both X10 and X11 support (because there are
+ conflicting routine names in the libraries). After you've defined
+ these, make sure to update the top-level Makefile accordingly. Also,
+ if you want X11 support, see the `Online output from Metafont'
+ section in ./README before compiling. */
+#undef HP2627WIN /* HP 2627. */
+#undef SUNWIN /* SunWindows. */
+#undef TEKTRONIXWIN /* Tektronix 4014. */
+#undef UNITERMWIN /* Uniterm Tektronix. */
+#undef X10WIN /* X Version 10. */
+#define X11WIN /* X Version 11. */
+
+#if defined(X10WIN) && defined(X11WIN)
+sorry
+#endif
+
+/* Default editor command string: `%d' expands to the line number where
+ TeX or Metafont found an error and `%s' expands to the name of the
+ file. The environment variables TEXEDIT and MFEDIT override this. */
+#define EDITOR "/usr/local/emacs +%d %s"
+
+/* Define this to be the return type of your signal handlers. POSIX
+ says it should be `void', but some older systems want `int'. Check
+ your <signal.h> include file if you're not sure. */
+#ifndef SIGNAL_HANDLER_RETURN_TYPE
+#define SIGNAL_HANDLER_RETURN_TYPE int
+#endif
+
+/* Define this to be what your sprintf(3) routine returns -- most likely
+ `int' or `char *'. Since the calls to sprintf are always cast to
+ void, anyway, this is only necessary to avoid conflicts between
+ declarations. */
+#ifndef SPRINTF_RETURN_TYPE
+#define SPRINTF_RETURN_TYPE char*
+#endif
+
+/* The type `glueratio' should be a floating point type which won't
+ unnecessarily increase the size of the memoryword structure. This is
+ the basic requirement. On most machines, if you're building a
+ normal-sized TeX, then glueratio must probably meet the following
+ restriction: sizeof(glueratio) <= sizeof(integer). Usually, then,
+ glueratio must be `float'. But if you build a big TeX, you can (on
+ most machines) and should make it `double' to avoid loss of precision
+ and conversions to and from double during calculations. (All this
+ also goes for Metafont.) Furthermore, if you have enough memory, it
+ won't hurt to have this defined to be `double' for running the
+ trip/trap tests. */
+typedef double glueratio;
+
+/* Define this if you want TeX to be compiled with local variables
+ declared as `register'. On SunOS 3.2 and 3.4 (at least), compiling
+ with cc, this will cause problems. If you're using gcc or the SunOS
+ 4.x compiler, and compiling with -O, register declarations are
+ ignored, so there is no point in defining this. */
+#ifndef REGFIX
+#undef REGFIX
+#endif
+
+/* If the type `int' is at least 32 bits (including a sign bit), this
+ symbol should be #undef'd; otherwise, it should be #define'd. If
+ your compiler uses 16-bit int's, arrays larger than 32K may give you
+ problems, especially if indices are automatically cast to int's. */
+#ifndef SIXTEENBIT
+#undef SIXTEENBIT
+#endif
+
+/* Our character set is 8-bit ASCII unless NONASCII is defined. For
+ other character sets, make sure that first_text_char and
+ last_text_char are defined correctly (they're 0 and 255,
+ respectively, by default). In the *.defines files, change the
+ indicated range of type `char' to be the same as
+ first_text_char..last_text_char, `#define NONASCII', and retangle and
+ recompile everything. */
+#ifndef NONASCII
+#undef NONASCII
+#endif
+
+/* The type `schar' should be defined here to be the smallest signed
+ type available. ANSI C compilers may need to use `signed char'. If
+ your char type is unsigned, then define schar to be the type
+ `short'. */
+#ifdef AIX
+typedef int schar;
+#else
+typedef char schar;
+#endif
+
+/* The type `integer' must be a signed integer capable of holding at
+ least the range of numbers (-2^31)..(2^32-1). The ANSI C standard
+ says that `long' meets this requirement, but if you don't have an
+ ANSI C compiler, you might have to change this definition. */
+typedef long integer;
+
+/* Define this if you want subdirectories of directories in the search
+ paths to be searched. (See discussion in ./README of directory
+ hierarchies.) */
+#ifndef SEARCH_SUBDIRECTORIES
+#define SEARCH_SUBDIRECTORIES
+#endif
+
+/* You need not worry about the definitions in `defaults.h', unless
+ something goes wrong. */
+#include "defaults.h"
+
+#endif /* not __WEB2C_SITE_H */
diff --git a/dviware/crudetype/version3/unix-site.sun b/dviware/crudetype/version3/unix-site.sun
new file mode 100644
index 0000000000..a2820bd81f
--- /dev/null
+++ b/dviware/crudetype/version3/unix-site.sun
@@ -0,0 +1,171 @@
+/* Master configuration file for W2C for SUN-OS 3.5 and GCC. Almost
+ all the definitions
+ are wrapped with #ifndef's, so that you can override them from the
+ command line, if you want to. */
+
+
+
+#ifndef __WEB2C_SITE_H
+#define __WEB2C_SITE_H
+
+/* Define if you're running on 4.2 or 4.3 BSD-based system. */
+#ifndef BSD
+#define BSD
+#endif
+
+/* Define if you're running on System V-based system. */
+#ifndef SYSV
+#undef SYSV
+#endif
+
+/* Define if you're running on an HP-based system (also define BSD).
+ (that is what the WEB2C site.h's say but I think it is a mistake
+*/
+#ifndef HP
+#undef HP
+#endif
+
+/* Define if you're running on an AIX-based system. */
+#ifndef AIX
+#undef AIX
+#endif
+
+/* Define this if the system will be compiled with an ANSI C compiler,
+ and never with a non-ANSI compiler. It changes web2c so that it
+ produces ANSI C as its output. This is a perhaps good idea, but you
+ don't necessarily gain anything in the production programs by doing
+ it. */
+#ifndef ANSI
+#define ANSI
+#endif
+
+/* Define these according to your local setup. It doesn't hurt anything
+ to have `.' in all the paths, but since most users do not have their
+ own fonts or format files, it only slows things down. (And most
+ users never run initex or inimf, so it doesn't hurt to have `.' in
+ the pool paths; if you take . out, `make fmts' and `make bases' will
+ not work properly.)
+
+ Do not put a leading or trailing colon in these paths, or double a
+ colon in the middle. That might lead to infinite recursion. */
+/*RMD; we dont have Metafont */
+
+
+#define TEXINPUTS ".:/tex/inputs"
+#define TEXFONTS "/tex/fonts"
+#define TEXFORMATS "/tex/formats"
+#define TEXPOOL "/tex/formats"
+#define MFBASES "/usr/local/lib/mf/bases"
+#define MFINPUTS ".:/usr/local/lib/mf/macros:/nfs/src/other/TeX+MF/typefaces"
+#define MFPOOL ".:/usr/local/lib/mf"
+
+/* BibTeX search path for .bib files. BibTeX uses TEXINPUTS to search
+ for .bst files. */
+#define BIBINPUTS ".:/tex/bibtex"
+
+/* Metafont window support: More than one may be defined, as long as you
+ don't try to have both X10 and X11 support (because there are
+ conflicting routine names in the libraries). After you've defined
+ these, make sure to update the top-level Makefile accordingly. Also,
+ if you want X11 support, see the `Online output from Metafont'
+ section in ./README before compiling. */
+#undef HP2627WIN /* HP 2627. */
+#undef SUNWIN /* SunWindows. */
+#undef TEKTRONIXWIN /* Tektronix 4014. */
+#undef UNITERMWIN /* Uniterm Tektronix. */
+#undef X10WIN /* X Version 10. */
+#define X11WIN /* X Version 11. */
+
+#if defined(X10WIN) && defined(X11WIN)
+sorry
+#endif
+
+/* Default editor command string: `%d' expands to the line number where
+ TeX or Metafont found an error and `%s' expands to the name of the
+ file. The environment variables TEXEDIT and MFEDIT override this. */
+#define EDITOR "/usr/local/emacs +%d %s"
+
+/* Define this to be the return type of your signal handlers. POSIX
+ says it should be `void', but some older systems want `int'. Check
+ your <signal.h> include file if you're not sure. */
+#ifndef SIGNAL_HANDLER_RETURN_TYPE
+#define SIGNAL_HANDLER_RETURN_TYPE int
+#endif
+
+/* Define this to be what your sprintf(3) routine returns -- most likely
+ `int' or `char *'. Since the calls to sprintf are always cast to
+ void, anyway, this is only necessary to avoid conflicts between
+ declarations. */
+#ifndef SPRINTF_RETURN_TYPE
+#define SPRINTF_RETURN_TYPE char*
+#endif
+
+/* The type `glueratio' should be a floating point type which won't
+ unnecessarily increase the size of the memoryword structure. This is
+ the basic requirement. On most machines, if you're building a
+ normal-sized TeX, then glueratio must probably meet the following
+ restriction: sizeof(glueratio) <= sizeof(integer). Usually, then,
+ glueratio must be `float'. But if you build a big TeX, you can (on
+ most machines) and should make it `double' to avoid loss of precision
+ and conversions to and from double during calculations. (All this
+ also goes for Metafont.) Furthermore, if you have enough memory, it
+ won't hurt to have this defined to be `double' for running the
+ trip/trap tests. */
+typedef double glueratio;
+
+/* Define this if you want TeX to be compiled with local variables
+ declared as `register'. On SunOS 3.2 and 3.4 (at least), compiling
+ with cc, this will cause problems. If you're using gcc or the SunOS
+ 4.x compiler, and compiling with -O, register declarations are
+ ignored, so there is no point in defining this. */
+#ifndef REGFIX
+#undef REGFIX
+#endif
+
+/* If the type `int' is at least 32 bits (including a sign bit), this
+ symbol should be #undef'd; otherwise, it should be #define'd. If
+ your compiler uses 16-bit int's, arrays larger than 32K may give you
+ problems, especially if indices are automatically cast to int's. */
+#ifndef SIXTEENBIT
+#undef SIXTEENBIT
+#endif
+
+/* Our character set is 8-bit ASCII unless NONASCII is defined. For
+ other character sets, make sure that first_text_char and
+ last_text_char are defined correctly (they're 0 and 255,
+ respectively, by default). In the *.defines files, change the
+ indicated range of type `char' to be the same as
+ first_text_char..last_text_char, `#define NONASCII', and retangle and
+ recompile everything. */
+#ifndef NONASCII
+#undef NONASCII
+#endif
+
+/* The type `schar' should be defined here to be the smallest signed
+ type available. ANSI C compilers may need to use `signed char'. If
+ your char type is unsigned, then define schar to be the type
+ `short'. */
+#ifdef AIX
+typedef int schar;
+#else
+typedef char schar;
+#endif
+
+/* The type `integer' must be a signed integer capable of holding at
+ least the range of numbers (-2^31)..(2^32-1). The ANSI C standard
+ says that `long' meets this requirement, but if you don't have an
+ ANSI C compiler, you might have to change this definition. */
+typedef long integer;
+
+/* Define this if you want subdirectories of directories in the search
+ paths to be searched. (See discussion in ./README of directory
+ hierarchies.) */
+#ifndef SEARCH_SUBDIRECTORIES
+#define SEARCH_SUBDIRECTORIES
+#endif
+
+/* You need not worry about the definitions in `defaults.h', unless
+ something goes wrong. */
+#include "defaults.h"
+
+#endif /* not __WEB2C_SITE_H */
diff --git a/dviware/crudetype/version3/unix.cap b/dviware/crudetype/version3/unix.cap
new file mode 100644
index 0000000000..14a7fad0af
--- /dev/null
+++ b/dviware/crudetype/version3/unix.cap
@@ -0,0 +1,32 @@
+#
+# This is a sample of printcap entries used by various printers/plotters
+#
+# Standard line printer
+lp|ap|arpa|ucbarpa|LA-180 DecWriter III:\
+ :br#9600:fs#0066320:tr=\f:of=/usr/lib/lpf:lf=/usr/adm/lpd-errs:\
+ :lp=/dev/ttya:sd=/usr/spool/lpd:
+#
+ps|postscript:\
+ :br#9600:fc#0000374:fs#0000003:xs#000040:tr=\f:lf=/usr/adm/lpd-errs:\
+ :lp=/dev/ttya:sh:sf:sd=/usr/spool/lpd:
+#
+# Laserjet Plus
+#
+hp|laserjet|Hewlett-Packard LaserjetPlus:\
+ :br#9600:fs#0066320:xc#177777:xs#040440:tr=\f:lf=/usr/adm/lpd-errs:\
+ :lp=/dev/ttya:sh:sf:sd=/usr/spool/lpd:
+#
+#
+#Experimental
+
+ep|experimental|LA-180 DecWriter III:\
+ :br#9600:fs#06320:tr=\f:of=/etc/mark:lf=/usr/adm/lpd-errs:\
+ :lp=/dev/ttya:sd=/usr/spool/lpd3:
+#
+#
+#Discarded fragment of an ep driver:
+#
+# :br#9600:fs#06320:tr=\f:lf=/usr/adm/lpd-errs:\
+# :lp=/dev/ttya:sb:of=/etc/mark3:sd=/usr/spool/lpd3:
+
+
diff --git a/dviware/crudetype/version3/unix.h b/dviware/crudetype/version3/unix.h
new file mode 100644
index 0000000000..f1b8c46969
--- /dev/null
+++ b/dviware/crudetype/version3/unix.h
@@ -0,0 +1,8 @@
+{UNIX.H Declare external routines for Crudetype}
+
+procedure setpaths;
+ external;
+function testaccess(
+ accessmode:integer; filepath:integer;
+ var name, realname: fixstring ) : boolean;
+ external;
diff --git a/dviware/crudetype/version3/unixcru.man b/dviware/crudetype/version3/unixcru.man
new file mode 100644
index 0000000000..13cc20c930
--- /dev/null
+++ b/dviware/crudetype/version3/unixcru.man
@@ -0,0 +1,115 @@
+
+.TH Crudetype 1 "Feb 1989"
+.SH NAME
+Crudetype \- Lineprinter output from DVI files.
+.SH SYNOPSIS
+.B crudetype
+.RB "[\|" \-b "\|]"
+.RB "[\|" \-c
+.IR countpages "\|]"
+.RB "[\|" \-d
+.IR font-directory "\|]"
+.RB "[\|" \-f
+.IR firstpage "\|]"
+.RI "[\|" \-i "[\|" page-height "\|]\|]"
+.RB "[\|" \-m
+.IR magnify "\|]"
+.RB "[\|" \-p
+.IR printfile "\|]"
+.RB "[\|" \-q "\|]"
+.RB "[\|" \-r "\|]"
+.RB "[\|" \-s "\|]"
+.RB "[\|" \-x
+.IR X-mag "\|]"
+.RB "[\|" \-y
+.IR Y-mag "\|]"
+.RI "[\|" dvifile "[\|" .dvi "\|]\|]"
+.SH DESCRIPTION
+.IX crudetype"" "\fLcrudetype\fR \(em Lineprinter output from DVI files.''
+.I Crudetype
+takes a standard TeX DVI file and generates output
+suitable for printing on a lineprinter. Of course no lineprinter can possibly
+do justice to the power of TeX, but it does give a fairly good idea of what
+your output would look like on a respectable printer.Thus
+.I Crudetype
+is very useful in the early stages of debugging TeX input, because you
+do not need any special equipment to run it and lineprinter output is
+less expensive than laserprinter output. The output file can also be
+inspected with editors or passed directly to your VDU but for this you
+need a 132-column-wide terminal. Also because VDUs cannot show
+overstruck characters, these appear in incorrect positions.
+
+
+.SH OPTIONS
+.PP
+.TP
+.BI \-b
+(Batch-view) Produces a file more suitable for viewing through an
+editor. The main change is that overstruck characters are omitted.
+.TP
+.BI \-c " number"
+Stop after this many pages. Normally
+.I Crudetype
+will print all pages.
+.TP
+.BI \-d " font-directory"
+Look for font files here instead of the standard TEXFONTS environment
+variable. Note the punctuation is peculiar, e.g. '-d/strange/place/.tfm'
+.TP
+.BI \-f " number"
+Start printing at the first page whose
+.I count0
+parameter is greater than or equal to the specified number.
+.TP
+.BI \-i " number"
+(Inspect) Produce immediate output on the terminal. The number N is
+optional. If it is specified, Crudetype pauses after every N lines.
+If it is missing, the default is 20. N=0 specifies no pausing.
+.TP
+.BI \-m " number"
+Magnify by (number)/100. Some magnification is needed because
+most TeX characters are narrower than lineprinter characters. I
+do not know any plausible algorithm for adjusting the magnification
+according to the fonts being used. The least bad alternative seemed to
+be to allow the user to specify a magnification; the default is
+adjusted so some files look reasonable on a lineprinter. Now replaced by
+.BI \-x
+and
+.BI \-y
+(see below); retained only for compatibility.
+.TP
+.BI \-p " printfile"
+Send output to the named file instead of the default. The
+default output file name is:
+(current default directory)(DVI file name)(.lpr)
+.TP
+.B \-q
+(quiet) Suppress information messages.
+.TP
+.B \-r
+(run on) Suppress form feeds; instead
+.I Crudetype
+prints a string
+like ----- PAGE n ----- .
+.TP
+.B \-s
+(squash) Suppress blank lines in the printed output. Normally,
+output is double-spaced to allow space for super- and subscripts.
+.TP
+.BI \-x " number"
+.TP
+.BI \-y " number"
+Specify separate horizontal and vertical magnifications. As with
+-m, the number is regarded as a percentage. If -m is also specified,
+both magnifications take effect.
+
+.SH AUTHOR
+.PP
+Program: R.M.Damerell, Maths Dept., RHBNC., Egham,
+Surrey, U.K. Unix changefile: P.King, Heriot-Watt University,
+Edinburgh, U.K. Bug reports to RMD please, E-mail address
+DAMERELL at UK.AC.NSFNET-RELAY.
+.TP
+Program is copyright,
+supplied free, AS IS with no guarantee of performance or support.
+
diff --git a/dviware/crudetype/version3/unixext.c b/dviware/crudetype/version3/unixext.c
new file mode 100644
index 0000000000..7a97d9edbe
--- /dev/null
+++ b/dviware/crudetype/version3/unixext.c
@@ -0,0 +1,132 @@
+/* External procedures for unix crudetype */
+/* Written by RMD (nearly all copied from H.Trickey's dvityext.c ) */
+/* Ought to be rewritten in cleaner form... */
+
+#include <stdio.h>
+#include "site.h"
+ /*Only needed to define TEXFONTS */
+
+#define TRUE 1
+#define FALSE 0
+
+char *fontpath;
+extern char *getenv();
+
+/*
+ * setpaths is called to set up the pointer fontpath
+ * as follows: if the user's environment has a value for TEXFONTS
+ * then use it; otherwise, use defaultfontpath.
+ */
+setpaths()
+{
+ register char *envpath;
+
+ if ((envpath = getenv("TEXFONTS")) != NULL)
+ fontpath = envpath;
+ else
+ fontpath = TEXFONTS;
+}
+
+#define namelength 100 /* should agree with crudetype
+
+
+/*
+ * testaccess(amode,filepath, name, realname)
+ *
+ * Test whether or not the file whose name is in name
+ * can be opened for reading (if mode=READACCESS)
+ * or writing (if mode=WRITEACCESS).
+ *
+ * The filepath argument is one of the ...FILEPATH constants defined below.
+ * If the filename given in name does not begin with '/', we try
+ * prepending all the ':'-separated areanames in the appropriate path to the
+ * filename until access can be made, if it ever can.
+ *
+ * The realname global array will contain the name that yielded an
+ * access success.
+ */
+
+#define READACCESS 4
+#define WRITEACCESS 2
+
+#define NOFILEPATH 0
+#define FONTFILEPATH 3
+
+testaccess(amode,filepath,name,realname)
+int amode,filepath;
+char *name;
+char *realname;
+{
+ register boolean ok;
+ register char *p;
+ char *curpathplace;
+ int f;
+
+ switch(filepath) {
+ case NOFILEPATH: curpathplace = NULL; break;
+ case FONTFILEPATH: curpathplace = fontpath; break;
+ }
+ if (name[0]=='/') /* file name has absolute path */
+ curpathplace = NULL;
+ do {
+ packrealname(&curpathplace,name,realname);
+ if (amode==READACCESS)
+ /* use system call "access" to see if we could read it */
+ if (access(realname,READACCESS)==0) ok = TRUE;
+ else ok = FALSE;
+ else {
+ /* WRITEACCESS: use creat to see if we could create it, but close
+ the file again if we're OK, to let pc open it for real */
+ f = creat(realname,0666);
+ ok = (f >= 0);
+ if (ok)
+ (void) close(f);
+ }
+ } while (!ok && curpathplace != NULL);
+ if (ok) { /* pad realname with blanks, as Pascal wants */
+ for (p = realname; *p != '\0'; p++)
+ /* nothing: find end of string */ ;
+ while (p < &(realname[namelength]))
+ *p++ = ' ';
+ }
+ return (ok);
+}
+
+/*
+ * packrealname(cpp,name,realname) makes realname contain the directory at *cpp,
+ * followed by '/', followed by the characters in name up until the
+ * first blank there, and finally a '\0'. The cpp pointer is left pointing
+ * at the next directory in the path.
+ * But: if *cpp == NULL, then we are supposed to use name as is.
+ */
+static packrealname(cpp,name,realname)
+ char **cpp;
+ char *name, *realname;
+{
+ register char *p,*tempname;
+
+ tempname = realname;
+ if ((p = *cpp)!=NULL) {
+ while ((*p != ':') && (*p != '\0')) {
+ *tempname++ = *p++;
+ if (tempname == &(realname[namelength-1]))
+ break;
+ }
+ if (*p == '\0') *cpp = NULL; /* at end of path now */
+ else *cpp = p+1; /* else get past ':' */
+ *tempname++ = '/'; /* separate the area from the name to follow */
+ }
+ /* now append name to tempname... */
+ /* There was a very peculiar bug here, I tried to fix it. (RMD).
+ Originally this said "p = name+1 ;" this cut off the
+ first character of the name */
+ p = name ;
+ while (*p != ' ') {
+ if (tempname >= &(realname[namelength-1])) {
+ (void) fprintf(stderr,"! Full file name is too long\n");
+ break;
+ }
+ *tempname++ = *p++;
+ }
+ *tempname = '\0';
+}
diff --git a/dviware/crudetype/version3/vms-build.com b/dviware/crudetype/version3/vms-build.com
new file mode 100644
index 0000000000..1e665dfc9f
--- /dev/null
+++ b/dviware/crudetype/version3/vms-build.com
@@ -0,0 +1,83 @@
+$! VMS.COM. Skeleton of command file to compile versions of
+$! Crudetype on VMS. Needs TANGLE and PASCAL compiler.
+$! Adapted to Crudetype v2, will probably need to be modified
+$! at other sites. Extra stuff also needed for any other version.
+$!
+$!
+$!
+$!
+$!
+$!
+$!
+$ask:
+$ if p1 .nes "" then goto try
+$ inquire p1 "What version do you want?"
+$goto ask
+$!
+$!
+$try:
+$ on warning then goto bad
+$ goto 'p1'
+$!
+$!
+$bad: write sys$output "UNKNOWN version, ", 'p1'
+$exit
+$!
+$!
+$crudetype:
+$ on warning then exit
+$ set verify
+$tangle xxx
+crudetype.web
+vms.ch
+crudetype.pas
+crudetype.pool
+
+$pascal/check crudetype
+$link crudetype
+$exit
+$!
+$!
+$hpgf:
+$!
+$!
+$!HPGF. Typical example for a printer changefile. It must be
+$! appended after the system changefile.
+$!
+$!
+$ on warning then exit
+$ set verify
+$copy vms.ch hpgf.vch
+$append hpgf.ch hpgf.vch
+$tangle xxx
+crudetype.web
+hpgf.vch
+hpgf.pas
+hpgf.pool
+
+$pascal/check hpgf
+$link hpgf
+$exit
+$!
+$!
+$noscheme:
+$!
+$! this is a weirdo. Use it if your TFM files dont have coding schemes
+$!
+$!
+$ on warning then exit
+$ set verify
+$copy crudetype.web noscheme.web
+$append noscheme.add noscheme.web
+$tangle xxx
+noscheme.web
+vms.ch
+crudetype.pas
+crudetype.pool
+
+$pascal/check crudetype
+$link crudetype
+$exit
+$ set noverify
+$!
+$!
diff --git a/dviware/crudetype/version3/vms.ch b/dviware/crudetype/version3/vms.ch
new file mode 100644
index 0000000000..8ed8a69b19
--- /dev/null
+++ b/dviware/crudetype/version3/vms.ch
@@ -0,0 +1,150 @@
+% vms.ch -*-mode: change; webfile: crudetype.web version 3.01;-*-
+% Originally, this was nearly empty, but I have now put into this file a lot
+% of the most VMS-specific code that was in the WEB file.
+%
+%
+
+% WEAVE: New title
+@x Module 0; Lines 42 -- 42
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\def\title{Crudetype for {\mc VMS}}
+@z
+
+% 11
+@x Module 11; Lines 305 -- 307
+@d real_number == real
+@d make_real( #) == #
+ {convert an integer to a |real_number|. Usually automatic}
+@y
+@d real_number == double
+@d make_real( #) == dble( #)
+ {convert an integer to double-length real}
+@z
+
+% 14
+%
+@x Module 14; Lines 360 -- 361
+@<Lowest...@>=
+ {Declare |parse_file|}
+@y
+@<Lowest...@>=
+ procedure parse_file( name: var_string; var dir, nam, ex: var_string) ;
+ var p,q,r,s: s_ptr ;
+ begin
+ dir := blank; nam := blank; ex := blank;
+ s := name.len ;
+ if ( s>0) then begin
+ p := s_search( name, ']', -s);
+ q := s_search( name, ':', -s);
+ if ( q>p) then p := q ;
+ if ( p>0) then substring( dir, name, 1, p) ;
+ r := s_search( name, '.', -s);
+ if ( r>p) then substring( ex, name, r, s-r+1)
+ else r := s +1 ;
+ substring( nam, name, p+1, r-p-1) ;
+ end;
+ end;
+@z
+
+@x Module 16; Lines 387 -- 388
+@ The next few sections contain the lowest level code for file handling. These
+macros describe how we use the terminal.
+@y
+@ The next few sections contain the lowest level code for file handling. These
+macros describe how we use the terminal. Here we have to do some messy stuff
+to circumvent a bad feature of VMS \PASCAL. VMS opens the terminal channels
+automatically, but by default, with a (short) maximum record length. The
+effect is that the program crashes on long files.
+@z
+
+@x Module 16; Lines 405 -- 406
+@d display(#)==write(term_out, #)
+@d display_ln(#)==write_ln(term_out, # )
+@y
+@d display(#)==write_ln(term_out, #)
+@d display_ln(#)==write_ln(term_out, #, chr( 13), chr( 10) )
+ {effectively makes record length infinite}
+@#
+@d no_crash == @=error := continue@>
+@d close_binary(#)== close(# , no_crash )
+@d r_len == @=record_length@>
+@d c_con == @=carriage_control@>
+ {VMS file-handling eccentricities}
+@z
+
+@x Module 16; Lines 416 -- 416
+@<Open terminal channels@>= do_nothing
+@y
+@<Open terminal channels@>=
+ open( output, 'SYS$OUTPUT', c_con := none);
+@z
+
+@x Module 19; Lines 442 -- 443
+@<Lowest...@>=
+ {Declare |open_binary|}
+@y
+
+If the VMS |open| procedure cannot open the file, |no_crash| suppresses the
+system error message, and |status| gets some nonzero value.
+
+@<Lowest...@>=
+ function open_binary
+ (var f_f: byte_file; name: var_string ): boolean;
+ var s: integer; f_n: filename ;
+ begin
+ close_binary(f_f );
+ {in case the file was left open}
+ name_of( f_n, name) ;
+ open(f_f, f_n, readonly, ,, fixed, no_crash );
+ s := status(f_f) ;
+ if ( s <> 0) then open_binary := false
+ else begin
+ reset(f_f , no_crash );
+ s := status(f_f) ;
+ open_binary := (s = 0 );
+ end;
+ end;
+@z
+
+@x Module 20; Lines 445 -- 446
+@ @<Open |printfile|@>=
+ rewrite(printfile) ;
+@y
+@ VMS \PASCAL\ allows 3 types of carriage control, called |list|, |fortran|,
+or |none|. No doubt other systems will have other peculiar types of carriage
+control. In VMS, |none| is to be used if at all possible, but some printers
+insist on a line feed after every carriage return. Roughly speaking, |@!list|
+directs the operating system to put a CR--LF at the end of each record when
+the file is printed. |@!fortran| means that a Fortran-type carriage control
+character must be put at the start of each record, and we assume that this
+must be inserted explicitly. One type of run-time error that causes a lot of
+trouble occurs if you try to write too many characters onto one record of the
+|printfile|. I have tried to defeat this by declaring a very long record
+length.
+
+@<Open |printfile|@>=
+ if inspection then
+ open (printfile, 'SYS$OUTPUT', c_con := list, r_len := 30000 )
+ else if fortran then
+ open (printfile, print_name.data, c_con := fortran, r_len := 30000 )
+ else if list then
+ open(printfile, print_name.data, c_con := list, r_len := 30000 )
+ else
+ open(printfile, print_name.data, c_con := none, r_len := 30000 ) ;
+ rewrite(printfile) ;
+
+@z
+
+@x Module 21; Lines 455 -- 458
+@d read_command_line( #) == do_nothing
+
+@<Lowest...@>=
+ {Declare |read_command_line| }
+@y
+@d read_command_line( #) == @= lib$get_foreign @> ( #)
+
+@<Lowest...@>=
+ procedure read_command_line( @= %descr @> ss: fix_string); extern ;
+@z
diff --git a/dviware/crudetype/version3/vmshpgf.tex b/dviware/crudetype/version3/vmshpgf.tex
new file mode 100644
index 0000000000..f3ddde68b0
--- /dev/null
+++ b/dviware/crudetype/version3/vmshpgf.tex
@@ -0,0 +1,109 @@
+% ARTICLE for Newsletter. Here are what I think are the useful N-L macros
+
+
+
+\font\big = cmbx10 at 14.4 truept
+\font\bold = cmb10 scaled \magstephalf
+\font\rm = cmr10 scaled \magstephalf
+\font\commandfont = cmtt10 scaled \magstephalf
+\def\titlefont{\big}
+\rm
+
+\def\title#1{\message{ Title: #1}\centerline {\titlefont#1}}
+
+\def\space#1{{\hglue 0.0 em plus #1 fill}}
+\def\author#1{\vskip\parskip\line{\space3 #1\space2}}
+\def\sign#1{\author{#1}}
+
+\hsize 170 true mm \vsize 257 true mm
+
+
+\parindent = 0.0 em
+\parskip = 8mm plus 35mm minus 4mm
+
+\def\address{\parskip=0mm\obeylines}
+
+
+
+
+% and here are my own macros
+
+
+% These macros for verbatim scanning are copied from MANMAC.TEX. But we cant
+% use the vertical bar for a temporary escape character as WEAVE catches it.
+% So we will use ! instead and hope for the best
+\chardef\other=12
+\def\ttverbatim{\begingroup
+ \catcode`\\=\other \catcode`\{=\other \catcode`\}=\other \catcode`\$=\other
+ \catcode`\&=\other \catcode`\#=\other \catcode`\%=\other \catcode`\~=\other
+ \catcode`\_=\other \catcode`\^=\other
+ \obeyspaces \obeylines \tt}
+
+\def\begintt{$$\let\par=\endgraf \ttverbatim \parskip=0pt
+ \catcode`\!=0 \rightskip-5pc \ttfinish}
+{\catcode`\!=0 !catcode`!\=\other % ! is temporary escape character
+ !obeylines !obeyspaces % end of line is active
+ !gdef!ttfinish#1^^M#2\endtt{#1!vbox{#2}!endgroup$$}}
+
+% \font\ninett=cmtt9
+% that is the normal WEB practice, but in view of the definition of
+% commandfont above, it seemed inadvisable...
+
+\font\ninett = cmtt10 scaled \magstephalf
+
+\let\mc=\ninett
+
+\def\C{{Crudetype}}
+\def\D{{\mc DVI}}
+
+
+\title{H-P Laserjet Plus output from \TeX.}
+
+HPGF is the H-P version of the \C\ program described in my other note. Note
+that this version only runs on the VAX, the Sun program is a version of
+Beebe's printer driver (and I think it is better than mine).
+
+
+To use HPGF, you
+must first issue the following commands:\begintt
+$USE TEX
+$HOP :== $SYS$USERDISK2:[UHAH208.CRUDE]HPGF
+$HMP :== PRINT/QUEUE=MATHSA4 \endtt
+These commands only need to be given once per login, so you can insert them
+into your {\tt LOGIN.COM} file. The first command tells HPGF where to look for
+the fonts. The second defines {\tt HOP} as what VMS calls a ``foreign''
+command. Then you can run the program by this command: \begintt
+$HOP (qualifiers) DVI_FILE \endtt
+The {\tt DVI\_FILE} must be specified. If you do not specify a directory or an
+extension \C\ will look in your current default directory and assume the
+default extension {\tt .DVI}. The qualifiers are all optional; they will
+not work unless {\tt HOP} is defined as above.
+Note this is different from any previous definition that might be
+in your {\tt LOGIN.COM} file.
+The permitted qualifiers are:
+
+
+
+/c,/f,/m,/p,/q \quad All exactly as in the Lineprinter version of Crudetype.
+(See its document).
+In fact the /r and /s qualifiers are also there, but I advise you not to
+use them.
+
+/e, /o \quad Print only even (respectively, odd) numbered pages. Page numbers are
+determined by the {\tt count0} parameter in the {\tt BOP} commands of the {\tt
+DVI} file. In principle this would allow double sided printing. In practice
+this will probably be very difficult.
+
+/l \quad Print in Landscape mode. Note that for this to work you will have to pass
+suitable {\tt hsize} and {\tt vsize} parameters to \TeX.
+
+Eventually you should get a message ``Output on (filename)''. The default output
+file name is (your current default directory)({\tt DVI} file name)({\tt .HPL}).
+Print it by \begintt
+$HMP (filename).HPL
+\endtt
+
+\sign{R.M.Damerell, Mathematics Dept.}
+
+
+\bye
diff --git a/dviware/crudetype/version3/vmsspew.com b/dviware/crudetype/version3/vmsspew.com
new file mode 100644
index 0000000000..d551546cd2
--- /dev/null
+++ b/dviware/crudetype/version3/vmsspew.com
@@ -0,0 +1,17 @@
+$! SPEW.COM.. PRINT binary file, treating printer as a terminal.
+$!
+$!
+$! Mode of use: (site specific) Log in with a terminal, making sure that
+$! the dreaded pin 20 is not connected. Issue the command to run this file,
+$! and type the name of the desired file.
+$! SPEW types "waiting" then pauses for 30 secs. In that time you must
+$! switch connections, so the output goes into the printer.
+$! Messy but reliable.
+$!
+$!
+$if p1 .eqs. "" then inquire p1 "file"
+$write sys$output "waiting..."
+$wait 00:00:30
+$set term/eight_bit/form/pasthru
+$copy 'p1' sys$output
+$set term/nopasthru
diff --git a/dviware/crudetype/version3/vmsuser.tex b/dviware/crudetype/version3/vmsuser.tex
new file mode 100644
index 0000000000..52884838ac
--- /dev/null
+++ b/dviware/crudetype/version3/vmsuser.tex
@@ -0,0 +1,140 @@
+% VMSUSER.TEX Suggested user document (VMS specific) for Crudetype.
+% Formatting could be much improved.
+
+
+\font\big = cmbx10 at 14.4 truept
+\font\bold = cmb10 scaled \magstephalf
+\font\rm = cmr10 scaled \magstephalf
+\font\commandfont = cmtt10 scaled \magstephalf
+\def\titlefont{\big}
+\rm
+
+\def\title#1{\message{ Title: #1}\centerline {\titlefont#1}}
+
+\def\space#1{{\hglue 0.0 em plus #1 fill}}
+\def\author#1{\vskip\parskip\line{\space3 #1\space2}}
+\def\sign#1{\author{#1}}
+
+\hsize 170 true mm \vsize 257 true mm
+
+
+\parindent = 0.0 em
+\parskip = 8mm plus 35mm minus 4mm
+
+\def\address{\parskip=0mm\obeylines}
+
+
+
+
+% and here are my own macros
+
+
+% These macros for verbatim scanning are copied from MANMAC.TEX. But we cant
+% use the vertical bar for a temporary escape character as WEAVE catches it.
+% So we will use ! instead and hope for the best
+\chardef\other=12
+\def\ttverbatim{\begingroup
+ \catcode`\\=\other \catcode`\{=\other \catcode`\}=\other \catcode`\$=\other
+ \catcode`\&=\other \catcode`\#=\other \catcode`\%=\other \catcode`\~=\other
+ \catcode`\_=\other \catcode`\^=\other
+ \obeyspaces \obeylines \tt}
+
+\def\begintt{$$\let\par=\endgraf \ttverbatim \parskip=0pt
+ \catcode`\!=0 \rightskip-5pc \ttfinish}
+{\catcode`\!=0 !catcode`!\=\other % ! is temporary escape character
+ !obeylines !obeyspaces % end of line is active
+ !gdef!ttfinish#1^^M#2\endtt{#1!vbox{#2}!endgroup$$}}
+
+% \font\ninett=cmtt9
+% that is the normal WEB practice, but in view of the definition of
+% commandfont above, it seemed inadvisable...
+
+\font\ninett = cmtt10 scaled \magstephalf
+
+\let\mc=\ninett
+
+\def\C{{Crudetype}}
+\def\D{{\mc DVI}}
+
+
+\title{Lineprinter output from \TeX.}
+
+\C\ is a program that takes a standard \TeX\ \D\ file and generates output
+suitable for printing on a lineprinter. Of course no lineprinter can possibly
+do justice to the power of \TeX, but it does give a fairly good idea of what
+your output would look like on a respectable printer.Thus \C\ is very useful
+in the early stages of
+debugging \TeX\ input, because you do not need any special equipment to run it
+and lineprinter output is less expensive than laserprinter output. The output
+file can also be
+inspected with editors such as EDT or TPU, but for this you need a 132-column-wide
+terminal. Also because VDUs cannot show overstruck characters, these appear
+incorrectly on the next line. To use \C, you
+must first issue the following commands:\begintt
+$CRT :== $UHAH:[208.CRUDE]CRUDETYPE \endtt
+This command defines {\tt CRT} as what
+VMS calls a ``foreign''
+command. It is only valid at one site; users at other sites must find
+out where the file is actually located.
+It only needs to be given once per login, so you can insert it
+into your {\tt LOGIN.COM} file.
+Then you can run the program by: \begintt
+$CRT (qualifiers) DVI_FILE \endtt
+The {\tt DVI\_FILE} must be specified. If you do not specify a directory or an
+extension \C\ will look in your current default directory and assume the
+default extension {\tt .DVI}. The qualifiers are all optional; they will
+not work unless {\tt CRT} is defined as above. The permitted qualifiers are:
+
+/m (number) Magnify by (number)/100. Now obsolete, see /x and /y
+below. Some magnification is needed because most \TeX\ characters are
+narrower than lineprinter characters. But I do not know any plausible
+algorithm for adjusting the magnification according to the fonts being
+used. The least bad alternative seemed to be to allow the user to
+specify a magnification; the default is adjusted so some files look
+reasonable on a lineprinter.
+
+/q (quiet) Suppress information messages.
+
+/r (run-on) Suppress form feeds; instead \C\ prints a string
+ like {\tt ----- PAGE n -----} .
+
+/s (squash) Suppress blank lines in the printed output. Normally,
+output is double-spaced to allow space for super- and subscripts.
+
+/f (number) (first page) Start printing at the first page whose {\tt count0}
+ parameter is greater than or equal to the specified number.
+
+/c (number) (count) Stop after this many pages. The defaults for /c and /f are
+$\pm 10^6$, so normally \C\ will print all pages.
+
+/p (printfile) Send output to the named file instead of the default. The
+ default output file name is:
+ (your current default directory)({\tt DVI} file name)({\tt .PRI}).
+ But note that when this qualifier is used VMS sometimes alters
+ the name: for example {\tt /p HORSE} generates the output file
+{\tt HORSE.DAT} instead of {\tt HORSE}.
+
+/b (batch-view) Generates output more suitable for viewing on a
+terminal. Essentially, this means that overstruck characters get
+omitted. This is no use unless your terminal is 132
+characters wide.
+
+/i (number) (Immediate) Generates output directly on a terminal. The
+number is optional. If it is specified, say $N$, then Crudetype will
+pause every $N$ lines and type the message `print return to continue'.
+If $N=0$, Crudetype does not pause. If $N$ is not given, it defaults
+to 20.
+
+/d (file-spec) Take font files from this directory, instead of the
+default, which is {\tt TEX\_FONTS:*.TFM}
+
+/x (number), /y (number) Horizontal and vertical magnifications. As
+with /m, these are percentages; default = 100\% = keep the {\tt DVI}
+file's magnification.
+
+
+
+\sign{R.M.Damerell, Mathematics Dept, RHBNC, Egham, Surrey, UK.}
+
+
+\bye
diff --git a/dviware/crudetype/version3/w2c-ext.c b/dviware/crudetype/version3/w2c-ext.c
new file mode 100644
index 0000000000..1936da74ad
--- /dev/null
+++ b/dviware/crudetype/version3/w2c-ext.c
@@ -0,0 +1,628 @@
+/* External procedures for these programs. */
+
+/* This includes <stdio.h> and "site.h". */
+#include "w2c-ext.h"
+
+extern unsigned char xord[], xchr[];
+
+/* These help to deal with Pascal vs. C strings. */
+void make_c_string (), make_pascal_string ();
+void end_with_null (), end_with_space ();
+
+
+/* Round R to the nearest whole number. */
+integer zround (r)
+ double r;
+{
+ return r >= 0.0 ? (r + 0.5) : (r - 0.5);
+}
+
+
+/* Memory operations: variants of malloc(3) and realloc(3) that just
+ give up the ghost when they fail. It is a very bad practice to call
+ system procs & not check for errors.
+*/
+
+extern char *malloc (), *realloc ();
+
+char *xmalloc (size)
+ unsigned size;
+{
+ char *mem = malloc (size);
+
+ if (mem == NULL)
+ {
+ fprintf (stderr, "! Cannot allocate %u bytes.\n", size);
+ exit (10);
+ }
+
+ return mem;
+}
+
+
+char * xrealloc (ptr, size)
+ char *ptr;
+ unsigned size;
+{
+ char *mem = realloc (ptr, size);
+
+ if (mem == NULL)
+ {
+ fprintf (stderr, "! Cannot reallocate %u bytes at %x.\n", size, ptr);
+ exit (10);
+ }
+
+ return mem;
+}
+
+
+/* String operations. */
+
+/* Deal with C and Pascal strings. */
+
+/* Change the Pascal string P_STRING into a C string; i.e., make it
+ start after the leading character Pascal puts in, and terminate it
+ with a null. We also have to convert from the internal character set
+ (ASCII) to the external character set, if we're running on a
+ non-ASCII system.
+*/
+void make_c_string (p_string)
+ char **p_string;
+{
+ (*p_string)++;
+ end_with_null (*p_string);
+}
+
+
+/* Replace the first space we come to with a null.
+*/
+void end_with_null (s)
+ char *s;
+{
+ for ( ; *s != ' '; s++)
+#ifdef NONASCII
+ *s = xchr[*s]
+#endif
+ ;
+ *s = '\0';
+}
+
+
+/* Change the C string C_STRING into a Pascal string; i.e., make it
+ start one character before it does now (so C_STRING had better have
+ been a Pascal string originally), and terminate with a space. We
+ also convert back from the external character set to the internal
+ character set (ASCII), if we're running on a non-ASCII system.
+*/
+void make_pascal_string (c_string)
+ char **c_string;
+{
+ end_with_space (*c_string);
+ (*c_string)--;
+}
+
+/* Replace the first null we come to with a space.
+*/
+void end_with_space (s)
+ char *s;
+{
+ for ( ; *s != '\0' ; s++)
+#ifdef NONASCII
+ *s = xchr[*s]
+#endif
+ ;
+
+ *s = ' ';
+}
+
+
+/* Change the suffix of BASE (a Pascal string) to be SUFFIX (another
+ Pascal string). We have to change them to C strings to do the work,
+ then convert them back to Pascal strings.
+*/
+void makesuffix (base, suffix)
+ char *base;
+ char *suffix;
+{
+ char *last_dot, *last_slash;
+ make_c_string (&base);
+
+ last_dot = rindex (base, '.');
+ last_slash = rindex (base, '/');
+
+ if (last_dot == NULL || last_dot < last_slash) /* Add the suffix? */
+ {
+ make_c_string (&suffix);
+ strcat (base, suffix);
+ make_pascal_string (&suffix);
+ }
+
+ make_pascal_string (&base);
+}
+
+
+/* Insert the string INSERTION into TARGET before the index WHERE. We
+ assume that TARGET is large enough to hold the result.
+*/
+static void insert_string (target, where, insertion)
+ char target[];
+ int where;
+ char *insertion;
+{
+ int i;
+ unsigned insertion_length = strlen (insertion);
+ unsigned target_length = strlen (target);
+
+ for (i = target_length; i >= where; i--)
+ target[i + insertion_length] = target[i];
+
+ strncpy (target + where, insertion, insertion_length);
+}
+
+
+
+/* Path searching. */
+
+#define NUMBER_OF_PATHS 11
+
+static char *path[NUMBER_OF_PATHS];
+static char *env_var_names[NUMBER_OF_PATHS]
+ = { "BIBINPUTS", "GFFONTS", "MFBASES", "MFINPUTS", "MFPOOL",
+ "PKFONTS", "TEXFORMATS", "TEXINPUTS", "TEXPOOL",
+ "TEXFONTS", "VFFONTS"
+ };
+
+#define READ_ACCESS 4 /* Used in access(2) call. */
+
+/* What separates elements of the path variables. */
+#ifdef MS_DOS
+#define PATH_DELIMITER ';'
+#else
+#define PATH_DELIMITER ':'
+#endif
+
+/* We will need some system include files to deal with directories. */
+#ifdef SEARCH_SUBDIRECTORIES
+#include <sys/types.h>
+#include <sys/stat.h>
+#ifdef SYSV
+#include <dirent.h>
+typedef struct dirent *directory_entry_type;
+#else
+#include <sys/dir.h>
+typedef struct direct *directory_entry_type;
+#endif /* not SYSV */
+
+/* Declare getcwd(3). */
+extern char *getcwd ();
+extern int errno;
+#endif /* SEARCH_SUBDIRECTORIES */
+
+
+/* Subroutines. */
+static void next_component ();
+int is_dir ();
+
+/* Says where NAME is ok to open for reading. */
+#define READABLE_FILE(name) access (name, READ_ACCESS) == 0 && !is_dir (name)
+
+
+/* This routine initializes `path[PATH_INDEX]'. If the environment
+ variable `env_var_names[PATH_INDEX]' is not set, we simply use
+ DEFAULT_VALUE. Otherwise, we use the value of the environment
+ variable, and then replace any ``extra'' colons with DEFAULT_VALUE.
+
+ For example, if DEFAULT_VALUE is `foo', and the environment variable
+ value is `:bar::baz:', the final result will be
+ `foo:bar:foo:baz:foo'. (Of course, it is pointless to have more than
+ one extra `:' in practice, but the point is that it can be anywhere.)
+
+ If subdirectory searching has been compiled (by defining
+ SEARCH_SUBDIRECTORIES), and SUBDIR_FLAG so indicates, we look at each
+ directory in the path and add all subdirectories we find to the end
+ of the path. This is somewhat less efficient when we are looking for
+ only one file, and the file would be found early in the path, but is
+ far more efficient when we look up many files using the same path. */
+
+/* Values for SUBDIR_FLAG. */
+#define SUBDIR_NO_CHECK 0
+#define SUBDIR_ALWAYS_CHECK 1
+#define SUBDIR_CHECK_IF_NOT_DEFAULT 2
+
+static void
+do_path (path_index, default_value, subdir_flag)
+ unsigned path_index;
+ char *default_value;
+ int subdir_flag;
+{
+ char *temp;
+ char *the_path;
+
+ temp = getenv (env_var_names[path_index]);
+ if (temp == NULL)
+ /* This doesn't actually assign into the array, but it doesn't
+ matter. */
+ the_path = default_value;
+ else
+ { /* Replace extra `:'s with the system default. */
+ the_path = xmalloc (strlen (temp) + 1);
+ strcpy (the_path, temp);
+
+ if (*the_path == PATH_DELIMITER)
+ {
+ the_path = xrealloc (the_path, strlen (the_path)
+ + strlen (default_value) + 1);
+ insert_string (the_path, 0, default_value);
+ }
+ if (*(the_path + strlen (the_path) - 1) == PATH_DELIMITER)
+ {
+ the_path = xrealloc (the_path, strlen (the_path)
+ + strlen (default_value) + 1);
+ strcat (the_path, default_value);
+ }
+ while ((temp = index (temp, PATH_DELIMITER)) != NULL)
+ {
+ temp++;
+ if (*temp == PATH_DELIMITER)
+ {
+ the_path = xrealloc (the_path, strlen (the_path)
+ + strlen (default_value) + 1);
+ insert_string (the_path, temp - the_path, default_value);
+ temp++;
+ }
+ }
+ }
+
+ /* Assign to the final resting place. */
+ path[path_index] = xmalloc (strlen (the_path) + 1);
+ strcpy (path[path_index], the_path);
+
+#ifdef SEARCH_SUBDIRECTORIES
+ /* At this point, `path[path_index]' is the colon-separated list of
+ directories to search. We want to add all the subdirectories
+ directly below each of those directories. */
+ if (subdir_flag == SUBDIR_ALWAYS_CHECK
+ || (subdir_flag == SUBDIR_CHECK_IF_NOT_DEFAULT
+ && the_path != default_value))
+ {
+ DIR *dir;
+ directory_entry_type e;
+ char dirname[FILENAMESIZE];
+
+ /* Unfortunately, we can't look in the environment for the current
+ directory, because if we are running under a program (let's say
+ Emacs), the PWD variable might have been set by Emacs' parent
+ to the current directory at the time Emacs was invoked. This
+ is not necessarily the same directory the user expects to be
+ in. So, we must always call getcwd(3), even though it is slow
+ and prone to hang in networked installations. */
+ char *cwd = getcwd (NULL, FILENAMESIZE + 2);
+ if (cwd == NULL)
+ {
+ perror ("getcwd");
+ exit (errno);
+ }
+
+ temp = xmalloc (strlen (path[path_index]) + 1);
+ strcpy (temp, path[path_index]);
+
+ do
+ {
+ next_component (dirname, &temp);
+
+ /* All the `::'s should be gone by now, but we may as well make
+ sure `opendir' doesn't crash. */
+ if (*dirname == 0) continue;
+
+ /* By changing directories, we save a bunch of string
+ concatenations (and make the pathnames the kernel looks up
+ shorter). */
+ if (chdir (dirname) != 0) continue;
+
+ dir = opendir (".");
+ if (dir == NULL) continue;
+
+ while ((e = readdir (dir)) != NULL)
+ {
+ if (is_dir (e->d_name) && strcmp (e->d_name, ".") != 0
+ && strcmp (e->d_name, "..") != 0)
+ {
+ unsigned len = strlen (path[path_index]);
+ char potential[FILENAMESIZE];
+ strcpy (potential, dirname);
+ strcat (potential, "/");
+ strcat (potential, e->d_name);
+
+ path[path_index] = xrealloc (path[path_index],
+ len + strlen (potential) + 2);
+
+ len = strlen (path[path_index]);
+ *(path[path_index] + len) = PATH_DELIMITER;
+ *(path[path_index] + len + 1) = 0;
+ strcat (path[path_index], potential);
+ }
+ }
+ closedir (dir);
+
+ /* Change back to the current directory, in case the path
+ contains relative directory names. */
+ if (chdir (cwd) != 0)
+ {
+ perror (cwd);
+ exit (errno);
+ }
+ }
+ while (*temp != 0);
+ }
+#endif
+}
+
+
+/* This sets up the paths, by either copying from an environment variable
+ or using the default path, which is defined as a preprocessor symbol
+ (with the same name as the environment variable) in `site.h'. The
+ parameter PATH_BITS is a logical or of the paths we need to set.
+*/
+extern void
+setpaths (path_bits)
+ int path_bits;
+{
+ /* We must assign to the TFM file path before doing any of the other
+ font paths, since it is used as a default. */
+ if (path_bits
+ & (TFMFILEPATHBIT | GFFILEPATHBIT | PKFILEPATHBIT | VFFILEPATHBIT))
+ do_path (TFMFILEPATH, TEXFONTS, SUBDIR_ALWAYS_CHECK);
+
+ if (path_bits & BIBINPUTPATHBIT)
+ do_path (BIBINPUTPATH, BIBINPUTS, SUBDIR_NO_CHECK);
+
+ if (path_bits & GFFILEPATHBIT)
+ do_path (GFFILEPATH, path[TFMFILEPATH], SUBDIR_CHECK_IF_NOT_DEFAULT);
+
+ if (path_bits & MFBASEPATHBIT)
+ do_path (MFBASEPATH, MFBASES, SUBDIR_NO_CHECK);
+
+ if (path_bits & MFINPUTPATHBIT)
+ do_path (MFINPUTPATH, MFINPUTS, SUBDIR_ALWAYS_CHECK);
+
+ if (path_bits & MFPOOLPATHBIT)
+ do_path (MFPOOLPATH, MFPOOL, SUBDIR_NO_CHECK);
+
+ if (path_bits & PKFILEPATHBIT)
+ do_path (PKFILEPATH, path[TFMFILEPATH], SUBDIR_CHECK_IF_NOT_DEFAULT);
+
+ if (path_bits & TEXFORMATPATHBIT)
+ do_path (TEXFORMATPATH, TEXFORMATS, SUBDIR_NO_CHECK);
+
+ if (path_bits & TEXINPUTPATHBIT)
+ do_path (TEXINPUTPATH, TEXINPUTS, SUBDIR_ALWAYS_CHECK);
+
+ if (path_bits & TEXPOOLPATHBIT)
+ do_path (TEXPOOLPATH, TEXPOOL, SUBDIR_NO_CHECK);
+
+ if (path_bits & VFFILEPATHBIT)
+ do_path (VFFILEPATH, path[TFMFILEPATH], SUBDIR_CHECK_IF_NOT_DEFAULT);
+}
+
+
+/* Look for NAME, a Pascal string, in a colon-separated list of
+ directories. The path to use is given (indirectly) by PATH_INDEX.
+ If the search is successful, leave the full pathname in NAME (which
+ therefore must have enough room for such a pathname), padded with
+ blanks. Otherwise, or if NAME is an absolute or relative pathname,
+ just leave it alone.
+*/
+boolean
+testreadaccess (name, path_index)
+ char *name;
+ int path_index;
+{
+ char potential[FILENAMESIZE];
+ int ok = 0;
+ char *the_path = path[path_index];
+ char *saved_path = the_path;
+
+ make_c_string (&name);
+
+ if (*name == '/' || *name == '~'
+ || (*name == '.' && *(name + 1) == '/')
+ || (*name == '.' && *(name + 1) == '.' && *(name + 2) == '/'))
+ ok = READABLE_FILE (name);
+ else
+ {
+ do
+ {
+ next_component (potential, &the_path);
+
+ if (*potential != 0)
+ {
+ strcat (potential, "/");
+ strcat (potential, name);
+ ok = READABLE_FILE (potential);
+ }
+ }
+ while (!ok && *the_path != 0);
+
+ /* If we found it, leave the answer in NAME. */
+ if (ok)
+ strcpy (name, potential);
+ }
+
+ make_pascal_string (&name);
+
+ return ok;
+}
+
+
+/* Return, in NAME, the next component of PATH, i.e., the characters up
+ to the next PATH_DELIMITER.
+*/
+static void next_component (name, path)
+ char name[];
+ char **path;
+{
+ unsigned count = 0;
+
+ while (**path != 0 && **path != PATH_DELIMITER)
+ {
+ name[count++] = **path;
+ (*path)++; /* Move further along, even between calls. */
+ }
+
+ name[count] = 0;
+ if (**path == PATH_DELIMITER)
+ (*path)++; /* Move past the delimiter. */
+}
+
+
+
+/* Return true if FN is a directory or a symlink to a directory,
+ false if not.
+*/
+int
+is_dir (fn)
+ char *fn;
+{
+ struct stat stats;
+
+ return stat (fn, &stats) == 0 && (stats.st_mode & S_IFMT) == S_IFDIR;
+}
+
+
+
+/* File operations. */
+
+/* Open a file; don't return if any error occurs. NAME is a Pascal
+ string, but is changed to a C string and not changed back.
+ RMD: I do want it changed back
+*/
+FILE * checked_fopen (name, mode)
+ char *name;
+ char *mode;
+{
+ FILE *result;
+ char *cp;
+
+ make_c_string (&name);
+
+ result = fopen (name, mode);
+ if (result != NULL) {
+ make_pascal_string (&name);
+ return result;}
+
+ perror (name);
+ exit (1);
+ /*NOTREACHED*/
+}
+
+
+/* Return true if we're at the end of FILE, else false. This implements
+ Pascal's `eof' builtin.
+*/
+boolean test_eof (file)
+ text file;
+{
+ register int c;
+ FILE *ff ;
+ /* Maybe we're already at the end? */
+ ff = *file ;
+ if (feof( ff))
+ return true;
+
+ if ((c = getc (*file)) == EOF)
+ return true;
+
+ /* Whoops, we weren't at the end. Back up. */
+ (void) ungetc (c, *file);
+
+ return false;
+}
+
+
+/* Return true on end-of-line in FILE or at the end of FILE, else false.
+*/
+
+boolean eoln (file)
+ text file;
+{
+ register int c;
+
+ if (feof (*file))
+ return true;
+
+ c = getc (*file);
+
+ if (c != EOF)
+ (void) ungetc (c, *file);
+
+ return c == '\n' || c == EOF;
+}
+
+
+/* Print real number R in the Pascal format N:M on the file F.
+RMD: these procs not used; I made web2c generate proper write statements.
+*/
+void fprintreal (f, r, n, m)
+ text f;
+ double r;
+ int n, m;
+{
+ char fmt[50]; /* Surely enough, since N and M won't be more than 25
+ digits each! */
+
+ (void) sprintf (fmt, "%%%d.%dlf", n, m);
+ (void) fprintf (*f, fmt, r);
+}
+
+
+/* Print S, a Pascal string, on the file F. It starts at index 1 and is
+ terminated by a space.
+*/
+static void fprint_pascal_string (s, f)
+ char *s;
+ FILE *f;
+{
+ s++;
+ while (*s != ' ') putc (*s++, f);
+}
+
+/* Print S, a Pascal string, on stdout.
+*/
+void printpascalstring (s)
+ char *s;
+{
+ fprint_pascal_string (s, stdout);
+}
+
+/* Ditto, for stderr.
+*/
+void errprintpascalstring (s)
+ char *s;
+{
+ fprint_pascal_string (s, stderr);
+}
+
+/* Read an integer from the file F, reading past the subsequent end of
+ line.
+*/
+integer inputint (f)
+ text f;
+{
+ char buffer[50]; /* Long enough for anything reasonable. */
+
+ return
+ fgets (buffer, sizeof (buffer), *f)
+ ? atoi (buffer)
+ : 0;
+}
+
+/* Read three integers from stdin.
+*/
+void zinput3ints (a,b,c)
+ integer *a, *b, *c;
+{
+ while (scanf ("%ld %ld %ld\n", a, b, c) != 3)
+ (void) fprintf (stderr, "Please enter three integers.\n");
+}
+
+
diff --git a/dviware/crudetype/version3/w2c-ext.h b/dviware/crudetype/version3/w2c-ext.h
new file mode 100644
index 0000000000..c8465eae85
--- /dev/null
+++ b/dviware/crudetype/version3/w2c-ext.h
@@ -0,0 +1,137 @@
+/* Main include file for this implementation. Everybody includes this. */
+
+#ifndef EXTRA_H
+#define EXTRA_H
+
+#include <stdio.h>
+#include "site.h"
+
+/* pltotf et al. use the symbol `index' themselves; we don't want to
+ redefine it in those cases (and those programs don't use the other
+ string functions, fortunately). */
+#ifndef index
+#ifndef BSD
+#include <string.h>
+#define index strchr
+#define rindex strrchr
+#else /* BSD */
+#include <strings.h>
+#endif /* BSD */
+#endif /* not index */
+
+extern char *getenv (), *rindex ();
+extern SPRINTF_RETURN_TYPE sprintf ();
+
+
+/* Global constants. */
+#define true 1
+#define false 0
+
+/* Path searching. The `...PATH' constants are used both as indices and
+ just as enumeration values. Their values must match the
+ initialization of `env_var_names' in extra.c. The `...PATHBIT'
+ constants are used in the argument to `setpaths'. */
+#define BIBINPUTPATH 0
+#define BIBINPUTPATHBIT (1 << BIBINPUTPATH)
+#define GFFILEPATH 1
+#define GFFILEPATHBIT (1 << GFFILEPATH)
+#define MFBASEPATH 2
+#define MFBASEPATHBIT (1 << MFBASEPATH)
+#define MFINPUTPATH 3
+#define MFINPUTPATHBIT (1 << MFINPUTPATH)
+#define MFPOOLPATH 4
+#define MFPOOLPATHBIT (1 << MFPOOLPATH)
+#define PKFILEPATH 5
+#define PKFILEPATHBIT (1 << PKFILEPATH)
+#define TEXFORMATPATH 6
+#define TEXFORMATPATHBIT (1 << TEXFORMATPATH)
+#define TEXINPUTPATH 7
+#define TEXINPUTPATHBIT (1 << TEXINPUTPATH)
+#define TEXPOOLPATH 8
+#define TEXPOOLPATHBIT (1 << TEXPOOLPATH)
+#define TFMFILEPATH 9
+#define TFMFILEPATHBIT (1 << TFMFILEPATH)
+#define VFFILEPATH 10
+#define VFFILEPATHBIT (1 << VFFILEPATH)
+
+/* For some initializations of constant strings. */
+typedef char *ccharpointer;
+
+/* We need one global variable. */
+extern integer argc;
+
+/* Globally needed routines we can implement as macros. */
+#define abs(x) ((x) >= 0 ? (x) : -(x)) /*Integer abs*/
+#define fabs(x) ((x) >= 0.0 ? (x) : -(x)) /*real*/
+#define odd(x) ((x) % 2)
+#define ord(x) (x)
+#define chr(x) (char)(x)
+#define round(x) zround ((double) (x))
+#define incr(x) ++(x)
+#define decr(x) --(x)
+#define toint(x) ((integer) (x))
+#define trunc(x) ((integer) (x))
+/* ``Unix exit'', since WEB already defines the symbol `exit'. */
+#define uexit exit
+#define dispose( x) ( free( (char*) x))
+
+
+/* C doesn't distinguish between text files and other files. */
+typedef FILE *file_ptr;
+typedef file_ptr text[1] ;
+
+
+/*File functions. All altered by RMD as you need an extra level of pointer*/
+#define eof(f) test_eof (f)
+#define flush(f) (void) fflush (*f)
+#define Fputs(f, s) (void) fputs (s, *f) /* fixwrites outputs this. */
+#define input3ints(a, b, c) zinput3ints (&a, &b, &c)
+#define printreal(r, n, m) fprintreal (stdout, r, n, m)
+#define putbyte(x, f) putc ((char) (x) & 255, *f)
+#define read(f, b) ((b) = getc (*f))
+#define readln(f) { register c; \
+ while ((c = getc (*f)) != '\n' && c != EOF); }
+#define page(file) putc( '\f', *file)
+
+/* Open files for reading and writing. */
+#define reset(f, n) \
+ ((*f) ? fclose (*f) : 0), (*f) = checked_fopen ((char *) (n), "r")
+#define rewrite(f, n) \
+ (*f) = checked_fopen ((char *) (n), "w")
+
+/* For throwing away input from the file F. */
+#define vgetc(f) (void) getc (*f)
+
+/* If we don't care that strcpy(3) returns A. */
+#define vstrcpy(a, b) (void) strcpy (a, b)
+
+/* Write out elements START through END of BUF to the file F. */
+#define writechunk(f, buf, start, end) \
+ (void) fwrite (&buf[start], sizeof (buf[start]), end - start + 1, *f)
+
+/* Like fseek(3), but cast the arguments and ignore the return value. */
+#define checkedfseek(f, n, w) (void) fseek(*f, (long) n, (int) w)
+
+
+/* Routines in extra.c and main.c. */
+#ifdef ANSI
+extern void argv (int, char[]);
+extern FILE *checked_fopen (char *, char *);
+extern boolean eoln (text);
+extern void fprintreal (text, double, int, int);
+extern integer inputint (text);
+extern char *xmalloc (unsigned), *xrealloc (char *, unsigned);
+extern integer zround (double);
+#else /* not ANSI */
+extern void argv ();
+extern FILE *checked_fopen ();
+extern boolean eoln ();
+extern void fprintreal ();
+extern integer inputint();
+extern void fprintreal ();
+extern char *xmalloc (), *xrealloc ();
+extern integer zround ();
+#endif /* not ANSI */
+
+#endif /* not EXTRA_H */
+
diff --git a/dviware/crudetype/version3/w2c-main.c b/dviware/crudetype/version3/w2c-main.c
new file mode 100644
index 0000000000..dcf8792557
--- /dev/null
+++ b/dviware/crudetype/version3/w2c-main.c
@@ -0,0 +1,41 @@
+/* main.c -- the usual main program. */
+
+#include "w2c-ext.h"
+
+
+/* The command line is stored here, since Pascal has usurped `argv'
+ for a procedure. */
+static char **gargv;
+
+/* Referenced from the Pascal, so not static. */
+integer argc;
+
+
+/* The entry point for all the programs except TeX and Metafont, which
+ have more to do. We just have to set up the command line. Pascal's
+ main block is transformed into the procedure `main_body'. */
+
+void
+main (ac, av)
+ int ac;
+ char **av;
+{
+ argc = ac;
+ gargv = av;
+ main_body ();
+ exit (0);
+}
+
+
+/* Read the Nth argument from the command line. BUF is a Pascal
+ string, i.e., it starts at index 1 and ends with a space. */
+
+void
+argv (n, buf)
+ int n;
+ char buf[];
+{
+ (void) strcpy (buf + 1, gargv[n]);
+ (void) strcat (buf + 1, " ");
+}
+
diff --git a/dviware/crudetype/version3/w2c-symtab.h b/dviware/crudetype/version3/w2c-symtab.h
new file mode 100644
index 0000000000..1129c6e7ce
--- /dev/null
+++ b/dviware/crudetype/version3/w2c-symtab.h
@@ -0,0 +1,29 @@
+/*
+ * This is the one thing we need to include in web2c.c as well as
+ * in other modules which include web2c.h.
+ */
+
+struct sym_entry {
+ char *id; /* points to the identifier */
+ int typ; /* token type */
+ int next; /* next symbol entry */
+ long val; /* constant : value
+ subrange type : lower bound */
+ long upper; /* subrange type : upper bound
+ variable, type or field : type length */
+ int val_sym, upper_sym; /* Sym table entries of symbols for lower
+ and upper bounds. On a function: point to
+ first and last formals.
+ */
+ char *arg_typ; /* If a var id was defined by a type-id, this points
+ to the type-id. On a field of a with record, points
+ to the record variable. In both cases, points into
+ STRINGS. Point at "vvoid" if no id was given. */
+ int top_type, sub_type ; /* Try to specify types of var. or type or field*/
+ boolean var_formal; /*TRUE if this is a formal parameter by reference
+ or a FORWARD proc.*/
+ boolean need_var;
+ /* TRUE this is a formal parameter and must be passed by pointer
+ */
+};
+
diff --git a/dviware/crudetype/version3/w2c.c b/dviware/crudetype/version3/w2c.c
new file mode 100644
index 0000000000..cf907502b4
--- /dev/null
+++ b/dviware/crudetype/version3/w2c.c
@@ -0,0 +1,623 @@
+/*
+ * This program converts (mostly) the pseudo-Pascal generated by Tangle to C.
+ * The output depends on many C macros and some postprocessing by other
+ * programs.
+ *
+ * Arguments:
+ * -f: force strict interpretation of semantics of for stmt
+ * (never used with TeX and friends)
+ * -t: special optimizations for tex.p->tex.c
+ * -m: special optimizations for mf.p->mf.c
+ * -c: supply part of the name of the coerce.h file
+ * -h: supply the name of the standard header file
+ * -a: generate ANSI-style function prototypes
+ *
+ * The majority of this program (which includes ptoc.yacc and ptoc.lex)
+ * was written by Tomas Rokicki, with modifications by Tim Morgan.
+ */
+
+#include <stdio.h>
+#include "w2cy.h"
+#include "w2c.h"
+
+#define max_line_length (78)
+#define ex_32 (2)
+#define ex_real (3)
+#define max(a,b) ((a>b)?a:b)
+
+int last_tok;
+int tex = 0, strict_for = 0, mf = 0;
+
+char safe_string[80], vvoid [] = "void\0";
+
+char field_list[200];
+char last_id[80];
+char next_temp[] = "zzzaa";
+/* Default names */
+char coerce_name[100] = "coerce.h";
+char comm_file[100] = "w2c.defines" ;
+
+
+long last_i_num;
+int ii, l_s;
+long lower_bound, upper_bound;
+extern FILE *fopen();
+
+int pf_count = 1;
+#ifdef ANSI
+boolean ansi=TRUE;
+#else
+boolean ansi=FALSE;
+#endif
+char *std_header="w2c-ext.h"; /* Default include filename */
+
+extern int yyleng;
+extern int yylineno;
+
+#define id_char(x) \
+ ((x >= 'a' && x <= 'z') || (x >= 'A' && x <= 'Z') || \
+ (x >= '0' && x <= '9'))
+
+void find_next_temp()
+{
+ next_temp[4]++;
+ if (next_temp[4] > 'z') {
+ next_temp[4] = 'a';
+ next_temp[3]++;
+ }
+}
+
+/* Normally, output goes to std. These functions switch output
+on or off, or divert it.*/
+
+int indent = 0;
+int line_pos=0, str_pos=0;
+int last_brace = 0;
+int block_level = 0;
+boolean want_space = FALSE, str_space = FALSE ;
+char *sink;
+FILE *std;
+FILE *coerce;
+
+void normal()
+{
+ std = stdout;
+ sink = 0;
+}
+
+void silent()
+{
+ std = 0 ;
+ sink = 0;
+}
+
+/*Divert output to string s */
+void to_string(s) char *s;
+{
+ std = 0 ;
+ sink = s;
+ *s = '\0' ;
+ str_space = FALSE ;
+ str_pos = 0 ;
+}
+
+void new_line()
+{if (std && (line_pos > 0))
+ {
+ if ( fputc('\n', std) == EOF) perror( "fputc");
+ line_pos = 0;
+ want_space = FALSE ;
+ }
+else if (sink && (str_pos > 0))
+ {
+ (void) strcat( sink, "\n") ;
+ str_pos = 0;
+ str_space = FALSE ;
+ }
+ }
+
+void my_output(s) char *s;
+{
+ int len = strlen(s);
+ int less_indent = 0;
+ char c = s[len-1], *n ;
+ if (len==0) return ;
+ last_brace = ( c == '}');
+ if (std) {
+ if ((line_pos + len > max_line_length) ||
+ ( *s == '#' && line_pos > 0))
+ new_line();
+ if (indent > 1 && (strcmp(s, "case") == 0 || strcmp(s, "default") == 0))
+ less_indent = 2;
+ if( *s != '#')
+ /*CPP commands must not be indented*/
+ while (line_pos < indent*2 - less_indent) {
+ if ( fputs(" ", std) == EOF) perror( "fputs");
+ line_pos += 2;
+ }
+ if (want_space && id_char (*s))
+ { line_pos += 1;
+ if ( fputc(' ', std) == EOF) perror( "fputc");
+ }
+ if ( fputs(s, std) == EOF) perror( "fputs");
+ want_space = id_char(c) ;
+ n = rindex( s, '\n') ;
+ if (n) line_pos = strlen(n) -1 ;
+ else line_pos += len ;
+ }
+ else if (sink) {
+ if ((str_pos + len > max_line_length) || ( *s == '#'))
+ new_line();
+ /* if (indent > 1 && (strcmp(s, "case") == 0 || strcmp(s, "default") == 0))
+ less_indent = 2;
+ if( *s != '#') */
+ /*CPP commands must not be indented*/
+ /* while (line_pos < indent*2 - less_indent) {
+ (void) strcat ( sink, " ") ;
+ line_pos += 2;
+ } */
+ if (str_space && id_char (*s))
+ { str_pos += 1;
+ (void) strcat ( sink, " ") ;
+ }
+ (void) strcat(sink , s);
+ str_space = id_char(c) ;
+ n = rindex( s, '\n') ;
+ if (n) str_pos = strlen(n) -1 ;
+ else str_pos += len ;
+ }
+}
+
+void semicolon()
+{
+ if (!last_brace) {
+ my_output(";");
+ new_line();
+ last_brace = 1;
+ }
+}
+
+void yyerror(s) char *s;
+{
+ (void) fflush(stdout);
+ (void) fprintf(stderr, " %s\n", s);
+ (void) fprintf(stderr, "Last token - %d\n", last_tok);
+ (void) fprintf(stderr, "Error buffer = %s\n", yytext);
+ (void) fprintf(stderr, "Last id - %s Line number %d\n", last_id, yylineno);
+ ii = search_table(last_id);
+ if (ii == -1)
+ (void) fprintf(stderr, "Not in symbol table!\n");
+ else
+ switch (sym_table[ii].typ) {
+ case undef_id_tok:
+ (void) fprintf(stderr, "Undefined\n");
+ break;
+ case var_id_tok:
+ (void) fprintf(stderr, "Variable\n");
+ break;
+ case const_id_tok:
+ (void) fprintf(stderr, "Constant\n");
+ break;
+ case type_id_tok:
+ (void) fprintf(stderr, "Type\n");
+ break;
+ case proc_id_tok:
+ (void) fprintf(stderr, "Procedure\n");
+ break;
+ case proc_forwd_tok:
+ (void) fprintf(stderr, "Procedure forward\n");
+ break;
+ case fun_id_tok:
+ (void) fprintf(stderr, "Function\n");
+ break;
+ case file_id_tok:
+ (void) fprintf(stderr, "File id\n");
+ break;
+ case fun_forwd_tok:
+ (void) fprintf(stderr, "Function forward\n");
+ break;
+ default:
+ (void) fprintf(stderr, "Unknown!\n");
+ break;
+ }
+ (void) fprintf(stderr, "Next sym free = %d\n", last_sym_used);
+/* (void) fprintf(stderr, "Mark sym = %d\n", mark_sym_used);*/
+ (void) fprintf(stderr, "Next string free = %d\n", next_string_free);
+/* (void) fprintf(stderr, "Mark string = %d\n", mark_string_free);*/
+}
+
+/*Other error messages*/
+void err_mes(s) char *s ;
+{
+ (void) fprintf(stderr, "error: %s line number %d\n", s, yylineno);
+}
+
+/*
+Managing the table of identifiers. The ids themselves are stored in strings.
+They are found via the hash table hash_list. If ss is an id, then
+hash_list[hash(ss)] points to the beginning of a list of ids in sym_table.
+This list contains all ids with the same hash, linked via their next fields.
+last_sym_used (previously mis-named next_sym_free) addresses the latest used
+place in sym_table.
+*/
+
+#define max_strings (20000)
+#define hash_prime (101)
+#define sym_table_size (3000)
+#define max_stack (100)
+
+char strings[max_strings];
+int hash_list[hash_prime];
+short sym_stack[max_stack], string_stack[max_stack];
+int depth = 0 ;
+#ifdef MS_DOS
+struct sym_entry huge sym_table[sym_table_size];
+#else
+struct sym_entry sym_table[sym_table_size];
+#endif
+
+int last_sym_used = 0, next_string_free = 0;
+
+int hash(id) char *id;
+{
+ register int i = 0, j;
+ for (j = 0; id[j] != 0; j++)
+ i = (i + i + id[j]) % hash_prime;
+ return (i);
+}
+
+/*Find the hash code and run along its linked list*/
+int search_table(id) char *id;
+{
+ int ptr;
+ ptr = hash_list[hash(id)];
+ while (ptr) {
+ if (strcmp(id, sym_table[ptr].id) == 0)
+ return (ptr);
+ else
+ ptr = sym_table[ptr].next;
+ }
+ return (0);
+}
+
+#define unused (271828)
+
+struct sym_entry dummy =
+ { 0, 0, 0, unused, 0, 0, 0, 0, 0, 0, FALSE, FALSE} ;
+
+/*Insert the new id at the front of its hash code's linked list. This hides any
+previous use of the id.*/
+int add_to_table(id) char *id;
+{
+ int h, ptr;
+ h = hash(id);
+ ptr = hash_list[h];
+ hash_list[h] = (++last_sym_used);
+ sym_table[last_sym_used] = dummy ;
+ sym_table[last_sym_used].next = ptr;
+ sym_table[last_sym_used].val = unused;
+ sym_table[last_sym_used].id = strings + next_string_free;
+ (void) strcpy(strings + next_string_free, id);
+ next_string_free += strlen(id) + 1;
+ return (last_sym_used);
+}
+
+/*Mark all current ids as belonging to the previous stack frame*/
+void mark()
+{
+ sym_stack[depth-1] = last_sym_used;
+ string_stack[depth-1] = next_string_free;
+}
+
+/*Push a stack frame*/
+void push_stack()
+{
+ if (depth >= max_stack) {
+ err_mes ("Fatal: stack overflow");
+ exit(1);
+ }
+ sym_stack[depth] = last_sym_used;
+ string_stack[depth] = next_string_free;
+ depth ++ ;
+}
+
+/*Hide all ids from p to q inclusive. */
+void hide_ids( p, q)
+int p, q;
+{
+ int h, ptr, n;
+ for (h = 0; h < hash_prime; h++) {
+ ptr = hash_list[h];
+ while (ptr >= p && ptr <= q)
+ ptr = sym_table[ptr].next;
+ hash_list[h] = ptr;
+ while (ptr)
+ {
+ n=ptr;
+ ptr = sym_table[ptr].next;
+ while (ptr >= p && ptr <= q)
+ ptr = sym_table[ptr].next;
+ sym_table[n].next = ptr ;
+ }
+ }
+}
+
+/*Pop a stack frame*/
+void pop_stack()
+{
+ if (depth == 0) {
+ err_mes ("Fatal: POP at level 0");
+ exit(1);
+ }
+ depth--;
+ hide_ids( sym_stack[depth] +1, last_sym_used ) ;
+ last_sym_used = sym_stack[depth] ;
+ next_string_free = string_stack[depth] ;
+}
+
+/*Un-hide ids from p to q. Each id goes at the head of its hash code's list.
+*/
+void unhide_ids( p, q)
+int p, q;
+{
+ int h, n, m; char *i ;
+ for (n = p; n <=q ; n++) {
+ i = sym_table[n].id ;
+ h = add_to_table(i);
+ m = sym_table[h].next ;
+ sym_table[h] = sym_table[n] ;
+ sym_table[h].next = m ;
+ }
+}
+
+/*Mark a proc. as 'forward'. fun points to the proc's name; the formal params
+go from fun+1 to last_sym_used. They must be hidden for later re-use. */
+void forward( fun)
+int fun ;
+{
+ sym_table[fun].var_formal = TRUE ;
+ hide_ids( sym_table[fun].val_sym , sym_table[fun].upper_sym);
+ if (sym_table[fun].typ == fun_id_tok)
+ sym_table[fun].typ = fun_forwd_tok ;
+ else if (sym_table[fun].typ == proc_id_tok)
+ sym_table[fun].typ = proc_forwd_tok ;
+ else err_mes( "FORWARD on non-proc") ;
+ mark();
+}
+
+/*Do this when a forward proc is being defined*/
+void un_forward( fun)
+int fun ;
+{
+ unhide_ids(
+ sym_table[fun].val_sym,
+ sym_table[fun].upper_sym) ;
+ if (sym_table[fun].typ == fun_forwd_tok)
+ sym_table[fun].typ = fun_id_tok ;
+ else if (sym_table[fun].typ == proc_forwd_tok)
+ sym_table[fun].typ = proc_id_tok ;
+ else err_mes( "FORWARD on non-proc") ;
+}
+
+/*Generate prototype and call macro for function fun. The call macro is needed
+for some Pascal var parameters; but it is too complicated to decide exactly when
+it is needed, so we simply use a macro whenever the fun. has parameters.*/
+void do_prototype( fun, extrn)
+int fun ;
+boolean extrn;
+{
+ int i, m, n; char *result, *name, z_id[100];
+ struct sym_entry cur_sym;
+ cur_sym = sym_table[fun] ;
+ m = cur_sym.val_sym ;
+ n = cur_sym.upper_sym ;
+ if (cur_sym.arg_typ)
+ result = cur_sym.arg_typ ;
+ else result = vvoid ;
+ name = cur_sym.id ;
+ if (n==0) /*no parameters*/
+ strcpy( z_id, name) ;
+ else if ( sprintf( z_id, "z%s", name) == NULL) perror( "sprintf");
+
+ /* ANSI style prototype */
+ if ( fprintf( coerce, "\n#ifdef ANSI \n" ) == EOF) perror( "fprintf");
+ if ( fprintf( coerce, "%s%s %s(",
+ (extrn)?"extern ":"" , result, z_id) == EOF) perror( "fprintf") ;
+ if (n == 0) { if ( fprintf(coerce, "void") == EOF) perror( "fprintf"); }
+ else {
+ for (i=m; i<=n; i++) {
+ if ( fprintf( coerce, " %s%s",
+ sym_table[i].arg_typ ,
+ (sym_table[i].need_var)?"*":"")
+ == EOF) perror( "fprintf");
+ if (i<n) if ( fputc(',', coerce) == EOF) perror( "fputc") ;
+ }}
+ if ( fprintf(coerce, ");\n#else /* not ANSI*/ \n") == EOF) perror( "fprintf");
+
+ /* Non-ANSI style prototype */
+ if ( fprintf( coerce, "%s%s %s();\n",
+ (extrn)?"extern ":"" , result, z_id) == EOF) perror( "fprintf") ;
+ if ( fprintf( coerce, "#endif /* ANSI*/ \n") == EOF) perror( "fprintf");
+
+ /* This part defines the call macro*/
+ if (n!=0) {
+ if ( fprintf(coerce, "#define %s(", name) == EOF) perror( "fprintf");
+ for (i=m; i<=n; i++) {
+ if ( fprintf(coerce, " %s%s",
+ sym_table[i].id,
+ (i<n)?",":"" ) == EOF) perror( "fprintf");
+ }
+ if ( fprintf(coerce, ") %s( ", z_id) == EOF) perror( "fprintf");
+ for (i=m; i<=n; i++) {
+ if (i > m)
+ if ( fprintf(coerce, ", ") == EOF) perror( "fprintf") ;
+ cur_sym =sym_table[i] ;
+ if ((cur_sym.top_type==is_int)
+ || (cur_sym.top_type==is_point)
+ || (cur_sym.top_type==is_real)
+ || cur_sym.need_var ) {
+ if ( fprintf(coerce, "(%s%s) %s(%s)",
+ cur_sym.arg_typ,
+ cur_sym.need_var?"*":"",
+ cur_sym.need_var?"&":"",
+ cur_sym.id ) == EOF) perror( "fprintf") ;}
+ else
+ if ( fprintf(coerce, "%s",
+ cur_sym.id ) == EOF) perror( "fprintf") ;
+ }
+ if ( fprintf(coerce, ")\n") == EOF) perror( "fprintf");
+ }
+ if ( fflush(coerce) == EOF) perror( "fflush");
+}
+
+/*Write the function header for fun*/
+void gen_function_head(fun)
+int fun ;
+{ int i, m, n; char *result, *name, z_id[100], out_string[300];
+ struct sym_entry cur_sym;
+ cur_sym = sym_table[fun] ;
+ if ( fflush(std) == EOF) perror( "fflush");
+ m = cur_sym.val_sym ;
+ n = cur_sym.upper_sym ;
+ if (cur_sym.arg_typ)
+ result = cur_sym.arg_typ ;
+ else result = vvoid ;
+ name = cur_sym.id ;
+ if (n==0) /*no parameters*/
+ strcpy( z_id, name) ;
+ else if ( sprintf( z_id, "z%s", name) == NULL) perror( "sprintf");
+
+ /* This part defines the memory word stuff.*/
+ if (tex) {
+ if (uses_mem && uses_eqtb){
+ if ( fprintf(coerce,
+ "#define %s_regmem register memoryword *mem=zmem, *eqtb=zeqtb;\n",
+ my_routine) == EOF) perror( "fprintf");}
+ else if (uses_mem){
+ if ( fprintf(coerce,
+ "#define %s_regmem register memoryword *mem=zmem;\n",
+ my_routine) == EOF) perror( "fprintf");}
+ else if (uses_eqtb){
+ if ( fprintf(coerce,
+ "#define %s_regmem register memoryword *eqtb=zeqtb;\n",
+ my_routine) == EOF) perror( "fprintf");}
+ else{
+ if ( fprintf(coerce,
+ "#define %s_regmem\n",
+ my_routine) == EOF) perror( "fprintf");}
+ }
+
+ /* This part defines the actual header -- ANSI--*/
+ new_line(); my_output("\n") ;
+ my_output( "#ifdef ANSI \n");
+ if ( sprintf( out_string, "%s %s(",
+ result, z_id) == NULL) perror( "sprintf") ;
+ my_output(out_string);
+ if (n) {
+ for (i=m; i<=n; i++) {
+ if ( sprintf( out_string, " %s %s%s%s",
+ sym_table[i].arg_typ,
+ (sym_table[i].need_var)?"*":"" ,
+ sym_table[i].id,
+ (i<n)?",":"" ) == NULL) perror( "sprintf") ;
+ my_output(out_string);
+ }}
+ else my_output( "void") ;
+ my_output( ")\n") ;
+
+ /* Not ANSI*/
+ my_output( "#else /* not ANSI*/ \n");
+ if ( sprintf( out_string, "%s %s(",
+ result, z_id) == NULL) perror( "sprintf") ;
+ my_output(out_string);
+ if (n) {
+ for (i=m; i<=n; i++) {
+ if ( sprintf( out_string, " %s%s",
+ sym_table[i].id,
+ (i<n)?",":"" ) == NULL) perror( "sprintf") ;
+ my_output(out_string);
+ }}
+ my_output( ")\n") ;
+ if (n) {
+ for (i=m; i<=n; i++) {
+ if ( sprintf( out_string, " %s %s%s;\n",
+ sym_table[i].arg_typ,
+ (sym_table[i].need_var)?"*":"" ,
+ sym_table[i].id ) == NULL) perror( "sprintf") ;
+ my_output(out_string);
+ }}
+ my_output( "#endif /* ANSI*/ \n");
+}
+
+/* Deal with input. Idea is to read the common defs and then the Pascal
+file (which comes from stdin) This lets us give the line no. of errors
+*/
+extern FILE *yyin;
+
+/* Called by LEX on end-of-file*/
+int yywrap()
+{
+ if (yyin == stdin)
+ return (1) ;
+ else {
+ yyin = stdin ;
+ yylineno = 1 ;
+ return (0);
+ }}
+
+void initialize()
+{
+ register int i;
+ for (i = 0; i < hash_prime; hash_list[i++] = 0);
+ for ( i=0; i<=max_stack; sym_stack[i++] = 0) ;
+ normal();
+ if(( coerce = fopen(coerce_name, "w")) == NULL)
+ perror( "Open coerce");
+ if(( yyin = fopen(comm_file, "r")) == NULL)
+ perror( "Open common");
+}
+
+#ifdef ANSI
+void
+#endif
+main(argc, argv)
+int argc;
+char *argv[];
+{
+ int error, i;
+
+ for (i=1; i < argc; i++) if (argv[i][0] == '-') switch (argv[i][1]) {
+ case 't':
+ tex = TRUE;
+ break;
+ case 'm':
+ mf = TRUE;
+ break;
+ case 'f':
+ strict_for = TRUE;
+ break;
+ case 'h':
+ std_header = &argv[i][2];
+ break;
+ case 'a':
+ ansi = TRUE;
+ break;
+ case 'c':
+ { if ( sprintf(coerce_name, "%s.h", &argv[i][2]) == NULL) perror( "sprintf");}
+ break;
+ case 'd':
+ strcpy(comm_file, &argv[i][2]) ;
+ break;
+ default:
+ fprintf(stderr, "Unknown option %s, ignored\n", argv[i]);
+ break;
+ }
+ else {
+ fprintf(stderr, "Unknown option %s, ignored\n", argv[i]);
+ }
+ initialize();
+ error = yyparse();
+ new_line();
+ (void) fprintf(stderr, "\n%d symbols.\n", last_sym_used);
+ exit(error);
+}
diff --git a/dviware/crudetype/version3/w2c.defines b/dviware/crudetype/version3/w2c.defines
new file mode 100644
index 0000000000..d1cd6bf3aa
--- /dev/null
+++ b/dviware/crudetype/version3/w2c.defines
@@ -0,0 +1,93 @@
+{This file is concatenated by ./convert to the beginning of the Pascal
+ code that tangle outputs. The idea is to put all these symbols, which
+ can be defined as macros or functions, or as part of standard C, into
+ web2c's symbol table, so that we can access them from a change file.
+ Some are standard Pascal functions, others are simply used in our
+ implementation.
+
+ web2c.yacc can parse these @define statements.}
+
+{The fields in gftodvi's memory_word structure, defined in
+ `mfware/memory.h'; `qqqq' is also in TeX and Metafont.}
+@define @field qqqq;
+@define @field sc;
+
+@define const false;
+@define const BIBINPUTPATH;
+@define const BIBINPUTPATHBIT;
+@define const FILENAMESIZE;
+@define const GFFILEPATH;
+@define const GFFILEPATHBIT;
+@define const MFINPUTPATH;
+@define const MFINPUTPATHBIT;
+@define const PKFILEPATH;
+@define const PKFILEPATHBIT;
+@define const stderr;
+@define const stdin;
+@define const stdout;
+@define const TEXINPUTPATH;
+@define const TEXINPUTPATHBIT;
+@define const TFMFILEPATH;
+@define const TFMFILEPATHBIT;
+@define const true;
+@define const VFFILEPATH;
+@define const VFFILEPATHBIT;
+
+@define type real;
+@define type integer;
+type char = 0..255;
+type alphafile = file of char ;
+@define type text ;
+type boolean = 0..1;
+type ccharpointer = ^char ;
+@define type memoryword; {for gftodvi, TeX, and Metafont}
+
+@define var argc;
+{These two are needed in BibTeX; see bibtex.ch.}
+@define var standardinput;
+@define var standardoutput;
+
+@define function abs: integer;
+@define function fabs: real;
+@define function aopenin: boolean;
+@define function aopenout: boolean;
+@define function chr:char;
+@define function eof: boolean;
+@define function eoln: boolean;
+@define function feof: boolean ;
+@define function ftell: integer ;
+@define function getc: char;
+@define function inputint: integer;
+@define function odd:boolean;
+@define function ord:integer;
+@define function round: integer;
+@define function strlen: integer;
+@define function strncmp: integer;
+@define function testreadaccess: integer;
+@define function toint: integer;
+@define function trunc: integer;
+
+@define procedure aclose ;
+@define procedure argv ;
+@define procedure checkedfseek ;
+@define procedure dispose ;
+@define procedure decr ;
+@define procedure errprintpascalstring ;
+@define procedure flush ;
+@define procedure fprintreal ;
+@define procedure incr ;
+@define procedure input3ints ;
+@define procedure printpascalstring ;
+@define procedure printreal;
+@define procedure putbyte ;
+@define procedure read ;
+@define procedure readln ;
+@define procedure reset ;
+@define procedure rewrite ;
+@define procedure setpaths ;
+@define procedure uexit ;
+@define procedure vgetc ;
+@define procedure vstrcpy ;
+@define procedure writechunk ;
+@define procedure page ;
+
diff --git a/dviware/crudetype/version3/w2c.h b/dviware/crudetype/version3/w2c.h
new file mode 100644
index 0000000000..7c11b9fbde
--- /dev/null
+++ b/dviware/crudetype/version3/w2c.h
@@ -0,0 +1,117 @@
+#include <stdio.h>
+#include "site.h"
+
+#define TRUE 1
+#define FALSE 0
+
+#ifndef BSD
+#include <string.h>
+#define rindex strrchr
+#define index strchr
+#else
+#include <strings.h>
+#endif
+
+#ifndef ANSI
+#ifdef SYSV
+extern sprintf();
+#else
+extern char *sprintf();
+#endif
+#endif
+
+#define max_line_length (78)
+#define max_strings (20000)
+#define hash_prime (101)
+#define sym_table_size (3000)
+#define unused (271828)
+#define ex_32 (2)
+#define ex_real (3)
+#define max(a,b) ((a>b)?a:b)
+
+extern int indent;
+extern int line_pos;
+extern int last_brace;
+extern int block_level;
+extern int ii;
+extern int last_tok;
+
+extern char safe_string[80];
+
+extern char field_list[200];
+extern char last_id[80];
+extern char next_temp[];
+
+extern long last_i_num;
+/*l_s is assigned by LEX to point to any non-reserved id*/
+extern int ii, l_s;
+extern long lower_bound, upper_bound;
+extern FILE *fopen();
+extern FILE *std;
+extern int pf_count;
+
+#include "w2c-symtab.h"
+
+extern char strings[max_strings];
+extern int hash_list[hash_prime];
+extern short global;
+#ifdef MS_DOS
+extern struct sym_entry huge sym_table[sym_table_size];
+#else
+extern struct sym_entry sym_table[sym_table_size];
+#endif
+extern int last_sym_used, next_string_free;
+
+#ifdef FLEX
+extern char *yytext;
+#else /* LEX */
+#ifdef HP
+extern unsigned char yytext[];
+#else /* Not HP */
+extern char yytext[];
+#endif /* HP */
+#endif /* LEX */
+
+/* These macros describe various types of variables. Any distinct small
+numbers will do*/
+
+#define is_char 1
+#define is_file 2
+#define is_array 3
+#define is_record 4
+#define is_int 5
+#define is_real 6
+#define is_point 7
+#define is_string 8
+
+static int uses_mem, uses_eqtb ;
+char my_routine[100]; /* Name of routine being parsed, if any */
+
+#ifdef ANSI
+extern void exit(int);
+extern int yyparse(void);
+void find_next_temp(void);
+void normal(void);
+void silent(void);
+void mark(void);
+void forward(int);
+void un_forward(int);
+void to_string(char *);
+void new_line(void);
+void indent_line(void);
+void my_output(char *);
+void semicolon(void);
+void yyerror(char *);
+int hash(char *);
+int search_table(char *);
+int add_to_table(char *);
+void pop_stack(void);
+void push_stack(void);
+void initialize(void);
+void main(int,char * *);
+#else
+void find_next_temp(), normal(), new_line(), indent_line(), mark(),
+my_output(), silent(), forward(), un_forward(), to_string(),
+semicolon(), yyerror(), pop_stack(), push_stack(), initialize();
+#endif
+
diff --git a/dviware/crudetype/version3/w2c.lex b/dviware/crudetype/version3/w2c.lex
new file mode 100644
index 0000000000..d9dc5d5ed5
--- /dev/null
+++ b/dviware/crudetype/version3/w2c.lex
@@ -0,0 +1,173 @@
+%{
+#include "w2c.h"
+#include "w2cy.h"
+#ifdef ANSI
+int yylex(void);
+#ifndef BSD
+static void unput(char);
+static int input(void);
+#endif
+#endif
+char conditional[20], negbuf[2], temp[20];
+extern boolean doing_statements;
+%}
+DIGIT [0-9]
+ALPHA [a-zA-Z]
+ALPHANUM ({DIGIT}|{ALPHA})
+IDENTIFIER ({ALPHA}{ALPHANUM}*)
+NUMBER ({DIGIT}+)
+SIGN ("+"|"-")
+SIGNED ({SIGN}?{NUMBER})
+WHITE [ \n\t]+
+REAL ({NUMBER}"."{NUMBER}("e"{SIGNED})?)|({NUMBER}"e"{SIGNED})
+COMMENT (("{"[^}]*"}")|("(*"([^*]|"*"[^)])*"*)"))
+W ({WHITE}|"packed")+
+WW ({WHITE}|{COMMENT}|"packed")*
+HHB0 ("hh"{WW}"."{WW}"b0")
+HHB1 ("hh"{WW}"."{WW}"b1")
+
+%%
+{W} ;
+"{" {while (input() != '}');
+ }
+"#" {
+ register int c;
+ (void) putc('#', std);
+ while ((c = input()) && c != ';')
+ (void) putc(c, std);
+ (void) putc('\n', std);
+ }
+"ifdef(" {register int c;
+ register char *cp=conditional;
+ new_line();
+ (void) input();
+ while ((c = input()) != '\'')
+#ifdef MS_DOS
+ *cp++ = (char) c;
+#else
+ *cp++ = c;
+#endif
+ *cp = '\0';
+ (void) input();
+ if (doing_statements) fputs("\t;\n", std);
+ (void) fprintf(std,
+ "#ifdef %s\n", conditional);
+ }
+"endif(" {register int c;
+ new_line();
+ fputs("#endif /* ", std);
+ (void) input();
+ while ((c = input()) != '\'')
+ (void) putc(c, std);
+ (void) input();
+ conditional[0] = '\0';
+ fputs(" */\n", std);
+ }
+"forward" return(last_tok=forward_tok) ;
+"external" return(last_tok=extern_tok) ;
+"@define" return(last_tok=define_tok);
+"@field" return(last_tok=field_tok);
+"and" return(last_tok=and_tok) ;
+"array" return(last_tok=array_tok) ;
+"begin" return(last_tok=begin_tok) ;
+"case" return(last_tok=case_tok) ;
+"const" return(last_tok=const_tok) ;
+"div" return(last_tok=div_tok) ;
+"break" return(last_tok=break_tok);
+"do" return(last_tok=do_tok) ;
+"downto" return(last_tok=downto_tok) ;
+"else" return(last_tok=else_tok) ;
+"end" return(last_tok=end_tok) ;
+"file" return(last_tok=file_tok) ;
+"for" return(last_tok=for_tok) ;
+"function" return(last_tok=function_tok) ;
+"goto" return(last_tok=goto_tok) ;
+"if" return(last_tok=if_tok) ;
+"label" return(last_tok=label_tok) ;
+"mod" return(last_tok=mod_tok) ;
+"not" return(last_tok=not_tok) ;
+"of" return(last_tok=of_tok) ;
+"or" return(last_tok=or_tok) ;
+"procedure" return(last_tok=procedure_tok) ;
+"program" return(last_tok=program_tok) ;
+"record" return(last_tok=record_tok) ;
+"repeat" return(last_tok=repeat_tok) ;
+{HHB0} return(last_tok=hhb0_tok) ;
+{HHB1} return(last_tok=hhb1_tok) ;
+"then" return(last_tok=then_tok) ;
+"to" return(last_tok=to_tok) ;
+"type" return(last_tok=type_tok) ;
+"until" return(last_tok=until_tok) ;
+"var" return(last_tok=var_tok) ;
+"with" return(last_tok=with_tok) ;
+"new" return(last_tok=new_tok) ;
+"while" return(last_tok=while_tok) ;
+"others" return(last_tok=others_tok) ;
+"write" return(last_tok=write_tok) ;
+"writeln" return(last_tok=writeln_tok) ;
+{REAL} {
+ (void) sprintf(temp, "%s%s", negbuf, yytext);
+ negbuf[0] = '\0';
+ return(last_tok=r_num_tok) ;
+ }
+{NUMBER} {
+ (void) sprintf(temp, "%s%s", negbuf, yytext);
+ negbuf[0] = '\0';
+ return(last_tok=i_num_tok) ;
+ }
+("'"([^']|"''")"'") return(last_tok=single_char_tok) ;
+("'"([^']|"''")*"'") return(last_tok=string_literal_tok) ;
+"+" { if ((last_tok>=undef_id_tok &&
+ last_tok<=field_id_tok) ||
+ last_tok==i_num_tok ||
+ last_tok==r_num_tok ||
+ last_tok==')' ||
+ last_tok==']')
+ return(last_tok='+') ;
+ else return(last_tok=unary_plus_tok) ; }
+"-" { if ((last_tok>=undef_id_tok &&
+ last_tok<=field_id_tok) ||
+ last_tok==i_num_tok ||
+ last_tok==r_num_tok ||
+ last_tok==')' ||
+ last_tok==']')
+ return(last_tok='-') ;
+ else {
+ int c;
+ while ((c = input()) == ' ' || c == '\t');
+#ifdef MS_DOS
+ unput((char) c);
+#else
+ unput(c);
+#endif
+ if (c < '0' || c > '9') {
+ return(last_tok = unary_minus_tok);
+ }
+ negbuf[0] = '-';
+ }}
+"*" return(last_tok='*') ;
+"/" return(last_tok='/') ;
+"=" return(last_tok='=') ;
+"<>" return(last_tok=not_eq_tok) ;
+"<" return(last_tok='<') ;
+">" return(last_tok='>') ;
+"<=" return(last_tok=less_eq_tok) ;
+">=" return(last_tok=great_eq_tok) ;
+"(" return(last_tok='(') ;
+")" return(last_tok=')') ;
+"[" return(last_tok='[') ;
+"]" return(last_tok=']') ;
+":=" return(last_tok=assign_tok) ;
+".." return(last_tok=two_dots_tok) ;
+"." return(last_tok='.') ;
+"," return(last_tok=',') ;
+";" return(last_tok=';') ;
+":" return(last_tok=':') ;
+"^" return(last_tok='^') ;
+{IDENTIFIER} { (void) strcpy(last_id,yytext) ;
+ l_s=search_table(last_id) ;
+ if (l_s) return(last_tok=sym_table[l_s].typ);
+ else return(last_tok=undef_id_tok);
+ }
+. return(last_tok=unknown_tok) ;
+%%
diff --git a/dviware/crudetype/version3/w2c.yacc b/dviware/crudetype/version3/w2c.yacc
new file mode 100644
index 0000000000..c3226d4968
--- /dev/null
+++ b/dviware/crudetype/version3/w2c.yacc
@@ -0,0 +1,1407 @@
+/*web2c.yacc amended by RMD. */
+
+%token array_tok begin_tok case_tok const_tok do_tok downto_tok else_tok
+ end_tok file_tok for_tok function_tok goto_tok if_tok label_tok
+ of_tok procedure_tok program_tok record_tok repeat_tok then_tok
+ to_tok type_tok until_tok var_tok while_tok integer_tok real_tok
+ others_tok r_num_tok i_num_tok string_literal_tok single_char_tok
+ assign_tok two_dots_tok unknown_tok undef_id_tok var_id_tok
+ proc_id_tok fun_id_tok fun_forwd_tok proc_forwd_tok const_id_tok
+ forward_tok extern_tok type_id_tok hhb0_tok hhb1_tok field_id_tok
+ define_tok field_tok break_tok write_tok writeln_tok file_id_tok
+ with_tok new_tok with_var type_fwd_tok
+
+%nonassoc '=' not_eq_tok '<' '>' less_eq_tok great_eq_tok
+%left '+' '-' or_tok
+%right unary_plus_tok unary_minus_tok
+%left '*' '/' div_tok mod_tok and_tok
+%right not_tok
+
+%{
+#include "w2c.h"
+
+#define symbol(x) sym_table[x].id
+#define MAX_ARGS 50
+/* #define YYDEBUG 1 */
+
+
+static char for_stack[300], control_var[50],
+ relation[3], new_string[30] , file_temp[100], file_stat[100],
+ i_o_file[50], i_o_exp[200], i_o_w1[20], i_o_w2[20], i_o_stat[1000],
+ i_o_fmt[100], *the_typ_id = 0, with_varr[300] ;
+static int last_type = 0, level, i_o_fun, i_o_typ;
+static char *with_v, *ww ;
+static char array_bounds[80], array_offset[80];
+static int lower_sym, upper_sym, fun_id, proc_num;
+boolean doing_statements = FALSE;
+static boolean var_formals = FALSE;
+static int cur_top_type = 0 ;
+static int cur_sub_type = 0 ;
+static int lo_var, hi_var;
+
+extern char conditional[], temp[], *std_header, *vvoid;
+extern int tex, mf, strict_for;
+extern int yylineno;
+extern boolean ansi;
+extern FILE *coerce;
+extern char coerce_name[];
+
+/* Forward refs */
+#ifdef ANSI
+static long labs(long x);
+static void compute_array_bounds(void);
+static void define_vars(int class);
+extern void do_prototype(int fun, int extrn);
+extern void gen_function_head(int fun);
+static boolean doreturn(char *label);
+static void declare_returns( void);
+static void return_value(void);
+static void do_write(void);
+static void send_write(void);
+extern int yylex(void);
+extern void err_mes(char *s) ;
+#else /* Not ANSI */
+static long labs();
+static void compute_array_bounds(), define_vars();
+extern void do_prototype(), gen_function_head();
+static boolean doreturn();
+static void declare_returns();
+static void return_value () ;
+static void do_write();
+static void send_write();
+#endif /* Not ANSI */
+
+%}
+
+%start PROGRAM
+
+%%
+
+PROGRAM: { level = 0 ; silent() ; }
+ DEFS
+ { normal() ; }
+ PROGRAM_HEAD
+ { level++;
+ if ( sprintf( i_o_file, "#include \"%s\"\n", std_header)
+ == NULL) perror( "sprintf") ;
+ my_output( i_o_file);
+ *i_o_file = '\0' ;}
+ BLOCK '.'
+ { new_line();
+ YYACCEPT;}
+ ;
+
+DEFS: /* empty */
+ | DEFS DEF
+ ;
+
+DEF: define_tok field_tok undef_id_tok ';'
+ {
+ ii = add_to_table(last_id);
+ sym_table[ii].typ = field_id_tok;
+ }
+ | define_tok function_tok undef_id_tok
+ {
+ fun_id = add_to_table(last_id);
+ }
+ ':' RESULT_TYPE ';'
+ {
+ sym_table[fun_id].top_type = cur_top_type ;
+ sym_table[fun_id].sub_type = cur_sub_type ;
+ sym_table[fun_id].typ = fun_id_tok;
+ }
+ | define_tok const_tok undef_id_tok ';'
+ {
+ ii = add_to_table(last_id);
+ sym_table[ii].typ = const_id_tok;
+ }
+ | define_tok procedure_tok undef_id_tok ';'
+ {
+ ii = add_to_table(last_id);
+ sym_table[ii].typ = proc_id_tok;
+ }
+ | define_tok procedure_tok undef_id_tok '(' ')' ';'
+ {
+ ii = add_to_table(last_id);
+ sym_table[ii].typ = proc_id_tok;
+ }
+ | define_tok type_tok undef_id_tok ';'
+ {
+ ii = add_to_table(last_id);
+ sym_table[ii].typ = type_id_tok;
+ }
+ | type_tok TYPE_DEF
+ | define_tok var_tok undef_id_tok ';'
+ {
+ ii = add_to_table(last_id);
+ sym_table[ii].typ = var_id_tok;
+ }
+ ;
+
+PROGRAM_HEAD: program_tok undef_id_tok ';'
+ | program_tok undef_id_tok '(' FILES ')' ';'
+ ;
+
+FILES: FILE_ID
+ | FILES ',' FILE_ID
+ ;
+
+FILE_ID: NEW_ID
+ {
+ ii = add_to_table(last_id);
+ sym_table[ii].typ = file_id_tok;
+ sym_table[ii].top_type = is_file ;
+ sym_table[ii].sub_type = is_char ;
+ if ( strcmp(last_id, "input") ==0)
+ { if ( sprintf( file_temp, "*input = stdin; \n") == NULL) perror( "sprintf") ;
+ if ( fprintf( coerce, "text input ;\n" ) == EOF) perror( "fprintf") ;
+ strcat( file_stat, file_temp) ;
+ }
+ else if ( strcmp(last_id, "output") ==0)
+ { if ( sprintf( file_temp, "*output = stdout; \n") == NULL) perror( "sprintf") ;
+ if ( fprintf( coerce, "text output ;\n " ) == EOF) perror( "fprintf") ;
+ strcat( file_stat, file_temp) ;
+ }
+ }
+ ;
+
+NEW_ID: undef_id_tok
+ | var_id_tok
+ | field_id_tok
+ | file_id_tok
+ | new_tok
+ ;
+
+BLOCK: { level++;
+ if (level > 2) {
+ my_output("{");
+ indent++;
+ declare_returns();
+ }
+ }
+ LABEL_DEC_PART
+ CONST_DEC_PART
+ TYPE_DEC_PART
+ VAR_DEC_PART
+ { if (level == 2) {
+ printf("\n#include \"%s\"\n", coerce_name); }}
+ P_F_DEC_PART
+ { if (level == 2) {
+ my_output("void main_body() {");
+ my_output(file_stat) ;
+ indent++;
+ }
+ }
+ STAT_PART
+ { if (level > 1) {
+ return_value () ;
+ my_output("}");
+ indent--;
+ }
+ level--;
+ new_line();
+ }
+ ;
+
+LABEL_DEC_PART: /* empty */
+ | label_tok
+ { my_output("/*"); }
+ LABEL_LIST ';'
+ { my_output("*/"); }
+ ;
+
+LABEL_LIST: LABEL
+ | LABEL_LIST ',' LABEL
+ ;
+
+LABEL: i_num_tok
+ { my_output(temp); }
+ ;
+
+CONST_DEC_PART: /* empty */
+ | const_tok CONST_DEC_LIST
+ { new_line(); }
+ ;
+
+CONST_DEC_LIST: CONST_DEC
+ | CONST_DEC_LIST CONST_DEC
+ ;
+
+CONST_DEC: { my_output("#define ");
+ }
+ undef_id_tok
+ { ii=add_to_table(last_id);
+ cur_top_type = 0 ;
+ cur_sub_type = 0 ;
+ sym_table[ii].typ = const_id_tok;
+ my_output(last_id);
+ my_output(" ");
+ }
+ '=' CONSTANT ';'
+ { sym_table[ii].val=last_i_num;
+ sym_table[ii].top_type = cur_top_type ;
+ sym_table[ii].sub_type = cur_sub_type ;
+ cur_top_type = 0 ;
+ cur_sub_type = 0 ;
+ new_line() ;
+ }
+ ;
+
+CONSTANT: i_num_tok
+ {
+ (void) sscanf(temp, "%ld", &last_i_num);
+ if (labs((long) last_i_num) > 32767)
+ (void) strcat(temp, "L");
+ my_output(temp);
+ cur_top_type = is_int ;
+ cur_sub_type = is_int ;
+ $$ = is_int;
+ }
+ | r_num_tok
+ { my_output(temp);
+ cur_top_type = is_real ;
+ cur_sub_type = is_real ;
+ $$ = is_real;
+ }
+ | STRING
+ | CHAR_CONST
+ { cur_top_type = is_char ;
+ cur_sub_type = is_char ;}
+ | CONSTANT_ID
+ ;
+
+STRING: string_literal_tok
+ { int i, j; char s[132];
+ j = 1;
+ s[0] = '"';
+ for (i=1; yytext[i-1]!=0; i++) {
+ if (yytext[i] == '\\' || yytext[i] == '"')
+ s[j++]='\\';
+ else if (yytext[i] == '\'') i++;
+ s[j++] = yytext[i];
+ }
+ s[j-1] = '"';
+ s[j] = 0;
+ my_output(s);
+ cur_sub_type = is_char ;
+ cur_top_type = is_string ;
+ $$ = is_string;
+ }
+ ;
+
+CHAR_CONST: single_char_tok
+ { char s[5];
+ s[0]='\'';
+ if (yytext[1] == '\\' || yytext[1] == '\'') {
+ s[2] = yytext[1];
+ s[1] = '\\';
+ s[3] = '\'';
+ s[4] = '\0';
+ }
+ else {
+ s[1] = yytext[1];
+ s[2]='\'';
+ s[3]='\0';
+ }
+ /* bodge: Put the actual char into last_i_num*/
+ last_i_num = yytext[1];
+ $$ = is_char ;
+ my_output(s);
+ }
+ ;
+
+CONSTANT_ID: const_id_tok
+ { cur_top_type = sym_table[l_s].top_type ;
+ cur_sub_type = sym_table[l_s].sub_type ;
+ if (cur_top_type == is_int || cur_top_type == is_char)
+ last_i_num = sym_table[l_s].val ;
+ my_output(last_id);
+ $$ = cur_top_type ;
+ }
+ ;
+
+TYPE_DEC_PART: /* empty */
+ | type_tok TYPE_DEF_LIST
+ ;
+
+TYPE_DEF_LIST: TYPE_DEF
+ | TYPE_DEF_LIST TYPE_DEF
+ ;
+
+TYPE_DEF: { my_output("typedef"); }
+ NEW_TYPE_ID
+ { cur_top_type = 0 ;
+ cur_sub_type = 0 ;
+ sym_table[ii].typ = type_id_tok;
+ (void) strcpy(safe_string, last_id);
+ last_type = ii;
+ }
+ '='
+ {
+ array_bounds[0] = '\0' ;
+ array_offset[0] = '\0' ;
+ }
+ TYPE ';'
+ { if (*array_offset) {
+ err_mes( "Cannot typedef arrays with offsets");
+ exit(1);
+ }
+ if (last_type) {
+ sym_table[last_type].top_type = cur_top_type ;
+ sym_table[last_type].sub_type = cur_sub_type ;
+ }
+ cur_sub_type = 0 ;
+ cur_top_type = 0 ;
+ my_output(safe_string);
+ my_output(array_bounds);
+ semicolon();
+ last_type = 0;
+ }
+ ;
+
+NEW_TYPE_ID: undef_id_tok
+ { ii = add_to_table(last_id); }
+ | type_fwd_tok
+ { ii = l_s ;}
+ ;
+
+TYPE: SIMPLE_TYPE
+ { the_typ_id = 0;}
+ | TYPE_ID
+ | STRUCTURED_TYPE
+ { the_typ_id = 0;}
+ ;
+
+SIMPLE_TYPE: SUBRANGE_TYPE
+ { if (last_type)
+ {
+ sym_table[ii].val = lower_bound;
+ sym_table[ii].val_sym = lower_sym;
+ sym_table[ii].upper = upper_bound;
+ sym_table[ii].upper_sym = upper_sym;
+ /* dont set its top_type or sub_type as this is done at TYPE_DEF*/
+ ii= -1;
+ }
+ /* The following code says: if the bounds are known at translation time
+ * on an integral type, then we select the smallest type of data which
+ * can represent it in ANSI C. We only use unsigned types when necessary.
+ */
+ {
+ if (lower_bound>= -128 && upper_bound<=127)
+ my_output("schar");
+ else if (lower_bound >= 0
+ && upper_bound <= 255)
+ my_output("unsigned char");
+ else if (lower_bound >= -32768
+ && upper_bound <= 32767)
+ my_output("short");
+ else if (lower_bound >= 0
+ && upper_bound <= 65535)
+ my_output("unsigned short");
+ else my_output("integer");
+ }
+ /* else my_output("integer");*/
+ }
+ ;
+
+SUBRANGE_TYPE: SUB_CONSTANT two_dots_tok SUB_CONSTANT
+ ;
+
+POSSIBLE_PLUS: /* empty */
+ | unary_plus_tok
+ ;
+
+SUB_CONSTANT: POSSIBLE_PLUS i_num_tok
+ { lower_bound = upper_bound;
+ lower_sym = upper_sym;
+ (void) sscanf(temp, "%ld", &upper_bound);
+ upper_sym = -1; /* no sym table entry */
+ cur_top_type = is_int ;
+ cur_sub_type = is_int ;
+ }
+ | const_id_tok
+ { lower_bound = upper_bound;
+ lower_sym = upper_sym;
+ upper_bound = sym_table[l_s].val;
+ upper_sym = l_s;
+ cur_top_type = sym_table[l_s].top_type ;
+ cur_sub_type = sym_table[l_s].sub_type ;
+ }
+ | CHAR_CONST
+ { lower_bound = upper_bound;
+ lower_sym = upper_sym;
+ upper_bound = last_i_num ;
+ upper_sym = -1; /* no sym table entry */
+ cur_top_type = is_char ;
+ cur_sub_type = is_char ;
+ }
+ ;
+
+TYPE_ID: type_id_tok
+ {
+ if (last_type) {
+ sym_table[last_type].upper = sym_table[l_s].upper;
+ sym_table[last_type].upper_sym = sym_table[l_s].upper_sym;
+ sym_table[last_type].val = sym_table[l_s].val;
+ sym_table[last_type].val_sym = sym_table[l_s].val_sym;
+ }
+ cur_top_type = sym_table[l_s].top_type ;
+ cur_sub_type = sym_table[l_s].sub_type ;
+ if (strcmp( last_id, "integer") ==0) {
+ cur_top_type = is_int ;
+ cur_sub_type = is_int ;
+ }
+ if (strcmp( last_id, "text") ==0) {
+ cur_top_type = is_file ;
+ cur_sub_type = is_char ;
+ }
+ if (strcmp( last_id, "char") ==0) {
+ cur_top_type = is_char ;
+ cur_sub_type = is_char ;
+ }
+ if (strcmp( last_id, "real") ==0) {
+ cur_top_type = is_real ;
+ cur_sub_type = is_real ;
+ }
+ my_output(last_id);
+ the_typ_id = sym_table[l_s].id ;
+ }
+ ;
+
+STRUCTURED_TYPE: ARRAY_TYPE
+ {
+ if ( cur_top_type = is_char)
+ cur_top_type = is_string ;
+ else cur_top_type = is_array ;
+ }
+ | RECORD_TYPE
+ {
+ if(!last_type)
+ err_mes(" warning: Record types are unreliable unless you use type ids");
+ else cur_sub_type = last_type ;
+ cur_top_type = is_record ;}
+ | FILE_TYPE
+ { cur_top_type = is_file ;}
+ | POINTER_TYPE
+ {
+ /* The sub-type of a pointer must be the actual
+ identifier, because its type might not yet
+ be defined*/
+ cur_top_type = is_point ;
+ cur_sub_type = l_s ;
+ my_output(last_id); my_output("*");
+ }
+ ;
+
+POINTER_TYPE: '^' type_id_tok
+ | '^' type_fwd_tok
+ | '^' undef_id_tok
+ { ii = add_to_table(last_id);
+ l_s = ii ;
+ sym_table[ii].typ = type_fwd_tok ; }
+ ;
+
+ARRAY_TYPE: array_tok '[' INDEX_TYPE ']' of_tok COMPONENT_TYPE
+ | array_tok '[' INDEX_TYPE ',' INDEX_TYPE ']' of_tok
+ COMPONENT_TYPE
+ ;
+
+INDEX_TYPE: SUBRANGE_TYPE
+ { compute_array_bounds(); }
+ | type_id_tok
+ { lower_bound = sym_table[l_s].val;
+ lower_sym = sym_table[l_s].val_sym;
+ upper_bound = sym_table[l_s].upper;
+ upper_sym = sym_table[l_s].upper_sym;
+ compute_array_bounds();
+ }
+ ;
+
+COMPONENT_TYPE: TYPE
+ { cur_sub_type = cur_top_type ;}
+ ;
+
+ RECORD_TYPE: record_tok
+ { my_output("struct"); my_output("{"); indent++;
+ if(last_type)
+ sym_table[last_type].val = last_sym_used+1 ;}
+ FIELD_LIST end_tok
+ { indent--; my_output("}"); semicolon();
+ if(last_type) {
+ cur_sub_type = last_type ;
+ sym_table[last_type].upper = last_sym_used ;}}
+ ;
+
+FIELD_LIST: FIXED_FIELDS
+ ;
+
+FIXED_FIELDS: RECORD_SECTION
+ | FIXED_FIELDS ';' RECORD_SECTION
+ ;
+
+RECORD_SECTION: { field_list[0] = 0; lo_var= last_sym_used+1 ;}
+ VAR_ID_DEC_LIST ':'
+ {
+ array_bounds[0] = '\0' ;
+ array_offset[0] = '\0' ;
+ }
+ TYPE
+ { define_vars (field_id_tok);}
+ | /* empty */
+ ;
+
+FILE_TYPE: file_tok of_tok
+ { my_output("text /* file of "); }
+ TYPE
+ { my_output("*/");}
+ ;
+
+VAR_DEC_PART: /* empty */
+ | var_tok VAR_DEC_LIST
+ ;
+
+VAR_DEC_LIST: VAR_DEC
+ | VAR_DEC_LIST VAR_DEC
+ ;
+
+VAR_DEC:
+ { array_bounds[0] = '\0' ;
+ array_offset[0] = '\0' ;
+ cur_sub_type = 0 ;
+ var_formals = FALSE;
+ lo_var= last_sym_used+1;
+ }
+ VAR_ID_DEC_LIST ':'
+ {
+ array_bounds[0] = '\0' ;
+ array_offset[0] = '\0' ;
+ }
+ TYPE ';'
+ { define_vars( var_id_tok);
+ cur_sub_type = 0 ;
+ }
+ ;
+
+VAR_ID_DEC_LIST: VAR_ID
+ | VAR_ID_DEC_LIST ',' VAR_ID
+ ;
+
+VAR_ID: NEW_ID
+ {
+ hi_var = add_to_table(last_id);
+ }
+ ;
+
+P_F_DEC_PART: /*empty*/
+ | P_F_DEC_PART P_F_DEC
+ ;
+
+P_F_DEC: PROCEDURE_DEC ';'
+ { new_line(); pop_stack(); }
+ | FUNCTION_DEC ';'
+ { new_line(); pop_stack(); }
+ ;
+
+PROCEDURE_DEC: PROCEDURE_HEAD
+ {
+ do_prototype( proc_num, FALSE );
+ gen_function_head(proc_num);
+ }
+ BLOCK
+ | PROCEDURE_HEAD DIRECTIVE
+ | FORWARD_HEAD ';'
+ { proc_num = l_s ;
+ un_forward( proc_num) ;
+ gen_function_head( proc_num) ;
+ push_stack();
+ if ( fprintf(stderr, " %s (forward)\n",
+ last_id) == EOF) perror( "fprintf");
+ (void) strcpy(my_routine, last_id);
+ uses_eqtb = uses_mem = FALSE;
+ }
+ BLOCK
+ ;
+
+DIRECTIVE: forward_tok
+ { do_prototype( proc_num, FALSE );
+ forward( proc_num) ;}
+ | extern_tok
+ { do_prototype( proc_num, TRUE ); }
+ ;
+
+FORWARD_HEAD: procedure_tok proc_forwd_tok
+ | function_tok fun_forwd_tok
+ ;
+
+
+PROCEDURE_HEAD: procedure_tok undef_id_tok
+ { proc_num = add_to_table (last_id) ;
+ silent() ;
+ push_stack();
+ if ( fprintf(stderr, "%3d Procedure %s\n",
+ pf_count++, last_id) == EOF) perror( "fprintf");
+ sym_table[proc_num].typ = proc_id_tok;
+ sym_table[proc_num].arg_typ = NULL ;
+ (void) strcpy(my_routine, last_id);
+ uses_eqtb = uses_mem = FALSE;
+ lo_var= last_sym_used+1;
+ }
+ PARAM ';'
+ { normal();}
+ ;
+
+PARAM: /* empty */
+ { sym_table[proc_num].upper_sym = 0;}
+ | '('
+ { sym_table[proc_num].val_sym = lo_var;
+ }
+ FORM_PAR_SEC_L ')'
+ { sym_table[proc_num].upper_sym = last_sym_used; }
+ ;
+
+FORM_PAR_SEC_L: FORM_PAR_SEC
+ | FORM_PAR_SEC_L ';' FORM_PAR_SEC
+ ;
+
+FORM_PAR_SEC: { var_formals = FALSE ;}
+ FORM_PAR_SEC1
+ | var_tok
+ { var_formals = TRUE ;}
+ FORM_PAR_SEC1
+ { var_formals = FALSE ;}
+ ;
+
+FORM_PAR_SEC1: { lo_var= last_sym_used+1;}
+ VAR_ID_DEC_LIST ':' TYPE_ID
+ {
+ define_vars( var_id_tok);
+ }
+ ;
+
+FUNCTION_DEC: FUNCTION_HEAD
+ {
+ if (sym_table[proc_num].var_formal)
+ un_forward( proc_num) ;
+ else do_prototype( proc_num, FALSE );
+ gen_function_head( proc_num);
+ }
+ BLOCK
+ | FUNCTION_HEAD DIRECTIVE
+ ;
+
+FUNCTION_HEAD: function_tok undef_id_tok
+ { proc_num = add_to_table (last_id) ;
+ silent() ;
+ push_stack();
+ if ( fprintf(stderr, "%3d Function %s\n",
+ pf_count++, last_id) == EOF) perror( "fprintf");
+ sym_table[proc_num].typ = fun_id_tok;
+ (void) strcpy(my_routine, last_id);
+ uses_eqtb = uses_mem = FALSE;
+ lo_var= last_sym_used+1;
+ }
+ PARAM ':'
+ { array_bounds[0] = '\0' ;
+ array_offset[0] = '\0' ;
+ }
+ RESULT_TYPE
+ { sym_table[proc_num].arg_typ = the_typ_id ;
+ sym_table[proc_num].top_type = cur_top_type ;
+ sym_table[proc_num].sub_type = cur_sub_type ;
+ }
+ ';'
+ { normal();}
+ ;
+
+RESULT_TYPE: TYPE_ID
+ ;
+
+STAT_PART: begin_tok STAT_LIST end_tok
+ ;
+
+COMPOUND_STAT: begin_tok
+ { my_output("{"); indent++; new_line();}
+ STAT_LIST end_tok
+ { indent--; my_output("}"); new_line(); }
+ ;
+
+STAT_LIST: STATEMENT
+ | STAT_LIST ';' STATEMENT
+ ;
+
+STATEMENT: UNLAB_STAT
+ | S_LABEL ':'
+ UNLAB_STAT
+ ;
+
+S_LABEL: i_num_tok
+ { if (!doreturn(temp)) {
+ if ( sprintf(safe_string, "lab%s:",
+ temp) == NULL) perror( "sprintf");
+ my_output(safe_string);
+ }
+ }
+ ;
+
+UNLAB_STAT: SIMPLE_STAT
+ { semicolon(); }
+ | STRUCT_STAT
+ { semicolon(); }
+ ;
+
+SIMPLE_STAT: ASSIGN_STAT
+ | PROC_STAT
+ | NEW_STAT
+ | WRITE_STAT
+ | GO_TO_STAT
+ | EMPTY_STAT
+ | break_tok
+ { my_output("break");}
+ ;
+
+ASSIGN_STAT: VARIABLE assign_tok
+ { my_output(" = "); }
+ EXPRESS
+ | FUNC_ID_AS assign_tok
+ { my_output("Result = "); }
+ EXPRESS
+ ;
+
+VARIABLE: VAR_OR_WITH
+ { cur_top_type = sym_table[l_s].top_type ;
+ cur_sub_type = sym_table[l_s].sub_type ;
+ if (strcmp(last_id, "mem") ==0)
+ uses_mem = 1 ;
+ else if (strcmp(last_id, "eqtb") ==0)
+ uses_eqtb = 1;
+ my_output(last_id);
+ if (sym_table[l_s].need_var )
+ (void) my_output( "[0]" );
+ }
+ VAR_DESIG_LIST
+ { if($3) $$ = $3 ;
+ else $$ = cur_top_type ;}
+ | file_id_tok
+ { my_output(last_id);
+ $$ = is_file ;
+ }
+ ;
+
+VAR_OR_WITH: var_id_tok
+ ;
+
+FUNC_ID_AS: fun_id_tok
+ { $$ = ex_32; }
+ ;
+
+VAR_DESIG_LIST: /*empty*/
+ { $$ = 0;}
+ | VAR_DESIG_LIST VAR_DESIG
+ { $$ = $2 ;}
+ ;
+
+VAR_DESIG: '['
+ { my_output("[");
+ $$ = cur_sub_type ;
+ if (cur_top_type != is_array &&
+ cur_top_type != is_point &&
+ cur_top_type != is_string )
+ err_mes("index on non-array") ; }
+ EXPRESS VAR_DESIG1
+ { my_output("]");
+ $$ = $2; cur_top_type = $2 ;}
+ | '.' field_id_tok
+ {
+ if (cur_top_type != is_record)
+ err_mes("field on non-record") ;
+ cur_top_type = sym_table[l_s].top_type ;
+ cur_sub_type = sym_table[l_s].sub_type ;
+ if (tex || mf)
+ {
+ if (strcmp(last_id, "int") ==0)
+ my_output(".cint");
+ else if (strcmp(last_id, "lh") ==0)
+ my_output(".v.LH");
+ else if (strcmp(last_id, "rh") ==0)
+ my_output(".v.RH");
+ else
+ {if ( sprintf(safe_string, ".%s", last_id) == NULL) perror( "sprintf");
+ my_output(safe_string);
+ }
+ }
+ else {
+ if ( sprintf(safe_string, ".%s", last_id) == NULL) perror( "sprintf");
+ my_output(safe_string);
+ }
+ $$ = cur_top_type ;
+ }
+ | '^'
+ { int ii = cur_sub_type ;
+ if ( cur_top_type != is_point )
+ err_mes(" ^ on non-pointer") ;
+ else {
+ my_output( "[0]") ;
+ cur_top_type = sym_table[ii].top_type ;
+ cur_sub_type = sym_table[ii].sub_type ; }
+ }
+ | '.'
+ hhb0_tok
+ { my_output(".hh.b0"); $$ = is_int ;}
+ | '.'
+ hhb1_tok
+ { my_output(".hh.b1"); $$ = is_int ;}
+ ;
+
+VAR_DESIG1: ']'
+ | ','
+ { my_output("][");}
+ EXPRESS ']'
+ ;
+
+EXPRESS: UNARY_OP EXPRESS %prec '*'
+ { $$ = $2; }
+ | EXPRESS '+' {my_output("+");} EXPRESS
+ { $$ = max($1, $4);}
+ | EXPRESS '-' {my_output("-");} EXPRESS
+ { $$ = max($1, $4);}
+ | EXPRESS '*' {my_output("*");} EXPRESS
+ { $$ = max($1, $4);}
+ | EXPRESS div_tok {my_output("/");} EXPRESS
+ { $$ = is_int;}
+ | EXPRESS '=' {my_output("==");} EXPRESS
+ { $$ = is_int;}
+ | EXPRESS not_eq_tok {my_output("!=");} EXPRESS
+ { $$ = is_int;}
+ | EXPRESS mod_tok {my_output("%");} EXPRESS
+ { $$ = is_int;}
+ | EXPRESS '<' {my_output("<");} EXPRESS
+ { $$ = is_int;}
+ | EXPRESS '>' {my_output(">");} EXPRESS
+ { $$ = is_int;}
+ | EXPRESS less_eq_tok {my_output("<=");} EXPRESS
+ { $$ = is_int;}
+ | EXPRESS great_eq_tok {my_output(">=");} EXPRESS
+ { $$ = is_int;}
+ | EXPRESS and_tok {my_output("&&");} EXPRESS
+ { $$ = is_int;}
+ | EXPRESS or_tok {my_output("||");} EXPRESS
+ { $$ = is_int;}
+ | EXPRESS '/'
+ { my_output("/ ((double)"); }
+ EXPRESS
+ { $$ = is_real; my_output(")"); }
+ | FACTOR
+ { $$ = $1; }
+ ;
+
+UNARY_OP: unary_plus_tok
+ | unary_minus_tok
+ { my_output("- (integer)"); }
+ | not_tok
+ { my_output("!"); }
+ ;
+
+FACTOR: '('
+ { my_output("("); }
+ EXPRESS ')'
+ { my_output(")"); $$ = $3; }
+ | VARIABLE
+ | CONSTANT
+ | FUN_CALL
+ { my_output(last_id);
+ $$ = sym_table[l_s].top_type ;
+ }
+ PARAM_LIST
+ { $$ = $2 ; }
+ ;
+
+FUN_CALL: fun_id_tok
+ | fun_forwd_tok
+ ;
+
+PARAM_LIST: /*empty*/
+ { my_output("()"); }
+ | '('
+ { my_output("("); }
+ ACTUAL_PARAM_L ')'
+ { my_output(")"); }
+ ;
+
+ACTUAL_PARAM_L: ACTUAL_PARAM
+ | ACTUAL_PARAM_L ','
+ { my_output(","); }
+ ACTUAL_PARAM
+ ;
+
+ACTUAL_PARAM: EXPRESS
+ ;
+
+PROC_STAT: PROC_NAME
+ { my_output(last_id); }
+ PARAM_LIST
+ ;
+
+PROC_NAME: proc_id_tok
+ | proc_forwd_tok
+ ;
+
+NEW_STAT: new_tok '(' VARIABLE
+ { int ii = cur_sub_type;
+ char *c = sym_table[ii].id ;
+ if (cur_top_type != is_point)
+ err_mes( "NEW on non-pointer") ;
+ if ( sprintf ( new_string, "= (%s*) xmalloc( sizeof( %s)) ", c, c)
+ == NULL) perror( "sprintf");
+ my_output( new_string) ; }
+ ')'
+ ;
+
+
+WRITE_STAT: WR_FUN
+ { *i_o_stat = '\0'; *i_o_fmt = '\0'; }
+ WR_ARGS
+ { normal() ;
+ send_write();
+ }
+ ;
+
+WR_FUN: write_tok
+ { i_o_fun = write_tok ;}
+ | writeln_tok
+ { i_o_fun = writeln_tok ;}
+ ;
+
+WR_ARGS: /*empty*/
+ { strcpy( i_o_file, "output" );
+ if (i_o_fun != writeln_tok)
+ err_mes( "You cant WRITE nothing") ;
+ }
+ | '(' file_id_tok ')'
+ { strcpy( i_o_file, last_id ) ;
+ if (i_o_fun != writeln_tok)
+ err_mes( "You cant WRITE nothing") ;
+ }
+ /* Here we need a production WR_ARGS -> ( DATA ) . (i.e.
+ the file is not named). Unfortunately I dont know how to
+ prevent a conflict which YACC resolves the wrong way. If
+ it reads 'write(file-name,...' it reduces file-name >>
+ variable >> factor >> express >> WR_ITEM and tries to
+ treat the file as something to be written to output*/
+ | '(' file_id_tok ','
+ { strcpy( i_o_file, last_id ) ; }
+ WR_DATA ')'
+ ;
+
+WR_DATA: WR_ITEM
+ | WR_DATA ',' WR_ITEM
+ ;
+
+WR_ITEM: { *i_o_w1 = '\0' ;
+ *i_o_w2 = '\0' ;
+ *i_o_exp = '\0' ;
+ to_string (i_o_exp) ;}
+ EXPRESS
+ { i_o_typ = $2 ;}
+ WIDTH1
+ { do_write () ;}
+ ;
+
+WIDTH1: /*empty*/
+ | ':' { to_string (i_o_w1) ;}
+ EXPRESS WIDTH2
+ ;
+
+WIDTH2: /*empty*/
+ | ':' { to_string (i_o_w2) ;}
+ EXPRESS
+ ;
+
+GO_TO_STAT: goto_tok i_num_tok
+ { if (doreturn(temp)) {
+ if (strcmp( sym_table[proc_num].arg_typ, "void"))
+ my_output("return(Result)");
+ else
+ my_output("return");
+ } else {
+ if ( sprintf(safe_string, "goto lab%s",
+ temp) == NULL) perror( "sprintf");
+ my_output(safe_string);
+ }
+ }
+ ;
+
+EMPTY_STAT: /* empty */
+ ;
+
+STRUCT_STAT: COMPOUND_STAT
+ | CONDIT_STAT
+ | REPETIT_STAT
+ ;
+
+CONDIT_STAT: IF_STATEMENT
+ | CASE_STATEMENT
+ ;
+
+IF_STATEMENT: BEGIN_IF_STAT
+ | BEGIN_IF_STAT ELSE_STAT
+ ;
+
+BEGIN_IF_STAT: if_tok
+ { my_output("if"); my_output("("); }
+ EXPRESS
+ { my_output(")"); new_line();}
+ then_tok STATEMENT
+ ;
+
+ELSE_STAT: else_tok
+ { my_output("else"); }
+ STATEMENT
+ ;
+
+CASE_STATEMENT: case_tok
+ { my_output("switch"); my_output("("); }
+ EXPRESS of_tok
+ { my_output(")"); new_line();
+ my_output("{"); indent++;
+ }
+ CASE_EL_LIST END_CASE
+ { indent--; my_output("}"); new_line(); }
+ ;
+
+CASE_EL_LIST: CASE_ELEMENT
+ | CASE_EL_LIST ';' CASE_ELEMENT
+ ;
+
+CASE_ELEMENT: CASE_LAB_LIST ':' UNLAB_STAT
+ { my_output("break"); semicolon(); }
+ ;
+
+CASE_LAB_LIST: CASE_LAB
+ | CASE_LAB_LIST ',' CASE_LAB
+ ;
+
+CASE_LAB: i_num_tok
+ { my_output("case");
+ my_output(temp);
+ my_output(":"); new_line();
+ }
+ | const_id_tok
+ { my_output("case");
+ my_output(last_id);
+ my_output(":"); new_line();
+ }
+ | others_tok
+ { my_output("default:"); new_line(); }
+ ;
+
+END_CASE: end_tok
+ | ';' end_tok
+ ;
+
+REPETIT_STAT: WHILE_STATEMENT
+ | REP_STATEMENT
+ | FOR_STATEMENT
+ ;
+
+WHILE_STATEMENT: while_tok
+ { my_output("while");
+ my_output("(");
+ }
+ EXPRESS
+ { my_output(")"); }
+ do_tok STATEMENT
+ ;
+
+REP_STATEMENT: repeat_tok
+ { my_output("do"); my_output("{"); indent++; }
+ STAT_LIST until_tok
+ { indent--; my_output("}");
+ my_output("while"); my_output("( ! (");
+ }
+ EXPRESS
+ { my_output(") )"); }
+ ;
+
+FOR_STATEMENT: for_tok
+ {
+ my_output("{");
+ my_output("register");
+ my_output("integer");
+ if (strict_for)
+ my_output("for_begin,");
+ my_output("for_end;");
+ }
+ CONTROL_VAR assign_tok
+ { if (strict_for)
+ my_output("for_begin");
+ else
+ my_output(control_var);
+ my_output("="); }
+ FOR_LIST do_tok
+ { my_output("; if (");
+ if (strict_for) my_output("for_begin");
+ else my_output(control_var);
+ my_output(relation);
+ my_output("for_end)");
+ if (strict_for) {
+ my_output("{");
+ my_output(control_var);
+ my_output("=");
+ my_output("for_begin");
+ semicolon();
+ }
+ my_output("do");
+ indent++;
+ new_line();}
+ STATEMENT
+ {
+ char *top = rindex(for_stack, '#');
+ indent--; new_line();
+ my_output("while");
+ my_output("(");
+ my_output(top+1);
+ my_output(")");
+ my_output(";");
+ my_output("}");
+ if (strict_for)
+ my_output("}");
+ *top=0;
+ new_line();
+ }
+ ;
+
+CONTROL_VAR: var_id_tok
+ { (void) strcpy(control_var, last_id); }
+ ;
+
+FOR_LIST: EXPRESS
+ { my_output(";"); }
+ to_tok
+ {
+ (void) strcpy(relation, "<=");
+ my_output("for_end");
+ my_output("="); }
+ EXPRESS
+ {
+ if ( sprintf(for_stack + strlen(for_stack),
+ "#%s++ < for_end", control_var) == NULL) perror( "sprintf");
+ }
+ | EXPRESS
+ { my_output(";"); }
+ downto_tok
+ {
+ (void) strcpy(relation, ">=");
+ my_output("for_end");
+ my_output("="); }
+ EXPRESS
+ {
+ if ( sprintf(for_stack + strlen(for_stack),
+ "#%s-- > for_end", control_var) == NULL) perror( "sprintf");
+ }
+ ;
+
+%%
+
+static void compute_array_bounds()
+{
+ long lb;
+ char tmp[200];
+
+ if (lower_sym == -1) { /* lower is a constant */
+ lb = lower_bound - 1;
+ if (lb==0) lb = -1; /* Treat lower_bound==1 as if lower_bound==0 */
+ if (upper_sym == -1) /* both constants */
+ {if ( sprintf(tmp, "[%ld]", upper_bound - lb) == NULL) perror( "sprintf");}
+ else { /* upper a symbol, lower constant */
+ if (lb < 0)
+ {if ( sprintf(tmp, "[%s + %ld]",
+ symbol(upper_sym), (-lb)) == NULL) perror( "sprintf");}
+ else
+ if ( sprintf(tmp, "[%s - %ld]",
+ symbol(upper_sym), lb) == NULL) perror( "sprintf");
+ }
+ if (lower_bound < 0 || lower_bound > 1) {
+ if (*array_bounds) {
+ err_mes( "Cannot handle offset in second dimension\n");
+ exit(1);
+ }
+ if (lower_bound < 0) {
+ if ( sprintf(array_offset, "+%ld", -lower_bound) == NULL) perror( "sprintf");
+ } else {
+ if ( sprintf(array_offset, "-%ld", lower_bound) == NULL) perror( "sprintf");
+ }
+ }
+ (void) strcat(array_bounds, tmp);
+ }
+ else { /* lower is a symbol */
+ if (upper_sym != -1) /* both are symbols */
+ { if ( sprintf(tmp, "[%s - %s + 1]", symbol(upper_sym),
+ symbol(lower_sym)) == NULL) perror( "sprintf");}
+ else { /* upper constant, lower symbol */
+ if ( sprintf(tmp, "[%ld - %s]", upper_bound + 1,
+ symbol(lower_sym)) == NULL) perror( "sprintf");
+ }
+ if (*array_bounds) {
+ err_mes( "Cannot handle symbolic offset in second dimension\n");
+ exit(1);
+ }
+ if ( sprintf(array_offset, "- (int)(%s)", symbol(lower_sym)) == NULL) perror( "sprintf");
+ (void) strcat(array_bounds, tmp);
+ }
+}
+
+/*Define a list of variables. These extend from index lo_var to hi_var inclusive
+of sym_table. This is called to define ordinary variables; fields in a field
+list (class = field_id_tok); a tag in a variant; or formal parameters (var_formals
+is true). If the type is a type id, we put its id-pointer into arg_typ; use this
+ when we calculate the proc. header.
+*/
+static void define_vars( class)
+int class;
+{ int k;
+ char output_string[100], real_symbol[100];
+ if (!hi_var) return;
+ for (k=lo_var; k<=hi_var; k++) {
+ strcpy( real_symbol, sym_table[k].id ) ;
+ if (cur_top_type == is_file)
+ sym_table[k].typ = file_id_tok ;
+ else sym_table[k].typ = class ;
+ sym_table[k].arg_typ = the_typ_id ;
+ /* If we are defining a formal parameter, need_var will indicate that it
+ must be passed by pointer.
+ */
+ sym_table[k].var_formal = var_formals ;
+ sym_table[k].need_var = var_formals &&
+ (( cur_top_type == is_record) ||
+ ( cur_top_type == is_int) ||
+ ( cur_top_type == is_char) );
+ sym_table[k].top_type = cur_top_type ;
+ sym_table[k].sub_type = cur_sub_type ;
+ if (*array_offset && class == var_id_tok) {
+ if ( sprintf(output_string, "#define %s (%s %s)\n",
+ real_symbol, next_temp, array_offset) == NULL) perror( "sprintf");
+ my_output(output_string);
+ (void) strcpy(real_symbol, next_temp);
+ find_next_temp();
+ }
+ if ( sprintf(output_string, "%s%s%s",
+ var_formals?"*":"" ,
+ real_symbol, array_bounds ) == NULL) perror( "sprintf") ;
+ my_output(output_string);
+ if ( k<hi_var ) my_output( ",");
+ }
+ semicolon();
+ hi_var = 0;
+}
+
+
+/*
+ * If we're not processing TeX, we return 0 (false). Otherwise,
+ * return 1 if the label is "10" and we're not in one of four TeX
+ * routines where the line labeled "10" isn't the end of the routine.
+ * Otherwise, return 0.
+ */
+static boolean doreturn(label)
+char *label;
+{
+ if (!tex) return(FALSE);
+ if (strcmp(label, "10") ==0) return(FALSE);
+ if (strcmp(my_routine, "macrocall") ==0) return(FALSE);
+ if (strcmp(my_routine, "hpack") ==0) return(FALSE);
+ if (strcmp(my_routine, "vpackage") ==0) return(FALSE);
+ if (strcmp(my_routine, "trybreak") ==0) return(FALSE);
+ return(TRUE);
+}
+
+
+/* Return the absolute value of a long */
+static long labs(x)
+long x;
+{
+ if (x < 0L) return(-x);
+ return(x);
+}
+
+static void declare_returns()
+{
+ if (sym_table[proc_num].arg_typ != NULL) {
+ my_output("register");
+ my_output( sym_table[proc_num].arg_typ);
+ my_output("Result;");
+ }
+ if (tex) {
+ if ( sprintf(safe_string, "%s_regmem",
+ my_routine) == NULL) perror( "sprintf");
+ my_output(safe_string);
+ new_line();
+ }
+}
+
+static void return_value ()
+{
+ if (sym_table[proc_num].arg_typ != NULL) {
+ my_output("return(Result)");
+ semicolon();
+ }
+}
+
+/* Generate a WRITE statement, I hope! On entry, i_o_file is the file to write,
+i_o_exp is the expression and i_o_w1 and i_o_w2 are widths, or 0 if not given.
+i_o_typ should be the type of the expression, but this is unreliable.
+i_o_stat assembles the args to be written in format i_o_fmt */
+static void do_write()
+{
+ char i_o_c, item[200], fmt[50] ;
+ if ( *i_o_w2 && i_o_typ != is_real)
+ err_mes( "Cannot print non-reals with two widths\n");
+ if (i_o_typ == is_char) i_o_c = 'c' ;
+ else if (i_o_typ == is_int) i_o_c = 'd' ;
+ else if (i_o_typ == is_real) i_o_c = 'E' ;
+ else if ( (i_o_typ == is_array && cur_sub_type == is_char )
+ || i_o_typ == is_string ) i_o_c = 's' ;
+ else err_mes( "Unprintable expression\n");
+ if ( *i_o_w2) {
+ if ( sprintf( fmt, "%%s%%s%%*.*E" ) == NULL) perror( "sprintf") ;
+ strcat( i_o_fmt, fmt);
+ if ( sprintf( item, " %s, %s, %s,", i_o_w1, i_o_w2, i_o_exp) == NULL) perror( "sprintf") ;
+ strcat( i_o_stat, item);
+ }
+ else if ( *i_o_w1)
+ {
+ if ( sprintf( fmt, "%%*%c", i_o_c ) == NULL) perror( "sprintf") ;
+ strcat( i_o_fmt, fmt);
+ if ( sprintf( item, " %s, %s,", i_o_w1, i_o_exp) == NULL) perror( "sprintf") ;
+ strcat( i_o_stat, item);
+ }
+ else
+ {
+ if ( sprintf( fmt, "%%%c", i_o_c ) == NULL) perror( "sprintf") ;
+ strcat( i_o_fmt, fmt);
+ if ( sprintf( item, " %s,", i_o_exp) == NULL) perror( "sprintf") ;
+ strcat( i_o_stat, item);
+ }
+}
+
+/* generate the actual write statement. Both i_o_stat and i_o_fmt have unwanted
+extra comma at end*/
+static void send_write()
+{
+ int n ; char *c ;
+ /* n= strlen(i_o_fmt) -1;
+ if (n >= 0)
+ c = i_o_fmt + n ;
+ else c = i_o_fmt ;
+ *c = '\0' ;*/
+ if (i_o_fun == writeln_tok)
+ { strcat (i_o_fmt, "%c") ;
+ strcat (i_o_stat, " '\\n',") ; }
+ n= strlen(i_o_stat) -1;
+ if (n >= 0)
+ c = i_o_stat + n;
+ else c = i_o_stat ;
+ *c = ')' ; c++; *c = '\0' ;
+ if ( sprintf(i_o_exp, "fprintf( *%s, \"%s\", ", i_o_file, i_o_fmt) == NULL) perror( "sprintf") ;
+ my_output( i_o_exp) ;
+ my_output ( i_o_stat);
+}
+
diff --git a/dviware/crudetype/version3/w2cbugs b/dviware/crudetype/version3/w2cbugs
new file mode 100644
index 0000000000..d9e1b12de9
--- /dev/null
+++ b/dviware/crudetype/version3/w2cbugs
@@ -0,0 +1,57 @@
+LIST of bugs in current version of my web2c. (Nov. 1990)
+
+POINTERS Crashes on self-referencing structures, e.g.
+
+type horse = ^cow ;
+ cow=record
+ log : horse;
+ (etc)
+
+
+In C this must all be rewritten approx. as follows:
+
+struct xyz {
+ xyz *log ;
+ (etc)
+
+
+followed by
+
+typedef struct xyz cow ;
+typedef cow *horse ;
+
+
+
+WITH statements. Fails because if you have an array of records,
+W2C knows the component type of the array is a record, but not
+what type of record it is.
+
+Variant records. A simple translation fails because you have to
+name all the intermediate places on the way down from top level.
+For example:
+
+ codeobject = packed record
+ breadth: iword ;
+ case boolean of
+ true: (IMfont: byte ; IMchar: byte );
+ {Printers font and character}
+ false: (multi: iword) ;
+ end;
+
+must be translated approx:
+
+typedef struct {
+ iword breadth ;
+ union{
+ struct{
+ byte IMfont ;
+ byte IMchar ;
+ } XXA ;
+ iword multi ;
+ } XXB ;
+} codeobject ;
+
+
+Then if C is a codeobject, C.IMfont must be translated as
+C.XXB.XXA.IMfont
+