This change file is for the VAX/VMS version of Metafont. It is based in part on the VAX/VMS change file for TeX written by David Fuchs. Changes by Brian {Hamilton Kelly} Copyright 1989 Brian Hamilton Kelly Changes by Christopher Neil Kempson Copyright 1989 Christopher Neil Kempson Changes by Don Hosek Copyright 1990 Don Hosek DO NOT MODIFY THIS FILE. If you must make changes, use a different name and alter the banner string so that it no longer has PD VMS in it. This file may be freely distributed only if it is unmodified. --Character Reference------------------------------------------------- Upper case letters: ABCDEFGHIJKLMNOPQRSTUVWXYZ Lower case letters: abcdefghijklmnopqrstuvwxyz Digits: 0123456789 Square, curly, angle braces, parentheses: [] {} <> () Backslash, slash, vertical bar: \ / | Punctuation: . ? ! , : ; Underscore, hyphen, equals sign: _ - = Quotes--right left double: ' ` " "at", "number" "dollar", "percent", "and": @ # $ % & "hat", "star", "plus", "tilde": ^ * + ~ ----------------------------------------------------------------------- OCT-1984 Original changes by Jane Colman JUL-1985 Added support for online graphics output for various Tektronix emulators. (Jane Colman(?)) 06-JUL-1988 BHK Increase mem_max (to be able to handle huge glyphs) -- needed for the RMCS shield at large magnifications. 22-SEP-1988 BHK Support Visual 550 terminal for graphics and also provide proper VAX/VMS exit status. 21-NOV-1988 CNK Set |last_text_char| = 255 (from 127). 21-DEC-1988 CNK Increase mem_top to 65534 (i.e. = mem_max) to allow inimf to run. 26-JAN-1989 CNK Increase file_name_size from 40 to 255 to allow for the maximum size of a VAX/VMS file specification. This also required a change to get_strings_started to pre-clear the name_of_file. 17-FEB-1989 BHK Fixed bug in WTek_coor where paramaters x & y are multiplied by 2 and exceed their allowed value range. 08-NOV-1989 BHK Introduced command-line interface, using separate .CLD file. LSE Review mode interface. Invoke editors through MF$EDIT logical. Inserted section numbers into change file to facilitate updating. 09-NOV-1989 BHK Provided separate |aux_file| to receive editor commands: \MF\ doesn't have \TeX's array of |write_file|'s! 14-NOV-1989 BHK Handle the /GF_FILE qualifier correctly. Don't bother to lowercase |command_line|; users need to quote multiple parameters anyway. Added subtitle for woven output. 23-JAN-1990 BHK Removed change relating to excess; now in canonical mf.web (sect 1119) [This is the PD VMS 2.0 change file.] 29-JUN-1990 thru 02-JUL-1990 Don Hosek Assorted changes to BHK's original to form PD VMS 2.1: -modified formatting of history to conform to other HMC TeX change files. -changed format of banner line to include PD VMS version number; added brief notes on history of change file. -Removed all instances of graph..hparg since they don't make sense in this context. -Removed ready_already check since we never preload formats in a manner appropriate for this. -Integrated MF and INIMF into a single executable through /INIT flag. -Added /EDITOR qualifier for selecting the editor -Added /CONTINUE qualifier to indicate whether or not MF should continue after a response of 'E' to the error prompt. -Added /MFINPUTS and /MFBASES qualifiers for indicating the names of those logicals. -Incorporated John Lavignino's Macro versions of inner-loop math functions for a speed increase of ~30%(!) On a benchmark using MF/BATCH on cmti10 scaled 5000 for the "lowres" device, I measured a speed increase of 33.8% on a VAX 8600. 07-AUG-1990 thru 16-AUG-1990 Don Hosek As the completion of PD VMS 2.1: -Re-wrote graphics routines as a sharable library. Life is much easier this way (and MF need not be re-compiled to add more terminals!) -Added code to set logical names given on /JOBNAME_SYMBOL and /JOBSIZE_SYMBOL on the basis of the output file of MF. e.g., if the MF output is going to cmr10.300gf, /JOBNAME_SYMBOL is MF_JOBNAME and /JOBSIZE_SYMBOL is MF_JOBSIZE, MF_JOBNAME will be defined to CMR10 and MF_JOBSIZE to 300. (Based on code by Jim Walker of South Carolina University). Note that these are DCL symbols and *not* logicals. -Macro code and CLD files included into change file. 30-AUG-1990 Don Hosek PD VMS 2.1a Fixed bug in jobname_symbol routine. --Beginning of MF.CLD------------------------------------------------- ! This is MF.CLD as of 30-AUG-1990 ! ! CLD for Metafont ! Based loosely on Brian Hamilton Kelly's MF.CLD ! ! Note that for easy configuration of a Metafont system, all logical names ! etc. are defined here. Thus, if, for example, you would like to be able ! to have your input path defined by MFINPUTS rather than MF_INPUTS, you can ! simply change the value for the /MFINPUTS qualifier (being sure that the ! change is made in both places where that qualifier is defined. ! The following qualifiers are subject to that sort of customization: ! EDITOR The editor to be used (set to TEX_EDIT: by default) ! MFBASES The path in which base files are sought (set to MF_BASES: by ! default. Note that values on /BASE will also need to be ! set). ! MFINPUTS The path in which input files are sought (set to MF_INPUTS:) ! DISPLAY The default output device for online displays (set to ! MF_TERM: by default. See below for more information.) ! GLIB_INDEX The index file used for finding graphics libraries (set to ! MF_LIB:GLIB_INDEX.DAT by default) ! JOBNAME_SYMBOL The name of a DCL symbol that the jobname will be stored in ! (set to MF_JOBNAME by default). ! JOBSIZE_SYMBOL The name of a DCL symbol in which the numeric portion of the ! extension of the output file will be stored (set to ! MF_JOBSIZE by default). ! ! INSTALLING METAFONT. ! To install Metafont from scratch you should first run TANGLE to generate the ! Pascal file mf.pas. (IMPORTANT NOTE: This implementation of Metafont uses one ! executable for both MF and INIMF!) After mf.pas has been generated, it should ! then be compiled and linked using the commands ! PASCAL/CHECK=(OVERFLOW,BOUNDS) MF ! LINK MF ! The COM file COMPILE_MF has been provided to do all three steps in one fell ! swoop. (Since there is only one linear path of dependencies in the ! generation of MF.EXE, it was not felt to be necessary to provide an MMS file ! to generate MF). ! Once MF has been compiled and linked, you should edit this file to insure ! that each image portion of the defined verbs points at the location ! where you will be keeping MF.EXE (usually TEX_ROOT:[EXE]). MF.CLD should then ! be installed in your system command tables. ! ! GRAPHICS LIBRARIES. ! The final step in installation is to edit the graphics libary index file ! indicated by the /GLIB_INDEX qualifier to indicate the graphics libraries ! available on your system. Full details on creating graphics libraries and ! are given in the VMSMF.TEX document. [not yet available] ! ! In older versions of VMS Metafont, the initialization file (usually ! texdefs.com) would have definitions along the lines of: ! MF == $TEX_EXE:MF ! INIMF == $TEX_EXE:INIMF ! these definitions should be removed. ! ! One other important thing to note: if you type MF commands on the command ! line you will need to enclose the argument in quotes, e.g., ! MF "\mode=lowres; input logo10" ! (old versions of MF did not require the quotes). Define Verb MF Image "tex_root:[exe]MF" Parameter P1, Label = Command_Line, Value (Default = "") Qualifier Base, Default, Placement = Global, Negatable, Value (Default = "MF_Bases:Plain") Qualifier Batch, Batch, Placement = Global Negatable, Qualifier GF_File, Label = Output, Default, Placement = Global, Nonnegatable, Value (Required, Type = $File) Qualifier Log_File, Default, Placement = Global, Negatable, Value (Required, Type = $File) Qualifier Diagnostics, Placement = Global, Negatable, Value (Type = $File) Qualifier Init, Placement = Global, Negatable Qualifier Continue, Placement = Global, Negatable Qualifier Editor, Placement = Global, Default, Negatable, Value(Default="TEX_EDIT:") Qualifier MFbases, Placement = Global, Default, Value(Default="MF_BASES:") Qualifier MFinputs, Placement = Global, Default, Value(Default="MF_INPUTS:") Qualifier DISPLAY Placement = Global, Default, Negatable, Value(Default="MF_TERM:") Qualifier GLIB_INDEX Placement=Global, Default, Value(Default="MF_LIB:GLIB_INDEX.DAT") Qualifier JOBNAME_SYMBOL Placement=Global, Default, Value(Default="MF_JOBNAME") Qualifier JOBSIZE_SYMBOL Placement=Global, Default, Value(Default="MF_JOBSIZE") Define Verb INIMF Image "tex_root:[exe]MF" Parameter P1, Label = Command_Line, Value (Default = "") Qualifier Base, Placement = Global, Negatable, Value (Required, Type=$file) Qualifier Batch, Batch, Placement = Global Negatable, Qualifier GF_File, Label = Output, Default, Placement = Global, Nonnegatable, Value (Required, Type = $File) Qualifier Log_File, Default, Placement = Global, Negatable, Value (Required, Type = $File) Qualifier Diagnostics, Placement = Global, Negatable, Value (Type = $File) Qualifier Init, Default Placement = Global, Negatable Qualifier Continue, Placement = Global, Negatable Qualifier Editor, Placement = Global, Default, Negatable, Value(Default="TEX_EDIT:") Qualifier MFbases, Placement = Global, Default, Value(Default="MF_BASES:") Qualifier MFinputs, Placement = Global, Default, Value(Default="MF_INPUTS:") Qualifier DISPLAY Placement = Global, Default, Negatable, Value(Default="MF_TERM:") Qualifier GLIB_INDEX Placement=Global, Default, Value(Default="MF_LIB:GLIB_INDEX.DAT") Qualifier JOBNAME_SYMBOL Placement=Global, Default, Value(Default="MF_JOBNAME") Qualifier JOBSIZE_SYMBOL Placement=Global, Default, Value(Default="MF_JOBSIZE") --End of MF.CLD------------------------------------------------------- --Beginning of MF-EXTRA.MAR------------------------------------------- ; This is MF-EXTRA.MAR as of 16-August-1990 ; Composed of routines contributed by John Lavagnino (Brandeis University) ; and Ned Freed (Innosoft International) .TITLE MF_EXTRA Math functions and extra routines for MF .IDENT /1.0/ ; If not replaced, the standard versions of these functions account ; for over 30% of the processing time used by METAFONT. These ; assembly-language versions are much faster because they can use ; extended-precision arithmetic to make the calculations directly, ; rather than by the iterative method used for portability in ; standard METAFONT. ; ; function makefraction(p, q: integer): fraction; ; { Calculate the function floor( (p * 2^28) / q + 0.5 ) } ; { if both p and q are positive. If not, then the value } ; { of makefraction is calculated as though both *were* } ; { positive, then the result sign adjusted. } ; { (e.g. makefraction ALWAYS rounds away from zero) } ; { In case of an overflow, return the largest possible } ; { value (2^31-1) with the correct sign, and set global } ; { variable "aritherror" to 1. Note that -2^31 is } ; { considered to be an illegal product for this type of } ; { arithmetic! } ; ; function makescaled(p, q: integer): scaled; ; { Calculate the function floor( (p * 2^16) / q + 0.5 ) } ; { Rounding same as in makefraction(). } ; ; function takefraction(q: integer; f: fraction): integer; ; { Calculate the function floor( (q * f) / 2^28 + 0.5 ) } ; { Rounding same as in makefraction(). } ; ; function takescaled(q: integer; f: scaled): integer; ; { Calculate the function floor( (q * f) / 2^16 + 0.5 ) } ; { Rounding same as in makefraction(). } ; ; ; Passes the TRAP test, version of December 4, 1989, with MF 2.0 --- ; though that test doesn't claim to exercise these fully. Also checked ; by generating a few CM fonts and comparing them with output from the ; unmodified program; and by comparison with the results of a C ; version of the standard routines on several million random pairs of ; integers. ; John Lavagnino, Department of English, Brandeis University, June 1990. ; Bitnet: lav@brandeis ; Internet: lav@binah.cc.brandeis.edu .external aritherror ; set on overflow TRUE = 1 ; value for aritherror EL_GORDO = ^x7fffffff ; 2^31-1 FRACTION_ONE = ^x10000000 ; 2^28 UNITY = ^x10000 ; 2^16 .psect $code, pic, shr, nowrt, long, exe ; long makescaled(p_ptr, q_ptr) [METAFONT: The Program, section 114.] ; long *p_ptr, *q_ptr .entry makescaled, ^m ;-- Move our scale factor into R3, and go to common code for ; makefraction and makescaled to compute (2^16 * p) div q. movl #UNITY, r3 brb make_code ; long makefraction(p_ptr, q_ptr) [METAFONT: The Program, section 107.] ; long *p_ptr, *q_ptr .entry makefraction, ^m ;-- Move our scale factor into R3, and continue in common code for ; makefraction and makescaled to compute (2^28 * p) div q. movl #FRACTION_ONE, r3 ;-- Argument handling for makefraction and makescaled, which differ only ; by a scale factor. make_code: ;-- First we figure out the correct sign for the result and make the ; arguments positive, as in the Pascal version in Metafont: The Program. ; This saves us from complications about which direction we're rounding ; in, etc. ; Put p into R2; make it positive, and save the original sign in R4. movzbl #1, r4 movl @4(ap), r2 bgeq 10$ mnegl r2, r2 mnegl r4, r4 10$: ; Put q into R1; make it positive, and save the correct sign for the ; final result of our calculations in R4. Then off to common code for ; main calculations. movl @8(ap), r1 bgeq main_calc mnegl r1, r1 mnegl r4, r4 brb main_calc ; long takescaled(q_ptr, f_ptr) [METAFONT: The Program, section 112.] ; long *q_ptr, *f_ptr .entry takescaled, ^m ;-- Move our divisor into R1, and go to common code for ; takefraction and takescaled to compute (q * f) div (2^16). movl #UNITY, r1 brb take_code ; long takefraction(q_ptr, f_ptr) [METAFONT: The Program, section 109.] ; long *q_ptr, *f_ptr .entry takefraction, ^m ;-- Move our divisor into R1, and continue in common code for ; takefraction and takescaled to compute (q * f) div (2^28). movl #FRACTION_ONE, r1 ;-- Argument handling for takefraction and takescaled, which differ ; only in the divisor that's used. take_code: ;-- First get sign for result and make arguments positive. ; Put q into R2; make it positive, and save the original sign in R4. movzbl #1, r4 movl @4(ap), r2 bgeq 10$ mnegl r2, r2 mnegl r4, r4 10$: ; Put f into R3; make it positive, and save the correct sign for the ; final result of our calculations in R4. movl @8(ap), r3 bgeq 20$ mnegl r3, r3 mnegl r4, r4 20$: ;-- Common code for the principal calculation for all these functions. ; At this point R2 and R3 should be the integers we multiply to get the ; dividend, R1 the divisor, and R4 the sign for the result. main_calc: ; Compute the dividend, R2 * R3. Output from the following is a ; quadword integer, in R2 and R3. emul r2, r3, #0, r2 ; Now divide the previous result by our divisor, R1. The quotient goes ; into R0, the remainder into R3. ediv r1, r2, r0, r3 ;-- Now checks for errors, rounding correction, and sign correction. ; Overflow checks. The BVS instruction checks for overflow as ; detected by EDIV, which uses the same criterion as Metafont ; (magnitude no greater than EL_GORDO, 2^31 - 1) for positive ; results. (A negative magnitude of 2^31 is allowed by the VAX, but ; we don't need to check for it because we made the input arguments ; positive.) bvs overflow ; If remainder R3 is more than half the divisor R1, increment our ; answer, because we want to round up and EDIV rounds down. rotl #1, r3, r3 cmpl r3, r1 blssu 10$ incl r0 bvs overflow 10$: ; Apply correct sign to the result. mull2 r4, r0 ; Successful return. Our answer is in R0. ret ;-- Overflow return: return EL_GORDO with the proper sign, and set ; the aritherror flag. overflow: mull3 #EL_GORDO, r4, r0 movb #TRUE, aritherror ret ; Code to handle indirect call of functions; we pass it a list of ; parameters, the last of which is the address of the routine to call and ; this code passes control to that routine with the given parameters. ; Contributed from MATHLIB by Ned Freed (Innosoft International): ; ned@ymir.claremont.edu .entry indirect,^m<> ashl #2,(ap),r0 addl2 ap,r0 callg (ap),@(r0) ret .end --End of MF-EXTRA.MAR------------------------------------------------- {Section 0} <<<<>>>> @x \def\gglob{20, 26} % this should be the next two sections of "" @y \def\gglob{20, 26} % this should be the next two sections of "" \let\maybe=\iffalse \def\title{\MF\ 2.7 [PD VMS 2.7/DECUS]} @z {Section 2} <<<<>>>> <<<<>>>> @x @d banner=='This is METAFONT, Version 2.7' {printed when \MF\ starts} @y This change file was originally created by Jane Colman of LBL who based her work on David Fuchs' change file for \TeX. These changes were then updated by Brian Hamilton Kelly and Christopher Niel Kempson at the Royal Military College of Science who cleaned up a few problems and added the CLI interface. The final round of changes was done by Don Hosek who did a lot of diddly type things and completely re-wrote the graphics interface. Macro versions of the inner-loop math routines were supplied by John Lavignino of Brandeis University. @d banner=='This is METAFONT, Version 2.7 [PD VMS 2.7/DECUS]' {printed when \MF\ starts} @z {Section 4} @x procedure initialize; {this procedure gets things started properly} var @@/ begin @@/ @y @@/ procedure initialize; {this procedure gets things started properly} var @@/ begin @@/ @z {Section 7} @x @d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging} @d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging} @y @d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging} @d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging} @z {Section 7} @x @d stat==@{ {change this to `$\\{stat}\equiv\null$' when gathering usage statistics} @d tats==@t@>@} {change this to `$\\{tats}\equiv\null$' when gathering usage statistics} @y @d stat== @d tats== @z {Section 8} @x @d init== {change this to `$\\{init}\equiv\.{@@\{}$' in the production version} @d tini== {change this to `$\\{tini}\equiv\.{@@\}}$' in the production version} @f init==begin @f tini==end @y @d init== if init_flag then begin @d tini== end; @f init==begin @f tini==end @z {Section 9} <<<<>>>> @x @ If the first character of a \PASCAL\ comment is a dollar sign, \ph\ treats the comment as a list of ``compiler directives'' that will affect the translation of this program into machine language. The directives shown below specify full checking and inclusion of the \PASCAL\ debugger when \MF\ is being debugged, but they cause range checking and other redundant code to be eliminated when the production system is being generated. Arithmetic overflow will be detected in all cases. @^system dependencies@> @^Overflow in arithmetic@> @= @{@&$C-,A+,D-@} {no range check, catch arithmetic overflow, no debug overhead} @!debug @{@&$C+,D+@}@+ gubed {but turn everything on when debugging} @y @ When the \PASCAL\ program generated as a result of `tangling' the \.{WEB} with the change file is compiled under VAX/VMS, command line qualifiers should be included to specify full checking and inclusion of debugger symbol records whilst \MF\ is being debugged, but eliminate range checking and other redundant code when the production system is being generated. Arithmetic overflow should be detected in all cases. @^system dependencies@> @^Overflow in arithmetic@> Under VAX/VMS, we arrange to `inherit' the descriptions of standard system services and named constants from the precompiled \PASCAL\ environment held in |'SYS$LIBRARY:STARLET.PEN'|---we do \&{not} specify whether or not any specific level of run-time checks shall be included, because any such attribute applied within the source code cannot be overridden by a command line qualifier when \MF\ is compiled. This library does not include \&{all} the library routines that are used by \MF84 under VAX/VMS, so other routines are declared as required using \PASCAL's syntax for |extern| routines. @fextern==forward @= @/@=[inherit('sys$library:starlet')]@>@\ {allows us to use system symbols and routines} @z {Section 10} <<<<>>>> @x @d othercases == others: {default for cases not listed explicitly} @y Fortunately for us, VAX-\PASCAL\ \&{does} support this default mechanism. @d othercases == otherwise {default for cases not listed explicitly} @z {Section 11} <<<<>>>> <<<<>>>> @x @^system dependencies@> @= @!mem_max=30000; {greatest index in \MF's internal |mem| array; must be strictly less than |max_halfword|; must be equal to |mem_top| in \.{INIMF}, otherwise |>=mem_top|} @!max_internal=100; {maximum number of internal quantities} @!buf_size=500; {maximum number of characters simultaneously present in current lines of open files; must not exceed |max_halfword|} @!error_line=72; {width of context lines on terminal error messages} @!half_error_line=42; {width of first lines of contexts in terminal error messages; should be between 30 and |error_line-15|} @!max_print_line=79; {width of longest text lines output; should be at least 60} @!screen_width=768; {number of pixels in each row of screen display} @!screen_depth=1024; {number of pixels in each column of screen display} @!stack_size=30; {maximum number of simultaneous input sources} @!max_strings=2000; {maximum number of strings; must not exceed |max_halfword|} @!string_vacancies=8000; {the minimum number of characters that should be available for the user's identifier names and strings, after \MF's own error messages are stored} @!pool_size=32000; {maximum number of characters in strings, including all error messages and help texts, and the names of all identifiers; must exceed |string_vacancies| by the total length of \MF's own strings, which is currently about 22000} @!move_size=5000; {space for storing moves in a single octant} @!max_wiggle=300; {number of autorounded points per cycle} @!gf_buf_size=800; {size of the output buffer, must be a multiple of 8} @!file_name_size=40; {file names shouldn't be longer than this} @!pool_name='MFbases:MF.POOL '; {string of length |file_name_size|; tells where the string pool appears} @.MFbases@> @!path_size=300; {maximum number of knots between breakpoints of a path} @!bistack_size=785; {size of stack for bisection algorithms; should probably be left at this value} @!header_size=100; {maximum number of \.{TFM} header words, times~4} @!lig_table_size=5000; {maximum number of ligature/kern steps, must be at least 255 and at most 32510} @!max_kerns=500; {maximum number of distinct kern amounts} @!max_font_dimen=50; {maximum number of \&{fontdimen} parameters} @y Since a number of arrays of |file_name_size| are used in this program to receive the full file specification of files when they are opened, it is necessary to extend this constant to 255, which is the maximum possible size that VAX/RMS can @.RMS@> @^Record Management Services@> return. It is not necessary, however, to pad out |pool_name| to this size (which would in any case prove ``difficult'' in WEB, because VAX-\PASCAL\ automatically pads short strings with spaces when assigned into longer variables. @^system dependencies@> @= @!mem_max=65534; {greatest index in \MF's internal |mem| array; must be strictly less than |max_halfword|; must be equal to |mem_top| in \.{INIMF}, otherwise |>=mem_top|} @!max_internal=100; {maximum number of internal quantities} @!buf_size=500; {maximum number of characters simultaneously present in current lines of open files; must not exceed |max_halfword|} @!error_line=72; {width of context lines on terminal error messages} @!half_error_line=42; {width of first lines of contexts in terminal error messages; should be between 30 and |error_line-15|} @!max_print_line=79; {width of longest text lines output; should be at least 60} @!stack_size=30; {maximum number of simultaneous input sources} @!max_strings=2000; {maximum number of strings; must not exceed |max_halfword|} @!string_vacancies=8000; {the minimum number of characters that should be available for the user's identifier names and strings, after \MF's own error messages are stored} @!pool_size=32000; {maximum number of characters in strings, including all error messages and help texts, and the names of all identifiers; must exceed |string_vacancies| by the total length of \MF's own strings, which is currently about 22000} @!move_size=5000; {space for storing moves in a single octant} @!max_wiggle=300; {number of autorounded points per cycle} @!gf_buf_size=1024; {size of the output buffer, must be a multiple of 8} @!VAX_block_length=512; {must be half |gf_buf_size| on Vax/VMS} @!file_name_size=255; {file names shouldn't be longer than this} @!path_size=300; {maximum number of knots between breakpoints of a path} @!bistack_size=785; {size of stack for bisection algorithms; should probably be left at this value} @!header_size=100; {maximum number of \.{TFM} header words, times~4} @!lig_table_size=5000; {maximum number of ligature/kern steps, must be at least 255 and at most 32510} @!max_kerns=500; {maximum number of distinct kern amounts} @!max_font_dimen=50; {maximum number of \&{fontdimen} parameters} @z {Section 12} @x @d mem_min=0 {smallest index in the |mem| array, must not be less than |min_halfword|} @d mem_top==30000 {largest index in the |mem| array dumped by \.{INIMF}; must be substantially larger than |mem_min| and not greater than |mem_max|} @d hash_size=2100 {maximum number of symbolic tokens, must be less than |max_halfword-3*param_size|} @d hash_prime=1777 {a prime number equal to about 85\pct! of |hash_size|} @d max_in_open=6 {maximum number of input files and error insertions that can be going on simultaneously} @d param_size=150 {maximum number of simultaneous macro parameters} @y @d mem_min=0 {smallest index in the |mem| array, must not be less than |min_halfword|} @d mem_top==65534 {largest index in the |mem| array dumped by \.{INIMF}; must be substantially larger than |mem_min| and not greater than |mem_max|} @d hash_size=2100 {maximum number of symbolic tokens, must be less than |max_halfword-3*param_size|} @d hash_prime=1777 {a prime number equal to about 85\pct! of |hash_size|} @d max_in_open=6 {maximum number of input files and error insertions that can be going on simultaneously} @d param_size=150 {maximum number of simultaneous macro parameters} @z {Section 22} <<<<>>>> @x @^character set dependencies@> @^system dependencies@> @y @^character set dependencies@> @^system dependencies@> The code shown here is intended to be used on VAX/VMS systems, and at other installations where only the printable ASCII set, plus |carriage_return|, |tab|, and |form_feed| will show up in text files. All |line_feed| and |null| characters are skipped. @d form_feed=@'14 {ASCII code used at end of a page} @d tab=@'11 @z {Section 22} <<<<>>>> <<<<>>>> @x for i:=0 to @'37 do xchr[i]:=' '; @y for i:=0 to @'37 do xchr[i]:=' '; xchr[form_feed]:=chr(form_feed); xchr[tab]:=chr(tab); @z {Section 24} <<<<>>>> @x The program actually makes use also of a third kind of file, called a |word_file|, when dumping and reloading base information for its own initialization. We shall define a word file later; but it will be possible for us to specify simple operations on word files before they are defined. @y The program actually makes use also of a third kind of file, called a |word_file|, when dumping and reloading base information for its own initialization. We shall define a word file later; but it will be possible for us to specify simple operations on word files before they are defined. Since the \.{WEB} already uses the name |text| for its own purposes, we have to define a macro to permit access to this VAX-\PASCAL\ file type identifier. @d VAX_text==@= text @> @z {Section 24} @x @!alpha_file=packed file of text_char; {files that contain textual data} @!byte_file=packed file of eight_bits; {files that contain binary data} @y @!alpha_file=VAX_text; {files that contain textual data} @!byte_block=packed array [0..VAX_block_length-1] of eight_bits; @!byte_file=packed file of byte_block; {files that contain binary data} @z {Section 25} @x \MF; some sort of extension to \PASCAL's ordinary |reset| and |rewrite| is crucial for our purposes. We shall assume that |name_of_file| is a variable of an appropriate type such that the \PASCAL\ run-time system being used to implement \MF\ can open a file whose external name is specified by |name_of_file|. @^system dependencies@> @= @!name_of_file:packed array[1..file_name_size] of char;@;@/ {on some systems this may be a \&{record} variable} @!name_length:0..file_name_size;@/{this many characters are actually relevant in |name_of_file| (the rest are blank)} @y \MF; some sort of extension to \PASCAL's ordinary |reset| and |rewrite| is crucial for our purposes. We shall assume that |name_of_file| is a variable of an appropriate type such that the \PASCAL\ run-time system being used to implement \MF\ can open a file whose external name is specified by |name_of_file|. @^system dependencies@> Any VAX-\PASCAL\ defaults may be supplied in |default_name|; this is used to expand partial file specifications given on such qualifiers as \.{/LOG}, in combination with other parts taken from the file specification of the \.{.MF} file. @^system dependencies@> @= @!name_of_file, @!default_name:packed array[1..file_name_size] of char;@;@/ {on some systems this may be a \&{record} variable} @!name_length, @!deflt_length:file_size;@/ {this many characters are actually relevant in |name_of_file| (the rest are blank)} @z {Section 26} <<<<>>>> @x @ The \ph\ compiler with which the present version of \MF\ was prepared has extended the rules of \PASCAL\ in a very convenient way. To open file~|f|, we can write $$\vbox{\halign{#\hfil\qquad&#\hfil\cr |reset(f,@t\\{name}@>,'/O')|&for input;\cr |rewrite(f,@t\\{name}@>,'/O')|&for output.\cr}}$$ The `\\{name}' parameter, which is of type `\ignorespaces|packed array[@t\<\\{any}>@>] of text_char|', stands for the name of the external file that is being opened for input or output. Blank spaces that might appear in \\{name} are ignored. The `\.{/O}' parameter tells the operating system not to issue its own error messages if something goes wrong. If a file of the specified name cannot be found, or if such a file cannot be opened for some other reason (e.g., someone may already be trying to write the same file), we will have |@!erstat(f)<>0| after an unsuccessful |reset| or |rewrite|. This allows \MF\ to undertake appropriate corrective action. @:PASCAL H}{\ph@> @^system dependencies@> \MF's file-opening procedures return |false| if no file identified by |name_of_file| could be opened. @y @ Under VAX-\PASCAL, we can open files with names that are not known at compile time through use of the VAX-specific procedure |open|, which takes too many varied parameters to describe here: for example, the third parameter controls whether a new file shall be generated, or can enforce that an existing file cannot possibly be altered. Because the identifier |open| is already used in the \.{WEB} source of \MF, we have to provide a macro to be able to utilize this VAX-\PASCAL\ standard procedure. @^system dependencies@> However, one in particular deserves special mention: the |user_action| parameter when included causes execution of a user-supplied routine which can manipulate the data structures used by RMS (Record Management Services) and thus @.RMS@> @^Record Management Services@> permit finer control over the actions undertaken during the opening or creation of files. All file manipulation procedures in VAX-\PASCAL\ (including |open|/|close|, |read|/|write|, etc.)\ can take an optional parameter which specifies whether or no the program shall continue execution after an error. Since we code to detect such errors, we nearly always make use of this facility. \MF's file-opening procedures return |false| if no file identified by |name_of_file| could be opened: note that VAX-\PASCAL's |status| function returns zero if the previous file operation was successfully completed, |-1| if |eof| would be |true|, and a positive integer if any error was detected. When a |new| file is opened, we specify that it shall be deleted when the program exits; this ensures that output files are correctly discarded if \MF\ is interrupted in its work. Later, when the files are closed, we can arrange to keep the files instead. VAX-\PASCAL's |open| procedure also allows us to specify a `default' file specification, which is used to supply defaults for those parts of the specification of the file being created that have not otherwise been provided by the user. Whenever a |word_file| is opened, the variable |base_count| is reset to zero to ensure that the first byte of the VAX block is that first accessed. @d VAX_open_file==@= open@> @d VAX_user_action==@=user_action@> @# @d VAX_new==@= new @> @d VAX_readonly==@= readonly @> @# @d VAX_default==@= default @> @# @d VAX_disposition_delete==@=disposition:=delete@> @d VAX_ignore_error==@=error:=continue@> @z {Section 26} <<<<>>>> @x @d reset_OK(#)==erstat(#)=0 @d rewrite_OK(#)==erstat(#)=0 @p function a_open_in(var @!f:alpha_file):boolean; @y @p function a_open_in(var @!f:alpha_file):boolean; @z {Section 26} <<<<>>>> @x begin reset(f,name_of_file,'/O'); a_open_in:=reset_OK(f); @y begin VAX_open_file(f,name_of_file,VAX_readonly,VAX_user_action:=user_reset, VAX_ignore_error); if status(f)>0 then a_open_in:=false else begin reset(f,VAX_ignore_error); a_open_in:=status(f)<=0; end; @z {Section 26} <<<<>>>> @x begin rewrite(f,name_of_file,'/O'); a_open_out:=rewrite_OK(f); @y begin VAX_open_file(f,name_of_file,VAX_new,16383,VAX_disposition_delete, VAX_default:=default_name, VAX_user_action:=user_rewrite,VAX_ignore_error); if status(f)>0 then a_open_out:=false else begin linelimit(f,maxint); rewrite(f,VAX_ignore_error); a_open_out:=status(f)<=0; end; @z {Section 26} <<<<>>>> @x begin rewrite(f,name_of_file,'/O'); b_open_out:=rewrite_OK(f); @y begin VAX_open_file(f,name_of_file,VAX_new,VAX_disposition_delete, VAX_default:=default_name, VAX_user_action:=user_rewrite,VAX_ignore_error); if status(f)>0 then b_open_out:=false else begin rewrite(f,VAX_ignore_error); b_open_out:=status(f)<=0; end; @z {Section 26} @x begin reset(f,name_of_file,'/O'); w_open_in:=reset_OK(f); @y begin VAX_open_file(f,name_of_file,VAX_readonly,VAX_user_action:=user_reset, VAX_ignore_error); if status(f)>0 then w_open_in:=false else begin reset(f,VAX_ignore_error); w_open_in:=status(f)<=0; end; base_count:=0; {hack} @z {Section 26} <<<<>>>> @x begin rewrite(f,name_of_file,'/O'); w_open_out:=rewrite_OK(f); @y begin VAX_open_file(f,name_of_file,VAX_new,VAX_disposition_delete, VAX_default:=default_name, VAX_user_action:=user_rewrite,VAX_ignore_error); if status(f)>0 then w_open_out:=false else begin rewrite(f,VAX_ignore_error); w_open_out:=status(f)<=0; end; base_count:=0; {hack} @z {Section 27} <<<<>>>> @x [3] file closing @ Files can be closed with the \ph\ routine `|close(f)|', which @^system dependencies@> should be used when all input or output with respect to |f| has been completed. This makes |f| available to be opened again, if desired; and if |f| was used for output, the |close| operation makes the corresponding external file appear on the user's area, ready to be read. @p procedure a_close(var @!f:alpha_file); {close a text file} begin close(f); @y @ Files can be closed with the VAX-\PASCAL\ routine |close(f,disposition,error)|, which @^system dependencies@> should be used when all input or output with respect to |f| has been completed. This makes |f| available to be opened again, if desired; and if |f| was used for output, the |close| operation can make the corresponding external file appear in the user's directory, ready to be read: this depends upon the value of the |disposition| parameter, which can (\\{inter alia}) control whether the file is kept or discarded. If this parameter is not specified, then disposition of the file is determined by the corresponding parameter of the |open| routine. It is through this mechanism that we are able to ensure that all output files are discarded if the operation of \MF\ is aborted by the user, and yet are kept if the program terminates correctly. These procedures should not generate error messages if a file is being closed before it has been successfully opened; the |error| parameter is used here to ensure that any such errors do not cause run-time failures. @d VAX_disposition_save==@=disposition:=save@> @p procedure a_close(var f:alpha_file); {close a text file} begin close(f,VAX_disposition_save,VAX_ignore_error); @z {Section 27} <<<<>>>> @x begin close(f); @y begin close(f,VAX_disposition_save,VAX_ignore_error); @z {Section 27} <<<<>>>> @x begin close(f); @y begin close(f,VAX_disposition_save,VAX_ignore_error); @z {Section 29} <<<<>>>> @x [3] read into auxiliary buffer first representing the beginning and ending of a line of text. @= @y representing the beginning and ending of a line of text. On Vax/VMS, we will read the lines first into an auxiliary buffer, in order to save the running time of procedure-call overhead. We have to be very careful to handle lines longer than the arbitrarily chosen length of the |aux_buf|. This buffer is declared using a VAX-\PASCAL\ extension for variable length strings, namely the |varying| array type. Such arrays actually appear as if they were a record declared with two fields, thus: |varying [max_size] of = record length: 0..max_size; body: packed array [1..max_size] of|. @d VAX_length(#)==#.@=length@> @d VAX_body(#)==#.@=body@> @f varying==array @= @!aux_buf:varying [133] of char; {where the characters go first} @z {Section 30} <<<<>>>> <<<<>>>> @x @p function input_ln(var @!f:alpha_file;@!bypass_eoln:boolean):boolean; {inputs the next line or returns |false|} var @!last_nonblank:0..buf_size; {|last| with trailing blanks removed} begin if bypass_eoln then if not eof(f) then get(f); {input the first character of the line into |f^|} last:=first; {cf.\ Matthew 19\thinspace:\thinspace30} if eof(f) then input_ln:=false else begin last_nonblank:=first; while not eoln(f) do begin if last>=max_buf_stack then begin max_buf_stack:=last+1; if max_buf_stack=buf_size then @; end; buffer[last]:=xord[f^]; get(f); incr(last); if buffer[last-1]<>" " then last_nonblank:=last; end; last:=last_nonblank; input_ln:=true; end; end; @y The following code uses VAX-\PASCAL\ extensions, such as |varying| strings to perform input of larger amounts of characters with a single input instruction. @^inner loop@> Under VAX-\PASCAL, it is not necessary to take special action to |bypass_eoln|, since the terminator character will be included in those read into the |aux_buf|. @p function input_ln(var f:alpha_file;@!bypass_eoln:boolean):boolean; {inputs the next line or returns |false|} label found; var @!len:integer; {length of line input} @!k:0..buf_size; {index into |buffer|} begin last:=first; {cf.\ Matthew 19\thinspace:\thinspace30} if status(f)<>0 then input_ln:=false else begin while not eoln(f) do begin read(f,aux_buf,VAX_ignore_error); len:=VAX_length(aux_buf); if last+len>=max_buf_stack then begin if last+len; end; for k:=last to last+len-1 do buffer[k]:=xord[aux_buf[k-last+1]]; last:=last+len; end; found: if last>first then if buffer[last-1]=" " then begin decr(last); goto found; end; input_ln:=true; read_ln(f,VAX_ignore_error); end; end; @z {Section 32} <<<<>>>> @x [3] terminal file opening @ Here is how to open the terminal files in \ph. The `\.{/I}' switch suppresses the first |get|. @^system dependencies@> @d t_open_in==reset(term_in,'TTY:','/O/I') {open the terminal for text input} @d t_open_out==rewrite(term_out,'TTY:','/O') {open the terminal for text output} @y @ Here is how to open the terminal files under Vax/VMS. @^system dependencies@> The standard input and output proces-permanent files \.{SYS\$INPUT} and \.{SYS\$OUTPUT} @.SYS{\$}INPUT@> @.SYS{\$}OUTPUT@> are opened, and the addresses of the associated |FAB| and |RAB| noted so that special actions (such as flushing the input buffer) can be coded. Output occurs without any implicit carriage-control: this permits the output buffer to be flushed to the terminal without terminating the line of output; it is necessary to output the carriage-return, line-feed character pair explicitly when the line is to be terminated. @d VAX_sys_input==@= 'SYS$INPUT' @> @d VAX_sys_output==@= 'SYS$OUTPUT' @> @d VAX_PAS_FAB==@= PAS$FAB@> @d VAX_PAS_RAB==@= PAS$RAB@> @d VAX_carriage_control==@= carriage_control @> @d VAX_none==@= none @> @# @d t_open_in==begin VAX_open_file(term_in,VAX_sys_input); reset(term_in); in_FAB:=VAX_PAS_FAB(term_in); in_RAB:=VAX_PAS_RAB(term_in); end {open the terminal for text input} @d t_open_out==begin VAX_open_file(term_out,VAX_sys_output,VAX_carriage_control:=VAX_none); linelimit(term_out,maxint); rewrite(term_out); out_FAB:=VAX_PAS_FAB(term_out); out_RAB:=VAX_PAS_RAB(term_out); end {open the terminal for text output} @z {Section 33} <<<<>>>> @x [3] terminal hacks: clear and update these operations can be specified in \ph: @^system dependencies@> @d update_terminal == break(term_out) {empty the terminal output buffer} @d clear_terminal == break_in(term_in,true) {clear the terminal input buffer} @d wake_up_terminal == do_nothing {cancel the user's cancellation of output} @y these operations can be specified in Vax/VMS Pascal, through manipulation of the data structures maintained in the |RAB| (Record Access Block) @^Record Access Block@> by RMS. @^RMS@> @^Record Management Services@> Since |wake_up_terminal| is only called just before output of an error message, there's no significant overhead in its being a procedure, and this saves 8k bytes of \PASCAL\ source compared with having it as a \.{WEB} definition. @^system dependencies@> To prevent spurious empty writes to the terminal in |batch_mode|, we apply a condition to |update_terminal|. @d VAX_RAB_purge_typeahead== @=RAB$V_PTA@> @d VAX_RAB_cancel_ctrlO== @=RAB$V_CCO@> @# @d update_terminal == if odd(selector) then write_ln(term_out) {empty the terminal output buffer} @d clear_terminal == in_RAB^.VAX_RAB_purge_typeahead:=true {clear the terminal input buffer} @.PTA@> @d crlf == chr(13),chr(10) @# @= procedure wake_up_terminal; begin out_RAB^.VAX_RAB_cancel_ctrlO:=true; write_ln(term_out); out_RAB^.VAX_RAB_cancel_ctrlO:=false; end; {cancel the user's cancellation of output} @.CCO@> @z {Section 36} <<<<>>>> <<<<>>>> @x @ The following program does the required initialization without retrieving a possible command line. It should be clear how to modify this routine to deal with command lines, if the system permits them. @^system dependencies@> @p function init_terminal:boolean; {gets the terminal input started} label exit; begin t_open_in; loop@+begin wake_up_terminal; write(term_out,'**'); update_terminal; @.**@> if not input_ln(term_in,true) then {this shouldn't happen} begin write_ln(term_out); write(term_out,'! End of file on the terminal... why?'); @.End of file on the terminal@> init_terminal:=false; return; end; loc:=first; while (loc @.LIB{\$}GET_FOREIGN@> @^system dependencies@> Since any command line passed to \MF\ from DCL via \.{LIB\$GET\_FOREIGN} will have been ``up-cased'', we convert everything to lower-case, so that any \MF\ commands therein can be recognized; of course, any such commands which are named with upper-case letters will be ``ruined'', but we can't have everything! Such conversion does not occur if we are using the full command line interpreter interface, since with that it is only possible to pass commands consisting of more than one word by enclosing the whole string in `\.{\char'042}' quotation marks, and this mechanism can thus preserve the correct case on input. @d VAX_lib_get_foreign==@= lib$get_foreign@> @d VAX_cli_present==@= cli$present@> @d VAX_cli_get_value==@= cli$get_value@> @p function init_terminal:boolean; {gets the terminal input started} label exit; var users_command: packed array[1..300] of char; @!len: sixteen_bits; @!i: integer; begin t_open_in; if cmd_line_present then VAX_cli_get_value('COMMAND_LINE',users_command,len) else VAX_lib_get_foreign(users_command,,len); i:=1; while (i<=len) and (users_command[i]=' ') do incr(i); if i<=len then begin loc:=first; last:=first; while i<=len do begin buffer[last]:=xord[users_command[i]]; if cmd_line_present then if (buffer[last]>="A") and (buffer[last]<="Z") then buffer[last]:=buffer[last]+"a"-"A"; incr(last); incr(i); end; init_terminal:=true; return; end; loop@+begin wake_up_terminal; write(term_out,'**'); update_terminal; @.**@> if not input_ln(term_in,true) then {this shouldn't happen} begin write(term_out,crlf); write_ln(term_out,'! End of file on the terminal... why?',crlf); @.End of file on the terminal@> init_terminal:=false; return; end; loc:=first; while (loc>>>>Added 30-JUN-1990 by DAH>>>>> @x remove init_tini from function decl @p @!init function get_strings_started:boolean; {initializes the string pool, but returns |false| if something goes wrong} label done,exit; var @!k,@!l:0..255; {small indices or counters} @!m,@!n:text_char; {characters input from |pool_file|} @!g:str_number; {garbage} @!a:integer; {accumulator for check sum} @!c:boolean; {check sum has been checked} begin pool_ptr:=0; str_ptr:=0; max_pool_ptr:=0; max_str_ptr:=0; str_start[0]:=0; @; @; exit:end; tini @y @p function get_strings_started:boolean; {initializes the string pool, but returns |false| if something goes wrong} label done,exit; var @!k,@!l:0..255; {small indices or counters} @!m,@!n:text_char; {characters input from |pool_file|} @!g:str_number; {garbage} @!a:integer; {accumulator for check sum} @!c:boolean; {check sum has been checked} begin pool_ptr:=0; str_ptr:=0; max_pool_ptr:=0; max_str_ptr:=0; str_start[0]:=0; @; @; exit:end; @z {Section 50} >>>>>Added 30-JUN-1990 by DAH>>>>> @x remove init_tini from variable decl @!init @!pool_file:alpha_file; {the string-pool file output by \.{TANGLE}} tini @y @!pool_file:alpha_file; {the string-pool file output by \.{TANGLE}} @z {Section 51} <<<<>>>> @x [4] bad_pool needs real crlf @ @d bad_pool(#)==begin wake_up_terminal; write_ln(term_out,#); @y @ As noted before, it is not necessary for the string |pool_name| to have the same length as the |array name_of_file|, because VAX-\PASCAL\ automatically pads such shorter strings with spaces when an assignment is made into a longer string variable. @d bad_pool(#)==begin wake_up_terminal; write_ln(term_out,#,crlf); @z {Section 54} <<<<>>>> @x @* \[5] On-line and off-line printing. Messages that are sent to a user's terminal and to the transcript-log file are produced by several `|print|' procedures. These procedures will direct their output to a variety of places, based on the setting of the global variable |selector|, which has the following possible values: \yskip \hang |term_and_log|, the normal setting, prints on the terminal and on the transcript file. \hang |log_only|, prints only on the transcript file. \hang |term_only|, prints only on the terminal. \hang |no_print|, doesn't print at all. This is used only in rare cases before the transcript file is open. \hang |pseudo|, puts output into a cyclic buffer that is used by the |show_context| routine; when we get to that routine we shall discuss the reasoning behind this curious mode. \hang |new_string|, appends the output to the current string in the string pool. \yskip \noindent The symbolic names `|term_and_log|', etc., have been assigned numeric codes that satisfy the convenient relations |no_print+1=term_only|, |no_print+2=log_only|, |term_only+2=log_only+1=term_and_log|. @y @* \[5] On-line and off-line printing. Messages that are sent to a user's terminal and to the transcript-log file are produced by several `|print|' procedures. These procedures will direct their output to a variety of places, based on the setting of the global variable |selector|, which has the following possible values: \yskip \hang |term_and_log|, the normal setting, prints on the terminal and on the transcript file. \hang |log_only|, prints only on the transcript file. \hang |term_only|, prints only on the terminal. \hang |no_print|, doesn't print at all. This is used only in rare cases before the transcript file is open. \hang |pseudo|, puts output into a cyclic buffer that is used by the |show_context| routine; when we get to that routine we shall discuss the reasoning behind this curious mode. \hang |new_string|, appends the output to the current string in the string pool. \hang |aux_write|, prints the characters into the |aux_file| only. \yskip \noindent The symbolic names `|term_and_log|', etc., have been assigned numeric codes that satisfy the convenient relations |no_print+1=term_only|, |no_print+2=log_only|, |term_only+2=log_only+1=term_and_log|. In the implementation of \TeX, these symbolic names are given values starting at 16, leaving room for an array of 16 auxiliary output files: \MF\ has no provision (or requirement) for such files itself, but the interface to various ``callable editors'', described toward the end of this program, necessitates the use of one such file, |aux_file|, which is declared here. @z {Section 54} <<<<>>>> @x @d max_selector=5 {highest selector setting} @= @!log_file : alpha_file; {transcript of \MF\ session} @y @d aux_write=6 {printing is deflected to the |aux_file|} @d max_selector=6 {highest selector setting} @= @!log_file : alpha_file; {transcript of \MF\ session} @!aux_file : alpha_file; {command files used when invoking some editors} @z {Section 56} <<<<>>>> <<<<>>>> @x [5] real crlf for terminal by changing |wterm|, |wterm_ln|, and |wterm_cr| here. @^system dependencies@> @d wterm(#)==write(term_out,#) @d wterm_ln(#)==write_ln(term_out,#) @d wterm_cr==write_ln(term_out) @d wlog(#)==write(log_file,#) @d wlog_ln(#)==write_ln(log_file,#) @d wlog_cr==write_ln(log_file) @y by changing |wterm|, |wterm_ln|, and |wterm_cr| here. @^system dependencies@> We also introduce here analogous macros for writing to the |diag_file|, which is used to generate diagnostic messages for use in conjunction with DEC's Language-sensitive editor (LSEdit). @^Language-sensitive editor@> @^LSE@> Yet another set of macros is concerned with writing to |temp_file|, which is a purely internal file, used to concatenate the various elements of \MF's error messages for use in diagnostic and other files. @d wterm(#)==write(term_out,#) @d wterm_ln(#)==write_ln(term_out,#,crlf) @d wterm_cr==write_ln(term_out,crlf) @d wlog(#)==if log_qual then write(log_file,#) @d wlog_ln(#)==if log_qual then write_ln(log_file,#) @d wlog_cr==if log_qual then write_ln(log_file) @d wdiag(#)==if diag_qual then write(diag_file,#) @d wdiag_ln(#)==if diag_qual then write_ln(diag_file,#) @d wdiag_cr==if diag_qual then write_ln(diag_file) @d wtemp(#)==write(temp_file,#) @d wtemp_ln(#)==write_ln(temp_file,#) @d wtemp_cr==write_ln(temp_file) @= procedure diag_char( s : integer ); var ch : char; begin ch := xchr[s]; wdiag(ch); if ch='"' then wdiag(ch) end; @# procedure temp_char( s : integer); var ch : char; begin ch := xchr[s]; wtemp(ch); if ch='"' then wtemp(ch) end; @# procedure diag_print( s : integer); var j : pool_pointer; begin j:=str_start[s]; while j < str_start[s+1] do begin diag_char(so(str_pool[j])); incr(j) end; end; @z {Section 57} <<<<>>>> @x no_print,pseudo,new_string: do_nothing; @y no_print,pseudo,new_string: do_nothing; aux_write: write_ln(aux_file); @z {Section 58} <<<<>>>> <<<<>>>> @x @ The |print_char| procedure sends one character to the desired destination, using the |xchr| array to map it into an external character compatible with |input_ln|. All printing comes through |print_ln| or |print_char|. @= procedure print_char(@!s:ASCII_code); {prints a single character} begin case selector of term_and_log: begin wterm(xchr[s]); wlog(xchr[s]); incr(term_offset); incr(file_offset); if term_offset=max_print_line then begin wterm_cr; term_offset:=0; end; if file_offset=max_print_line then begin wlog_cr; file_offset:=0; end; end; log_only: begin wlog(xchr[s]); incr(file_offset); if file_offset=max_print_line then print_ln; end; term_only: begin wterm(xchr[s]); incr(term_offset); if term_offset=max_print_line then print_ln; end; no_print: do_nothing; pseudo: if tally= procedure print_char(@!s:ASCII_code); {prints a single character} begin @; case selector of term_and_log: begin wterm(xchr[s]); wlog(xchr[s]); incr(term_offset); incr(file_offset); if term_offset=max_print_line then begin wterm_cr; term_offset:=0; end; if file_offset=max_print_line then begin wlog_cr; file_offset:=0; end; end; log_only: begin wlog(xchr[s]); incr(file_offset); if file_offset=max_print_line then print_ln; end; term_only: begin wterm(xchr[s]); incr(term_offset); if term_offset=max_print_line then print_ln; end; no_print: do_nothing; pseudo: if tally>>>> @x [5] Turn off clearing typeahead after terminal input term_offset:=0; {the user's line ended with \<\rm return>} @y in_RAB^.VAX_RAB_purge_typeahead:=false; {turn off purging of typeahead} @.PTA@> term_offset:=0; {the user's line ended with \<\rm return>} @z {Section 68} <<<<>>>> @x @d print_err(#)==begin if interaction=error_stop_mode then wake_up_terminal; print_nl("! "); print(#); @.!\relax@> end @= @!interaction:batch_mode..error_stop_mode; {current level of interaction} @y @d print_err(#)==begin if interaction=error_stop_mode then wake_up_terminal; print_nl("! "); copy_err:=save_it; rewrite(temp_file); print(#); {Other |print|s will add to |temp_file|} @.!\relax@> end @= @!interaction:batch_mode..error_stop_mode; {current level of interaction} @z {Section 77} <<<<>>>> @x @ Here now is the general |error| routine. @y @ Here now is the general |error| routine, which completes output of the error message. @z {Section 77} <<<<>>>> @x begin if history; @y begin if history; show_context; if interaction=error_stop_mode then @; @z {Section 79} <<<<>>>> @x @ It is desirable to provide an `\.E' option here that gives the user an easy way to return from \MF\ to the system editor, with the offending line ready to be edited. But such an extension requires some system wizardry, so the present implementation simply types out the name of the file that should be edited and the relevant line number. @^system dependencies@> @y @ It is desirable to provide an `\.E' option here that gives the user an easy way to return from \MF\ to the system editor, with the offending line ready to be edited. This version of \MF\ invokes callable versions of various DEC editors, depending upon the value of the \.{/EDITOR} switch (normally set to \.{TEX\_EDIT}), @./EDITOR@> @.TEX_EDIT@> including \.{EDT}, \.{TPU}, DEC's Language-sensitive editor (LSEdit), and even @^EDT@> @^TPU@> @^Language-sensitive editor@> @^LSE@> \.{TECO}. @^TECO@> Other editors may be run in a sub-process by setting \.{/EDITOR} to any DCL command, including activating a command procedure. @^system dependencies@> In addition, if the \.{/CONTINUE} qualifier is present on the command line, @.{/CONTINUE} \MF\ will continue processing after returning from the editor. @z {Section 79} <<<<>>>> >>>>>Changed 30-JUN-1990 by DAH>>> @x "E": if file_ptr>0 then begin print_nl("You want to edit file "); @.You want to edit file x@> print(input_stack[file_ptr].name_field); print(" at line "); print_int(line);@/ interaction:=scroll_mode; jump_out; end; @y "E": if file_ptr>0 then begin if edit_file(input_stack[file_ptr],line) then begin if continue_qual then begin show_context; goto continue; end else begin interaction:=scroll_mode; jump_out; end end else begin print_nl("You want to edit file "); @.You want to edit file x@> print(input_stack[file_ptr].name_field); print(" at line "); print_int(line);@/ interaction:=scroll_mode; jump_out; end end; @z {Section 80} <<<<>>>> @x @= begin error_count:=0; interaction:=batch_mode+c-"Q"; print("OK, entering "); case c of "Q":begin print("batchmode"); decr(selector); end; "R":print("nonstopmode"); "S":print("scrollmode"); end; {there are no other cases} print("..."); print_ln; update_terminal; return; end @y We have to ensure that the message has been displayed \&{before} we switch off output to the terminal. @= begin error_count:=0; interaction:=batch_mode+c-"Q"; print("OK, entering "); case c of "Q":print("batchmode"); "R":print("nonstopmode"); "S":print("scrollmode"); end; {there are no other cases} print("..."); print_ln; update_terminal; if c = "Q" then decr (selector); return; end @z {Section 91} <<<<>>>> @x @ Users occasionally want to interrupt \MF\ while it's running. If the \PASCAL\ runtime system allows this, one can implement a routine that sets the global variable |interrupt| to some nonzero value when such an interrupt is signalled. Otherwise there is probably at least a way to make |interrupt| nonzero using the \PASCAL\ debugger. @^system dependencies@> @^debugging@> @y @ Users occasionally want to interrupt \MF\ while it's running. By using a VAX system service, we can declare an Asynchronous System Trap (AST) handler which will be called when the user types \.{Ctrl-C}. The AST handler then sets the global variable |interrupt| to some nonzero value when such an interrupt is signalled. @^system dependencies@> Since this variable may be changed at any time, we must prevent the compiler from applying optimizations to the code related to this variable (for example, it would not do for it to be held in a machine register), so we give it the VAX-\PASCAL\ `attribute' \.{volatile}, which is defined at this point. We also define a couple of other attributes that may be applied to affect the placement of variables under VAX-\PASCAL. Assuming that it's possible to assign an I/O channel to device \.{SYS\$COMMAND}, @.SYS{\$}COMMAND@> which should be the case provided the program is being run interactively, then the Control-C handler is declared by a call of the \.{\$QIOW} system service. @.{\$}QIOW@> Some parameters for this system service have to passed by the `immediate' parameter-passing mechanism; we take this opportunity to define all the means used in \MF\ to override VAX-\PASCAL's default parameter-passing mechanisms. @d VAX_volatile==@= volatile @> @d VAX_aligned==@= aligned @> @d VAX_static==@= static @> @# @d VAX_immed==@= %immed @> @d VAX_stdescr==@= %stdescr @> @d VAX_ref==@= %ref @> @# @d VAX_io_setmode==@= io$_setmode @> @d VAX_iom_ctrlcast==@= io$m_ctrlcast @> @# @d VAX_qiow==@= $qiow@> @d VAX_assign==@= $assign@> @# @z {Section 91} @x @d check_interrupt==begin if interrupt<>0 then pause_for_instructions; end @= @!interrupt:integer; {should \MF\ pause for instructions?} @y @d check_interrupt==begin if interrupt<>0 then pause_for_instructions; end @d enable_control_C== VAX_qiow(,tt_chan,VAX_io_setmode+VAX_iom_ctrlcast,,,, VAX_immed ctrlc_rout,,VAX_immed 3,,,); @= @!interrupt:[VAX_volatile]integer; {should \MF\ pause for instructions?} @z {Section 92} <<<<>>>> @x interrupt:=0; OK_to_interrupt:=true; @y interrupt:=0; OK_to_interrupt:=true; if VAX_assign('SYS$COMMAND',tt_chan,,)=VAX_ss_normal then enable_control_C; @z {Section 97} >>>>>John Lavignino (added 02-July-1990 DAH)>>>>> @x Made global for access by external arithmetic routines @= @!arith_error:boolean; {has arithmetic overflow occurred recently?} @y Here we also define the |VAX_global| specifier. @d VAX_global== @=global@> @= @!arith_error:[VAX_global]boolean; {has arithmetic overflow occurred recently?} @z {Sections 107,108} >>>>>John Lavignino (added 02-July-1990 DAH)>>>>> @x replace make_fraction with faster external routine @p function make_fraction(@!p,@!q:integer):fraction; var @!f:integer; {the fraction bits, with a leading 1 bit} @!n:integer; {the integer part of $\vert p/q\vert$} @!negative:boolean; {should the result be negated?} @!be_careful:integer; {disables certain compiler optimizations} begin if p>=0 then negative:=false else begin negate(p); negative:=true; end; if q<=0 then begin debug if q=0 then confusion("/");@;@+gubed@;@/ @:this can't happen /}{\quad \./@> negate(q); negative:=not negative; end; n:=p div q; p:=p mod q; if n>=8 then begin arith_error:=true; if negative then make_fraction:=-el_gordo@+else make_fraction:=el_gordo; end else begin n:=(n-1)*fraction_one; @; if negative then make_fraction:=-(f+n)@+else make_fraction:=f+n; end; end; @ The |repeat| loop here preserves the following invariant relations between |f|, |p|, and~|q|: (i)~|0<=p @= f:=1; repeat be_careful:=p-q; p:=be_careful+p; if p>=0 then f:=f+f+1 else begin double(f); p:=p+q; end; until f>=fraction_one; be_careful:=p-q; if be_careful+p>=0 then incr(f) @y Under VAX/VMS, we have replaced the \PASCAL\ version of |make_fraction| with an assembly-language version for greater speed: in assembly language we can do the multiple-precision calculation directly, rather than via iteration. This is a definition of their external interfaces: note the application of the `external' attribute, and use of the |extern| directive. @d VAX_external==@=external@> @p [VAX_external] function make_fraction(@!p,@!q:integer):fraction; extern; @ This section was deleted when |make_fraction| was removed. @z {Sections 109,110,111} >>>>>John Lavignino (added 02-July-1990 DAH)>>>>> @x replace take_fraction with faster external version @p function take_fraction(@!q:integer;@!f:fraction):integer; var @!p:integer; {the fraction so far} @!negative:boolean; {should the result be negated?} @!n:integer; {additional multiple of $q$} @!be_careful:integer; {disables certain compiler optimizations} begin @=0| and |q>0|@>; if f; be_careful:=n-el_gordo; if be_careful+p>0 then begin arith_error:=true; n:=el_gordo-p; end; if negative then take_fraction:=-(n+p) else take_fraction:=n+p; end; @ @=0| and |q>0|@>= if f>=0 then negative:=false else begin negate(f); negative:=true; end; if q<0 then begin negate(q); negative:=not negative; end; @ The invariant relations in this case are (i)~$\lfloor(qf+p)/2^k\rfloor =\lfloor qf_0/2^{28}+{1\over2}\rfloor$, where $k$ is an integer and $f_0$ is the original value of~$f$; (ii)~$2^k\L f<2^{k+1}$. @^inner loop@> @= p:=fraction_half; {that's $2^{27}$; the invariants hold now with $k=28$} if q>>>>John Lavignino (added 02-July-1990 DAH)>>>>> @x replace take_scaled with faster external version @p function take_scaled(@!q:integer;@!f:scaled):integer; var @!p:integer; {the fraction so far} @!negative:boolean; {should the result be negated?} @!n:integer; {additional multiple of $q$} @!be_careful:integer; {disables certain compiler optimizations} begin @=0| and |q>0|@>; if f; be_careful:=n-el_gordo; if be_careful+p>0 then begin arith_error:=true; n:=el_gordo-p; end; if negative then take_scaled:=-(n+p) else take_scaled:=n+p; end; @ @= p:=half_unit; {that's $2^{15}$; the invariants hold now with $k=16$} @^inner loop@> if q>>>>John Lavignino (added 02-July-1990 DAH)>>>>> @x replace make_scaled with faster external version @p function make_scaled(@!p,@!q:integer):scaled; var @!f:integer; {the fraction bits, with a leading 1 bit} @!n:integer; {the integer part of $\vert p/q\vert$} @!negative:boolean; {should the result be negated?} @!be_careful:integer; {disables certain compiler optimizations} begin if p>=0 then negative:=false else begin negate(p); negative:=true; end; if q<=0 then begin debug if q=0 then confusion("/");@+gubed@;@/ @:this can't happen /}{\quad \./@> negate(q); negative:=not negative; end; n:=p div q; p:=p mod q; if n>=@'100000 then begin arith_error:=true; if negative then make_scaled:=-el_gordo@+else make_scaled:=el_gordo; end else begin n:=(n-1)*unity; @; if negative then make_scaled:=-(f+n)@+else make_scaled:=f+n; end; end; @ @= f:=1; repeat be_careful:=p-q; p:=be_careful+p; if p>=0 then f:=f+f+1 else begin double(f); p:=p+q; end; until f>=unity; be_careful:=p-q; if be_careful+p>=0 then incr(f) @y Function |make_scaled| has also been replaced by an external routine. @ This section was deleted when |make_scaled| was replaced by an external routine. @p [VAX_external] function make_scaled(@!p,@!q:integer):scaled; extern; @z {Section 155} @x @d ho(#)==#-min_halfword {to take a sixteen-bit item from a halfword} @d qo(#)==#-min_quarterword {to read eight bits from a quarterword} @d qi(#)==#+min_quarterword {to store eight bits in a quarterword} @y @d ho(#)==# @d qo(#)==# @d qi(#)==# @z {Section 156} @x [8] block up word files @!word_file = file of memory_word; @y @!word_block = packed array [0..VAX_block_length-1] of memory_word; @!word_file = packed file of word_block; @z {Section 173} @x remove init..tini from procedure decl @p @!init procedure sort_avail; {sorts the available variable-size nodes by location} var @!p,@!q,@!r: pointer; {indices into |mem|} @!old_rover:pointer; {initial |rover| setting} begin p:=get_node(@'10000000000); {merge adjacent free areas} p:=rlink(rover); rlink(rover):=max_halfword; old_rover:=rover; while p<>old_rover do @; p:=rover; while rlink(p)<>max_halfword do begin llink(rlink(p)):=p; p:=rlink(p); end; rlink(p):=rover; llink(rover):=p; end; tini @y @p procedure sort_avail; {sorts the available variable-size nodes by location} var @!p,@!q,@!r: pointer; {indices into |mem|} @!old_rover:pointer; {initial |rover| setting} begin p:=get_node(@'10000000000); {merge adjacent free areas} p:=rlink(rover); rlink(rover):=max_halfword; old_rover:=rover; while p<>old_rover do @; p:=rover; while rlink(p)<>max_halfword do begin llink(rlink(p)):=p; p:=rlink(p); end; rlink(p):=rover; llink(rover):=p; end; @z {Section 194} @x Since standard \PASCAL\ cannot provide such information, something special is needed. The program here simply specifies July 4, 1776, at noon; but users probably want a better approximation to the truth. @y @z {Section 194} @x @p procedure fix_date_and_time; begin internal[time]:=12*60*unity; {minutes since midnight} internal[day]:=4*unity; {fourth day of the month} internal[month]:=7*unity; {seventh month of the year} internal[year]:=1776*unity; {Anno Domini} @y The requisite information is obtained through a call of the \.{\$NUMTIM} system @.{\$}NUMTIM@> service. @d VAX_numtim==@= $numtim@> @p procedure fix_date_and_time; var t:array[1..7] of signed_halfword; {raw year, month, day and time} begin VAX_numtim(t); internal[year]:=t[1]*unity; internal[month]:=t[2]*unity; internal[day]:=t[3]*unity; internal[time]:=(t[4]*60+t[5])*unity; {minutes since midnight} @z {Section 199} <<<<>>>> @x Treat tab and formfeed as blanks for k:=127 to 255 do char_class[k]:=invalid_class; @y char_class[tab]:=space_class; char_class[form_feed]:=space_class; for k:=127 to 255 do char_class[k]:=invalid_class; @z {Section 210} @x remove init..tini from procedure decl @p @!init procedure primitive(@!s:str_number;@!c:halfword;@!o:halfword); var @!k:pool_pointer; {index into |str_pool|} @!j:small_number; {index into |buffer|} @!l:small_number; {length of the string} begin k:=str_start[s]; l:=str_start[s+1]-k; {we will move |s| into the (empty) |buffer|} for j:=0 to l-1 do buffer[j]:=so(str_pool[k+j]); cur_sym:=id_lookup(0,l);@/ if s>=256 then {we don't want to have the string twice} begin flush_string(str_ptr-1); text(cur_sym):=s; end; eq_type(cur_sym):=c; equiv(cur_sym):=o; end; tini @y @p procedure primitive(@!s:str_number;@!c:halfword;@!o:halfword); var @!k:pool_pointer; {index into |str_pool|} @!j:small_number; {index into |buffer|} @!l:small_number; {length of the string} begin k:=str_start[s]; l:=str_start[s+1]-k; {we will move |s| into the (empty) |buffer|} for j:=0 to l-1 do buffer[j]:=so(str_pool[k+j]); cur_sym:=id_lookup(0,l);@/ if s>=256 then {we don't want to have the string twice} begin flush_string(str_ptr-1); text(cur_sym):=s; end; eq_type(cur_sym):=c; equiv(cur_sym):=o; end; @z {Section 390} @x VAX/VMS PASCAL COMPILER BUG!????? begin if odd(octant_before)=odd(octant_after) then cur_x:=x else cur_x:=-x; if (octant_before>negate_y)=(octant_after>negate_y) then cur_y:=y @y begin if (odd(octant_before) and odd(octant_after)) or (not odd(octant_before) and not odd(octant_after)) then cur_x:=x else cur_x:=-x; if ((octant_before>negate_y)and(octant_after>negate_y)) or ((octant_before<=negate_y)and(octant_after<=negate_y)) then cur_y:=y @z {Section 434} @x VAX/VMS PASCAL COMPILER BUG!????? if odd(right_type(p))<>odd(right_type(q)) then @y if (odd(right_type(p)) and not odd(right_type(q))) or (not odd(right_type(p)) and odd(right_type(q))) then @z {Section 564} >>>>>>Updated 8-AUG-1990 DAH>>>>> @x In fact, there are exactly four such routines: \yskip\hang |init_screen| does whatever initialization is necessary to support the other operations; it is a boolean function that returns |false| if graphic output cannot be supported (e.g., if the other three routines have not been written, or if the user doesn't have the right kind of terminal). \yskip\hang |blank_rectangle| updates a buffer area in memory so that all pixels in a specified rectangle will be set to the background color. \yskip\hang |paint_row| assigns values to specified pixels in a row of the buffer just mentioned, based on ``transition'' indices explained below. \yskip\hang |update_screen| displays the current screen buffer; the effects of |blank_rectangle| and |paint_row| commands may or may not become visible until the next |update_screen| operation is performed. (Thus, |update_screen| is analogous to |update_terminal|.) \yskip\noindent The \PASCAL\ code here is a minimum version of |init_screen| and |update_screen|, usable on \MF\ installations that don't support screen output. If |init_screen| is changed to return |true| instead of |false|, the other routines will simply log the fact that they have been called; they won't really display anything. The standard test routines for \MF\ use this log information to check that \MF\ is working properly, but the |wlog| instructions should be removed from production versions of \MF. @p function init_screen:boolean; begin init_screen:=false; end; @# procedure update_screen; {will be called only if |init_screen| returns |true|} begin @!init wlog_ln('Calling UPDATESCREEN');@+tini {for testing only} end; @y In fact, there are exactly four such routines: \yskip\hang |open_display| loads the appropriate library and prints a second banner message identifying the graphics library {\it unless\/} the user has specified \.{/NODISPLAY} @./DISPLAY@> or \.{/BATCH}. @./BATCH@> in which case it will set up |init_screen| so that it returns |false|. This routine should be called just after the main \MF\ banner is printed. |open_display| takes two parameters, both of which should be passed |var|---|screen_depth| and |screen_width| which will, on return, contain the size of the output display. \yskip\hang |init_screen| does whatever initialization is necessary to support the other operations; it is a boolean function that returns |false| if graphic output cannot be supported (e.g., if the other three routines have not been written, or if the user doesn't have the right kind of terminal). \yskip\hang |blank_rectangle| updates a buffer area in memory so that all pixels in a specified rectangle will be set to the background color. \yskip\hang |paint_row| assigns values to specified pixels in a row of the buffer just mentioned, based on ``transition'' indices explained below. \yskip\hang |update_screen| displays the current screen buffer; the effects of |blank_rectangle| and |paint_row| commands may or may not become visible until the next |update_screen| operation is performed. (Thus, |update_screen| is analogous to |update_terminal|.) All graphics routines should be sure to leave the terminal in a state for text printing upon completion of their actions. \yskip\hang |close_display| resets the display back to a ``normal'' state upon program completion. \yskip\noindent In addition to the above routines, which constitute the level~1 graphics libraries other routines may be provided by any sharable library for graphics. (There is an ulterior motive behind this having its roots in my desire to integrate this graphics library support into Andrew Trevorrow's DVItoVDU.) These functions will be described elsewhere. Having explained all of that, let's first insert |open_display| into the ``Initalize the output routines'' sequence. @= open_display(screen_width,screen_depth); @z {Section 565} >>>>>Added 08-AUG-1990 by DAH>>>>> @x @d white=0 {background pixels} @d black=1 {visible pixels} @= @!screen_row=0..screen_depth; {a row number on the screen} @!screen_col=0..screen_width; {a column number on the screen} @!trans_spec=array[screen_col] of screen_col; {a transition spec, see below} @!pixel_color=white..black; {specifies one of the two pixel values} @y We need to alter the way things are done somewhat since we don't know in advance what the values of |screen_depth| and |screen_width| are, so for convenience's sake we make |screen_row| and |screen_col| integers and assume that no display will have more than 65536 columns. @d white=0 {background pixels} @d black=1 {visible pixels} @= @!screen_row=integer; {a row number on the screen} @!screen_col=integer; {a column number on the screen} @!trans_spec=array[0..65536] of screen_col; {a transition spec, see below} @!pixel_color=white..black; {specifies one of the two pixel values} @z {Section 566} <<<<>>>> @x @ We'll illustrate the |blank_rectangle| and |paint_row| operations by pretending to declare a screen buffer called |screen_pixel|. This code is actually commented out, but it does specify the intended effects. @= @{@!screen_pixel:array[screen_row,screen_col] of pixel_color;@+@} @y @ Now we'll define the |open_display| routine. This is the single most complicated system-dependent routine in the graphics section of the code. We have four basic tasks: (1)~determine if we should be doing online displays at all (we don't do online displays if the \.{/BATCH} qualifier is given or the @./BATCH@> user says \.{/NODISPLAY}); (2)~determine the name of the display to be used: this involves getting the value of the \.{/DISPLAY} qualifier and if it ends @./DISPLAY@> with a colon, translating that value as a logical name before proceeding; (3)~find the entry for that display (if it's there at all) in the file given by the \.{/GLIB\_INDEX} qualifier and break that down into the area/extension and @./GLIB_INDEX@> filename for passing to \.{LIB\$FIND\_IMAGE\_SYMBOL} (what a lousy calling @.LIB\$FIND_IMAGE_SYMBOL@> syntax); (4) load the various routines into memory and call the |LIBINITSC| routine to print the graphics library banner and set |screen_width| and |screen_depth|. Before getting too much into that, however, we'll first take a moment to explain how we access files in the sharable libraries: if we were writing in C or Modula-2, it would be a simple matter to assign the address of a routine to the address returned by \.{LIB\$FIND\_IMAGE\_SYMBOL}, but we're not so a little subterfuge is necessary. Ned Freed of Innosoft International was kind enough to donate a routine from the MATHLIB package that solves the difficulty for us. What we do is define each routine in the library to point to the external routine |indirect|. That routine looks takes its last argument and transfers control to the address given by it with the remaining parameters as the calling list. The definition of |lib_init_screen| below is typical of how a routine called in this matter should be defined. Getting back to the task at hand. @d VAX_find_image == @= lib$find_image_symbol @> @d VAX_index == @= index @> @d VAX_indirect == @= (indirect) @> @d VAX_max == @= max @> @d VAX_min == @= min @> @d VAX_substr == @= substr @> @d VAX_len == @= length @> @p [VAX_external VAX_indirect] procedure@?lib_init_screen (VAX_ref x_size: screen_col; VAX_ref y_size: screen_row; VAX_immed entry: integer); extern;@t\2@>@/ @# procedure open_display(var screen_width:screen_row; var screen_depth:screen_col); var @!init_entry: integer; @!disp_len, @!index_len : file_size; @!disp_name, @!index_name, @!index_line, @!lib_name, @!lib_area, @!lib_fn: packed array [1..file_name_size] of char; @!found_lib_name: boolean; @!j, @!k: integer; @!glib_index: alpha_file; begin {Step one: should we even do graphics?} if not odd(VAX_cli_present('BATCH')) and odd(VAX_cli_present('DISPLAY')) then begin display_available:=true; {Step two: get the display name. check for a logical and translate it if it is} VAX_cli_get_value('DISPLAY',disp_name,disp_len); if disp_name[disp_len]=':' then begin disp_name[disp_len]:=' '; decr(disp_len); display_available:=translate(disp_name,disp_len); end; {Step three: Find the entry for the name in the file given by \.{GLIB\_INDEX}} VAX_cli_get_value('GLIB_INDEX',index_name,index_len); VAX_open_file(glib_index,index_name,VAX_readonly,VAX_ignore_error); display_available:=display_available and (status(glib_index)<=0); if display_available then begin reset(glib_index,VAX_ignore_error); display_available := (status(glib_index)<=0); end; if display_available then begin {find the values for the library name and location in the index file} found_lib_name:=false; repeat read_ln(glib_index,index_line); if (index_line[1]<>'!') and (index_line[1]<>' ') then begin j := VAX_index(index_line,'*'); k := VAX_index(index_line,' '); if j=0 then j:=disp_len+1; if k=0 then k:=j; j:=VAX_min(j,k)-1;; if VAX_substr(index_line,1,j)=VAX_substr(disp_name,1,j) then found_lib_name:=true; end; until found_lib_name or eof(glib_index); display_available:=found_lib_name; end; if display_available then begin {Now isolate the name of the library and split it up} k:=-1; lib_name:=''; for j:= 1 to file_name_size do begin if k=-1 then if index_line[j]=' ' then k:=0; if k=0 then if index_line[j]<>' ' then k:=j; if k>0 then if (index_line[j]=' ') and (lib_name='') then lib_name:=VAX_substr(index_line,k,j-k); end; if lib_name='' then lib_name:=VAX_substr(index_line,k, file_name_size-k); j:=VAX_max(VAX_index(lib_name,']'),VAX_index(lib_name,':')); lib_area:=VAX_substr(lib_name,1,j)+'.EXE'; lib_fn:=VAX_substr(lib_name,j+1,VAX_len(lib_name)-j); end; if display_available then begin VAX_find_image(VAX_stdescr lib_fn, VAX_stdescr 'LIBINITSC', init_entry, VAX_stdescr lib_area); lib_init_screen(screen_width,screen_depth,init_entry); display_available:=(screen_width<>0); end; if display_available then begin {Locate all the other entry points} VAX_find_image(VAX_stdescr lib_fn, VAX_stdescr 'LIBSTARTS', start_entry, VAX_stdescr lib_area);@/ VAX_find_image(VAX_stdescr lib_fn, VAX_stdescr 'LIBBLRECT', blank_entry, VAX_stdescr lib_area);@/ VAX_find_image(VAX_stdescr lib_fn, VAX_stdescr 'LIBDRWROW', draw_entry, VAX_stdescr lib_area);@/ VAX_find_image(VAX_stdescr lib_fn, VAX_stdescr 'LIBUPDTSC', update_entry, VAX_stdescr lib_area);@/ VAX_find_image(VAX_stdescr lib_fn, VAX_stdescr 'LIBCLOSSC', close_entry, VAX_stdescr lib_area); end; end else display_available:=false; end; @z {Section 567} <<<<>>>> @x @ The |blank_rectangle| routine simply whitens all pixels that lie in columns |left_col| through |right_col-1|, inclusive, of rows |top_row| through |bot_row-1|, inclusive, given four parameters that satisfy the relations $$\hbox{|0<=left_col<=right_col<=screen_width|,\quad |0<=top_row<=bot_row<=screen_depth|.}$$ If |left_col=right_col| or |top_row=bot_row|, nothing happens. The commented-out code in the following procedure is for illustrative purposes only. @^system dependencies@> @p procedure blank_rectangle(@!left_col,@!right_col:screen_col; @!top_row,@!bot_row:screen_row); var @!r:screen_row; @!c:screen_col; begin @{@+for r:=top_row to bot_row-1 do for c:=left_col to right_col-1 do screen_pixel[r,c]:=white;@+@}@/ @!init wlog_cr; {this will be done only after |init_screen=true|} wlog_ln('Calling BLANKRECTANGLE(',left_col:1,',', right_col:1,',',top_row:1,',',bot_row:1,')');@+tini end; @y @ Now, we will define all of the routines we need for the graphics interface. Each routine but |close_screen| has two definitions. One is the hook to the external routine which actually does the work and the other is the routine actually called by the main program. This indirection is due to (1)~a desire to simplify the hooks to the main program and (2)~the requirement that {\tt TRAPMF} must write certain information to the log file as it executes. @p [VAX_external VAX_indirect] procedure@?lib_start_screen(VAX_immed entry: integer); extern;@t\2@>@/ [VAX_external VAX_indirect] procedure@?lib_blank_rect(left_col, right_col : screen_col; top_row, bot_row : screen_col; VAX_immed entry: integer); extern;@t\2@>@/ [VAX_external VAX_indirect] procedure@?lib_draw_row(r: screen_row; b: pixel_color; var a: trans_spec; n: screen_col; VAX_immed entry: integer); extern;@t\2@>@/ [VAX_external VAX_indirect] procedure@?lib_update_screen(VAX_immed entry: integer); extern;@t\2@>@/ [VAX_external VAX_indirect] procedure@?lib_close_screen(VAX_immed entry: integer); extern;@t\2@> @# function init_screen: boolean; begin if display_available then begin if not init_flag then lib_start_screen(start_entry); init_screen:=true; end else init_screen:=false; end; @# procedure blank_rectangle(left_col, right_col : screen_col; top_row, bot_row : screen_row); begin if init_flag then begin wlog_cr; wlog_ln('Calling BLANKRECTANGLE(',left_col:1,',',right_col:1,',', top_row:1,',',bot_row:1,')'); end else lib_blank_rect(left_col, right_col, top_row, bot_row, blank_entry); end; @# procedure paint_row(r: screen_row; b: pixel_color; var a: trans_spec; n: screen_col); var k: integer; begin if init_flag then begin wlog('Calling PAINTROW(',r:1,',',b:1,';'); {this is done only after |init_screen=true|} for k:=0 to n do begin wlog(a[k]:1); if k<>n then wlog(','); end; wlog_ln(')'); end else lib_draw_row(r,b,a,n,draw_entry); end; @# procedure update_screen; begin if init_flag then wlog_ln('Calling UPDATESCREEN') else lib_update_screen(update_entry); end; @z {Section 568} >>>>>Added 08-AUG-1990 by DAH>>>>> @x @ The real work of screen display is done by |paint_row|. But it's not hard work, because the operation affects only one of the screen rows, and it affects only a contiguous set of columns in that row. There are four parameters: |r|~(the row), |b|~(the initial color), |a|~(the array of transition specifications), and |n|~(the number of transitions). The elements of~|a| will satisfy $$0\L a[0] @p procedure paint_row(@!r:screen_row;@!b:pixel_color;var @!a:trans_spec; @!n:screen_col); var @!k:screen_col; {an index into |a|} @!c:screen_col; {an index into |screen_pixel|} begin @{ k:=0; c:=a[0]; repeat incr(k); repeat screen_pixel[r,c]:=b; incr(c); until c=a[k]; b:=black-b; {$|black|\swap|white|$} until k=n;@+@}@/ @!init wlog('Calling PAINTROW(',r:1,',',b:1,';'); {this is done only after |init_screen=true|} for k:=0 to n do begin wlog(a[k]:1); if k<>n then wlog(','); end; wlog_ln(')');@+tini end; @y @ Finally, we need to define some variables to support the above routines: @= start_entry, blank_entry, draw_entry, update_entry, close_entry : integer; display_available : boolean; screen_depth: screen_row; screen_width: screen_col; @z {Section 635} <<<<>>>> @x @@/ begin file_ptr:=input_ptr; input_stack[file_ptr]:=cur_input; {store current state} @y @@/ begin file_ptr:=input_ptr; input_stack[file_ptr]:=cur_input; {store current state} @; @z {Section 635} <<<<>>>> @x done: cur_input:=input_stack[input_ptr]; {restore original state} end; @y done: cur_input:=input_stack[input_ptr]; {restore original state} @; end; @z {Section 637} <<<<>>>> @x @= if name<=1 then if terminal_input and(file_ptr=0) then print_nl("<*>") else print_nl("") else if name=2 then print_nl("") else begin print_nl("l."); print_int(line); end; @y @= if name<=1 then begin @; if terminal_input and(file_ptr=0) then print_nl("<*>") else print_nl(""); @; end else if name=2 then begin @; print_nl(""); @; end else begin print_nl("l."); print_int(line); @; end; @z {Section 638} <<<<>>>> @x @ @= case token_type of @y @ @= @; case token_type of @z {Section 638} <<<<>>>> @x endcases @y endcases; @ @z {Section 643} <<<<>>>> @x for q:=p to first_count-1 do print_char(trick_buf[q mod error_line]); print_ln; for q:=1 to n do print_char(" "); {print |n| spaces to begin line~2} if m+n<=error_line then p:=first_count+m else p:=first_count+(error_line-n-3); for q:=first_count to p-1 do print_char(trick_buf[q mod error_line]); if m+n>error_line then print("...") @y for q:=p to first_count-1 do print_char(trick_buf[q mod error_line]); @; if m+n<=error_line then p:=first_count+m else p:=first_count+(error_line-n-3); for q:=first_count to p-1 do print_char(trick_buf[q mod error_line]); if m+n>error_line then print("..."); @ @z {Section 644} <<<<>>>> @x begin if i=loc then set_trick_count; print(buffer[i]); end @y begin if i=loc then set_trick_count; print(buffer[i]); end; if name<=2 then @ @z {Section 645} <<<<>>>> @x else show_macro(start,loc,100000) @y else show_macro(start,loc,100000); @ @z {Section 768} <<<<>>>> @x following structure: If the name contains `\.>' or `\.:', the file area @y following structure: If the name contains `\.>', `\.]' or `\.:', the file area @z {Section 768} <<<<>>>> @x @!area_delimiter:pool_pointer; {the most recent `\.>' or `\.:', if any} @y @!area_delimiter:pool_pointer; {the most recent `\.>', `\.]' or `\.:', if any} @!MF_area:str_number; @!inp_name: packed array [1..file_name_size] of char; @!inp_len: file_size; @!i: integer; @z {Section 769} @x @d MF_area=="MFinputs:" @.MFinputs@> @y For VMS, we handle setting the names for this logical by defining it in the \.{CLD} file through the \.{/MFINPUTS} qualifier. @./MFINPUTS@> @.MFinputs@> @= VAX_cli_get_value('MFINPUTS',inp_name,inp_len); str_room(inp_len); for i := 1 to inp_len do append_char(xord[inp_name[i]]); MF_area:=make_string @z {Section 771} <<<<>>>> @x else begin if (c=">")or(c=":") then @y else begin if (c=">") or (c="]") or (c=":") then @z {Section 772} <<<<>>>> <<<<>>>> @x [38] Logical name translation: @ The third. @^system dependencies@> @p procedure end_name; begin if str_ptr+3>max_str_ptr then @y @ The third. We have to check to see if a logical name has been referred to, and if so, translate it. @^system dependencies@> @p procedure end_name; label restart,exit; var @!u:varying[file_name_size] of char; @!t:packed array[1..file_name_size] of char; @!i:pool_pointer; @!len:signed_halfword; @!c:char; begin restart: if (str_pool[area_delimiter]=si(":")) and (pool_ptr=area_delimiter+1) then begin cur_area:=make_string; len:=length(cur_area)-1; {don't include the colon} for i:=1 to len do t[i]:=xchr[so(str_pool[str_start[cur_area]+i-1])]; if not translate(t,len) then begin cur_ext:=""; cur_name:=""; {silly case} return; end; flush_string(cur_area); {needn't remember logical name in |cur_area|} begin_name; for i:=1 to len do if not more_name(xord[t[i]]) then goto restart; goto restart; {heavy!} end; if str_ptr+3>max_str_ptr then @z {Section 772} <<<<>>>> @x str_start[str_ptr]:=ext_delimiter; cur_ext:=make_string; end; end; @y str_start[str_ptr]:=ext_delimiter; cur_ext:=make_string; end; exit: end; @z {Section 775} <<<<>>>> @x [38] system logical names @d base_default_length=18 {length of the |MF_base_default| string} @d base_area_length=8 {length of its area part} @d base_ext_length=5 {length of its `\.{.base}' part} @d base_extension=".base" {the extension, as a \.{WEB} constant} @= @!MF_base_default:packed array[1..base_default_length] of char; @y We want to be able to load the name of the area where base files live from an argument on the command line. This requires that some \.{WEB} constants be changed to variables since we cannot know at compile time how long the argument to \.{/MFBASES} will be. @./MFBASES@> We also will take this opportunity to set the value for |pool_name| since we need the value given by \.{/MFBASES} to construct it. @d base_name_length=10 {length of |'plain.base'|} @d base_ext_length=5 {length of its `\.{.base}' part} @d base_extension=".base" {the extension, as a \.{WEB} constant} @d pool_name_length=7 @= @!MF_b_name_default:packed array [1..base_name_length] of char; {abbreviated name for conflict considerations} @!MF_base_default:packed array[1..file_name_size] of char; @!pool_name: packed array [1..file_name_size] of char; @!pool_f_name: packed array [1..pool_name_length] of char; @!base_area_length: file_size; {length of the area part} @!base_default_length: integer; {length of the whole mess upon construction} @z {Section 776} @x MF_base_default:='MFbases:plain.base'; @.MFbases@> @y MF_b_name_default:='plain.base'; pool_f_name:='MF.POOL'; VAX_cli_get_value('MFBASES',MF_base_default,base_area_length); pool_name:=MF_base_default; for i:=1 to pool_name_length do pool_name[i+base_area_length]:=pool_f_name[i]; for i:=1 to base_name_length do MF_base_default[i+base_area_length]:=MF_b_name_default[i]; base_default_length:=base_area_length+base_name_length; @z {Section 777} @x @ @= if base_default_length>file_name_size then bad:=41; @y @ There used to be a consistency check here, but since the value it checked wouldn't be set until {\it after\/} consistency checking, we've deleted it. Besides, our code will automaticaly guarantee consistency simply by the way that |MF_base_default| is defined. @z {Section 780} <<<<>>>> @x @ Operating systems often make it possible to determine the exact name (and possible version number) of a file that has been opened. The following routine, which simply makes a \MF\ string from the value of |name_of_file|, should ideally be changed to deduce the full name of file~|f|, which is the file most recently opened, if it is possible to do this in a \PASCAL\ program. @^system dependencies@> @y @ The VMS operating system is able to determine the exact name (and version number) of a file that has been opened through use of the |user_action| parameter of the |open| routine. The following routine makes an \MF\ string from the value of |last_name[1..last_length]|, which is the full specification of the most recently opened file. @^system dependencies@> @z {Section 780} @x [28] get file name from system begin if (pool_ptr+name_length>pool_size)or(str_ptr=max_strings) then make_name_string:="?" else begin for k:=1 to name_length do append_char(xord[name_of_file[k]]); make_name_string:=make_string; end; @y begin if (pool_ptr+last_length>pool_size)or(str_ptr=max_strings) then make_name_string:="?" else begin for k:=1 to last_length do append_char(xord[last_name[k]]); make_name_string:=make_string; end; @z {Section 784} <<<<>>>> @x @ Here is a routine that manufactures the output file names, assuming that |job_name<>0|. It ignores and changes the current settings of |cur_area| and |cur_ext|. @y @ Here is a routine that manufactures the output file names, assuming that |job_name<>0|. It ignores and changes the current settings of |cur_area| and |cur_ext|. Similarly, |pack_default_name| extracts a (possibly partial) file specification from the appropriate command line qualifier, if used, and creates a string which may be used to provide defaults for part of a file specification when opening certain auxiliary files. The routine |clear_default_name| is also provided to ensure that no defaults are applied on successive calls of |open|. @z {Section 784} <<<<>>>> <<<<>>>> @x @p procedure pack_job_name(@!s:str_number); {|s = ".log"|, |".gf"|, or |base_extension|} begin cur_area:=""; cur_ext:=s; cur_name:=job_name; pack_cur_name; end; @y @p procedure pack_job_name(@!s:str_number); {|s = ".lis"|, |".gf"|, |".dia"| or |base_extension|} begin cur_area:=""; cur_ext:=s; cur_name:=job_name; pack_cur_name; end;@# function pack_default_name(qual : boolean; df_name : packed array [l1..u1:integer] of char; df_len : file_size) : boolean; var k : integer; begin for k:=1 to file_name_size do default_name[k] := name_of_file[k]; deflt_length:=name_length; if qual then begin name_of_file := df_name; name_length := df_len; if name_length < file_name_size then for k:=name_length+1 to file_name_size do name_of_file[k]:=' '; end; pack_default_name := qual; {Result is whether file wanted} end;@# procedure clear_default_name; var k : integer; begin for k:=1 to file_name_size do default_name[k]:=' '; end; @z {Section 786} <<<<>>>> @x @ If some trouble arises when \MF\ tries to open a file, the following routine calls upon the user to supply another file name. Parameter~|s| is used in the error message to identify the type of file; parameter~|e| is the default extension if none is given. Upon exit from the routine, variables |cur_name|, |cur_area|, |cur_ext|, and |name_of_file| are ready for another attempt at file opening. @y @ If some trouble arises when \MF\ tries to open a file, the following routine calls upon the user to supply another file name. Parameter~|s| is used in the error message to identify the type of file; parameter~|e| is the default extension if none is given. Upon exit from the routine, variables |cur_name|, |cur_area|, |cur_ext|, and |name_of_file| are ready for another attempt at file opening. Because this procedure invokes the |print_err| macro, but does not terminate the ``error'' (by invoking |error|), we have to take special measures to prevent everything from here onwards being written to the |temp_file| used for diagnostics. It does this by resetting the |temp_file|. @z {Section 786} <<<<>>>> @x clear_terminal; prompt_input(": "); @; @y clear_terminal; prompt_input(": "); @; @; @z {Section 788} <<<<>>>> @x @ The |open_log_file| routine is used to open the transcript file and to help it catch up to what has previously been printed on the terminal. @p procedure open_log_file; @y @ The |open_log_file| routine is used to open the transcript file and to help it catch up to what has previously been printed on the terminal. @p @ @# procedure open_log_file; @z {Section 788} <<<<>>>> @x pack_job_name(".log"); while not a_open_out(log_file) do @; log_name:=a_make_name_string(log_file); @y pack_job_name(".lis"); if pack_default_name(log_qual,logf_name,logf_len) then begin while not a_open_out(log_file) do @; log_name:=a_make_name_string(log_file); clear_default_name end else log_name:="."; open_diag_file; @z {Section 789} @x prompt_file_name("transcript file name",".log"); @y prompt_file_name("transcript file name",".lis"); @z {Section 791} <<<<>>>> @x @d set_output_file_name== begin if job_name=0 then open_log_file; pack_job_name(gf_ext); while not b_open_out(gf_file) do prompt_file_name("file name for output",gf_ext); output_file_name:=b_make_name_string(gf_file); @y @d set_output_file_name== begin if job_name=0 then open_log_file; pack_job_name(gf_ext); if pack_default_name(gf_qual,gff_name,gff_len) then begin while not b_open_out(gf_file) do prompt_file_name("file name for output",gf_ext); output_file_name:=b_make_name_string(gf_file); clear_default_name; end else output_file_name:="."; @z {Section 793} <<<<>>>> @x @ Let's turn now to the procedure that is used to initiate file reading when an `\.{input}' command is being processed. @y @ Let's turn now to the procedure that is used to initiate file reading when an `\.{input}' command is being processed. As originally used by \MF82 under VMS, this procedure discarded the current file name (as returned to it by the operating system) after it had been printed. However, with this version of \MF, with its capability of writing diagnostic files for use by LSEdit's review mode, we need to be able to report the full file specifications of any files that may be involved in |show_context|; therefore, we do not call |flush_string| here. @z {Section 793} <<<<>>>> @x if name=str_ptr-1 then {we can conserve string pool space now} begin flush_string(name); name:=cur_name; end; @y @z {Section 807} <<<<>>>> @x print_exp(p,1); {``medium verbose'' printing of the expression} if s<>"" then begin print_nl("! "); print(s); @.!\relax@> end; @y print_exp(p,1); {``medium verbose'' printing of the expression} if s<>"" then begin print_nl("! "); @.!\relax@> copy_err:=save_it; rewrite(temp_file); print(s); end; @z {Section 1051} <<<<>>>> @x procedure do_show_whatever; begin if interaction=error_stop_mode then wake_up_terminal; @y procedure do_show_whatever; begin if interaction=error_stop_mode then wake_up_terminal; @; @z {Section 1133} @x @d tfm_out(#)==write(tfm_file,#) {output one byte to |tfm_file|} @y @d tfm_out(#)==begin tfm_file^[tfm_count]:=#; {output one byte to |tfm_file|} incr(tfm_count); if tfm_count=VAX_block_length then begin put(tfm_file,VAX_ignore_error); tfm_count:=0; end end @z {Section 1134} @x while not b_open_out(tfm_file) do prompt_file_name("file name for font metrics",".tfm"); @y while not b_open_out(tfm_file) do prompt_file_name("file name for font metrics",".tfm"); tfm_count:=0; @z {Section 1134} @x b_close(tfm_file) @y while tfm_count>0 do tfm_out(0); {flush out the buffer} b_close(tfm_file) @z {Section 1152} @x @ Some systems may find it more efficient to make |gf_buf| a |packed| array, since output of four bytes at once may be facilitated. @^system dependencies@> @= @!gf_buf:array[gf_index] of eight_bits; {buffer for \.{GF} output} @y @ Some systems may find it more efficient to make |gf_buf| a |packed| array, since output of four bytes at once may be facilitated. On Vax/VMS, we get even more complicated than that, for efficiency. @d gf_buf==g_buffer.b {buffer for \.{GF} output} @= @!g_buffer: [VAX_volatile,VAX_aligned(9)] packed record case boolean of false: (b:packed array[gf_index] of eight_bits); true: (l:byte_block; r:byte_block; j:eight_bits); end; @z {Section 1154} @x @ The actual output of |gf_buf[a..b]| to |gf_file| is performed by calling |write_gf(a,b)|. It is safe to assume that |a| and |b+1| will both be multiples of 4 when |write_gf(a,b)| is called; therefore it is possible on many machines to use efficient methods to pack four bytes per word and to output an array of words with one system call. @^system dependencies@> @= procedure write_gf(@!a,@!b:gf_index); var k:gf_index; begin for k:=a to b do write(gf_file,gf_buf[k]); end; @y @ The actual output of |gf_buf[a..b]| to |gf_file| is performed by calling |write| on the other variant of the |gf_buf| record. Thus, we have to be sure that things line up properly. @^system dependencies@> @= if gf_buf_size<>2*VAX_block_length then bad:=223; @z {Section 1155} @x begin write_gf(0,half_buf-1); gf_limit:=half_buf; @y begin write(gf_file,g_buffer.l); gf_limit:=half_buf; @z {Section 1155} @x else begin write_gf(half_buf,gf_buf_size-1); gf_limit:=gf_buf_size; @y else begin write(gf_file,g_buffer.r); gf_limit:=gf_buf_size; @z {Section 1156} @x if gf_limit=half_buf then write_gf(half_buf,gf_buf_size-1); if gf_ptr>0 then write_gf(0,gf_ptr-1) @y if gf_limit=half_buf then write(gf_file,g_buffer.r); for k:=gf_ptr to gf_buf_size do gf_buf[k]:=223; if gf_ptr>0 then write(gf_file,g_buffer.l); if gf_ptr>half_buf then write(gf_file,g_buffer.r); @z {Section 1186} >>>>>Added 30-JUN-1990 by DAH>>>> @x remove init..tini from procedure decl>>>>> @!init procedure store_base_file; var @!k:integer; {all-purpose index} @!p,@!q: pointer; {all-purpose pointers} @!x: integer; {something to dump} @!w: four_quarters; {four ASCII codes} begin @; @; @; @; @; @; @; end; tini @y procedure store_base_file; var @!k:integer; {all-purpose index} @!p,@!q: pointer; {all-purpose pointers} @!x: integer; {something to dump} @!w: four_quarters; {four ASCII codes} begin @; @; @; @; @; @; @; end; @z {Section 1188} @x @d dump_wd(#)==begin base_file^:=#; put(base_file);@+end @d dump_int(#)==begin base_file^.int:=#; put(base_file);@+end @d dump_hh(#)==begin base_file^.hh:=#; put(base_file);@+end @d dump_qqqq(#)==begin base_file^.qqqq:=#; put(base_file);@+end @y @d base_put==begin incr(base_count); if base_count=VAX_block_length then begin put(base_file,VAX_ignore_error); base_count:=0; end end @d base_word==base_file^[base_count] @d dump_wd(#)==begin base_word:=#; base_put;@+end @d dump_int(#)==begin base_word.int:=#; base_put;@+end @d dump_hh(#)==begin base_word.hh:=#; base_put;@+end @d dump_qqqq(#)==begin base_word.qqqq:=#; base_put;@+end @z {Section 1189} @x @d undump_wd(#)==begin get(base_file); #:=base_file^;@+end @d undump_int(#)==begin get(base_file); #:=base_file^.int;@+end @d undump_hh(#)==begin get(base_file); #:=base_file^.hh;@+end @d undump_qqqq(#)==begin get(base_file); #:=base_file^.qqqq;@+end @y @d base_get==begin incr(base_count); if base_count=VAX_block_length then begin get(base_file,VAX_ignore_error); base_count:=0; end end @d undump_wd(#)==begin base_get; #:=base_word;@+end @d undump_int(#)==begin base_get; #:=base_word.int;@+end @d undump_hh(#)==begin base_get; #:=base_word.hh;@+end @d undump_qqqq(#)==begin base_get; #:=base_word.qqqq;@+end @z {Section 1191} @x x:=base_file^.int; @y x:=base_word.int; @z {Section 1201} @x w_close(base_file) @y while base_count>0 do dump_int(0); {flush out the buffer} w_close(base_file) @z {Section 1203} @x @!ready_already:integer; {a sacrifice of purity for economy} @y @!ready_already:integer; {a sacrifice of purity for economy} @!init_flag: boolean; @z {Section 1204} <<<<>>>> @x @ Now this is really it: \MF\ starts and ends here. The initial test involving |ready_already| should be deleted if the \PASCAL\ runtime system is smart enough to detect such a ``mistake.'' @^system dependencies@> @y @ Now this is really it: \MF\ starts and ends here. The initial test involving |ready_already| should be deleted if the \PASCAL\ runtime system is smart enough to detect such a ``mistake'' @^system dependencies@> and in fact it has been deleted. We also take this opportunity to find out if we're supposed to be \MF\ or {\tt INIMF}. (As an interesting note, Knuth simply uses {\tt INIMF} for everything now. Since the only difference between the two programs relates to the writing of base files and a few items at start up, there is effectively no performance difference.) Since all files are opened with a |disposition:=delete| clause, they will be deleted automatically if the program does not complete properly. However, if a fatal error occurs, the |jumpout| procedure also causes termination of the program without closing the files, therefore we ensure that at least the |log_file| gets closed so that the fatal error can be examined! @z {Section 1204} >>>>>Added 30-JUN-1990 by DAH>>>>> @x if ready_already=314159 then goto start_of_MF; @y init_flag := odd (VAX_cli_present('INIT')); @z {Section 1204} <<<<>>>> @x start_of_MF: @; @y start_of_MF: @; @; @z {Section 1204} @x Modify end of MF to emit exit status end_of_MF: close_files_and_terminate; final_end: ready_already:=0; end. @y end_of_MF: close_files_and_terminate; final_end: ready_already:=0; if log_opened then begin wlog_cr; a_close(log_file); selector:=selector-2; if selector=term_only then begin if log_qual then begin print_nl("Transcript written on "); @.Transcript written...@> print(log_name); print_char("."); end else print_nl("No transcript file."); end; end; @; end. @z {Section 1205} <<<<>>>> @x if log_opened then begin wlog_cr; a_close(log_file); selector:=selector-2; if selector=term_only then begin print_nl("Transcript written on "); @.Transcript written...@> print(log_name); print_char("."); end; end; @y if diag_qual then begin print_nl("Diagnostics written on "); print(diag_name); print_char("."); wdiag_cr; wdiag_ln('end module'); a_close(diag_file); end; @z {Section 1210} >>>>>Added 30-JUN-1990 by DAH>>>>> @x remove init..tini from procedure decl @!init procedure init_prim; {initialize all the primitives} begin @; end; @# procedure init_tab; {initialize other tables} var @!k:integer; {all-purpose index} begin @@; end; tini @y procedure init_prim; {initialize all the primitives} begin @; end; @# procedure init_tab; {initialize other tables} var @!k:integer; {all-purpose index} begin @@; end; @z {Section 1211} >>>>>Added 1-JUL-1990 by DAH>>>>>> @x @; @y @; @; @z {Section 1214...} <<<<>>>> @x This section should be replaced, if necessary, by any special modifications of the program that are necessary to make \MF\ work at a particular installation. It is usually best to design your change file so that all changes to previous sections preserve the section numbering; then everybody's version will be consistent with the published program. More extensive changes, which introduce new sections, can be inserted here; then only the index itself will get a new section number. @y Here are the remaining changes to the program that are necessary to make \.{MF} work on Vax/VMS. Firstly, putting the cart before the horse, this is how we can return the final status of \MF\ to the operating system, in such a way that DCL command procedures and the like can determine whether the run of \MF\ was successfull or not. We use the \.{\$EXIT} system service; the value of its parameter is @.{\$}EXIT@> given by an appropriate symbolic constant taken from the \.{starlet} library. We also take this opportunity to call the |symbol_jobname| routine (defined below). @d VAX_exit==@=$exit@> @d VAX_ss_normal==@= sts$k_success @> @d VAX_ss_ignore==@= sts$m_inhib_msg @> @d VAX_ss_warning==@= sts$k_warning+sts$m_inhib_msg @> @d VAX_ss_error==@= sts$k_error+sts$m_inhib_msg @> @d VAX_ss_fatal==@= sts$k_severe+sts$m_inhib_msg @> @= if gf_prev_ptr>0 then symbol_jobname; case history of { Issue an appropriate VAX exit status } spotless: VAX_exit(VAX_ss_normal); { Everything OK! } warning_issued: VAX_exit(VAX_ss_warning); error_message_issued: VAX_exit(VAX_ss_error); fatal_error_stop: VAX_exit(VAX_ss_fatal) endcases @ |symbol_jobname| is a routine which takes the |job_name| string and the numeric portion of the extension of the output file and writes that information to the DCL symbols given by the parameters of the \.{/JOBNAME\_SYMBOL} and \.{/JOBSIZE\_SYMBOL}. The code here is based on code donated by Jim Walker of South Carolina University. @d VAX_set_symbol == @= lib$set_symbol @> @= procedure@?VAX_set_symbol(VAX_immed symbol: descr_ptr; VAX_immed value_string: descr_ptr; tbl_ind: integer); external; @t\2@> @# procedure symbol_jobname; var l_jobname: packed array [1..file_name_size] of char; l_len_name: file_size; l_jobsize: packed array [1..file_name_size] of char; l_len_size: file_size; tmp_descr: descr_ptr; tmp_str: str_number; begin if odd(VAX_cli_present('JOBNAME_SYMBOL')) and odd(VAX_cli_present('JOBSIZE_SYMBOL')) then begin tmp_descr:=nil; VAX_cli_get_value('JOBNAME_SYMBOL',l_jobname,l_len_name); VAX_cli_get_value('JOBSIZE_SYMBOL',l_jobsize,l_len_size); str_to_descr(job_name,tmp_descr); VAX_set_symbol (VAX_stdescr l_jobname, tmp_descr, 2); {Now we re-do the numeric part of the extension (see section 1164)} old_setting:=selector; selector:=new_string; print_int(make_scaled(internal[hppp],59429463)); {$2^{32}/72.27\approx59429463.07$} tmp_str:=make_string; selector:=old_setting; str_to_descr(job_name,tmp_descr); VAX_set_symbol (VAX_stdescr l_jobsize, tmp_descr, 2); end; end; @ Support is provided for the \.{REVIEW} mode of DEC's Language-sensitive editor, @^Language-sensitive editor@> @^LSE@> by generating a \.{.dia} file. Any output sent via this routine is also repeated to that file if the global |copy_err| is |print_it|: if the characters are being ``repeated'' to produce a \.{label} for a \.{region/text} directive, then characters will only be copied if no more than |label_max| have been output; this is controlled by |label_size|. Negative values for this variable always permit printing. Since \MF\ produces its error messages by many separate calls to various printing routines, we accumulate the full text in the \PASCAL\ internal file |temp_file| when |copy_err| is set to |save_it|. This file can later be |reset| and ``played back'' by standard \PASCAL\ routines. @d label_max=14 @= case copy_err of print_it: begin if label_size<> 0 then diag_char(s); if label_size>0 then decr(label_size) end; ignore_it: do_nothing; save_it: temp_char(s) endcases @ We introduce here variables which control the action of error reporting routines. When error message display is commenced, the variable |copy_err| is set to |save_it|: this causes parts of the error message to be saved in the internal file |temp_file|, which is rewound at this point. Certain parts of the error message are not so saved (|copy_err=ignore_it|). This variable is also used to cause messages to be written (|copy_err=print_it|) to the diagnostics file |diag_file|. Since VAX-\PASCAL\ supports proper enumeration types, we don't bother with defining numeric constants for this. When information is being written to the |diag_file|, we restrict the ``label'' portion of a diagnostic message to |label_max| characters, to preserve on-screen alignment in LSEdit's \.{REVIEW} buffer. Characters are only output through to the |diag_file| if |label_size| is non-zero, and this variable is decremented after each character has been output if it is positive. Thus negative values of |label_size| do not impose any restriction on the amount of text that may be output to the |diag_file|. @= @!copy_err:(ignore_it,print_it,save_it); @!label_size:-1..label_max; {Restricts ``printing'' in the \.{.dia} file} @ After the terminating period has been written, |copy_err| is reset to prevent further output to |temp_file|, which is also reset, ready to be ``replayed'' into the diagnostics file itself. This code is also used during initialization, and also before prompting for a new file name when \MF\ has been unable to find a users' file. @= copy_err:=ignore_it; reset(temp_file) {Full \MF\ message in |temp_file|} @ Every error message that \MF\ creates is ``wrapped'' into a \.{diagnostic} environment for use by LSE's \.{REVIEW} mode. This is the text generated for the start of such an environment. @= wdiag_ln('!'); wdiag_ln(' start diagnostic') @ And this finishes off the \.{diagnostic} environment: we copy into it the informational part of \MF's own error message. @= wdiag(' message "%MF-E-MFERROR, '); while not eof(temp_file) do begin wdiag(temp_file^); get(temp_file) end; wdiag_ln('"'); wdiag_ln(' end diagnostic') @ If the error report arises within the expansion of a macro, \MF\ will report the expansions of all macros and arguments involved: each such line of information is used in the diagnostics file as a \.{label} (in the terminology of LSE's \.{REVIEW} mode). This is how we start it off, and ensure that no more than |label_max| characters are printed, thus preserving alignment of the text within the \.{\$REVIEW} buffer. @= wdiag(' region/text/label="'); copy_err:=print_it; label_size:=label_max @ The rest of the context (display of macro expansions, or whatever) forms the remainder of the diagnostic region label. @= copy_err:=ignore_it; wdiag('" "') @ On the other hand, if \MF's error report specifies a location within a source file, the diagnostic region generated in the diagnostics file reports that location thus: @= wdiag(' region/file/primary '); diag_print(name); wdiag_ln(' -'); {Continuation line follows} wdiag_ln(' /line=',line:1,'/column_range=(1,65535)') @ Whenever |show_context| involves printing out a token list, we arrange to capture the printed tokens for our diagnostic file. @= wdiag(' region/text/label="'); copy_err:=print_it; label_size:=label_max @ As we write out the second line of the original source, split at the point of error detection, we don't want to include within the diagnostic file the newline nor the leading spaces. This looks like horrible duplication of code, but remember that |copy_err=print_it| \&{only} if a diagnostic file is being generated. @= if copy_err=print_it then begin copy_err:=ignore_it; print_ln; for q:=1 to n do print_char(" "); {print |n| spaces to begin line~2} copy_err:=print_it end else begin print_ln; for q:=1 to n do print_char(" "); {print |n| spaces to begin line~2} end @ After we've completed the display of the error context, we are able to complete the diagnostic region within the diagnostics file. @= if copy_err=print_it then begin wdiag('"/line=1/column_range=('); n:=n-l; wdiag_ln(n+1:1,',65535)'); copy_err:=ignore_it; end else wdiag_ln(' region/nested/column=',loc-start+1:1) @ When we are writing the remainder of the context to the terminal and/or transcript file, we need to ensure that it is also \&{all} copied to the diagnostics file. The diagnostic is completed by ``playing back'' the contents of the |temp_file|, which contains \MF's error message. @= begin copy_err:=print_it; label_size:=-1 end @ When the \.{\string\show} primitive is used, it will later involve the display of a token; the latter would cause output to be written to the |temp_file| used for accumulating error messages for the diagnostics file, so we ensure here that the file will not be overfilled. @= copy_err:=ignore_it; rewrite(temp_file); {Internal file will later be |reset|} @ The |open_diag_file| routine is used to open a file into which error diagnostics are written to support DEC's Language-sensitive Editor (LSEdit). @^Language-sensitive editor@> @^LSE@> These may be used by the latter to locate the editor at the position within the source file at which an error has been detected. @= procedure open_diag_file; var k : 0..buf_size; {index into |buffer|} begin pack_job_name(".dia"); if pack_default_name(diag_qual,diagf_name,diagf_len) then begin while not a_open_out(diag_file) do prompt_file_name("diagnostics file name",".dia"); diag_name:=a_make_name_string(diag_file); clear_default_name; wdiag_ln('start module'); end else diag_name:="."; end; @ Here are a number of variables used during the initial extraction of the command line and its qualifiers. Firstly, we require separate flags for each of the possible qualifiers. We also need to declare those variables associated with support for the diagnostics file, utilized by LSEdit. @^Language-sensitive editor@> @^LSE@> When \MF\ is producing error messages, they are created in ``dribs and drabs''; we utilize a \PASCAL\ `internal' file |temp_file| to accumulate the whole message for transfer to the diagnostics file. This mechanism is also used to create a command line by means of which an editor can be invoked by the user answering `\.e' in response to \MF's error prompt. Since such invocation of an editor will disrupt access to the values associated with any qualifiers on the \.{MF} command, we have to provide storage space for any values provided with those qualifiers, so that they may be read during the initialization phase, in preparation for use later (in some cases, much later) in the program. For each such piece of text, we need somewhere to save it, and somewhere else to record its length, for use with |pack_default_name|. @= @!base_qual, @!gf_qual, @!cmd_line_present, @!edit_qual, @!continue_qual, @!batch_qual, @!log_qual, @!diag_qual : boolean; @# @!diag_file : alpha_file; @!diag_name : str_number; @!temp_file : alpha_file; @# @!logf_name, @!diagf_name, @!edit_name, @!gff_name : packed array [1..file_name_size] of char; @!logf_len, @!diagf_len, @!gff_len, @!edit_len : file_size; @ Since we provide a command-line qualifier which will ``preload'' a base file, it would be best to extract all the qualifiers before the |banner| gets printed, so that the correct preloaded base can be displayed (it will never {\it really\/} be preloaded, but a VAX doesn't take long to read a \.{.FMT} file!) The |cmd_line_present| flag will later avoid clearing the |buffer| if a command-line has already been ``read'' into it. We can control \MF's operation in |batch_mode| through the \.{/BATCH} qualifier. At this point, we also initialize |copy_err|, which controls the insertion into the diagnostics file of text being (pseudo)printed in traditional \MF\ error message. @= diag_name := 0; get_command_line; if batch_qual then interaction:=batch_mode; copy_err:=ignore_it@; @ For interacting with a user-supplied command line, we need to call the VAX standard library routines \.{CLI\$PRESENT}, \.{CLI\$GET\_VALUE} and \.{LIB\$GET\_FOREIGN}. @.CLI{\$}PRESENT@> @.CLI{\$}GET_VALUE@> @.LIB{\$}GET_FOREIGN@> @= [VAX_external] function VAX_cli_present(@/ VAX_stdescr entity:[VAX_volatile] packed array [l1..u1:integer] of char := VAX_immed 0) : integer; @/extern;@;@t\2@>@# [VAX_external] function VAX_cli_get_value(@/ VAX_stdescr entity:[VAX_volatile] packed array [l1..u1:integer] of char := VAX_immed 0; VAX_stdescr returns:[VAX_volatile] packed array [l2..u2:integer] of char := VAX_immed 0; var retlen:[VAX_volatile] sixteen_bits := VAX_immed 0):integer; @/ extern;@;@t\2@>@# [VAX_external] function VAX_lib_get_foreign( VAX_stdescr cmdlin:[VAX_volatile] packed array [l1..u1:integer] of char := VAX_immed 0; VAX_stdescr prompt:[VAX_volatile] packed array [l2..u2:integer] of char := VAX_immed 0; var len : [VAX_volatile] sixteen_bits := VAX_immed 0; var flag : [VAX_volatile] integer := VAX_immed 0) :integer; @/ extern; @ Logically, the following procedure belongs with |init_terminal|; however, we can't declare it there because it calls functions which don't get declared until later, so we'll stuff it in just before the main program starts. If an editor is invoked later, its use of the command-line interface parsing routines will ``disable communications'', so we'd better extract any values associated with qualifiers now. The various flags are set or cleared according as to whether the associated qualifier is or is not present. @= procedure get_command_line; var users_command: packed array[1..300] of char; @!len: sixteen_bits; @!i: integer; @!j: 0..buf_size; begin cmd_line_present := odd(VAX_cli_present('COMMAND_LINE')); edit_qual := odd(VAX_cli_present('EDITOR')); if edit_qual then VAX_cli_get_value('EDITOR',edit_name,edit_len); continue_qual := odd(VAX_cli_present('CONTINUE')); batch_qual := odd(VAX_cli_present('BATCH')); gf_qual := odd(VAX_cli_present('OUTPUT')); if gf_qual then VAX_cli_get_value('OUTPUT',gff_name,gff_len); log_qual := odd(VAX_cli_present('LOG_FILE')); if log_qual then VAX_cli_get_value('LOG_FILE',logf_name,logf_len); diag_qual := odd(VAX_cli_present('DIAGNOSTICS')); if diag_qual then VAX_cli_get_value('DIAGNOSTICS',diagf_name,diagf_len); base_qual := odd(VAX_cli_present('BASE')); if base_qual then begin VAX_cli_get_value('BASE',users_command,len); loc := 0; buffer[0] := xord['&']; j := 1; for i := 1 to len do begin buffer[j] := xord[users_command[i]]; incr(j) end; buffer[j] := xord[' ']; { |open_base_file| requires space after name } if base_ident <> 0 then initialize; if not open_base_file then goto final_end; if not load_base_file then begin w_close(base_file); goto final_end; end; w_close(base_file); end; end; @ Here are the things we need for |byte_file| and |word_file| files: @= @!gf_count: 0..VAX_block_length; @!tfm_count:0..VAX_block_length; @!base_count:0..VAX_block_length; @ Here's the interrupt stuff. At this point, we define some attributes for specifying particular sizes and alignments of numerical quantities in VAX-\PASCAL. @d VAX_word==@= word @> @d VAX_longword==@= long @> @d VAX_byte==@= byte @> @d VAX_unsigned==@= unsigned @> @= @!signed_halfword=[VAX_word] -32768..32767; @!sixteen_bits=[VAX_word] 0..65535; @!file_size=[VAX_word] 0..file_name_size; @ @= @!itm: array [1..4] of VAX_unsigned; @!res:[VAX_volatile] integer; @!tt_chan: [VAX_volatile] signed_halfword; @ @= [asynchronous] procedure @!ctrlc_rout; begin interrupt:=1; enable_control_C; end; @ Here is the stuff for magic file operations. % DAH--added @@! stuff to the beginnings of the type definitions. % Yes, Virginia, it does make a difference! (12-July-1990) @d VAX_FAB_type==@= FAB$type @> @d VAX_RAB_type==@= RAB$type @> @d VAX_NAM_type==@= NAM$type @> @= @!unsafe_file = [unsafe] file of char; @!FAB_ptr = ^VAX_FAB_type; @!RAB_ptr = ^VAX_RAB_type; @!NAM_ptr = ^VAX_NAM_type; @!chrptr = ^char; @ We supply the following two routines to be used (in a call of the VAX-\PASCAL\ |open| procedure) as a |user_action| function. When called from within the |open| routine, the addresses of the |FAB| and |RAB| allocated to the file are passed to such a function, along with the file variable; the latter is tagged as `unsafe' to prevent undesirable compiler optimizations. The two external functions |VAX_PAS_FAB| and |VAX_PAS_RAB| permit access by the program to these structures after the file has been opened. @d VAX_create==@=$create@> @d VAX_connect==@=$connect@> @d VAX_open==@=$open@> @# @d VAX_FAB_L_NAM== @=FAB$L_NAM@> @d VAX_NAM_B_RSL== @=NAM$B_RSL@> @d VAX_NAM_L_RSA== @=NAM$L_RSA@> @= function user_reset (var FAB:VAX_FAB_type; var RAB:VAX_RAB_type; var F:unsafe_file):integer; var status:integer; NAM:NAM_ptr; p:chrptr; i:integer; begin last_length:=0; status:=VAX_open(FAB); if odd(status) then status:=VAX_connect(RAB); if odd(status) then begin NAM:=FAB.VAX_FAB_L_NAM::NAM_ptr; if NAM<>nil then last_length:=NAM^.VAX_NAM_B_RSL; for i:=1 to last_length do begin p:=(NAM^.VAX_NAM_L_RSA::integer+i-1)::chrptr; last_name[i]:=p^; end; end; user_reset:=status; end; @# function user_rewrite (var FAB:VAX_FAB_type; var RAB:VAX_RAB_type; var F:unsafe_file):integer; var status:integer; NAM:NAM_ptr; p:chrptr; i:integer; begin status:=VAX_create(FAB); if odd(status) then status:=VAX_connect(RAB); if odd(status) then begin NAM:=FAB.VAX_FAB_L_NAM::NAM_ptr; if NAM<>nil then last_length:=NAM^.VAX_NAM_B_RSL; for i:=1 to last_length do begin p:=(NAM^.VAX_NAM_L_RSA::integer+i-1)::chrptr; last_name[i]:=p^; end; end; user_rewrite:=status; end; @# function VAX_PAS_FAB(var foobar:unsafe_file):FAB_ptr; extern;@;@t\2@>@/ function VAX_PAS_RAB(var foobar:unsafe_file):RAB_ptr; extern; @ @= in_FAB,out_FAB,fyl_FAB: FAB_ptr; in_RAB,out_RAB,fyl_RAB: RAB_ptr; last_length: integer; last_name:packed array [1..file_name_size] of char; @ The following procedure is used to translate any logical name that may appear as its parameter into its equivalence string and makes use of the \.{\$TRNLNM} @.{\$}TRNLNM@> system service in place of the obsolete \.{\$TRNLOG}. If the content of the @.{\$}TRNLOG@> buffer is a logical name, it is replaced by its equivalence string and the routine returns |true|. If no translation can be found, the result is |false|, and the original string is left unchanged. The VAX-\PASCAL\ procedure |substr| is used to extract a substring into the |varying| array which is passed to the system service, whilst another VAX-specific function |iaddress| is used to obtain the address of various data items to fill in the |item_list|. @d VAX_trnlnm==@= $trnlnm@> @d VAX_lnm_case_blind==@= lnm$m_case_blind @> @d VAX_lnm_string==@= lnm$_string @> @# @d VAX_address_of==@= iaddress@> @= function translate ( var t : packed array [l1..u1 : integer] of char; var len : signed_halfword): boolean; var @!s: varying[file_name_size] of char; @!trnlnm_return: integer; {what did the \.{\$TRNLNM} return?} @!return_length : [VAX_volatile] integer; @!attributes : unsigned; @!item_list : [VAX_volatile] array [0..1] of VMS_item_list; begin s:=VAX_substr(t,1,len); attributes := VAX_lnm_case_blind; return_length := 0; with item_list[0] do begin buffer_length := file_name_size; item_code := VAX_lnm_string; buffer_addr := VAX_address_of(t); ret_len_addr := VAX_address_of(return_length); end; item_list[1].next_item := 0; trnlnm_return := VAX_trnlnm(attributes,'LNM$DCL_LOGICAL',s,,item_list); len := return_length; translate := trnlnm_return=VAX_ss_normal; end; @ Here is a new type introduced to support \.{\$TRNLNM}. Many Vax/VMS system @.{\$}TRNLNM@> services make use of an |item_list| to pass information in and out. An |item_list| consists of a number of |item_list| elements, with each element containing the following fields: \centerline{\vtop{\offinterlineskip\hrule \halign{\vrule#\hskip2pt&\strut#\hfil&#\hfil&#\hfil&\hskip2pt\vrule#\cr height2pt&\omit&\omit&\omit&\cr &\hfil Name & \hfil Type & \hfil Usage&\cr height2pt&\omit&\omit&\omit&\cr \noalign{\hrule} height2pt&\omit&\omit&\omit&\cr &|buffer_length| & 16-bit word & Size of buffer&\cr &|item_code| & unsigned 16-bit word & Code for desired operation&\cr &|buffer_address| & Pointer to char & Address of buffer&\cr &|ret_len_addr| & Pointer to integer & To receive length of translation&\cr height2pt&\omit&\omit&\omit&\cr} \hrule }} This structure is overlaid with a single 32-bit integer whose use is solely to hold the value zero indicating the end of the list. @== @!VMS_item_list = packed record case boolean of true: ( @!buffer_length : sixteen_bits;@/ @!item_code : sixteen_bits;@/ @!buffer_addr : [VAX_longword] integer;@/ @!ret_len_addr : [VAX_longword] integer); false: ( @!next_item : [VAX_longword] integer) end; @ If the user, in response to \MF's error message, elects to edit the source file, then we have to find some method of invoking an editor. The simplest solution, under VAX/VMS, is simply to spawn a sub-process, but this is expensive in terms of image activation and might leave the sub-process short of page file quota, since the latter is shared by all processes in the current `job'. Therefore, where possible, we invoke a ``callable'' editor, which merely requires that we find the relevant editor's entry point in an installed shareable image. However, the library routine which can perform this trick returns the entry point as an address, and yet we want the \PASCAL\ code to think that it's invoking the editor through a procedure call, passing appropriate parameter(s). The callable versions of LSEdit @^Language-sensitive editor@> @^LSE@> and TPU each require a single parameter which is @^TPU@> @.EDIT/TPU@> a string similar to the DCL command that could be used to invoke the non-callable versions. In the case of EDT @^EDT@> @.EDIT/EDT@> @^Callable editors@> and TECO, @^TECO@> @.EDIT/TECO@> the first parameter gives the name of the file to be edited, the second (if used) names the output file, whilst the third can specify the name of a command file. Both editors can also take further parameters, and their meanings differ, but luckily we don't need any of these other parameters! Unfortunately, \PASCAL\ provides no mechanism by which a routine, which has amongst its formal parameters one which is in turn another routine, may be called with anything but the name of an \\{actual} routine (with congruent parameters) substitued for that formal parameter. Therefore, it is not permissible to pass the address of the routine instead and yet that is all that we have available! We therefore provide a procedure which calls, in turn, the actual editor ``procedure'', and resorting to subterfuge, invoke a rather useful VAX Library Routine: @d VAX_lib_callg==@= lib$callg@> @= [VAX_external] function VAX_lib_callg ( VAX_immed arg_list : [VAX_longword] integer; VAX_immed user_proc: [VAX_longword] integer) : integer; extern;@t\2@>@# function call_editor ( @!proc: [VAX_longword] integer; @!param_1, @!param_3 : [VAX_volatile] descr_ptr ) : integer; var @!call_G_descriptor : packed array [1..4] of [VAX_longword] integer; begin call_G_descriptor[1] := 1; {Number of arguments} call_G_descriptor[2] := param_1::integer; {DCL-like command line or name of file to be edited} if param_3 <> nil then begin call_G_descriptor[1] := 3; {EDT and TECO require more arguments} call_G_descriptor[3] := 0; {Default the output file name} call_G_descriptor[4] := param_3::integer; {Editor command file} end; call_editor:=VAX_lib_callg(VAX_address_of(call_G_descriptor),proc) end; @ Here is the interface to two routines from the run-time library to handle dynamic strings. Also, we declare here the interface to the \.{LIB\$SIGNAL} @.LIB{\$}SIGNAL@> library function, because we don't have much else to fall back on if an error crops up whilst allocating strings! @d str_allocate ==@= str$get1_dx@> @d str_release ==@= str$free1_dx@> @d lib_signal ==@= lib$signal@> @d VAX_char_string==@= dsc$k_dtype_t @> @d VAX_class_S==@= dsc$k_class_s @> @d VAX_class_D==@= dsc$k_class_d @> @= function str_allocate( VAX_ref alloc : sixteen_bits; VAX_immed descrp : descr_ptr ) : integer; extern;@t\2@> @# function str_release ( VAX_immed descrp : descr_ptr ) : integer; extern;@t\2@> @# procedure lib_signal ( VAX_immed cond_code : integer ); extern; @ Some editors require either command or file specifications to be passed to them as parameters, which in turn requires that they be passed in the form of string descriptors. Many of the strings that we have to deal with are held within \MF's string pool. This routine converts a \.{WEB}-type string (from the pool) into an appropriate VAX-\PASCAL\ string descriptor. Any existing string described by |dynam_str| is returned to the operating system and a new string allocated to reflect the actual length of the string in |pool_string|. @= procedure str_to_descr( @!pool_string : str_number; var @!dynam_str : [VAX_volatile] descr_ptr); var @!ch_ptr, @!str_stat : integer; @!str_size : sixteen_bits; @!ch_ctr : chrptr; begin if dynam_str = nil then begin new( dynam_str ); with dynam_str^ do begin len := 0; desc_type := VAX_char_string; desc_class := VAX_class_D; string := 0 end; end else if dynam_str^.len <> 0 then begin str_stat := str_release( dynam_str ); if not odd(str_stat) then lib_signal(str_stat) end; ch_ptr := str_start[pool_string]; str_size := str_start[pool_string+1]-str_start[pool_string]; str_stat := str_allocate(str_size,dynam_str); if not odd(str_stat) then lib_signal(str_stat); ch_ctr := dynam_str^.string :: chrptr; while str_size>0 do begin ch_ctr^ := xchr[so(str_pool[ch_ptr])]; ch_ctr := (ch_ctr::integer + 1)::chrptr; incr(ch_ptr); decr(str_size) end; end; @ Here is where we declare a structure to hold a VMS Descriptor. We could just have used one of the definitions in the \.{STARLET} library that we've inherited, but declaring it here is an aid to understanding. \centerline{\vtop{\offinterlineskip\hrule \halign{\vrule#\hskip2pt&\strut#\hfil&#\hfil&#\hfil&\hskip2pt\vrule#\cr height2pt&\omit&\omit&\omit&\cr &\hfil Name & \hfil Type & \hfil Usage&\cr height2pt&\omit&\omit&\omit&\cr \noalign{\hrule} height2pt&\omit&\omit&\omit&\cr &|len| & 16-bit word & Elements in the array&\cr &|desc_type| & unsigned 8-bit byte & Type of items in array&\cr &|desc_class| & unsigned 8-bit byte & \\{e.g.} Fixed, Varying, Dynamic&\cr &|string| & Pointer to char & Address of first item in array&\cr height2pt&\omit&\omit&\omit&\cr} \hrule }} It also makes life much easier, when passing dynamic strings as parameters, especially to system services and library routines which expect to be passed the address of such a descriptor, to have a type which is a pointer to such a descriptor, and then pass the pointer's value by immediate parameter-passing mechanism. @= @!descr_type = packed record {A VAX-descriptor object} len : sixteen_bits; desc_type : eight_bits; desc_class: eight_bits; string : [VAX_longword] integer; end; @!descr_ptr = ^descr_type; @ Here is a procedure to dispose of dynamically-allocated strings when they are no longer required. @= procedure release ( @!string : descr_ptr ); var str_stat : integer; begin if string <> nil then begin str_stat := str_release( string ); if not odd(str_stat) then lib_signal( str_stat ); dispose(string); string := nil; end; end; @ This version of \MF\ supports various editors; that required by the user must be specified by the VMS logical name \.{MF\_EDIT} (by analogy with @.MF_EDIT@> @.MAIL{\$}EDIT@> \.{MAIL\$EDIT}). If this logical name translates to one of the strings `\.{Callable\_LSE}', `\.{Callable\_TPU}', `\.{Callable\_EDT} @.Callable_xxx@> or `\.{Callable\_TECO}', the appropriate editor is invoked from its callable shared image. Any other equivalence string for \.{MF\_EDIT} is treated as a DCL command, and a sub-process is spawned in which the command is executed; the name of the file to be edited, together with the location of the error, are passed as parameters to this DCL command, which will most usefully, therefore, be defined to invoke a command procedure. Here is a data structure which holds details of the supported callable editors: @= @!editor_ident = packed record @!logical : packed array [1..file_name_size] of char; @!image, @!entry, @!quitting, @!exiting, @!cmd_text: str_number; @!cmd_offset : integer; @!start_qual, @!EDT_like : boolean end; @ We need a suitably sized array of such structures: @d max_editor=4 @# @d LSE_editor=1 @d TPU_editor=2 @d EDT_editor=3 @d TECO_editor=4 @= @!editor : packed array [1..max_editor] of editor_ident; @ And we needs must initialize them: @= with editor[LSE_editor] do begin logical := 'CALLABLE_LSE'; image := "LSESHR"; entry := "LSE$LSE"; quitting := "TPU$_QUITTING"; exiting := "TPU$_EXITING"; cmd_text := "LSEdit"; cmd_offset := 0; start_qual:=true; EDT_like := false; end; with editor[TPU_editor] do begin logical := 'CALLABLE_TPU'; image := "TPUSHR"; entry := "TPU$TPU"; quitting := "TPU$_QUITTING"; exiting := "TPU$_EXITING"; cmd_text := "EDIT/TPU"; cmd_offset := 5; {Actual command expected by \.{TPU\$TPU} omits \.{EDIT/}} start_qual:=true; EDT_like := false; end; with editor[EDT_editor] do begin logical := 'CALLABLE_EDT'; image := "EDTSHR"; entry := "EDT$EDIT"; quitting := 0; exiting := 0; cmd_text := "EDIT/EDT"; cmd_offset := 0; start_qual:=false; EDT_like := true; end; with editor[TECO_editor] do begin logical := 'CALLABLE_TECO'; image := "TECOSHR"; entry := "TECO$EDIT"; quitting := 0; exiting := 0; cmd_text := "EDIT/TECO"; cmd_offset := 0; start_qual := false; EDT_like := true; end; @ When we invoke an editor, there are three (possibly more?) potential outcomes: (1) The editor cannot be invoked --- perhaps we should find some other method; (2) The user makes no change to the file (quits); (3) The use produces a new version of the file. This type allows us to discriminate between these outcomes: @= @!edit_result = (failed,quit,edited); @ If the user elects to edit the relevant input file in response to an error message, we prefer to use an editor provided as a ``callable image'', since this saves the overhead of spawning a sub-process. DEC provide callable versions of EDT, @^EDT@> @.EDIT/EDT@> @^Callable editors@> TPU, @^TPU@> @.EDIT/TPU@> LSEdit (the language-sensitive editor), @^Language-sensitive editor@> @^LSE@> and even for that editor beloved of many, TECO. @^TECO@> @.EDIT/TECO@> To activate such a callable image, we need to load it into the process's \.{P0} space, and determine its entry point before transferring control to it with appropriate parameters. If it proves impossible to load a suitable callable image, we can adopt the expedient of spawning a new (DCL) sub-process, and pass to it the command to be executed. When such a spawned sub-process is given a single command to execute, the exit status of that command is passed back to the parent process when the sub-process exits. In most useful applications of such a sub-process, the ``command'' to be executed will be a DCL command procedure; the code below will accept an exit status of $1$ as indicating that an edit has taken place, the value $0$ (which is of warning severity level) as showing that the edit was aborted (the user quit), and any other value will be interpreted as indicative of a failure of the sub-process to perform editing. The official definition of \.{LIB\$SPAWN} has about a dozen parameters, but @.LIB{\$}SPAWN@> since all of them are optional, and we only need to pass a command (which is the first parameter) and get back the completion status (which is the seventh), we'll pretend that it only takes seven parameters. @d VAX_lib_spawn ==@= lib$spawn@> @= [VAX_external] function VAX_find_image ( VAX_immed @!filenm : descr_ptr; VAX_immed @!symbol : descr_ptr; VAX_ref @!symbol_value : [VAX_volatile,VAX_longword] integer; VAX_immed @!image_name : descr_ptr := VAX_immed 0) : integer; @/ extern;@t\2@> @# [VAX_external] function VAX_lib_spawn ( VAX_immed cmd : descr_ptr; VAX_immed sys_input : descr_ptr := VAX_immed 0; VAX_immed sys_output : descr_ptr := VAX_immed 0; VAX_ref flags : [VAX_longword] integer := VAX_immed 0; VAX_immed prcnm : descr_ptr := VAX_immed 0; VAX_ref pid : [VAX_longword] integer := VAX_immed 0; VAX_ref status : [VAX_longword] integer := VAX_immed 0 ): integer; @/ extern;@t\2@> @# function Edit ( @!filenm, @!cmd_file : str_number; @!editor : editor_ident ): edit_result; var @!edit_command_line : descr_ptr; @!char_ct : sixteen_bits; @!editor_entry : integer; @!editor_status, @!str_stat : integer; @!ch_ptr : chrptr; @!quit_status, @!exit_status : integer; @!image_symbol, @!entry_point, @!bad_symbol, @!good_symbol : descr_ptr; @!edit_file, @!edit_cmd : descr_ptr; begin @; edit_command_line := nil; @; edit_file:=nil; edit_cmd:=nil; if editor.EDT_like then {Such editors take \\{filenames} as parameters} begin str_to_descr(filenm,edit_file); str_to_descr(cmd_file,edit_cmd); end; Edit := failed; {Assume the worst!} editor_status := 4; {Neither edited nor quitted} quit_status := 0; {Users' command procedures can return this for quitting} exit_status := VAX_ss_normal; @; if editor.image <> 0 then {Possibly callable} begin if VAX_find_image(image_symbol,entry_point,editor_entry)=VAX_ss_normal then @ else editor.image := 0 {Indicate inability to invoke shareable image} end; if editor.image = 0 then {Use non-shareable-image editing} str_stat:=VAX_lib_spawn(cmd:=edit_command_line,status:=editor_status); @; @ end; @ The data structure |editor| contains pool strings giving the name of the required shareable image and the names of symbols which are to be sought for in it. This is where we translate those strings into dynamic ones to be passed to \.{LIB\$FIND\_IMAGE\_SYMBOL} @.LIB{\$}FIND_IMAGE_SYMBOL@> @== image_symbol := nil; entry_point := nil; bad_symbol := nil; good_symbol := nil; str_to_descr(editor.image,image_symbol); str_to_descr(editor.entry,entry_point); str_to_descr(editor.quitting,bad_symbol); str_to_descr(editor.exiting,good_symbol) @ If we're to invoke a callable editor, we have now obtained its entry point, which will have caused its image to be loaded into the process's \.{P0} space. Now we find within the image the values associated with the symbols which indicate whether the editor was used to create a new file or whether the use quit without creating a new file (only possible for LSEdit and TPU; with EDT and TECO, we assume that any successful exit resulted in the creation of a new file). @= begin @; if editor.EDT_like then editor_status:=call_editor(editor_entry,edit_file,edit_cmd) else @; end @ Just to keep things tidy, we dispose of all dynamic strings used by |Edit| before exit; this ensures that repeated invocation of an editor will not result in the ``eating up'' of virtual memory. @= release(image_symbol); release(entry_point); release(bad_symbol); release(good_symbol); release(edit_command_line); release(edit_file); release(edit_cmd); @ After the editor, whether running in a spawned sub-process or as a callable version in a shared image, has returned control to \MF, we attempt to interpret its exit status. Having removed any flag instructing the CLI to ignore the error status (because the editor will have reported such an error already), we attempt to match the exit status against the values which we have preset as indicating normal exit or quit from the editor. Any other value will leave the value |failed| to be returned by |Edit|: this should cause \MF\ to inform the user that the edit will have to be performed ``off-line''. @= if editor_status>=VAX_ss_ignore then editor_status:=editor_status-VAX_ss_ignore; if editor_status = exit_status then Edit := edited else if editor_status = quit_status then Edit := quit @ As well as containing the entry point at which the callable editor should be entered, its image file may also contain global symbols which give the exit status which will be returned by the editor if the user exits successfully, having written a new file, or quits without writing a new file. We extract the values of these symbols so that this status can be interpreted on exit from this procedure |Edit|. @= if editor.quitting<>0 then if not odd(VAX_find_image(image_symbol,bad_symbol,quit_status)) then quit_status := VAX_ss_normal; if editor.exiting<>0 then if not odd(VAX_find_image(image_symbol,good_symbol,exit_status)) then exit_status := VAX_ss_normal @ If we're invoking the callable version of TPU, we have to remove the `\.{EDIT/}' from the `\.{EDIT/TPU...}' command that we've constructed in |edit_command_line|. This code removes the first |editor.cmd_offset| characters of the command by overwriting with spaces, which achieves the desired effect. We then invoke the editor through |call_editor|. @= begin ch_ptr := edit_command_line^.string :: chrptr; for char_ct := 1 to editor.cmd_offset do begin ch_ptr^ := ' '; {Expunge the first |cmd_offset| characters} ch_ptr := (ch_ptr::integer + 1)::chrptr end; editor_status:=call_editor(editor_entry,edit_command_line,nil); end @ So far, we've managed to construct in the |temp_file| a command to be passed to the callable editor (through appropriate diversion to that \PASCAL\ internal file during the analysis of the logical \.{MF\_EDIT}). So that we can allocate @.MF_EDIT@> an appropriately sized dynamic string and its descriptor to be passed to the callable image, we need initially to determine how long that command really is: @= reset(temp_file); char_ct:=1; while not eof(temp_file) do begin get(temp_file); incr(char_ct) end @ Now we can allocate the dynamic string to hold the editor command, and copy the latter into it. Perhaps it might be thought that this could be simplified, because we could ``replay'' the command from the |temp_file| into a pool string by setting |selector| to |new_string| and then using |str_to_descr|: however, I'm not sure that this would be safe if in so doing we exceeded the allocated string pool, so we're going to do a bit more work! @= new( edit_command_line ); with edit_command_line^ do begin len := 0; desc_type := VAX_char_string; desc_class := VAX_class_D; string := 0 end; str_stat := str_allocate( char_ct, edit_command_line ); if not odd(str_stat) then lib_signal(str_stat); ch_ptr := edit_command_line^.string::chrptr; reset(temp_file); while not eof(temp_file) do begin ch_ptr^ := temp_file^; get(temp_file); ch_ptr := (ch_ptr::integer + 1)::chrptr end @ Certain VAX callable editors (\.{LSE} and \.{TPU}) accept a qualifier which may be used to specify the row and column number at which the editor's cursor is to be positioned. This routine adds suitable characters to the editor command line currently under construction in |temp_file|. @= procedure edit_locate(@!line, @!col : integer); begin print("/START_POSITION=("); print_int(line); print_char(","); print_int(col); print(") ") end; @ The function |edit_file| is called from the error reporting routine with the context of an input file and the line number as parameters. It forms a command for the desired editor (making using of |temp_file| and various of the error printing routines). The function returns |true| if it was able to invoke an editor. If |false| is returned, the user-interface routine should tell the user what and where to edit, and exit from \MF. First of all, we need to make a forward declaration in order that the code which interprets the user's response can be compiled to call this procedure. @= function edit_file( @!stack_item : in_state_record; line : integer ) : boolean; forward; @ But the function itself needs to \\{follow} all those declared in \.{WEB} modules, so we put it just before the main program itself. To determine what name to use in invoking the editor, this function attempts to translate the value of \.{/EDITOR}; if the translation is recognized, then we'll use that as the value, otherwise, we'll use the value given by \.{/EDITOR}. If the editing of the file has (or could have) created a new version of the source file, then steps are taken to ensure that further edits all access the newly created file(s) rather than the original. @= function edit_file; {|( @!stack_item : in_state_record; line : integer ) : boolean|} var @!equivalence : packed array [1..file_name_size] of char; @!equv_len : signed_halfword; @!old_setting : integer; @!edit_status : edit_result; @!edit_ctr : integer; @!edit_found : integer; @@; begin old_setting:=selector; selector:=log_only; edit_file := false; edit_status:=failed; {Assume the worst!} equivalence:=edit_name; equv_len:=edit_len; if edit_qual then if equivalence[equv_len]=':' then begin equivalence[equv_len]:=' '; decr(equv_len); edit_qual:=translate(equivalence,equv_len); end; if edit_qual then @; if edit_status<>failed then begin edit_file := true; if edit_status=edited then @ end; selector:=old_setting; end; @ If the logical \.{MF\_EDIT} has a suitable translation, we attempt to @.MF_EDIT@> identify the ``preferred'' editors (preferred in the sense that they can be invoked from a shareable image, without the overhead of spawning a new process). @= begin print_nl("Issuing the following command:"); @.Issuing the following command:@> @; @; if edit_found<>0 then @ else @; copy_err:=ignore_it; selector:=old_setting; end @ The equivalence string for \.{MF\_EDIT} needs to be converted to upper-case, @.MF_EDIT@> to ensure that it may be matched to the names of the preferred editors. @= for edit_ctr:=1 to equv_len do if equivalence[edit_ctr] in ['a'..'z'] then equivalence[edit_ctr] := xchr[xord[equivalence[edit_ctr]]+"A"-"a"] @ Now that we have the equivalence string in upper-case, we attempt to match it with the names of the preferred editors in the data structure |editor|. @= edit_ctr:=1; edit_found:=0; while (edit_ctr<=max_editor) and (edit_found=0) do begin if VAX_index(editor[edit_ctr].logical,equivalence) = 1 then edit_found:=edit_ctr; incr(edit_ctr) end; @ Well, we now know that the user wishes to use one of the supported \\{callable} editors. So the next move is to construct suitable command strings and invoke the editor from the appropriate shareable image. @= with editor[edit_found] do begin rewrite(temp_file); copy_err:=save_it; print_nl(cmd_text); if start_qual then with stack_item do edit_locate(line,loc_field-start_field+1); if edit_found=EDT_editor then @; if edit_found=TECO_editor then @; print(stack_item.name_field); copy_err:=ignore_it; selector:=old_setting; if EDT_like then begin edit_status := Edit(stack_item.name_field,cmd_file,editor[edit_found]); @ end else edit_status := Edit(0,0,editor[edit_found]); end @ The common-or-garden \.{EDT} editor doesn't have a qualifier to specify the starting position, so we create a small command file, and specify its name on the \.{/COMMAND} qualifier for \.{EDT} The command file contains line-mode commands to position the cursor appropriately. Strictly speaking, it is illegal to issue a \.{CHANGE} command (which is the only one that accepts no-keypad commands to position the cursor) except from a terminal, and \.{EDT} will display a message about this when it executes the command from the command file; however, it \\{does} honour the command correctly, so the end does justify the means! \MF\ has none of \TeX's auxiliary output streams for textual files, so this VAX/VMS implementation has introduced one such especially for use when creating an editor command file. It is accessed by letting |selector=aux_write|. @= begin new_selector:=aux_write; name_of_file:='MF_EDTINI'; default_name:='.EDT'; if a_open_out(aux_file) then begin cmd_file:=make_name_string; equivalence:='EDTINI'; equv_len:=6; {If it's defined} if not translate(equivalence,equv_len) then equv_len:=6; copy_err:=ignore_it; selector:=new_selector; print("SHOW COMMAND"); print_ln; print("CHANGE "); print_int(line); print_char(";"); with stack_item do print_int(loc_field-start_field); print("(+C)"); print_ln; print("SET MODE CHANGE"); print_ln; print("SET COMMAND "); for kkk:=1 to equv_len do print_char(xord[equivalence[kkk]]); a_close(aux_file); copy_err:=save_it; selector:=log_only; print("/COMMAND="); print(cmd_file); print_char(" "); end end @ Here are the other variables used in the above module: @= @!new_selector,@!file_ctr,@!kkk : integer; @!cmd_file : str_number; @ Neither does the \.{TECO} editor accept such a qualifier, so again we create a suitable command file. @= begin new_selector:=aux_write; name_of_file:='MF_TECOINI'; default_name:='.TEC'; if a_open_out(aux_file) then begin cmd_file:=make_name_string; equivalence:='TEC_INIT'; equv_len:=8; {If it's defined} copy_err:=ignore_it; selector:=new_selector; if translate(equivalence,equv_len) then begin if equivalence[1]='_' then begin print("EI"); for kkk:=2 to equv_len do print_char(xord[equivalence[kkk]]); end else for kkk:=1 to equv_len do print_char(xord[equivalence[kkk]]); print_char(@"1B); print_ln; end; print("@@^U1/"); print_int(line); print("U0"); with stack_item do print_int(loc_field-start_field); print("U20U1<(Q1+1)U1(Q0-Q1-1):;L(.-Z)""LF>'^E""L(Q1+1)U1'P>Q2CT/"); print_char(@"1B); print_char(@"1B); print_ln; a_close(aux_file); copy_err:=save_it; selector:=log_only; print("/COMMAND="); print(cmd_file); print_char(" "); @ end end @ Unfortunately, the present version (V40.36) of \.{TECO} does not appear to make use of the third parameter (which is supposed to be the name of an initialization file). Therefore, we create (or redefine) the logical name \.{TEC\_INIT}, which the callable version of TECO will then use. Afterwards, of @.TEC_INIT@> course, we have to put things back as they were, since otherwise a further invocation of the editor would introduce a circularity. The requirement for \.{TEC\_INIT} is that its first character shall be a dollar sign (`\.\$') to indicate that the rest of the logical name gives the name of a file to be used for initialization. @d VAX_create_logical==@= $crelnm@> @= begin TECO_cmd := '$'; kkk:=str_start[cmd_file]; while kkk= @!TECO_cmd : [VAX_volatile] varying [file_name_size] of char; @!item_list : [VAX_volatile] array [0..1] of VMS_item_list; @ After \.{EDT} or \.{TECO} has completed its editing, we are at liberty to delete the command file that was used to direct the cursor to the appropriate place. We've got the full file specification saved up from when the file was created, so we can go ahead and use the VAX-\PASCAL\ |delete_file| command to remove the file. @d VAX_delete_logical==@= $dellnm@> @d VAX_delete_file ==@= delete_file@> @= begin if edit_found=TECO_editor then begin if equv_len>0 then begin with item_list[0] do begin buffer_length := equv_len; item_code := VAX_lnm_string; buffer_addr := VAX_address_of(equivalence); ret_len_addr := 0; end; item_list[1].next_item := 0; VAX_create_logical(,'LNM$PROCESS_TABLE','TEC_INIT',,item_list); end else VAX_delete_logical('LNM$PROCESS_TABLE','TEC_INIT'); end; VAX_delete_file(last_name) end @ Once a source file has been edited, any further calls of an editor should access the latest version of the source file, rather than that first opened by \MF. Therefore, as a crude approximation to this desired outcome, we truncate the file specification held in the pool by substituting spaces for the `\.;' and any characters that follow it in there. (This is a good approximation, since generally any revised file will have been written out to the next higher version number, and the method adopted is easier than trying to shuffle all of the pool down to fill the vacant space.) @= begin had_semicolon := false; for next_ch := str_start[stack_item.name_field] to str_start[stack_item.name_field+1]-1 do begin if str_pool[next_ch] = si(";") then had_semicolon := true; if had_semicolon then str_pool[next_ch] := si(" ") end; end @ Here's the necessary global variables for the previous module: @= @!next_ch : pool_pointer; @!had_semicolon : boolean; @ If we were unable to recognize the equivalence string for the \.{MF\_EDIT} @.MF_EDIT@> logical name, it's assumed to be a DCL command (most probably preceded by an `\.@@' to invoke a command procedure). The command will be run in a sub-process, and provided with three parameters: the name of the file to be edited, and the row and column numbers (starting from 1) of the file at which the error was detected. The following code constructs the requisite DCL command ready to be passed to the spawned sub-process by procedure |Edit|. As for the callable editors above, this command is constructed in the \PASCAL\ internal file |temp_file|, using various print commands. @= begin rewrite(temp_file); copy_err:=save_it; print_ln; for kkk:=1 to equv_len do print(xord[equivalence[kkk]]); print(" "); print(stack_item.name_field); print(" "); print_int(line); print(" "); with stack_item do print_int(loc_field-start_field+1); edit_status := Edit(0,0,empty_editor); end @ Here's a dummy |editor| structure to be passed to |Edit| for non-callable editors: @= @!empty_editor : editor_ident; @ and its initialization: @= with empty_editor do begin logical := ''; image := 0; entry := 0; quitting := 0; exiting := 0; cmd_text := 0; cmd_offset := 0; start_qual := false; EDT_like := false; end; @z These were stripped out of section 9 above, because they are all provided at the point of first use. However, I've saved them in case any have been overlooked. @d VAX_new==@= new @> @d VAX_none==@= none @> @d VAX_word==@= word @> @d VAX_length==@= length @> @d VAX_record_length==@= record_length @> @d VAX_syi_sid==@= syi$_sid @> @d VAX_continue==@= continue @> @d VAX_external==@= external @> @d VAX_readonly==@= readonly @> @d VAX_volatile==@= volatile @> @d VAX_aligned==@= aligned @> @d VAX_unsigned==@= unsigned @> @d VAX_static==@= static @> @d VAX_carriage_control==@= carriage_control @> @d VAX_io_setmode==@= io$_setmode @> @d VAX_iom_ctrlcast==@= io$m_ctrlcast @> @d VAX_immed==@= %immed @> @d VAX_stdescr==@= %stdescr @> @d VAX_ref==@= %ref @> @d VAX_assign==@= $assign @> @d VAX_qiow==@= $qiow @> @d VAX_numtim==@= $numtim @> @d VAX_getsyi==@= $getsyi @> @d VAX_lib_get_foreign==@= lib$get_foreign @> @d VAX_delete==@= delete @> @d VAX_save==@= save @> @d VAX_trnlog==@= $trnlog @> @d VAX_exit==@=$exit@> @d VAX_ss_normal==@= ss$_normal @> @d VAX_ss_warning==@= 0 @> @d VAX_ss_error==@= 2 @> @d VAX_ss_fatal==@= 4 @> @d VAX_user_action==@=user_action@> @d VAX_create==@=$create@> @d VAX_connect==@=$connect@> @d VAX_open==@=$open@> @d VAX_FAB_type==@= FAB$type @> @d VAX_RAB_type==@= RAB$type @> @d VAX_NAM_type==@= NAM$type @> @d VAX_PAS_FAB==@= PAS$FAB @> @d VAX_PAS_RAB==@= PAS$RAB @> @d VAX_FAB_L_NAM== @=FAB$L_NAM@> @d VAX_NAM_B_RSL== @=NAM$B_RSL@> @d VAX_NAM_L_RSA== @=NAM$L_RSA@> @d VAX_lognam==@= lognam @> @d VAX_rslbuf==@= rslbuf @>