home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #31 / NN_1992_31.iso / spool / vmsnet / tpu / 551 < prev    next >
Encoding:
Text File  |  1992-12-22  |  8.3 KB  |  211 lines
  1. Newsgroups: vmsnet.tpu
  2. Path: sparky!uunet!zaphod.mps.ohio-state.edu!pacific.mps.ohio-state.edu!linac!unixhub!slacvx.slac.stanford.edu!fairfield
  3. From: fairfield@slacvx.slac.stanford.edu
  4. Subject: FORMAT_UPD.SHARE - Update to KHF$FORMAT.TPU
  5. Message-ID: <1992Dec22.114241.1@slacvx.slac.stanford.edu>
  6. Lines: 200
  7. Sender: news@unixhub.SLAC.Stanford.EDU
  8. Organization: Stanford Linear Accelerator Center
  9. Date: Tue, 22 Dec 1992 19:42:41 GMT
  10.  
  11.     Well, I can't seem to leave well enough alone...
  12.  
  13.     In looking at the  Khf$Justify  procedure in KHF$FORMAT.TPU, which I
  14. posted  a few days ago, I got to thinking about all the unnecessary work
  15. the Eve$Current_Word is doing in terms of  creating  marks  and  ranges.
  16. Since  DEC  TPU  developers  have  noted  on  this list in the past that
  17. creating marks and ranges is  "expensive"  in TPU, and since the JUSTIFY
  18. command  takes  a noticeable amount of time to complete (compared  to  a
  19. simple FILL for example), I've replaced  calls  to  Eve$Current_Word  by
  20. Eve$End_of_Word.  I won't say that the performance is noticeably better,
  21. but it _is_ an improvement.
  22.  
  23.     Below is a VMS_SHARE  file  which  contains KHF$FORMAT.UPD.  Extract
  24. the  VMS_SHARE  file (into something like FORMAT.SHARE), strip out  this
  25. message down to the "CUT HERE" line,  and  @FORMAT.SHARE  the  resulting
  26. file.  Then use the SUMSLP editor to update KHF$FORMAT.TPU:
  27.  
  28.         $ EDIT/SUM KHF$FORMAT.TPU /UPDATE=KHF$FORMAT.UPD
  29.  
  30.     -Ken
  31. --
  32.  Dr. Kenneth H. Fairfield    |  Internet: Fairfield@Slac.Stanford.Edu
  33.  SLAC, P.O.Box 4349, MS 98   |  DECnet:   45537::FAIRFIELD (45537=SLACVX)
  34.  Stanford, CA   94309        |  BITNET    Fairfield@Slacvx
  35.  ----------------------------------------------------------------------------
  36.  These opinions are mine, not SLAC's, Stanford's, nor the DOE's...
  37.  
  38. $! ------------------ CUT HERE -----------------------
  39. $ v='f$verify(f$trnlnm("SHARE_UNPACK_VERIFY"))'
  40. $!
  41. $! This archive created by VMS_SHARE Version 8.1
  42. $!   On 22-DEC-1992 11:28:58.44   By user FAIRFIELD   
  43. $!
  44. $! The VMS_SHARE software that created this archive
  45. $!    was written by  Andy Harper, Kings College London UK
  46. $!    -- September 1992
  47. $!
  48. $! Credit is due to these people for their original ideas:
  49. $!    James Gray, Michael Bednarek 
  50. $!
  51. $! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
  52. $! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
  53. $!
  54. $! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
  55. $!       1. KHF$FORMAT.UPD;2
  56. $!
  57. $set="set"
  58. $set symbol/scope=(nolocal,noglobal)
  59. $f=f$parse("SHARE_UNPACK_TEMP","SYS$SCRATCH:."+f$getjpi("","PID"))
  60. $e="write sys$error  ""%UNPACK"", "
  61. $w="write sys$output ""%UNPACK"", "
  62. $ if .not. f$trnlnm("SHARE_UNPACK_LOG") then $ w = "!"
  63. $ ve=f$getsyi("version")
  64. $ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto start
  65. $ e "-E-OLDVER, Must run at least VMS 4.4"
  66. $ v=f$verify(v)
  67. $ exit 44
  68. $unpack: subroutine ! P1=filename, P2=checksum, P3=attributes
  69. $ if f$search(P1) .eqs. "" then $ goto file_absent
  70. $ e "-W-EXISTS, File ''P1' exists. Skipped."
  71. $ delete 'f'*
  72. $ exit
  73. $file_absent:
  74. $ if f$parse(P1) .nes. "" then $ goto dirok
  75. $ dn=f$parse(P1,,,"DIRECTORY")
  76. $ w "-I-CREDIR, Creating directory ''dn'"
  77. $ create/dir 'dn'
  78. $ if $status then $ goto dirok
  79. $ e "-E-CREDIRFAIL, Unable to create ''dn' File skipped."
  80. $ delete 'f'*
  81. $ exit
  82. $dirok:
  83. $ w "-I-UNPACK, Unpacking file ''P1'"
  84. $ n=P1
  85. $ if P3 .nes. "" then $ n=f
  86. $ if .not. f$verify() then $ define/user sys$output nl:
  87. $ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='n'
  88. PROCEDURE GetHex LOCAL x1,x2;x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,
  89. ERASE_CHARACTER(1))-1;RETURN 16*x1+x2;ENDPROCEDURE;
  90. PROCEDURE SkipPartsep LOOP EXITIF INDEX(ERASE_LINE,"-+-+-+-+-+-+-+-+")=1;
  91. ENDLOOP;ENDPROCEDURE;
  92. PROCEDURE ExpandChar CASE CURRENT_CHARACTER FROM ' ' TO 'z' ["`"]
  93. :ERASE_CHARACTER(1);COPY_TEXT(ASCII(GetHex));[" "]:ERASE_CHARACTER(1);[
  94. OUTRANGE,INRANGE]:MOVE_HORIZONTAL(1);ENDCASE;ENDPROCEDURE;
  95. PROCEDURE ProcessLine s:=ERASE_CHARACTER(1);LOOP EXITIF CURRENT_OFFSET>=LENGTH(
  96. CURRENT_LINE);ExpandChar;ENDLOOP;IF s="V" THEN APPEND_LINE;ENDIF;ENDPROCEDURE;
  97. PROCEDURE AdvanceLine MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);
  98. ENDPROCEDURE;PROCEDURE Decode POSITION(BEGINNING_OF(b));LOOP EXITIF MARK(NONE)=
  99. END_OF(b);IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+-")=1 THEN SkipPartSep;
  100. ELSE ProcessLine;AdvanceLine;ENDIF;ENDLOOP;ENDPROCEDURE;SET(FACILITY_NAME,
  101. "UNPACK");SET(SUCCESS,OFF);SET(INFORMATIONAL,OFF);t:="0123456789ABCDEF";f:=
  102. GET_INFO(COMMAND_LINE,"file_name");b:=CREATE_BUFFER(f,f);Decode;WRITE_FILE(b,
  103. GET_INFO(COMMAND_LINE,"output_file"));QUIT;
  104. $ if p3 .eqs. "" then $ goto dl
  105. $ open/write fdl &f
  106. $ write fdl "RECORD"
  107. $ write fdl P3
  108. $ close fdl
  109. $ w "-I-CONVRFM, Converting record format to ", P3
  110. $ convert/fdl=&f &f-1 &P1
  111. $dl: delete 'f'*
  112. $ if P2 .eqs. "" then $ goto ckskip
  113. $ checksum 'P1'
  114. $ if checksum$checksum .nes. P2 then $ -
  115.   e "-E-CHKSMFAIL, Checksum of ''P1' failed."
  116. $ exit
  117. $ckskip: e "-W-CHKSUMSKIP, checksum validation unavailable for ''P1'"
  118. $ endsubroutine
  119. $start:
  120. $!
  121. $ create 'f'
  122. X-`20`20541,`20`20546
  123. X!`09The`20EVE`20internal`20procedure`20Eve$End_of_Word,`20found`20in`20EVE$FOR
  124. VMAT.TPU,
  125. X!`09Version`20V02-100b,`20is`20used`20here`20to`20fill`20khf$x_word_array`20wi
  126. Vth`20MARKs
  127. X!`09corresponding`20to`20the`20beginning`20of`20each`20word`20(but`20the`20fir
  128. Vst)`20in`20a`20line.
  129. X!`09Changes`20to`20that`20procedure`20must`20be`20tracked`20here.
  130. X!
  131. X!`09Khf$Justify`20expects`20the`20range_arg`20parameter`20to`20be`20a`20typica
  132. Vl`20para-
  133. X-`20`20568,`20`20572
  134. X!`09Eve$Current_Word`20(although`20here`20I`20have`20used`20Eve$End_of_Word).
  135. V`20`20Both
  136. X!`09of`20the`20earlier`20procedures`20implemented`20appending`20a`20second`20s
  137. Vpace
  138. X!`09following`20a`20sentence`20terminator,`20but`20I`20have`20moved`20that`20t
  139. Vo`20the
  140. X!`09calling`20procedure.
  141. X!
  142. X!`20`20Author/Date:`09`09K.H.`20Fairfield,`09`0922-DEC-1992
  143. X-`20`20594,`20`20594
  144. X`09ngaps,`09`09!`20Number`20of`20gaps,`20equals`20words`20in`20word_array`20le
  145. Vss`20one
  146. X`09temp;`09`09!`20Just`20a`20temporary`20variable...
  147. X-`20`20608,`20`20609
  148. X!`20`20Create`20khf$x_word_array`20on`20first`20use.`20`20Should`20be`20big
  149. V`20enough`20for`20most`20lines;
  150. X!`20`20will`20be`20extended`20on`20the`20fly`20otherwise.
  151. X-`20`20636,`20`20648
  152. X`09indx`09:=`200;
  153. X!+
  154. X!`20`20Loop`20over`20words`20in`20the`20current`20line,`20fill`20khf$x_word_ar
  155. Vray`20with`20marks
  156. X!`20`20corresponding`20to`20the`20beginning`20each`20word`20except`20the`20fir
  157. Vst.`20`20Note`20that
  158. X!`20`20Eve$End_of_Word`20positions`20to`20the`20_start_`20of`20the`20_next_
  159. V`20word.
  160. X!-
  161. X`09Loop
  162. X`09`20`20`20`20temp`20:=`20Eve$End_of_Word;
  163. X`09`20`20`20`20Exitif`20(CURRENT_CHARACTER`20=`20"");`09`20`20`20`20!`20Line_e
  164. Vnd`20condition.
  165. X`09`20`20`20`20indx`20:=`20indx`20+`201;
  166. X`09`20`20`20`20khf$x_word_array`20`7Bindx`7D`20:=`20Mark`20(NONE);
  167. X`09Endloop;
  168. X
  169. X`09ngaps`20:=`20indx;`09`09`09`09`20`20`20`20!`20Number`20of`20gaps
  170. X`09Exitif`20(ngaps`20<=`200);`09`09`09`20`20`20`20!`20Can't`20justify`20one
  171. V`20word...
  172. X-`20`20656,`20`20658
  173. X`09`20`20`20`20sm_size`20`20`20`20:=`20nspaces`20/`20ngaps;`09`20`20`20`20!
  174. V`20Size`20of`20small_fill
  175. X`09`20`20`20`20nbig`20`20`20`20`20`20`20:=`20nspaces`20-`20(sm_size`20*`20ngap
  176. Vs);
  177. X`09`20`20`20`20nsmall`20`20`20`20`20:=`20ngaps`20-`20nbig;`09`09`20`20`20`20!
  178. V`20Number`20of`20small_fill`20gaps
  179. X-`20`20665,`20`20669
  180. X!`20`20are`20from`20the`20center`20outward,`20from`20the`20outside`20towards
  181. V`20the`20center,`20from
  182. X!`20`20the`20right`20towards`20the`20beginning`20of`20the`20line,`20and`20from
  183. V`20the`20left`20towards
  184. X!`20`20the`20end`20of`20the`20line.
  185. X-`20`20674,`20`20674
  186. X`09`09indx1`20:=`20(ngaps/2)`20+`201;`20`20`20`20`20!`09at`20the`20center`20of
  187. V`20the`20line`20and
  188. X-`20`20699,`20`20700
  189. X`09`09indx1`20:=`201;`09`09`20`20`20`20!`09both`20ends`20of`20the`20line`20and
  190. V`20work
  191. X`09`09indx2`20:=`20ngaps;`09`09`20`20`20`20!`09toward`20the`20center.`20`20Var
  192. Viable
  193. X-`20`20724,`20`20726
  194. X`09`09indx`20:=`20ngaps;`09`09`20`20`20`20!`09the`20beginning`20of`20the`20lin
  195. Ve.
  196. X`09`09Loop
  197. X`09`09`20`20`20`20Exitif`20(indx`20<=`20(ngaps-nsmall-nbig));
  198. X-`20`20730,`20`20730
  199. X`09`09`20`20`20`20If`20(indx`20=`20(ngaps-nbig))
  200. X-`20`20737,`20`20742
  201. X`09`09indx`20:=`201;`09`09`20`20`20`20!`09the`20end`20of`20the`20line.
  202. X`09`09Loop
  203. X`09`09`20`20`20`20Exitif`20(indx`20>`20(nsmall+nbig));
  204. X`09`09`20`20`20`20Position`20(khf$x_word_array`20`7Bindx`7D);
  205. X`09`09`20`20`20`20Copy_Text`20(the_fill);
  206. X`09`09`20`20`20`20If`20(indx`20=`20(nbig))
  207. X/
  208. $ call unpack KHF$FORMAT.UPD;2 808945207 ""
  209. $ v=f$verify(v)
  210. $ exit
  211.