From: fairfield@slacvx.slac.stanford.edu
Subject: FORMAT_UPD.SHARE - Update to KHF$FORMAT.TPU
Organization: Stanford Linear Accelerator Center
Date: Tue, 22 Dec 1992 19:42:41 GMT

    Well, I can't seem to leave well enough alone...

    In looking at the  Khf$Justify  procedure in KHF$FORMAT.TPU, which I
posted  a few days ago, I got to thinking about all the unnecessary work
the Eve$Current_Word is doing in terms of  creating  marks  and  ranges.
Since  DEC  TPU  developers  have  noted  on  this list in the past that
creating marks and ranges is  "expensive"  in TPU, and since the JUSTIFY
command  takes  a noticeable amount of time to complete (compared  to  a
simple FILL for example), I've replaced  calls  to  Eve$Current_Word  by
Eve$End_of_Word.  I won't say that the performance is noticeably better,
but it _is_ an improvement.

    Below is a VMS_SHARE  file  which  contains KHF$FORMAT.UPD.  Extract
the  VMS_SHARE  file (into something like FORMAT.SHARE), strip out  this
message down to the "CUT HERE" line,  and  @FORMAT.SHARE  the  resulting
file.  Then use the SUMSLP editor to update KHF$FORMAT.TPU:

    	$ EDIT/SUM KHF$FORMAT.TPU /UPDATE=KHF$FORMAT.UPD

    -Ken
--
 Dr. Kenneth H. Fairfield    |  Internet: Fairfield@Slac.Stanford.Edu
 SLAC, P.O.Box 4349, MS 98   |  DECnet:   45537::FAIRFIELD (45537=SLACVX)
 Stanford, CA   94309        |  BITNET    Fairfield@Slacvx
 ----------------------------------------------------------------------------
 These opinions are mine, not SLAC's, Stanford's, nor the DOE's...

$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_UNPACK_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 8.1
$!   On 22-DEC-1992 11:28:58.44   By user FAIRFIELD   
$!
$! The VMS_SHARE software that created this archive
$!    was written by  Andy Harper, Kings College London UK
$!    -- September 1992
$!
$! Credit is due to these people for their original ideas:
$!    James Gray, Michael Bednarek 
$!
$! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
$! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
$!
$! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
$!       1. KHF$FORMAT.UPD;2
$!
$set="set"
$set symbol/scope=(nolocal,noglobal)
$f=f$parse("SHARE_UNPACK_TEMP","SYS$SCRATCH:."+f$getjpi("","PID"))
$e="write sys$error  ""%UNPACK"", "
$w="write sys$output ""%UNPACK"", "
$ if .not. f$trnlnm("SHARE_UNPACK_LOG") then $ w = "!"
$ ve=f$getsyi("version")
$ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto start
$ e "-E-OLDVER, Must run at least VMS 4.4"
$ v=f$verify(v)
$ exit 44
$unpack: subroutine ! P1=filename, P2=checksum, P3=attributes
$ if f$search(P1) .eqs. "" then $ goto file_absent
$ e "-W-EXISTS, File ''P1' exists. Skipped."
$ delete 'f'*
$ exit
$file_absent:
$ if f$parse(P1) .nes. "" then $ goto dirok
$ dn=f$parse(P1,,,"DIRECTORY")
$ w "-I-CREDIR, Creating directory ''dn'"
$ create/dir 'dn'
$ if $status then $ goto dirok
$ e "-E-CREDIRFAIL, Unable to create ''dn' File skipped."
$ delete 'f'*
$ exit
$dirok:
$ w "-I-UNPACK, Unpacking file ''P1'"
$ n=P1
$ if P3 .nes. "" then $ n=f
$ if .not. f$verify() then $ define/user sys$output nl:
$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='n'
PROCEDURE GetHex LOCAL x1,x2;x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,
ERASE_CHARACTER(1))-1;RETURN 16*x1+x2;ENDPROCEDURE;
PROCEDURE SkipPartsep LOOP EXITIF INDEX(ERASE_LINE,"-+-+-+-+-+-+-+-+")=1;
ENDLOOP;ENDPROCEDURE;
PROCEDURE ExpandChar CASE CURRENT_CHARACTER FROM ' ' TO 'z' ["`"]
:ERASE_CHARACTER(1);COPY_TEXT(ASCII(GetHex));[" "]:ERASE_CHARACTER(1);[
OUTRANGE,INRANGE]:MOVE_HORIZONTAL(1);ENDCASE;ENDPROCEDURE;
PROCEDURE ProcessLine s:=ERASE_CHARACTER(1);LOOP EXITIF CURRENT_OFFSET>=LENGTH(
CURRENT_LINE);ExpandChar;ENDLOOP;IF s="V" THEN APPEND_LINE;ENDIF;ENDPROCEDURE;
PROCEDURE AdvanceLine MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);
ENDPROCEDURE;PROCEDURE Decode POSITION(BEGINNING_OF(b));LOOP EXITIF MARK(NONE)=
END_OF(b);IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+-")=1 THEN SkipPartSep;
ELSE ProcessLine;AdvanceLine;ENDIF;ENDLOOP;ENDPROCEDURE;SET(FACILITY_NAME,
"UNPACK");SET(SUCCESS,OFF);SET(INFORMATIONAL,OFF);t:="0123456789ABCDEF";f:=
GET_INFO(COMMAND_LINE,"file_name");b:=CREATE_BUFFER(f,f);Decode;WRITE_FILE(b,
GET_INFO(COMMAND_LINE,"output_file"));QUIT;
$ if p3 .eqs. "" then $ goto dl
$ open/write fdl &f
$ write fdl "RECORD"
$ write fdl P3
$ close fdl
$ w "-I-CONVRFM, Converting record format to ", P3
$ convert/fdl=&f &f-1 &P1
$dl: delete 'f'*
$ if P2 .eqs. "" then $ goto ckskip
$ checksum 'P1'
$ if checksum$checksum .nes. P2 then $ -
  e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ exit
