diff --git a/Makefile b/Makefile index dae84d0c..c225be36 100644 --- a/Makefile +++ b/Makefile @@ -44,7 +44,7 @@ SRC = syseng sysen1 sysen2 sysen3 sysnet kshack dragon channa \ mits_s rab stan_k bs cstacy kp dcp2 -pics- victor imlac rjl mb bh \ lars drnil radia gjd maint bolio cent shrdlu vis cbf digest prs jsf \ decus bsg muds54 hello rrs 2500 minsky danny survey librm3 librm4 \ - klotz atlogo clusys cprog + klotz atlogo clusys cprog r DOC = info _info_ sysdoc sysnet syshst kshack _teco_ emacs emacs1 c kcc \ chprog sail draw wl pc tj6 share _glpr_ _xgpr_ inquir mudman system \ xfont maxout ucode moon acount alan channa fonts games graphs humor \ @@ -52,10 +52,10 @@ DOC = info _info_ sysdoc sysnet syshst kshack _teco_ emacs emacs1 c kcc \ aplogo _temp_ pdp11 chsncp cbf rug bawden llogo eak clib teach pcnet \ combat pdl minits mits_s chaos hal -pics- imlac maint cent ksc klh \ digest prs decus bsg madman hur lmdoc rrs danny netwrk klotz hello \ - clu + clu r BIN = sys sys1 sys2 emacs _teco_ lisp liblsp alan inquir sail comlap \ c decsys graphs draw datdrw fonts fonts1 fonts2 games macsym \ - maint _www_ gt40 llogo bawden sysbin -pics- lmman r shrdlu imlac \ + maint _www_ gt40 llogo bawden sysbin -pics- lmman shrdlu imlac \ pdp10 madman survey rrs clu clucmp MINSRC = midas system $(DDT) $(SALV) $(KSFEDR) $(DUMP) diff --git a/bin/r/ts.r42 b/bin/r/ts.r42 deleted file mode 100755 index 20445eed..00000000 Binary files a/bin/r/ts.r42 and /dev/null differ diff --git a/build/misc.tcl b/build/misc.tcl index b9dfc6fd..4406e42d 100644 --- a/build/misc.tcl +++ b/build/misc.tcl @@ -1429,15 +1429,6 @@ expect ":KILL" respond "*" ":testc\r" expect "Done." -# R, text formatter. -respond "*" ":link sys3; ts r, r; ts r42\r" -# sys2; ts rr -> r; ts rr -# .info.; r info -> r; r info -# .info.; r recent -> r; r recent -# r; r macros -> r; r30 rmac -# r; rmacro 1 -> r; r macros -# sys3; ts itype -> r; ts itype - # Revert patch to [CLIB] 16 to avoid use of the FIX instruction on a KA10. patch_clib_16 @@ -1460,6 +1451,20 @@ respond "*" ":link sys; ts tj6, sys; ts ntj6\r" respond "*" ":midas sys2; ts otj6_tj6; otj6\r" expect ":KILL" +# Alan Snyder's R typesetting language. +respond "*" ":cwd r\r" +respond "*" ":cc rcntrl rdev rexpr rfile rfonts richar ridn rin rin1 rin2\r" +respond "*" ":cc rits rline rlpt rmain rmisc rout rreadr rreg rreq1 rreq2\r" +respond "*" ":cc rreq3 rtext rtoken rtrap rvaria rxgp\r" +respond "*" ":stinkr r\r" +respond "*" ":link sys3; ts r, r; ts r30\r" +# sys2; ts rr -> r; ts rr +# .info.; r info -> r; r info +# .info.; r recent -> r; r recent +# r; r macros -> r; r30 rmac +# r; rmacro 1 -> r; r macros +# sys3; ts itype -> r; ts itype + # Binary patch Lisp image to work on ITS not named AI, ML, MC, or DM. # This is for Bolio. respond "*" ":job purqio\r" diff --git a/build/timestamps.txt b/build/timestamps.txt index da4ac3a6..852a8d18 100644 --- a/build/timestamps.txt +++ b/build/timestamps.txt @@ -1664,6 +1664,47 @@ quux/schint.lsp 197709221505.26 quux/schmac.fasl 197709011620.57 quux/schmac.lsp 197709011620.40 quux/schuuo.lsp 197709061911.30 +r/r.h 197801301232.45 +r/r.histry 197611061243.09 +r/r.notes 197801301646.52 +r/rcntrl.c 197712030746.20 +r/rdev.c 197712142003.56 +r/rexpr.c 197707270835.24 +r/rextrn.desc 197801112025.50 +r/rextrn.list 197801272000.23 +r/rfile.c 197801272042.51 +r/rfonts.c 197712030748.11 +r/richar.c 197712150847.09 +r/rideas.r 197710121031.31 +r/ridn.c 197712030748.01 +r/rin.c 197712150850.17 +r/rin1.c 197712160851.20 +r/rin2.c 197712150943.07 +r/rits.c 197801272147.37 +r/rline.c 197801272033.02 +r/rlpt.c 197712141920.24 +r/rmain.c 197801122003.53 +r/rman.index 197801301733.26 +r/rman.r 197801301835.38 +r/rman.toc 197801301730.42 +r/rmantc.r 197801300959.38 +r/rmisc.c 197712150847.40 +r/rout.c 197712200939.10 +r/rreadr.c 197801301232.08 +r/rreg.c 197801301233.29 +r/rreq1.c 197801301207.00 +r/rreq2.c 197801272118.53 +r/rreq3.c 197801301214.33 +r/rt20.c 197801160908.20 +r/rteco.macros 197710011050.36 +r/rtext.c 197801301237.13 +r/rtoken.c 197711252356.40 +r/rtoken.old 197710011528.38 +r/rtrap.c 197801161035.01 +r/runix.c 197712031129.59 +r/rvaria.c 197712141848.11 +r/rxgp.c 197712141847.02 +r/troff.compar 197801050924.12 rab/line.2 197712070031.04 radia/tortis.31 197302181913.22 _/ram.ram 198505040209.09 diff --git a/doc/r/r.histry b/doc/r/r.histry new file mode 100644 index 00000000..09793653 --- /dev/null +++ b/doc/r/r.histry @@ -0,0 +1,22 @@ +21 11/6/76 11:27:27 +20 9/19/76 18:55:01.5 +19 7/8/76 18:39:02.5 +18 5/31/76 16:43:38.5 +17 3/5/76 14:36:49 +16 2/26/76 21:05:14 +15 2/21/76 12:46:46 +14 12/22/75 13:49:17 +13 12/6/75 17:54:53.5 +12 11/13/75 12:44:44.5 +11 11/2/75 18:13:18.5 +10 10/30/75 11:09:52 +9 10/28/75 12:33:22 +8 10/26/75 18:01:44 +7 10/13/75 17:29:43 +6 9/20/75 19:12:33 +5 9/1/75 18:17:05 +4 8/16/75 21:01:57 +3 5/11/75 21:46:02 +2 4/16/75 11:36:05 +1 3/19/75 15:30:11 + \ No newline at end of file diff --git a/doc/r/r.notes b/doc/r/r.notes new file mode 100644 index 00000000..2fbd5e44 --- /dev/null +++ b/doc/r/r.notes @@ -0,0 +1,79 @@ +R CHANGES UNDER CONSIDERATION (30 Jan 1978) + +-- changes made --- + +leading ^C, ^R causes break +don't remove trailing blanks in nofill mode +FS changes both c and p fonts +PF request removed +TR takes 2 characters only +WF and WA can take a full file name (if one name given then + taken as extension) +HV, VV requests +^F ring buffer (also used by FS) +FONT, PFONT NR do not affect ring buffer +Fwidth NR +End_of_sentence NR + +-- likely changes -- + +Allow arb. space/tab to separate file name from font mode +Should the no-space mode be reset when the vertical position is + changed? (YES) +.ms macro -> string +CFDATE, CFTIME string registers +Does ^X macro start in state=0? Should it? + +LESS LIKELY CHANGES + +Concealed newlines? +Outfile SR/SR init? +case shift request? +Better way to handle tabs. +Allow underlining of white space (internal prefix operator). +A way to avoid widows? +RD arg should always go to tty (error file on UNIX?) +Should .nr font x interfere with ^F* (by changing old font)? + At least document it. +There apparently is some use for a "left-justify" character, other + than the hpos hack, which perhaps should change. +Could use a "relative tab" that does not break words or affect justification. + Perhaps simply change semantics of .hp to always be + relative (thus allow negative hpos until actually used). +\^A"0 "doubles" quotes before inserting +Should allow more than 10 macro arguments? +Think about beginning-of-line and end-of-line traps (for line numbering + and large character hacks) +Perhaps the ES request should not copy the partial line. +Recognize hyphen at end of input line in fill mode (?) +Invisible hyphen character ^Y (?) +LPT_TABs: if (n=lpt_tabs)>0 then assume that LPT has tab stops every + n columns and use tabs for input tabs, ^Ps, etc. +Should " matching only occur at one input level? How difficult to + implement? + +Possible uses for remaining control characters: + ^O - horizontal offset + ^Y - hYphen + +R BUGS + +R MACRO BUGS + +R MACROS + +R MACRO DOCUMENTATION + +R MANUAL + +Ignore would be a good example. +Should talk about using fixed-width fonts to get things + lined up as in input (pf and tabs). +Explain how character width is calculated, and what it means. + space_width = width (' ') + char_width = max (width (' '), min (2*width(' '), width ('0'))) +Note that skipping statement bodies knows nothing about + macro definitions. +EQ needs example. +Note that .\^Sfoo is possible. + \ No newline at end of file diff --git a/doc/r/rextrn.desc b/doc/r/rextrn.desc new file mode 100644 index 00000000..9fbf5492 --- /dev/null +++ b/doc/r/rextrn.desc @@ -0,0 +1,50 @@ +Description of externally used routines: + (Not including routines in RITS.C) + +file I/O: + Files are represented by integers or pointers, returned by + the various open routines. These routines must return + the constant OPENLOSS when a file cannot be opened. + + cputc (c, f) output the character c; '\n' implies + end of line + c = cgetc (f) input a character; '\n' implies end + of line; and negative or zero must be + returned on end-of-file + b = ceof (f) return TRUE iff end-of-file (last + character read by cgetc was negative + or zero) + gets (buffer) read a line of characters from standard + input into the buffer, terminated by + NUL + ungetc (c, f) push back character onto input stream; + capacity of 1 character is required + cclose (f) close file + cisfd (f) return nonzero if f looks like it is + a file descriptor + setprompt (s) make string s the default prompt for + terminal input (optional, of course) + +Standard files: + cin standard input (used for terminal input) + cout standard output (used for messages) + cerr standard error (used for some fatal errors) + +String routines: + n = slen (s) return length of string + b = stcmp (s1, s2) compare for equality of strings + stcpy (s, d) copy string from s to d + +Storage allocation: + *i = salloc (n) return n integers [check for storage full] + *c = calloc (n) return n characters [check for storage full] + sfree (*i) return integers allocated by salloc + cfree (*c) return characters allocated by calloc + n = alocstat (*p, *q) return number of free words of storage + set *p to size of free space (in words) + and *q to the number of free blocks + return -1 if no stats available +Miscellaneous: + stkdmp (f) dump stack frames on file for debugging (optional) + i = cputm () return cpu time in 1/60 sec + \ No newline at end of file diff --git a/doc/r/rideas.r b/doc/r/rideas.r new file mode 100644 index 00000000..77b0c26f --- /dev/null +++ b/doc/r/rideas.r @@ -0,0 +1,68 @@ +.fo 0 25vg +.fo 1 25vgb +.fo 2 25vgi +.fo 3 31vg +.so r/r.macros +.sr left_heading 2R Ideas* +.sr right_heading 2fdate* +.de sec title {date} +.fi +.sp +.ne 5 +3\0 \1* +.sp +.em +.de bug date +.fi +.sp +.ne 5 +3\0 BUG* +.sp +.em +.sec "Page Selection" 6/29/75 +It might be desirable to have a command option, like TROFF, which +causes only designated pages to be output. +.sec "String Substitution" 6/29/75 +It has been suggested that R implement some form of low-level +string substitution (without rescanning), so that one could write +<= and have it replaced by ^F1^Q^[^F*. +.sec "Indexes" 9/18/75 +One possibility is to be able to specify a list of words to be +indexed when output (don't do unless printing turned on). +XOFF (CMU 10/72) has the following commands: +.table + .index + .note + .print index +.end_table +These produce lines of the form +.table + word (phrase)page1, page2(5i) +.end_table +In addition, there is 1collate in*, which specifies sorting, +and 1collate out*, which specifies when a blank line should +be left in the index (normally between entries whose first characters +differ). +.sec "Output Diversion" 10/1/75 +A possible way to do output diversion is to have another device type, +STRING, and save the actual device output in a macro. One problem +is to make sure that absolute vertical positions are changed to +relative. + +Another possibility is to attempt to store the output in a form +which can be processed as input. This has the advantage of being +readable, at least. A new control character or mode would be +needed that would cause justification without filling. +.bug 10/3/75 +It is possible to evoke a message, "escape character ('\t') not +allowed as text." I believe this escape character should be +allowed as text, regardless of how it is obtained. +.sec "Footnote Problems" 10/26/75 +See Greif, p. 91, for PUB footnote lossage. What about footnote +reference in a figure which may be moved to the next page after +it is determined how much room it needs. +.sec "Macro Insertion" 11/1/75 +It might be desirable to have some way of dynamically inserting +a macro body inside the definition of another macro. How should +one be able to concatenate two macros into another macro definition? + \ No newline at end of file diff --git a/doc/r/rman.index b/doc/r/rman.index new file mode 100644 index 00000000..afa35b33 --- /dev/null +++ b/doc/r/rman.index @@ -0,0 +1,79 @@ +.index am 17 +.index be 19 +.index bj 12 +.index bk 19 +.index bp 11 +.index br 12 +.index cc 22 +.index ct 21 +.index de 16 +.index dv 10 +.index ec 22 +.index ef 19 +.index em 17 +.index en 19 +.index eo 11 +.index eq 17 +.index es 18 +.index ev 18 +.index ex 21 +.index fi 12 +.index fo 10 +.index fr 19 +.index fs 10 +.index hp 14 +.index hs 14 +.index hv 20 +.index hx 15 +.index if 19 +.index in 13 +.index ir 14 +.index ll 13 +.index ls 13 +.index nc 22 +.index nd 14 +.index ne 11 +.index nf 12 +.index nr 14 +.index ns 13 +.index nv 19 +.index nx 21 +.index oo 11 +.index pl 11 +.index pn 11 +.index rd 21 +.index rl 24 +.index rm 17 +.index rs 13 +.index rt 21 +.index sb 15 +.index sc 15 +.index sd 15 +.index si 15 +.index sl 16 +.index so 21 +.index sp 13 +.index sr 14 +.index st 21 +.index sv 19 +.index ta 14 +.index ti 14 +.index tm 24 +.index tr 23 +.index uo 23 +.index ut 23 +.index vp 13 +.index vv 20 +.index vx 15 +.index wa 21 +.index we 22 +.index wf 21 +.index wh 19 +.index wl 22 +.index wm 22 +.index ws 22 +.index xc 24 +.index xe 18 +.index xn 15 +.index xs 15 + \ No newline at end of file diff --git a/doc/r/rman.r b/doc/r/rman.r new file mode 100644 index 00000000..64889e1e --- /dev/null +++ b/doc/r/rman.r @@ -0,0 +1,3156 @@ +.dv xgp +.fo 0 25vg +.fo 1 25vgb +.fo 2 25vgi +.fo 3 40vg +.fo 4 75vbee +.fo 5 18fg +.fo 6 31as +.fo 7 31vg +.fo 8 25as +.fo 9 22fg +.fo F 2AS +. +.nr sec_map 4 +.nr sec_rq 7 +.nr req_dev 1 +.nr req_fill 3 +.nr req_vp 4 +.nr req_env 9 +.nr sec_cclist 8 +.nr sec_delay 9 +.nr sec_freeze 11 +.nr sec_example 15 +. +.ec x  +.ec h  +. +.tr @ +.sr r_version 30 +.sr edate fdate +.nr both_sides 1 +.sr left_heading 2R Reference Manual* +.sr right_heading 2edate* +.sr list_left_margin 500m +.sr list_right_margin 500m +.sr figure_name Figure \ +.sr footnote_starter   5\cfn* +.nr fnfont 5 +. +.sr asterisk 1** +.sr newline 1newline* +.sr tab 1tab* +.sr quote 8'* +.sr dot dodot() +.sr pom +\h(-fheight/4m)-(+fheight/4m) +. +.de dodot +.hs 10m +. +.hs 10m +.em +. +.de nw +.if ll-rindent-hpos<\0 +. bj +.en +.em +. + lbox - A carefully handcrafted macro to make + a letter in a box. It works only for 25vg + and 18fg. + +.de lbox +. if ll-rindent-hpos<500 +. bj +. en +. if +. nv font 0 +. nv S hpos +|\h(+15m)|(-15m) +. hs (S-hpos+10)m +. nr font 15 +(-25m)_ +. hs (S-hpos+35)m +_(+25m) +. hs (S-hpos+40)m +. nr font 9 +(+10m)\0(-10m) +. hs (S-hpos+10)m +. nr font 15 +(+10m)_ +. hs (S-hpos+35)m +_(-10m) +. hs (-20)m +. nr font 0 +|\h(+15m)|(-15m) +. en +.em +. +.de c +. if nargs>0 +. lbox \0 +. ef +. lbox  +. en +.em +. +.if lpt +.de c +. if +. nv font 0 +. if nargs>0 +^\0 +. ef +. nr font 1 +space +. en +. en +.em +.en +. +.sr space c() +.sr cquote c(') +. +. +.if (?nice==0&lpt)|?m==0 +.ex +.en +.if 4*m*m-3*m~=10660 +.ex +.en +.tm R Reference Manual - edate - Version r_version +.so r.macros +.rs +.sp 2.5i +.nf c +.new_font 4 +R +Reference +Manual +.new_font 0 +.sp 3i +.new_font 3 +Draft of edate +Corresponds to R Version r_version +.sp 1i +Copyright 6c* 1976, 1977, 1978 by Alan Snyder +.new_font 0 +.nf l +.fi +. + MACROS +. +.am table_of_contents +.new_font 7 +.em +. +. +.de para +.sp +.ne 3l +.em +. +.nr sec_no 0 +. +.de sec title +.nr rqsecno 0 +.in 0 +.fi +.sp +.ne 6l +3\+sec_no. \0* +.sp +.ns +.am table_of_contents +.nf +.sp .5 +\sec_no. \0 . \page +\.em +.if ?user!terisk==0 +.tr aeeiioouua +.end +.em +. +. +.de req_summary +.keep +.em +. +. +.de safetab +.lbegin +.nv pos 0 +.hx pos \0 +.hs 1 +.if hpos>=pos +. br +.en +.nr hpos pos +.end +.em +. +.wf index +.we +. +.de req name args break explanation +.lbegin +.nv breaks 0 +.sv no no +.sv break \2 +.sc breaks break no +.sv cchar quote +.if breaks +.sr cchar . +.en +.sp +.ne 2 +.fi +.in reqindent +.ti -reqindent +\cchar!\0 \1safetab(reqindent) +.am req_summary +\cchar!\0 \1safetab(reqindent)\3  \page@ +\.em +.wa index +.wl .index \0 \page +.we +.am table_of_contents +2\0* +\.em +.end +.em +. +. +. +.de reqtabs +.lbegin +.nv s +.hx s 1 +.nv i indent/s +.ta i+3.7 i+16 i+16+4 i+16+24 +.nr reqindent i+16 +.end lbegin +.em +. +. +.de reqh +.sp +.reqtabs +.ne 6l +. +1Request Form Explanation0 +.br +.em +. +.de reqsumh +.sp +.reqtabs +.ne 6l +. +1Request Form Explanation  Page0 +.br +.em +. +. +.nr rqsecno 0 +. +.de rqsec +.in 0 +.sp +.ne 9l +3\sec_no.\+rqsecno \0* +.sp +.ns +.am req_summary +.end_keep +.sp +.keep +3\rqsecno. \0* +.sp +\.em +.am table_of_contents +.ne 2 +.ta indent+600m + \sec_no.\rqsecno \0 . \page +.fi +  +\.em +.em +. +. +.de examples +.sp +.ne 8l +1Examples.* +.em +. +.de cc_des name form desc +.ta 2 2+5 2+5+14 +.in 2+5+14 +.sp +.ne 3l +.ti -(2+5+14) + \0 \1  +.am cc_summary +.ta 10+2 10+2+5 10+2+5+14 + \0 \1 \2  \page@ +.br +\.em +.em +. +. +.de cc_header +.ta 2 2+5 2+5+14 +.ne 6l +.br +1D esig Form Explanation* +.br +.em +. +.de cc_sum_header +.ta 10+2 10+2+5 10+2+5+14 +1D esig Form Explanation  Page* +.br +.em +. +.nr rqsec 0 +. +. + END OF MACROS +. +.ev contents +.ls 1 +.new_font 7 +.ev +. +.begin_table_of_contents 2 +.sec Introduction +.para +R is a text formatter which produces output for both typesetting devices +(such as the Xerox Graphics Printer) and normal printing devices. +It accepts input containing the text to be formatted, +plus requests and control characters that +indicate how the text is to be formatted. +.para +This document describes the input format and the R requests and +control characters, and presents a number of examples. It is +not a tutorial; familiarity with the basic concepts of text +formatting is assumed. R users should also examine the documentation +of any standard macro packages. +. +.foot +R macro files and documentation files are stored in the R directory +on ITS and in the /usr/r directory on Unix. +.efoot +. +.para +R can perform filling, adjusting, centering, indenting, underscoring, +overprinting, superscripting and subscripting. +R can handle +multiple variable-width fonts of different heights. +R supports adjustable tab stops and allows the space created by a tab +to be filled with a sequence of arbitrary text. +R supports text output to multiple files for later processing +by other programs. +.para +R provides the following extension facilities: macros, number +registers and string registers, integer arithmetic and logical +operations, traps, multiple environments, conditionals, iteration, +and local variables (dynamically bound, 2a la* LISP). +Macro packages have been developed that support header and footer +areas, page numbering, sectioning, section numbering, tables of +contents, numbered tables and figures, and footnotes (this +document was produced using such a macro package). +A tracing facility is available for debugging. +.para +The following features are not supported: multiple columns on the XGP +device, automatic forward references, line numbering, automatic or manual +hyphenation. +.if 0 +.para +Implementation notes: (1) superscripting and subscripting are +not implemented for the LPT device. +.end if +.sec Philosophy +The development of R has been motivated in large part +by a small number of good ideas and a larger number +of defects in previous text formatting programs. +Its design goals include: +.ilist 5 +2flexibility* - Instead of inflexible, +built-in facilities for things like margins, headers +and footers, sectioning, tables, tables of contents, +and footnotes, R is intended to provide low-level +mechanisms that allow users to implement these +facilities as they desire. It is intended that +standard macro packages be used to provide these facilities. +.next +2generality* - All ASCII characters should be +allowed in text (although escape sequences may be needed +in order to write some characters); no characters should +be reserved for internal implementation purposes. +Requests should be generalized wherever possible; +uniform mechanisms should be provided for specifying +various options (such as different units of measurement +and relative values) rather than complex, incomplete +sets of specialized requests. +.next +2device compatability* - The device-dependence of the +language should be minimized so that it is easy to write +programs that can be processed for all supported +output devices without change. +.next +2modularity* - It should be possible for a user to +redefine the characters used to represent the R control +characters in the input file without affecting the +operation of separately-written macro packages. +.end_list +.sec "The Logical Input Alphabet" +.para +In describing R, it is convenient to distinguish two +input alphabets, the logical input alphabet and the +physical input alphabet. +The logical input alphabet is an "internal" character set +in terms of which the semantics of R constructs +are defined. The physical input alphabet is what the +actual input is written in. +Of primary importance to the user is the mapping from +the physical input alphabet to the logical input alphabet. +This mapping is described in Section sec_map. +Two input alphabets are needed because (1) R deals conceptually +with an alphabet (the logical input alphabet) that is larger +than most computer character sets and (2) the rules +mapping the physical input alphabet to the logical input +alphabet will in general be system-dependent. +. +.para +The logical input alphabet consists of text characters and +control characters. +There are 128 ASCII text characters. Each text +character maps directly into corresponding output +characters (one character for each font). +Not all ASCII characters may be meaningful, +depending on the output device and the particular font +in use. +. +.para +The control characters each have +a corresponding ASCII designation character, +which is used to represent the character in this +document and in some R requests. +A control character is referred to as control-2X* +and written in this manual as \xc(X), where +X is the corresponding ASCII designation character. +The control characters are distinct from ASCII control characters, +which are text characters. In this document, the +ASCII character control-X is written as ^X. +. +.para +There are 30 control characters, \xc(A) through \xc(Z), plus +\xc(.), cquote, \xc(\), and \xc() (control-space). +(A listing of the R control characters and their functions +appears in Section sec_cclist.) +The \xc(.) and cquote characters are used to begin +R requests. +The space character separates input text words and +causes some width of blank space to appear +in the output (except when at the end of an +output line in fill mode, see Section sec_rq.req_fill below). +The minimum width of blank space so produced +is determined by the 1principal font* +(see Section sec_rq.req_dev below); +this width may be increased by the process of 1justification* +(see Section sec_rq.req_fill below). +. +.para +The \xc(\) character has two functions. When followed +immediately (in a file) by a letter, the \xc(\) and +the letter together represent an escape character. +There are 26 possible escape characters, +one for each letter of the alphabet. Each escape character can +be defined to be equivalent to some logical input character, +using the EC request. When an escape character is read, it is +treated exactly like the corresponding logical input character. +(Use of an undefined escape character is an error.) +. +.para +If a \xc(\) is not followed by a letter, then the \xc(\) serves to +delay the interpretation of an immediately following control +character (see Section sec_delay). +. +.para +The logical input character \xc(I) is also called tab; +the logical input character \xc(J) is also called newline. +Note, however, that the R control characters do not necessarily +correspond to the ASCII control characters. +. +.sec "The Input Mapping" +.para +The physical input alphabet consists of whatever character +code is used by the computer system. The physical +input alphabet and its mapping to the logical input +alphabet are thus system-dependent. However, this +section will describe a particular alphabet and mapping +for systems using the ASCII character set. +.para +In this mapping, most of the ASCII characters either +stand for themselves (the corresponding ASCII text logical +input characters) or they stand for particular control +characters (the exact mapping may be set by the user +using R requests). +The exceptions are the characters CR, NL, and FF. +The CR, NL, and FF +characters are either ignored or (perhaps in some +particular system-defined sequences) they represent +the \xc(J) character (newline), which +terminates logical input lines. +.para +Initially, the ASCII control characters ^A (control-A) through +^Z (control-Z) represent the corresponding R control +characters \xc(A) through \xc(Z). +The backslash character (\) represents \xc(\), +and ASCII SP (space) represents \xc(). +The characters "." and "quote" (apostrophe), when the first +character of an input line, represent the \xc(.) and cquote logical input +characters, respectively. When not the first character of an input +line, they represent the corresponding ASCII text characters. +All other ASCII characters (except CR, NL, and FF) +represent the corresponding ASCII text characters. +. +.para +The following escape characters are initially defined to represent ASCII text +characters: +.table 5 +.ta 6 20 +1 escape char corresponding text char* +.sp + 1esc-*n NL + 1esc-*r CR + 1esc-*p FF +.end_table +.rtabs +(This is the only way to write text NL, CR, or FF characters.) +The other escape characters have no initially-defined meaning. +.para +The mapping defined in this section is used for all examples +of R input in this document. +Thus, in examples of R input, ^S means +the ASCII ^S physical input character (which +normally maps to the \xc(S) logical input character). +. +.para +The mapping from the physical input alphabet to the logical +input alphabet takes place only upon reading from files. Once +information enters R, it is stored as strings in the logical +input alphabet. +.sec "Input Modes" +.para +The physical to logical input mapping maps physical input characters +into either the corresponding text characters or to control +characters. +The mapping operates in a number of modes, +depending upon context. In each mode, some control characters +are recognized and some are not. If a control character is +not recognized, then a physical input character that would +normally map to that control character instead maps to +the corresponding text character. +For example, if the ASCII ^S physical input character +normally maps to \xc(S) but \xc(S) is not recognized, then +^S maps to the ^S ASCII text character. +.para +The input modes are numbered, from 0 +to 2. The modes are totally ordered, with +mode 0 performing the smallest subset of the mapping and +mode 2 being the full mapping. Each mode contains all of +the transformations contained in the lower-numbered modes. +.para +The modes are described in the Table :current_table, +along with an enumeration of their uses. The description of uses +refers to R requests and control characters; these are +described in later sections. +. +. +.begin_table "Input Modes" +.ne 10 +.ilist 5 +1mode description* +.next + 0. In mode 0, the only mapping is from the CR, NL, and +FF characters into either \xc(J) (newline) or nothing. The exact mapping +is system-dependent. This mode is used to read the character +following the \xc(Q) character and for skipping comments +and extra characters on request lines. +.next + 1. In mode 1, mode 0 mapping is performed. In addition, +the \xc(A), \xc(I), \xc(K), \xc(N), \xc(Q), \xc(S), +\xc(\), and space characters are +recognized. +This mode is used for reading request names, for reading the first +argument to the EC request, and for reading the arguments of +all R requests not mentioned elsewhere in this table. +.next + 2. In mode 2, mode 1 mapping is performed. In addition, all +other R control characters are recognized. +This mode is used for +reading text lines, macro definitions, arguments to the SR and XC +requests, arguments to macro invocations, and the second argument +to the EC request, and for skipping the bodies of IF, WHILE, +and FOR statements. +.br +.ns +.end_list +.finish_table +. +. +Note that the \xc(.) and cquote characters are recognized only as the +first character of an input line. +If one wishes to use \xc(A), \xc(S), or \xc(N) to compute a request +argument that is normally read in a mode in which \xc(A), \xc(S), +and \xc(N) are not recognized, one can use the XC (execute) +request, which reads all arguments in mode 2. +Note also that macro bodies are always read in mode 2, regardless +of whether or not the macro bodies contain requests whose arguments +are normally read in some other mode. +. +.sec "Input Format" +.para +The input to R consists of lines of text interspersed with R requests. +An R request is an input line that begins with a period (actually, +the \xc(.) character). +A request consists of a request name optionally followed +by some number of arguments. The request name may be indented by +inserting space!s or \xc(I)s between the \xc(.) and the +request name. The request name and the arguments all must be separated +by at least one space or \xc(I). Any extra arguments to a request +are ignored. A request may also be written using cquote instead of \xc(.)@; +using this form inhibits the line-break normally caused by +certain R requests. +(Line-breaks are described in Section sec_rq.req_fill.) +A request line containing no request name is ignored. A request +line naming an undefined request produces an error message. + +One may write comments on request lines or text lines using the +\xc(K) character. This character causes all following input, +up to the next newline, to be ignored. If the \xc(K) appears as the +first character on a line, then the entire line (including the +terminating newline) is ignored. +. +.sec "Request Descriptions" +.am table_of_contents +.sp .5 +.fs 1 +.ir +300m +.em +.para +The following sections describe the R requests. The description of a +request starts with a line containing the form of the request. +Requests that normally cause line-breaks are +shown prefixed by "."; requests that do not cause line-breaks are +shown prefixed by "quote". Many request descriptions refer to R control +characters; these are described in Section sec_cclist. +.para +The notations used in the description of request arguments are +described in Table :current_table. +. +. +.de arg_notations +.table +.nf +1Argument description syntax: {2name*:}{0pom*} +2type*{(2default*)}* + +2Name* - a name used to refer to an argument in descriptions of the request +2Type* - a description of allowed values of an argument +2Default* - the value used if no argument is given + +.fi +The notation pom means that the argument may optionally be preceded by a + or a -, +meaning increment or decrement the old value. + +A default value of 2prev* means that the previous value of the +relevant parameter is restored. + +.nf +The possible types are: + + M a name (alphanumeric string, case not distinguished, mode 1) + C a single text character (mode 1) + F a font designator character (mode 1) + L a single logical input character (mode 2, one \ removed) + S a string terminated by \xc(J) (mode 2) + T a string of text characters terminated by \xc(J) (mode 1) + N a decimal expression, integer value used (mode 1) + R a decimal expression, fractional part allowed (mode 1) + V a vertical distance specification having the forms: + R R times the height of principal font + Rl R times the line separation distance + Ri R inches + Rm R mils (1/1000 inches) + Rc R centimeters + H a horizontal distance specification having the forms: + R R times the character width of principal font + Ri R inches + Rm R mils (1/1000 inches) + Rc R centimeters +.end_table +.em +. +. +.begin_table "Request Argument Notations" +.lbegin +.nv s +.hx s 1 +.nv i indent/s +.ta i+5 i+10 i+13 i+18 +.end lbegin +.table 14 +.arg_notations +.br +.ns +.end_table +.rtabs +.finish_table +. +. +An argument specified by T may contain the characters +space and \xc(I); they are converted to the +ASCII SP and HT characters, respectively. +. +.para +An 1expression* (forms N, R, V, and H) +may be a simple integer or fixed-point number, a +name, or an expression containing arithmetic and logical operators. +These operators are listed in Table :current_table. +A name used in an expression may not begin with a digit. +When a valid name is encountered during expression evaluation, +it is treated as if it were preceded by a \xc(N), i.e., it +is used as the name of a number register. Expression evaluation +is performed in floating-point. The result of an expression is +converted to an integer by rounding to the nearest integer value; +a number 2n*.5 rounds to 2n*. +. +. +.begin_table "Arithmetic and Logical Operators" +. +. +.table 16 +.ta 5 20 + + addition + - subtraction + * multiplication + / division (result is rounded) + ^ integer division (result is truncated toward 0) + % mod + & logical and + | logical or + == equal + ~= not equal + < less than + <= less than or equal + > greater than + >= greater than or equal + + prefix + + - prefix - + ~ prefix logical not +.br +.ns +.end_table +.rtabs +.finish_table +. +. +The logical operators interpret zero as FALSE and non-zero +as TRUE; they return 1 for TRUE. +The usual operator precedence is recognized; in addition, +parentheses may be used to explicity specify the +disambiguation. +. +.para +The suffixes used for vertical and horizontal distance specifications +(forms V and H) may only follow a complete request argument +and may not be attached to individual components of an argument. +The suffixes apply to the entire preceding expression. +Where "mixed mode" calculations are desired, the VX, HX, VV, and HV requests +should be used. The suffixes are recognized in both upper and +lower case. +. +.para +The notation "prev" used to describe the default value of +a request argument means that if no argument is given, the +previous value of the relevant parameter is used. +Only one "previous value" of a parameter is remembered; it is changed +only when an explicit argument is provided. +. +.rqsec "Output Device Specifications" +.para +The available output devices are line printers +(called LPT, also includes "standard" printing terminals), +Varian Statos printer/plotters (called VARIAN), and the +M.I.T. Xerox Graphics Printer (called XGP). +.foot +The VARIAN device is implemented only on Unix. +The XGP device is not implemented on Unix. +.efoot +The output device may be set either by a command option +or by the DV request. If not specified, the default +is LPT. +.para +The XGP and VARIAN devices understand up to 16 fonts, which are +designated by the +numbers 0 through 9 and capital letters A through F. Initially, font +0 is defined to be a standard font; +.foot +This font is currently 25vg. +.efoot +other fonts are initially undefined. A font must be defined (using +the FO request) before it can be used. +. +.para +When the output device is LPT, +the treatment of characters in a particular font is determined by +the corresponding font mode, which is one of: +.table 4 + n - output normally + u - underscore + o - overprint + c - capitalize +.end_table +Font modes are specified in the FO requests; the default font mode +is Normal for font 0 and Underscore for all other fonts. +.para +The 1principal font* is used to determine the units of horizontal +and vertical measurement when expressed in terms of characters and +lines. It is also used to determine the vertical spacing of output +lines and the increments of vertical offset for superscripts and +subscripts. +.para +The unit of horizontal measurement is called the 2character width* +of the font. It is computed as follows: +.table 1 + charwidth = max (width (" "), min (2*width(" "), width ("0"))) +.end_table +The character width is (potentially) distinct from the 2space +width*, which is the width of the space character. The space +width determines the width of blank space produced by the \xc() +character. +. +.para +The 1current font* is used in mapping the 128 ASCII +logical input characters (when occurring in text) into +output characters. A logical input character +2X* is mapped into the output character +<2F*, 2X*>, where 2F* is the current font +at the time the mapping is performed. +. +.reqh +. +.req dv M(LPT) no "Declare output device to be M." +(Device) +The output device is declared to be that given by the specified name. +The name must be either LPT, VARIAN, or XGP (case not +important). The DV request, if present, must be +given at the beginning of the input (see Section sec_freeze +for a precise statement of this restriction). +More than one DV request may be given, in which case the +last one is used. +. +.req fo "F T" no "Specify font designated by F to be T." +(Font Definition) +The FO request defines the font designated by F to be that specified +by T. +.foot +In the ITS implementation, T must be a file specification that names +a KST-format font definition file. The default extension is KST; +the default device is DSK. If no directory is specified, the +current directory is searched, followed by FONTS and FONTS1. Because +of a limitation of the XGP spooler, the font file must also +exist in the corresponding location on the AI machine. +In the Unix implementation, T must specify a font name corresponding +to a font definition in /sys/fonts. +.efoot +The font specification T may optionally be followed by a font mode +(described above) in parentheses. +The FO request may appear only at the beginning of the input +(see Section sec_freeze for a precise statement of this restriction). +More than one FO request for a given font designator F may be given, +in which case the last one is used. +Fonts may be selected using the \xc(F) character or the FS request. +Initially, the current font is font 0. +. +.examples +The following is one possible way to begin an R file: +.table + .dv xgp ^K make XGP the default device + .fo 0 30vr ^K define the normal font + .fo 1 31vgb ^K define the bold font + .fo 2 30vri ^K define the italic font + .fo 3 37vrb (c) ^K define the big font (capitalize on LPT) + .fo 4 75vbee (c) ^K define the huge font (capitalize on LPT) +.end_table +. +. +.req fs F(*) no "Select font F as current and principal font." +(Font Select) +The FS request sets the current font and the principal font +to be that designated by F. +The current font and principal font are initially font 0. +(See also \xc(F) and the FONT and PFONT built-in number registers.) +.para +The FS request and \xc(F), when used with an explicit argument, +first push the old value of the current font on a per-environment +stack. When FS is used with no argument (or \xc(F)* is used), the +most recent font is removed from the stack and used (implicitly) +as the argument. +The size of the font stack is fixed. When the stack becomes full, +the oldest value is discarded. Use of the FONT or PFONT number +registers does not affect the font stack. +.para +The font stack can be used to perform local font changes without +affecting surrounding text. However, to work properly, all font +changes (using the FS request or \xc(F)) must be properly nested, +with each explicit font change (e.g. \xc(F)1) having a matching implicit +font restoration (e.g. \xc(F)*). +.rqsec "Page Control" +.para +The length of the output page is set by the PL request. +Top and bottom margins are not automatically provided; +they must be explicitly specified by setting traps +at the top of the page and at the bottom margin. +In the absence of such action, R will use the entire +page length for output. Each output page has a page +number. The page number is not automatically printed, +but is available for printing in a manner specified +by the user. Section sec_example presents +a set of macros that define top and bottom margins +and print headings on each page. +These functions are also conventionally performed by +standard macro packages. +. +.para +The EO and OO requests allow the user to shift the entire output +horizontally on the page, without affecting any internal horizontal +position calculations, such as tab stops or indentation. +These requests are used +to set the width of the left margin. +. +.reqh +. +.req pl pom!V(11i) no "Set page length to V." +(Page Length) +The page length is set to the specified vertical distance. When it +is attempted to make the current vertical position greater than the +page length, a new page is automatically started. +Where possible, the PL request will also change the +actual physical page size. +.foot +To change the page length for the XGP device, the PL request must be given +before any text is output. The LPT and VARIAN devices do not support +variable page lengths. +.efoot +Thus, this request should not be used to define a bottom +margin. +The page length is initially 11 inches. +(See also the PL built-in number register.) +. +.req bp pom!N(old+1) yes "Begin page (number N)." +(Begin Page) +A new page is started. If an argument is given, it +specifies the number of the new page. +If no argument is given and no PN requests have been made during the +processing of the current page, the new page will be numbered one +greater than the current page. +. +.req pn pom!N no "Set number for next page to N." +(Page Number) +The next output page (when it occurs) will have the page number N, +unless this request is superseded by another PN request or the new page +is caused by a BP request that explicitly specifies a page number. +The first page is initally numbered page 1. +(See also the PAGE and NEXT_PAGE built-in number registers.) +. +.req eo pom!H(prev) no "Set even page offset to H." +(Even Offset) +The entire output image on even-numbered pages is moved right +the specified horizontal distance. +The initial even page offset is 1 inch, giving a 1 inch +left margin. +. +.req oo pom!H(prev) no "Set odd page offset to H." +(Odd Offset) +The entire output image on odd-numbered pages is moved right +the specified horizontal distance. +The initial odd page offset is 1 inch, giving a 1 inch +left margin. +. +.req ne V(1) yes "Need vertical space of height V." +(Need) +If the vertical distance D to the next trap position (or to the end +of the page) is less than the specified vertical distance, +then the current vertical position will be increased by +the distance D. This request is used when one wishes to +ensure that a new section, table, etc. does not begin +too close to the bottom of the page. +.rqsec "Text Filling and Adjusting" +.para +R operates in one of two filling modes, fill mode and nofill mode. +In fill mode, words are taken from as many input lines as needed +in order to fill out the current output line. In nofill mode, +the end of an input text line causes the current output line +to be output and a new output line to be started (this is called +a line-break). Line-breaks are also caused by blank input lines, +by input lines beginning with space, \xc(C), \xc(I), \xc(P), +or \xc(R), and by many built-in requests. +.para +Output lines may be adjusted by the enlargement of space!s +between words or the insertion of extra space before +the entire line. The various modes of adjustment are: +(L) left-adjustment, meaning that no extra space is inserted +and the right margin remains ragged, +(R) right-adjustment, meaning that extra space is inserted +at the beginning of the lines so that the right margin is +uniform but the left margin is ragged, +(B) both margins adjusted, meaning that space!s are enlarged +between words so that both the left and right +margins are uniform, and +(C) centered, meaning that extra space is inserted at the +beginning of the line so that the output text is centered on +the line. +Adjustment is specified separately for fill mode and for +nofill mode. +.para +B-mode adjustment is inhibited to the left of a \xc(I) or a \xc(P). +B-mode and C-mode adjustment are superceded by any adjustment +caused by a \xc(C) or a \xc(R). +. +.reqh +. +.req br "" yes "Cause line break." +(Break) +This request causes a line-break. +The output line being constructed is output and a new output line +started. If in fill mode and the adjustment mode is Normal, then the +output line is not adjusted. +. +.req bj "" yes "Cause line break, with justification." +(Break and Justify) +This request causes a line-break. +The output line being constructed is output and a new output +line started. Unlike BR, if in fill mode and the adjustment mode is +Normal, then the output line 2is* adjusted. +This request can 2not* be inhibited by using cquote. +. +.req fi C(unchanged) yes "Fill output lines; set adjust mode." +(Fill) +Fill mode is entered. Subsequent output lines will be filled. +If the argument C is given, the adjustment mode to be used +when in fill mode is set to C (the adjustment modes are listed +above); otherwise, the fill-mode adjustment mode is not +changed. Initially, R is in fill mode with adjustment mode B. +(See also the FILL and ADJUST built-in number registers.) +. +.req nf C(unchanged) yes "Do not fill output lines; set adjust mode." +(Nofill) +Nofill mode is entered. Subsequent output lines will not be +filled; each input line will cause exactly one output line. +If the argument C is given, the adjustment mode to be used +when in nofill mode is set to C (the adjustment modes are listed +above); otherwise, the nofill-mode adjustment mode is not +changed. The initial nofill-mode adjustment mode is L. +(See also the FILL and ADJUST built-in number registers.) +.rqsec "Line Spacing and Blank Lines" +.para +Line spacing determines the default vertical separation +between output lines. Line spacing is measured in terms of +the height of the principal font. A line spacing of 1 corresponds +to single spacing, 2 corresponds to double spacing, etc. +Non-integer line spacings (e.g. 1.5) are allowed, although the desired +results will not be obtained when the output device is LPT. +.para +The 1current vertical position* (VPOS) measures the distance +from the top of the page to the 1base line* of the next +text line to be output. +The 1last vertical position used* (LVPU) records the position of the +bottom of the last text line output. It is used to avoid overlap +between the bottom of one line and the top of the next. +This processing takes place even when output printing is turned +off. If the current vertical position is ever 2decreased*, then +LVPU is set to 0, so that only overlapping the top +of the page is checked. +.foot +The XGP device does not allow a text line to be output unless +it is below and does not overlap all lines already output on the +same page. Separate checking is used to prevent this occurrence. +If overlapping lines are produced for the LPT device, a separate +postprocessor must be used. +.efoot +Both VPOS and LVPU are accessible as built-in number registers. +. +.reqh +. +.req ls pom!R(prev) no "Set inter-line spacing to R" +(Line Spacing) +Line spacing is set to R. After a line is output, the +current vertical position will be increased by R times +the single-space height of the principal font. +The initial line spacing is single spacing (.LS 1). +(See also the LS built-in number register.) +. +.req sp V(1) yes "Space down distance V." +(Space) +The current vertical position is increased by V. +A blank input line is equivalent to a line containing a .SP 1 +request (e.g., it is inhibited in no-space mode, described +below). +. +.req vp V(0) yes "Set vertical position to V." +(Vertical Position) +The current vertical position is set to V (V may be +less than or greater than the current vertical postion). +(See also the VPOS and LVPU built-in number registers.) +. +.req ns C(S) no "Enter no-space mode." +(No Spacing) +No-space mode is set according to the mode C. +The possible modes are S and P. +If no-space mode is S, SP requests are inhibited. +If no-space mode is P, SP requests +are inhibited and BP requests that do not specify a +page number are inhibited. +If the no-space mode is P, then an NS request will not reduce it to S. +No-space mode is turned off when a line of +text is output. +No-space mode is initially off. +(See also the SPACING built-in number register.) +. +.req rs "" yes "Resume spacing." +(Resume Spacing) +No-space mode is turned off. +.rqsec "Line Length, Indenting, and Horizontal Positioning" +.para +Requests are provided to set the line length and to cause +indenting of both the left and right margins. The line +length includes any indenting but does not include the +page offsets. When in fill mode, no output line containing +more than one word will exceed the line length (including +indenting). Horizontal positioning may be performed using +the characters \xc(I) and \xc(P) and by the HS and +HP requests, +which allow arbitrary horizontal positioning. The tab +stops used by \xc(I) are adjustable. +.para +Changes made to the line length or the indentation take effect +at the next output line. They do not affect +a non-empty current partial line. +. +.reqh +. +.req ll pom!H(prev) no "Set line length to H." +(Line Length) +The line length is set to the specified horizontal distance. +This request is used to set the width of the right margin. +The initial line length is 6.5 inches, giving a right margin +of 1 inch for a page width of 8.5 inches and a page +offset of 1 inch. +(See also the LL built-in number register.) +. +.req in pom!H(prev) yes "Set indentation to H." +(Indent) +The left-margin indent is set to the specified horizontal +distance. Each output line is begun with blank space +of the specified width (in addition to any implied by the page +offset). The left-margin indent is initially 0. +(See also the INDENT built-in number register.) +. +.req ti pom!H(1) yes "Temporarily indent next output line by H." +(Temporary Indent) +The next output line (only) will be left-indented the specified +distance (pom relative to the current left-margin indent). +The normal left-margin indent is not changed. +. +.req ir pom!H(prev) yes "Set right-side indentation to H." +(Indent Right) +The right-margin indent is set to the specified horizontal distance. +The indentation is leftwards from the position specified by the +line length. In fill mode, the +right margin (position) is the line length minus the right-margin +indent. The right-margin indent is initially 0. +(See also the RINDENT built-in number register.) +. +.req ta "H H ..." no "Set tab stops." +(Tabs) +All existing tab stops are removed. Then, +tab stops are set at the specified horizontal positions. +Note that tab stops are at absolute horizontal positions, not +at column numbers; to keep tab stops at column numbers one must reset +the tab stops whenever the principal font changes. Note also that +the positions of tab stops on the output page are not affected +by changes in the indentation (set by the IN request). +The tab stops are initially set at column positions 8, 16, etc., +with respect to font 0. +. +.req hs H(0) no "Output horizontal space of width H." +(Horizontal Space) +Produce a non-justifiable space of the specified width. +The width 2may* be negative, but may not cause the +current horizontal position to become negative. +. +.req hp pom!H(0) no "Set horizontal position to H." +(Horizontal Position) +The current horizontal position is set to H. This new horizontal +position may be less than or greater than the old position. +(See also the HPOS built-in number register.) Warning: use of +the HP request or the HPOS built-in number register is generally +meaningless in the presence of filling or adjusting (other than +L-mode adjusting), since in these cases +the actual horizontal position of a word +on output is not known until the entire output line is determined. +It is recommended that the HS request be used wherever a +change in horizontal position is a intended to +be a relative change, rather than a change to a specific +absolute position. +. +.rqsec "Registers" +.para +It is possible to save both integer and string values in +registers and to insert said values into the input stream +using the characters \xc(N) and \xc(S) (q.v.). +. +.reqh +. +.req nr "M N(0)" no "Define number register M to be N." +(Number Register) +A number register is defined or redefined to have the +specified value. Its value may be inserted into the +input stream using the \xc(N) character. +Its value may also be referenced in expressions by +writing the number register name (unless the name +begins with a digit). +. +.req sr "M S(null)" no "Define string register M to be S." +(String Register) +A string register is defined or redefined to have the +specified value. Its value may be inserted into the +input stream using the \xc(S) character. +Note that because space!s and \xc(I)s separate +arguments, to begin the string argument with a space +or \xc(I) one must precede it with \xc(\). +. +.req nd "M N(0)" no "Set default value of number register M to be N." +(Number Default) +If the named number register is undefined, then its value is set +to the given value. Otherwise, there is no effect. +. +.req sd "M S(null)" no "Set default value of string register M to be S." +(String Default) +If the named string register is undefined, then its value is set +to the given value. Otherwise, there is no effect. +. +.req hx "M H..." no "Horizontal distance expression." +(Horizontal Expression) +The number register specified by M is defined +or redefined to have a value that is the sum of the +given horizontal distance specifications in mils. +. +.req vx "M V..." - V=0 no "Vertical distance expression." +(Vertical Expression) +The number register specified by M is defined +or redefined to have a value that is the sum of the +given vertical distance specifications in mils. +. +.req xn M no "Expunge number register M." +(Expunge Number Register) +The number register specified by M is made undefined. +This request may specify a built-in number register, in which +case the register ceases to be treated specially. +. +.req xs M no "Expunge string register M." +(Expunge String Register) +The string register specified by M is made undefined. +This request may specify a built-in string register, in which +case the register ceases to be treated specially. +. +.rqsec "String Operations" +. +.para +Requests are provided to operate upon the contents of string registers. +These requests take their string operands in string registers and +produce results in number registers or string registers. The arguments +to the requests are names of string registers and number registers, +plus integers. +. +.para +The first character in a string is numbered 1. Note that +string registers contain logical input characters, not just +ASCII characters. For example, a string can contain space!s, +which are not the same as ASCII SP characters. This distinction +affects primarily the collating sequence used by the comparison +operator. +. +.reqh +. +.req sb "result:M source:M index:N(1) length:N(infinity)" no "Compute substring." +(Substring) +Argument 2result* is the name of a string register in which to +store the result of this operation. Argument 2source* is the +name of the source string register. +The SB request computes the substring of the contents of the source +string register and puts it in the result string +register. The substring begins with the character specified +by 2index* and contains the number of characters specified by +2length*. There is no error if 2length* is longer than the +number of characters available. If 2length* is less than 1 or +2index* is out of range, then the result is the null string. +. +.req si "result:M pattern:M source:M skip:N(0)" no "Search for occurrence of string." +(String Index) +Argument 2result* is the name of a number register in which to store +the result of this operation. Argument 2pattern* is the name of +a string register supplying a pattern. Argument 2source* is the +name of a string register supplying the source string. +The SI request computes the index of an occurrence of the +contents of the pattern in the source. +The index is made the value of the result number register. +If 2skip* is not present or is not positive, then the index +of the first occurrence is computed. If 2skip* is positive, then +2skip* occurrences are first skipped. If there is no such +occurrence, then the value computed is 0. +. +.req sc "result:M sr1:M sr2:M" no "Compare strings." +(String Compare) +Argument 2result* is the name of the result number register. +Arguments 2sr1* and 2sr2* are the names of the string registers containing +the strings to be compared. +The SC request computes an integer value of -1, 0, or +1 by comparing the contents of the two strings. +The value is stored in the result number register. +The value is 0 if the two strings are equal, +-1 if the first is less than the second, 1 otherwise. +The comparison is lexicographic, but note that the characters +are logical input characters, not just ASCII text characters. +Control characters (such as space) are "greater than" all text +characters. +. +.req sl "result:M source:M" no "Compute the length of a string." +(String Length) +Argument 2result* is the name of the result number register. +Argument 2source* is the name of the string register containing the +source string. +The SL request computes the length of the source string +and stores it in the result number register. +The length is the number of logical +input characters in the string. Note that +nw(1000)\xc(\)\xc(\)\xc(\)\xc(A) is 2one* +logical input character, a "thrice-protected control-A". +. +. +.rqsec "Macros" +.para +A macro is a named set of lines that may be inserted into +the input stream by a request giving that name (normal macro +invocation), by a control character sequence giving that name +(inline macro invocation), or by an attempt to increase the +current vertical position past a specific point (trap invocation, q.v.). +A macro named "foo" may be invoked by a request giving +"foo" as the request name. Arguments to the macro may +be given on the request line; these arguments may be referenced +by the macro body using the \xc(A) character (q.v.). +The arguments on a request line are separated by space!s and \xc(I)s. +An argument that includes space!s or \xc(I)s may be enclosed +in quotation marks ("); alternatively the space!s or \xc(I)s can be +protected by the \xc(\) character. Within a quoted argument, +one can write "" to mean ". +Examples of macro definitions are presented in Section sec_example. +.para +The invocation of a macro causes the current input to be suspended +(its current state is saved on a stack) and input to be taken from +the body of the macro (established by DE and/or AM requests). +When the end of the macro body is reached, the input stream is +reset to what it was when the macro invocation occurred, and processing +continues. If a macro is invoked when in fill mode, some input text may +have been read and collected, but not yet output because not enough +had been collected to fill an output line. This partially-collected +line will be output in that form if the macro invocation causes a +line-break in that environment (see Section sec_rq.req_env below). +Macro invocation 2per se* does not cause a line-break; however, the +body of the macro may cause a line-break if it contains a request +or text line that causes a line-break. +.para +A macro may be invoked using either \xc(.) or cquote. The macro +definition 2may* distinquish between these two cases (using +the \xc(A)dot notation). Otherwise, there is no difference between +using \xc(.) and cquote to invoke a macro. In particular, using +cquote does 2not* automatically prevent a macro from +causing a line-break. +.para +Macros may be invoked in text lines using the \xc(X) character +(q.v.). Examples of inline macro invocation are presented in +Section sec_example. +.para +The input file is implicity followed by an invocation of a macro +named 2exit_macro*. This macro is intended to be used by +macro packages for performing "clean-up" operations. It may be +defined in the normal manner; there is no error if it is not defined. +. +.reqh +. +.req de "macro:M terminator:M" no "Define or redefine macro." +(Define) +The DE request defines or redefines the macro with name 2macro*. +2Terminator* is an optional name which is used to terminate the macro +body; the default value for 2terminator* is EM. +The contents of the macro begins with the next input line. +It is terminated by a request line whose request name is +the terminator 2terminator*. +After the macro body is read, the terminating request +line is executed normally (the terminating line does not become part +of the macro definition). +The macro +text is processed for the recognition of R control characters; +unprotected \xc(A), \xc(K), \xc(N), and \xc(S) characters are interpreted (see Section +sec_cclist). +Requests in the macro text are not +processed. No output is produced by the definition of a macro. +A macro definition may contain other macro definitions. +If interior macro definitions use the same terminator as the enclosing +macro definition, then those interior terminator lines must +be preceded by \xc(\) so that they do not inadvertently +terminate the enclosing macro definition. +. +.req rm M no "Remove definition of macro M." +(Remove Macro) +The specified macro name becomes undefined; an invocation of +said macro will produce an error message. +. +.req am "macro:M terminator:M" no "Append to macro definition." +(Append to Macro) +This request is equivalent to the DE request, except that the following +text is 2appended* to the body of the specified macro. If there +is no macro M (or M is a request), then the AM request +request is exactly equivalent to the DE request. +. +.req eq "new:M old:M" no "Make request NEW equivalent to request OLD." +(Equate) +The name given as 2new* is defined to have the current +definition of 2old* (either a built-in request, a macro +definition, or undefined). The meaning of 2new* will not +be affected by subsequent redefinitions of 2old*, except +by the AM request. The EQ request can be used to define +synonyms for requests or macros, or to "save" the definition +of a built-in request so that the initial request name can be +redefined without losing the built-in request definition. +.examples +Suppose that for debugging purposes, one wanted to print +a message each time the DE request is used. The following +code achieves that purpose: +.table + .eq old_de de ^K "save" original definition + .de de ^K make new definition + .tm Defining macro \^A0 ^K type the message + .old_de \^A0 \^A1 now use the original definition + .em +.end_table +The original definition of DE is first given an additional +name, OLD_DE. We do this because we need to use the original +definition of DE within the definition of the new DE. +The new DE (a macro) first +types out a message, then invokes the orignal DE (now +called OLD_DE). +. +.req em "" no "Terminate a macro body." +(End Macro) +This request is used by default to terminate macro definitions. +When invoked, it has no effect. +. +.rqsec "Environments" +.para +Text processing is performed in one of a number of environments. +Each environment contains the following parameters: +.table 3 +.ta .5i 2.56i 4.82i + principal font fill mode indenting + current font adjust modes tab stops + font stack vertical offset underscoring + line spacing +.end_table +.rtabs +In addition, the environment contains the partially-filled +output line being constructed. All other information is +global, that is, exists in common for all environments. +.para +Each environment has a name. Initially, there is one +environment, called "text." Other environments may +be defined by the user. +Macros that are to be invoked by traps should +in general perform their processing in an environment +other than "text" since when a trap is invoked, the +then current environment often contains a partially-collected +output line that should not be printed at that time. +. +.reqh +. +.req ev M(prev) no "Select environment M as current environment." +(Environment) +The current environment becomes that specified by the given name. If no +such environment exists, a new one is created. All environments are +initialized identically as specified in the descriptions of the related +requests. The initial environment is named "text". +If no argument is specified and the previous environment has been +expunged, then the current environment is unchanged. +This request is used to switch among multiple environments. +(See also the ENV built-in string register.) +. +.req es M no "Save current environment in environment M." +(Environment Save) +The current environment is copied into the named environment (including +the partial line). +A new environment is created if no such environment exists. +The current environment is not changed. +This request is generally used to initialize the parameters of +a new, often temporary environment to the values +from some other environment. +. +.req xe M(current) no "Expunge environment M." +(Expunge Environment) +This request deletes the named environment. If the specified environment +is the current environment, or no argument is given, then the current +environment is marked as "to be deleted". The environment will be +deleted the next time that a 2different* environment is selected +as the current environment. This request is provided to allow the +storage associated with temporary environments to be reclaimed. +. +.rqsec "Blocks, Conditionals, Iteration, and Local Variables" +R provides four forms of control structures: BEGIN blocks, +IF statements, WHILE +statements, and FOR statements. Each consists of a request (either +BE, IF, WH, or FR) followed by a body of input lines called the +statement body; a statement body consists of the lines following the +BE, IF, WH, or FR request, terminated by the next matching EN request. +BE, IF, WHILE, and FOR statements must be properly nested. +IF, WHILE, and FOR statements must be completely +enclosed in a macro definition or an input file; WHILE and FOR +statements may occur only in macro definitions. The BK (break) +request may be used to break out of (terminate) the innermost WHILE +or FOR statement; the BK request must appear in the same macro +definition as the corresponding WHILE or FOR statement. +.para +An IF statement may be broken into a number of separate 2cases* +using the EF request. Associated with each case is a conditional +expression; the conditional expression is written +as an argument to the IF or EF request +that heads the case. (If no argument is present, the default is +1.) When an IF statement is executed, the conditional expressions +are evaluated in turn until one evaluates to non-zero. The +corresponding case is then executed, and the remainder of the IF +statement is skipped. An EF request with an argument thus performs +as ELSE-IF; an EF request without an argument performs as ELSE. +Only one EN request is needed to terminate an IF statement, +regardless of the number of cases. +.para +Within BE, IF, WHILE, or FOR statements, one may define local +variables using the NV, SV, HV, and VV requests. These requests are +like NR, SR, HX, and VX, except that they first save the old value +of the register (if any) on a stack; old values are restored +when the end of the innermost enclosing statement body is +reached, in reverse order of variable definition. (If there +was no value, then the register is made undefined again.) +The NV, SV, HV and VV requests are like declarations with initial values; +subsequent assignments to variables should be made using the +NR, SR, HX, and VX requests. +. +.para +Note that embedded macro definiitons are not +recognized when searching for a matching +EN request. In general, one should +avoid using macro definitions within statements. +. +.reqh +. +.req be M no "Begin statement block named M." +(Begin) +This request marks the beginning of a BEGIN block. The name +(which is required) is used to name the block in case it +is not properly terminated. All statements define new scopes +for variables; begin blocks do nothing else. Begin blocks are +the only statements that do not have to be properly contained +in files or macro definitions. +. +.req if N(1) no "Conditionally execute statement body." +(If) +If the argument is 0, input is ignored until the next matching EF or +EN request is encountered; \xc(A), \xc(S), and \xc(N) characters in the skipped +input are not interpreted. +Otherwise, the statement body up to any +matching EF request is executed. An IF statement can be used +in place of a BEGIN block where the block is entirely nested in +a macro definition. This usage is advantageous in that an error +message will be produced if the IF statement is not terminated +at the end of the macro definition. +. +.req ef N(1) no "Begin an alternative case." +(Else-If) +This request may appear only directly within an IF statement. +If this request is encountered as the result of a successful IF +or EF test, then it causes the remainder of the IF statement to +be skipped. If it is encountered as the result of an unsuccessful +IF or EF request, then the argument is evaluated and used to +control input execution as for the IF request. +. +.req wh N(1) no "Iterate statement body." +(While) +The argument is evaluated. If the argument is 0, input is ignored +until the next matching EN request is encountered; \xc(A), \xc(S), and +\xc(N) characters in the skipped input are not interpreted. +Otherwise, +the statement body is executed; when the corresponding EN +request is reached, the process iterates with the evaluation +of the argument to the WH request. +. +.req fr "var:M init:N(1) limit:N(infinity) step:N(1) test:N(1)" no "Iterate statement body." +(For) +This request defines the iteration number variable 2var* +and initializes it to the initial value 2init*; +the 2limit* and 2step* values are evaluated and saved. Then the +iteration begins: the value of the iteration variable is compared +to the limit value; if the step is positive and the iteration variable +is greater than the limit value or if the step is negative and the +iteration variable is less than the limit value, then the FOR +statement terminates. The conditional test 2test* is evaluated; if 0, the +FOR statement terminates. The body of the FOR statement is executed. +The value of the iteration variable is incremented by the step value. +The iteration then repeats. When the execution of the FOR +statement is completed, the old value of the iteration variable +is restored. +. +.req en "" no "Terminate statement body." +(End) +The body of the innermost BEGIN, IF, WHILE, or FOR statement is +terminated. +. +.req bk "" no "Break out of WHILE or FOR statement." +(Break) +Execution of the innermost WHILE or FOR statement is abandoned. +Input is taken from the point following the corresponding EN +request. +. +.req nv "M N(0)" no "Define number variable M, initialize to N." +(Number Variable) +The old value of the named number register (if any) is saved (after +the second argument is evaluated), +and the value of the number register is set to the given value. +The old value of the number register will be restored when the +end of the innermost enclosing statement body is reached. +. +.req sv "M S(null)" no "Define string variable M, initialize to S." +(String Variable) +The old value of the named string register (if any) is saved (after +the second argument is evaluated), +and the value of the string register is set to the given value. +The old value of the string register will be restored when the +end of the innermost enclosing statement body is reached. +. +.req hv "M H..." no "Define variable; initialize to sum of H..." +(Horizontal Variable) +The old value of the named number register (if any) is saved (after +the remaining arguments are evaluated), +and the value of the number register is set to the sum +of the given horizontal distance specifications in mils. +The old value of the number register will be restored when the +end of the innermost enclosing statement body is reached. +. +.req vv "M V..." no "Define variable; initialize to sum of V..." +(Vertical Variable) +The old value of the named number register (if any) is saved (after +the remaining arguments are evaluated), +and the value of the number register is set to the sum +of the given vertical distance specifications in mils. +The old value of the number register will be restored when the +end of the innermost enclosing statement body is reached. +. +.rqsec "Traps" +.para +A trap causes the dynamic invocation of a macro when a particular +vertical position is reached. A trap is set by the ST request, +which specifies a macro name and a vertical position. +If any attempt is made to increase the current vertical position +past the specified position V, the current vertical position is set +to V and the specified macro is invoked at that point. +More than one trap may be set at a given vertical position, +in which case the macros are invoked in the order in which +the traps were set. +A macro is guaranteed only to be able +to output one line (without explicitly changing the current +vertical position) before it is itself subject to being "interrupted" +by another trap macro. +.para +Traps may be inhibited by setting the built-in number register +ENABLED to zero. When traps are inhibited, no trap macros will +be dynamically invoked, regardless of the vertical position. +Traps may be enabled by setting the built-in number register +ENABLED to one. When traps are turned on, +trap macros will be invoked as described above. +If there are traps set at vertical +positions less than or equal to the current vertical position +at the time traps are turned on and these traps had +not yet been invoked on the current page, then they will +become eligible for invocation after the next attempt +to increase the current vertical position. +.para +A trap set at vertical position 0 is invoked at the beginning +of a page. However, invocation of such header macros is not +done as soon as a new page is begun. Instead, it is delayed +until the first text line (perhaps already in progress) or +break-causing request (other than BJ) is seen. The trap macro is invoked +before the text or break-causing request is actually processed. +Even if a break is not caused, a request that changes the +current vertical position will also invoke header macros, +as normal. When traps are inhibited, text lines and break-causing +requests do not enable header macros, nor do they disable +later invocation of header macros by text lines or break-causing +requests after traps have been re-enabled. (See the +PAGE_EMPTY built-in number register.) +. +.para +When all input is exhausted, R (in effect) repeatedly does BPs until +the current page is empty and there is no more input, +in order to flush out all traps pending on the last page. +It is thus incorrect to have a footer trap macro that also puts out the +header on the next page, as an infinitely-long document would result. +. +.para +The built-in number register VTRAP contains the vertical distance +in mils to the next trap position. When a trap is invoked by an +increase to the vertical position, the vertical position is set +to the trap position, which may be less than the vertical position +that would have been reached had there been no trap invocation. +The built-in number register VPLOST is set to the amount of vertical +distance thus lost. +. +.reqh +. +.req st "M V" no "Set trap to macro M at vertical position V." +(Set Trap) +A trap to the specified macro is set at the specified vertical +position. +. +.req rt "M V" no "Remove trap to macro M (at position V)." +(Remove Trap) +The specified trap is removed. If no vertical position is +specified, the trap to the named macro at the smallest vertical +position will be removed. +. +.req ct "M pom!V" no "Change position of trap to V." +(Change Trap) +The position of the first trap to the specified macro is +changed to the specified position (pom relative to the +old position). +.rqsec "Stream Switching" +.para +The input to R is normally taken from the file specified +in the command line. This input may be switched temporarily +(pushed and popped) to other sources. +. +.reqh +. +.req so T no "Insert from file T." +(Source File) +Input is temporarily taken from the specified file. +If the file is not found in the specified (or default) +directory, the standard R directory is also searched. +(See also the CFILENAME built-in string register.) +. +.req nx T no "Begin reading from next file, T." +(Next File) +The current (most recent) input file is terminated. If an argument +is present, the specified file is opened and used for input. +If the file is not found in the specified (or default) +directory, the standard R directory is also searched. +(See also the CFILENAME built-in string register.) +. +.req rd T(bell) no "Read from standard input; prompt with T." +(Read) +The string T is printed on the standard output and input is +read from the standard input (normal input mapping occurs). +Input from the standard input is terminated by an empty line, at +which point normal input is resumed. (See also the INTERACTIVE +built-in number register.) +. +.req ex "" no "Exit." +(Exit) +Text processing is terminated as if all current input sources +ended at that point. +.rqsec "Text File Output" +.para +Requests are provided to write text to additional output files +for subsequent processing by other programs. Only one output file +may be open at one time. Before text may be output, a file must +be opened by a WF or WA request. Output is performed by the WS, +WL, and WM requests. The output file is closed by the WE request. +.para +When logical input characters are output, the inverse of the default +mapping is used to translate them to sequences of physical input +characters. Thus, for example, text characters that normally +map to a control character are preceded by ^Q when output. +. +.reqh +. +.req wf T no "Begin writing new file T." +(Write File) +A new file with name T is opened for output. +If T consists of a single name, then T is used as a suffix +on the output file name. +. +.req wa T no "Append output to file T." +(Write Append) +The file name T is interpreted as specified for the WF +request. +If the named file exists, then it is opened +for output, with output being appended onto the current contents +of the file. Otherwise, a new file is created, as for WF. +. +.req ws S no "Write string S to file." +(Write String) +The given string is written (without a trailing newline) onto +the currently-open output file. +. +.req wl S no "Write line S to file." +(Write Line) +The given string is written with a trailing newline onto the +currently-open output file. +. +.req wm M no "Write body of macro M to file." +(Write Macro) +The body of the named macro is written onto the currently-open +output file. +. +.req we "" no "Close output file." +(Write End) +The currently-open output file, if any, is closed. +.rqsec "Control Characters" +.para +The mapping of physical input characters to either the +corresponding ASCII text characters or to R control +characters may be modified using the CC and NC requests. +In addition, the meaning of the escape characters +may be modified using the EC request. +. +.reqh +. +.req cc "C C2" no "Interpret C2 as \xc(C)." +(Control Character) +The physical input character (call it P2) corresponding to +text character C2 is hereafter interpreted to be the R +control character \xc(C) designated by the text +character C. (See Section sec_cclist for a listing of +the R control characters and their designations.) +This interpretation holds only when reading +is performed in a mode in which the character \xc(C) +is recognized; otherwise, the input character P2 is mapped +to the corresponding text character, C2. When reading +is performed in a mode in which \xc(C) is recognized, P2 can be +forced to be interpreted as the corresponding text character C2 +by immediately preceding it by the \xc(Q) character (q.v.). + +This request should 2not* be used to redefine the \xc(J) (newline) +character. It is also recommended that letters not be used +to represent control characters, so as to avoid conflict +with the representation for escape characters. +. +.req nc C no "Make character C normal." +(Normal Character) +The physical input character corresponding to the text +character C is hereafter interpreted as that text character. +. +.examples +The following sequence gives examples of the use of the CC and NC requests: +.table + .cc . $ ^K make $ be \xc(.) + .nc . ^K . now does nothing special + .foobar ^K this is a text line + $cc . . ^K restore original definition of . + .nc $ ^K restore orignal definition of $ +.end_table +. +. +.req ec "C L" no "Define escape character 1esc-*C to be L." +(Escape Character) +The escape character 1esc-*C (C is a text character) +is hereafter interpreted as the logical input +character L. +One level of protection is removed from the character L +when it is read, thus allowing the interpretation of a +\xc(), \xc(I), \xc(A), \xc(K), \xc(N), +\xc(Q), or \xc(S) to be inhibited by preceding it +by a \xc(\). +. +.examples +The following are examples of the use of the EC request: +.table + .ec a \^A ^K define \a to be \xc(A) + .ec c ^C ^K define \c to be \xc(C) + .ec k \^K ^K define \k to be \xc(K) + .ec q \^Q \k define \q to be \xc(Q) + .ec z \q^K ^K define \z to be 2text* ^K +.end_table +. +.rqsec "Output Processing" +.para +Requests are provided to cause character translation in text +and to change the thickness and the relative position of underscoring +caused by \xc(B) and \xc(E). +.para +Output printing may be turned off by setting the built-in +number register PRINTING to zero. When output printing is +turned off, calculation of horizontal +and vertical position and page numbers continues as usual. +Printing is resumed when the number register PRINTING is set +to one. This facility can be used to perform two-pass processing. +Caveat utilor. +. +.reqh +. +.req tr "C1 C2(SP)" no "Translate C1 to C2 in text." +(Translate) +This request causes occurrences of the text character C1 to +be replaced by the text character C2, 2when C1 appears +in text words*. Translation can 2not* be inhibited by \xc(Q). +. +.examples +The TR request is commonly used to define a convenient representation for +the ASCII space character, as follows: +.tr @@ +.table + .tr @ +.end_table +Because only one character is given, it is (by default) translated +to ASCII space, a character that normally must be quoted with +\xc(Q). Hereafter, @ will act like a "dummy" space character, +that is, a character that prints like a space but is not interpreted as +a \xc() and may not therefore be widened during justification +or cause an end-of-line. +.foot +This example assumes that the SP character prints as blank space. +R does not in general make this assumption. +.efoot +The translation can be undone by +.table + .tr @ @ +.end_table +which causes @ to be translated to itself. +.tr @ +. +.req uo V no "Set underscoring offset to V." +(Underscore Offset) +This request sets the offset of underscoring (controlled by +\xc(B) and \xc(E)) relative to the base line (negative offset is below +the base line). The offset specifies the position of the top +of the underscoring. +The initial value of the underscore offset is +device-dependent. If no argument is given, UO restores the +initial offset. +This request has effect when a line is output; +it may not be used to vary the underscoring within one output line. +. +.req ut V no "Set underscoring thickness to V." +(Underscore Thickness) +This request sets the thickness of underscoring (controlled +by \xc(B) and \xc(E)). The default thickness is device-dependent. +If no argument is given, UT restores the initial thickness. +This request has effect when a line is output; +it may not be used to vary the underscoring within one output line. +. +.rqsec "Miscellaneous" +.reqh +. +.req tm T no "Type message T." +(Type Message) +The specified string is printed on the standard output unit, +followed by a newline. +(See also the INTERACTIVE built-in number register.) +. +.req rl "M T" no "Read line from standard input into string register M." +(Read Line) +The string specified by T is printed on the standard output +unit, without a trailing newline. Then, a line of text is +read from the standard input unit and assigned to be the +value of the named string register. +(See also the INTERACTIVE built-in number register.) +. +.req xc "M args" no "Execute request M." +(Execute Request) +The request M is executed with the given arguments. +The arguments are read in mode 2; thus, the \xc(A), \xc(S), and \xc(N) +characters can be used to compute arguments that are normally +quoted. +.am table_of_contents +.br +.fs +.ir -300m +.ne 5i +.em +. +.sec "Control Characters" +.para +There are two stages in the processing of R control characters. The +first stage is 1recognition*, where a sequence of one or more physical +input characters is transformed into the R control character that it +represents. +The second stage is 1interpretation*, where an already-recognized +R control character causes some action to occur. +This section defines the interpretation of the R control characters. +Those R control characters not defined here have no interpretation, +but are reserved for future use. +.para +There are four classes of control characters, distinguished by +where they are interpreted and their relation to text words. +The four classes are: +.ilist 400m +1text* - These control characters are interpreted only when +processing text, and are considered to be components of text words. +The text control characters are \xc(B), \xc(D), \xc(E), \xc(F), \xc(H), +\xc(U), \xc(V), and \xc(Z). +.next +1text separator* - These control characters are interpreted only +when processing text, but serve to separate text words. The text +separator control characters are \xc(C), \xc(G), \xc(P), \xc(R), \xc(T), +\xc(W), and \xc(X). +.next +1universal separator* - These control characters are interpreted +everywhere, and also serve to separate text words. The universal +separator control characters are space, \xc(I), \xc(J) (newline), +\xc(.), and cquote. +.next +1input* - The input control characters are interpreted everywhere, +at the level of input scanning. The input control characters are +\xc(A), \xc(K), \xc(N), \xc(Q), \xc(S), and \xc(\). +.end_list +There is no need to delay the interpretation of text or text +separator control characters in macro definitions. +.sp +.ne 10l +The following table lists the R control characters and describes +their interpretation: +.sp +.cc_header +.cc_des A \xc(A)2n* "Insert Macro Argument 2n*" +The 2nth* (2n* a decimal digit, arguments counted from 0) +argument of the current macro invocation is +inserted into the input stream, replacing the control character +sequence. If no 2nth* argument was given in the current +macro invocation, then the null string is inserted. +An error message is printed if \xc(A) is used when there +are no active macro invocations. +. +.cc_des A \xc(A)dot "Test for invocation by \xc(.)" +This control character sequence is replaced by 1 if the current +macro was invoked using \xc(.) and returns 0 if the macro was invoked +by cquote, by \xc(X), or as a trap macro. This control character +sequence can be used to contruct macros that simulate those +built-in requests that normally cause line-breaks. +An error message is printed if lkeep(\xc(A)dot) is used when there +are no active macro invocations. +. +.cc_des B \xc(B) "Begin Underscore" +The following text, terminated by a \xc(E) character, +is underscored in the output. Only text is underscored, not +spaces. +. +.cc_des C \xc(C) "Center Following Text" +The text following the \xc(C) and terminated by the next +\xc(R), \xc(P), \xc(I), or line-break is centered within the +horizontal positions defined by the preceding \xc(P), \xc(I), +or the left margin and the next \xc(P), \xc(I), +or the right margin. +A \xc(C) at the beginning of an input line causes a line-break. +. +.cc_des D \xc(D) "Move Down (Subscript)" +The vertical offset is decreased by a device-dependent +distance (LPT: one line height, VARIAN and XGP: one-half the +height of the principal font above the baseline). +An error message is produced if subscripts extend +over more than one input line (see \xc(G)). (See also the VOFF +built-in number register.) +. +.cc_des E \xc(E) "End Underscore" +Terminates underscoring. +. +.cc_des F \xc(F)2f* "Font Select" +The font designated by 2f* becomes the current font. +The old current font is pushed on the font stack +(see the FS request). +lkeep(\xc(F)*) pops a font from the font stack +and makes it the current font. +. +.cc_des G \xc(G) "Glue Together Adjacent Words" +The immediately preceding and following words are glued together +into one. More precisely, if the current output line ends with +a space that was produced by a \xc(J) (newline) in fill mode, +then that space is removed. +The last text word in the line is marked as incomplete. +The immediately following word (in the same environment) will be +concatenated to the incomplete word, unless there is an +intervening break. A single +immediately following \xc(J) (newline) +will not cause a break (in nofill mode), will not +be changed to +space!s, and will not cause error messages for unterminated +superscripts or subscripts. +A leading space, \xc(C), \xc(I), \xc(P), or \xc(R) +following the \xc(J) also will +not cause a break. (See \xc(W).) +. +.cc_des H \xc(H) Backspace +(Backspace) The "character position" within the text word being +built is decreased by 1. This control character is used to overprint +multiple text characters in the same position within one text word. +Overprinted characters are centered within a space whose width +is sufficient to contain each of the characters. +. +.cc_des I \xc(I) Tab +(Tab) In text, this character causes the current horizontal position +to be increased by the nominal +character width of the principal font and then to the +next tab stop (if any). +A \xc(I) at the beginning of an input line causes a line-break. +In request lines, this character is used to separate request and macro +arguments. +. +.cc_des J \xc(J) Newline +(Newline) The newline character separates input lines. In nofill +mode, it causes a line-break. In fill mode, if it immediately +follows a text word ending with a period, then it is +equivalent to a double-width space character. Otherwise, it +is equivalent to a normal-width space character. +(See \xc(G).) +. +.cc_des K \xc(K) "Begin Comment" +This control character causes all following input, +up to the next newline, to be ignored. If the \xc(K) appears as the +first character on a line, then the entire line (including the +terminating newline) is ignored. This character is interpreted only +for file input. +. +.cc_des N \xc(N){pom}{2m*}M "Insert Number Register" +Here the "{pom}" indicates an optional quote+quote or +quote-quote character, +{2m*} stands for an optional printing mode (listed below), +and M is the name of a number register. +The result of this control sequence is that the control +sequence is replaced by the value of the named number +register. If the quote+quote is present, the number register +is first incremented. If the quote-quote is present, the number +register is first decremented. If a mode is present, the number +is printed as follows: +.br +.lbegin +.sv list_right_margin 0 +.ne 7 +.ilist 6 0 +1mode format* +.sp +.next +. lower-case Roman numerals +.next +: upper-case Roman numerals +.next +, lower-case alphabetic (a,b, ... z,aa,ab, ... ) +.next +; upper-case alphabetic (A,B, ... Z,AA,AB, ... ) +.end_list +.end +Otherwise, the value is printed in the usual decimal +notation. The control sequence may be followed by quote!!quote +in order to terminate the number register name; this is +necessary only if the control sequence is followed by +a letter, digit, \xc(A), \xc(N), \xc(S), or quote!!quote. +. +.cc_des N \xc(N)?M "Test Number Register Definedness" +This control sequence is replaced by "1" if the named +number register is defined, "0" otherwise. +. +.cc_des P \xc(P)(2h*) "Tab to Specified Position" +This control sequence causes the current horizontal position to be +increased to the horizontal position specified by 2h*. +The horizontal position is always increased by at least the nominal +character width of the principal font. In this regard, +\xc(P) is similar to \xc(I). +A \xc(P) at the beginning of an input line causes a line-break. +. +.cc_des Q \xc(Q)2c* "Quote Input Character" +The physical input character 2c* is quoted; that +is, the control sequence is replaced by the ASCII +text character corresponding to 2c*. For example, +the sequence \xc(Q)^Q (written ^Q^Q in the input file) +represents the ASCII control-Q text character. +. +.cc_des R \xc(R) "Right Flush Following Text" +The text following the \xc(R), terminated by the next \xc(P), \xc(I), or +the end of the output line is justified rightmost +against the horizontal position defined by the next \xc(P), +\xc(I), or the right margin. +A \xc(R) at the beginning of an input line causes a line-break. +. +.cc_des S \xc(S)M "Insert String Register" +The value of the string register designated by M +is inserted in place of the control sequence. +The string register name is read as for \xc(N). +. +.cc_des S \xc(S)?M "Test String Register Definedness" +This control sequence is replaced by "1" if the named +string register is defined, "0" otherwise. +. +.cc_des T \xc(T)2s* "Define Tab Replacement Text" +The text word 2s* becomes the text used to fill out the space +generated by the next \xc(I), \xc(P), \xc(C), or \xc(R) +in the same environment. +. +. +.cc_des U \xc(U) "Move Up (Superscript)" +The vertical offset is increased by a device-dependent +distance (same as for \xc(D)). +An error message is produced if superscripts extend +over more than one input line (see \xc(G)). (See also the VOFF +built-in number register.) +. +.cc_des V \xc(V)(pom2v*) "Change Vertical Offset" +The vertical offset is set to 2v* (a leading pom causes 2v* +to be interpreted pom relative to the +previous vertical offset). An error message is produced if the +vertical offset is not zero at the end of an input line (see \xc(G)). +(See also the VOFF built-in number register.) +. +.cc_des W \xc(W) "Word-break" +This control character separates text words without resulting +in any output space. For example, it can be used to allow +a word to be broken after an explicit hyphen, as in the +word "built-^Win". It can also be used to protect a preceding +space or a following newline from being eaten by a \xc(G). +. +.cc_des X \xc(X)M(2args*) "Inline Macro Invocation" +This control character, 2when occurring in a text line*, causes the +inline invocation of the named macro. If arguments are to be +given, the argument list must immediately follow the macro name and be enclosed +in parentheses. Multiple arguments are +separated by space!s and \xc(I)s. Parentheses in unquoted arguments +must be balanced. Arguments may be enclosed in quotation marks, +in which case they may contain space!s, \xc(I)s, and unbalanced parentheses. +Nested inline macro invocations are passed unexpanded +to the macro definition. If no arguments are to be given, then +the parentheses should be omitted, and the macro name may be followed +by quote!!quote as for \xc(N). Text that is output by the macro invocation will +be concatenated to an immediately preceding word and to an immediately +following word. \xc(X) is 2not* interpreted in request lines. +. +.cc_des Z \xc(Z) "Set Vertical Offset to Zero" +The vertical offset (used for superscripting and subscripting) +is set to zero (normal). (See also the VOFF built-in number register.) +. +.cc_des . \xc(.)2request* "Normal Request" +This control character is recognized only as the first character of +an input line, in which case the line is considered to be an R request. +. +.cc_des quote cquote2request* "No-break Request" +This control character is recognized only as the first character of +an input line. Its effect is the same as the \xc(.) character, except +that a built-in request (other than the BJ request) is inhibited from +causing a line-break. +(In addition, a macro 2may* distinguish between invocations using +cquote and those using \xc(.)) +. +.cc_des \ \xc(\) "Delay Control Character Interpretation" +This control character is used +to delay the interpretation of other +control characters (see the next section for a more complete +description). It is also used in file input to write +escape characters. +. +.cc_des SP \xc() "Space" +This control character separates words and causes a blank +space on output (except when it occurs at the end of an output +line in fill mode, in which case it causes no output). +Multiple \xc()s are not compacted. +A \xc() at the beginning of an input line causes a line-break. +In request lines, this character is used to separate request and macro +arguments. +.in 0 +.sec "Delayed Interpretation of Control Characters" +.para +The interpretation of a control character, primarily \xc(A), \xc(N), or \xc(S), +may be delayed for one or more "readings" by preceding it by +one or more \xc(\) characters. A "reading" is a reading of the character +from an input file, a macro body, or a macro argument. +A sequence of 2n* \xc(\) characters delays the interpretation of an +immediately following control character for 2n* +readings. +For example, the character \xc(A) is interpreted directly and is replaced +by a macro argument. The sequence \xc(\)\xc(A) is not interpreted, but +if stored in a string register, macro body, or macro argument, +it will be stored as \xc(A), so as to be interpreted when the string +register, macro body, or macro argument is later read. Each storing +into a string register, macro body, or macro argument removes one \xc(\). +One \xc(\) is also removed from the second argument of the EC +request. +.para +The \xc(\) character is most useful in the bodies of macro definitions. +If one writes \xlkeep(\xc(A)0) in a macro definition, then the control sequence is +interpreted at macro definition time and thus will attempt to insert +the 02th* argument of a current macro expansion, which will be +meaningful only if the macro definition had been written inside the body +of another macro definition. Most often, one really +wants to write \xlkeep(\xc(\)\xc(A)0) in the macro definition. The \xc(\) protects +the \xc(A) from being interpreted when the macro definition is first read. +When the macro is later invoked, the macro body is read again, +and the \xc(A) is interpreted, as desired. +(Recall that \xc(\) is written as \ in the physical input alphabet.) +.nr nrtable current_table +.nr srtable current_table+1 +.sec "Built-In Registers" +.para +There are a number of built-in number and string registers +that allow the R user access to various R parameters. +Built-in registers are referenced normally, using the +names listed below. Some built-in registers may not be +redefined; these are indicated in the tables by asterisks. +Built-in registers whose values are dependent on the current +environment are indicated by an E. +The built-in number registers are listed in Table :nrtable; +the built-in string registers are listed in Table :srtable. +. +. +.begin_table "Built-in Number Registers" +. +. +.ta 5 25 +.sp + 1name value* +.sp + adjust (E) the current adjust mode (0=left,1=right,2=center,3=both) + day (*) the current day of the month (1-31) + debug (*) debugging flag (set by -d option) + enabled 1 <==> traps are enabled + end_of_sentence (E) 1 <==> last word ended a sentence + even (*) 1 <==> the current page is even + fheight (E*) the height in mils of the principal font + fill (E) fill mode (1=fill, 0=nofill) + font (E) the current font (0-15) + fwidth (E*) the character width in mils of the principal font + habove (E*) the height above the baseline of the current output line + hbelow (E*) the heignt below the baseline of the current output line + hpos (E) the current horizontal position in mils + indent (E) the current indentation in mils + interactive (*) 1 <==> the standard output unit is a terminal + ll the line length in mils + lpt (*) 1 <==> the output device is LPT + ls (E) current line spacing * 100 + lvpu the last vertical position used, in mils + month (*) the current month (1-12) + nargs (*) the number of arguments to the innermost macro invocation (0-10) + next_page the next page number + page the current page number + page_empty 1 <==> a text line or line break will invoke a header trap + pfont (E) the principal font (0-15) + pl the page length in mils + printing 1 <==> printing is enabled + rindent (E) the current right-margin indentation in mils + spacing spacing mode (0=normal, 1=S, 2=P) + stats 1 <==> print extra statistics when done (set by -s option) + trace tracing flag (set by -t option) + varian (*) 1 <==> the output device is VARIAN + version (*) R version number (0 => experimental) + voff (E) the vertical offset in mils + vplost (*) the vertical distance lost due to most recent trap + vpos the current vertical position in mils + vtrap (*) the vertical distance to the next trap in mils + xgp (*) 1 <==> the output device is XGP + year (*) the current year (1900-?) +.em +. +.finish_table +. +. +. +. +.begin_table "Built-in String Registers" +. +. +.ta 5 25 +.sp + 1name value* +.sp + cfilename (*) the name of the currently-active input file + date (*) the current date (e.g. 1 January 1984) + device (*) the device name + env (E) the current environment name + fdate (*) the creation date of the main input file + filename (*) the name of the main input file + ftime (*) the creation time of the main input file + lineno (*) the current line number (as in error messages) + sdate (*) the current date (short format, e.g. Jan 1 1984) + time (*) the current time (e.g. 20:01:59) + user (*) the user name +.em +. +.finish_table +. +. +.ne 13l +.sec "Freezing" +R requires the output device and the fonts +to be specified before any of the following events occur: +.ilist 3 0 +1. A text line is encountered. +.next +2. A line-break occurs. +.next +3. A vertical or horizontal distance specification is used. +.next +4. An environment-dependent built-in register is referenced. +.next +5. An environment-, trap-, or device-related request (other +than DV or FO) is performed. +.end_list +When any of these events occur, the selection of output device +and fonts is said to be 2frozen*. Subsequent DV or FO +requests are illegal and cause processing to be aborted. +. +.ne 12 +.sec "Invoking R" +.para +R is invoked giving the input file name as a command argument. +.foot +On ITS, the input file name must be surrounded by quotation +marks if it contains spaces, e.g. "PAPER@R". Alternatively, +one may write paper.r or common/paper.r, avoiding the use +of quotation marks. On Unix, if no file name is given, R takes +its input from the standard input unit. +.efoot +R produces an output file whose name is the input file name +with a new suffix. (The exact suffix is system- and device-dependent.) +. +.para +The following options may be given on the command line: +.ilist 14 0 +-l force device to LPT +.next +-v force device to VARIAN +.next +-x force device to XGP +.next +-d initialize 2debug* number register to 1 +.next +-t initialize 2trace* number register to 1 +.next +-s initialize 2stats* number register to 1 +.next +2name*=2value* initialize the number register specified by +2name* to the specified 2value* (an optionally signed integer) +.end_list +The initialization of number registers by the = form of command +takes place immediately, except for certain environment-oriented +or device-oriented built-in number registers. +For these built-in number registers, initialization +takes place when the choice of output device becomes frozen +(as described in the previous section). +.para +As for all C programs, the TTY output of R can be redirected +to a file by adding an extra command argument, +.table 1 + >filename +.end_table +which causes the TTY output to be sent to the named file. +.sec "Error Messages" +.para +R detects various errors in request usage and other anomalous +conditions and reports them to the user on the standard output unit. +The form of an error message is +.table 1 + 2line-number*: 2message* +.end_table +The 2line_number* is a description of the currently active +input sources, listed as +.table 1 + 2source*,2source*, ... ,2source* +.end_table +with the most recently activated source at the right. File inputs +are represented by the file name and +the current line number (input from the standard +input unit is represented by "TTY"). Currently active macro +invocations are represented by the macro name. +.sec "The Trace Facility" +.para +R provides a trace facility to aid in the debugging of R programs. +When tracing is on, a complete record of the execution is written +onto two files (with extensions 2rta* and 2rtb*). The first file +contains a low-level description that indicates the exact input +read, with changes of input indicated as follows: +.rtabs +.table + [F] - reading from a file + [M] - reading from a macro definition + [A] - reading from an argument or string register + [S] - reading a pushed-back string + [C] - reading a pushed-back character +.end_table +The second file presents a higher-level trace of the requests +executed and the values of evaluated arguments. In addition, +each output file contains a record of trap invocations and +error messages. +.para +The trace facility is controlled by the 2trace* built-in +number register. It may also be turned on by a command option -t. +.force_out +.bp +.nr example 0 +.de example +.sp +.ne 6l +3\sec_no.\+example \0* +.sp +.ns +.am table_of_contents +.ta indent+600m + 1\sec_no.\example \0 . \page* +\.em +.em +.sec Examples +.am table_of_contents +.sp .5 +.fs 1 +.ir +300m +.em +.para +.rtabs +This section describes a number of examples, ranging from +relatively simple macros for paragraphs, chapter headings, and margins, +to sophisticated formatting macros. +The functions performed by these macros are generally provided by +standard macro packages. +Users should always consult the documentation of available macro +packages before writing their own macros. +. +.example "Paragraphs" +.para +One way to start paragraphs in R is to simply begin the text of the +paragraph on a new line, preceded by a \xc(I) (tab). The \xc(I) at +the beginning of the line causes a line-break, so that the paragraph +will begin on a new output line; it also causes indentation. If one +wants to have a blank line between paragraphs in the output document, +one can simply leave a blank line between paragraphs in the input. +.para +While these methods work, they have disadvantages. One disadvantage +is that one must be careful that the tab stops are always set in +the right place; it may be inconvenient to shift back and forth +between a tab stop at column 5 for paragraphs and a tab stop at +column 8 +for tables, for example. Obviously, other methods, such as +explicit SP requests and TI requests, could be used. However, +the major disadvantage of these approaches (and any other approaches +involving explicit R requests) is inflexibility. If at some later +time one decides to change the paragraph format (for example, to +meet the formatting requirements of a journal), changing all of +the paragraphs to the new format will be difficult and error-prone. +If one is lucky, the change can be made by a text editor; however, +one must be careful that there are no non-paragraph uses of the +paragraphing requests. +.para +The right way to do paragraphs (and any other repeated action with +a specific meaning to the user) is to use a macro. Using a macro +ensures that all of the paragraphs are done the same way and that +it is easy to change the paragraph format. Using a macro also +encourages adding extra requests that one would be too lazy to +write by hand for each paragraph; in particular, one could have +a NE request to make sure that a paragraph did not start too close +to the bottom of the page. +.ne 16 +.para +An example of a paragraph macro that has been used in a technical +paper is: +.table 13 + .if ls<150 + . de para + . sp + . ne 3l + . ti 5 + . em + .ef + . de para + . br + . ne 3l + . ti 5 + . em + .en +.end_table +This macro definition has been conditionalized to work with two +formats, one a single-spaced format with paragraphs separated by +blank lines (camera-ready form) and one a double-spaced format with +no extra blank lines between paragraphs (review form). +.example "Chapter Headings" +.para +A useful macro to have around is one that defines chapter headings. +This macro is intended to be invoked with one argument, +the title of the chapter. The macro should print +the chapter number and the chapter title and print +blank lines appropriately. +.para +First we will need a number register to keep a count +of the number of chapters. This is defined using +the request +.table 1 + .nr chapter_no 0 +.end_table +which defines the number register and initializes it +to zero. Now, let's define the actual macro: +.table 6 + .de chapter + . sp + . ne 6l + \^N+:chapter_no. \^A0 + . sp + . ns + .em +.end_table +The are a number of points to explain. The macro begins with an SP +request that causes a line-break and prints out a blank line. Then a +NE request checks to make sure that we are not too close to the end of +the page; if we are too close, a new page is started. The next line +prints the chapter number followed by the title. It uses the +increment form of the \xc(N) sequence and uses upper-case Roman printing +mode. Note the use of the \xc(\) character to delay the interpretation +of the \xc(N) and \xc(A) characters until the macro is invoked. Finally, +another SP request prints another blank line, and we enter no-space +mode. No-space mode is entered in order to inhibit any blank line +that might be caused, for example, by an immediately following +paragraph macro. If a paragraph macro is used, one must be sure +that the NE distance in the chapter macro is sufficiently larger +than the NE distance in the paragraph macro so that a chapter heading +will never be printed at the bottom of a page with the first paragraph +at the top of the next page. +.para +.ne 7 +This macro could be used as follows: +.table 1 + .chapter "Suggestions for Future Research" +.end_table +which would print: +.table 1 + I. Suggestions for Future Research +.end_table +Note that the macro argument must be enclosed in +quotation marks because it contains space!s. +.example "Margins" +.para +The next example consists of a header and footer +macro that set up one-inch top and bottom margins: +.table 4 + .de header_macro + . vx lvpu 1i + . ns p + .em +.end_table +.table 7 + .de footer_macro + quote bp + .em + + .st header_macro 0 + .st footer_macro 10i +.end_table +The header macro is set to be invoked at the beginning +of each page. It first sets the 2last vertical position used* +(LVPU, see Section sec_rq.req_vp above) to 1 inch from the top of the +page. Setting LVPU ensures that any subsequent output +will be entirely below the specified position. In this case, +a top margin of size 1 inch results. +. +.para +The macro concludes by entering no-space no-page mode. +This is to prevent the top margin from being extended by +the accidental occurrence of a SP request immediately +after the invocation of the header macro or a blank +page from being produced by the occurrence of a BP request +immediately after the invocation of the header macro. +(If one desires to have a blank space even at the top +of an output page, one must precede the SP request with +an RS request.) +. +.para +Note that the header macro does not cause +a line-break. One must be careful to avoid causing a line-break +in a trap-invoked macro. Often when a trap occurs, a partial +output line will have been collected. This partial line would +be output immediately if there were a line-break. +. +.para +The footer macro is set to be invoked when the current +vertical position is increased past 10 inches. It simply +does a BP (note: with the line-break inhibited), resulting +in at least a one inch bottom margin (assuming a page +length of 11 inches). Note that subscripts may extend into +the bottom margin. +.para +The above code can be parameterized by the page length, as +follows: +.table 1 + .st footer_macro pl-1000m +.end_table +This sets the footer trap at one inch (1000 mils) above the bottom +of the page; the trap position is specified in mils because the +PL number register is in units of mils. Note that if the page +length is later changed, the trap position will 2not* +automatically change: the trap position is evaluated 2once*, +when the ST request is processed. +.example "Headings" +.para +A more complicated header macro can be written that +prints a header line at the top of each page, consisting +of a left-heading and a right-heading, with the page +number centered inbetween. +It is assumed that the left and right heading text will +be provided in string registers by the user of the macro; +this decision allows the headings to be changed during the +processing of the text file. +.ne 1 +The new header macro is: +.table 10 + .de header_macro + . ev header + . nf + . vp 0.5i + \^Sleft_heading^C- \^Npage -^R\^Sright_heading + . ev + . vx lvpu 1i + . ns p + .em +.end_table +This macro needs to use a new environment because it produces +a text line. If it used the existing environment, the +left-over text from the previous page would get printed +on the header line. +The 2page* number register +is a built-in number register whose value is always +the current page number. +.para +The above macro uses the EV request to change environments. +This has the disadvantage of "remembering" only one old +environment. If the header macro should go off in the middle +of some other macro that also used the EV request to save +an older environment, then the older +environment would not be restored properly. The macro can +be improved by using the local variable mechanism to save an +arbitrary number of old environments: +.table 11 + .de header_macro + . if page>1 + . sv env header + . nf + . vp 0.5i + \^Sleft_heading^C- \^Npage -^R\^Sright_heading + . en + . vx lvpu 1i + . ns p + .em +.end_table +The IF statement serves to define the scope of the local +variable ENV; it also conveniently serves to prevent the +heading from being printed on the first page. +The environment is set using the SV request, which +automatically saves the old value on a stack; the old value +is restored when the IF statement terminates. +.example "Equations" +.para +The next example is a more sophisticated one. It is a macro +DIV which takes two text arguments and outputs them one +above the other, separated by a horizontal line, as in +the mathematical notation for division. A macro WIDTH +is assumed to exist that takes a text argument and +computes its width, height above the baseline, and height +below the baseline; these results are to be left in number +registers WIDTH, HA, and HB, respectively. +(The WIDTH macro is developed in the next example.) +.para +The basic idea of the DIV macro +is compute the maximum width of the two +text strings, output a horizontal line of that width, then +center the two text strings above and below that line, at +appropriate vertical offsets so that the two strings do not +touch the horizontal line. +.para +The actual macro is shown in Figure current_figure. +.begin_figure "The DIV macro." +.rtabs +.table + .de div + .if + . width "\^A0" + . nv width1 width + . nv hb1 hb + . width "\^A1" + . nv width2 width + . nv ha2 ha + . nv total width1 + . if width2>width1 + . nr total width2 + . en + . width _ + . nv uwidth width + . if total%uwidth + . nr total total+(uwidth-(total%uwidth)) + . en + . nv slop1 (total-width1)/2 + . nv slop2 (total-width2)/2 + . nv start hpos + . nv end start+total + ^U^Xhline(\^Ntotal)^G + . hs (start+slop1-hpos)m + ^V(+hb1-20m)\^A0^G + . hs (start+slop2-hpos)m + ^V(-hb1+ha2!m)\^A1^V(+ha2+20m)^D^G + . hs (end-hpos)m + .en + .em + + .de hline + .if + . nv end hpos+\^A0 + . wh hposwidth1 +. nr total width2 +. en +. width _ +. nv uwidth width +. if total%uwidth +. nr total total+(uwidth-(total%uwidth)) +. en +. nv slop1 (total-width1)/2 +. nv slop2 (total-width2)/2 +. nv start hpos +. nv end start+total +hline(\total) +. hs (start+slop1-hpos)m +(+hb1-20m)\0 +. hs (start+slop2-hpos)m +(-hb1+ha2!m)\1(+ha2+20m) +. hs (end-hpos)m +.en +.em +. +.de hline +.if +.nv end hpos+\0 +.wh hposll-rindent-hpos + . bj + . en + \^A0^G + . en + .em +.end_table +This macro is designed to be invoked using \xc(X). It takes one +argument, which is some text. The macro simply outputs the text. +However, if the text would not fit on the remainder of the +current output line, then the current output line is first terminated +(using BJ so as not to inhibit justification), so that the +text will begin the next output line. +. +. +.example "Computing the Width and Height of Text" +.para +The previous example used a macro called WIDTH that computed +the output width and height of a text string. The implementation of +such a macro involves a number of fine points. +.para +The basic method for computing the width or height of a string is to +begin a new line and output the string. The width of the string +is then the current horizontal position minus the starting horizontal +position, and the height above and +below the baseline of the string is that of the current output line. +However, in order to be useful, +the macro must not actually output any text, nor should +it cause any other side-effects. One implication of this +requirement is that the macro must use its own environment, +so that the current partial line will not be disturbed. +This working environment must be initialized from the current +environment, so that the relevant parameters (such as the +current font) will +be the same. In addition, the macro will have to turn off +printing and traps and preserve the current vertical position. +A width macro is given in Figure current_figure. +.begin_figure "A simple WIDTH macro." +.table + .de width + .if + . es width + . sv env width + . nv printing 0 + . nv enabled 0 + . nv vpos vpos + . nv voff 0 + . nv ll 30000 + . br + . nv start hpos + \^A0^G + . nr width hpos-start + . nr ha habove + . nr hb hbelow + . xe + .en + .em +.ns +.end_table +.finish_figure +This macro also increases the line length so that it can accurately +measure strings that are wider than one line. (The line length +is set to 30000 because this is a large number that is sure to +fit on 16-bit machines.) An IF statement is used so that the +parameters that are changed will be reset automatically. +.para +Although the macro above will work in many cases, it will not work +if called recursively, as it is called in the last example of the +use of the DIV macro. It fails on a recursive call because each +invocation uses the same environment, and each causes side-effects +on the partial line. In order to fix this problem, a number register +is introduced to keep track of the depth of invocation. This +register is then used to form an environment name that is different +for each level of invocation (see Figure current_figure). +.begin_figure "The correct WIDTH macro." +.table + .nr width_level 0 + + .de width + .if + . nv width_level width_level+1 + . es width\^Nwidth_level + . sv env width\^Nwidth_level + . nv printing 0 + . nv enabled 0 + . nv vpos vpos + . nv voff 0 + . nv ll 30000 + . br + . nv start hpos + \^A0^G + . nr width hpos-start + . nr ha habove + . nr hb hbelow + . xe + .en + .em +.ns +.end_table +.finish_figure +. +.am table_of_contents +.fs +.ir -300m +.em +. +.bp +.am table_of_contents +.sp .5 +Request Summary . page +.em +. +.in 10 +.ir 10 +. +3REQUEST SUMMARY* +.sp 2 +.table 12 +3Key to Argument Descriptions* +.sp +.ta 10+5 10+10 10+13 10+18 +.arg_notations +.sp 2 +.reqtabs +. +.am req_summary +\.em +.end_keep +.em +. +.reqsumh +. +.de temp_header +.reqsumh +.sp +.ns +.em +. +.st temp_header top_margin_size!m +. +.req_summary +.rt temp_header +.ir 0 +.in 0 +.bp +.am table_of_contents +.sp .5 +Control Character Summary . page +.em +3CONTROL CHARACTER SUMMARY* +.sp 2 +.ir 10 +.cc_sum_header +.sp 2 +.cc_summary +.ir 0 +.end_table +. +.nr icount 0 +.de index req page + \0 . \1 +.if \+icount==4 +. nr icount 0 +. br +.en +.em +.am table_of_contents +.do_index +.em +. +.wf toc +.wl .sr left_heading left_heading +.wl .sr right_heading right_heading +.wl .de table_of_contents +.wm table_of_contents +.wl .em +.we +. +.de do_index +.sp 3 +Request Index +.sp 2 +.new_font 0 +.in 0 +.ir 0 +.ta .5i 1.5i 2i 3i 3.5i 4.5i 5i 6i +.fi +.so rman.index +.nf +.new_font 7 +.em +. +.nr verbose 1 + \ No newline at end of file diff --git a/doc/r/rman.toc b/doc/r/rman.toc new file mode 100644 index 00000000..4636d106 --- /dev/null +++ b/doc/r/rman.toc @@ -0,0 +1,237 @@ +.sr left_heading 2R Reference Manual* +.sr right_heading 230 January 1978* +.de table_of_contents +.new_font 7 +.nf +.sp .5 +1. Introduction . 4 +.nf +.sp .5 +2. Philosophy . 4 +.nf +.sp .5 +3. The Logical Input Alphabet . 5 +.nf +.sp .5 +4. The Input Mapping . 5 +.nf +.sp .5 +5. Input Modes . 6 +.nf +.sp .5 +6. Input Format . 6 +.nf +.sp .5 +7. Request Descriptions . 7 +.sp .5 +.fs 1 +.ir +300m +.ne 2 +.ta indent+600m + 7.1 Output Device Specifications . 8 +.fi +  +2dv* +2fo* +2fs* +.ne 2 +.ta indent+600m + 7.2 Page Control . 11 +.fi +  +2pl* +2bp* +2pn* +2eo* +2oo* +2ne* +.ne 2 +.ta indent+600m + 7.3 Text Filling and Adjusting . 12 +.fi +  +2br* +2bj* +2fi* +2nf* +.ne 2 +.ta indent+600m + 7.4 Line Spacing and Blank Lines . 12 +.fi +  +2ls* +2sp* +2vp* +2ns* +2rs* +.ne 2 +.ta indent+600m + 7.5 Line Length, Indenting, and Horizontal Positioning . 13 +.fi +  +2ll* +2in* +2ti* +2ir* +2ta* +2hs* +2hp* +.ne 2 +.ta indent+600m + 7.6 Registers . 14 +.fi +  +2nr* +2sr* +2nd* +2sd* +2hx* +2vx* +2xn* +2xs* +.ne 2 +.ta indent+600m + 7.7 String Operations . 15 +.fi +  +2sb* +2si* +2sc* +2sl* +.ne 2 +.ta indent+600m + 7.8 Macros . 16 +.fi +  +2de* +2rm* +2am* +2eq* +2em* +.ne 2 +.ta indent+600m + 7.9 Environments . 17 +.fi +  +2ev* +2es* +2xe* +.ne 2 +.ta indent+600m + 7.10 Blocks, Conditionals, Iteration, and Local Variables . 18 +.fi +  +2be* +2if* +2ef* +2wh* +2fr* +2en* +2bk* +2nv* +2sv* +2hv* +2vv* +.ne 2 +.ta indent+600m + 7.11 Traps . 20 +.fi +  +2st* +2rt* +2ct* +.ne 2 +.ta indent+600m + 7.12 Stream Switching . 21 +.fi +  +2so* +2nx* +2rd* +2ex* +.ne 2 +.ta indent+600m + 7.13 Text File Output . 21 +.fi +  +2wf* +2wa* +2ws* +2wl* +2wm* +2we* +.ne 2 +.ta indent+600m + 7.14 Control Characters . 22 +.fi +  +2cc* +2nc* +2ec* +.ne 2 +.ta indent+600m + 7.15 Output Processing . 23 +.fi +  +2tr* +2uo* +2ut* +.ne 2 +.ta indent+600m + 7.16 Miscellaneous . 24 +.fi +  +2tm* +2rl* +2xc* +.br +.fs +.ir -300m +.ne 5i +.nf +.sp .5 +8. Control Characters . 24 +.nf +.sp .5 +9. Delayed Interpretation of Control Characters . 28 +.nf +.sp .5 +10. Built-In Registers . 28 +.nf +.sp .5 +11. Freezing . 28 +.nf +.sp .5 +12. Invoking R . 30 +.nf +.sp .5 +13. Error Messages . 31 +.nf +.sp .5 +14. The Trace Facility . 31 +.nf +.sp .5 +15. Examples . 32 +.sp .5 +.fs 1 +.ir +300m +.ta indent+600m + 115.1 Paragraphs . 32* +.ta indent+600m + 115.2 Chapter Headings . 33* +.ta indent+600m + 115.3 Margins . 33* +.ta indent+600m + 115.4 Headings . 34* +.ta indent+600m + 115.5 Equations . 35* +.ta indent+600m + 115.6 Computing the Width and Height of Text . 37* +.fs +.ir -300m +.sp .5 +Request Summary . 39 +.sp .5 +Control Character Summary . 43 +.do_index +.em diff --git a/doc/r/rmantc.r b/doc/r/rmantc.r new file mode 100644 index 00000000..ec774971 --- /dev/null +++ b/doc/r/rmantc.r @@ -0,0 +1,56 @@ +.dv xgp +.fo 0 25vg +.fo 1 25vgb +.fo 2 25vgi +.fo 3 40vg +.fo 4 75vbee +.fo 5 18fg +.fo 6 31as +.fo 7 31vg +.fo 8 25as +.fo 9 22fg +.fo F 2AS +. +.tr @ +.nr both_sides 1 +.sr list_left_margin 500m +.sr list_right_margin 500m +. +.sr asterisk 1** +.sr newline 1newline* +.sr tab 1tab* +.sr quote 8'* +.sr dot dodot() +. +.so r.macros +. +.nr page 2 +.begin_table_of_contents 2 +. +. +.de index req page +.elements "\0@.@\1" +.em +. +.so rws/column.rmac +. +.de do_index +.sp 3 +Request Index +.sp 2 +.new_font 0 +.in 0 +.ir 0 +.ta .5i 1.5i 2i 3i 3.5i 4.5i 5i 6i +.fi +.so rman.index +.hx inter_column_spacing 400m +.columns 4 1 0 0 0 800m +.nf +.new_font 7 +.em +. +. +.so rman.toc +.nr verbose 1 + \ No newline at end of file diff --git a/doc/r/troff.compar b/doc/r/troff.compar new file mode 100644 index 00000000..1be26be9 --- /dev/null +++ b/doc/r/troff.compar @@ -0,0 +1,118 @@ +.so usual.rmacs +.de e +.next +.nr e list_count-1 +\e.  +.em +. +. +.nf c +1Comparison of R with respect to NROFF/TROFF0 +.nf l +.fi +.sp 2 +1External Features* +.br +.ilist 5 +.ns +.e +Unlimited length macro and register names. +.e +All ASCII characters can be used as text. (Of course, +escape or quoting may be needed to write some characters.) +.e +Tracing mode for debugging. +.e +Control character mapping more reasonable and more precisely +defined. Changing the control character mapping does not +interfere with previously-defined macros. +.e +Many built-in number registers and string registers. +.e +Lambda-binding of registers. When used with the built-in +registers, this provides a convenient method for saving +and restoring states. +.e +Conditional and loop constructs. +.e +String operations. +.e +Up to 16 fonts. (Fonts are actually font/size combinations; +there is no notion of separately changing point size.) +.e +Many error messages. (Error messages go to the terminal; +formatted output always goes to a file.) +.e +Inline macro invocation. Useful for equations. +.e +Operator precedence in expressions. +.e +Extra line-space provided automatically to compensate for +extra-tall characters. +.e +Non-integer line-spacing allowed (e.g. space-and-a-half). +.e +Explicit right indentation. +.e +Arbitrary number of named environments. +.e +Tabs, hpos, etc. refer to 2output* positions. +.e +Can expunge environments and registers. +.e +To delay the interpretation of a control character for 2n* readings, +2n* backslashes are used, rather than 22n*-1. +.end_list +.sp +.ne 10 +1Internal Features* +.br +.ilist 5 +.ns +.e +Well-modularized, with device and system dependencies factored +out. Currently runs on 2 systems (PDP11 UNIX and PDP10 ITS) +and supports 3 devices (printing, XGP, and Varian). +.e +Long names used internally. (The long names are translated to +short ones where necessary by #defines. The C preprocessor must +be changed to recognize 16 characters in identifiers to support +this usage.) +.end_list +.sp +1External Unfeatures* +.br +.ilist 5 +.ns +.e +No hyphenation. +.e +No diverted output. (However, facilities are provided to do +local two-pass processing.) +.e +No direct to terminal output. (A file is always produced. +A separate program can be used to print the file on a +terminal, pausing at each page and adding extra blank lines +to fill out pages.) +.e +No line numbering. +.e +No fixed-width mode. +.e +No input-line-count traps. +.e +No special support for ligatures or special names for +special characters. +.e +No transparent throughput mode. +.end_list +.sp +.ne 4 +1Internal Unfeatures* +.br +.ilist 5 +.ns +.e +Big -- requires separate I and D space on the PDP11. +.end_list + \ No newline at end of file diff --git a/src/r/r.h b/src/r/r.h new file mode 100644 index 00000000..33b5054b --- /dev/null +++ b/src/r/r.h @@ -0,0 +1,520 @@ +# + +/* + + R Text Formatter + Header File + + Copyright (c) 1976, 1977 by Alan Snyder + +*/ + +/********************************************************************** + + CONFIGURATION OPTIONS + + For the following options, TRUE == the symbol is #define'd, + FALSE == the symbol is not #defined'd. + + Option USE_PORTABLE_OUTPUT: if TRUE, output is performed + by the standard COPEN/CPUTC/CPRINT/CCLOSE. Otherwise, the + routines OOPN, OUTC, OUTI, OUTS, and OCLS are assumed to be + elsewhere defined. + + Option SCRIMP: if TRUE, tables sizes are reduced to minimize + storage space. + + Option USE_MACROS: if TRUE, the various non-essential macros + are used. Otherwise, the corresponding routines are used. + Many of the routines do (hopefully) redundant error checking. + + WORD SIZE OPTION + + If the type INT has 32 or more bits, #define BIGWORD. + [IGNORE: + Otherwise, if the type LONG has 32 or more bits, #define + BIGWORD and #define BIGLONG.] + Otherwise, do not #define either of these, and only 16 bits + per word will be used. The penalty of not using BIGWORD + seems to have gone away. + + DEVICE OPTIONS: + + HAVE_XGP => include XGP support + HAVE_VARIAN => include VARIAN support + +**********************************************************************/ + +# ifdef unix /* UNIX settings */ +# define USE_PORTABLE_OUTPUT +# define SCRIMP +# define USE_MACROS +# define HAVE_VARIAN +# endif + +# ifndef unix /* ITS settings */ +# define USE_MACROS +# define BIGWORD +# define HAVE_XGP +# endif + +/* complete set: + + # define USE_PORTABLE_OUTPUT + # define SCRIMP + # define USE_MACROS + # define BIGWORD + # define BIGLONG + # define HAVE_XGP + # define HAVE_VARIAN + +*/ + +/********************************************************************** + + ROUNDING + + If the default float-to-int conversion of your C does not + round (i.e. it truncates), then a ROUND function must be + provided. Otherwise, an "identity" macro is sufficient. + NOTE: round(-x) must be equal to -round(x). I weakly prefer + that round(1.5)=1. + +**********************************************************************/ + +# ifdef unix +# define round(x) ((x)>=0 ? (int)((x)+0.4999) : -((int)(-(x)+0.4999))) +# endif + +# ifndef unix +# define round(x) (x) +# endif + +/********************************************************************** + + END OF CONFIGURATION OPTIONS + +**********************************************************************/ + +/* new types */ + +# ifdef BIGLONG +# define bits long +# endif +# ifndef BIGLONG +# define bits int +# endif +extern bits btemp; + +# define token bits /* input tokens */ +# define word int /* text words */ +# define idn int /* index into hash table */ +# define ac int /* extendible character arrays */ +# define ichar int /* logical input character */ + +/* sizes not subject to easy change */ + +# define ndev 3 /* number of output devices */ +# define max_args 10 /* max number of macro arguments */ +# define max_fonts 16 /* max number of fonts */ + +/* changeable sizes */ + +# define max_env 20 /* max number of environments */ +# define max_tabs 30 /* max number of tab stops */ +# define FRSIZE 10 /* font ring-buffer size */ + +/* changeable SCRIMP-dependent sizes */ + +# ifndef SCRIMP +# define FNSIZE 100 /* max size of file names */ +# define max_idn 1000 /* max number of identifiers */ +# define max_var 200 /* maximum number of variables */ +# define tcstore_size 010000 /* storage for text words; + must be power of 2 and <= 010000 */ +# define max_group 30 /* max depth of group nesting */ +# define max_icb 30 /* max depth of input stack */ +# define max_traps 20 /* max number of traps */ +# define max_tokens 300 /* max number tokens per line */ +# define gc_tab_size 100 /* temporary storage for GC */ +# endif + +# ifdef SCRIMP +# define FNSIZE 50 /* max size of file names */ +# define max_idn 600 /* max number of identifiers */ +# define max_var 50 /* maximum number of variables */ +# define tcstore_size 04000 /* storage for text words; + must be power of 2 and <= 010000 */ +# define max_group 20 /* max depth of group nesting */ +# define max_icb 15 /* max depth of input stack */ +# define max_traps 10 /* max number of traps */ +# define max_tokens 100 /* max number tokens per line */ +# define gc_tab_size 50 /* temporary storage for GC */ +# endif + +/* useful values */ + +# define TRUE 1 +# define FALSE 0 +# define infinity 30000 /* a large integer */ +# define OPENLOSS (-1) /* value returned by failing open */ +# define TCMASK (tcstore_size-1) + +# define max_voff 8191 /* largest vertical offset */ +# define min_voff (-8192) /* smallest vertical offset */ +# ifndef BIGLONG +# ifdef BIGWORD +# define max_voff 32767 /* largest vertical offset */ +# define min_voff (-32768) /* smallest vertical offset */ +# endif +# endif + +# ifdef BIGWORD +# define WVMASK 0177777 +# define WSHIFT 16 +# define WOSIZE 5 +# define WOMASK 037 +# endif + +# ifndef BIGWORD +# define WVMASK 07777 +# define WSHIFT 12 +# define WOSIZE 4 +# define WOMASK 017 +# endif + +/* tokens types */ + +/* tokens with no value component: */ + +# define t_null 0 +# define t_center 1 +# define t_right 2 + +/* tokens with a value component: */ + +# define t_offset 9 +# define t_nlspace 10 +# define t_hpos 11 +# define t_pos 12 +# define t_space 13 +# define t_tabc 14 +# define t_text 15 + +/* devices */ + +# define d_xgp 0 +# define d_lpt 1 +# define d_varian 2 + +/* adjustment modes */ + +# define a_left 0 +# define a_right 1 +# define a_center 2 +# define a_both 3 + +/* font modes */ + +# define f_normal 0 +# define f_underline 1 +# define f_overprint 2 +# define f_caps 3 + +/* control-character types */ + +# define cc_text 1 /* part of text */ +# define cc_separator 2 /* separates text */ +# define cc_universal 3 /* separator recognized everywhere */ +# define cc_input 4 /* interpreted by input scanner */ + +/* input source types */ + +# define i_file 0 +# define i_char 1 +# define i_string 2 +# define i_ac 3 +# define i_macro 4 +# define i_peekc 5 +# define i_nomore 6 + +/* input character types */ + +# define i_text 0 +# define i_control 1 +# define i_protect 10 + +/* some ICHAR literals */ + +# define i_space 01040 +# define i_newline 01152 +# define i_eof 01000 +# define i_dot 01056 /* ^. */ +# define i_quote 01047 /* ^' */ +# define i_back 01134 /* ^\ */ +# define i_ctrl_a 01141 /* ^a */ +# define i_ctrl_g 01147 /* ^g */ +# define i_ictr_g 01107 /* ^G (internal) */ +# define i_tab 01151 /* ^i */ +# define i_comment 01153 /* ^k */ +# define i_ctrl_n 01156 /* ^n */ +# define i_ctrl_q 01161 /* ^q */ +# define i_ctrl_s 01163 /* ^s */ +# define i_ctrl_x 01170 /* ^x */ + +/* input modes */ + +# define m_quote 0 +# define m_args 1 +# define m_text 2 + +/* name_info bits */ + +# define NRDEFINED 00001 /* named number register exists */ +# define NRBUILTIN 00002 /* number register is built-in */ +# define NRFREEZE 00004 /* built-in number register freezes */ +# define SRDEFINED 00010 /* named string register exists */ +# define SRBUILTIN 00020 /* string register is built-in */ +# define SRFREEZE 00040 /* built-in string register freezes */ +# define RQMACRO 00100 /* request is a macro */ +# define RQFREEZE 00200 /* built-in request freezes */ +# define RQBREAK 00400 /* built-in request causes break */ +# define RQTHAW 01000 /* built-in request must precede freeze */ +# define RQBITS 01700 /* request info bits */ + +/* code sequences */ + +# define freeze if (!frozen) header () +# define not_frozen if (frozen) toolate () + +/* types */ + +struct _env { + idn ename; /* environment name */ + int line_spacing; /* in lines * 100 */ + int indent; /* in HU */ + int right_indent; /* in HU */ + int adjust_mode; + int nofill_adjust_mode; + int filling; /* boolean */ + int temp_indent; /* -1 if none */ + int tn; /* number of tokens in line_buf */ + int ha; /* height of line above baseline */ + int hb; /* height of line below baseline */ + int hp; /* current horizontal position in line */ + int rm; /* right margin for current line */ + int text_seen; /* text seen in current line */ + int default_height; /* determines line spacing */ + int space_width; /* width of space in HU */ + int char_width; /* nominal char width in HU */ + int pfont; /* principle font */ + int ifont; /* current input font */ + int iul; /* input underline mode */ + int ivoff; /* input vertical offset */ + int tab_stops[max_tabs]; /* in HU */ + token line_buf[max_tokens]; /* current partially collected line */ + int partial_word; + /* flag set by ^g and ^G (internal): + bit PWCONCAT: causes concatenation if last word + on line is text + bit PWEATNL: inhibits newlines + */ + int end_of_sentence; /* should newline be 2 spaces? */ + int delflag; /* delete when next deselected */ + }; + +# define env struct _env + +# define PWCONCAT 01 +# define PWEATNL 02 + + +struct _fontdes { + char fname[FNSIZE]; /* font file name */ + int fha; /* height above baseline */ + int fhb; /* height below baseline */ +# ifdef unix + int cpadj; /* font column position adjustment */ +# endif + int fwidths[0200]; /* character widths */ +# ifdef unix + int flkern[0200]; /* character lkerns */ +# endif + int fmode; /* LPT mode */ + }; + +# define fontdes struct _fontdes + +/* renamings to handle long names */ + +# define LineBrkjust lnbrkjust +# define LineNLSpace lnnlspace +# define LineReset lnreset +# define LineTabc lntabc +# define LineText lntext +# define append_string astring +# define append_token atoken +# define check_prefix chkprx +# define cntrl_stat ctrlstat +# define current_adjust_mode curadjust_mode +# define decode_backslash dcbackslash +# define decode_sharp dcsharp +# define eprint_lineno epline +# define find_env fenv +# define find_pos fpos +# define find_trap ftrap +# define font_exists fexists +# define font_ha fntha +# define font_name foname +# define font_table ftable +# define font_width fwidth +# define get_cc getcc +# define get_font gt_font +# define get_input_pos ginppos +# define get_input_type ginptype +# define get_lineno gt_lineno +# define getc_ac gcac +# define getc_char gcchar +# define getc_eof gceof +# define getc_file gcfile +# define getc_macro gcmacro +# define getc_peekc gcpeekc +# define getc_string gcstring +# define getc_trace gctrace +# define ichar_cons iccons +# define ichar_type ictype +# define ichar_val icval +# define insert_number insnumber +# define insert_string insstring +# define lpt_eof lpteof +# define lpt_eop lptep +# define lpt_eow lptew +# define make_ac_idn mk_ac_idn +# define make_env mk_env +# define move_up movup +# define new_pfont npfont +# define next_tab nxtab +# define next_trap nxtrap +# define old_env oldenv +# define output_init oinit +# define output_line oline +# define page_empty pgempty +# define page_length pglength +# define page_number pgnumber +# define po_eof poeof +# define po_eop poeop +# define po_eow poeow +# define process_args proargs +# define process_break probrk +# define process_options proopts +# define push_ac pac +# define push_char pchar +# define push_file pfile +# define push_for psh_for +# define push_group psh_group +# define push_icb picb +# define push_if psh_if +# define push_macro pmacro +# define push_string pstring +# define push_var psh_var +# define push_while psh_while +# define reset_overprint rsoverprint +# define reset_traps rtraps +# define scan_macro_body scanmacrobody +# define set_lpt setlpt +# define skip_arg skiparg +# define skip_until_end skp_until_end +# define text_ha txha +# define text_hb txhb +# define text_init txinit +# define text_mark txmrk +# define text_update txupd +# define token_cons tkcons +# define token_type tktype +# define token_val tkval +# define trace_off trcoff +# define trace_on trcon +# define xgp_eof xgpeof +# define xgp_eop xgpep +# define xgp_eow xgpew + +/* end of renamings */ + +/* MACROS */ + +# ifdef USE_MACROS +# define max(a,b) ((a)<(b) ? (b) : (a)) +# define min(a,b) ((a)<(b) ? (a) : (b)) +extern char ctab[]; +# define alpha(c) (!((c)&~0177) && ctab[c]) + +# ifndef BIGLONG +# define token_cons(type,val) (((type)<>WSHIFT)&WOMASK) + +extern int tcstore[]; +# define text_width(w) (tcstore[w]) +# define text_ha(w) (tcstore[(w) + 1]) +# define text_hb(w) (tcstore[(w) + 2]) + +extern int device; +extern fontdes *font_table[]; + +# define font_ha(n) (device==d_lpt?1:font_table[n]->fha) +# define font_hb(n) (device==d_lpt?0:font_table[n]->fhb) +# define font_width(n,c) (device==d_lpt?1:font_table[n]->fwidths[c]) + +# define ichar_type(ic) (((ic)>>9) & 077) +# define ichar_val(ic) ((ic) & 0777) +# define ichar_cons(type,val) (((type)<<9) | (val)) + +extern char *nametab[]; +# define idn_string(i) (nametab[i]) + +# endif /* USE_MACROS */ + +/* ichar macros */ + +# define is_separator(ic) ((ic) == i_space || (ic) == i_tab) +# define is_terminator(ic) ((ic)==i_space||(ic)==i_tab||(ic)==i_newline||(ic)==i_eof) + +/* high-level trace macros */ + +# define trace_character(ic) if (f2trace>=0) tr_character (ic); else +# define trace_int(i) if (f2trace>=0) tr_int (i); else +# define trace_hu(i) if (f2trace>=0) tr_hu (i); else +# define trace_vu(i) if (f2trace>=0) tr_vu (i); else +# define trace_fixed(i) if (f2trace>=0) tr_fixed (i); else + +/* output macros */ + +# ifdef USE_PORTABLE_OUTPUT +# define outc(c) cputc ((c), fout) /* output ascii char */ +# define outi(c) cputc ((c) | 0400, fout) /* output image char */ +# define outs(str) cprint (fout, "%s", (str)) /* output string */ +# define ocls() cclose (fout) /* close output */ +# endif + +/* INDIRECT ROUTINES */ + +extern ichar (*pgetc)(); +# define getc1() ((*pgetc)()) +# define getc2() ((*pgetc)()) + +extern int (*po_char)(), (*po_eow)(), (*po_vp)(), (*po_space)(), + (*po_eol)(), (*po_eop)(), (*po_eof)(); +# define output_char (*po_char) +# define output_eow (*po_eow) +# define output_vp (*po_vp) +# define output_space (*po_space) +# define output_eol (*po_eol) +# define output_eop (*po_eop) +# define output_eof (*po_eof) + +double gete1(); +# define gete() (gete1 (-1)) diff --git a/src/r/r.stinkr b/src/r/r.stinkr new file mode 100644 index 00000000..50817cca --- /dev/null +++ b/src/r/r.stinkr @@ -0,0 +1,29 @@ +x c/clib +l clib/c10sfd.stk +l rcntrl.stk +l rdev.stk +l rexpr.stk +l rfile.stk +l rfonts.stk +l richar.stk +l ridn.stk +l rin.stk +l rin1.stk +l rin2.stk +l rits.stk +l rline.stk +l rlpt.stk +l rmain.stk +l rmisc.stk +l rout.stk +l rreadr.stk +l rreg.stk +l rreq1.stk +l rreq2.stk +l rreq3.stk +l rtext.stk +l rtoken.stk +l rtrap.stk +l rvaria.stk +l rxgp.stk +o ts.r30 diff --git a/src/r/rcntrl.c b/src/r/rcntrl.c new file mode 100644 index 00000000..ac811697 --- /dev/null +++ b/src/r/rcntrl.c @@ -0,0 +1,620 @@ +# include "r.h" + +/* + + R Text Formatter + Control Structures and Variables + + Copyright (c) 1976, 1977 by Alan Snyder + + + ROUTINES: + + cntrl_init () initialization + push_group (...) push group entry + pop_group () pop top group entry + push_var (type, name) push variable + pop_var () pop top variable entry + leave_group (lev) end-of-macro handler + unterminated_group (p) emit error message + nv_define (n, v) define number variable + sv_define (s, v) define string variable + be_com () begin BEGIN block + push_begin (name) push begin group on stack + wh_com () begin WHILE statement + push_while () push while group on stack + if_com () begin IF statement + push_if () push if group on stack + fr_com () begin FOR statement + push_for (...) push for group on stack + cond_test () perform a conditional test + skip_until_end (p, b) skip until matching EN request is found + bk_com () process BREAK statement + ef_com () process ELSE statement + en_com () process END statement + +*/ + +/* variables */ + +# define v_nr 0 /* previously-defined NR */ +# define v_unr 1 /* previously-undefined NR */ +# define v_sr 2 /* previously-defined SR */ +# define v_usr 3 /* previously-undefined SR */ + +struct _var_entry { + idn name; /* register name */ + int vtype; /* variable type */ + int val; /* variable value */ + }; +# define var_entry struct _var_entry + +var_entry + var_stack[max_var], + *cvar {var_stack}, + *evar, + *mvar {var_stack}; + +/* group types */ + +# define g_while 0 +# define g_for 1 +# define g_if 2 +# define g_begin 3 +# define g_dummy 4 /* surrounds entire file */ + +struct _group_entry + {idn name; /* FOR variable or BEGIN block name */ + int gtype; /* type of group */ + int icblev; /* input level of macro */ + var_entry *pvar; /* variable stack level */ + char *ip; /* input pointer */ + int icount; /* input count */ + int hi; /* hi bound of FOR */ + int step; /* step of FOR */ + }; +# define group_entry struct _group_entry + +group_entry + group_stack[max_group], + *cgrp {group_stack}, + *egrp, + *mgrp {group_stack}; + +extern int icblev, no_interpretation, in_mode, i_val, exiting; +extern char *i_p; + +/********************************************************************** + + CNTRL_INIT - initialization + +**********************************************************************/ + +int cntrl_init () + + {cgrp->gtype = g_dummy; + cgrp->icblev = -1; + egrp = cgrp + max_group; + evar = cvar + max_var; + cgrp->pvar = cvar; + } + +/********************************************************************** + + PUSH_GROUP - push group entry + +**********************************************************************/ + +push_group (type, need_pos, name, hi, step) + idn name; + + {if (++cgrp >= egrp) fatal ("too many nested statements"); + if (cgrp > mgrp) mgrp = cgrp; + cgrp->gtype = type; + cgrp->icblev = icblev; + cgrp->pvar = cvar; + if (need_pos) + {cgrp->ip = i_p; + cgrp->icount = i_val; + } + else cgrp->ip = cgrp->icount = 0; + cgrp->name = name; + cgrp->hi = hi; + cgrp->step = step; + } + +/********************************************************************** + + POP_GROUP - pop top group entry + +**********************************************************************/ + +pop_group () + + {var_entry *p; + + if (cgrp <= group_stack) barf ("POP_GROUP: stack underflow"); + else + {p = cgrp->pvar; + while (cvar > p) pop_var (); + --cgrp; + } + } + +/********************************************************************** + + PUSH_VAR - push variable entry + +**********************************************************************/ + +push_var (type, name) + + {int val; + if (++cvar >= evar) fatal ("too many variables"); + if (cvar > mvar) mvar = cvar; + cvar->name = name; + val = 0; + if (type == v_nr) + {if (nr_find (name) >= 0) val = nr_value (name); + else type = v_unr; + } + else if (type == v_sr) + {if (sr_find (name) >= 0) val = sr_value (name); + else type = v_usr; + } + cvar->vtype = type; + cvar->val = val; + } + +/********************************************************************** + + POP_VAR - pop top variable entry + +**********************************************************************/ + +pop_var () + + {idn name; + + name = cvar->name; + if (cvar <= var_stack) barf ("POP_VAR: stack underflow"); + else + {switch (cvar->vtype) { + case v_nr: nr_enter (name, cvar->val); break; + case v_unr: nr_undef (name); break; + case v_sr: sr_enter (name, cvar->val); /* move ref */ + break; + case v_usr: sr_undef (name); break; + default: barf ("POP_VAR: bad variable type"); + } + --cvar; + } + } + +/********************************************************************** + + LEAVE_GROUP - this routine is called when a macro + containing an active group is finished; it is + also called explicitly when processing is finished + +**********************************************************************/ + +leave_group (lev) + + {while (cgrp->icblev >= lev) + {if (cgrp->gtype == g_begin && lev > 0) + {group_entry *p; + int olev; + p = cgrp; + olev = lev; + while (olev >= lev) + olev = --p->icblev; + olev = max (0, olev); + while (++p <= cgrp) + p->icblev = olev; + break; + } + if (!exiting) unterminated_group (cgrp); + pop_group (); + } + } + +/********************************************************************** + + UNTERMINATED_GROUP - emit error message for unterminated group + +**********************************************************************/ + +unterminated_group (p) + group_entry *p; + + {switch (p->gtype) { +case g_while: error ("unterminated while statement"); return; +case g_if: error ("unterminated if statement"); return; +case g_for: error ("unterminated for statement"); return; +case g_begin: if (p->name == -1) + error ("unterminated unnamed begin block"); + else error ("unterminated begin block named %s", + idn_string (p->name)); + return; +default: barf ("UNTERMINATED_GROUP: bad group type"); + } + } + +/********************************************************************** + + OUT_OF_SCOPE - return TRUE if not properly in the + scope of some statement + +**********************************************************************/ + +int out_of_scope () + + {return (cgrp->icblev < icblev && cgrp->gtype != g_begin);} + +/********************************************************************** + + NV_DEFINE - define number variable + +**********************************************************************/ + +nv_define (name, val) + idn name; + + {if (out_of_scope ()) + error ("variables must be defined within statements"); + else + {push_var (v_nr, name); + nr_enter (name, val); + } + } + +/********************************************************************** + + SV_DEFINE - define string variable + +**********************************************************************/ + +sv_define (name, val) + idn name; + + {if (out_of_scope ()) + error ("variables must be defined within statements"); + else + {push_var (v_sr, name); + sr_enter (name, val); + } + } + +/********************************************************************** + + BE_COM - Begin BEGIN block. The input must be positioned + in front of the block name. + +**********************************************************************/ + +be_com () + + {idn name; + + name = get_name (); + push_begin (name); + set_exit (leave_group); + } + +/********************************************************************** + + PUSH_BEGIN - push begin group on stack + +**********************************************************************/ + +push_begin (name) {push_group (g_begin, FALSE, name, 0, 0);} + +/********************************************************************** + + WH_COM - Begin WHILE statement. Input must be coming + from a macro definition, and the input must be positioned + in front of the while expression. + +**********************************************************************/ + +wh_com () + + {int t; + ichar ic; + + ic = -1; + t = get_input_type (); + if (t==i_char) /* character following WH may have + been read */ + {ic = getc1 (); + t = get_input_type (); + } + if (t != i_macro) + {error ("while statement must be in macro definition"); + return; + } + if (ic != 1) decrement_input_pos (); + push_while (); + set_exit (leave_group); + cond_test (); + } + +/********************************************************************** + + PUSH_WHILE - push while group on stack + +**********************************************************************/ + +push_while () {push_group (g_while, TRUE, 0, 0, 0);} + +/********************************************************************** + + FR_COM - Begin FOR statement. Input must be coming + from a macro definition, and the input must be positioned + in front of the first argument. + +**********************************************************************/ + +fr_com () + + {int t, lo, hi, step; + ichar ic; + idn name; + + name = get_name (); + lo = get_int (1, 0); + hi = get_int (infinity, 0); + step = get_int (1, 0); + + if (name<0) return; + ic = -1; + t = get_input_type (); + if (t==i_char) /* character following FR may have been read */ + {ic = getc1 (); + t = get_input_type (); + } + if (t != i_macro) + {error ("for statement must be in macro definition"); + return; + } + if (ic != 1) decrement_input_pos (); + push_for (name, hi, step); + set_exit (leave_group); + push_var (v_nr, name); + nr_enter (name, lo); + cond_test (); + } + +/********************************************************************** + + PUSH_FOR - push for group on stack + +**********************************************************************/ + +push_for (name, hi, step) + idn name; + int hi, step; + + {push_group (g_for, TRUE, name, hi, step); + } + +/********************************************************************** + + IF_COM - Begin IF statement. Input must be coming + from a macro definition, and the input must be positioned + in front of the conditional expression. + +**********************************************************************/ + +if_com () + + {int t; + ichar ic; + group_entry *p; + + ic = -1; + t = get_input_type (); + if (t==i_char) /* character following IF may have been read */ + {ic = getc1 (); + t = get_input_type (); + } + if (t != i_macro && t != i_file) + {error ("if statement must be in file or macro definition"); + return; + } + push_if (); + set_exit (leave_group); + if (ic != -1) push_char (ic); + p = cgrp; + for (;;) /* loop to process else-if clauses */ + {if (cond_test ()) break; /* test succeeds */ + if (cgrp != p) break; /* no else-if */ + } + } + +/********************************************************************** + + PUSH_IF - push if group on stack + +**********************************************************************/ + +push_if () {push_group (g_if, FALSE, 0, 0, 0);} + +/********************************************************************** + + COND_TEST - perform a IF, FOR, or WHILE statement test + If current input is from a macro, the input will be + positioned to read the conditional expression. + Returns TRUE if the test succeeded. + +**********************************************************************/ + +int cond_test () + + {int val, lev, i, flag; + + val = -1; + flag = FALSE; + switch (cgrp->gtype) { + case g_if: flag = TRUE; break; + case g_for: i_p = cgrp->ip; + i_val = cgrp->icount; + i = nr_value (cgrp->name); + if (cgrp->step>=0 && i>cgrp->hi || + cgrp->step<=0 && ihi) + {val = 0; + break; + } + break; + case g_while: i_p = cgrp->ip; + i_val = cgrp->icount; + break; + default: barf ("COND_TEST: bad group"); + return; + } + lev = cgrp->icblev; + if (val == -1) val = get_int (1, 0); + if (val==0) /* expression is FALSE */ + skip_until_end (cgrp, flag); + return (val != 0); + } + +/********************************************************************** + + SKIP_UNTIL_END - Skip until specified matching EN request is + or corresponding macro definition is terminated. + If FLAG is TRUE, stop if an ELSE statement at the current + level is seen. + +**********************************************************************/ + +skip_until_end (p, flag) + group_entry *p; + + {ichar ic; + idn name; + int (*f)(); + extern int (*comtab[])(), name_info[], en_com(), wh_com(), + if_com(), fr_com(), be_com(), ef_com(); + + no_interpretation = TRUE; + in_mode = m_text; + while (TRUE) + {ic = getc1 (); + if (cgrp < p || icblev<0) break; + if (ic == i_dot || ic == i_quote) + {name = get_untraced_name (); + if (name >= 0 && (name_info[name] & RQMACRO) == 0) + {f = comtab[name]; + if (f == en_com) pop_group (); + else if (f == wh_com) push_while (); + else if (f == if_com) push_if (); + else if (f == be_com) push_begin (get_name ()); + else if (f == fr_com) push_for (-1, 0, 0); + else if (f == ef_com) + {if (flag && p == cgrp) + {ic = -1; + break; + } + } + } + } + } + if (ic != -1) push_char (ic); + no_interpretation = FALSE; + } + +/********************************************************************** + + BK_COM - process BREAK statement + +**********************************************************************/ + +bk_com () + + {ichar ic; + group_entry *p; + + ic = -1; + if (get_input_type () == i_char) ic = getc1 (); + /* character following BK may have been read */ + p = cgrp; + while (p->gtype != g_while && p->gtype != g_for) + if (icblev > p->icblev) + {error ("extraneous break statement"); + return; + } + else --p; + skip_until_end (p, FALSE); + } + +/********************************************************************** + + EF_COM - process ELSE statement + +**********************************************************************/ + +ef_com () + + {ichar ic; + group_entry *p; + + ic = -1; + if (get_input_type () == i_char) ic = getc1 (); + /* character following EF may have been read */ + p = cgrp; + if (p->gtype != g_if || icblev > p->icblev) + {error ("extraneous else-if statement"); + return; + } + skip_until_end (p, FALSE); + } + +/********************************************************************** + + EN_COM - process END statement + +**********************************************************************/ + +en_com () + + {int t; + ichar ic; + var_entry *p; + + ic = -1; + t = get_input_type (); + if (t==i_char) /* character following EN may have been read */ + {ic = getc1 (); + t = get_input_type (); + } + p = cgrp->pvar; + if (out_of_scope ()) error ("extraneous end statement"); + else switch (cgrp->gtype) { + case g_begin: + case g_if: pop_group (); + break; + case g_for: ++p; + while (cvar > p) pop_var (); + nr_enter (cgrp->name, + nr_value (cgrp->name) + cgrp->step); + return (cond_test ()); + case g_while: while (cvar > p) pop_var (); + return (cond_test ()); + } + if (ic != -1) push_char (ic); + } + +/********************************************************************** + + CNTRL_STAT - Compute Statistics + +**********************************************************************/ + +cntrl_stat (nvar, ngroup) int *nvar, *ngroup; + + {*nvar = (mvar-var_stack); + *ngroup = (mgrp-group_stack); + } + \ No newline at end of file diff --git a/src/r/rdev.c b/src/r/rdev.c new file mode 100644 index 00000000..065282ff --- /dev/null +++ b/src/r/rdev.c @@ -0,0 +1,191 @@ +# include "r.h" + +/* + + R Text Formatter + General Device Information + + Copyright (c) 1976, 1977 by Alan Snyder + + + ROUTINES: + + dev_init () initialize device routines + rc = devoption (c) process possible device option character + devsetup () setup selected device + devheader () output header for device + + To install a new device: + + (1) write device handlers + (2) add device #, compilation option to r.h + (3) add device entries to rdev.c + (4) add device number register to rreg.c + (5) add device suffix to operating-system files + +*/ + +/* device table */ + +idn dev_tab[ndev]; +int device; /* the output device */ + +/* device-dependent parameters */ + +int superfactor {1}; /* divisor for ^U and ^D */ + +int bad(); +int (*po_char)() {bad}, + (*po_eow)() {bad}, + (*po_vp)() {bad}, + (*po_space)() {bad}, + (*po_eol)() {bad}, + (*po_eop)() {bad}, + (*po_eof)() {bad}; + +int lpt_char(), lpt_eow(), lpt_vp(), lpt_space(), lpt_eol(), + lpt_eop(), lpt_eof(); + +# ifdef HAVE_XGP +int xgp_char(), xgp_eow(), xgp_vp(), xgp_space(), xgp_eol(), + xgp_eop(), xgp_eof(); +# endif + +# ifdef HAVE_VARIAN +int vn_char(), vn_eow(), vn_vp(), vn_space(), vn_eol(), + vn_eop(), vn_eof(); +# endif + +/********************************************************************** + + DEV_INIT + +**********************************************************************/ + +dev_init () + + {dev_tab[d_lpt] = make_idn ("lpt"); + dev_tab[d_xgp] = make_idn ("xgp"); + dev_tab[d_varian] = make_idn ("varian"); + device = d_lpt; + lpt_init (); + +# ifdef HAVE_VARIAN + vn_init (); +# endif + +# ifdef HAVE_XGP + xgp_init (); +# endif + } + +/********************************************************************** + + DEVOPTION - Process possible device option character. + Return TRUE if it is one. + +**********************************************************************/ + +int devoption (c) + int c; + + {extern int opt_dev; + + switch (c) { + case 'l': opt_dev = d_lpt; break; + +# ifdef HAVE_XGP + case 'x': opt_dev = d_xgp; break; +# endif + +# ifdef HAVE_VARIAN + case 'v': opt_dev = d_varian; break; +# endif + + default: return (FALSE); + } + return (TRUE); + } + +/********************************************************************** + + DEVSETUP - Setup selected device + +**********************************************************************/ + +devsetup () + + {extern int device; + switch (device) { + +case d_lpt: set_lpt (); + po_char = lpt_char; + po_eow = lpt_eow; + po_vp = lpt_vp; + po_space = lpt_space; + po_eol = lpt_eol; + po_eop = lpt_eop; + po_eof = lpt_eof; + return; + +# ifdef HAVE_XGP +case d_xgp: set_xgp (); + po_char = xgp_char; + po_eow = xgp_eow; + po_vp = xgp_vp; + po_space = xgp_space; + po_eol = xgp_eol; + po_eop = xgp_eop; + po_eof = xgp_eof; + return; +# endif + +# ifdef HAVE_VARIAN +case d_varian: set_vn (); + po_char = vn_char; + po_eow = vn_eow; + po_vp = vn_vp; + po_space = vn_space; + po_eol = vn_eol; + po_eop = vn_eop; + po_eof = vn_eof; + return; +# endif + +default: fatal ("output device unsupported"); + } + } + +/********************************************************************** + + DEVHEADER - Output device header + +**********************************************************************/ + +devheader () + + {extern int device; + switch (device) { + +case d_lpt: lpt_header (); break; + +# ifdef HAVE_XGP +case d_xgp: xgp_header (); break; +# endif + +# ifdef HAVE_VARIAN +case d_varian: vn_header (); break; +# endif + } + } + +/********************************************************************** + + BAD - routine to detect call before initialization + +**********************************************************************/ + +bad () + + {barf ("R: output routine called before initialization"); + } diff --git a/src/r/rexpr.c b/src/r/rexpr.c new file mode 100644 index 00000000..34acfabd --- /dev/null +++ b/src/r/rexpr.c @@ -0,0 +1,303 @@ +# include "r.h" + +/* + + R Text Formatter + Expression Parsing + + Copyright (c) 1976, 1977 by Alan Snyder + + + ROUTINES: + + gete () => double read numeric expression + getp () => double read numeric primary + getop () => op read expression operator + pushop (op) push-back expression operator + i = fcomp (f1, f2) floating point comparison + +*/ + + +/* expression operators */ + +# define o_end 0 +# define o_add 1 +# define o_sub 2 +# define o_mul 3 +# define o_div 4 +# define o_and 5 +# define o_or 6 +# define o_eq 7 +# define o_ne 8 +# define o_lt 9 +# define o_le 10 +# define o_gt 11 +# define o_ge 12 +# define o_mod 13 +# define o_idiv 14 + +extern int ftrace; +extern ac rd_ac; +extern double getp(), gete1(); + +/********************************************************************** + + GETE - Get Numeric Expression + + The expression is assumed to begin with the next input + character. The expression terminates with the first invalid + expression character. The operators are the usual arithmetic, + comparison, and logical operators. The precedence of the + operators is given in the array PREC. All operators are + left-associative. Left-corner parsing is used. + +**********************************************************************/ + +int prec[] { + 0, /* o_end */ + 5, /* o_add */ + 5, /* o_sub */ + 6, /* o_mul */ + 6, /* o_div */ + 2, /* o_and */ + 1, /* o_or */ + 3, /* o_eq */ + 3, /* o_ne */ + 4, /* o_lt */ + 4, /* o_le */ + 4, /* o_gt */ + 4, /* o_ge */ + 6, /* o_mod */ + 6 /* o_idiv */ + }; + +double gete1 (lprec) int lprec; /* left binding power */ + + {double val, rval; + int rprec, op, i; + + val = getp (); + while ((op = getop()) != o_end) + {if ((rprec = prec[op]) <= lprec) + {pushop (op); + return (val); + } + rval = gete1 (rprec); + switch (op) { + +case o_or: val = fcomp (val, 0.0) || fcomp (rval, 0.0); break; +case o_and: val = fcomp (val, 0.0) && fcomp (rval, 0.0); break; +case o_eq: val = !fcomp (val, rval); break; +case o_ne: val = fcomp (val, rval); break; +case o_lt: val = fcomp (val, rval) < 0; break; +case o_le: val = fcomp (val, rval) <= 0; break; +case o_gt: val = fcomp (val, rval) > 0; break; +case o_ge: val = fcomp (val, rval) >= 0; break; +case o_add: val =+ rval; break; +case o_sub: val =- rval; break; +case o_mul: val =* rval; break; +case o_div: val =/ rval; break; +case o_mod: val = (i=val) % (i=rval); break; +case o_idiv: val = (i=val) / (i=rval); break; +default: barf ("GETE: bad operator %d", op); break; + } + } + return (val); + } + +/********************************************************************** + + GETP - Read Numeric Primary + + The primary expression is assumed to begin with the + next input character. The primary expression terminates + with the first invalid expression character. Prefix '+', + '-', and '~' are recognized, as are parenthesized expressions. + +**********************************************************************/ + +double getp () + + {double val, factor; + int c, ival; + idn name; + + switch (c = getc2 ()) { + +case '+': return (getp ()); +case '-': return (-getp ()); +case '~': return (val = !fcomp (getp (), 0.0)); +case '(': val = gete (); + if ((c = getc2 ()) != ')') + {error ("missing ')' in expression"); + push_char (c); + } + return (val); + } + + if (c>='0' && c<='9' || c=='.') + {val = 0.0; + while (c>='0' && c<='9') + {val = val*10.0 + (c-'0'); c=getc2();} + if (c=='.') + {c = getc2 (); + factor = .1; + while (c>='0' && c<='9') + {val =+ factor*(c-'0'); + factor =/ 10.0; + c=getc2(); + } + } + push_char (c); + return (val); + } + + if (alpha (c)) + {ac_flush (rd_ac); + while (alpha (c)) + {ac_xh (rd_ac, c); + c = getc2 (); + } + if (c != '!') push_char (c); + name = make_ac_idn (rd_ac); + val = ival = nr_value (name); + if (ftrace >= 0) cprint (ftrace, "(%d)", ival); + return (val); + } + + push_char (c); + return (0.0); + } + +/********************************************************************** + + GETOP - Get Expression Operator + + The operator is assumed to begin with the next character. + If a valid operator is not found, the end-of-expression + operator is returned and the input reset so that that same + character will be next read. If a valid operator is found, + the next input character will be the character following + the operator. + + The recognizer is driven by the table OPCTAB, which lists the + valid first characters of operators. The corresponding table + OPVTAB gives either the value of the single-character operator + (if that is the only operator beginning with that character) + or negative the index into OPCTAB of another list giving the + possible second characters of two-character operators + beginning with that symbol. These lists terminate with 0 if + the single character is not a valid operator or -1 if it is. + +**********************************************************************/ + +int opctab[] { + '*', + '/', + '+', + '-', + '&', + '|', + '%', + '~', + '=', + '<', + '>', + '^', + 0, /* end of first character list */ + '=', /* (13) ~= */ + 0, /* (14) ~ (invalid) */ + '=', /* (15) == */ + 0, /* (16) = (invalid) */ + '=', /* (17) <= */ + -1, /* (18) < */ + '=', /* (19) >= */ + -1, /* (20) > */ + }; + +int opvtab[] { + o_mul, + o_div, + o_add, + o_sub, + o_and, + o_or, + o_mod, + -13, /* ~ */ + -15, /* = */ + -17, /* < */ + -19, /* > */ + o_idiv, + 0, + o_ne, + 0, + o_eq, + 0, + o_le, + o_lt, + o_ge, + o_gt + }; + +int getop () + + {int c1, c2, *p, m, v; + + c1 = getc2 (); + p = opctab; + while (m = *p++) if (c1 == m) + {v = opvtab[p-opctab-1]; + if (v>=0) return (v); + c2 = getc2 (); + p = opctab-v; + while ((m = *p++) > 0) if (c2==m) break; + v = opvtab[p-opctab-1]; + if (c2 == m) return (v); + push_char (c2); + if (m == -1) return (v); + break; + } + push_char (c1); + return (o_end); + } + +/********************************************************************** + + PUSHOP - Push-back expression operator + +**********************************************************************/ + +char *opstab[] { + + "", "+", "-", "*", "/", "&", "|", "==", "~=", "<", "<=", + ">", ">=", "%"}; + +pushop (op) {push_string (opstab[op]);} + +/********************************************************************** + + FCOMP - Floating Point Comparison + + Compare two floating point numbers F1 and F2; return + -1 if F1F2 + +**********************************************************************/ + +int fcomp (f1, f2) double f1, f2; + + {int w; + double m1, m2, m; + + w = f1 < f2; + if (f1<0) m1 = -f1; else m1 = f1; + if (f2<0) m2 = -f2; else m2 = f2; + if (m1= 0) + {c = *p++; + switch (c) { + case '#': --count; c = *p++; + if (c == '0') {cputc ('#', wfile); continue;} + if (c >= '1' && c <= '9') + {c = c-'0'; + while (--c >= 0) cputc ('\\', wfile); + --count; + c = *p++; + } + switch (c) { + case ' ': cputc ('', wfile); + case '.': + case '\'': break; + default: c = c - ('a' - 1); + } + cputc (c, wfile); + continue; + default: if ((c >= 1 && c <= 26) || c == '\\') + cputc ('', wfile); + cputc (c, wfile); + } + } + } + +/********************************************************************** + + FIL_CLOSE - Close open file. + +**********************************************************************/ + +fil_close () + + {if (wfile == OPENLOSS) return; + cclose (wfile); + wfile = OPENLOSS; + } diff --git a/src/r/rfonts.c b/src/r/rfonts.c new file mode 100644 index 00000000..ca6edbee --- /dev/null +++ b/src/r/rfonts.c @@ -0,0 +1,183 @@ +# include "r.h" + +/* + + R Text Formatter + Font Hacking + + Copyright (c) 1976, 1977 by Alan Snyder + + + ROUTINES: + + read_font (n) read in font # n + bool = font_exists (n) does font exist? + s = font_name (n) return font file name + h = font_ha (n) return font height above baseline + h = font_hb (n) return font height below baseline + w = font_width (n, c) return width of char in font + set_font (n, s) set font + n = fontid (ic) parse font identification + fonts_init () initialization routine + +*/ + +fontdes *font_table [max_fonts]; +extern int device; + +/********************************************************************** + + FONTS_INIT - Initialization Routine + +**********************************************************************/ + +int fonts_init () + + {register int i; + + for (i=0;i=max_fonts) + barf ("READ_FONT: bad font number %d", n); + else if (f = font_table[n]) f = rdfont (f); + } + +/********************************************************************** + + FONT_EXISTS - Does Font Exist? + +**********************************************************************/ + +int font_exists (n) + + {if (n<0 || n>=max_fonts) return (FALSE); + return (font_table[n] != 0); + } + +/********************************************************************** + + FONT_NAME - Return FONT file name + +**********************************************************************/ + +char *font_name (n) + + {fontdes *f; + + if (n<0 || n>=max_fonts) + {barf ("FONT_NAME: bad font number %d", n); + return (""); + } + if (f = font_table[n]) return (f->fname); + return (""); + } + +/********************************************************************** + + FONT_HA - Return FONT height above baseline + +**********************************************************************/ + +# ifndef USE_MACROS + +int font_ha (n) + + {if (device == d_lpt) return (1); + if (n<0 || n>=max_fonts) + {barf ("FONT_HA: bad font number %d", n); + return (24); + } + return (font_table[n]->fha); + } + +/********************************************************************** + + FONT_HB - Return FONT height below baseline + +**********************************************************************/ + +int font_hb (n) + + {if (device == d_lpt) return (0); + if (n<0 || n>=max_fonts) + {barf ("FONT_HB: bad font number %d", n); + return (8); + } + return (font_table[n]->fhb); + } + +/********************************************************************** + + FONT_WIDTH - Return width of character in font. + +**********************************************************************/ + +int font_width (n, c) + + {if (device == d_lpt) return (1); + if (n < 0 || n >= max_fonts) + {barf ("FONT_WIDTH: bad font number %d", n); + return (0); + } + return (font_table[n]->fwidths[c]); + } + +# endif /* USE_MACROS */ + +/********************************************************************** + + SET_FONT - Set Font + +**********************************************************************/ + +set_font (n, s) char s[]; + + {if (n<0 || n>=max_fonts) barf ("SET_FONT: bad font number: %d", n); + else + {fontdes *f; + int l; + if ((f = font_table[n]) == 0) + f = font_table[n] = salloc (sizeof(*f)/sizeof(n)); + f->fmode = (n==0 ? f_normal : f_underline); + l = slen (s); + if (l>=3 && s[l-1]==')' && s[l-3]=='(') + {switch (chlower (s[l-2])) { + case 'n': f->fmode = f_normal; break; + case 'u': f->fmode = f_underline; break; + case 'o': f->fmode = f_overprint; break; + case 'c': f->fmode = f_caps; break; + default: error ("bad font mode '%c'", s[l-2]); + } + s[l-3] = 0; + if (l>3 && s[l-4]==' ') s[l-4] = ' '; + } + stcpy (s, f->fname); + } + } + +/********************************************************************** + + FONTID - Convert character to font number + +**********************************************************************/ + +int fontid (c) + ichar c; + + {if (c >= '0' && c <= '9') return (c - '0'); + if (c >= 'A' && c <= 'F') return (c - 'A' + 10); + return (-1); + } + \ No newline at end of file diff --git a/src/r/richar.c b/src/r/richar.c new file mode 100644 index 00000000..2bb4aba6 --- /dev/null +++ b/src/r/richar.c @@ -0,0 +1,100 @@ +# include "r.h" + +/* + + R Text Formatter + Input Character Routines + + Copyright (c) 1976, 1977 by Alan Snyder + + + ROUTINES: + + type = ichar_type (ic) + val = ichar_val (ic) + ic = ichar_cons (type, value) + ichar_print (ic, fd) + + REPRESENTATION OF AN ICHAR: + + An ICHAR is represented as an integer consisting of 2 fields: + + bits 14-9 T (type) + bits 8-0 V (value) + + The possible ICHARs: + + T=0 Text character; V is ASCII code. + T=1 R control character; V is ASCII designation + character. + T>10 An R control character protected by T-10 + protection characters; V is the ASCII designation + character. + +*/ + +# ifndef USE_MACROS + +int ichar_type (ic) {return ((ic>>9) & 077);} +int ichar_val (ic) {return (ic & 0777);} + +int ichar_cons (type, value) + + {if (value>>9) barf ("ICHAR_CONS: bad value %d", value); + if (type>>6) barf ("ICHAR_CONS: bad type %d", type); + return ((type<<9)|value); + } + +# endif + +/********************************************************************** + + ICHAR_PRINT - Print an ICHAR + + Ichar_print prints an ICHAR in a readable form. + +**********************************************************************/ + +ichar_print (ic, fd) + + {int type, val; + + type = (ic>>9) & 077; + val = ic & 0777; + + switch (type) { + +case i_text: switch (val) { + + case ' ': cprint (fd, "b_"); break; + case '\r': cprint (fd, "\\r"); break; + case '\n': cprint (fd, "\\n"); break; + case '\014': cprint (fd, "\\014"); break; + case '^': cprint (fd, "^_"); break; + case '\\': cprint (fd, "\\_"); break; + default: cputc (val, fd); break; + } + break; + +case i_control: + + switch (val) { + + case 'G': break; /* internal: don't print */ + case 'j': cputc ('\n', fd); break; + case ' ': cputc (' ', fd); break; + case 0: cprint (fd, "^@"); break; + default: cputc ('^', fd); cputc (val, fd); break; + } + break; + +default: if (type > i_protect) + {while (type > i_protect) + {cputc ('\\', fd); + --type; + } + ichar_print (ichar_cons (i_control, val), fd); + } + } + } + \ No newline at end of file diff --git a/src/r/ridn.c b/src/r/ridn.c new file mode 100644 index 00000000..10a46709 --- /dev/null +++ b/src/r/ridn.c @@ -0,0 +1,225 @@ +# include "r.h" + +/* + + R Text Formatter + Identifier Cluster + + Copyright (c) 1976, 1977 by Alan Snyder + + + ROUTINES: + + i = make_idn (s) convert CONSTANT string to idn + i = make_ac_idn (ac) convert ac to idn + s = idn_string (i) convert idn to string + idn_init () initialization routine + + REPRESENTATION OF AN IDN: + + An IDN is represented as an integer index into + the array NAMETAB. The NAMETAB entry corresponding + to the integer contains the string form of the + identifier. The string form is related to the + NAMETAB entry using a hash table. + +*/ + +int hash_tab [max_idn]; /* entries initialized to -1 */ +int nidn {0}; /* number of idns */ +int *ehp; /* points to end of hash_tab */ + +char *nametab [max_idn]; /* holds string form of idns */ + +# define BLKSIZE 1024 /* allocation size for cstore */ + +char *ccs {0}; /* points to next unused element of cstore */ +char *ecs {0}; /* points to last element of cstore */ + +int Zncsused {0}; /* size of cstore used */ +int Zncsalloc {0}; /* size of cstore allocated */ +int Zncspure {0}; /* size of pure strings */ + +char ctab[128] { /* for alpha check and case mapping */ + + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + '0', '1', '2', '3', '4', '5', '6', '7', + '8', '9', 0, 0, 0, 0, 0, 0, + 0, 'a', 'b', 'c', 'd', 'e', 'f', 'g', + 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', + 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', + 'x', 'y', 'z', 0, 0, 0, 0, '_', + 0, 'a', 'b', 'c', 'd', 'e', 'f', 'g', + 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', + 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', + 'x', 'y', 'z', 0, 0, 0, 0, 0 + }; + +/********************************************************************** + + IDN_INIT - Initialization Routine + +**********************************************************************/ + +int idn_init () + + {register int i; + + for (i=0;i= 0) + if (stcmp (nametab[v], s)) return (v); + else if (++h >= ehp) h = hash_tab; + + /* not there, so enter it */ + + nametab[v = *h = nidn++] = s; + if (nidn >= max_idn) fatal ("hash table overflow"); + Zncspure =+ sz; + return (v); + } + +/********************************************************************** + + MAKE_AC_IDN - Convert AC to identifier. + +**********************************************************************/ + +idn make_ac_idn (a) + ac a; + + {char *s; + int i, *h, v, sz; + + s = ac_string (a); + i = ihshcopy (s, &sz); + + /* look for identifier in hash table */ + + h = &hash_tab[i % max_idn]; + while ((v = *h) >= 0) + if (stcmp (nametab[v], ccs)) return (v); + else if (++h >= ehp) h = hash_tab; + + /* not there, so enter it */ + + nametab[v = *h = nidn++] = ccs; + ccs =+ sz; + if (nidn >= max_idn) fatal ("hash table overflow"); + Zncsused =+ sz; + return (v); + } + +/********************************************************************** + + IHSHCOPY + +**********************************************************************/ + +int ihshcopy (s, psz) + char *s; + int *psz; + + /* Compute hash code for string. Also copy string to + cstore, converting upper case to lower case. */ + + {char *p, *q; + int i, c, shift; + + q = s; + p = ccs; + shift = i = 0; + while (c = *q++) + {if ((c = ctab[c]) == 0) + {error ("invalid character in name '%s'", s); + c = 'x'; + } + i =+ (c << shift); + if (++shift == 8) shift = 0; + if (p >= ecs) /* leave room for trailing NUL */ + {char *b, *np; + int sz; + sz = max (BLKSIZE, (p-ccs)*2); + np = b = calloc (sz); + Zncsalloc =+ sz; + while (ccs < p) *np++ = *ccs++; + ccs = b; + ecs = ccs + (sz-1); + p = np; + } + *p++ = c; + } + if (i < 0) i = -i; + *p++ = 0; + *psz = p-ccs; + return (i); + } + +/********************************************************************** + + IHASH + +**********************************************************************/ + +int ihash (s, psz) + char *s; + int *psz; + + /* Compute hash code for lower-case string. */ + + {register char *q; + int i, c, shift, sz; + + q = s; + sz = shift = i = 0; + while (c = *q++) + {i =+ (c << shift); + if (++shift == 8) shift = 0; + ++sz; + } + if (i < 0) i = -i; + *psz = sz+1; + return (i); + } + +/********************************************************************** + + IDN_STRING - Get string form of identifier. + +**********************************************************************/ + +# ifndef USE_MACROS + +char *idn_string (i) + + {if (i<0 || i>=nidn) + {barf ("IDN_STRING: bad identifier %d", i); + return ("bad"); + } + return (nametab[i]); + } + +# endif + \ No newline at end of file diff --git a/src/r/rin.c b/src/r/rin.c new file mode 100644 index 00000000..9d2ead54 --- /dev/null +++ b/src/r/rin.c @@ -0,0 +1,533 @@ +# include "r.h" + +/* + + R Text Formatter + Top-Level Input Routines + + Copyright (c) 1976, 1977 by Alan Snyder + + + ROUTINES: + + get_name () => idn read a name + get_optional_name () => idn read an optional name + get_untraced_name () => idn read an optional name (no trace2) + get_hu (d, b) => int read value in HU + get_vu (d, b) => int read value in VU + get_int (d, b) => int read integer + get_fixed (d, b) => int read value in 1/100ths + get_c () => int read text character + get_l () => ic read logical input char + get_string () => ac read string argument + get_text () => ac read text string argument + get_adjust (def) => int read adjustment mode + get_font (def) => n read font designator + check_prefix () check for prefix + check_next (s) => c check validity of next char + ic = skip_blanks () skip input spaces and tabs, return next char + ic = skip_arg () skip until arg terminator + in_init () initialization routine + +*/ + +/********************************************************************** + + WARNING: These routines use floating-point! They expect + the ROUND macro (or routine) to convert floating-point + to integer by rounding. + +**********************************************************************/ + +int allow_neg {FALSE}; /* allow negative VX and HX */ +int inparens; /* expression is in parens */ +ac rd_ac; /* read temp ac */ + +extern env *e; +extern int frozen, nhui, nvui, in_mode, f2trace, ftrace, + no_interpretation; + +/********************************************************************** + + IN_INIT - Initialization Routine + +**********************************************************************/ + +int in_init () + + {rd_ac = ac_alloc (40); + } + +/********************************************************************** + + GET_NAME - Read Name + + Name is assumed to begin with next non-SPACE input character and + be immediately followed by a SPACE or a ^J. Returns -1 if bad + character in name or no name found. An error message is + produced if no name is found. + +**********************************************************************/ + +idn get_name () + + {idn name; /* holds result */ + + name = get_optional_name (); + if (name == -2) + {error ("name not found where expected"); + name = -1; + } + return (name); + } + +/********************************************************************** + + GET_OPTIONAL_NAME - Read Name (Optional) + + Name is assumed to begin with next non-SPACE input character and + be immediately followed by a SPACE or a ^J. Returns -1 if bad + character in name, -2 if no name found. + +**********************************************************************/ + +idn get_optional_name () + + {idn name; + + name = get_untraced_name (); + if (name >= 0 && f2trace >= 0) + cprint (f2trace, " %s", idn_string (name)); + return (name); + } + +/********************************************************************** + + GET_UNTRACED_NAME - Read Name (Optional) + + Like GET_OPTIONAL_NAME except that there is no trace2 output. + +**********************************************************************/ + +idn get_untraced_name () + + {ichar ic; /* current character */ + ichar badc; /* first bad character encountered */ + idn name; /* holds result */ + int oin_mode; /* to restore input mode */ + + ac_flush (rd_ac); + oin_mode = in_mode; + in_mode = m_args; + ic = skip_blanks (); + if (ic == i_newline) /* no name? */ + name = -2; + else + {while ((ic != i_eof) && alpha (ic)) + {ac_xh (rd_ac, ic); + ic = getc2 (); + } + if (!is_terminator (ic)) + {badc = ic; + ic = skip_arg (); + if (!no_interpretation) /* not skipping stmt body */ + error ("invalid character '%i' in name", badc); + name = -1; + } + else name = make_ac_idn (rd_ac); + } + + if (!is_separator (ic)) push_char (ic); /* efficiency hack */ + in_mode = oin_mode; + return (name); + } + +/********************************************************************** + + GET_HU - Read value in Horizontal Units + +**********************************************************************/ + +int get_hu (def, base) + + {double val; + int c, f, ival; + + f = check_prefix (); + if (f==2) return (def); + val = gete (); + c = check_next ("IMC"); + switch (c) { + case 'i': val =* nhui; break; + case 'm': val =* nhui / 1000.; break; + case 'c': val =* nhui / 2.54; break; + default: val =* e->char_width; + } + if (f>0) val=base+val; + else if (f<0) val=base-val; + ival = round (val); + if (ival<0 && !allow_neg) + {error ("negative horizontal distance specification"); + ival = 0; + } + trace_hu (ival); + return (ival); + } + +/********************************************************************** + + GET_VU - Read Value in Vertical Units + +**********************************************************************/ + +int get_vu (def, base) + + {double val; + int c, f, ival; + + f = check_prefix (); + if (f==2) return (def); + val = gete (); + c = check_next ("IMCL"); + switch (c) { + case 'i': val =* nvui; break; + case 'm': val =* nvui / 1000.; break; + case 'c': val =* nvui / 2.54; break; + case 'l': val =* e->default_height * (e->line_spacing / 100.); + break; + default: val =* e->default_height; + } + if (f>0) val = base+val; + else if (f<0) val = base-val; + ival = round (val); + if (ival<0 && !allow_neg) + {error ("negative vertical distance specification"); + ival = 0; + } + trace_vu (ival); + return (ival); + } + +/********************************************************************** + + GET_INT - Read Integer Expression Value + +**********************************************************************/ + +int get_int (def, base) + + {double val; + int f, ival; + + f = check_prefix (); + if (f==2) return (def); + val = gete (); + check_next (0); + if (f>0) val=base+val; + else if (f<0) val=base-val; + ival = round (val); + trace_int (ival); + return (ival); + } + +/********************************************************************** + + GET_FIXED - Read Value in Hundredths + +**********************************************************************/ + +int get_fixed (def, base) + + {double val; + int f, ival; + + f = check_prefix (); + if (f==2) return (def); + val = gete () * 100.; + check_next (0); + if (f>0) val=base+val; + else if (f<0) val=base-val; + ival = round (val); + trace_fixed (ival); + return (ival); + } + +/********************************************************************** + + GET_C - Read one text logical input character, return + the character value. Returns -1 if lossage, -2 + if ^J encountered. + +**********************************************************************/ + +int get_c () + + {int c, oin_mode; + ichar ic; + + oin_mode = in_mode; + if (in_mode > m_args) in_mode = m_args; + if ((ic = skip_blanks ()) == i_newline) + {push_char (ic); + c = -2; + } + else + {trace_character (i_space); + trace_character (ic); + if (ichar_type (ic) != i_text) + {error ("non-text character '%i' where text expected", ic); + c = -1; + } + else c = ichar_val (ic); + } + in_mode = oin_mode; + return (c); + } + +/********************************************************************** + + GET_L - Read one non-space non-^J logical input character, + removing 1 level of protection. Returns -1 if ^J found. + +**********************************************************************/ + +ichar get_l () + + {int oin_mode; + ichar ic; + + oin_mode = in_mode; + in_mode = m_text; + if ((ic = skip_blanks ()) == i_newline) + {push_char (ic); + ic = -1; + } + else + {trace_character (i_space); + trace_character (ic); + ic = unprotect (ic); + } + in_mode = oin_mode; + return (ic); + } + +/********************************************************************** + + GET_STRING - Read String Argument + + The string is assumed to begin with the next non-SPACE input + character and terminate with the next ^J, which is pushed back. + +**********************************************************************/ + +ac get_string () + + {ac s; /* holds the string */ + ichar ic; /* the current char */ + + in_mode = m_text; + s = ac_alloc (20); + ic = skip_blanks (); + trace_character (i_space); + while (ic != i_newline && ic != i_eof) + {trace_character (ic); + append_char (s, ic); + ic = getc2 (); + } + push_char (ic); + return (s); + } + +/********************************************************************** + + GET_TEXT - Read Text String Argument + + The string is assumed to begin with the next non-SPACE input + character and terminate with the next ^J, which is pushed + back. Non-text characters within the string are converted to + text. Return an ASCII string -- NOT ENCODED. + +**********************************************************************/ + +ac get_text () + + {ac s; /* the string */ + ichar ic; /* the current char */ + int val; /* current character value */ + + in_mode = m_args; + s = ac_alloc (20); + ic = skip_blanks (); + trace_character (i_space); + while (ic != i_newline && ic != i_eof) + {trace_character (ic); + if (ic==i_space) ic = ichar_cons (i_text, ' '); + else if (ic==i_tab) ic = ichar_cons (i_text, '\t'); + val = ichar_val (ic); + switch (ichar_type (ic)) { + case i_text: ac_xh (s, val); break; + default: {int t; + t = ichar_type (ic) - i_protect; + while (--t >= 0) ac_xh (s, '\\'); + } /* fall through */ + case i_control: ac_xh (s, '^'); + ac_xh (s, val); + break; + } + ic = getc2 (); + } + push_char (ic); + return (s); + } + +/********************************************************************** + + GET_ADJUST - read adjustment mode + +**********************************************************************/ + +int get_adjust (def) + + {int c; + + if ((c = get_c ()) >= 0) switch (chlower (c)) { + case 'l': return (a_left); + case 'r': return (a_right); + case 'n': /* obsolete */ + case 'b': return (a_both); + case 'c': return (a_center); + default: error ("unrecognized adjust mode '%c'", c); + return (-1); + } + if (c == -2) return (def); + return (-1); + } + +/********************************************************************** + + GET_FONT - read font designator + + Returns -1 in case of loss. + +**********************************************************************/ + +int get_font (def) + + {int oin_mode, f; + ichar ic; + + oin_mode = in_mode; + in_mode = m_args; + if ((ic = skip_blanks ()) == i_newline) + {push_char (ic); + return (def); + } + trace_character (i_space); + trace_character (ic); + in_mode = oin_mode; + f = fontid (ic); + if (f == -1) error ("invalid font specification: %i", ic); + return (f); + } + +/********************************************************************** + + CHECK_PREFIX - Check next input characters for (1) the presence + or absence of a +/- prefix, (2) the presence or absence of an + argument. Leading SPACEs are skipped if not INPARENS. Return: + + -1 - prefix found (and eaten) + 0 no prefix (input reset) + 1 + prefix found (and eaten) + 2 arg found to be missing (spaces eaten) + +**********************************************************************/ + +int check_prefix () + + {int ic; + + in_mode = m_args; + if (inparens) ic = getc2 (); + else ic = skip_blanks (); + if (ic=='+') return (1); + if (ic=='-') return (-1); + push_char (ic); + if (ic==i_newline || ic==i_eof) return (2); + return (0); + } + +/********************************************************************** + + CHECK_NEXT - The next input characters are processed and the + input is advanced until the next character is either a newline, + a NULL, or a SPACE or TAB. If a SPACE or TAB, then the SPACE + or TAB is eaten (unless tracing is on). + + If INPARENS, the input must match a ')', which is eaten. + + If no match set is given or a match set is given but the next + input character does not match, an error message will be + printed if the next character is not a space, a tab, a newline, + or a NULL; the value returned will be 0. If a match set is + given and the next character is in that set, then it will be + skipped and the following input treated as described above; + the returned value will be the character that matched, in + lower case. + +**********************************************************************/ + +int check_next (s) char s[]; + + {int m, val; + ichar ic; + + ic = getc2 (); + val = 0; + if (s) while (m = *s++) if (ic == m || ic == chlower (m)) + {val = chlower (ic); + ic = getc2 (); + break; + } + if (inparens ? ic != ')' : !is_terminator(ic)) + {error ("invalid expression (bad character is '%i')", ic); + if (inparens) return (val); + ic = skip_arg (); + } + if (!inparens && (!is_separator(ic) || ftrace>=0)) push_char (ic); + /* efficiency hack */ + return (val); + } + +/********************************************************************** + + SKIP_BLANKS - Skip Input Spaces and Tabs, Return Next Character + +**********************************************************************/ + +ichar skip_blanks () + + {ichar ic; + while (TRUE) + {ic = getc2 (); + if (!is_separator (ic)) return (ic); + } + } + +/********************************************************************** + + SKIP_ARG - Skip until SPACE, TAB, NEWLINE, or EOF + +**********************************************************************/ + +ichar skip_arg () + + {ichar ic; + + in_mode = m_args; + while (TRUE) + {ic = getc1 (); + if (is_terminator (ic)) return (ic); + } + } + \ No newline at end of file diff --git a/src/r/rin1.c b/src/r/rin1.c new file mode 100644 index 00000000..51b38e9d --- /dev/null +++ b/src/r/rin1.c @@ -0,0 +1,971 @@ +# include "r.h" + +/* + + R Text Formatter + Lowest Level Input Routines + + Copyright (c) 1976, 1977 by Alan Snyder + + + These routines handle multiple input sources. + + ROUTINES: + + set_map (c, d) set mapping of input character + unset_map (c) remove mapping of input character + d = get_map (c) return mapping of input character + getc1 () get next character + getc_notrace () get next character, don't trace it + getc_trace () get next character, trace it + getc_file () get next character from file + getc_char () get next character from character + getc_string () get next character from string + getc_ac () get next character from AC + getc_macro () get next character from macro + getc_peekc () get next character from PEEKC + getc_eof () get next character after EOF + push_file (f, s) push file input source + push_char (c) push character input source + push_string (s) push string input source + push_ac (s) push array of chars input source + push_macro (name, s, argv, n, dotflag) push macro input source + pop_icb () pop top input source + pop_all () pop all input sources + pop_file () pop innermost file input + in_nargs () return number of macro args + i = get_input_type () return current input type + decrement_input_pos () decrement input position in macro + set_exit (f) set exit routine + getfilename () => ac return innermost file name + get_lineno () => ac get line number description + trace_on () turn tracing on + trace_off () turn tracing off + in1_init () initialization routine + +*/ + +# define _ignore -1 /* char should be ignored on input */ +# define _newline -2 /* char indicates end of input line */ + +struct _icb { + int type; /* type of input source */ + char *p; /* current char ptr */ + ac s; /* for AC and MACRO input, also filename */ + int val; /* miscellaneous use */ + int state; /* old READER state or lineno */ + int nlflag; /* next char will be first of input line */ + idn name; /* name of macro */ + int (*exit)(); /* routine to call on exit */ + }; +# define icb struct _icb + +ichar (*pgetc)(); /* current getc routine */ +ichar getc_file(),getc_char(),getc_string(),getc_ac(),getc_macro(), + getc_peekc(),getc_eof(); +ichar (*agetc[])() + {getc_file, + getc_char, + getc_string, + getc_ac, + getc_macro, + getc_peekc, + getc_eof}; + +icb istack[max_icb]; +int icblev {-1}; +int trlev {-1}; /* level last mentioned in trace */ +int exit_called {FALSE}; /* exit macro has been invoked */ +int exiting {FALSE}; /* indicates forced popping of inputs */ +icb *cicb; + +/* + * The current ICB is kept in special variables for faster + * referencing. They are kept in sync by PUSH_ICB and + * POP_ICB. Variables I_P and I_VAL are read and modified + * by RCNTRL, which saves and restores position in macros. + */ + +int i_type, i_val, i_state, i_nlflag; +char *i_p; +ac i_s; +int (*i_exit)(); + +int peekc {-1}; /* lookahead character */ +int no_interpretation {FALSE}; + /* If TRUE, then ^Q, ^A, ^N, ^S, and ^K are not + interpreted. This flag is used for + skipping statement bodies and for parsing \ */ + +ac margs[max_icb][max_args]; /* macro arguments */ +int mdotflag[max_icb]; /* ^A. flag */ +int maclev {0}; + +int ftrace {-1}, f2trace {-1}, etrace {-1}, e2trace {-1}; + +extern int state, in_mode, cin; +extern long Znchar; + +/********************************************************************** + + The mapping from physical input characters to logical + input characters which takes place upon input from files + is represented in the following tables. A physical input + character C may be mapped to either a control character CC + or the text character corresponding to C. If the latter, + then CC_MODE[C]==1000. If the former, then CC_TAB[C]==CC + and CC_MODE[C]== "that input mode needed to recognize CC." + The mapping tables are maintained by the routines + SET_MAP and UNSET_MAP. + +**********************************************************************/ + +ichar cc_tab[0200]; +int cc_mode[0200]; +ichar ec_tab[26]; /* EC_TAB maps escape sequences into ICHARs */ + + /* CC_TYPE gives the type of each control character */ + +int cc_type[0200] { + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + cc_universal /* SPACE */, 0, 0, 0, 0, 0, 0, cc_universal /* ^' */, + 0, 0, 0, 0, 0, 0, cc_universal /* ^. */, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, cc_separator /* ^G */, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, cc_input /* ^\ */, 0, 0, 0, + 0, + cc_input, /* ^a */ + cc_text, /* ^b */ + cc_separator, /* ^c */ + cc_text, /* ^d */ + cc_text, /* ^e */ + cc_text, /* ^f */ + cc_separator, /* ^g */ + cc_text, /* ^h */ + cc_universal, /* ^i */ + cc_universal, /* ^j */ + cc_input, /* ^k */ + 0, /* ^l */ + 0, /* ^m */ + cc_input, /* ^n */ + 0, /* ^o */ + cc_separator, /* ^p */ + cc_input, /* ^q */ + cc_separator, /* ^r */ + cc_input, /* ^s */ + cc_separator, /* ^t */ + cc_text, /* ^u */ + 0, /* ^v */ + cc_separator, /* ^w */ + cc_separator, /* ^x */ + 0, /* ^y */ + cc_text, /* ^z */ + 0, 0, 0, 0, 0}; + +/********************************************************************** + + IN1_INIT - Initialization Routine + +**********************************************************************/ + +in1_init () + + {register int i; + + /* initialization of CC_TAB and CC_MODE */ + + for (i=1;i<=032;++i) /* ^A thru ^Z */ + set_map (i, i+('a'-1)); + for (i=033;i<0200;++i) /* ESC thru DEL */ + unset_map (i); + unset_map (0); /* NUL is text */ + set_map (' ', ' '); /* SPACE char */ + set_map ('\\', '\\'); /* protect char */ + set_map ('.', '.'); /* request char */ + set_map ('\'', '\''); /* no-break request char */ + + /* special system-dependent hacks */ + + cc_tab['\r'] = _ignore; + cc_tab['\n'] = _newline; + cc_tab['\014'] = _ignore; + cc_mode['\r'] = cc_mode['\n'] = cc_mode['\014'] = 0; + + /* initialization of EC_TAB */ + + for (i=0;i<26;++i) ec_tab[i] = _ignore; + ec_tab ['n'-'a'] = ichar_cons (i_text, '\n'); + ec_tab ['r'-'a'] = ichar_cons (i_text, '\r'); + ec_tab ['p'-'a'] = ichar_cons (i_text, '\014'); + } + +/********************************************************************** + + SET_MAP (C, D) + + Adjust the input mapping so that physical input character + C maps to the control character designated by D. + +**********************************************************************/ + +set_map (c, d) + + {int mode; + + if (c == '\r' || c == '\n' || c == '\014') return; + switch (d) { + case 'k': + case 'i': + case ' ': + case '\\': + case 'q': + case 'a': + case 'n': + case 's': mode = m_args; break; + default: mode = m_text; break; + } + + cc_mode[c] = mode; + cc_tab[c] = ichar_cons (i_control, d); + } + +/********************************************************************** + + UNSET_MAP (C) + + Adjust the input mapping so that the physical input + character C maps to the corresponding text character. + +**********************************************************************/ + +unset_map (c) + + {if (c == '\r' || c == '\n' || c == '\014') return; + cc_mode[c] = 1000; + cc_tab[c] = ichar_cons (i_text, c); + } + +/********************************************************************** + + D = GET_MAP (C) + + Returns the mapping of the physical input character C. + If C is mapped to a control character, then the corresponding + designator character is returned. If C is mapped to the + corresponding text input character, then -1 is returned. + +**********************************************************************/ + +int get_map (c) + + {if (cc_mode[c] == 1000) return (-1); + else return (ichar_val (cc_tab[c])); + } + +/********************************************************************** + + GETC1 - Lowest-Level Input Routine + + GETC1 returns the next logical input character, according to + the current mode. It handles multiple input sources and the + recognition of R control characters. The QUOTE control + character is implemented by this routine, as is the backslash + input conventions. + + GETC1 returns an ICHAR; ICHARs are described in a separate + file. + + Peculiarities: The mapping from the physical input alphabet to + the logical input alphabet is performed only on FILE input. In + addition, the recognition of the . and ' control characters + only occurs when the the physical input character begins an + input line. Also, ^K works only in file input. + + In strings, ACs, and MACROs, non-text characters are encoded. + The encoding is as follows: + + control X => #x + text # => #0 + n-protected ^X => #nx (n a digit char) + + Except that: + + control-space => SP + text-space => # SP + + These encodings, and the particular decoding techniques + used, imply that none of the following can be logical + input characters: + + control-digit + + The input routines must guarantee that no such characters + can be created. + + Knowledge of the encodings is also present in RFILE, + RMISC, and RREQ3. + +**********************************************************************/ + +# define getc_notrace() ((*agetc[i_type])()) + +ichar getc_trace () + {ichar ic; + ic = (*agetc[i_type])(); + trace_input_type (); + ichar_print (ic, ftrace); + return (ic); + } + +ichar getc_peekc () + + {i_type = cicb->type; + if (ftrace<0) pgetc = agetc[i_type]; + else pgetc = getc_trace; + return (peekc); + } + +ichar getc_eof () + {if (exit_called) return (ichar_cons (i_control, 0)); + exit_called = TRUE; + push_char (i_newline); + push_string ("exit_macro"); + push_char (i_quote); + return (getc_notrace ()); + } + +/********************************************************************** + + GETC_FILE - read from current file + +**********************************************************************/ + +ichar getc_file () + + {ichar ic; + int c, onlflag, oin_mode, t; + + if ((c = cgetc (i_val)) <= 0 && ceof (i_val)) + {if (!i_nlflag) {i_nlflag = TRUE; return (i_newline);} + pop_icb (); + return (getc_notrace ()); + } + + ++Znchar; + if (i_nlflag) /* at beginning of an input line */ + {onlflag = TRUE; + i_nlflag = FALSE; + ++i_state; + } + else onlflag = FALSE; + + /* now recognize control characters */ + + if (cc_mode[c] > in_mode) return (ichar_cons (i_text, c)); + + /* must be a control character */ + + ic = cc_tab[c]; + for (;;) /* loop for backslash */ + {if (ic == _newline) + {if (i_val==cin && onlflag) + {pop_icb (); + return (getc_notrace ()); + } + i_nlflag = TRUE; + return (i_newline); + } + if (ic == _ignore) return (getc_file ()); + if (ichar_type (ic) != i_control) return (ic); + if ((t = cc_type[ichar_val (ic)]) < cc_universal) + return (ic); + + /* the character is either universal or input */ + + if (t == cc_universal) switch (ic) { + +case i_space: return (i_space); /* here for efficiency */ + +case i_dot: +case i_quote: if (!onlflag) return (ichar_cons (i_text, c)); + +default: return (ic); + } + + switch (ic) { + +case i_comment: if (no_interpretation) return (ic); + while ((c = cgetc (i_val)) > 0 || !ceof (i_val)) + if (c == '\n') + {i_nlflag = TRUE; + if (!onlflag) return (i_newline); + return (getc_file ()); + } + pop_icb (); + return (getc_notrace ()); + +case i_ctrl_q: if (no_interpretation) return (ic); + oin_mode = in_mode; + in_mode = m_quote; + ic = ichar_cons (i_text, getc_file ()); + in_mode = oin_mode; + return (ic); + +case i_ctrl_a: if (no_interpretation) return (ic); + insert_argument (); + return (getc_notrace ()); + +case i_ctrl_s: if (no_interpretation) return (ic); + insert_string (); + return (getc_notrace ()); + +case i_ctrl_n: if (no_interpretation) return (ic); + insert_number (); + return (getc_notrace ()); + +case i_back: ic = process_backslash (onlflag); + continue; + +default: return (ic); + } + } + } + +/********************************************************************** + + PROCESS_BACKSLASH - Process an escape sequence from + the current input file. + + ONLFLAG => the escape sequence begins an input line. + +**********************************************************************/ + +ichar process_backslash (onlflag) + + {register int count, c, x; + ichar ic; + + i_nlflag = onlflag; + count = 1; + while ((c = cgetc (i_val)) > 0 || !ceof (i_val)) + if (cc_tab[c] == i_back) ++count; + else break; + if (ceof (i_val)) + {error ("invalid use of \\: incomplete escape sequence"); + return (getc_file ()); + } + x = chlower (c); + if (x >= 'a' && x <= 'z') /* make escape character */ + {ic = ec_tab[x-'a']; + if (ic == _ignore) + error ("escape sequence \\%c undefined", x); + --count; + } + else + {ungetc (c, i_val); + ++no_interpretation; + ic = getc_file (); + --no_interpretation; + } + return (protect (ic, count)); + } + +/********************************************************************** + + PROTECT - protect a given ICHAR with N levels of protection + +**********************************************************************/ + +ichar protect (ic, n) + ichar ic; + + {if (n <= 0) return (ic); + if (ichar_type (ic) != i_control) + {error ("invalid use of \\: not followed by letter or control character"); + return (_ignore); + } + return (ichar_cons (i_protect+n, ichar_val (ic))); + } + +/********************************************************************** + + UNPROTECT - remove 1 level of protection from a character + +**********************************************************************/ + +ichar unprotect (ic) + ichar ic; + + {register int t; + t = ichar_type (ic); + if (t > i_protect) + {if (--t>i_protect) ic = ichar_cons (t, ichar_val (ic)); + else ic = ichar_cons (i_control, ichar_val (ic)); + } + return (ic); + } + +/********************************************************************** + + GETC_CHAR - read current character + +**********************************************************************/ + +ichar getc_char () + + {ichar ic; + + ic = i_val; + pop_icb (); + return (ic); + } + +/********************************************************************** + + String, Arrays-of-Characters, and Macros require decoding. + The DECODE_CHAR macro does the inline stuff; the DECODE_SHARP + and DECODE_BACKSLASH functions do the special-case stuff + out-of-line. + +**********************************************************************/ + +# define decode_char(c) (c==' '?ichar_cons(i_control,' '):c=='#'?decode_sharp():ichar_cons(i_text,c)) + +ichar decode_sharp () + + {register ichar ic; + + ic = getc_notrace (); + if (ic == i_space) return (ichar_cons (i_text, ' ')); + if (ic>'0' && ic<='9') + return (ichar_cons (i_protect + (ic - '0'), getc_notrace())); + switch (ic) { +case '0': return (ichar_cons (i_text, '#')); +case 'a': if (no_interpretation) break; + insert_argument (); + return (getc_notrace ()); +case 's': if (no_interpretation) break; + insert_string (); + return (getc_notrace ()); +case 'n': if (no_interpretation) break; + insert_number (); + return (getc_notrace ()); + } + return (ichar_cons (i_control, ic)); + } + +/********************************************************************** + + GETC_STRING - read from current string + +**********************************************************************/ + +ichar getc_string () + + {int c; + + if (c = *i_p++) + {++Znchar; + return (decode_char (c)); + } + pop_icb (); + return (getc_notrace ()); + } + +/********************************************************************** + + GETC_AC - read from current array-of-characters + +**********************************************************************/ + +ichar getc_ac () + + {int c; + + if (--i_val < 0) + {pop_icb (); + return (getc_notrace ()); + } + ++Znchar; + c = *i_p++; + return (decode_char (c)); + } + +/********************************************************************** + + GETC_MACRO - read from current macro definition + +**********************************************************************/ + +ichar getc_macro () + + {int c; + + if (--i_val < 0) + {pop_icb (); + return (getc_notrace ()); + } + ++Znchar; + c = *i_p++; + return (decode_char (c)); + } + +/********************************************************************** + + INPUT PUSH ROUTINES + +**********************************************************************/ + +push_file (f, s) /* S is not linked to */ + ac s; + + {push_icb (i_file, 0, s, f, 0); + } + +push_string (s) char s[]; + + {push_icb (i_string, s, 0, 0, -1); + } + +push_ac (s) ac s; + + {int size; + + if (size = ac_size (s)) + push_icb (i_ac, ac_string (s), ac_link (s), size, -1); + } + +push_char (c) + + {int oc; + + if (i_type==i_peekc) + {oc = peekc; + i_type = cicb->type; + push_icb (i_char, 0, 0, oc, -1); + } + cicb->type = i_type; + i_type = i_peekc; + pgetc = getc_peekc; + peekc = c; + } + +push_macro (name, s, argv, n, dotflag) + idn name; + ac s; + ac argv[]; + + {int i, size; + + if (s && (size = ac_size (s))) + {push_icb (i_macro, ac_string (s), ac_link (s), size, state); + for (i=0;iname = name; + } + } + +/********************************************************************** + + PUSH_ICB - Internal Input Push Routine + +**********************************************************************/ + +push_icb (type, p, s, val, st) char *p; ac s; + + {int c; + + if (val == 0 && (type==i_ac || type==i_macro)) return; + /* don't want any null strings */ + + if (type==i_macro) ++maclev; + + if (i_type==i_peekc) + {c = peekc; + i_type = cicb->type; + push_icb (i_char, 0, 0, c, -1); + if (ftrace>=0) pgetc = getc_trace; + } + + if (icblev>=0) + {cicb->type = i_type; + cicb->p = i_p; + cicb->s = i_s; + cicb->val = i_val; + cicb->state = i_state; + cicb->nlflag = i_nlflag; + cicb->exit = i_exit; + } + + if (++icblev >= max_icb) fatal ("input stack overflow"); + cicb = &istack[icblev]; + i_type = type; + i_p = p; + i_s = s; + i_val = val; + i_state = st; + i_nlflag = TRUE; + i_exit = 0; + if (ftrace<0) pgetc = agetc[i_type]; + } + +/********************************************************************** + + POP_ICB - Pop Top Input Source + +**********************************************************************/ + +pop_icb () + + {int i; + int (*exit)(); + ac s; + + if (i_type==i_peekc) i_type=cicb->type; + else if (icblev>=0) + {exit = i_exit; + if (exit) (*exit)(icblev); + if (i_type==i_ac || i_type==i_macro || i_type==i_file) + {if (i_s) ac_unlink (i_s);} + if (i_type==i_macro) + {for (i=0;i= 0) state = i_state; + } + if (i_type==i_file && i_val != cin) cclose (i_val); + if (--icblev>=0) + {cicb = &istack[icblev]; + trlev = -1; + i_type = cicb->type; + i_p = cicb->p; + i_s = cicb->s; + i_val = cicb->val; + i_state = cicb->state; + i_nlflag = cicb->nlflag; + i_exit = cicb->exit; + } + else i_type = i_nomore; + } + if (ftrace<0) pgetc = agetc[i_type]; + else pgetc = getc_trace; + } + +/********************************************************************** + + POP_ALL - Pop all input sources. + +**********************************************************************/ + +pop_all () + + {++exiting; + while (icblev>=0) pop_icb (); + --exiting; + } + +/********************************************************************** + + POP_FILE - Pop the innermost file source. + +**********************************************************************/ + +pop_file () + + {int t; + + ++exiting; + while (icblev>=0) + {t = i_type; + pop_icb (); + if (t == i_file) break; + } + --exiting; + } + +/********************************************************************** + + IN_NARGS - Return the number of arguments provided to + the most recent macro invocation. + +**********************************************************************/ + +int in_nargs () + + {ac *mp; + int i; + + mp = margs[maclev]; + for (i=0;i '0' && c <= '9' && i_p[-1]=='#') + {i_p =- 2; i_val =+ 2;} + } + +/********************************************************************** + + SET_EXIT - set exit routine + +**********************************************************************/ + +set_exit (f) + int (*f)(); + + {i_exit = f;} + +/********************************************************************** + + GETFILENAME - Return the innermost filename as AC + +**********************************************************************/ + +ac getfilename () + + {if (icblev >= 0) + {register int i; + if (i_type!=i_peekc) cicb->type = i_type; + cicb->val = i_val; + cicb->state = i_state; + cicb->s = i_s; + for (i=icblev;i>=0;--i) + {register icb *p; + p = &istack[i]; + if (p->type == i_file) + {if (p->val != cin) + return (ac_link (p->s)); + else return (ac_create ("TTY")); + } + } + } + return (ac_create ("EOF")); + } + +/********************************************************************** + + GET_LINENO - Return line number as AC + +**********************************************************************/ + +ac get_lineno () + + {char buf[500], *r, *s; + int i, first; + icb *p; + + if (icblev<0) s = "EOF"; + else + {s = r = buf; + first = TRUE; + if (i_type!=i_peekc) cicb->type = i_type; + cicb->val = i_val; + cicb->state = i_state; + cicb->s = i_s; + for (i=0;i<=icblev;++i) + {p = &istack[i]; + if (p->type == i_file) + {if (!first) *r++ = ','; + first = FALSE; + if (p->val != cin) + {r = a2a (ac_string(p->s), r); + r = a2a (" (", r); + r = i2a (p->state, r); + *r++ = ')'; + } + else r = a2a ("TTY", r); + } + else if (p->type == i_macro) + {if (!first) *r++ = ','; + first = FALSE; + r = a2a (idn_string (p->name), r); + } + } + *r = 0; + } + return (ac_create (s)); + } + +/********************************************************************** + + TRACE_INPUT_TYPE - trace type of current input + +**********************************************************************/ + +trace_input_type () + + {int t; + if (icblev != trlev) + {switch (i_type) { + case i_file: t = 'F'; break; + case i_char: t = 'C'; break; + case i_string: t = 'S'; break; + case i_ac: t = 'A'; break; + case i_macro: t = 'M'; break; + case i_peekc: return; + case i_nomore: return; + default: t = '?'; break; + } + cprint (ftrace, "[%c]", t); + trlev = icblev; + } + } + +/********************************************************************** + + TRACE_ON - turn on tracing + +**********************************************************************/ + +trace_on () + + {pgetc = getc_trace; + if (ftrace < 0) + {if (etrace < 0) opentrace (); + if (etrace < 0 || e2trace < 0) + fatal ("unable to open trace files"); + ftrace = etrace; + f2trace = e2trace; + tprint ("TRACE ON\n"); + } + } + +/********************************************************************** + + TRACE_OFF - turn tracing off + +**********************************************************************/ + +trace_off () + + {pgetc = agetc[i_type]; + if (ftrace >= 0) + {tprint ("\nTRACE OFF\n"); + ftrace = f2trace = -1; + } + } + \ No newline at end of file diff --git a/src/r/rin2.c b/src/r/rin2.c new file mode 100644 index 00000000..ab841763 --- /dev/null +++ b/src/r/rin2.c @@ -0,0 +1,143 @@ +# include "r.h" + +/* + + R Text Formatter + Input Insertion Routines + + Copyright (c) 1976, 1977 by Alan Snyder + + + These routines handle the insertion of text from number + registers, string registers, and macro arguments. + +*/ + +extern ac margs[max_icb][max_args]; +extern int mdotflag[max_icb]; +extern int maclev, ftrace; + +insert_argument () + + {register ichar ic; + + if (ftrace>=0) cprint (ftrace, "^a"); + ic = getc2 (); + if ((ic>='0' && ic<='9') || ic=='.') + {if (maclev>0) + {if (ic=='.') + {if (mdotflag[maclev]) push_char ('1'); + else push_char ('0'); + } + else + {register ac s; + s = margs[maclev][ic-'0']; + if (s) push_ac (s); + } + } + else error ("invalid macro argument reference (^A): no active macro"); + } + else + {error ("invalid macro argument reference (^A): no argument number"); + push_char (ic); + } + } + +insert_number () + + {ac s; + register ichar ic; + int incr, mode, val; + idn name; + static char r[40]; + + if (ftrace>=0) cprint (ftrace, "^n"); + incr = 0; + mode = 0; + ic = getc2 (); + if (ic == '?') + {mode = '?'; + ic = getc2 (); + } + else + {if (ic == '+' || ic == '-') + {incr = ic; + ic = getc2 (); + } + if (ic == '.' || ic == ':' || ic == ',' || ic == ';') + {mode = ic; + ic = getc2 (); + } + } + s = ac_alloc (20); + while (alpha (ic)) + {ac_xh (s, ic); + ic = getc2 (); + } + if (ic != '!') push_char (ic); + if (ac_size (s) == 0) + {error ("invalid number register reference (^N): no name specified"); + ac_unlink (s); + return; + } + name = make_ac_idn (s); + ac_unlink (s); + if (mode == '?') + push_char (nr_find (name) >= 0 ? '1' : '0'); + else + {switch (incr) { + case '+': val = nr_incr (name); break; + case '-': val = nr_decr (name); break; + default: val = nr_value (name); + } + switch (mode) { + +case '.': i2sr (val, r); break; /* lower case roman numerals */ +case ':': i2r (val, r); break; /* upper case roman numerals */ +case ',': i2al (val, 'a', r); break; /* lower case alpha */ +case ';': i2al (val, 'A', r); break; /* upper case alpha */ +default: i2a (val, r); break; /* arabic */ + } + + s = ac_create (r); + push_ac (s); + ac_unlink (s); + } + } + +insert_string () + + {ac s; + ichar ic; + idn name; + int mode; + + if (ftrace>=0) cprint (ftrace, "^s"); + s = ac_alloc (20); + mode = 0; + ic = getc2 (); + if (ic == '?') + {mode = '?'; + ic = getc2 (); + } + while (alpha (ic)) + {ac_xh (s, ic); + ic = getc2 (); + } + if (ic != '!') push_char (ic); + if (ac_size (s) == 0) + {error ("invalid string register reference (^S): no name specified"); + ac_unlink (s); + return; + } + name = make_ac_idn (s); + ac_unlink (s); + if (mode == '?') + push_char (sr_find (name) >= 0 ? '1' : '0'); + else + {s = sr_value (name); + push_ac (s); + ac_unlink (s); + } + } + \ No newline at end of file diff --git a/src/r/rits.c b/src/r/rits.c new file mode 100644 index 00000000..db8c9cd1 --- /dev/null +++ b/src/r/rits.c @@ -0,0 +1,360 @@ +# include "r.h" +# include "c/c.defs" +# include "c/its.bits" + +/* + + R Text Formatter + ITS Version System-Dependent Code + + Copyright (c) 1977 by Alan Snyder + +*/ + +/* system-dependent values */ + +# define trace1_ext "rta" /* lo-level trace file */ +# define trace2_ext "rtb" /* hi-level trace file */ + +# ifdef USE_PORTABLE_OUTPUT +# define oopn(fname) copen (fname, 'w') /* open output */ +# endif + +/********************************************************************** + + OPENINPUT - Open Input File + +**********************************************************************/ + +int openinput () + + {extern char ofname[], ifname[], *fname; + int f; + + f = copen (fname, 'r'); + if (f==OPENLOSS) f = copen (apfname (ifname, fname, "r"), 'r'); + setfdir (ofname, fname, "DSK:"); /* set device & resolve defaults */ + if (f != OPENLOSS) + {filespec fs; + filnam (itschan (f), &fs); + if (fs.dev == csto6("DSK")) fs.dev=0; + prfile (&fs, ifname); + } + return (f); + } + +/********************************************************************** + + OPENOUTPUT - Open output file. + +**********************************************************************/ + +int openoutput () + + {extern char ofname[]; + extern int device; + char *suffix; + int f; + + switch (device) { + case d_lpt: suffix = "LPT"; break; + case d_xgp: suffix = "XGP"; break; + default: suffix = "LOSER"; + } + apfname (ofname, ofname+4, suffix); /* HACK !!! */ + f = oopn (ofname); + if (f<0) f = oopn ("r.out"); + if (f<0) fatal ("can't open output file"); + return (f); + } + +/********************************************************************** + + OPENREAD - Open "Included" File + +**********************************************************************/ + +int openread (name, realname) char *name, *realname; + + {int fd; + + fd = copen (name, 'r'); + if (fd == OPENLOSS) + {char buffer[FNSIZE]; + setfdir (buffer, name, "DSK:R;"); + fd = copen (buffer, 'r'); + } + if (fd != OPENLOSS) + {filespec fs; + filnam (itschan (fd), &fs); + if (fs.dev == csto6("DSK")) fs.dev=0; + prfile (&fs, realname); + } + return (fd); + } + +/********************************************************************** + + OPENWRITE - Open auxiliary output file. + +**********************************************************************/ + +int openwrite (s) char *s; + + {char buffer[FNSIZE]; + fixfname (s, buffer); + return (copen (buffer, 'w')); + } + +/********************************************************************** + + FIXFNAME - Fix auxiliary file name. If a single name + is given, it is used as a suffix to the output + file name. + +**********************************************************************/ + +fixfname (s, buffer) + char *s, *buffer; + + {extern char ofname[]; + filespec fs; + fparse (s, &fs); + if (fs.dev==0 && fs.dir==0 & fs.fn2==0) + {c6tos (fs.fn1, buffer); + apfname (buffer, ofname, buffer); + } + else prfile (&fs, buffer); + } + +/********************************************************************** + + OPENAPPEND - Open auxiliary output file. + +**********************************************************************/ + +int openappend (s) char *s; + + {char buffer[FNSIZE]; + fixfname (s, buffer); + return (copen (buffer, 'a')); + } + +/********************************************************************** + + OPENSTAT - Open Statistics File + +**********************************************************************/ + +int openstat () + + {int f; + + f = copen ("/dsk/r/r.stat", 'a'); + if (f==OPENLOSS) f = copen ("/dsk/as/r.stat", 'a'); + if (f==OPENLOSS) f = copen ("/dsk/common/r.stat", 'a'); + if (f==OPENLOSS) f = copen ("r.stat", 'a'); + return (f); + } + +/********************************************************************** + + INTERACTIVE - Are we interactive? + +**********************************************************************/ + +int interactive () + + {extern int cout; + return (istty (cout)); + } + +/********************************************************************** + + OPENTRACE - Open trace files. + +**********************************************************************/ + +opentrace () + + {extern char ofname[]; + extern int etrace, e2trace; + char trace1_name[FNSIZE], trace2_name[FNSIZE]; + + apfname (trace1_name, ofname, trace1_ext); + apfname (trace2_name, ofname, trace2_ext); + etrace = copen (trace1_name, 'w'); + e2trace = copen (trace2_name, 'w'); + } + +/********************************************************************** + + USERNAME - Return User Name + +**********************************************************************/ + +# define UXUNAME 074 + +char *username () + + {static char buffer[7]; + c6tos (rsuset (UXUNAME), buffer); + return (buffer); + } + +/********************************************************************** + + GETFDATES - Get File Date and Time from Stream + + Note: the format of dates and times is part of the definition + of R. + +**********************************************************************/ + +getfdates (f) + + {extern ac fdate_ac, ftime_ac; + extern char *months[]; + int q; + + q = rfdate (itschan (f)); + if (q<0) + {ftime_ac = ac_create ("?"); + fdate_ac = ac_create ("?"); + } + else + {char buffer[FNSIZE]; + cal timex; + int i; + f2cal (q, &timex); + i = copen (buffer, 'w', "s"); + prcal (&timex, i); + cclose (i); + ftime_ac = ac_create (buffer+12); + i = copen (buffer, 'w', "s"); + cprint (i, "%d %s %d", timex.day, months[timex.month-1], timex.year); + cclose (i); + fdate_ac = ac_create (buffer); + } + } + +/********************************************************************** + + GETDATES - Get Current Date and Time + + Note: the format of dates and times is part of the definition + of R. + +**********************************************************************/ + +getdates () + + {extern ac date_ac, time_ac, sdate_ac; + extern char *months[]; + extern int rmonth, rday, ryear; + cal timex; + int i; + char buffer[FNSIZE]; + + now (&timex); + rmonth = timex.month; + rday = timex.day; + ryear = timex.year; + i = copen (buffer, 'w', "s"); + prcal (&timex, i); + cclose (i); + buffer[11] = 0; + sdate_ac = ac_create (buffer); + time_ac = ac_create (buffer+12); + i = copen (buffer, 'w', "s"); + cprint (i, "%d %s %d", timex.day, months[timex.month-1], timex.year); + cclose (i); + date_ac = ac_create (buffer); + } + +/********************************************************************** + + SETHANDLER - Setup Interrupt Handler + +**********************************************************************/ + +sethandler () + + {extern int ghandler(); + + on (ctrlg_interrupt, ghandler); /* ^G */ + } + +/********************************************************************** + + RDFONT - Read font file + +**********************************************************************/ + +fontdes *rdfont (f) fontdes *f; + + {int fd, i, h, bl; + filespec fs; + + fparse (f->fname, &fs); + if (fs.dev == 0) fs.dev = csto6 ("DSK"); + if (fs.fn2 == 0) fs.fn2 = csto6 ("KST"); + if (fs.fn1 == 0) fs.fn1 = csto6 ("25VG"); + if (fs.dir == 0) + {fs.dir = rsname (); + i = open (&fs, BII); + if (i<0) + {fs.dir = csto6 ("FONTS"); + i = open (&fs, BII); + } + if (i<0) + {fs.dir = csto6 ("FONTS1"); + i = open (&fs, BII); + } + if (i<0) fs.dir=0; + else close (i); + } + prfile (&fs, f->fname); + fd = copen (f->fname, 'r', "b"); + if (fd<0) + {error ("unable to open font file: %s", f->fname); + return (0); + } + for (i=0;i<0200;++i) f->fwidths[i] = 0; + cgeti (fd); /* KSTID */ + i = cgeti (fd); + h = i & 0777777; + bl = (i >> 18) & 0777; + f->fha = bl + 1; + f->fhb = h - bl - 1; + cgeti (fd); /* first USER ID */ + do + {i = cgeti (fd) & 0777777; /* char code */ + if (i >= 0200) + {error ("font file bad format: %s", f->fname); + cclose (fd); + return (0); + } + f->fwidths[i] = cgeti (fd) & 0777777; + while (((i = cgeti (fd)) & 1) == 0) /* skip matrix */ + if (ceof (fd)) + {error ("font file bad format: %s", + f->fname); + return (0); + } + } while (i != -1); + cclose (fd); + return (f); + } + +/********************************************************************** + + Until the real one shows up... + +**********************************************************************/ + +int alocstat (p, q) + int *p, *q; + + {return (-1);} + \ No newline at end of file diff --git a/src/r/rline.c b/src/r/rline.c new file mode 100644 index 00000000..84bc0ccb --- /dev/null +++ b/src/r/rline.c @@ -0,0 +1,672 @@ +# include "r.h" + +/* + + R Text Formatter + Line Hacking Routines + + Copyright (c) 1976, 1977 by Alan Snyder + + + ROUTINES: + + LineReset () + LineText (w) + LineSpace (width) + LineNLSpace (width) + LineOffset (width) + LineCenter () + LineRight () + LineGlue () + LineIGlue () + LinePos (pos) + LineHPos (pos) + LineTab () + LineTabc (w) + LineNull () + LineBreak () + LineBrkjust () + LineFinish (rc) + + hack_line (a, n, rm) do centering and right-flushing + justify_line (a, n, rm) justify right-margin + append_token (tag, value) append token to current line + find_pos (a, i, n) find POS in line + find_right (a, i, n) find RIGHT in line + length_line (a, i, j) determine width of line + set_line () setup line parameters + +*/ + +extern env *e; + +extern int nsmode, vp, next_page_number, line_length, page_empty, + lvpu; + +/********************************************************************** + + LineReset - Reset environment for new line + +**********************************************************************/ + +LineReset () + + {if (e) + {e->tn = e->ha = e->hb = 0; + e->text_seen = FALSE; + /* the following is just to make HP look reasonable */ + if (e->temp_indent >= 0) e->hp = e->temp_indent; + else e->hp = e->indent; + } + } + +/********************************************************************** + + LineText - add text word to line + +**********************************************************************/ + +LineText (w) + word w; + + {register int i; + e->partial_word = 0; + i = text_width (w); + if (e->text_seen && e->filling && i+e->hp>e->rm) + LineBrkjust (); + if (!e->text_seen) set_line (); + e->hp =+ i; + LIAText (t_text, w); + } + +/********************************************************************** + + LineSpace + +**********************************************************************/ + +LineSpace (width) + int width; + + {e->partial_word = 0; + if (!e->text_seen) set_line (); + append_token (t_space, width); + e->hp =+ width; + } + +/********************************************************************** + + LineNLSpace + +**********************************************************************/ + +LineNLSpace (width) + int width; + + {e->partial_word = 0; + if (!e->text_seen) set_line (); + append_token (t_nlspace, width); + e->hp =+ width; + } + +/********************************************************************** + + LineOffset + +**********************************************************************/ + +LineOffset (width) + int width; + + {e->partial_word = 0; + if (!e->text_seen) set_line (); + if (width < -e->hp) width = -e->hp; + append_token (t_offset, width + (WVMASK+1)/2); + e->hp =+ width; + } + +/********************************************************************** + + LineCenter + +**********************************************************************/ + +LineCenter () + + {e->partial_word = 0; + if (!e->text_seen) set_line (); + append_token (t_center, 0); + } + +/********************************************************************** + + LineRight + +**********************************************************************/ + +LineRight () + + {e->partial_word = 0; + if (!e->text_seen) set_line (); + append_token (t_right, 0); + } + + +/********************************************************************** + + LineGlue + +**********************************************************************/ + +LineGlue () + + {token t; + e->partial_word = PWEATNL|PWCONCAT; + if (!e->text_seen) return; + t = e->line_buf[e->tn-1]; + if (token_type(t)==t_nlspace) + {--e->tn; + e->hp =- token_val(t); + } + } + +/********************************************************************** + + LineIGlue + +**********************************************************************/ + +LineIGlue () + + {e->partial_word =| PWCONCAT; + } + +/********************************************************************** + + LinePos + +**********************************************************************/ + +LinePos (pos) + int pos; + + {e->partial_word = 0; + if (!e->text_seen) set_line (); + if (pos < e->hp) error ("^P position passed"); + e->hp =+ e->space_width; + if (pos > e->hp) e->hp = pos; + append_token (t_pos, e->hp); + } + +/********************************************************************** + + LineHPos + +**********************************************************************/ + +LineHPos (pos) + int pos; + + {e->partial_word = 0; + if (!e->text_seen) set_line (); + e->hp = pos; + append_token (t_hpos, e->hp); + } + +/********************************************************************** + + LineTab + +**********************************************************************/ + +LineTab () + + {e->partial_word = 0; + if (!e->text_seen) set_line (); + e->hp = next_tab (e->hp); + append_token (t_pos, e->hp); + } + +/********************************************************************** + + LineTabc + +**********************************************************************/ + +LineTabc (w) + word w; + + {e->partial_word = 0; + if (!e->text_seen) set_line (); + LIAText (t_tabc, w); + } + +/********************************************************************** + + LIAText - Add text word to line, updating HA and HB + +**********************************************************************/ + +LIAText (t, w) + int t; + word w; + + {register int i; + if ((i=text_ha (w)) > e->ha) e->ha = i; + if ((i=text_hb (w)) > e->hb) e->hb = i; + append_token (t, w); + } + +/********************************************************************** + + LineNull + +**********************************************************************/ + +LineNull () + + {e->partial_word = 0; + if (!e->text_seen) set_line (); + append_token (t_null, 0); + } + +/********************************************************************** + + LineBreak + +**********************************************************************/ + +LineBreak () + + {if (e->text_seen) LineFinish (FALSE); + } + +/********************************************************************** + + LineBrkjust + +**********************************************************************/ + +LineBrkjust () + + {if (e->text_seen) LineFinish (TRUE); + } + +/********************************************************************** + + LineFinish (internal routine) + +**********************************************************************/ + +LineFinish (jflag) + + {nsmode = 'n'; + if (e->filling) trim_spaces (); + if (e->tn == 0) return; + hack_line (e->line_buf, e->tn, e->rm); + if (current_adjust_mode () == a_both && (jflag || !e->filling)) + justify_line (e->line_buf, e->tn, e->rm); + page_empty = FALSE; + if (lvpu+e->ha > vp) vp = lvpu + e->ha; /* prevent overlap */ + output_line (e->line_buf, e->tn, e->ha, e->hb, vp); + lvpu = vp + e->hb; + new_vp (vp + (e->line_spacing * e->default_height + 49)/100); + LineReset (); + } + +/********************************************************************** + + SET_LINE - Set relevant parameters for current line. + +**********************************************************************/ + +set_line () + + {if ((e->hp = e->temp_indent) >= 0) e->temp_indent = -1; + else e->hp = e->indent; + if (e->hp>0) append_token (t_pos, e->hp); + switch (current_adjust_mode ()) { + case a_right: + append_token (t_right, 0); break; + case a_center: + append_token (t_center, 0); break; + } + e->rm = line_length - e->right_indent; + e->text_seen = TRUE; + } + +/********************************************************************** + + TRIM_SPACES - Trim trailing spaces from line. + +**********************************************************************/ + +trim_spaces () + + {register int i, tag; + register token t; + i = e->tn-1; + while (i >= 0) + {t = e->line_buf[i]; + tag = token_type (t); + if (tag != t_space && + tag != t_nlspace && + tag != t_offset) break; + --i; + e->hp =- token_val (t); + } + e->tn = i+1; + } + +/********************************************************************** + + HACK_LINE - HACK CENTERING AND RIGHT-FLUSHING + +**********************************************************************/ + +hack_line (a, n, rm) token a[]; int n, rm; + + {int hp; /* horizontal position */ + int last_pos; /* most recent POS, or 0 */ + token w; /* current token */ + int val; /* value of current token */ + int i, j, k; /* pointers into A */ + int pos; /* next POS, or Right Margin */ + int len1, len2; /* lengths of text in HU */ + int fudge, fudge1; /* fudge factors in HU */ + int slack; /* slack space in HU */ + + hp = 0; + last_pos = 0; + + for (i=0;i=0 && kspace_width, slack); + else if (fudge-fudge1 <= len2) /* overlap on right */ + fudge1 = fudge - (len2 + min (e->space_width, slack)); + + /* replace CENTER with appropriate POS */ + + hp = last_pos + fudge1; + a[i] = token_cons (t_pos, hp); + continue; + +case t_right: j = find_pos (a, i+1, n); + pos = (j>=0 ? token_val (a[j]) : rm); + len1 = length_line (a, i+1, (j<0 ? n-1 : j-1)); + + /* check for overlap */ + + if (pos-hp <= len1) hp =+ e->space_width; + else hp = pos-len1; + a[i] = token_cons (t_pos, hp); + continue; + +case t_null: +case t_tabc: continue; + +default: barf ("HACK_LINE: bad token type %d", token_type (w)); + continue; + + } + } + } + +/********************************************************************** + + JUSTIFY_LINE - Justify Right Margin + +**********************************************************************/ + +justify_line (a, n, rm) token a[]; int n, rm; + + {int j; /* pointer into A */ + int len; /* length of justifiable text */ + int nspaces; /* number of SPACEs in justifiable text */ + token w; /* current token */ + int val; /* value of current token */ + int pos; /* left-most position of justification */ + int text_seen; /* text seen so far in scan */ + int fudge; /* width of SPACE to use up */ + int per; /* basic increment per SPACE */ + int nmore; /* number of SPACEs which get 1 more HU */ + int incr; /* increment to current space width */ + static int spr; /* spread direction: 0 => left */ + + len = 0; + nspaces = 0; + pos = 0; + text_seen = FALSE; + + /* Scan the line from right to left to determine the + justifiable text. Spaces to the right of all text + are converted to nulls. Scanning is terminated by + a POS or HPOS. */ + + for (j=n-1;j>=0;--j) + {w = a[j]; + val = token_val (w); + switch (token_type (w)) { + +case t_text: len =+ text_width (val); + text_seen = TRUE; + continue; + +case t_offset: len =+ val - (WVMASK+1)/2; + continue; + +case t_space: +case t_nlspace: if (!text_seen) a[j] = token_cons (t_null, 0); + else + {len =+ val; + ++nspaces; + } + continue; + +case t_hpos: +case t_pos: pos = val; + break; + +case t_tabc: a[j] = token_cons (t_null, 0); /* meaningless */ +case t_null: continue; + +default: barf ("JUSTIFY_LINE: bad token type %d", token_type (w)); + continue; + } + break; + } + + if (len == 0) return; /* no text to justify */ + + /* Now scan from left to right, removing spaces that are + before the first text word from the justifiable region. */ + + while (++j < n) + {w = a[j]; + switch (token_type (w)) { + case t_text: break; + case t_space: + case t_nlspace: val = token_val (w); + --nspaces; len =- val; pos =+ val; continue; + case t_offset: val = token_val (w) - (WVMASK+1)/2; + pos =+ val; + continue; + case t_null: continue; + default: barf ("JUSTIFY_LINE: bad token type %d", token_type (w)); + continue; + } + break; + } + + fudge = rm - pos - len; /* amount of space to use up */ + + if (fudge==0) return; + if (nspaces==0) + {error ("unable to justify right margin: no justifiable spaces"); + return; + } + if (fudge<0) + {error ("unable to justify right margin: line too long"); + return; + } + + per = fudge / nspaces; + nmore = fudge % nspaces; + + --j; + while (++j < n) /* process SPACEs in justifiable text */ + {int t; + t = token_type (w = a[j]); + if (t == t_space || t == t_nlspace) + {incr = per; + if (spr==0) /* left spread */ + {if (--nmore>=0) ++incr;} + else /* right spread */ + {if (--nspaces < nmore) ++incr;} + a[j] = token_cons (t_space, token_val(w)+incr); + } + } + spr = !spr; + } + +/********************************************************************** + + APPEND_TOKEN - Append token to current line + +**********************************************************************/ + +append_token (tag, value) + int tag, value; + + {if (e->tn >= (max_tokens - 2)) + fatal ("line too long -- line buffer overflow"); + e->line_buf[e->tn++] = token_cons (tag, value); + } + +/********************************************************************** + + FIND_POS - Find first POS token in line A[I:N-1]. + Return -1 if none. + +**********************************************************************/ + +int find_pos (a, i, n) token a[]; + + {while (i 0) while (--diff >= 0) + {outc (ESC); + outc ('u'); + need2 = TRUE; + } + else while (++diff <= 0) + {outc (ESC); + outc ('d'); + need2 = TRUE; + } + ovoff = tvoff; + } + ul = tul; + switch (font_table[tfont]->fmode) { + case f_underline: ul = TRUE; break; + case f_overprint: outc (c); outc ('\b'); break; + case f_caps: if (c>='a' && c<='z') c =- 'a'-'A'; + break; + } + if (ul && c != '_') + {outc ('_'); + outc ('\b'); + } + if (c == ESC) {outc (ESC); need2 = TRUE;} + outc (c); + } + +/********************************************************************** + + LPT_EOW - Output whatever necessary at end of word. + +**********************************************************************/ + +lpt_eow () + + {;} + +/********************************************************************** + + LPT_VP - Output whatever is necessary to set up the + vertical position of the next line at vertical + position POS, having a height above the base + line of HA and a height below the baseline of HB. + +**********************************************************************/ + +lpt_vp (pos, ha, hb) + + {int i; + + if (printing) + {i = pos-olvpu-1; + if (i<0) + while (++i<=0) {outc (ESC); outc ('p'); need2 = TRUE;} + else while (--i>=0) outc ('\n'); + olvpu = pos-1; + } + } + +/********************************************************************** + + LPT_SPACE - Output a space of given width or tab to + the given horizontal position. + +**********************************************************************/ + +lpt_space (width, pos) + + {if (width==0 || !printing) return; + if (width>0) {while (--width>=0) outc (' ');} + else while (++width<=0) outc ('\b'); + } + +/********************************************************************** + + LPT_EOL - Output whatever is necessary to terminate + the current line, which is at vertical position POS + and has height above baseline HA and height below + baseline HB. + +**********************************************************************/ + +lpt_eol (pos, ha, hb) + + {if (printing) + {outc ('\n'); + olvpu = pos+hb; + } + } + +/********************************************************************** + + LPT_EOP - Output whatever is necessary to terminate + the current page. + +**********************************************************************/ + +lpt_eop () + + {if (printing) + {outc ('\014'); + ++Znpage; + olvpu = 0; + } + } + +/********************************************************************** + + LPT_EOF - Output whatever is necessary to terminate + the output file. + +**********************************************************************/ + +lpt_eof () + + {if (need2) cprint ("Note: postprocessing needed.\n");} diff --git a/src/r/rmain.c b/src/r/rmain.c new file mode 100644 index 00000000..8737e3e7 --- /dev/null +++ b/src/r/rmain.c @@ -0,0 +1,438 @@ +# include "r.h" + +/* + + R Text Formatter + Main Program Section + + Copyright (c) 1976, 1977 by Alan Snyder + +*/ + +env *e {0}; /* current environment */ + +ac date_ac, + sdate_ac, + time_ac, + user_ac, + filename_ac, + fdate_ac, + ftime_ac; + +int rmonth, rday, ryear; + +# ifndef unix +char version[5] {'X'}; /* R version name: patched later */ +# endif +# ifdef unix +char version[5] {'2', '9'}; /* for unix where patching is difficult */ +# endif + +int verno; /* R version number */ +char ofname[FNSIZE]; /* output file name buffer */ +char ifname[FNSIZE]; /* input file name buffer */ + +int page_length {infinity}; /* in VU */ +int line_length {infinity}; /* in HU */ +int page_number {1}; +int next_page_number {2}; +int even_page_offset {0}; /* in HU */ +int odd_page_offset {0}; /* in HU */ +int current_page_offset; /* according to page_number */ +int nsmode {'n'}; /* no-space mode */ +int in_mode {m_text}; /* input mode */ + +int lvpu {0}; /* internal last vertical position used: + used to avoid overlap of subscripts and + superscripts */ +int vp {0}; /* VP is the vertical position to + be used for the baseline of the + next line to be output. */ + +int page_empty {TRUE}; /* TRUE if no line yet output on page. */ +int page_started {FALSE}; /* TRUE if NEW_VP has been called on page. + TRUE => input text or break will + cause header macro to be invoked, + if traps are enabled */ + +int traps_enabled {TRUE}; /* TRUE if traps are enabled */ +int temp; /* used by MACRO definitions */ +bits btemp; /* used by MACRO definitions */ +int gflag {FALSE}; /* indicates user ^G interrupt */ + +char *fname {0}; /* input file name */ +int xargc; /* program arg count */ +char **xargv; /* program args */ + +char *months[] { + "January", "February", "March", "April", "May", "June", + "July", "August", "September", "October", "November", "December"}; + +extern int etrace, frozen, cout, fout; + +/* options */ + +int opt_dev {-1}; /* desired output device */ +int debug {FALSE}; /* (user) debug mode */ +int sflag {FALSE}; /* print statistics */ +int tflag {FALSE}; /* start up in trace mode */ + +/* statistics */ + +long Znchar {0}; /* number of input chars read */ +int Znpage {0}; /* number of pages written */ +int Zngc {0}; /* number of GCs */ +int Zngcw {0}; /* number of GC-moved words */ +int gc_time {0}; +int rstart {FALSE}; /* TRUE => program restared */ + +/********************************************************************** + + MAIN - Main Routine + +**********************************************************************/ + +main (argc, argv) int argc; char *argv[]; + + {int f, time; + + time = cputm (); + xargc = --argc; + xargv = ++argv; + + if (fname) /* We have been restarted! */ + {rstart = TRUE; + reinit (); + } + +# ifndef unix + if (argc < 1) + {cprint ("Usage: R input.file\n"); + return; + } +# endif + + process_args (argc, argv); + if (fname == 0) + +# ifndef unix + {cprint ("No file name given.\n"); + return; + } +# endif +# ifdef unix + {f = 0; + filename_ac = ac_create ("tty"); + } +# endif + + else + {f = openinput (); + if (f==OPENLOSS) + {cprint ("Unable to open %s.\n", fname); + return; + } + filename_ac = ac_create (ifname); + } + if (!interactive ()) cprint ("%s:\n", ifname); + init (f); /* initialize the world */ + push_file (f, ac_link (filename_ac)); /* push input file */ + sethandler (); /* set interrupt handler */ + reader (); /* do it ! */ + freeze; /* create output file if not yet done */ + leave_group (0); /* check for unterminated blocks */ + fil_close (); /* close any auxiliary output file */ + output_eof (); /* do any needed output processing */ + ocls (); /* close output file */ + dostat (time); /* output statistics */ + } + +/********************************************************************** + + PROCESS_ARGS - Process Command Arguments + +**********************************************************************/ + +process_args (argc, argv) char **argv; + + {char *s, *is_eq(); + + while (--argc >= 0) + {s = *argv++; + if (s[0] == '-') process_options (s+1); + else if (!is_eq (s)) + {if (fname) cprint ("Extra file name given: %s\n", s); + else fname = s; + } + } + } + +/********************************************************************** + + PROCESS_OPTIONS - Process an options string + +**********************************************************************/ + +process_options (s) char *s; + + {if (s[1] == 0) + {int c; + c = chlower (s[0]); + switch (c) { + case 'd': debug = TRUE; return; + case 's': sflag = TRUE; return; + case 't': tflag = TRUE; return; + } + if (devoption (c)) return; + cprint ("Unrecognized command option: %s\n", s); + } + } + +/********************************************************************** + + IS_EQ - Is the given string an equate? + If it is, return a pointer to the character + following the equal sign. Otherwise, return 0. + +**********************************************************************/ + +char *is_eq (s) + char *s; + + {int c; + + while (c = *s++) if (c == '=') return (s); + return (0); + } + +/********************************************************************** + + REINIT - Initialize on restart + +**********************************************************************/ + +reinit () + + {extern int icblev, trlev, peekc, ftrace, f2trace, + etrace, e2trace, maclev; + fname = 0; + Znchar = 0; + Znpage = Zngc = Zngcw = gc_time = 0; + icblev = trlev = peekc = ftrace = f2trace = etrace = e2trace = -1; + maclev = 0; + } + +/********************************************************************** + + INIT - Main Initialization + +**********************************************************************/ + +init (f) + + {int ichar_print(), ac_puts(), phex(); + char *username(); + + if (!rstart) + {deffmt ('i', ichar_print, 1); /* extend cprint formats */ + deffmt ('a', ac_puts, 1); + deffmt ('x', phex, 1); + setprompt ("r "); /* set default TTY input prompt */ + verno = atoi (version); + } + user_ac = ac_create (username ()); + getfdates (f); + getdates (); + + if (!rstart) + {cntrl_init (); + fil_init (); + fonts_init (); + idn_init (); + in_init (); + in1_init (); + readr_init (); + reg_init (); + req1_init (); + req2_init (); + text_init (); + dev_init (); /* after idn init */ + } + + do_reginit (FALSE); + if (tflag) trace_on (); + } + +/********************************************************************** + + HEADER - Perform Beginning of File Processing + Now that things are frozen. + +**********************************************************************/ + +header () + + {extern int device, nvui, nhui; + int i; + + frozen = TRUE; + if (opt_dev >= 0) device = opt_dev; + if (device != d_lpt) + {for (i=0;i=0) + {extern int name_info[]; + int info; + info = name_info[name]; + if (((info & NRFREEZE) != 0) == freezers) + nr_enter (name, atoi (r)); + } + } + } + } + +/********************************************************************** + + GHANDLER - handler user ^G interrupt + (will cause input to be taken from TTY at next + command reading) + +**********************************************************************/ + +ghandler () + + {gflag = TRUE;} + +/********************************************************************** + + DOSTAT - Do Statistics Hacking + +**********************************************************************/ + +dostat (time) + + {int nsec, n100, rate, gc_1000, f; + + time = cputm () - time; + nsec = time / 60; + n100 = ((time % 60) * 100) / 60; + rate = (Znchar * 60.0) / time; + gc_1000 = (gc_time * 1000.) / time; + f = openstat (); + if (f != OPENLOSS) + {cprint (f, "%2s %s %6s %c%c", + version, ac_string (sdate_ac), ac_string (user_ac), + (etrace>=0 ? 'T' : ' '), (debug ? 'D' : ' ')); +# ifdef unix + printf (f, "%10ld", Znchar); +# endif +# ifndef unix + cprint (f, "%10d", Znchar); +# endif + cprint (f, "c%6dc/s %d.%d%%\t%s\n", rate, + gc_1000/10, gc_1000%10, ofname); + cclose (f); + } +# ifdef unix + printf ("%ld", Znchar); +# endif +# ifndef unix + cprint ("%d", Znchar); +# endif + + cprint (" chars in %d.%d%d sec: %d char/s (%d.%d%% GC)\n", + nsec, n100/10, n100%10, rate, gc_1000/10, + gc_1000%10); + if (sflag) pstat (cout); + } + +/********************************************************************** + + PSTAT - Print extra statistics + +**********************************************************************/ + +pstat (f) + + {extern int name_info[], nidn; + extern ac s_vals[], comtab[]; + extern env *env_tab[]; + extern int Zncspure, Zncsused, Zncsalloc; + + int nmacro, ncmacro, nnr, nsr, ncsr, nenv; + int i, info, nvar, ngroup, nwfree, nwalloc, nblock; + + nmacro = ncmacro = nnr = nsr = ncsr = nenv = 0; + for (i=0;i= 0) + {cprint (f, "Dynamic Storage: %d words used/%d words allocated\n", + nwalloc-nwfree, nwalloc); + cprint (f, "\t%d strings, %d free blocks\n", ac_n(), nblock); + } + cprint (f, "Pages Output: %d\n", Znpage); + } + \ No newline at end of file diff --git a/src/r/rmisc.c b/src/r/rmisc.c new file mode 100644 index 00000000..9cff6784 --- /dev/null +++ b/src/r/rmisc.c @@ -0,0 +1,572 @@ +# include "r.h" + +/* + + R Text Formatter + Miscellaneous Routines + + Copyright (c) 1976, 1977 by Alan Snyder + + + ERROR ROUTINES: + + error (fmt, args...) announce user error + fatal (fmt, args...) announce fatal user error + barf (fmt, args...) announce internal error + bletch (fmt, args...) announce fatal internal error + eprint (fmt, args...) print error message string + eprint_lineno () print error line number + + OTHER ROUTINES: + + hp = next_tab (hp) return next tab stop + chkvoff () check for legitimate voff + x = min (i, j) + x = max (i, j) + bool = alpha (c) is character alphanumeric? + ic = iclower (ic) convert ichar to lower case + c = chlower (c) convert text to lower case + append_char (s, c) append "extended" char to string + append_string (ac, s) append C string to AC + tprint (fmt, args...) print tracing info + scan_macro_def (s, name, term) + scan macro definition + phex (h, f, w) print hexadecimal + i = atoi (s) convert string to integer + i = current_adjust_mode () return current adjust mode + i2al (n, c, s) convert integer to alpha mode + i2r (n, s) convert integer to roman numerals + i2sr (n, s) convert integer to small romans + i2a (n, s) convert integer to ascii + a2a (s, s) move string + + unit conversion routines: + + i = mil2hu (i) convert mils to HU + i = mil2vu (i) convert mils to VU + i = hu2mil (i) convert HU to mils + i = vu2mil (i) convert VU to mils + + trace support routines: + + tr_character (ic) + tr_int (i) + tr_hu (i) + tr_vu (i) + tr_fixed (i) + +*/ + +extern env *e; +extern int in_mode, etrace, e2trace, ftrace, f2trace, cout; +extern char ctab[]; +static char *bufp; + +error (fmt, a1, a2, a3, a4, a5) + + {eprint_lineno (); + eprint ("%s", ": "); + eprint (fmt, a1, a2, a3, a4, a5); + eprint ("\n"); + } + +fatal (fmt, a1, a2, a3, a4, a5) + + {error (fmt, a1, a2, a3, a4, a5); + cprint ("execution aborted"); + cexit (1); + } + +barf (fmt, a1, a2, a3, a4, a5) + + {eprint_lineno (); + eprint ("%s", ": internal error in "); + eprint (fmt, a1, a2, a3, a4, a5); + eprint ("\n"); + if (etrace>=0) stkdmp (etrace); + if (e2trace>=0) stkdmp (e2trace); + stkdmp (cout); + } + +bletch (fmt, a1, a2, a3, a4, a5) + + {barf (fmt, a1, a2, a3, a4, a5); + cprint ("execution aborted"); + cexit (2); + } + +eprint (fmt, a1, a2, a3, a4, a5) + + {cprint (fmt, a1, a2, a3, a4, a5); + if (etrace>=0) + cprint (etrace, fmt, a1, a2, a3, a4, a5); + if (e2trace>=0) + cprint (e2trace, fmt, a1, a2, a3, a4, a5); + } + +eprint_lineno () + + {ac s; + + s = get_lineno (); + ac_puts (s, cout); + if (etrace>=0) + {cprint (etrace, "\n *** "); + ac_puts (s, etrace); + } + if (e2trace>=0) + {cprint (e2trace, "\n *** "); + ac_puts (s, e2trace); + } + ac_unlink (s); + } + +/********************************************************************** + + NEXT_TAB - Return horizontal position of next tab stop + given current horizontal position. Returns + first tab stop >= HP + SPACE_WIDTH; if none, + returns HP + SPACE_WIDTH. + +**********************************************************************/ + +int next_tab (hp) + + {int i, l; + + hp =+ e->space_width; + for (i=0;itab_stops[i]; + if (l == -1) return (hp); + if (l >= hp) return (l); + } + return (hp); + } + +/********************************************************************** + + CHKVOFF + +**********************************************************************/ + +chkvoff () + + {register int v; + + v = e->ivoff; + if (v > max_voff-min_voff) + {error ("too much superscripting"); + e->ivoff = max_voff-min_voff; + } + else if (v < 0) + {error ("too much subscripting"); + e->ivoff = 0; + } + } + +/********************************************************************** + + MAX and MIN + +**********************************************************************/ + +# ifndef USE_MACROS + +int max (i, j) + + {return (i>=j ? i : j); + } + +int min (i, j) + + {return (i<=j ? i : j); + } + +# endif + +/********************************************************************** + + ALPHA - Is character alphanumeric? + +**********************************************************************/ + +# ifndef USE_MACROS + +int alpha (ic) + ichar ic; + + {return (!(ic&~0177) && ctab[ic]);} + +# endif + +/********************************************************************** + + ICLOWER - Convert arbitrary character to lower case + +**********************************************************************/ + +ichar iclower (ic) + ichar ic; + + {if (ichar_type (ic) == i_text) + return (ichar_cons (i_text, chlower (ichar_val (ic)))); + return (ic); + } + +/********************************************************************** + + CHLOWER - Convert text character to lower case + +**********************************************************************/ + +int chlower (c) + + {int x; + if (x = ctab[c]) return (x); + return (c); + } + +/********************************************************************** + + APPEND_CHAR - Append ICHAR onto string + + Protected characters are decremented here. + +**********************************************************************/ + +append_char (s, ic) ac s; ichar ic; + + {register int t, v; + + v = ichar_val (ic); + switch (t = ichar_type (ic)) { + +case i_text: if (v == ' ') ac_xh (s, '#'); + ac_xh (s, v); + if (v == '#') ac_xh (s, '0'); + return; + +default: /* protected control character */ + t =- i_protect; /* number of quoting backslashes */ + --t; /* remove 1 backslash */ + if (t > 0) /* still protected? */ + {ac_xh (s, '#'); + ac_xh (s, '0' + t); + ac_xh (s, v); + return; + } + /* otherwise, it's a normal control character */ + +case i_control: if (v != ' ') ac_xh (s, '#'); + ac_xh (s, v); + return; + } + } + +/********************************************************************** + + APPEND_STRING + +**********************************************************************/ + +append_string (s, r) + ac s; char *r; + + {int c; + + while (c = *r++) append_char (s, c); + } + +/********************************************************************** + + TPRINT - print info on trace files + +**********************************************************************/ + +tprint (fmt, a1, a2, a3, a4, a5) + + {if (ftrace>=0) cprint (ftrace, fmt, a1, a2, a3, a4, a5); + if (f2trace>=0) cprint (f2trace, fmt, a1, a2, a3, a4, a5); + } + +/********************************************************************** + + SCAN_MACRO_DEF - Read in and return macro definition + + This routine is assumed to be called by a request handler. + Thus, the first thing it does is skip past the next newline + character. Then it continues reading until a line containing + an invocation of the terminating macro is found. When it + returns normally, the next input character will be a newline. + The NAME parameter is used only in the "unterminated macro + definition" error message. It may be -1. + +**********************************************************************/ + +scan_macro_def (s, name, term) ac s; idn name, term; + + {ichar ic; /* current char */ + char *sterm; /* terminating string */ + char *p; /* pointer into string for comparison */ + int win; /* boolean indicating success of comparison */ + int nlflag; /* boolean indicating last char was newline */ + int first; /* boolean to prevent extra newline trace */ + ichar leader; /* either ^. or ^' */ + + sterm = idn_string (term); + in_mode = m_quote; + while ((ic = getc2 ()) != i_newline && ic != i_eof); + /* skip end of request */ + trace_character (i_newline); + + nlflag = TRUE; + first = TRUE; + win = TRUE; + + in_mode = m_text; + while (TRUE) + {ic = getc2 (); + if (nlflag) + {if (ic == i_dot || ic == i_quote) + {win = TRUE; + leader = ic; + p = sterm; + } + else + {if (f2trace >= 0 && !first) + trace_character (i_newline); + win = FALSE; + } + } + else if (win && !((p == sterm) && is_separator (ic))) + {char next, *q; + next = *p++; + if (iclower (ic) != next || ic == i_eof) + {if (next==0 && is_terminator (ic)) + {push_char (ic); + push_string (sterm); + push_char (leader); + push_char (i_newline); + return; + } + if (!first) trace_character (i_newline); + append_char (s, leader); + trace_character (leader); + q = sterm; + --p; + while (q < p) + {trace_character (*q); + append_char (s, *q++); + } + win = FALSE; + } + } + if (ic == i_eof) break; + if (ic == i_newline) + {nlflag = TRUE; + first = FALSE; + } + else nlflag = FALSE; + if (!win) + {append_char (s, ic); + if (ic != i_newline) trace_character (ic); + } + } + push_char (i_newline); + if (name >= 0) + error ("missing '.%s' to terminate definition of macro '%s'", + sterm, idn_string (name)); + else error ("missing '.%s'", sterm); + } + +/********************************************************************** + + PHEX - Print hexadecimal digit + +**********************************************************************/ + +phex (h, f, w) + + {if (h>=0 && h<=9) cputc ('0'+h, f); + else if (h>=10 && h<=15) cputc (('A'-10)+h, f); + else cputc ('?', f); + } + +/********************************************************************** + + ATOI - convert string to integer + +**********************************************************************/ + +int atoi (s) char s[]; + + {int i, f, c; + + if (!s) return (0); + i = f = 0; + if (*s == '-') {++s; ++f;} + while ((c = *s++)>='0' && c<='9') i = i*10 + c-'0'; + return (f?-i:i); + } + +/********************************************************************** + + CURRENT_ADJUST_MODE - return current adjustment mode + +**********************************************************************/ + +int current_adjust_mode () + + {if (e->filling) return (e->adjust_mode); + return (e->nofill_adjust_mode); + } + +/********************************************************************** + + I2AL - Convert number to alphabetics. + +**********************************************************************/ + +char *i2al (n, c, buffer) char buffer[]; + + {bufp = buffer; + if (n==0) *bufp++ = '0'; + else + {if (n<0) {*bufp++ = '-'; n = -n;} + i2al1 (n-1, c); + } + *bufp = 0; + return (bufp); + } + +i2al1 (n, c) + + {int i; + + i = n/26; + if (i>0) i2al1 (i-1, c); + *bufp++ = c + n%26; + } + +/********************************************************************** + + I2R - Convert Integer to Roman Numerals + I2SR - Convert Integer to Small Roman Numerals + +**********************************************************************/ + +char *i2r (val, buffer) char buffer[]; + + {bufp = buffer; + if (val==0) *bufp++ = '0'; + else + {if (val<0) {val = -val; *bufp++ = '-';} + i2r1 (val, "IXCM", "VLD"); + } + *bufp = 0; + return (bufp); + } + +char *i2sr (val, buffer) char buffer[]; + + {bufp = buffer; + if (val==0) *bufp++ = '0'; + else + {if (val<0) {val = -val; *bufp++ = '-';} + i2r1 (val, "ixcm", "vld"); + } + *bufp = 0; + return (bufp); + } + +i2r1 (val, p1, p5) char *p1, *p5; + + {int q, r; + + q = val/10; + r = val%10; + if (q > 0) i2r1 (q, p1+1, p5+1); + if (r > 0) + {q = r/5; + r = r%5; + if (r==4) + {*bufp++ = *p1; + if (q==0) *bufp++ = *p5; + else *bufp++ = p1[1]; + } + else + {if (q>0) *bufp++ = *p5; + while (--r >= 0) *bufp++ = *p1; + } + } + } + +/********************************************************************** + + I2A - Convert integer to ASCII + +**********************************************************************/ + +char *i2a (n, buffer) char buffer[]; + + {bufp = buffer; + if (n==0) *bufp++ = '0'; + else + {if (n<0) {*bufp++ = '-'; n = -n;} + i2a1 (n); + } + *bufp = 0; + return (bufp); + } + +i2a1 (n) + + {int i; + + i = n/10; + if (i>0) i2a1 (i); + *bufp++ = '0' + n%10; + } + +/********************************************************************** + + MOVE STRING + +**********************************************************************/ + +char *a2a (s, d) register char *s, *d; + + {while (*d++ = *s++); + return (--d); + } + +/********************************************************************** + + CONVERSION BETWEEN HU, VU AND MILS. + +**********************************************************************/ + +extern int nhui, nvui; +int mil2hu (val) {return (round ((val / 1000.) * nhui));} +int mil2vu (val) {return (round ((val / 1000.) * nvui));} +int hu2mil (val) {return (round ((val * 1000.) / nhui));} +int vu2mil (val) {return (round ((val * 1000.) / nvui));} + +/********************************************************************** + + TRACE SUPPORT ROUTINES + +**********************************************************************/ + +tr_character (ic) {ichar_print (ic, f2trace);} +tr_int (i) {cputc (' ', f2trace); tr_iint (i);} +tr_iint (i) {cprint (f2trace, "%d", i);} +tr_hu (i) {tr_int (hu2mil (i)); cputc ('m', f2trace);} +tr_vu (i) {tr_int (vu2mil (i)); cputc ('m', f2trace);} +tr_fixed (i) + {tr_int (i/100); + cputc ('.', f2trace); + tr_iint ((i%100)/10); + tr_iint (i%10); + } + \ No newline at end of file diff --git a/src/r/rout.c b/src/r/rout.c new file mode 100644 index 00000000..d702d14a --- /dev/null +++ b/src/r/rout.c @@ -0,0 +1,116 @@ +# include "r.h" + +/* + + R Text Formatter + Common Output Routines + + Copyright (c) 1976, 1977 by Alan Snyder + + + ROUTINES: + + output_line (a, n, ha, hb, pos) + bad () detect call before initialization + +*/ + +int fout, /* output file descriptor */ + printing {TRUE}, /* printing mode */ + ofont {0}, /* current output font */ + oul {FALSE}, /* current output underline mode */ + ovoff {-min_voff}, /* current output vertical offset */ + olvpu {0}, /* current output last vertical position used */ + /* used to enforce device constraints, if any */ + ulpos {0}, /* underline position -- + actual init is device-dependent */ + uldpos {0}, /* default underline position */ + ulthick {0}, /* underline thickness */ + uldthick {0}; /* default underline thickness */ + +extern env *e; +extern int current_page_offset; + +/********************************************************************** + + OUTPUT_LINE - Output the line A[N] with height above the + baseline HA, height below the baseline HB, and + vertical position of baseline POS. + Set LVPU to the last vertical position actually used. + Page offset handled by this routine. + +**********************************************************************/ + +output_line (a, n, ha, hb, pos) token a[]; + + {token t; + word tabc; + int hp, lhp, i, val, width, j, frame, d; + + if (!printing) return; + output_vp (pos, ha, hb); + hp = current_page_offset; + lhp = 0; + tabc = -1; + + for (i=0;i lhp) + {width = text_width (tabc); + if (width >= e->space_width) frame=width; + else frame = e->space_width; + d = lhp % frame; + if (d>0 && !isul (tabc)) + {d = frame - d; + output_space (d, lhp+d); + lhp =+ d; + } + j = (hp - lhp) / frame; + d = frame - width; + while (--j >= 0) + {output_text (tabc, lhp); + lhp =+ frame; + if (d>0) output_space (d, lhp); + } + if (hp-lhp >= width) + {output_text (tabc, lhp); + lhp =+ width; + } + } + tabc = -1; + continue; + +case t_tabc: tabc = val; + continue; + +case t_null: continue; + +default: barf ("OUTPUT_LINE: bad token type %d", token_type (t)); + continue; + } + } + + output_eol (pos, ha, hb); + } + \ No newline at end of file diff --git a/src/r/rreadr.c b/src/r/rreadr.c new file mode 100644 index 00000000..240e093b --- /dev/null +++ b/src/r/rreadr.c @@ -0,0 +1,358 @@ +# include "r.h" + +/* + + R Text Formatter + Top-Level Input Reader + + Copyright (c) 1976, 1977 by Alan Snyder + + + ROUTINES: + + reader () top-level reader + inline_macro () process inline macro invocation + readpos () process ^P + readvoff () process ^V + readr_init () initialization routine + +*/ + +int state {0}; /* reader state: + 0 - at beginning of line + 1 - not at beginning of line + */ +int old_state; /* state when current character read */ + +extern env *e; +extern ac rd_ac; +extern int frozen, page_started, vp, nhui, allow_neg, inparens, + in_mode, f2trace, ftrace, gflag, cin, cc_type[], + traps_enabled, icblev, wwval, nsmode, page_empty; + +/********************************************************************** + + READR_INIT - Initialization Routine + +**********************************************************************/ + +int readr_init () + + {;} + +/********************************************************************** + + READER - Top Level Input Reader + +**********************************************************************/ + +reader () + + {LineReset (); + while (TRUE) + {int v, it, i; + ichar ic; + + if (gflag) + {push_file (cin, 0); + gflag = FALSE; + } + + v = ichar_val (ic = getc2 ()); + it = ichar_type (ic); + + if (it == i_control) switch (v) { + + case '.': + case '\'': perform_request (v == '.'); + continue; + + case 0: DoEof (); + if (icblev<0) return; + continue; + } + freeze; + if (!page_started && traps_enabled) + {push_char (ic); + new_vp (vp); /* header macros not called too soon */ + continue; + } + + old_state = state; + state = 1; + + if (it == i_control && cc_type[v] >= cc_separator) switch (v) { + + case 'j': /* newline */ + + /* A newline causes a line-break in nofill or centering mode. In + fill mode, it turns into a space, whose width is determined + by whether the last token on the line is a text word + and on the last character of that text word. The effects + of newline are inhibited if immediately following a ^G. */ + + if ((e->partial_word & PWEATNL) == 0) + {state = 0; + if (e->ivoff > -min_voff) + error ("input line contains unterminated superscripts"); + else if (e->ivoff < -min_voff) + error ("input line contains unterminated subscripts"); + e->ivoff = -min_voff; + if (old_state == 0) + {LineBreak (); + if (nsmode == 'n') new_vp (vp+e->default_height); + } + else if (!e->filling) LineBreak (); + else + {i = 1; + if (e->tn>0 && + token_type(e->line_buf[e->tn-1])==t_text && + e->end_of_sentence) i = 2; + LineNLSpace (i*e->space_width); + } + } + else e->partial_word =& (~PWEATNL); + trace_character (ic); + continue; + + case ' ': /* SPACE */ + + trace_character (ic); + if (old_state==0) LineBreak (); + LineSpace (e->space_width); + continue; + + case 'i': /* TAB */ + + trace_character (ic); + if (old_state==0) LineBreak (); + LineTab (); + continue; + + case 'G': /* internal GLUE -- don't trace */ + + LineIGlue (); + continue; + + case 'g': /* GLUE */ + + trace_character (ic); + LineGlue (); + continue; + + case 'w': /* WORD BREAK */ + + trace_character (ic); + LineNull (); + continue; + + case 'p': /* POS */ + + trace_character (ic); + readpos (); + continue; + + case 'c': /* CENTER */ + + trace_character (ic); + if (old_state == 0) LineBreak(); + LineCenter (); + continue; + + case 'r': /* RIGHT FLUSH */ + + trace_character (ic); + if (old_state == 0) LineBreak(); + LineRight (); + continue; + + case 't': /* SET TAB REPLACEMENT WORD */ + + trace_character (ic); + push_char (build_text_word (getc1 (), -1)); + LineTabc (wwval); + continue; + + case 'x': /* INLINE MACRO INVOCATION */ + + trace_character (ic); + inline_macro (); + continue; + } + + /* processing text */ + + {word w; + + w = -1; + if (e->partial_word) + {token t; + t = e->line_buf[e->tn-1]; + if (token_type (t) == t_text) + {--e->tn; + w = token_val (t); + e->hp =- text_width (w); + } + e->partial_word = 0; + } + ic = build_text_word (ic, w); + if (ic != i_space) push_char (ic); + else trace_character (ic); + LineText (wwval); + /* may cause trap (sets state=0) */ + if (ic == i_space) LineSpace (e->space_width); + /* efficiency hack */ + } + } + } + +/********************************************************************** + + INLINE_MACRO - interpret inline macro invocation + +**********************************************************************/ + +inline_macro () + + {ac argv[max_args]; + int argc, level; + idn name; + ichar ic; + + in_mode = m_text; + ac_flush (rd_ac); + ic = getc2 (); + while (alpha (ic)) + {ac_xh (rd_ac, ic); + trace_character (ic); + ic = getc2 (); + } + if (ac_size (rd_ac) == 0) + {error ("name missing in inline macro invocation (^X)"); + return; + } + name = make_ac_idn (rd_ac); + + argc = 0; + if (ic == '(') + {trace_character (ic); + while ((ic = getc2 ()) != i_eof) + {ac s; + if (ic == i_newline || ic == ')') break; + if (is_separator (ic)) continue; + s = ac_new (); + level = 0; + if (ic == '"') while (TRUE) + {trace_character ('"'); + while ((ic = getc2 ()) != '"' && + ic != i_eof && ic != i_newline) + {trace_character (ic); + append_char (s, ic); + } + if (ic != '"') + error ("unterminated quoted macro argument"); + else + {ic = getc2 (); + if (ic == '"') + {trace_character (ic); + append_char (s, ic); + continue; + } + } + break; + } + else while (ic != i_newline && ic != i_eof) + {if (is_separator (ic) && level<=0) break; + else if (ic == ')') {if (--level<0) break;} + else if (ic == '(') ++level; + trace_character (ic); + append_char (s, ic); + ic = getc2 (); + } + if (is_separator (ic)) trace_character (ic); + else if (ic != ')') push_char (ic); + if (argc= 0) + {ac s; + s = getmd (name); + if (s==0) + error ("macro %s undefined in inline macro invocation (^X)", + idn_string (name)); + else + {e->partial_word =| PWCONCAT; + push_char (i_ictr_g); + push_macro (name, s, argv, argc, 0); + } + } + } + +/********************************************************************** + + READPOS - process ^P + +**********************************************************************/ + +readpos () + + {if (getc2() == '(') + {int i, oin_mode; + oin_mode = in_mode; + trace_character ('('); + ++inparens; + i = get_hu (e->hp, 0); + --inparens; + trace_character (')'); + if (old_state==0) LineBreak (); + LinePos (i); + in_mode = oin_mode; + } + else error ("bad POS (^P) specification"); + } + +/********************************************************************** + + READVOFF - Process ^V + +**********************************************************************/ + +readvoff () + + {if (getc2() == '(') + {int oin_mode; + oin_mode = in_mode; + trace_character ('('); + ++allow_neg; + ++inparens; + e->ivoff = (get_vu (0, e->ivoff+min_voff) - min_voff); + --inparens; + --allow_neg; + trace_character (')'); + in_mode = oin_mode; + } + else error ("bad VOFF (^V) specification"); + } + +/********************************************************************** + + DoEof + +**********************************************************************/ + +DoEof () + + {freeze; + LineBreak (); + if (!page_empty) new_page (); + } + + \ No newline at end of file diff --git a/src/r/rreg.c b/src/r/rreg.c new file mode 100644 index 00000000..abd4f310 --- /dev/null +++ b/src/r/rreg.c @@ -0,0 +1,581 @@ +# include "r.h" + +/* + + R Text Formatter + Register Hacking Routines + + Copyright (c) 1976, 1977 by Alan Snyder + + + ROUTINES: + + nr_find (name) => b is named number register defined? + nr_enter (name, val) define or redefine nr + nr_undef (name) make nr undefined + nr_value (name) => value get value of nr + nr_incr (name) => value increment nr, return new value + nr_decr (name) => value decrement nr, return new value + und_nr (name) print undefined nr error message + bad_nr (name, val) print bad value error message + + sr_find (name) => b is named string register defined? + sr_enter (name, val) define or redefine sr + sr_undef (name) make sr undefined + sr_value (name) => value get value of sr + und_sr (name) print undefined sr error message + reg_init () initialization routine + +*/ + +/********************************************************************** + + Built-in Register Information + +**********************************************************************/ + +/* the following give UIDs for built-in registers */ + +# define r_page 0 +# define r_even 1 +# define r_lpt 2 +# define r_xgp 3 +# define r_pfont 4 +# define r_font 5 +# define r_vpos 6 +# define r_hpos 7 +# define r_vtrap 8 +# define r_ll 9 +# define r_pl 10 +# define r_indent 11 +# define r_rindent 12 +# define r_month 13 +# define r_day 14 +# define r_year 15 +# define r_ls 16 +# define r_debug 17 +# define r_next_page 18 +# define r_spacing 19 +# define r_printing 20 +# define r_vplost 21 +# define r_nargs 22 +# define r_version 23 +# define r_trace 24 +# define r_fill 25 +# define r_adjust 26 +# define r_enabled 27 +# define r_date 28 +# define r_time 29 +# define r_env 30 +# define r_sdate 31 +# define r_lineno 32 +# define r_device 33 +# define r_user 34 +# define r_filename 35 +# define r_fdate 36 +# define r_ftime 37 +# define r_stats 38 +# define r_voff 39 +# define r_habove 40 +# define r_hbelow 41 +# define r_fheight 42 +# define r_varian 43 +# define r_lvpu 44 +# define r_interactive 45 +# define r_cfilename 46 +# define r_page_empty 47 +# define r_fwidth 48 +# define r_end_of_sentence 49 + +/* The following must appear in the same order as the + above UIDs. They give the string names of the + registers, plus the related register info. +*/ + +struct _rginfo { + char *name; + int info; + }; + +# define rginfo struct _rginfo + +rginfo rgtab[] { + "page", NRDEFINED+NRBUILTIN, + "even", NRDEFINED+NRBUILTIN, + "lpt", NRDEFINED+NRBUILTIN+NRFREEZE, + "xgp", NRDEFINED+NRBUILTIN+NRFREEZE, + "pfont", NRDEFINED+NRBUILTIN+NRFREEZE, + "font", NRDEFINED+NRBUILTIN+NRFREEZE, + "vpos", NRDEFINED+NRBUILTIN+NRFREEZE, + "hpos", NRDEFINED+NRBUILTIN+NRFREEZE, + "vtrap", NRDEFINED+NRBUILTIN+NRFREEZE, + "ll", NRDEFINED+NRBUILTIN+NRFREEZE, + "pl", NRDEFINED+NRBUILTIN+NRFREEZE, + "indent", NRDEFINED+NRBUILTIN+NRFREEZE, + "rindent", NRDEFINED+NRBUILTIN+NRFREEZE, + "month", NRDEFINED+NRBUILTIN, + "day", NRDEFINED+NRBUILTIN, + "year", NRDEFINED+NRBUILTIN, + "ls", NRDEFINED+NRBUILTIN+NRFREEZE, + "debug", NRDEFINED+NRBUILTIN, + "next_page", NRDEFINED+NRBUILTIN, + "spacing", NRDEFINED+NRBUILTIN, + "printing", NRDEFINED+NRBUILTIN, + "vplost", NRDEFINED+NRBUILTIN+NRFREEZE, + "nargs", NRDEFINED+NRBUILTIN, + "version", NRDEFINED+NRBUILTIN, + "trace", NRDEFINED+NRBUILTIN, + "fill", NRDEFINED+NRBUILTIN+NRFREEZE, + "adjust", NRDEFINED+NRBUILTIN+NRFREEZE, + "enabled", NRDEFINED+NRBUILTIN, + "date", SRDEFINED+SRBUILTIN, + "time", SRDEFINED+SRBUILTIN, + "env", SRDEFINED+SRBUILTIN+SRFREEZE, + "sdate", SRDEFINED+SRBUILTIN, + "lineno", SRDEFINED+SRBUILTIN, + "device", SRDEFINED+SRBUILTIN+SRFREEZE, + "user", SRDEFINED+SRBUILTIN, + "filename", SRDEFINED+SRBUILTIN, + "fdate", SRDEFINED+SRBUILTIN, + "ftime", SRDEFINED+SRBUILTIN, + "stats", NRDEFINED+NRBUILTIN, + "voff", NRDEFINED+NRBUILTIN+NRFREEZE, + "habove", NRDEFINED+NRBUILTIN+NRFREEZE, + "hbelow", NRDEFINED+NRBUILTIN+NRFREEZE, + "fheight", NRDEFINED+NRBUILTIN+NRFREEZE, + "varian", NRDEFINED+NRBUILTIN+NRFREEZE, + "lvpu", NRDEFINED+NRBUILTIN+NRFREEZE, + "interactive", NRDEFINED+NRBUILTIN, + "cfilename", SRDEFINED+SRBUILTIN, + "page_empty", NRDEFINED+NRBUILTIN, + "fwidth", NRDEFINED+NRBUILTIN+NRFREEZE, + "end_of_sentence", NRDEFINED+NRBUILTIN+NRFREEZE, + 0 + }; + +/* The value tables hold a UID for built-in registers. */ + +int n_vals [max_idn]; /* NR value table */ +ac s_vals [max_idn]; /* SR value table */ + +extern int page_number, device, vp, nvui, nhui, page_length, + next_page_number, debug, nsmode, printing, vplost, + verno, ftrace, line_length, frozen, traps_enabled, + sflag, name_info[], rmonth, rday, ryear, lvpu, + page_empty; +extern env *e; +extern ac date_ac, time_ac, sdate_ac, user_ac, filename_ac, + fdate_ac, ftime_ac; +extern idn dev_tab[]; + +/********************************************************************** + + REG_INIT - Initialization Routine + +**********************************************************************/ + +int reg_init () + + {register int i, info; + char *name; + idn x; + + for (i=0;iindent = mil2hu (val); + return; + case r_rindent: if (val < 0) goto bad; + e->right_indent = mil2hu (val); + return; + case r_ls: if (val < 0) goto bad; + e->line_spacing = val; + return; + case r_next_page: next_page_number = val; return; + case r_spacing: if (val == 0) nsmode = 'n'; + else if (val == 1) nsmode = 's'; + else if (val == 2) nsmode = 'p'; + else goto bad; + return; + case r_printing: printing = val; return; + case r_trace: if (val==1) trace_on (); + else if (val==0) trace_off (); + else goto bad; + return; + case r_fill: if (val==0 || val==1) e->filling=val; + else goto bad; + return; + case r_adjust: if (val<0 || val>a_both) goto bad; + if (e->filling) e->adjust_mode = val; + else e->nofill_adjust_mode = val; + return; + case r_enabled: traps_enabled = (val != 0); return; + case r_stats: sflag = (val != 0); return; + case r_voff: e->ivoff = mil2vu (val) - min_voff; + chkvoff (); + return; + case r_lvpu: lvpu = mil2vu (val); return; + case r_page_empty: + page_empty = (val != 0); return; + case r_end_of_sentence: + e->end_of_sentence = (val != 0); + return; + default: + error ("attempt to redefine built-in number register '%s'", + idn_string (name)); + } + return; +bad: bad_nr (name, val); + } + +/********************************************************************** + + NR_UNDEF - Make NR undefined. + +**********************************************************************/ + +nr_undef (name) + + {name_info[name] =& ~(NRDEFINED+NRBUILTIN+NRFREEZE); + } + +/********************************************************************** + + NR_VALUE - Return value of number register. + +**********************************************************************/ + +int nr_value (name) idn name; + + {int info; + + info = name_info[name]; + if (info & NRBUILTIN) + {if (info & NRFREEZE) freeze; + return (getbnr (name)); + } + if (info & NRDEFINED) return (n_vals[name]); + und_nr (name); + nr_enter (name, 0); + return (0); + } + +/********************************************************************** + + GETBNR - Get value of built-in number register. + +**********************************************************************/ + +int getbnr (name) idn name; + + {switch (n_vals[name]) { + + case r_page: return (page_number); + case r_even: return (!(page_number & 1)); + case r_lpt: return (device == d_lpt); + case r_xgp: return (device == d_xgp); + case r_pfont: return (e->pfont); + case r_font: return (e->ifont); + case r_vpos: return (vu2mil (vp)); + case r_hpos: return (hu2mil (e->hp)); + case r_vtrap: return (vu2mil ((next_trap() - vp))); + case r_ll: return (hu2mil (line_length)); + case r_pl: return (vu2mil (page_length)); + case r_indent: return (hu2mil (e->indent)); + case r_rindent: return (hu2mil (e->right_indent)); + case r_month: return (rmonth); + case r_day: return (rday); + case r_year: return (ryear); + case r_ls: return (e->line_spacing); + case r_debug: return (debug); + case r_next_page: return (next_page_number); + case r_spacing: return (nsmode=='p' ? 2 : (nsmode=='s' ? 1 : 0)); + case r_printing: return (printing); + case r_vplost: return (vu2mil (vplost)); + case r_nargs: return (in_nargs ()); + case r_version: return (verno); + case r_trace: return (ftrace >= 0); + case r_fill: return (e->filling); + case r_adjust: return (e->filling ? e->adjust_mode : + e->nofill_adjust_mode); + case r_enabled: return (traps_enabled); + case r_stats: return (sflag); + case r_voff: return (vu2mil (e->ivoff + min_voff)); + case r_habove: return (vu2mil (e->ha)); + case r_hbelow: return (vu2mil (e->hb)); + case r_fheight: return (vu2mil (e->default_height)); + case r_fwidth: return (hu2mil (e->char_width)); + case r_varian: return (device == d_varian); + case r_lvpu: return (vu2mil (lvpu)); + case r_interactive: + return (interactive () != 0); + case r_page_empty: + return (page_empty); + case r_end_of_sentence: + return (e->end_of_sentence); + default: barf ("GETBNR: bad register name"); + } + return (0); + } + +/********************************************************************** + + NR_INCR - Increment value of number register; return + incremented value. + +**********************************************************************/ + +int nr_incr (name) idn name; + + {int val; + + val = nr_value (name) + 1; + nr_enter (name, val); + return (val); + } + +/********************************************************************** + + NR_DECR - Decrement value of number register; return + decremented value. + +**********************************************************************/ + +int nr_decr (name) idn name; + + {int val; + + val = nr_value (name) - 1; + nr_enter (name, val); + return (val); + } + +/********************************************************************** + + UND_NR - Print undefined number register error message. + +**********************************************************************/ + +und_nr (name) idn name; + + {error ("undefined number register: '%s'", idn_string (name)); + } + +/********************************************************************** + + BAD_NR - Print bad number register value error message. + +**********************************************************************/ + +bad_nr (name, val) idn name; + + {error ("bad value %d specified for built-in number register: '%s'", + val, idn_string (name)); + } + +/********************************************************************** + + SR_FIND - Return 1 if string register is defined; + return -1 if string register is undefined. + +**********************************************************************/ + +int sr_find (name) idn name; + + {return (name_info[name] & SRDEFINED ? 1 : -1);} + +/********************************************************************** + + SR_ENTER - Define or redefine string register; set its value. + (The value reference is moved, not copied.) + +**********************************************************************/ + +sr_enter (name, val) idn name; ac val; + + {int info; + + info = name_info[name]; + if (info & SRBUILTIN) + {if (info & SRFREEZE) freeze; + setbsr (name, val); + } + else + {sr_undef (name); /* throw away any old value */ + name_info[name] =| SRDEFINED; + s_vals[name] = val; + } + } + +/********************************************************************** + + SETBSR - Set value of built-in string register. + +**********************************************************************/ + +setbsr (name, val) idn name; ac val; + + {int uid; + + uid = s_vals[name]; + switch (uid) { + + case r_env: get_env (make_ac_idn (val)); + ac_unlink (val); + return; + + default: + error ("attempt to redefine built-in string register '%s'", + idn_string (name)); + ac_unlink (val); + } + } + +/********************************************************************** + + SR_UNDEF - Make string register undefined. + +**********************************************************************/ + +sr_undef (name) idn name; + + {register int info; + + info = name_info[name]; + if ((info & SRDEFINED) && !(info & SRBUILTIN)) + ac_unlink (s_vals[name]); + name_info[name] =& ~(SRDEFINED+SRBUILTIN+SRFREEZE); + s_vals[name] = 0; + } + +/********************************************************************** + + SR_VALUE - Return value of string register. + +**********************************************************************/ + +ac sr_value (name) idn name; + + {ac s; + int info; + + info = name_info[name]; + if (info & SRBUILTIN) + {if (info & SRFREEZE) freeze; + return (getbsr (name)); + } + if (info & SRDEFINED) return (ac_link (s_vals[name])); + und_sr (name); + sr_enter (name, s = ac_new ()); + return (ac_link (s)); + } + +/********************************************************************** + + GETBSR - Get value of built-in string register. + +**********************************************************************/ + +ac getbsr (name) idn name; + + {int uid; + + uid = s_vals[name]; + switch (uid) { + case r_date: return (ac_link (date_ac)); + case r_time: return (ac_link (time_ac)); + case r_env: return (ac_create (idn_string (e->ename))); + case r_sdate: return (ac_link (sdate_ac)); + case r_lineno: return (get_lineno ()); + case r_device: return (ac_create (idn_string (dev_tab[device]))); + case r_user: return (ac_link (user_ac)); + case r_filename: return (ac_link (filename_ac)); + case r_fdate: return (ac_link (fdate_ac)); + case r_ftime: return (ac_link (ftime_ac)); + case r_cfilename: return (getfilename ()); + + default: barf ("GETBSR: bad register name"); + return (ac_new ()); + } + } + +/********************************************************************** + + UND_SR - Print undefined string register error message. + +**********************************************************************/ + +und_sr (name) idn name; + + {error ("undefined string register: '%s'", + idn_string (name)); + } + + \ No newline at end of file diff --git a/src/r/rreq1.c b/src/r/rreq1.c new file mode 100644 index 00000000..781463bc --- /dev/null +++ b/src/r/rreq1.c @@ -0,0 +1,423 @@ +# include "r.h" + +/* + + R Text Formatter + Request Control + + Copyright (c) 1976, 1977 by Alan Snyder + + + ROUTINES: + + find_env (name) find an environment + make_env (name) make an uninitialized environment + get_env (name) set current environment + copy_env (name) make a copy of the current environment + new_pfont () propagate new principle font + set_current_font (i) set current input font + set_pfont (i) set principal font + perform_request (brk) + def_com (name, routine) define request + getmd (name) get macro definition (or 0) + req1_init () +*/ + +int name_info [max_idn]; + +struct _ienv { + int old_line_spacing; + int old_indent; + int old_right_indent; + int old_adjust_mode; + int font_ring[FRSIZE]; + int cfont; + }; + +# define ienv struct _ienv + +int comtab[max_idn]; /* request and macro table */ +int frozen {FALSE}; +idn com {-1}; /* current request name */ + /* -1 if not in request routine */ + +ienv *ie; +ienv *oie; +ienv *ienv_tab[max_env]; + +env *env_tab[max_env]; /* table of environments */ + +extern env *e; +extern int page_number, page_started, vp, line_length, + ec_tab[], in_mode, traps_enabled, f2trace, cout, vsp; + +/********************************************************************** + + REQ1_INIT - Initialization Routine + +**********************************************************************/ + +int req1_init () + + {register int i; + extern int und_com (); + + for (i=0;iename==name) return (i); + return (-1); + } + +/********************************************************************** + + MAKE_ENV - Create a new uninitialized environment. + Return its index. + +**********************************************************************/ + +int make_env (name) idn name; + + {int i; + + if ((i = find_env (name)) >= 0) + {barf ("MAKE_ENV: environment already exists"); + return (i); + } + + for (i=0;iename = name; + return (i); + } + + fatal ("too many environments"); + } + +/********************************************************************** + + EXPUNGE_ENV - Expunge environment + +**********************************************************************/ + +expunge_env (name) idn name; + + {int i; + + if ((i = find_env (name)) < 0) + {error ("no environment %s", idn_string (name)); + return; + } + + if (e == env_tab[i]) /* environment is current */ + e->delflag = TRUE; + else + {extern env *old_env; + if (old_env == env_tab[i]) old_env = 0; + sfree (env_tab[i]); + sfree (ienv_tab[i]); + env_tab[i] = ienv_tab[i] = 0; + } + } + +/********************************************************************** + + GET_ENV - Select Environment, Create If Necessary. + +**********************************************************************/ + +env *get_env (name) idn name; + + {int i, j, flag; + env *old_e; + + flag = FALSE; + i = find_env (name); + if (i == -1) /* must create one */ + {i = make_env (name); + flag = TRUE; + } + old_e = e; + e = env_tab[i]; + ie = ienv_tab[i]; + if (old_e && old_e != e && old_e->delflag) expunge_env (old_e->ename); + if (!flag) return (e); + + /* initialize the new environment */ + + e->line_spacing = 100; + e->indent = e->right_indent = e->partial_word = 0; + e->adjust_mode = a_both; + e->nofill_adjust_mode = a_left; + e->filling = TRUE; + e->temp_indent = -1; + e->ivoff = -min_voff; + e->rm = line_length; + e->iul = e->text_seen = e->delflag = FALSE; + e->tn = e->ha = e->hb = e->hp = e->pfont = e->ifont = 0; + new_pfont (); + for (j=0;jtab_stops[j] = j*8*e->char_width; + + ie->old_line_spacing = e->line_spacing; + ie->old_indent = e->indent; + ie->old_right_indent = e->right_indent; + ie->old_adjust_mode = e->adjust_mode; + for (j=0;jfont_ring[j] = 0; + ie->cfont = 0; + return (e); + } + +/********************************************************************** + + COPY_ENV - Make a copy of the current environment + +**********************************************************************/ + +copy_env (name) + + {int i, *p, *q, n; + + if (e->ename == name) return; + i = find_env (name); + if (i == -1) i = make_env (name); + + p = e; + q = env_tab[i]; + n = sizeof(*e)/sizeof(i); + while (--n >= 0) *q++ = *p++; + + p = ie; + q = ienv_tab[i]; + n = sizeof(*ie)/sizeof(i); + while (--n >= 0) *q++ = *p++; + + env_tab[i]->ename = name; /* don't change name! */ + } + +/********************************************************************** + + NEW_PFONT - Update ENV to reflect new PFONT + +**********************************************************************/ + +new_pfont () + + {register int f, i, j; + + f = e->pfont; + e->default_height = font_ha (f) + font_hb (f) + vsp; + i = e->space_width = font_width (f, ' '); + j = font_width (f, '0'); + if (j > i) i = min (j, 2*i); + e->char_width = i; + } + +/********************************************************************** + + SET_CURRENT_FONT - Set Current Input Font + + Set the current input font to the specified font number. + If the given number is -1000, reset the current input font + to the previous input font. Emit an error message if the + specified font does not exist. + +**********************************************************************/ + +popfont () + + {register int f; + f = ie->font_ring[ie->cfont]; + if (--ie->cfont < 0) ie->cfont = FRSIZE-1; + return (f); + } + +pushfont (n) + + {if (++ie->cfont >= FRSIZE) ie->cfont=0; + ie->font_ring[ie->cfont] = n; + } + +set_cfont (n) + + {if (font_exists (n)) e->ifont = n; + else error ("undefined font %x selected", n); + } + +set_pfont (n) + + {if (font_exists (n)) + {e->pfont = n; + new_pfont (); + } + } + +/********************************************************************** + + PERFORM_REQUEST + + Read request name and execute corresponding request routine. + If at the beginning of an output page and the request will + cause a line-break and traps are enabled, reset the world and + do a NEW_VP to enable any header macros. + +**********************************************************************/ + +perform_request (brk) + + {int (*f)(), info; + idn lcom; + ichar ic; + + in_mode = m_args; + if ((lcom = get_untraced_name ()) >= 0) + {info = name_info[lcom]; + f = comtab[lcom]; + if ((info & RQBREAK) && brk) + {freeze; + if (!page_started && traps_enabled) /* headers */ + {push_char (i_space); + push_string (idn_string (lcom)); + push_char (i_dot); + new_vp (vp); /* can invoke trap macro */ + return; + } + else if (e->text_seen) + {push_char (i_space); + push_string (idn_string (lcom)); + push_char (i_quote); + LineBreak (); /* can invoke trap macro */ + return; + } + } + if (f2trace>=0) + cprint (f2trace, "%i%s", brk ? i_dot : i_quote, + idn_string (lcom)); + com = lcom; + if (info & RQMACRO) mac_com (brk); + else + {if (info & RQFREEZE) freeze; + if (info & RQTHAW) not_frozen; + (*f)(); /* execute request routine */ + } + com = -1; + } + in_mode = m_quote; + while ((ic = getc2 ()) != i_newline && ic != i_eof); + in_mode = m_text; + if (lcom>=0) trace_character (i_newline); + } + +/********************************************************************** + + DEF_COM - Define Command (Performed at Initialization Only) + +**********************************************************************/ + +def_com (s, f, info) char s[]; int (*f)(); + + {idn name; + + name = make_idn (s); + comtab[name] = f; + name_info[name] =| info; + } + +/********************************************************************** + + MAC_COM - Macro Command (Invoke macro COM) + +**********************************************************************/ + +mac_com (brk) + + {ac argv[max_args], s; + int argc; + ichar ic; + + argc = 0; + in_mode = m_text; + + while ((ic = getc2 ()) != i_newline && ic!=i_eof) + {if (is_separator (ic)) continue; + trace_character (i_space); + s = ac_new (); + if (ic == '"') while (TRUE) + {trace_character ('"'); + while ((ic = getc2 ()) != '"' && + ic != i_eof && ic != i_newline) + {trace_character (ic); + append_char (s, ic); + } + trace_character (ic); + if (ic != '"') + error ("unterminated quoted macro argument"); + else + {ic = getc2 (); + if (ic == '"') + {append_char (s, ic); + continue; + } + } + break; + } + else while (!is_terminator (ic)) + {trace_character (ic); + append_char (s, ic); + ic = getc2 (); + } + if (!is_separator (ic)) push_char (ic); /* efficiency hack */ + if (argcname) {def_com (name, p->f, p->info); ++p;} + } + +/********************************************************************** + + REQUEST ROUTINES + +**********************************************************************/ + +pl_com () + + {extern int page_length; + + page_length = get_vu (11*nvui, page_length); + } + +bp_com () + + {int n; + n = get_int (07777, page_number); + if (n != 07777) next_page_number = n; + if (nsmode != 'p' || n != 07777) new_page (); + } + +pn_com () + + {extern int next_page_number; + int i; + + i = get_int (-1000, page_number); + if (i>=0) next_page_number = i; + } + +eo_com () + + {extern int even_page_offset, current_page_offset; + int i; + + i = get_hu (old_even_page_offset, even_page_offset); + old_even_page_offset = even_page_offset; + even_page_offset = i; + if ((page_number&1)==0) current_page_offset = even_page_offset; + } + +oo_com () + + {extern int odd_page_offset, current_page_offset; + int i; + + i = get_hu (old_odd_page_offset, odd_page_offset); + old_odd_page_offset = odd_page_offset; + odd_page_offset = i; + if (page_number&1) current_page_offset = odd_page_offset; + } + +ne_com () + + {int d; + + d = get_vu (e->default_height, 0); + if (next_trap()-vp < d) new_vp (vp+d); + } + +br_com () + + {;} + +bj_com () + + {LineBrkjust ();} + +fi_com () + + {int mode; + e->filling = TRUE; + if ((mode = get_adjust (-1)) >= 0) e->adjust_mode = mode; + } + +nf_com () + + {int mode; + e->filling = FALSE; + if ((mode = get_adjust (-1)) >= 0) e->nofill_adjust_mode = mode; + } + +ls_com () + + {int n; + + n = get_fixed (ie->old_line_spacing, e->line_spacing); + if (n<0) error ("negative line spacing"); + else + {ie->old_line_spacing = e->line_spacing; + e->line_spacing = n; + } + } + +sp_com () + + {int d; + d = get_vu (e->default_height, 0); + if (nsmode == 'n') new_vp (vp+d); + } + +hp_com () + + {LineHPos (get_hu (0, e->hp)); + } + +hs_com () + + {allow_neg = TRUE; + LineOffset (get_hu (0, 0)); + allow_neg = FALSE; + } + +vp_com () + + {new_vp (get_vu (0, 0)); + } + +ns_com () + + {extern int nsmode; + int c; + + c = get_c (); + switch (c) { + + case 's': + case 'S': + case -2: + case ' ': if (nsmode != 'p') nsmode = 's'; break; + + case 'p': + case 'P': nsmode = 'p'; break; + + default: error ("unrecognized no-space mode '%c'", c); + } + } + +rs_com () + + {extern int nsmode; + + nsmode = 'n'; + } + +ll_com () + + {int d; + + d = get_hu (old_line_length, line_length); + old_line_length = line_length; + line_length = d; + } + +in_com () + + {int d; + + d = get_hu (ie->old_indent, e->indent); + ie->old_indent = e->indent; + e->indent = d; + } + +ti_com () + + {int d; + + d = get_hu (e->char_width, e->indent); + e->temp_indent = d; + } + +ir_com () + + {int d; + + d = get_hu (ie->old_right_indent, e->right_indent); + ie->old_right_indent = e->right_indent; + e->right_indent = d; + } + +eq_com () + + {idn source, dest; + int info; + + dest = get_name (); + source = get_name (); + if (source >= 0 && dest >= 0 && source != dest) + {info = name_info[source] & RQBITS; + name_info[dest] =& ~RQBITS; + name_info[dest] =| info; + if (info & RQMACRO) comtab[dest] = ac_link (comtab[source]); + else comtab[dest] = comtab[source]; + } + } + +de_com () + + {idn name; /* macro name */ + idn term; /* macro terminator */ + ac s; /* will hold macro definition */ + + term = em_idn; + name = get_name (); + + if (name>=0) + {idn temp; + temp = get_optional_name (); + if (temp >= 0) term = temp; + if (name_info[name] & RQMACRO) ac_unlink (comtab[name]); + } + s = ac_alloc (200); + scan_macro_def (s, name, term); + if (name>=0) + {comtab[name] = ac_trim (s); + name_info[name] =& ~RQBITS; + name_info[name] =| RQMACRO; + } + else ac_unlink (s); + } + +am_com () + + {idn name; /* macro name */ + idn term; /* macro terminator */ + ac s; /* will hold macro definition */ + + term = em_idn; + name = get_name (); + if (name<0 || (name_info[name] & RQMACRO) == 0) + s = ac_new (); + else s = comtab[name]; + if (name >= 0) + {idn temp; + temp = get_optional_name (); + if (temp >= 0) term = temp; + } + scan_macro_def (s, name, term); + if (name>=0) + {comtab[name] = s; + name_info[name] =& ~RQBITS; + name_info[name] =| RQMACRO; + } + else ac_unlink (s); + } + +rm_com () + + {idn name; /* macro name */ + + name = get_name (); + if (name>=0 && (name_info[name] & RQMACRO)) + {ac_unlink (comtab[name]); + comtab[name] = und_com; + name_info[name] =& ~RQBITS; + } + } + +st_com () + + {idn name; /* macro name */ + int v; /* trap position */ + + name = get_name (); + v = get_vu (0, 0); + if (name >= 0) add_trap (name, v); + } + +rt_com () + + {idn name; /* macro name */ + int v; /* trap position (if specified) */ + + name = get_name (); + v = get_vu (-1, 0); + if (name >= 0) rem_trap (name, v); + } + +ct_com () + + {idn name; /* macro name */ + int v; /* new trap position */ + int v1; /* old trap position */ + + name = get_name (); + if (name >= 0) + {if ((v1 = find_trap (name)) >= 0) + {v = get_vu (0, v1); + rem_trap (name, v1); + add_trap (name, v); + } + else error ("no trap to macro '%s'", idn_string (name)); + } + } + +cc_com () + + {int d, c; + + d = get_c (); + c = get_c (); + if (c>=0 && d>=0) set_map (c, chlower (d)); + } + +nc_com () + + {int c; + + c = get_c (); + if (c>=0) unset_map (c); + } + +ec_com () + + {int c; + ichar ic; + + c = get_c (); + if (c >= 0) + {c = chlower (c); + if (c >= 'a' && c <= 'z') + {ic = get_l (); + if (ic != -1) ec_tab [c - 'a'] = ic; + else error ("second argument to EC request missing"); + } + else error ("non-alphabetic escape character designator"); + } + else error ("arguments to EC request missing"); + } + +tr_com () + + {register int c1, c2; + + c1 = get_c (); + if (c1 >= 0) + {c2 = get_c (); + if (c2 < 0) c2 = ' '; + trt[c1] = c2; + } + } + +ev_com () + + {idn name; + + name = get_optional_name (); + if (name >= 0) + {old_env = e; + oie = ie; + get_env (name); + } + else if (name == -2) + {if (old_env) + {e = old_env; + ie = oie; + } + } + } + +xe_com () + + {idn name; + + name = get_optional_name (); + if (name == -1) return; + if (name == -2) name = e->ename; + expunge_env (name); + } + +es_com () + + {idn name; + + name = get_name (); + if (name >= 0) copy_env (name); + } + +ex_com () + + {pop_all (); + push_char (i_newline); + } + +ta_com () + + {int i, h; + + for (i=0;itab_stops[i] = h; + } + while (itab_stops[i++] = -1; + } + +xc_com () + + {ac s; + ichar ic; + + s = ac_new (); + append_char (s, i_dot); + in_mode = m_text; + ic = skip_blanks (); + while (ic != i_newline && ic != i_eof) + {append_char (s, ic); + ic = getc2 (); + } + append_char (s, i_newline); + push_ac (s); + ac_unlink (s); + push_char (ic); + } + +uo_com () + + {allow_neg = TRUE; + ulpos = get_vu (uldpos, 0); + allow_neg = FALSE; + } + +ut_com () + + {ulthick = get_vu (uldthick, 0); + } + +wf_com () + + {fil_open (FALSE); + } + +wa_com () + + {fil_open (TRUE); + } + +we_com () + + {fil_close (); + } + +ws_com () + + {ac s; + + s = get_string (); + fil_write (s); + ac_unlink (s); + } + +wl_com () + + {ac s; + + s = get_string (); + append_char (s, i_newline); + fil_write (s); + ac_unlink (s); + } + +wm_com () + + {idn name; + + name = get_name (); + if (name >= 0) + {if (name_info[name] & RQMACRO) + fil_write (comtab[name]); + else error ("macro %s undefined", idn_string (name)); + } + } + +___com () + + {;} + +int be_com(), bk_com(), ef_com(), en_com(), fr_com(), if_com(), wh_com(); +int sb_com(), sc_com(), si_com(), sl_com(), nr_com(), xn_com(), sr_com(); +int xs_com(), nd_com(), sd_com(), nv_com(), sv_com(), hx_com(), vx_com(); +int hv_com(), vv_com(), dv_com(), fo_com(), fs_com(); +int so_com(), nx_com(), tm_com(), rl_com(), rd_com(); + +rqinfo rqtab[] { + "am", am_com, 0, + "be", be_com, 0, + "bj", bj_com, 0, + "bk", bk_com, 0, + "bp", bp_com, RQBREAK+RQFREEZE, + "br", br_com, RQBREAK, + "cc", cc_com, 0, + "ct", ct_com, RQFREEZE, + "de", de_com, 0, + "dv", dv_com, RQTHAW, + "ec", ec_com, 0, + "ef", ef_com, 0, + "em", ___com, 0, + "en", en_com, 0, + "eo", eo_com, RQFREEZE, + "eq", eq_com, 0, + "es", es_com, RQFREEZE, + "ev", ev_com, RQFREEZE, + "ex", ex_com, 0, + "fi", fi_com, RQBREAK+RQFREEZE, + "fo", fo_com, RQTHAW, + "fr", fr_com, 0, + "fs", fs_com, RQFREEZE, + "hp", hp_com, RQFREEZE, + "hs", hs_com, RQFREEZE, + "hv", hv_com, RQFREEZE, + "hx", hx_com, RQFREEZE, + "if", if_com, 0, + "in", in_com, RQBREAK+RQFREEZE, + "ir", ir_com, RQBREAK+RQFREEZE, + "ll", ll_com, RQFREEZE, + "ls", ls_com, RQFREEZE, + "nc", nc_com, 0, + "nd", nd_com, 0, + "ne", ne_com, RQBREAK+RQFREEZE, + "nf", nf_com, RQBREAK+RQFREEZE, + "nr", nr_com, 0, + "ns", ns_com, 0, + "nv", nv_com, 0, + "nx", nx_com, 0, + "oo", oo_com, RQFREEZE, + "pl", pl_com, RQFREEZE, + "pn", pn_com, 0, + "rd", rd_com, 0, + "rl", rl_com, 0, + "rm", rm_com, 0, + "rs", rs_com, RQBREAK, + "rt", rt_com, RQFREEZE, + "sb", sb_com, 0, + "sc", sc_com, 0, + "sd", sd_com, 0, + "si", si_com, 0, + "sl", sl_com, 0, + "so", so_com, 0, + "sp", sp_com, RQBREAK+RQFREEZE, + "sr", sr_com, 0, + "st", st_com, RQFREEZE, + "sv", sv_com, 0, + "ta", ta_com, RQFREEZE, + "ti", ti_com, RQBREAK+RQFREEZE, + "tm", tm_com, 0, + "tr", tr_com, 0, + "uo", uo_com, RQFREEZE, + "ut", ut_com, RQFREEZE, + "vp", vp_com, RQBREAK+RQFREEZE, + "vv", vv_com, RQFREEZE, + "vx", vx_com, RQFREEZE, + "wa", wa_com, 0, + "we", we_com, 0, + "wf", wf_com, 0, + "wh", wh_com, 0, + "wl", wl_com, 0, + "wm", wm_com, 0, + "ws", ws_com, 0, + "xc", xc_com, 0, + "xe", xe_com, RQFREEZE, + "xn", xn_com, 0, + "xs", xs_com, 0, + "exit_macro", ___com, 0, + 0}; + diff --git a/src/r/rreq3.c b/src/r/rreq3.c new file mode 100644 index 00000000..aa5bee9f --- /dev/null +++ b/src/r/rreq3.c @@ -0,0 +1,429 @@ +# include "r.h" + +/* + + R Text Formatter + More Request Handlers + + Copyright (c) 1976, 1977 by Alan Snyder + + +*/ + +extern int allow_neg, device, cin, cout; +extern env *e; +ichar svscan (); + +dv_com () + + {idn name; + int i; + extern idn dev_tab[]; + + name = get_name (); + if (name < 0) return; + for (i=0;i= 0) set_font (n, ac_string (s)); + ac_unlink (s); + } + +fs_com () + + {int n; + + n = get_font (-1000); + if (n != -1) + {if (n == -1000) n = popfont (); + else pushfont (e->ifont); + set_cfont (n); + set_pfont (n); + } + } + +so_com () + + {ac s; + int f; + char buffer[FNSIZE]; + + s = get_text (); + getc1 (); + f = openread (ac_string (s), buffer); + if (f != OPENLOSS) push_file (f, ac_create (buffer)); + else error ("unable to open '%a'", s); + ac_unlink (s); + push_char (i_newline); + } + +nx_com () + + {ac s; + int f; + char buffer[FNSIZE]; + + s = get_text (); + pop_file (); + if (ac_size (s) > 0) + {f = openread (ac_string (s), buffer); + if (f != OPENLOSS) push_file (f, ac_create (buffer)); + else error ("unable to open '%a'", s); + } + ac_unlink (s); + push_char (i_newline); + } + +tm_com () + + {ac s; + + s = get_text (); + cprint ("%a\n", s); + ac_unlink (s); + } + +rl_com () + + {idn name; /* string register being defined */ + ac s; /* message printed */ + char buf[200]; /* input */ + + name = get_name (); + s = get_text (); + if (name >= 0) + {cprint ("%a", s); + gets (buf); + sr_enter (name, ac_create (buf)); + } + ac_unlink (s); + } + +rd_com () + + {ac s; + + s = get_text (); + getc1 (); + if (ac_size (s) > 0) cprint ("%a\n", s); + else cputc (07, cout); + push_file (cin, 0); + push_char (i_newline); + ac_unlink (s); + } + +nr_com () + + {idn name; /* number register name */ + int n; /* new value */ + + name = get_name (); + n = get_int (0, 0); + if (name >= 0) nr_enter (name, n); + } + +xn_com () + + {idn name; /* number register name */ + + name = get_name (); + if (name >= 0) nr_undef (name); + } + +sr_com () + + {idn name; /* string register name */ + ac s; /* new value */ + + name = get_name (); + s = get_string (); + if (name >= 0) sr_enter (name, ac_trim (s)); + else ac_unlink (s); + } + +xs_com () + + {idn name; /* string register name */ + + name = get_name (); + if (name >= 0) sr_undef (name); + } + +nd_com () + + {idn name; /* number register name */ + int n; /* new value */ + + name = get_name (); + n = get_int (0, 0); + if (name >= 0 && nr_find (name) < 0) nr_enter (name, n); + } + +sd_com () + + {idn name; /* string register name */ + ac s; /* new value */ + + name = get_name (); + s = get_string (); + if (name >= 0 && sr_find (name) < 0) sr_enter (name, ac_trim (s)); + else ac_unlink (s); + } + +nv_com () + + {idn name; /* number register name */ + int n; /* new value */ + + name = get_name (); + n = get_int (0, 0); + if (name >= 0) nv_define (name, n); + } + +sv_com () + + {idn name; /* string register name */ + ac s; /* new value */ + + name = get_name (); + s = get_string (); + if (name >= 0) sv_define (name, s); + else ac_unlink (s); + } + +hx_com () + + {register idn name, val; + + name = get_name (); + val = rdhx (); + if (name >= 0) nr_enter (name, hu2mil (val)); + } + +hv_com () + + {register idn name, val; + + name = get_name (); + val = rdhx (); + if (name >= 0) nv_define (name, hu2mil (val)); + } + +int rdhx() + + {register int sum, h; + sum = 0; + allow_neg = TRUE; + while ((h = get_hu (-infinity, 0)) != -infinity) sum =+ h; + allow_neg = FALSE; + return (sum); + } + +vx_com () + + {register idn name, val; + + name = get_name (); + val = rdvx (); + if (name >= 0) nr_enter (name, vu2mil (val)); + } + +vv_com () + + {register idn name, val; + + name = get_name (); + val = rdvx (); + if (name >= 0) nv_define (name, vu2mil (val)); + } + +int rdvx() + + {register int sum, v; + sum = 0; + allow_neg = TRUE; + while ((v = get_vu (-infinity, 0)) != -infinity) sum =+ v; + allow_neg = FALSE; + return (sum); + } + +sb_com () + + {idn dest, source; + int index, length, srclen; + ac d, src; + char *s, *end; + + dest = get_name (); + if (dest == -1) return; + source = get_name (); + if (source == -1) return; + index = get_int (1, 0); + length = get_int (infinity, 0); + src = sr_value (source); + srclen = ac_size (src); + s = ac_string (src); + end = s + srclen; + d = ac_new (); + if (length > 0) + {int i; + if (index < 1) index = 1; + i = 1; + while (i < index) + if (svscan (&s, end) == -1) break; + else ++i; + while (length > 0) + {ichar c; + c = svscan (&s, end); + if (c == -1) break; + append_char (d, c); + --length; + } + } + sr_enter (dest, d); + ac_unlink (src); + } + +si_com () + + {idn dest, source, pattern; + int skip, index; + ac src, pat; + char *s, *p, *se, *pe; + + dest = get_name (); + if (dest == -1) return; + pattern = get_name (); + if (pattern == -1) return; + source = get_name (); + if (source == -1) return; + skip = get_int (0, 0); + src = sr_value (source); + pat = sr_value (pattern); + s = ac_string (src); + p = ac_string (pat); + se = s + ac_size (src); + pe = p + ac_size (pat); + + index = 1; + ac_unlink (src); + ac_unlink (pat); + if (skip < 0) skip = 0; + while (s < se) + {char *ts, *tp; + ichar cs, cp; + ts = s; + tp = p; + while (TRUE) + {cs = svscan (&ts, se); + cp = svscan (&tp, pe); + if (cs != cp || cp == -1) break; + } + if (cp == -1) + if (--skip < 0) + {nr_enter (dest, index); + return; + } + ++index; + svscan (&s, se); + } + nr_enter (dest, 0); + } + +sc_com () + + {idn dest, source1, source2; + int len1, len2; + ac s1, s2; + char *p1, *p2; + + dest = get_name (); + if (dest == -1) return; + source1 = get_name (); + if (source1 == -1) return; + source2 = get_name (); + if (source2 == -1) return; + s1 = sr_value (source1); + s2 = sr_value (source2); + len1 = ac_size (s1); + len2 = ac_size (s2); + p1 = ac_string (s1); + p2 = ac_string (s2); + ac_unlink (s1); + ac_unlink (s2); + nr_enter (dest, svcomp (p1, p2, len1, len2)); + } + +svcomp (p1, p2, len1, len2) + char *p1, *p2; + + {char *e1, *e2; + + e1 = p1+len1; + e2 = p2+len2; + while (TRUE) + {ichar c1, c2; + c1 = svscan (&p1, e1); + c2 = svscan (&p2, e2); + if (c1 != c2) + {if (c1 < c2) return (-1); + return (1); + } + if (c1 == -1) return (0); + } + } + +sl_com () + + {idn dest, source; + ac src; + char *s, *end; + int len; + + dest = get_name (); + if (dest == -1) return; + source = get_name (); + if (source == -1) return; + src = sr_value (source); + s = ac_string (src); + end = s + ac_size (src); + len = 0; + while (svscan (&s, end) != -1) ++len; + ac_unlink (src); + nr_enter (dest, len); + } + +ichar svscan (s, end) + char **s, *end; + + {int c; + if (*s >= end) return (-1); + c = *(*s)++; + if (c == '#') + {c = *(*s)++; + if (c == '0') return (ichar_cons (i_text, '#')); + if (c > '0' && c <= '9') + {int n; + n = c - '0'; + c = *(*s)++; + return (ichar_cons (i_protect + n, c)); + } + if (c == ' ') return (ichar_cons (i_text, ' ')); + return (ichar_cons (i_control, c)); + } + if (c == ' ') return (ichar_cons (i_control, ' ')); + return (ichar_cons (i_text, c)); + } + + \ No newline at end of file diff --git a/src/r/rt20.c b/src/r/rt20.c new file mode 100644 index 00000000..6d68f6ac --- /dev/null +++ b/src/r/rt20.c @@ -0,0 +1,337 @@ +# include "r.h" + +/* + + R Text Formatter + TOPS-20 Version System-Dependent Code + + Copyright (c) 1977, 1978 by Alan Snyder + +*/ + +/* system-dependent values */ + +# define trace1_ext "rta" /* lo-level trace file */ +# define trace2_ext "rtb" /* hi-level trace file */ + +struct _cal {int year, month, day, hour, minute, second;}; +# define cal struct _cal + +/********************************************************************** + + Default output routines + +**********************************************************************/ + +# ifdef USE_PORTABLE_OUTPUT + +extern int fout; +outc(c) {cputc ((c), fout);} /* output ascii char */ +outi(c) {cputc ((c) | 0400, fout);} /* output image char */ +outs(str) {cprint (fout, "%s", (str));} /* output string */ +ocls() {cclose (fout);} /* close output */ +oopn(fname) {return (copen (fname, 'w'));} /* open output */ + +# endif + +/********************************************************************** + + OPENINPUT - Open Input File + +**********************************************************************/ + +int openinput () + + {extern char ofname[], ifname[], *fname; + int f; + + f = copen (fname, 'r'); + if (f == OPENLOSS) + {fnsdf (ifname, fname, 0, 0, "OUTPUT", "R", 0, 0); + f = copen (ifname, 'r'); + } + if (f == OPENLOSS) return (f); + SYSJFNS (mkbptr (ifname), cjfn (f), 0211110000001); + fnsfd (ofname, ifname, "", 0, 0, "", "", ""); + fnsdf (ofname, ofname, 0, 0, "OUTPUT", 0, 0, 0); + return (f); + } + +/********************************************************************** + + OPENOUTPUT - Open output file. + +**********************************************************************/ + +int openoutput () + + {extern char ofname[]; + extern int device; + char *suffix; + int f; + + switch (device) { + case d_lpt: suffix = "LPT"; break; + case d_xgp: suffix = "XGP"; break; + default: suffix = "LOS"; + } + fnsfd (ofname, ofname, 0, 0, 0, suffix, 0, 0); + f = oopn (ofname); + if (f == OPENLOSS) f = oopn ("r.out"); + if (f == OPENLOSS) fatal ("can't open output file"); + return (f); + } + +/********************************************************************** + + OPENREAD - Open "Included" File + +**********************************************************************/ + +int openread (name, realname) char *name, *realname; + + {int fd; + + fd = copen (name, 'r'); + if (fd == OPENLOSS) + {char buffer[FNSIZE]; + fnsdf (buffer, name, 0, "R", 0, 0, 0, 0); + fd = copen (buffer, 'r'); + } + if (fd != OPENLOSS) + SYSJFNS (mkbptr (realname), cjfn (fd), 0211110000001); + return (fd); + } + +/********************************************************************** + + OPENWRITE - Open auxiliary output file. + +**********************************************************************/ + +int openwrite (suffix) char *suffix; + + {extern char ofname[]; + char buffer[FNSIZE]; + + fnsfd (buffer, ofname, 0, 0, 0, suffix, 0, 0); + return (copen (buffer, 'w')); + } + +/********************************************************************** + + OPENAPPEND - Open auxiliary output file. + +**********************************************************************/ + +int openappend (suffix) char *suffix; + + {extern char ofname[]; + char buffer[FNSIZE]; + + fnsfd (buffer, ofname, 0, 0, 0, suffix, 0, 0); + return (copen (buffer, 'a')); + } + +/********************************************************************** + + OPENSTAT - Open Statistics File + +**********************************************************************/ + +int openstat () + + {int f; + + f = copen ("r.stat", 'a'); + if (f==OPENLOSS) f = copen ("r.stat", 'a'); + if (f==OPENLOSS) f = copen ("r.stat", 'a'); + return (f); + } + +/********************************************************************** + + INTERACTIVE - Are we interactive? + +**********************************************************************/ + +int interactive () + + {extern int cout; + return (istty (cout)); + } + +/********************************************************************** + + OPENTRACE - Open trace files. + +**********************************************************************/ + +opentrace () + + {extern char ofname[]; + extern int etrace, e2trace; + char trace1_name[FNSIZE], trace2_name[FNSIZE]; + + fnsfd (trace1_name, ofname, 0, 0, 0, trace1_ext, 0, 0); + fnsfd (trace2_name, ofname, 0, 0, 0, trace2_ext, 0, 0); + etrace = copen (trace1_name, 'w'); + e2trace = copen (trace2_name, 'w'); + } + +/********************************************************************** + + USERNAME - Return User Name + +**********************************************************************/ + +char *username () + + {static char buffer[30]; + int un, p; + + p = &un; + p =| 0777777000000; + SYSGJI (-1, p, 2); /* GETJI - read user number */ + SYSDIRST (mkbptr (buffer), un); + return (buffer); + } + +/********************************************************************** + + GETFDATES - Get File Date and Time from Stream + + Note: the format of dates and times is part of the definition + of R. + +**********************************************************************/ + +getfdates (f) + + {extern ac fdate_ac, ftime_ac; + extern char *months[]; + int q; + + SYSRTAD (cjfn (f), &q, 1); + if (q == -1) + {ftime_ac = ac_create ("?"); + fdate_ac = ac_create ("?"); + } + else + {char buffer[FNSIZE]; + cal timex; + int i; + t2cal (q, &timex); + i = copen (buffer, 'w', "s"); + prcal (&timex, i); + cclose (i); + ftime_ac = ac_create (buffer+12); + i = copen (buffer, 'w', "s"); + cprint (i, "%d %s %d", timex.day, months[timex.month-1], timex.year); + cclose (i); + fdate_ac = ac_create (buffer); + } + } + +/********************************************************************** + + GETDATES - Get Current Date and Time + + Note: the format of dates and times is part of the definition + of R. + +**********************************************************************/ + +getdates () + + {extern ac date_ac, time_ac, sdate_ac; + extern char *months[]; + extern int rmonth, rday, ryear; + cal timex; + int i; + char buffer[FNSIZE]; + + i = SYSGAD (); + t2cal (i, &timex); + rmonth = timex.month; + rday = timex.day; + ryear = timex.year; + i = copen (buffer, 'w', "s"); + prcal (&timex, i); + cclose (i); + buffer[11] = 0; + sdate_ac = ac_create (buffer); + time_ac = ac_create (buffer+12); + i = copen (buffer, 'w', "s"); + cprint (i, "%d %s %d", timex.day, months[timex.month-1], timex.year); + cclose (i); + date_ac = ac_create (buffer); + } + +/********************************************************************** + + SETHANDLER - Setup Interrupt Handler + +**********************************************************************/ + +sethandler () + + {/* extern int ghandler(); + + on (ctrlg_interrupt, ghandler) */; /* ^G */ + } + +/********************************************************************** + + RDFONT - Read font file + +**********************************************************************/ + +fontdes *rdfont (f) fontdes *f; + + {int fd, i, h, bl; + char buffer[FNSIZE]; + + /* NEED ITS SYNTAX FOR OUTPUT FILE! */ + + fnsdf (buffer, f->fname, 0, 0, "25VG", "KST", 0, 0); + fd = copen (f->fname, 'r', "b"); + if (fd == OPENLOSS) + {fnsdf (buffer, buffer, 0, "FONTS", 0, 0, 0, 0); + fd = copen (buffer, 'r', "b"); + if (fd == OPENLOSS) + {fnsdf (buffer, buffer, 0, "FONTS1", 0, 0, 0, 0); + fd = copen (buffer, 'r', "b"); + if (fd == OPENLOSS) + {error ("unable to open font file: %s", f->fname); + return (0); + } + } + } + for (i=0;i<0200;++i) f->fwidths[i] = 0; + cgeti (fd); /* KSTID */ + i = cgeti (fd); + h = i & 0777777; + bl = (i >> 18) & 0777; + f->fha = bl + 1; + f->fhb = h - bl - 1; + cgeti (fd); /* first USER ID */ + do + {i = cgeti (fd) & 0777777; /* char code */ + if (i >= 0200) + {error ("font file bad format: %s", f->fname); + cclose (fd); + return (0); + } + f->fwidths[i] = cgeti (fd) & 0777777; + while (((i = cgeti (fd)) & 1) == 0) /* skip matrix */ + if (ceof (fd)) + {error ("font file bad format: %s", + f->fname); + return (0); + } + } while (i != -1); + cclose (fd); + return (f); + } + \ No newline at end of file diff --git a/src/r/rteco.macros b/src/r/rteco.macros new file mode 100644 index 00000000..5ab69709 --- /dev/null +++ b/src/r/rteco.macros @@ -0,0 +1,20 @@ +! macro 9: reads and sorts rextrn.list, forms defines, and updates r.h ! + +:^i9/ + [1 [2 [6 1f[bothcase + mr rextrn list + :ll + mw rextrn list + j + <.-z;1:fb "e0lk'"#0li# definel'> + hx6 + mr r h + 1 + :ft unsuccessful!  +/ + diff --git a/src/r/rtext.c b/src/r/rtext.c new file mode 100644 index 00000000..e282525f --- /dev/null +++ b/src/r/rtext.c @@ -0,0 +1,819 @@ +# include "r.h" + +/* + + R Text Formatter + Text Word Routines + + Copyright (c) 1976, 1977 by Alan Snyder + + + ROUTINES: + + c = build_text_word (c, w) build text, given first + character + text_width (w) return width of text word + text_ha (w) return height above baseline + text_hb (w) return height below baseline + output_text (w, hp) output word given the + horizontal position + isul (w) is word an underline? + text_init () initialization + + + INTERNAL ROUTINES: + + ostext (p) output non-overstruck text word + ootext (p, hp) output overstruck text word + reset_overprint () reset for word with overprinting + setup_overprint () set up for word with overprinting + ocinsert (c) insert character with overprinting + ocappend (c) append character with overprinting + move_up (p, q, n) move block of words + gc () word garbage collector + trcwords (f) trace accessible words, apply f + text_mark (w) mark text word for GC + text_update (&w) update reference for GC + move_word (s, d) move word from s to d + + REPRESENTATION OF A TEXT WORD: + + The VAL of a text word is an index into the array TCSTORE. + This index points to the first of a sequence of INTs making + up the word, as follows: + + 0: width of word (in HU) + 1: max height of word above baseline (in VU) + 2: max height of word below baseline (in VU) + 3: reserved for GC + + Following is a sequence of INTs, terminated by a zero. There + are two formats, depending upon whether or not there is + overprinting in the word. + + FORMAT 1: NO OVERPRINTING + + The sequence consists of TCHARS, where a TCHAR is ONEOF: + + TCUL n change underlining to (n & 01) + TCFONT n change to font 'n' + TCVOFF v change vertical offset to 'v' + TCCHAR c output the character c + + The initial FONT and VOFF are zero and UL is off. Note that + no TCHAR has an integer value of zero (that's why the hacked + representation of TCUL). + + FORMAT 2: OVERPRINTING + + The sequence consists of a -1 (to distinguish it from the + format 1), followed by some number of character position + descriptions. Each character position description consists + of an int N giving the number of characters in the position + (greater than 0), followed by the width of the character + position plus 1, followed by N OCHARS. An OCHAR consists + of two words, described as follows (right adjusted in 16 + bits): + + ochar = struct {int tag1:1, voff:14; + int tag2:1, :1, ul:1, font:4, char:8}; + + The tags are always 1, so that no int is zero. + +*/ + +# define TWHEAD 4 /* number of header words */ + +# define tchar int +# define TCUL 0 +# define TCFONT 1 +# define TCVOFF 2 +# define TCCHAR 3 +# define TCOMASK 03 + +# define TCSHIFT 14 +# define TCVMASK 037777 + +# ifndef BIGLONG +# ifdef BIGWORD +# define TCSHIFT 16 +# define TCVMASK 0177777 +# endif +# endif + +# define OCSIZE 2 +# define OCMASK 037777 +# define OCTAG 040000 + +# ifndef BIGLONG +# ifdef BIGWORD +# define OCMASK 0177777 +# define OCTAG 0200000 +# endif +# endif + +# define ULMASK 01 +# define FONTMASK 017 +# define CHARMASK 0377 +# define CHARSIZE 8 +# define FONTSIZE 4 + +# define tchar_cons(t,v) (((t)<>TCSHIFT)&TCOMASK) +# define tchar_val(x) ((x)&TCVMASK) +# define mako1(voff) (OCTAG | (voff)) +# define mako2(ul,f,c) ((((((ul)<= gcwp) gc (); + wwval = wp - tcstore; + wp[3] = 0; + wsp = (wp =+ TWHEAD); + overprint = FALSE; + need_update = TRUE; + + if (w == -1) /* initialize for new word */ + {w_ha = w_hb = w_width = lastc = 0; + if (e->ifont != 0) appfont (e->ifont); + if (e->iul != 0) appul (e->iul); + if (e->ivoff != -min_voff) appvoff (e->ivoff); + } + else /* initialize for appending to old word */ + {if (w < 0 || w >= tcstore_size) + bletch ("BUILD_TEXT_WORD: bad argument"); + q = &tcstore[w]; + w_width = q[0]; + w_ha = q[1]; + w_hb = q[2]; + q =+ TWHEAD; + while (tt = *q++) + {*wp++ = tt; + if (wp>=ewp) fatal("^G'ed word too long"); + /* can't GC here ... we have a reference in hand */ + } + reset_overprint (); + if (!overprint) + {appfont (e->ifont); + appul (e->iul); + appvoff (e->ivoff); + } + gcw = -1; /* don't need it anymore */ + if (e->end_of_sentence) lastc = '.'; else lastc = 0; + } + + do /* loop until break character is read */ + /* don't trace a break character */ + + {v = ichar_val (ic); + if ((ty = ichar_type (ic)) == i_control) + {if ((ct = cc_type[v]) == cc_separator) goto done; + if (ct == cc_universal) goto done; + } + trace_character (ic); + + switch (ty) { + +case i_control: switch (v) { + + case 'f': ic = getc2 (); + trace_character (ic); + if (ic == '*') f = popfont (); + else + {f = fontid (ic); + if (f == -1) + {error ("invalid font (^F) specification: %i", + ic); + continue; + } + pushfont (e->ifont); + } + set_cfont (f); + if (!overprint) appfont (e->ifont); + need_update = TRUE; + continue; + + case 'v': readvoff (); + chkvoff (); + if (!overprint) appvoff (e->ivoff); + need_update = TRUE; + continue; + + case 'u': v = font_ha (e->pfont) / superfactor; + e->ivoff =+ v; + if (!overprint) appvoff (e->ivoff); + need_update = TRUE; + continue; + + case 'd': v = font_ha (e->pfont) / superfactor; + e->ivoff =- v; + if (!overprint) appvoff (e->ivoff); + need_update = TRUE; + continue; + + case 'z': e->ivoff = -min_voff; + if (!overprint) appvoff (e->ivoff); + need_update = TRUE; + continue; + + case 'b': e->iul = TRUE; + if (!overprint) appul (TRUE); + continue; + + case 'e': e->iul = FALSE; + if (!overprint) appul (FALSE); + continue; + + case 'h': if (!overprint) setup_overprint (); + if (ccol==0) + {if (bserr_flag) + error ("backspace past beginning of word"); + bserr_flag = TRUE; + } + else --ccol; + continue; + + default: error ("unrecognized control character '%c' in word", + v); + continue; + } + +case i_text: lastc = v = trt[v]; + if (overprint) + {if (ccol <= maxcol) ocinsert (v); + else ocappend (v); + ++ccol; + } + else + {appchar (v); + w_width =+ font_width (e->ifont, v); + } + if (wp >= gcwp) gc (); + if (need_update) /* recompute ha and hb */ + {voff = (e->ivoff + min_voff); /* real VOFF */ + if ((tt = font_ha (e->ifont) + voff) > w_ha) w_ha = tt; + if ((tt = font_hb (e->ifont) - voff) > w_hb) w_hb = tt; + } + continue; +default: error ("protected control character '%c' in text", v); + continue; + } + } + /* loop ends here */ + while (ic = getc2 ()); + + /* finalization */ + +done: e->end_of_sentence = (lastc=='.' || lastc=='?' || lastc=='!'); + wsp[-4] = w_width; + wsp[-3] = w_ha; + wsp[-2] = w_hb; + *wp++ = 0; + wsp = wp; + overprint = FALSE; + return (ic); + } + +/********************************************************************** + + TEXT_WIDTH - Return width of text word. + +**********************************************************************/ + +# ifndef USE_MACROS + +int text_width (w) word w; + + {return (tcstore[w]); + } + +/********************************************************************** + + TEXT_HA - Return height of text word above baseline. + +**********************************************************************/ + +int text_ha (w) word w; + + {return (tcstore[w+1]); + } + +/********************************************************************** + + TEXT_HB - Return height of text word below baseline. + +**********************************************************************/ + +int text_hb (w) word w; + + {return (tcstore[w+2]); + } + +# endif /* USE_MACROS */ + +/********************************************************************** + + OUTPUT_TEXT - Output text word given the horizontal position. + +**********************************************************************/ + +output_text (w, hp) word w; + + {int *p; /* pointer into TCSTORE */ + + p = tcstore + w + TWHEAD; + if (p[0] == -1) ootext (p+1, hp); + else ostext (p); + output_eow (); + } + +/********************************************************************** + + ISUL - Is word an underline? + +**********************************************************************/ + +int isul (w) word (w); + + {register tchar *p, tc; + int c; + + if (w < 0 || w >= tcstore_size) + {barf ("ISUL: bad argument"); + return (FALSE); + } + p = tcstore + w + TWHEAD; + if (p[0] == -1) return (FALSE); + c = -1; + while (tc = *p++) + {switch (tchar_type (tc)) { + case TCUL: + case TCFONT: + case TCVOFF: continue; + case TCCHAR: if (c != -1) return (FALSE); + c = tchar_val (tc); + continue; + } + } + return (c == '_'); + } + +/********************************************************************** + + OSTEXT - Output straight text (no overprinting) + +**********************************************************************/ + +ostext (p) register int *p; + + {register tchar tc; /* TCHAR being processed */ + register int val; /* current TCHAR value */ + + tfont = tul = 0; + tvoff = -min_voff; + while (tc = *p++) + {val = tchar_val (tc); + switch (tchar_type (tc)) { + +case TCUL: tul = val & 01; continue; +case TCFONT: tfont = val; continue; +case TCVOFF: tvoff = val; continue; +case TCCHAR: output_char (val); continue; +default: barf ("OSTEXT: bad TCHAR type"); + } + } + } + +/********************************************************************** + + OOTEXT - Output overstruck text. + +**********************************************************************/ + +ootext (p, hp) register int *p; + + {int thp; /* temp horizontal position for overprint */ + int o2; /* 2nd word of OCHAR being processed */ + int n; /* counter of chars overprinted in one column */ + int w1; /* width of overprinted column */ + int w2; /* width of character in overprinted column */ + int s; /* space needed to center overprinted char */ + + while (n = *p++) + {if (n > 100) + {barf ("OOTEXT: strange overstruck word"); + return; + } + w1 = *p++ - 1; + thp = hp; + while (--n >= 0) + {tvoff = (*p++) & OCMASK; + o2 = *p++; + tul = (o2 >> (CHARSIZE+FONTSIZE)) & ULMASK; + tfont = (o2 >> CHARSIZE) & FONTMASK; + o2 =& CHARMASK; + w2 = font_width (tfont, o2); + s = (w1-w2) >> 1; + if (s<0) barf ("OOTEXT: overstrike error"); + output_space (hp+s-thp, hp+s); + output_char (o2); + thp = hp + s + w2; + } + hp =+ w1; + output_space (hp-thp, hp); + } + } + +/********************************************************************** + + RESET_OVERPRINT - Reestablish overprint data base for + word being concatenated to. + +**********************************************************************/ + +reset_overprint () + + {int *p; + + if (*wsp != -1) return; + overprint = TRUE; + ccol = 0; + p = wcolp = wsp + 1; + while (wcolp < wp) + {p = wcolp; + wcolp =+ (2 + (*wcolp * OCSIZE)); + ++ccol; + } + maxcol = wcol = ccol - 1; + wcolp = p; + bserr_flag = FALSE; + } + +/********************************************************************** + + SETUP_OVERPRINT + +**********************************************************************/ + +setup_overprint () + + {int font, ul, voff, v; + register int *p; + register tchar tc; + + *wp++ = 0; + wwval = wp-tcstore; + p = wsp-TWHEAD; + while (p < wsp) *wp++ = *p++; + wsp = wp; + *wp++ = -1; + ul = font = 0; + voff = -min_voff; + ccol = 0; + while (tc = *p++) + {v = tchar_val (tc); + switch (tchar_type (tc)) { + case TCUL: ul = v & 01; continue; + case TCFONT: font = v; continue; + case TCVOFF: voff = v; continue; + case TCCHAR: ++ccol; + wcolp = wp; + *wp++ = 1; + *wp++ = font_width (font, v) + 1; + appo1 (voff); + appo2 (ul, font, v); + continue; + } + } + wcol = maxcol = ccol - 1; + bserr_flag = FALSE; + overprint = TRUE; + } + +/********************************************************************** + + OCINSERT - Insert OCHAR into middle of word. + +**********************************************************************/ + +ocinsert (c) + + {int n, delta; + register int *p; + + if (wp >= gcwp) gc (); + if (ccol < wcol) + {wcol = 0; + wcolp = wsp + 1; + } + while (wcol < ccol) + {wcolp =+ (2 + (*wcolp * OCSIZE)); + ++wcol; + } + n = wcolp[0]++; + p = wcolp + 2 + (n*OCSIZE); + move_up (p, wp-1, OCSIZE); + p[0] = mako1 (e->ivoff); + p[1] = mako2 (e->iul, e->ifont, c); + wp =+ OCSIZE; + delta = font_width (e->ifont, c) + 1 - wcolp[1]; + if (delta > 0) + {wcolp[1] =+ delta; + w_width =+ delta; + } + } + +/********************************************************************** + + OCAPPEND - Append OCHAR to end of word. + +**********************************************************************/ + +ocappend (c) + + {int width; + + width = font_width (e->ifont, c); + *wp++ = 1; + *wp++ = width + 1; + appo1 (e->ivoff); + appo2 (e->iul, e->ifont, c); + w_width =+ width; + maxcol = ccol; + } + +/********************************************************************** + + MOVE_UP + + Move a block of words from P to Q up by N words. + +**********************************************************************/ + +move_up (p, q, n) register int *p, *q; + + {register int *r; + r = q + n; + while (q >= p) *r-- = *q--; + } + +/********************************************************************** + + GC -- word garbage collector + +**********************************************************************/ + +gc () + + {extern env *env_tab[]; + int i, start_time; + int *l, *q, *r, *move_word(), text_mark(), text_update(); + register int **pp, **qq, **rr; + + ++Zngc; + start_time = cputm (); + nwords = 0; + + /* mark */ + + trcwords (text_mark); + + /* compute new locations of valid text words */ + + l = tcstore; + if (nwords <= gc_tab_size) /* all in table! */ + {rr = &gc_tab[nwords]; + for (pp=gc_tab;pp= tcstore_size) + bletch ("GC: bad wsp or wp"); + while (q < wp) *l++ = *q++; + if (overprint) wcolp =- i; + } + wp = l; + if (wp < tcstore || wp >= tcstore+tcstore_size) + bletch ("GC: bad new wp"); + if (wp >= gcwp) fatal ("word storage overflow"); + gc_time =+ (cputm () - start_time); + Zngcw =+ nwords; + } + +/********************************************************************** + + TRCWORDS - Trace accessible words and apply function given + word location. + +**********************************************************************/ + +trcwords (f) int (*f)(); + + {int i, j, t; + register token w, *ww; + env *ee; + + if (gcw != -1) + {gcw = token_cons (t_text, gcw); + (*f)(&gcw); + gcw = token_val (gcw); + } + for (i=0;itn; + ww = &ee->line_buf[0]; + while (--j >= 0) + {w = *ww; + t = token_type (w); + if (t == t_text || t == t_tabc) (*f)(ww); + ++ww; + } + } + } + } + +/********************************************************************** + + TEXT_MARK - mark text word + +**********************************************************************/ + +text_mark (ww) token *ww; + + {register int i, *p; + + p = tcstore + token_val (*ww); + if (p[3]==0) + {p[3] = -1; + i = nwords; + if (++nwords <= gc_tab_size) gc_tab[i] = p; + } + } + +/********************************************************************** + + TEXT_UPDATE + +**********************************************************************/ + +text_update (ww) token *ww; + + {register token w; + register int *p; + int *q; + + w = *ww; + p = tcstore + token_val (w); + q = p[3]; + *ww = token_cons (token_type (w), q-tcstore); + } + +/********************************************************************** + + MOVE_WORD - internal GC routine + +**********************************************************************/ + +int *move_word (q, l) + register int *q; /* source */ + int *l; /* destination */ + + {register int *r; + r = q[3]; + if (r != l) bletch ("MOVE_WORD: GC phase error"); + r[0] = q[0]; + r[1] = q[1]; + r[2] = q[2]; + r[3] = 0; + r =+ TWHEAD; + q =+ TWHEAD; + while (*r++ = *q++); + return (r); + } + diff --git a/src/r/rtoken.c b/src/r/rtoken.c new file mode 100644 index 00000000..b5787aee --- /dev/null +++ b/src/r/rtoken.c @@ -0,0 +1,60 @@ +# include "r.h" + +/* + + R Text Formatter + Token Routines + + Copyright (c) 1976, 1977 by Alan Snyder + + + *** TOKEN TYPE *** + + type val meaning + + CENTER center within column or POS + HPOS n>=0 (HU) set horizontal pos (from .HP or HPOS nr) + NLSPACE n>=0 (HU) SPACE created from NL + NULL ignore + POS n>=0 (HU) set horizontal pos (from ^P,^C,^R,^I) + RIGHT right flush the following text + SPACE n>=0 (HU) horizontal space + TABC * tab replacement word + TEXT * a word of text + + *** REPRESENTATION *** + + BIGWORD: type[31:27], val[26:0] + !BIGWORD: type[15:12], val[11:0] + + *** OPERATIONS *** + + token_cons (type, val) => token + token_val (token) => val + token_type (token) => type + +*/ + +# ifndef USE_MACROS + +token token_cons (type, val) + + {register token ttype; + + ttype = type; + if ((type & ~WOMASK) == 0 && (val & ~WVMASK) == 0) + return ((ttype<>WSHIFT) & WOMASK);} + +# endif /* USE_MACROS */ + \ No newline at end of file diff --git a/src/r/rtrap.c b/src/r/rtrap.c new file mode 100644 index 00000000..52c6c233 --- /dev/null +++ b/src/r/rtrap.c @@ -0,0 +1,240 @@ +# include "r.h" + +/* + + R Text Formatter + Trap Routines + + Copyright (c) 1976, 1977 by Alan Snyder + + + ROUTINES: + + add_trap (name, pos) + rem_trap (name, pos) pos == -1 => first one + pos = find_trap (name) -1 if none + pos = next_trap () page_length if none + new_vp (pos) + trap (name) do trap + reset_traps () + new_page () + +*/ + + +struct _trapdes { + int pos; /* in VU */ + idn name; /* macro to be invoked */ + }; + +# define trapdes struct _trapdes + + +trapdes trap_table [max_traps]; +trapdes *etrap {trap_table}; /* end of trap list */ +trapdes *ctrap {trap_table}; /* next pending trap */ +int vplost {0}; /* vp space lost by trap */ + +extern int vp, lvpu, page_length, page_empty, page_started, + traps_enabled, page_number, next_page_number, + current_page_offset, even_page_offset, odd_page_offset; + +extern env *e; + +/********************************************************************** + + ADD_TRAP - Add trap to given macro at given vertical + position. The new trap will go after all + traps of lesser or equal vertical position. + If the new trap is before the current vertical + position, it will not become enabled until the + next page, unless there is another pending trap + on the current page at a lesser or equal vertical + position as the new trap. + +**********************************************************************/ + +add_trap (name, pos) idn name; int pos; + + {trapdes *p, *q; + + if (etrap >= trap_table+max_traps) + fatal ("too many traps"); + for (p=trap_table;ppos > pos) /* then insert before this one */ + {for (q=etrap;q>p;--q) + {q->name = q[-1].name; + q->pos = q[-1].pos; + } + break; + } + p->name = name; + p->pos = pos; + ++etrap; + if (p==ctrap && posname == name && (pos == -1 || p->pos == pos)) + {if (ctrap > p) --ctrap; + --etrap; + while (p < etrap) + {p->name = p[1].name; + p->pos = p[1].pos; + ++p; + } + return; + } + } + +/********************************************************************** + + FIND_TRAP - Find the vertical position of the first trap + to the given macro. Return -1 if there are no + traps to the given macro. + +**********************************************************************/ + +int find_trap (name) idn name; + + {trapdes *p; + + for (p=trap_table;pname==name) return (p->pos); + return (-1); + } + +/********************************************************************** + + NEXT_TRAP - Return the vertical position of the next + pending trap. Return the page_length if there + are no pending traps before the end of the + page. + +**********************************************************************/ + +int next_trap () + + {if (!traps_enabled) return (infinity); + if (ctrappos < page_length) + return (ctrap->pos); + return (page_length); + } + +/********************************************************************** + + NEW_VP - Update the current vertical position to the given + value. If there is a pending trap at or before + this position and within the page_length, enable + that trap and set the current vertical position + to that trap position (unless that action would + decrease the current vertical position). + Otherwise, if the desired vertical position is + greater than the page_length, call NEW_PAGE. + +**********************************************************************/ + +new_vp (pos) + + {if (pos < vp) lvpu = 0; + if (traps_enabled) + {page_started = TRUE; + if (ctrap=ctrap->pos && ctrap->pospos>vp) vp = ctrap->pos; + vplost = max (0, pos-vp); + name = ctrap->name; + ++ctrap; + trap (name); + } + else if (pos >= page_length) + {vp = pos; /* avoid infinite recursion */ + new_page (); + } + else vp=pos; + } + else vp=pos; + } + +/********************************************************************** + + TRAP + +**********************************************************************/ + +trap (name) + idn name; + + {int t; + ac s; + extern int state; + t = vu2mil (vp); + tprint (" *** trap to %s at %dm\n", idn_string (name), t); + s = getmd (name); + if (s) + {extern idn com; + if (com != -1) /* we are interrupting a request routine */ + {while (TRUE) /* so skip remainder of request line */ + {ichar ic; + ic = getc1 (); + if (ic == i_newline || ic == i_eof) break; + } + } + push_macro (name, s, 0, 0, 0); + if (com != -1) push_char (i_newline); /* request terminator */ + else state = 0; /* process as new line */ + } + else error ("trap macro %s undefined", idn_string (name)); + } + +/********************************************************************** + + RESET TRAPS + +**********************************************************************/ + +reset_traps () + + {ctrap = trap_table;} + +/********************************************************************** + + NEW_PAGE - Go to the next page + + If the current page has not been finished, then call + NEW_VP to finish off the page: if there is any pending + trap, it will be enabled; otherwise, the vertical + position will be set past the page length and NEW_PAGE + called (recursively). + +**********************************************************************/ + +new_page () + + {if (vp < page_length) new_vp (page_length); /* recursion! */ + else + {output_eop (); + lvpu = 0; + vp = 0; + page_number = next_page_number++; + current_page_offset = (page_number&1 ? odd_page_offset : + even_page_offset); + page_empty = TRUE; + page_started = FALSE; + reset_traps (); + } + } + + \ No newline at end of file diff --git a/src/r/runix.c b/src/r/runix.c new file mode 100644 index 00000000..2732c281 --- /dev/null +++ b/src/r/runix.c @@ -0,0 +1,397 @@ +# include "r.h" + +/* + + R Text Formatter + DSSR UNIX Version System-Dependent Code + +*/ + +/* system-dependent values */ + +# define trace1_ext "rt1" /* lo-level trace file */ +# define trace2_ext "rt2" /* hi-level trace file */ + +struct fonthdr { char name[6]; + long kstid; + char xcpadj,base; + int height; + }; + +struct charhdr { char ascii,id[5]; + int lkern,rwidth,cwidth,nbytes; + }; + +char directory[FNSIZE]; +char *font_dir "/sys/fonts"; + +/********************************************************************** + + CPUTM - return cpu time + +**********************************************************************/ + +cputm() + + {struct tbuffer { long user,system,childu,childs; } xxx; + int i; + + times(&xxx); + i = xxx.user; + return(i); + } + +/********************************************************************** + + OPENINPUT - Open Input File + +**********************************************************************/ + +int openinput () + + {extern char *fname; + char buffer[FNSIZE]; + int f; + + f = copen (fname, 'r'); + if (f==OPENLOSS) + {parsefn(directory,fname,"r",buffer,3); + f = copen (buffer, 'r'); + } + if (f != OPENLOSS) + {parsefn(directory,fname,"r",buffer,0); + stcpy(buffer,fname); + } + return (f); + } + +/********************************************************************** + + OPENOUTPUT - Open output file. + +**********************************************************************/ + +int openoutput () + + {extern char ofname[], *fname; + extern int device, read_id, write_id; + char *suffix; + int f, fildes[2]; + + switch (device) { + case d_lpt: suffix = "lpt"; break; + case d_xgp: suffix = "xgp"; break; + + case d_varian: if ((f = pipe(fildes)) == -1) + {fatal("can't open pipe to vsort"); + return(f); + } + read_id = fildes[0]; + write_id = fildes[1]; + parsefn(directory,fname,"vv",ofname,3); + return(fildes[1]); + + default: suffix = "loser"; + } + parsefn(directory,fname,suffix,ofname,3); + f = copen (ofname,'w'); + if (f == OPENLOSS) f = copen ("r.out",'w'); + if (f == OPENLOSS) fatal ("can't open output file"); + return (f); + } + +/********************************************************************** + + OPENREAD - Open "Included" File + +**********************************************************************/ + +int openread (name, realname) char *name, *realname; + + {int f; + char buffer[FNSIZE], scratch[FNSIZE]; + + f = copen (name, 'r'); + stcpy (name, buffer); + if (f == OPENLOSS) + {stcpy (directory, scratch); + parsefn (scratch,name,"r",buffer,3); + f = copen (buffer, 'r'); + if (f == OPENLOSS) + {stcpy("/usr/r",scratch); + parsefn(scratch,name,"r",buffer,3); + f = copen (buffer, 'r'); + } + } + stcpy (buffer, realname); + return(f); + } + +/********************************************************************** + + OPENWRITE - Open auxiliary output file. + +**********************************************************************/ + +int openwrite (suffix) char *suffix; + + {extern char ofname[]; + char buffer[FNSIZE]; + + parsefn(directory,ofname,suffix,buffer,3); + return (copen (buffer, 'w')); + } + +/********************************************************************** + + OPENAPPEND - Open auxiliary output file. + +**********************************************************************/ + +int openappend (suffix) char *suffix; + + {extern char ofname[]; + char buffer[FNSIZE]; + + parsefn(directory,ofname,suffix,buffer,3); + return (copen (buffer, 'a')); + } + +/********************************************************************** + + OPENSTAT - Open Statistics File + +**********************************************************************/ + +int openstat () + + {return(copen ("/usr/r/r.stat", 'a'));} + +/********************************************************************** + + INTERACTIVE - Are we interactive? + +**********************************************************************/ + +int interactive () + + {extern int cout; + return (ttyn(cout)!='x'); + } + +/********************************************************************** + + OPENTRACE - Open trace files. + +**********************************************************************/ + +opentrace () + + {extern char *fname; + extern int etrace, e2trace; + char trace1_name[FNSIZE], trace2_name[FNSIZE]; + + parsefn(directory,fname,trace1_ext,trace1_name,3); + parsefn(directory,fname,trace2_ext,trace2_name,3); + etrace = copen (trace1_name, 'w'); + e2trace = copen (trace2_name, 'w'); + } + +/********************************************************************** + + USERNAME - Return User Name + +**********************************************************************/ + +char *username () + + {static char buffer[FNSIZE]; + if (getpw(getuid(),buffer) == 0) + {int i; + i = 0; + while (buffer[i]!='\0' & buffer[i]!=':') ++i; + buffer[i] = '\0'; + } + else buffer[0] = '\0'; + return (buffer); + } + +/********************************************************************** + + GETFDATES - Get File Date and Time from Stream + + Note: the format of dates and times is part of the definition + of R. + +**********************************************************************/ + +getfdates (f) + + {extern ac fdate_ac, ftime_ac; + extern char *months[]; + int timex[2], i; + char buffer[FNSIZE], *timevec, *p; + + time(timex); timevec = ctime(timex); + p = buffer; + for (i=11;i<19;i++) *p++ = timevec[i]; + *p = '\0'; + ftime_ac = ac_create (buffer); + p = buffer; + *p++ = timevec[8]; *p++ = timevec[9]; + for (i=3;i<7;i++) *p++ = timevec[i]; + for (i=19;i<24;i++) *p++ = timevec[i]; + *p = '\0'; + fdate_ac = ac_create (buffer); + } + +/********************************************************************** + + GETDATES - Get Current Date and Time + + Note: the format of dates and times is part of the definition + of R. + +**********************************************************************/ + +getdates () + + {extern ac date_ac, time_ac, sdate_ac; + extern char *months[]; + extern int rmonth, rday, ryear; + int timex[2], *rtime; + int i; + char buffer[FNSIZE], *timevec, *p; + + time(timex); timevec = ctime(timex); rtime = localtime(timex); + rmonth = rtime[4]+1; rday = rtime[3]; ryear = rtime[5]+1900; + p = buffer; + for (i=11;i<19;i++) *p++ = timevec[i]; + *p ='\0'; + time_ac = ac_create (buffer); + p = buffer; + *p++ = timevec[8]; *p++ = timevec[9]; + for (i=3;i<7;i++) *p++ = timevec[i]; + for (i=19;i<24;i++) *p++ = timevec[i]; + *p = '\0'; + date_ac = ac_create (buffer); + sdate_ac = ac_create (buffer); + } + +/********************************************************************** + + SETHANDLER - Setup Interrupt Handler + +**********************************************************************/ + +sethandler () + + {extern int ghandler(); + + signal(2,ghandler); /* ^B */ + } + +/********************************************************************** + + RDFONT - Read font file + +**********************************************************************/ + +fontdes *rdfont (f) fontdes *f; + + {int fd,i; + struct fonthdr fh; + struct charhdr ch; + char buffer[FNSIZE]; + + parsefn(font_dir,f->fname,"vft",buffer,3); + stcpy(buffer,f->fname); + fd = open(buffer,0); + if (fd<0) + {error ("unable to open font file: %s", buffer); + return (0); + } + for (i=0;i<0200;++i) f->fwidths[i] = 0; + if (read(fd,&fh,sizeof fh) != sizeof fh) + {error("font file bad format: %s", f->fname); + close(fd); return(0); } + f->fha = fh.base + 1; + f->fhb = fh.height - fh.base - 1; + f->cpadj = fh.xcpadj; + while (read(fd,&ch,sizeof ch)) + {if (ch.ascii >= 0200) + {error ("font file bad format: %s", f->fname); + close (fd); + return (0); + } + f->fwidths[ch.ascii] = ch.cwidth; + f->flkern[ch.ascii] = ch.lkern; + seek(fd,ch.nbytes,1); + }; + close (fd); + return (f); + } + +/****************************************************************************** + + Unix-specific routines as described in rextrn.desc + +******************************************************************************/ + +slen(s) + char *s; + + { int n; for (n=0; *s++ != '\0'; n++); return(n); } + +stcpy(s,d) + char *s,*d; + + { while (*d++ = *s++); } + +stcmp(s,p) + char *s,*p; + + { while (*s != '\0') if (*s++ != *p++) return(0); + return (*s == *p); } + +char *calloc(n) + int n; + + {char *s; + s = alloc(n); + if (s==0) fatal ("storage overflow"); + return (s); + } + +int *salloc(n) + int n; + + {return(calloc(2*n));} + +sfree(p) + int *p; + + { free(p); } + +cfree(p) + char *p; + + { free(p); } + +int alocstat (p, q) + int *p, *q; + + {return (-1);} + +setprompt(s) + char *s; + + {;} + +stkdmp (fd) + {;} + +cisfd (fd) + {return (fd<20);} + + \ No newline at end of file diff --git a/src/r/rvaria.c b/src/r/rvaria.c new file mode 100644 index 00000000..34ca78e8 --- /dev/null +++ b/src/r/rvaria.c @@ -0,0 +1,192 @@ +# include "r.h" +# ifdef HAVE_VARIAN + +/* + + R Text Formatter + VSORT/VARIAN Output Routines + + + ROUTINES: + + vn_init () + set_vn () + + OUTPUT ROUTINES: + + vn_header () + vn_char (c) + vn_eow () + vn_vp (pos, ha, hb) + vn_space (width, pos) + vn_eol (pos, ha, hb) + vn_eop () + vn_eof () + +*/ + + int read_id,write_id,curvpos,curhpos; + +extern env *e; +extern int nvui, nhui, dvpw, dvpl, vsp, superfactor; +extern int fout, printing, ofont, oul, ovoff, Znpage; + +/********************************************************************** + + VN_INIT - Initialize + +**********************************************************************/ + +vn_init () + + {;} + +/********************************************************************** + + SET_VN - Set Device + +**********************************************************************/ + +set_vn () + + {nvui = 200; + nhui = 200; + dvpw = 1700; + dvpl = 2047; + vsp = 6; + superfactor = 2; + } + +/********************************************************************** + + VN_HEADER - Output font names and exec VSORT + +**********************************************************************/ + +vn_header () + + {extern char ofname[]; + int i; + + curvpos = curhpos = 0; + if (fork()) { close(read_id); return(0); } + close(0); + close(write_id); + dup(read_id); + execl("/usr/bin/rvsort","/usr/bin/rvsort",ofname, + font_name(0),font_name(1),font_name(2), + font_name(3),font_name(4),font_name(5),font_name(6),font_name(7),0); + error("VN_HEADER: can't do exec"); + exit(0); + } + +/********************************************************************** + + VN_CHAR - Output actual text character. + +**********************************************************************/ + +vn_char (c) + + {extern int tul, tfont, tvoff; + extern fontdes *font_table[]; + register int hpos,vpos; + + if (!printing) return; + ofont = tfont; + oul = tul; + ovoff = tvoff; + + hpos = curhpos - font_table[ofont]->flkern[c] + + font_table[ofont]->cpadj; + vpos = (dvpl-curvpos) + (ovoff+min_voff); + outword((hpos<<5) | ((vpos>>6)&037)); + outword((vpos<<10) | ((ofont&07)<<7) | (c&0177)); + if (oul) + { vpos =- 2; + outword((hpos<<5) | ((vpos>>6)&037)); + outword((vpos<<10) | ((ofont&07)<<7) | ('_'&0177)); + } + curhpos =+ font_table[ofont]->fwidths[c]; + return; + } + +outword (w) + { outi(w&0377); outi((w>>8)&0377); } + +/********************************************************************** + + VN_EOW - Output whatever necessary at end of word. + +**********************************************************************/ + +vn_eow () + + {if (oul && printing) oul = FALSE; + } + +/********************************************************************** + + VN_VP - Output whatever is necessary to set up the + vertical position of the next line at vertical + position POS, having a height above the base + line of HA and a height below the baseline of HB. + +**********************************************************************/ + +vn_vp (pos, ha, hb) + + {if (printing) curvpos = pos; + } + +/********************************************************************** + + VN_SPACE - Output a space of given width or tab to + the given horizontal position. + +**********************************************************************/ + +vn_space (width, pos) + + {if (width==0 || !printing) return; + curhpos = pos; + } + +/********************************************************************** + + VN_EOL - Output whatever is necessary to terminate + the current line, which is at vertical position POS + and has height above baseline HA and height below + baseline HB. + +**********************************************************************/ + +vn_eol (pos, ha, hb) + + {;} + +/********************************************************************** + + VN_EOP - Output whatever is necessary to terminate + the current page. + +**********************************************************************/ + +vn_eop () + + {if (printing) {outword(-1); outword(-1); ++Znpage;} + } + +/********************************************************************** + + VN_EOF - Output whatever is necessary to terminate + the output file. + +**********************************************************************/ + +vn_eof () + + {;} + +# endif /* HAVE_VARIAN */ + \ No newline at end of file diff --git a/src/r/rxgp.c b/src/r/rxgp.c new file mode 100644 index 00000000..b3edd817 --- /dev/null +++ b/src/r/rxgp.c @@ -0,0 +1,294 @@ +# include "r.h" +# ifdef HAVE_XGP + +/* + + R Text Formatter + XGP Output Routines + + Copyright (c) 1976, 1977 by Alan Snyder + + + ROUTINES: + + xgp_init () + set_xgp () + + OUTPUT ROUTINES: + + xgp_header () + xgp_char (c) + xgp_eow () + xgp_vp (pos, ha, hb) + xgp_space (width, pos) + xgp_eol (pos, ha, hb) + xgp_eop () + xgp_eof () + +*/ + +extern env *e; +extern int nvui, nhui, dvpw, dvpl, vsp, superfactor; +extern int olvpu, fout, printing, ofont, oul, ovoff, ulpos, uldpos, + ulthick, uldthick, page_length, Znpage; + +static int header_out {FALSE}; + +/********************************************************************** + + XGP_INIT - Initialize + +**********************************************************************/ + +xgp_init () + + {;} + +/********************************************************************** + + SET_XGP - Set Device + +**********************************************************************/ + +set_xgp () + + {ulpos = uldpos = -1; + ulthick = uldthick = 2; + nvui = 192; + nhui = 200; + dvpw = 1632; + dvpl = infinity; + vsp = 6; + superfactor = 2; + } + +/********************************************************************** + + XGP_HEADER - Output file header + +**********************************************************************/ + +xgp_header () + + {;} + +xgp_rheader () + + {extern char version[]; + extern ac date_ac; + extern char ofname[], *ac_string(); + int i; + char buf[10]; + + header_out = TRUE; + outs (";SKIP 1\n;TOPMAR 0\n;BOTMAR 0\n;LFTMAR 0\n;VSP 0\n"); + outs (";SQUISH\n;SIZE "); + i = vu2mil (page_length); + i2a (i/1000, buf); + outs (buf); + i =% 1000; + if (i) + {i2a (i, buf); + outc ('.'); + if (i<10) outc ('0'); + if (i<100) outc ('0'); + outs (buf); + } + outs ("\n;KSET "); + for (i=0;i 63 || xgp_voff < -64) + {int diff; + diff = xgp_voff - old_xgp_voff; + if (diff > 0) + {while (diff >= 63) + {outi (0177); outi (1); outi (052); outi (63); + diff =- 63; + } + if (diff > 0) + {outi (0177); outi (1); outi (052); outi (diff);} + } + else + {while (diff <= -64) + {outi (0177); outi (1); outi (052); outi (-64); + diff =+ 64; + } + if (diff < 0) + {outi (0177); outi (1); outi (052); outi (diff);} + } + } + else + {outi (0177); outi (1); outi (043); outi (xgp_voff);} + ovoff = tvoff; + } + if (c>015 && c<0177 || c>0 && c<010 || c==013) /* normal */ + {outi (c); + return; + } + outi (0177); + outi (c); + return; + } + +/********************************************************************** + + XGP_EOW - Output whatever necessary at end of word. + +**********************************************************************/ + +xgp_eow () + + {if (oul && printing) xgpul (oul = FALSE); + } + +/********************************************************************** + + XGP_VP - Output whatever is necessary to set up the + vertical position of the next line at vertical + position POS, having a height above the base + line of HA and a height below the baseline of HB. + +**********************************************************************/ + +xgp_vp (pos, ha, hb) + + {int i; + + if (printing) + {if (!header_out) xgp_rheader (); + i = pos-ha+1; /* top of line */ + if (i <= olvpu) error ("output lines overlap"); + else + {outi (0177); + outi (3); + outi (i>>7); + outi (i&0177); + } + } + } + +/********************************************************************** + + XGP_SPACE - Output a space of given width or tab to + the given horizontal position. + +**********************************************************************/ + +xgp_space (width, pos) + + {if (width==0 || !printing) return; + if (width >= -64 && width<64) + {outi (0177); + outi (2); + outi (width & 0177); + } + else + {outi (0177); + outi (1); + outi (040); + outi (pos>>7); + outi (pos&0177); + } + } + +/********************************************************************** + + XGP_EOL - Output whatever is necessary to terminate + the current line, which is at vertical position POS + and has height above baseline HA and height below + baseline HB. + +**********************************************************************/ + +xgp_eol (pos, ha, hb) + + {if (printing) + {outc ('\n'); + ovoff = -min_voff; + olvpu = pos+hb; + } + } + +/********************************************************************** + + XGP_EOP - Output whatever is necessary to terminate + the current page. + +**********************************************************************/ + +xgp_eop () + + {if (printing && olvpu > 0) + {if (!header_out) xgp_rheader (); + outc ('\014'); + ++Znpage; + olvpu = 0; + } + } + +/********************************************************************** + + XGP_EOF - Output whatever is necessary to terminate + the output file. + +**********************************************************************/ + +xgp_eof () + + {if (printing && !header_out) xgp_rheader (); + } + +/********************************************************************** + + XGPUL - Output XGP Underline code + +**********************************************************************/ + +xgpul (ul) + + {outi (0177); + outi (1); + if (ul) {outi (046);} + else + {outi (051); + if (ulthick < 1) outi (1); + else if (ulthick > 127) outi (127); + else outi (ulthick); + if (ulpos < -63) outi (63); + else if (ulpos > 64) outi (-64); + else outi (-ulpos); + } + } + +# endif /* HAVE_XGP */ + \ No newline at end of file