diff options
Diffstat (limited to 'dviware/crudetype')
54 files changed, 26456 insertions, 0 deletions
diff --git a/dviware/crudetype/README b/dviware/crudetype/README new file mode 120000 index 0000000000..9f5535dfd2 --- /dev/null +++ b/dviware/crudetype/README @@ -0,0 +1 @@ +version3/aaaread.me
\ No newline at end of file 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 Binary files differnew file mode 100644 index 0000000000..7b407ba9a8 --- /dev/null +++ b/dviware/crudetype/version3/crudetype.pdf 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 + |