$ckskip: e "-W-CHKSUMSKIP, checksum validation unavailable for ''P1'"
$ endsubroutine
$start:
$!
$ create 'f'
X-`20`20541,`20`20546
X!`09The`20EVE`20internal`20procedure`20Eve$End_of_Word,`20found`20in`20EVE$FOR
VMAT.TPU,
X!`09Version`20V02-100b,`20is`20used`20here`20to`20fill`20khf$x_word_array`20wi
Vth`20MARKs
X!`09corresponding`20to`20the`20beginning`20of`20each`20word`20(but`20the`20fir
Vst)`20in`20a`20line.
X!`09Changes`20to`20that`20procedure`20must`20be`20tracked`20here.
X!
X!`09Khf$Justify`20expects`20the`20range_arg`20parameter`20to`20be`20a`20typica
Vl`20para-
X-`20`20568,`20`20572
X!`09Eve$Current_Word`20(although`20here`20I`20have`20used`20Eve$End_of_Word).
V`20`20Both
X!`09of`20the`20earlier`20procedures`20implemented`20appending`20a`20second`20s
Vpace
X!`09following`20a`20sentence`20terminator,`20but`20I`20have`20moved`20that`20t
Vo`20the
X!`09calling`20procedure.
X!
X!`20`20Author/Date:`09`09K.H.`20Fairfield,`09`0922-DEC-1992
X-`20`20594,`20`20594
X`09ngaps,`09`09!`20Number`20of`20gaps,`20equals`20words`20in`20word_array`20le
Vss`20one
X`09temp;`09`09!`20Just`20a`20temporary`20variable...
X-`20`20608,`20`20609
X!`20`20Create`20khf$x_word_array`20on`20first`20use.`20`20Should`20be`20big
V`20enough`20for`20most`20lines;
X!`20`20will`20be`20extended`20on`20the`20fly`20otherwise.
X-`20`20636,`20`20648
X`09indx`09:=`200;
X!+
X!`20`20Loop`20over`20words`20in`20the`20current`20line,`20fill`20khf$x_word_ar
Vray`20with`20marks
X!`20`20corresponding`20to`20the`20beginning`20each`20word`20except`20the`20fir
Vst.`20`20Note`20that
X!`20`20Eve$End_of_Word`20positions`20to`20the`20_start_`20of`20the`20_next_
V`20word.
X!-
X`09Loop
X`09`20`20`20`20temp`20:=`20Eve$End_of_Word;
X`09`20`20`20`20Exitif`20(CURRENT_CHARACTER`20=`20"");`09`20`20`20`20!`20Line_e
Vnd`20condition.
X`09`20`20`20`20indx`20:=`20indx`20+`201;
X`09`20`20`20`20khf$x_word_array`20`7Bindx`7D`20:=`20Mark`20(NONE);
X`09Endloop;
X
X`09ngaps`20:=`20indx;`09`09`09`09`20`20`20`20!`20Number`20of`20gaps
X`09Exitif`20(ngaps`20<=`200);`09`09`09`20`20`20`20!`20Can't`20justify`20one
V`20word...
X-`20`20656,`20`20658
X`09`20`20`20`20sm_size`20`20`20`20:=`20nspaces`20/`20ngaps;`09`20`20`20`20!
V`20Size`20of`20small_fill
X`09`20`20`20`20nbig`20`20`20`20`20`20`20:=`20nspaces`20-`20(sm_size`20*`20ngap
Vs);
X`09`20`20`20`20nsmall`20`20`20`20`20:=`20ngaps`20-`20nbig;`09`09`20`20`20`20!
V`20Number`20of`20small_fill`20gaps
X-`20`20665,`20`20669
X!`20`20are`20from`20the`20center`20outward,`20from`20the`20outside`20towards
V`20the`20center,`20from
X!`20`20the`20right`20towards`20the`20beginning`20of`20the`20line,`20and`20from
V`20the`20left`20towards
X!`20`20the`20end`20of`20the`20line.
X-`20`20674,`20`20674
X`09`09indx1`20:=`20(ngaps/2)`20+`201;`20`20`20`20`20!`09at`20the`20center`20of
V`20the`20line`20and
X-`20`20699,`20`20700
X`09`09indx1`20:=`201;`09`09`20`20`20`20!`09both`20ends`20of`20the`20line`20and
V`20work
X`09`09indx2`20:=`20ngaps;`09`09`20`20`20`20!`09toward`20the`20center.`20`20Var
Viable
X-`20`20724,`20`20726
X`09`09indx`20:=`20ngaps;`09`09`20`20`20`20!`09the`20beginning`20of`20the`20lin
Ve.
X`09`09Loop
X`09`09`20`20`20`20Exitif`20(indx`20<=`20(ngaps-nsmall-nbig));
X-`20`20730,`20`20730
X`09`09`20`20`20`20If`20(indx`20=`20(ngaps-nbig))
X-`20`20737,`20`20742
X`09`09indx`20:=`201;`09`09`20`20`20`20!`09the`20end`20of`20the`20line.
X`09`09Loop
X`09`09`20`20`20`20Exitif`20(indx`20>`20(nsmall+nbig));
X`09`09`20`20`20`20Position`20(khf$x_word_array`20`7Bindx`7D);
X`09`09`20`20`20`20Copy_Text`20(the_fill);
X`09`09`20`20`20`20If`20(indx`20=`20(nbig))
X/
$ call unpack KHF$FORMAT.UPD;2 808945207 ""
$ v=f$verify(v)
$ exit