home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / net / prep.1 < prev    next >
Internet Message Format  |  1986-12-17  |  61KB
  1. From prove@batcomputer.tn.cornell.edu Tue Dec 16 13:56:15 1986
  2. Path: beno!seismo!rochester!cornell!batcomputer!prove
  3. From: prove@batcomputer.tn.cornell.edu (Roger Ove)
  4. Newsgroups: net.sources
  5. Subject: PREP: fortran preprocessor, part 1/2
  6. Keywords: fortran , preprocessor, cray
  7. Message-ID: <1840@batcomputer.tn.cornell.edu>
  8. Date: 16 Dec 86 18:56:15 GMT
  9. Organization: Theory Center, Cornell U., Ithaca NY
  10. Lines: 1954
  11.  
  12.  
  13.      This is part 1 of 2  of a preprocessor for fortran, which 
  14. supports macros, flow control extensions, vector statement
  15. shorthand, and automatic loop unrolling for certain classes of
  16. loops.  It is written in generic c and will run on nearly any
  17. machine: ibmpc, Sun, CrayXMP, Definicon dsi20.
  18.  
  19. # This is a shell archive.  Remove anything before this line,
  20. # then unpack it by saving it in a file and typing "sh file".
  21. #
  22. # Wrapped by newton!ove on Mon Dec 15 21:12:26 CST 1986
  23. # Contents:  prep.doc Makefile makemsc prep.c macro.c vec.c str.c
  24.  
  25. echo x - prep.doc
  26. sed 's/^@//' > "prep.doc" <<'@//E*O*F prep.doc//'
  27.                              PREP v. 2.0
  28.  
  29.                     Copyright (C) 1985,1986 P.R.Ove
  30.                           All rights reserved.
  31.  
  32.      Suggestions and comments regarding this program are welcome,
  33. preferably in the form of code segments.  I will make an effort to
  34. incorporate any suggestions that are deemed worthy and maintain an
  35. "official" version of this program on the net.  At the moment comments
  36. should be directed to 14004@ncsavmsa.bitnet (or equivalently 14004@
  37. ncsaa.cso.uiuc.edu), or prove@uiucmvd.bitnet, or prove@tcgould.tn.
  38. cornell.edu.
  39.  
  40.  
  41.  
  42. Introduction
  43.  
  44.      This documentation describes the use of PREP, a preprocessor for 
  45. fortran.  As an alternative to ratfor, PREP offers some distinct advantages.
  46. These include full macro facilities and a concise shorthand for array
  47. and vector statements.  In addition, all of the standard flow control
  48. constructs of forth are supported.  Some attempts have been made to
  49. avoid ratfor syntax to that both preprocessors can be used, but this
  50. has never been checked fully.  It is probably possible to emulate much of
  51. ratfor's syntax using PREP's macro processor to modify the flow control
  52. commands.  PREP is written is generic c and will run on nearly any
  53. machine/compiler combination.  Currently it runs on IBM pc's and
  54. compatibles, unix machines, the Definicon dsi20 68020 parasite card in
  55. an IBM PC compatible machine, and the Cray XMP.
  56.      PREP does not do everything, and in particular does not offer any
  57. help with the deficiency of data structures in fortran.  It also does not
  58. understand fortran, and will quite happily produce nonsense code if so
  59. instructed.  It will detect errors in its own syntax, but errors in 
  60. fortran will be left for the compiler.  Therefore debugging will 
  61. unfortunately involve looking at the fortran output, which can be quite
  62. ugly.  These problems are shared with ratfor.
  63.      The vector statement notation makes it possible to incorporate do
  64. loop unrolling automatically to any depth, which for certain classes of
  65. loops on certain machines (memory bound loops on vector machines) will
  66. improve performance.  On the Cray XMP performance for certain loops
  67. was increased from the normal 50 Mflops to a maximum of 80 Mflops when
  68. unrolled to a depth of 16.  On machines with many parallel paths to
  69. memory there may also be situations where this is advantageous.
  70.      Although the syntax is similar to forth, the spirit of forth is
  71. totally absent.  The macros are really macros, not colon definitions,
  72. and recursive macro definitions will cause an error during expansion.
  73. Postfix notation would only cause confusion, being in conflict with
  74. fortran conventions, and is not used.
  75.     The macro processor can be considered a pre-preprocessor.  The
  76. order of translation is:
  77.  
  78.     1) file inclusion
  79.     2) macro processing
  80.     3) flow control extensions
  81.     4) vector statements
  82.  
  83. Note that because of this the flow control syntax can be modified
  84. at the macro level.  Although this order of translation holds
  85. rigorously, PREP is a one pass processor and makes no temporary
  86. files.
  87.      Macro definitions can be imbedded in the program file or in
  88. files that can later be included.  Some common definitions mapping
  89. certain symbols ( &, <=, !=, etc ) to their fortran equivalents ( .and.,
  90. @.le., .ne., etc ) are stored in the file prepmac.h.  These can be made
  91. active by placing the statement ' #include "prepmac.h" ' in the program
  92. file, or by using the -i switch from the command line.
  93.     The nesting limit for all loops is defined by an internal constant
  94. NESTING, which is set to a number like 10 or 20 (implementation 
  95. dependent).  The flow control directives are permitted inside vector
  96. loops, but since they will inhibit Cray vectorization of those loops it
  97. may be best to avoid this.  One of the reasons for using the vector
  98. shorthand is that it encourages programming in a style that can be
  99. easily vectorized by the compiler.
  100.     This program attempts to avoid all fixed limits on data structures,
  101. and instead allocates memory when needed.  The flow control directives
  102. do not adhere to this philosophy, since the maximum expansion length
  103. can be determined in advance and processing is faster without continual
  104. reallocation of memory.  Fairly robust memory management is used by the
  105. macro processor and input routines (there is no source line length limit
  106. other than any limitations imposed by the system).  Recursive macro
  107. definitions are accepted during the definition phase, but will cause an
  108. error during expansion.  When a macro is expanded more than the limit
  109. (100 or so per line, but implementation dependent) the program will abort
  110. with a recursion error message, but it is conceivable (if the memory of
  111. the machine is small and the macro definitions are very long) that a
  112. memory allocation error will occur before this.
  113.     In most cases the flow control directives must be the first word
  114. on the line (PREP is line oriented like fortran and unlike c).  The
  115. only exception is that directives and fortran code can be on the same
  116. line after an OF statement.  Any delimiters (){}[]'" may be used in the
  117. logical expressions ( i.e.  leave [ i == 1 ] ).  Macro definitions
  118. must use () for the parameter block however (to allow macro names
  119. containing the character {, for instance), and macro names cannot contain
  120. the open parens or whitespace characters.
  121.  
  122.  
  123. Running PREP
  124.  
  125.      The command line interface and program function is identical 
  126. regardless of the machine (so far).  The syntax is
  127.  
  128. prep -x -x .... <file>
  129.  
  130. where file is the first name of the file and the extension is assumed
  131. to be P.  The output file will have the extension F.  x represents
  132. a command line option:
  133.  
  134.  Switches:
  135.    -c        keep comments (truncated at column 72)
  136.    -u        keep underline characters
  137.    -m        only do macro substitution (==> -c and -u as well, and
  138.         prevents file includes (except -i switch).
  139.    -i    <file>    include <file> before processing
  140.    -U n        unroll vector loops to depth n
  141.    -L n        unroll loops with n or fewer lines
  142.    -?        write message about allowed switches
  143.  
  144.      If no file is present standard input and output are used.  The -i
  145. switch requires the full path name of the include file.
  146.      Normally underline characters and comment records are eliminated
  147. unless overridden with a switch.  Quoted underlines (the fortran quote
  148. character is the apostrophe) are never deleted.  In general quoted
  149. characters are safe from PREP, as is text in comment records.
  150.      The -m switch is useful for converting existing programs to PREP
  151. format.  It turns off all PREP functions except macro substitution.  To
  152. partially convert a fortran program, enter:
  153.  
  154. prep -m -i fix.h <prog.f >prog.p
  155.  
  156. The file fix.h contains the inverse definitions of prepmac.h.  A side
  157. effect of PREP on DOS machines is that the terminating control-z is
  158. removed, which is useful if the fortran code is to be transferred to
  159. another machine.  Running the above command without the -i switch and
  160. without any internal macro definitions, it will do nothing but remove the
  161. control-z.
  162.      If the argument for -U is omitted the default is 8.  If -U is not
  163. present then unrolling will not be done at all unless turned on by an
  164. internal directive.  The command line switch will not override imbedded
  165. unrolling commands.  If -L is omitted the default is 1000, while if the
  166. argument is omitted the default is 1.
  167.      Versions for Intel 80*** based machines come compiled for small
  168. and large memory models.  The large model version is quite large
  169. itself.  It is only necessary to use the large model if the memory
  170. is needed for many very long macro definitions, which are memory resident.
  171. If you have a memory allocation error with the small version try the
  172. other.  The large one is called bigprep.exe.  Since I am now distributing
  173. the source you can do what your want.
  174.  
  175.  
  176.  
  177.  
  178. Summary of Features
  179.  
  180.     The extensions can be broken up into four classes: 1) including
  181. files, 2) macro definition/expansion, 3) flow control directives, and
  182. 4) vector notation.  These will be discussed in this order, which is 
  183. also the order in which they are processed.
  184.  
  185.  
  186.  
  187. Included files
  188.   example:
  189.   #include "prepmac.h"
  190.  
  191.      Normally fortran incudes files with the directive "include". 
  192. Incidentally, using cft and precomp on a cray, files are included with
  193. "use" so if you are using a cray you may find it convenient to define
  194. "include" equivalent to "use" with
  195.     : include(x)    use x ;
  196. so that "include 'file'" will be translated to "use file".  Prep will
  197. include a file if it finds an include directive ( #include "file" )
  198. in the source, or if the -i switch is used from the command line.  Included
  199. files can be nested 10 deep.  Only the current directory is searched,
  200. and PREP will terminate if the file is not found.  To include a file in
  201. another directory the full pathname must be used.
  202.  
  203.  
  204. Macros
  205.      The style is similar to that of c #define macros, except
  206. that : is used instead of #define and ; terminates the macro.  No
  207. special character is needed to continue to the next line.  Non-c syntax
  208. is used to allow both PREP macros and c preprocessor macros in the
  209. same program.
  210.      Recursive definitions are permitted, but will cause an abort
  211. (and possibly a memory allocation error) on expansion.  For each
  212. line submitted to expand_macros, a count of is kept for each
  213. stored macro indicating how many times it has been expanded in
  214. the current line.  When this exceeds MAX_CALLS, the program 
  215. assumes a macro definition is recursive and stops.  Macros
  216. are expanded starting with the one with the longest name, so that
  217. if the definitions
  218.  
  219.    : >=        .ge. ;
  220.    : >        .gt. ;
  221.  
  222. are in effect, >= will be changed to .ge. rather than .gt.=.  This
  223. is only a potential problem when macro names are not fully
  224. alphanumeric, since "arg" will not be flagged if "r" is defined.
  225. The underline character is considered non-alphanumeric here, for
  226. no good reason and perhaps it should not be.
  227.  
  228.      The definition phase is invoked when a leading : is found in
  229. the record.  Text is then taken until the terminating ; is found.  Text
  230. following the ; is ignored (until the next newline).  Multi-line macros
  231. are permitted: they will be converted to at least as many lines in the
  232. fortran program.  The general form of a macro definition is:
  233.  
  234.    : name( parm1, parm2, ... )    text with parameters
  235.                 more text with parameters
  236.                  "    "    "    "    ;
  237.  
  238. with 20 as the maximum number of parameters.  There must be no space
  239. between the macro name and the open delimiter of the parameter block in
  240. a definition, and the delimiters (if present) must be ().  Macro names
  241. can not contain the open parens.  Examples of macros with more than
  242. one line are:
  243.  
  244.    : }
  245.     end do ;
  246.    : {
  247.     ;
  248.  
  249. These will allow translation of ratfor style do loops:
  250.  
  251.     do i = 1, 10 { write(*,*) ' i = ', i }
  252.  
  253. is translated into:
  254.  
  255.     do i = 1, 10
  256.     write(*,*) ' i = ', i
  257.     end do
  258.  
  259. which will be translated into fortran during the flow control processing.
  260. Note that this example relies on the fact the whitespace between the
  261. macro definition and its terminating ; is significant (newline is not
  262. considered whitespace here).  This is not the case for whitespace between
  263. the name and the definition.  Failure to have a terminating ; will define
  264. the entire program to be a macro.  This could cause a memory allocation
  265. failure, as macros are stored in memory.
  266.      While in a definition the open parens must follow the name without
  267. whitespace, in the source code this requirement (and the need to use only
  268. () as delimiters) is relaxed.  Alphanumeric macros must be not be next to
  269. an alpha or number character or they will not be recognized.
  270.      The macro definition routine puts the macro string into a more easily
  271. handled format, replacing parameters in the text with n, where n is a
  272. binary value (128 to 128+MAX_TOKENS).  The macro is placed in a structure
  273. of the form:
  274.  
  275. struct mac {
  276.     char *name ;        macro id tag
  277.     char *text ;        encoded macro text
  278.     int  parmcount ;    number of arguments
  279.     int  callcount ;    recursion check
  280. } macro[MAX_MACROS] ;
  281.  
  282. where the text string has binary symbols where the parms were.  Parmcount
  283. is used to see if a parameter block should be searched for when expanding
  284. a macro.  Callcount is used to stop expansion in case of recursive definitions.
  285.      Caution must be exercised to avoid accidental recursive definitions
  286. involving more than one macro:
  287.  
  288.     : h    i+x ;
  289.     : i(y)    func(y) ;
  290.     : func    h ;
  291.  
  292. This will generate the successive strings (from a = func(x)):
  293.  
  294.     a = h(x)
  295.     a = i+x(x)
  296.     a = func()+x(x)
  297.     a = h()+x(x) .... and so on.  Beware.
  298.  
  299.      Macro names will not be flagged if they are quoted (with apostrophes)
  300. in the source, or if they are in comment records.
  301.      If more parameters are found than were present in the definition, the
  302. trailers are ignored.  If fewer are found they will be inserted where
  303. expected only (the missing parameters will be taken to be null strings).
  304. Parameters are separated by commas, and are only recognized if they are
  305. balanced according to delimiters.  If : MACRO(a,b) a + b ; is defined
  306. and
  307.  
  308.     MACRO " [i,j] "
  309.  
  310. is found in the text, only one parameter will be found and it will be
  311. expanded as:
  312.  
  313.     [i,j] +
  314.  
  315. It is not possible to have unbalanced delimiters in a parameter of a 
  316. macro unless the macro only has one argument.
  317.  
  318.  
  319.  
  320. Flow Control Extensions
  321.      These commands are based on the flow control of forth (except for
  322. the do/end_do construct).  With the exception of the OF and DEFAULT
  323. commands, no other text is allowed on the line.  If trailing text is
  324. present it is ignored, leading text will prevent PREP from seeing the
  325. command.  This includes labels: PREP command lines may not have labels
  326. unless macros are used to define labels to expand as continue statements
  327. and newlines.  The commands end_case, end_do, and leave_do can have a
  328. space instead of the underline, but the space is significant.  Of course
  329. a macro could be defined as    : enddo end_do ;.  Unlike some other
  330. languages (forth and c) where CONTINUE applies to all types of loops,
  331. here there are three CONTINUE statements (continue, continue_do, and
  332. continue_case) which apply to the three classes of loops supported by
  333. PREP.  This avoids some confusion in certain situations with nested
  334. loops of differing types.  In general for the flow control extensions,
  335. if optional expressions are omitted they are taken to be TRUE.
  336.  
  337.  
  338.  Forth style begin/while/until/again construct:
  339.      begin ... again
  340.      begin ... while (exp1) ... again
  341.      begin ... until (exp1)
  342.      leave (optional expression) to exit current level
  343.      continue (optional expression) to got back to begin
  344.  
  345.      Here the ...'s represent lines of PREP and fortran code, not on
  346. the same line with the directives.  A working example of one of these
  347. is:
  348.      begin
  349.         line of code
  350.      while ( SOME_MACRO[i] )   ; the macro evaluates to a logical expression
  351.         line of code
  352.         line of code
  353.      again
  354.  
  355. The begin ... again construct will loop forever.  Usually it will have a
  356. leave command inside ( leave [ EOF ], where EOF is a macro ), or a
  357. return to caller.  These (as with the case construct and do/end_do) may
  358. be nested ten levels deep.  The begin is always necessary, even it the
  359. next statement is while.
  360.  
  361.  
  362.  Case construct:
  363.      case ( optional exp )
  364.      of   ( exp2 )  line of code
  365.                     line of code
  366.                     continue_case ( optional logical exp )
  367.      of   ( exp3 )  line of code
  368.      default        line of code
  369.                     line of code
  370.      end_case
  371.  
  372.      This is processed by converting to if else endif expressions.  It is
  373. somewhat clearer in general.  The expressions here must NOT be logical
  374. (.eq. is used), unless CASE is followed by no parameter in which case 
  375. the OF expressions MUST be logical expressions.  Unfortunately fortran
  376. does not allow comparisons between logical expressions using .eq., so
  377. there is no way around this dilemma without having the preprocessor
  378. understand fortran to determine variable types (which in turn would
  379. require that all fortran include directives be processed).  Of course
  380. if the value is logical there is not much sense in using the case
  381. construct instead of and ordinary if/else/endif.  An example of a 
  382. case construct is
  383.  
  384.      c = getchar()    ; function that returns a character value
  385.      case ( c )
  386.      of ( 'q' )   call exit
  387.      of ( 'd' )   call dump
  388.                   continue_case ( not_done )
  389.      default      write(*,*) 'illegal character, try again'
  390.                   continue_case
  391.      end_case
  392.  
  393. In this example the continue statements pass control back to the case, so
  394. getchar is not reevaluated.  If getchar() were put in the case expression
  395. however, it would be evaluated for each OF statement as
  396.  
  397.      if ( 'q' .eq. getchar() ) etc
  398.  
  399. which is probably not what was intended.  Therefore, continue_case is rather
  400. useless here unless the value of variable c is changed by the OF clause.
  401. The example will write indefinitely if any character other than q or d
  402. is entered.  The right way to do this is by switching the 1st 2 lines:
  403.  
  404.      case ( c )
  405.      c = getchar()    ; function that returns a character value
  406.      of ( 'q' )   call exit
  407.            ...
  408.            ...
  409.      end_case
  410.  
  411. This will evaluate the function getchar on entry and once every time
  412. continue_case is encountered.  An example which uses logical expressions is
  413.  
  414.      case
  415.      c = getchar()
  416.      of ( 'q' == c ) call exit
  417.            ...
  418.      end case
  419.  
  420. The nesting limit for case constructs is again 10.  If continue_case
  421. is too long a command name, it can always be abbreviated with a macro
  422. definition (in prepmac.h the definition ": ->case continue_case ;" does
  423. this).
  424.  
  425.  
  426.  
  427.  do ... end_do
  428.  
  429.      The syntax here is like that of vms fortran, except for the leave_do
  430. which jumps out of the loop if the logical expression is true, and 
  431. continue_do which jumps to the end_do and continues the loop.  An
  432. example:
  433.  
  434.      do i = 1, 10
  435.     line of code
  436.      continue do ( i == 2 )    ; goes to end_do if true
  437.     line of code
  438.     line of code
  439.      leave do ( i*j == 4 )    ; exits loop if true
  440.     line of code
  441.      end do
  442.  
  443. The leave_do and continue_do commands cannot be used in normal labeled
  444. do loops.  If the logical expressions are omitted they are assumed
  445. true.
  446.  
  447.  
  448.  
  449.  
  450. Vector Arithmetic
  451.      When writing large number crunching programs in fortran it often
  452. happens that there are a large number of arrays with the same dimensions.
  453. More than likely the loop parameters will be the same for many loops,
  454. and even a simple routine may be rather long and difficult to read
  455. because of all the excess baggage.  It is therefore helpful to have
  456. a shorthand method for writing loops that use common loop parameters.
  457.      A few examples of the shorthand supported by PREP follow.
  458.  
  459.     a(#,#) = b(#,#) + 1
  460.  
  461. This has the obvious meaning that all of the elements of array a are
  462. set equal to those of b incremented by 1.  Assuming the appropriate
  463. default loop parameters have been set, this will be expanded as
  464.  
  465.     do 10001 i001 = 1, my
  466.     do 10000 i000 = 1, mx
  467.     a(i000,i001) = b(i000,i001) + 1
  468. 10000    continue
  469. 10001    continue
  470.  
  471. The labels will be generated uniquely.  The variables i000 -> i009 are
  472. reserved for this purpose.  PREP assumes that the usual fortran 
  473. conventions hold and that variables beginning with i are integers.
  474. In fortran the first index of an array changes the most rapidly as
  475. one proceeds through the memory, so the loops are always generated
  476. with the innermost loop over the first index.  This is essential for
  477. efficiency on machines with virtual memory (VAX) or those that rely
  478. on sequential addressing for vectorization (Cyber).
  479.      More than one line can be placed in the core of a loop by using
  480. square brackets to group them together.
  481.  
  482.     c(#,#) = exp( d(#,#) ) + c(#,#)
  483. [    a(#,#) = b(#,#,1)*c(#,#) - 100
  484.     x = y
  485.     d(#,#) = e(#,#)         ]
  486.  
  487. is expanded as
  488.  
  489.     do 10001 i001 = 1, my
  490.     do 10000 i000 = 1, mx
  491.     c(i000, i001) = exp( d(i000,i001) ) + c(i000,i001)
  492. 10000    continue
  493. 10001    continue
  494.     do 10003 i001 = 1, my
  495.     do 10002 i000 = 1, mx
  496.     a(i000,i001) = b(i000,i001,1)*c(i000,i001) - 100
  497.     x = y
  498.     d(i000,i001) = e(i000,i001)
  499. 10002    continue
  500. 10003    continue
  501.  
  502. Yes the output can get very ugly, but computers don't care.  PREP will 
  503. always continue to the next line if necessary so there is no need
  504. to worry about line length.
  505.     The above loops use default loop limits, and these must be set
  506. with the do_limits command.  The general form is:
  507.  
  508. do_limits [ (mi, mf, minc), (ni, nf, ninc), .... ]
  509.  
  510. The number of triples (do i000=mi, mf, minc) determines how many
  511. indices will be looped over.  If a triple has only 2 elements they are
  512. assumed to be the initial value and final value and the increment is
  513. taken to be 1.  If a triple has just one element (parens then not needed)
  514. it is assumed to be the final value and the initial value and increment
  515. are both taken to be 1.  Therefore the above examples could have their
  516. limits set with
  517.  
  518. do_limits [ mx, my ]
  519.  
  520. Usually the do_limits statement will be tucked out of the way at the
  521. beginning of the program file or in a PREP #include file.  Again the
  522. underline can be replaced by a blank.
  523.      As a rule the number of # symbols in each array should equal the
  524. number of indices implied by the current default limits.  A common
  525. exception is
  526.  
  527.     a(#) = a(#) + b(#,#)*c(#,#)
  528.  
  529. which expands as
  530.  
  531.     do 10001 i001 = 1, my
  532.     do 10000 i000 = 1, mx
  533.     a(i000) = a(i000) + b(i000,i001)*c(i000,i001)
  534. 10000    continue
  535. 10001    continue
  536.  
  537. This does a lot of dot products in parallel on a vector machine like
  538. the Cray.  The compiler will vectorize the inner loop, but is not 
  539. smart enough to realize that the vector a should be kept in a vector
  540. register from one outer iteration to the next, and does an unnecessary
  541. save and fetch each time.  Because this loop is memory bound (the
  542. performance is limited by the time it takes to fetch and store the
  543. data rather than the floating point speed of the machine because
  544. there are so few operations in the loop) the performance can be 
  545. increased by unrolling the loop.  This is done automatically by PREP
  546. to any depth.  Unrolling this example to a depth of 4 gives
  547.  
  548.       do 10001 i001=1,int((1.0*(( my )-1+1))/(1*4))*1*4+1-1,1*4
  549.       do 10000 i000 = 1, ( mx), 1
  550.       a(i000) = a(i000) + b(i000,i001)*c(i000,i001)
  551.       a(i000) = a(i000) + b(i000,i001+1*1)*c(i000,i001+1*1)
  552.       a(i000) = a(i000) + b(i000,i001+1*2)*c(i000,i001+1*2)
  553.       a(i000) = a(i000) + b(i000,i001+1*3)*c(i000,i001+1*3)
  554. 10000 continue
  555. 10001 continue
  556.       do 10003 i001=int((1.0*(( my )-1+1))/(1*4))*1*4+1,( my ),1
  557.       do 10002 i000 = 1, ( mx), 1
  558.       a(i000) = a(i000) + b(i000,i001)*c(i000,i001)
  559. 10002 continue
  560. 10003 continue
  561.  
  562. The second set of loops is a clean up operation.  This technique
  563. improves performance because now the compiler will see that the
  564. same vector will be used in the next vector statement and therefore
  565. keeps it in a register.  The example above which is not unrolled runs
  566. at about 50 Mflops.  Unrolling to a depth of 16 results in a speed
  567. of 80 Mflops (when mx=my=100)
  568.      Unrolling can be controlled with the command line switches
  569. mentioned earlier and with the command
  570.  
  571. unroll ( 8 )
  572.  
  573. imbedded in the source.  The depth must be explicit of course.
  574. Using the imbedded command individual loops can be controlled
  575. independently.
  576.      Unfortunately, using the same trick on more complicated loops
  577. actually degrades performance, since the loops become too
  578. complicated for the optimizer.  For this reason there is a command
  579. line switch -L n, which inhibits unrolling unless the vector
  580. statement is on n or fewer lines.  Unrolling is always disabled
  581. if the number of indices is not greater than 1, since it would
  582. serve no purpose for 1 index loops on the vector machines for
  583. which it is intended (Unrolling a 1 index loop will inhibit
  584. vectorization).  This should perhaps be a command line option
  585. as well, since scalar machines may derive some benefit for such
  586. loops.
  587.      Loops should never be unrolled unless one is certain that
  588. the result is independent of the order over which the indices are
  589. swept.  Usually if a loop is vectorizable on the Cray and can be
  590. written in this notation, it can be unrolled.  A loop such as
  591.  
  592. [    a(#,#) = i
  593.     i = i + 1
  594. ]
  595.  
  596. is not vectorizable and if unrolled the result will not be
  597. independent of the unrolling depth.  Low precision calculations may
  598. show differences depending on the depth because of round off errors.
  599. For instance, if sum is a 32 bit real and a is an array of 32 or
  600. 64 bit reals with a(i,j)=i+mi*j where the dimensions are large,
  601. the loop
  602.  
  603.     sum = sum + a(#,#)
  604.  
  605. may differ in the least significant digits when unrolled.  This is
  606. because when not unrolling (in this example) small numbers have a
  607. chance to add up before being added to large ones.  The unrolled
  608. loops may add small numbers directly to large ones and lose them.
  609. Of course this is just a precision problem and has nothing to do
  610. with the correctness of the algorithm.  Examples could just as
  611. easily be invented where the unrolled version is more accurate.
  612.      Some performance improvements have been noted for scalar
  613. machines.  Parallel processors have not yet been tested but
  614. may allow the most improvement, since the technique will be
  615. of greater assistance if the number of parallel paths to memory
  616. is increased.  In principle each processor could access a local
  617. memory store simultaneously, and unrolling would allow an 
  618. optimizing compiler to realize more easily that fetches could
  619. be done in parallel.  PREP allows such matters to be investigated
  620. without the need for a great deal of text editing to unroll
  621. loops by hand.
  622.  
  623.      However, unrolling do loops is only a small benefit of this
  624. program.  The main reason for using the vector shorthand (and
  625. for using PREP at all) is that using a more intuitively clear
  626. and concise language greatly reduces the time spent making
  627. and correcting mistakes.
  628.  
  629.  
  630.      If you have used this program and have any comments or 
  631. suggestions, they can be sent via lectric-mail to the addresses
  632. mentioned above.
  633.  
  634. @//E*O*F prep.doc//
  635. chmod u=rw,g=r,o=r prep.doc
  636.  
  637. echo x - Makefile
  638. sed 's/^@//' > "Makefile" <<'@//E*O*F Makefile//'
  639. LINKFLAGS = 
  640. LIBS      = -lm
  641. OBJS     = prep.o flow.o vec.o misc.o str.o
  642.  
  643. @.SUFFIXES : 
  644. @.SUFFIXES : .o .c
  645.  
  646. prep :: $(OBJS) macro.o
  647.     cc -o prep $(OBJS) macro.o $(LIBS)
  648.  
  649. @.c.o :
  650.     cc -c -O $*.c
  651.  
  652. macro.o : macro.c prepdf.h prep.h
  653.  
  654. $(OBJS) : prep.h prepdf.h
  655.  
  656. @//E*O*F Makefile//
  657. chmod u=rw,g=r,o=r Makefile
  658.  
  659. echo x - makemsc
  660. sed 's/^@//' > "makemsc" <<'@//E*O*F makemsc//'
  661. #----------------------------------------------------------------------
  662. #  MAKEFILE for PREP, msc version, (Kneller make)
  663. #-----------------------------------------------------------------------
  664.  
  665. LINKFLAGS = /stack:10000
  666. LIBS      = c:\lib\\
  667.  
  668. COBJS     = prep.obj flow.obj vec.obj misc.obj
  669.  
  670. @.SUFFIXES : 
  671. @.SUFFIXES : .exe .obj .c
  672.  
  673. prep.exe :: $(COBJS) macro.obj
  674.     @link $<, $@, NUL, $(LIBS) $(LINKFLAGS)
  675.  
  676. @.c.obj :
  677.     msc $* /AS;
  678.  
  679. $(COBJS) :: prep.h  prepdf.h $*.c
  680.  
  681. macro.obj :: prep.h prepdf.h macro.h $*.c
  682. @//E*O*F makemsc//
  683. chmod u=rw,g=r,o=r makemsc
  684.  
  685. echo x - prep.c
  686. sed 's/^@//' > "prep.c" <<'@//E*O*F prep.c//'
  687. /* Program PREP.C
  688.  *
  689.  * Preprocessor for FORTRAN 77.
  690.  * Adds the additional features:
  691.  *
  692.  *  1) Vector arithmetic:
  693.  *     a(#,#,1) = b(#,#) + 1
  694.  *
  695.  *   [ a(#) = b(#)*c(#) - 100
  696.  *     x = y
  697.  *     d(#) = e(#)         ]
  698.  *
  699.  *  2) Case construct:
  700.  *     case ( exp1 )
  701.  *     of   ( exp2 )  line of code
  702.  *                    line of code
  703.  *                    continue_case
  704.  *     of   ( exp3 )  line of code
  705.  *     default        line of code
  706.  *                    line of code
  707.  *     end_case
  708.  *
  709.  *  3) do i = 1, 10
  710.  *        line of code
  711.  *        line of code
  712.  *     leave_do (optional expression)
  713.  *        line of code
  714.  *     continue_do (optional expression)
  715.  *        line of code
  716.  *     end_do
  717.  *
  718.  *  4) forth style begin/while/until/again construct:
  719.  *     begin ... again
  720.  *     begin ... while (exp1) ... again
  721.  *     begin ... until (exp1)
  722.  *     leave (optional expression) to exit current level
  723.  *     continue (optional expression) to go back to beginning
  724.  *
  725.  *  5) Vector loop unrolling to any depth, for loops 
  726.  *     that can be expressed as in #1 above.
  727.  *
  728.  *  6) Macro processing, defined a macro "name" with:
  729.  *     : name(a,b,c)    a = a + func( c, d ) ;
  730.  *
  731.  *  7) Included files:
  732.  *     #include "filename"
  733.  *
  734.  *    The nesting limit for all loops is defined by the constant
  735.  * NESTING in file prepdefs.h.  All underline characters are removed,
  736.  * as are comments if com_keep is NULL.
  737.  *    Any delimeters (){}[]'" may be used in the logical expressions
  738.  * ( i.e.  leave [i .eq. 1] ).
  739.  *    The flow control directives are permitted inside vector
  740.  * loops, but since they will inhibit Cray vectorization of those
  741.  * loops it may be best to avoid this.  One of the reasons for
  742.  * using the vector shorthand is that it encourages programming
  743.  * in a style that can be easily vectorized.
  744.  *    Some attempts have been made to avoid ratfor syntax to that
  745.  * both preprocessors can be used, but this has never been checked.
  746.  *    The number of parameters allowed in a macro is set by the constant
  747.  * MAX_MAC_PARMS in file prepdefs.h (20 is probably more than enough).
  748.  *    Although the syntax is similar to forth, the spirit of
  749.  * forth is totally absent.  The macros are really macros,
  750.  * not colon definitions, and recursive macro definitions will cause
  751.  * an error during expansion.  Postfix notation would only cause
  752.  * confusion, being in conflict with fortran conventions, and is
  753.  * not used.
  754.  *    The macro processor can be considered a pre-preprocessor.  The
  755.  * order of translation is:
  756.  *
  757.  *    1) file inclusion
  758.  *    2) macro processing
  759.  *    3) flow control extensions
  760.  *    4) vector statements
  761.  *
  762.  * Note that because of this the flow control syntax can be modified
  763.  * at the macro level.
  764.  *
  765.  * Switches:
  766.  *   -c        keep comments (truncated at column 72)
  767.  *   -u        keep underline characters
  768.  *   -m        only do macro substitution (==> -c and -u as well, and
  769.  *        prevents file includes (except -i switch).
  770.  *   -i    <file>    include <file> before processing
  771.  *   -U n    unroll vector loops to depth n
  772.  *   -L n    unroll loops with n or fewer lines
  773.  *   -?        write message about allowed switches
  774.  *
  775.  * P. R. OVE  11/9/85
  776.  */
  777.  
  778. #define    MAIN    1
  779. #include "prep.h"
  780.  
  781. main( argc, argv )
  782. int    argc ;
  783. char    *argv[] ;
  784. {
  785. int     i, j, maxlength, lines ;
  786. char    *text ;
  787.  
  788.  
  789. init() ;
  790. parmer( argc, argv ) ;    /* process command line switches */
  791.  
  792. /* copyright notice */
  793. fprintf( stderr,
  794.     "PREP  Copyright (C) 1985,1986 P.R.Ove.  All rights reserved\n" ) ;
  795.  
  796. /* Main loop, loop until true end of file */
  797. while ( 1 ) {
  798.  
  799.     /* get the next record */
  800.     if ( NULL == get_rec() ) break ;
  801.  
  802.     /* comment and blank line filtering */        
  803.     if ( (*in_buff == 'c') | (*in_buff == 'C') | NOT (IN_BUFF_FULL) ) {
  804.         if ( com_keep ) {
  805.             if ( NOT macro_only ) in_buff[72] = NULL ;
  806.             put_string( in_buff ) ;
  807.         }
  808.         continue ;
  809.     }
  810.  
  811.     /* handle file inclusion if not in macro_only mode */
  812.     if ( NOT macro_only ) {
  813.         preproc( rec_type( 0 ) ) ;
  814.         if ( NOT (IN_BUFF_FULL) ) continue ;
  815.     }
  816.  
  817.     /* expand macros in in_buff, result pointed to by text */
  818.     if ( NULL == (text = mac_proc()) ) continue ;    /* NULL ==> macro def */
  819.  
  820.     /* output text here if only doing macro expansion */
  821.     if ( macro_only ) {
  822.         put_string( text ) ;
  823.         free( text ) ;
  824.         continue ;
  825.     }
  826.  
  827.     /* count lines in text, delimit with NULLs, and find the longest line */
  828.     for ( maxlength=0, i=0, j=0, lines=1;; i++, j++ ) {
  829.         if ( text[i] == '\n' ) {
  830.             text[i] = NULL ;
  831.             if ( j>maxlength ) maxlength = j ;
  832.             j = -1 ;
  833.             lines++ ;
  834.             continue ;
  835.         }
  836.         if ( text[i] == NULL ) {
  837.             if ( j>maxlength ) maxlength = j ;
  838.             break ;
  839.         }
  840.     }
  841.  
  842.     /* if necessary expand the output buffer size */
  843.     if ( maxlength > allocation ) {
  844.         allocation = maxlength + maxlength/10 ;
  845.         if ( NULL == (in_buff = realloc( in_buff, allocation )) )
  846.             abort( "reallocation failed" ) ;
  847.         if ( NULL == (out_buff = realloc( out_buff, 4*allocation )) )
  848.             abort( "reallocation failed" ) ;
  849.     }
  850.  
  851.     /* send each line through the passes */
  852.     for ( j=0, i=0; j<lines; j++, i+=strlen(&text[i])+1 ) {
  853.         strcpy( in_buff, &text[i] ) ;
  854.         passes() ;
  855.     }
  856.     
  857.     /* free the storage created by mac_proc */
  858.     free( text ) ;
  859. }
  860.  
  861. fclose( out ) ;
  862. }
  863.  
  864.  
  865.  
  866. /* Do preprocessor passes 1, 2, and 3 on text in in_buff.  Output is
  867.  * also done here.
  868.  */
  869. passes()
  870. {
  871.  
  872. /* process the statement until it is NULL */
  873. while ( IN_BUFF_FULL ) {
  874.  
  875.     preproc( rec_type( 1 ) ) ;
  876.  
  877.     preproc( rec_type( 2 ) ) ;
  878.  
  879.     preproc( rec_type( 3 ) ) ;
  880. }
  881. }
  882.  
  883.  
  884.  
  885. /* initialization */
  886. init() {
  887. int    i ;
  888.  
  889. /* do loop counter variables and flags */
  890. for ( i = 0; i < NESTING; i++ ) {
  891.     sprintf( var_name[i], "i%03d", i ) ;
  892.     leave_do_flag[i] = FALSE ;
  893. }
  894.  
  895. /* Allocate some space for the buffers */
  896. allocation = DEF_BUFFSIZE ;
  897. GET_MEM( in_buff, allocation ) ;
  898. GET_MEM( out_buff, 4*allocation ) ;
  899. }
  900.  
  901.  
  902.  
  903. /* error exit */
  904. abort( string )
  905. char    *string ;
  906. {
  907.     fprintf( stderr, "%s\n", string ) ;
  908.     fprintf( out, "%s\n", string ) ;
  909.     fclose( out ) ;
  910.     exit() ;
  911. }
  912. @//E*O*F prep.c//
  913. chmod u=rw,g=r,o=r prep.c
  914.  
  915. echo x - macro.c
  916. sed 's/^@//' > "macro.c" <<'@//E*O*F macro.c//'
  917. /* MACRO.c
  918.  *
  919.  *   The routines in this file support the macro processing facilities
  920.  * of PREP.  The style is similar to that of c #define macros, except
  921.  * that : is used instead of #define and ; terminates the macro.  
  922.  * This is done to allow both PREP macros and ratfor macros in the
  923.  * same program.
  924.  *   Recursive definitions are permitted, but will cause an abort
  925.  * (and possibley a memory allocation error) on expansion.  For each
  926.  * line submitted to expand_macros, a count of is kept for each
  927.  * stored macro indicating how many times it has been expanded in
  928.  * the current line.  When this exceeds MAX_CALLS, the program 
  929.  * assumes a macro definition is recursive and stops.  Macros
  930.  * are expanded starting with the one with the longest name, so that
  931.  * if the definitions
  932.  *
  933.  * : >=        .ge. ;
  934.  * : >        .gt. ;
  935.  *
  936.  * are in effect, >= will be changed to .ge. rather than .gt.=.  This
  937.  * is only a potential problem when macro names are not fully
  938.  * alphanumeric, since "arg" will not be flagged if "r" is defined.
  939.  *
  940.  * 11/4/86 P.R.OVE
  941.  */
  942.  
  943. #include "macro.h"
  944.  
  945.  
  946. /* Macro processor.
  947.  *
  948.  *   This routine defines and expands macros.  The definition phase
  949.  * is invoked when a leading : is found in the record.  Text is
  950.  * then taken until the terminating ; is found.  Text following the
  951.  * ; is ignored.  Multiline macros are permitted: they will be
  952.  * converted to at least as many lines in the fortran program.
  953.  * Failure to have a terminating ; will define the entire program
  954.  * to be a macro.
  955.  *   A NULL pointer is returned if a macro has been defined.  Otherwise
  956.  * a pointer to the buffer with the expanded text is returned (even if
  957.  * no macros have been expanded).  The buffer is temporary and should
  958.  * be eliminated by the caller.
  959.  */
  960.  
  961. char    *mac_proc()
  962. {
  963. int    i, j, size ;
  964. char    *text, *def ;
  965.  
  966.  
  967. /* see if this is a definition (look for leading :) */
  968. for ( i=0, text=NULL; in_buff[i] != NULL; i++ ) {
  969.     if ( in_buff[i] == BLANK | in_buff[i] == TAB ) continue ;
  970.     if ( in_buff[i] == ':' ) text = &in_buff[i] ;
  971.     break ;
  972. }
  973.  
  974. if ( text == NULL ) {
  975. /* expand macro if not a definition */
  976.     if ( defined_macros == 0 ) {
  977.         GET_MEM( text, strlen(in_buff) ) ;
  978.         strcpy( text, in_buff ) ;
  979.         return( text ) ;
  980.     }
  981.     else return( expand_macros( in_buff ) ) ;
  982.  
  983. }
  984. else {
  985.  
  986. /* macro definition, get characters until ; */
  987.     GET_MEM( def, strlen(text)+10 ) ;
  988.     strcpy( def, text ) ;
  989.     for ( j=1;; j++ ) {
  990.  
  991.         switch ( def[j] ) {
  992.  
  993.         case ';'  :{    def[j+1] = NULL ;
  994.                 define_macro( def ) ;
  995.                 free( def ) ;
  996.                 return( NULL ) ;
  997.             }
  998.             
  999.         case NULL :{    
  1000.                 def[j] = '\n' ;
  1001.                 def[j+1] = NULL ;
  1002.                 if ( NULL == get_rec() )
  1003.                     abort("MACRO: EOF in macro def") ;
  1004.                 size = strlen(def) + strlen(in_buff) + 10 ;
  1005.                 if ( NULL == (def=realloc(def,size)) )
  1006.                     abort("MACRO: realloc error") ;
  1007.                 strcat( def, in_buff ) ;
  1008.             }
  1009.         }
  1010.     }
  1011. }
  1012. }
  1013.  
  1014.  
  1015.  
  1016.  
  1017. /* Process the macro definition in the argument string.
  1018.  * A macro has the form:
  1019.  *
  1020.  * : name( parm1, parm2, ... )    text with parms ;
  1021.  *
  1022.  * In a definition the delimeter must follow the name
  1023.  * without whitespace.  In the source code this requirement is
  1024.  * relaxed.  Alphanumeric macros must be not be next to an alpha or 
  1025.  * number character or they will not be recognized.
  1026.  *
  1027.  * This routine puts the macro string into a more easily handled
  1028.  * structure, replacing parms in the text with n, where n is a
  1029.  * binary value (128 to 128+MAX_TOKENS).
  1030.  *
  1031.  * The macro is placed in a structure of the form:
  1032.  *
  1033.  *    struct mac {
  1034.  *    char *name ;        macro id tag
  1035.  *    char *text ;        encoded macro text
  1036.  *    int  parmcount ;    number of arguments
  1037.  *    int  callcount ;    recursion check
  1038.  *    } macro[MAX_MACROS] ;
  1039.  *
  1040.  * where the text string has binary symbols where the parms were.
  1041.  * Returns the macro index.  The number of macros defined is stored
  1042.  * in global variable defined_macros.
  1043.  * 
  1044.  * The macros are entered in order of their name length, so that
  1045.  * the macro expander will expand those with long names first.
  1046.  */
  1047.  
  1048. int    define_macro(string)
  1049. char    *string ;
  1050. {
  1051. char    *pntr, *pntr1, *name, *parms[MAX_TOKENS], *parm, *text,
  1052.     *open_parens, *close_parens ;
  1053. int    i, j, l, parmcount ;
  1054.  
  1055. /* macrop is a pointer to the macro structure that will be used */
  1056.     if ( defined_macros >= MAX_MACROS ) {
  1057.         sprintf(errline,"DEFINE_MACRO: too many macros: %s",string);
  1058.         abort( errline ) ;
  1059.     }
  1060.     macrop = ¯o[defined_macros] ;
  1061.     defined_macros++ ;
  1062.  
  1063. /* get the name */
  1064.     name = strtokp( string, ":; \n\t(" ) ;    /* pointer to the name */
  1065.     GET_MEM( macrop->name, strlen(name) ) ;
  1066.     strcpy( macrop->name, name ) ;
  1067.  
  1068. /* get the parameters */
  1069.     for ( i=0; i<MAX_TOKENS; i++ ) parms[i] = NULL ;
  1070.     open_parens = strmatch(string,name) + strlen(name) ;
  1071.     if ( NULL == line_end( open_parens ) ) {
  1072.         sprintf( errline, "DEFINE_MACRO: unterminated: %s", string ) ;
  1073.         abort( errline ) ;
  1074.     }
  1075.  
  1076.     /* get the text storage here to avoid memory allocation tangles */
  1077.     text = open_parens ;
  1078.     GET_MEM( macrop->text, strlen(text) ) ;
  1079.  
  1080.     if ( strchr( "([{\'\"", *open_parens ) ) {
  1081.         if ( NULL == ( close_parens = mat_del( open_parens ) ) ) {
  1082.             sprintf(errline,"DEFINE_MACRO: missing delimeter: %s",
  1083.                 string ) ;
  1084.             abort( errline ) ;
  1085.         }
  1086.         text = close_parens + 1 ;
  1087.         i = (int)(close_parens - open_parens) - 1 ;
  1088.         pntr = open_parens + 1 ;
  1089.         *close_parens = NULL ;
  1090.         for ( i=0, pntr1 = pntr; i<MAX_TOKENS; i++, pntr1 = NULL ) {
  1091.             if ( NULL == ( parm = strtokp( pntr1, ", \t" ) ) )
  1092.                 break ;
  1093.             GET_MEM( parms[i], strlen(parm) ) ;
  1094.             strcpy( parms[i], parm ) ;
  1095.         }
  1096.     }
  1097.  
  1098.     
  1099. /* get the text, plugging in binary codes for parameters */
  1100.  
  1101.     /* remove leading whitespace */
  1102.     if ( NULL == (text=line_end( text )) ) {
  1103.         sprintf( errline, "DEFINE_MACRO: unterminated: %s", string ) ;
  1104.         abort( errline ) ;
  1105.     }
  1106.  
  1107.     /* remove the trailing ';' but NOT whitespace */
  1108.     for ( i=strlen(text)-1; i>=0; i-- ) {
  1109.         if ( text[i] == ';' ) { text[i] = NULL ; break ; }
  1110.     }
  1111.  
  1112.     strcpy( macrop->text, text ) ;
  1113.     text = macrop->text ;
  1114.  
  1115.     for ( i=0; i<MAX_TOKENS & NULL != (parm = parms[i]); i++ ) {
  1116.  
  1117.         /* replace parm by code, if not next to an alpha or number */
  1118.         l = strlen(parm) ;
  1119.         for ( pntr=text;NULL != (pntr1=strmatch(pntr,parm));
  1120.         pntr=pntr1+1 ) {
  1121.             if ( !( isalnum(*(pntr1-1)) && isalnum(*pntr1) ) &
  1122.                  !( isalnum(*(pntr1+l-1)) && isalnum(*(pntr1+l)))) {
  1123.                      *pntr1 = i + 128 ;
  1124.                 strcpy( pntr1 + 1, pntr1 + strlen(parm) ) ;
  1125.             }
  1126.         }
  1127.     }
  1128.  
  1129.     
  1130. /* count parms and free up temporary storage */
  1131.     macrop->parmcount = 0 ;
  1132.     for ( i=0; i<MAX_TOKENS & NULL != parms[i]; i++ ) {
  1133.         free( parms[i] ) ;
  1134.         macrop->parmcount++ ;
  1135.     }
  1136.  
  1137. /* rearrange the macro table so it is sorted by name length */
  1138.     name = macrop->name ;
  1139.     text = macrop->text ;
  1140.     parmcount = macrop->parmcount ;
  1141.     l = strlen( name ) ;
  1142.     for ( i=0; i<defined_macros-1; i++ ) {
  1143.         if ( l < strlen( macro[i].name ) ) {
  1144.             for ( j=defined_macros-1; j>i; j-- ) {
  1145.                 macro[j].name = macro[j-1].name ;
  1146.                 macro[j].text = macro[j-1].text ;
  1147.                 macro[j].parmcount = macro[j-1].parmcount ;
  1148.             }
  1149.             macro[i].name = name ;
  1150.             macro[i].text = text ;
  1151.             macro[i].parmcount = parmcount ;
  1152.             break ;
  1153.         }
  1154.     }
  1155.     
  1156. /* return the index of the new macro */
  1157.     return(i) ;
  1158. }
  1159.  
  1160.  
  1161.  
  1162. /* Expand the macros in the argument string.  Returns a pointer
  1163.  * to the expanded string, which is likely to be huge.  The memory
  1164.  * should be freed as soon as possible.  The macros are expanded
  1165.  * starting with the one with the highest index.  Recursive macro
  1166.  * definitions will be flagged, but may cause a termination due to
  1167.  * allocation failure before doing so.  Caution must be exercised
  1168.  * to avoid accidental recursive definitions involving
  1169.  * more than one macro:
  1170.  *    : h    i+x ;
  1171.  *    : i(y)    func(y) ;
  1172.  *    : func    h ;
  1173.  * This will generate the successive strings (from a = func(x)):
  1174.  *    a = h(x)
  1175.  *    a = i+x(x)
  1176.  *    a = func()+x(x)
  1177.  *    a = h()+x(x) .... and so on.  Beware.
  1178.  * The string is deallocated by this routine.
  1179.  */
  1180.  
  1181. /* macros to check for being next to an alpha */
  1182. #define FIRSTCHAR ( (pntr1!=text) && (isalnum(*(pntr1-1))&&isalnum(*pntr1)) )
  1183. #define LASTCHAR  ( isalnum(*(pntr1+l-1)) && isalnum(*(pntr1+l)) )
  1184. #define NEXT_TO_ALPHA    ( FIRSTCHAR || LASTCHAR )
  1185.  
  1186. char    *expand_macros(string)
  1187. char    *string ;
  1188. {
  1189. char    *pntr, *pntr1, *name, *text ;
  1190. int    i, hit, l ;
  1191.  
  1192. /* Allocate some initial storage */
  1193.     GET_MEM( text, strlen(string) ) ;
  1194.     strcpy( text, string ) ;
  1195.  
  1196. /* clear the recursion check counters */
  1197.     for ( i=0; i<defined_macros; i++ ) macro[i].callcount = 0 ;
  1198.  
  1199. /* search for macros */
  1200.     do {
  1201.     for ( i=defined_macros-1, hit=0; i>=0; i-- ) {
  1202.         
  1203.     /* See if macro[i] is in the present string.  If the "edges"
  1204.      * of the macro name are alphanumeric, don't accept the string
  1205.      * if the adjacent character is also alphanumeric.  This avoids
  1206.      * having variables such as "sin" flagged if "s" is defined.
  1207.      * Potential macros are also rejected if quoted with '.
  1208.      */
  1209.         name = macro[i].name ;
  1210.         l = strlen(name) ;
  1211.         for ( pntr=text; NULL != (pntr1=strmatch(pntr,name));
  1212.         pntr=pntr1+1 ) {
  1213.             if ( !quoted( pntr1, text ) && !NEXT_TO_ALPHA ) {
  1214.                 hit = 1 ;            /* got one */
  1215.                 text = mac_expand( text, pntr1, i ) ;
  1216.                 break ;
  1217.             }
  1218.         }
  1219.         if ( hit != 0 ) break ;    /* start over if one was found */
  1220.     }
  1221.     } while( hit != 0 ) ; 
  1222.  
  1223.  
  1224.     return( text ) ;
  1225. }
  1226.  
  1227.  
  1228.  
  1229. /* Expand a single macro in a text string, freeing the old storage
  1230.  * and returning * a pointer to the new string.  Name points to the
  1231.  * macro in the string and index is the macro index.
  1232.  */
  1233.  
  1234. char    *mac_expand( text, name, index )
  1235. char    *text, *name ;
  1236. int    index ;
  1237. {
  1238. char    *pntr, *newtext, *parm, *parms[MAX_TOKENS], *temp,
  1239.     *open_parens, *close_parens, *rest_of_text ;
  1240. int    i, j, size ;
  1241. unsigned char     c ;
  1242.  
  1243.     macrop = ¯o[index] ;
  1244.     if ( macrop->callcount++ > MAX_CALLS ) {
  1245.         sprintf( errline,
  1246.         "MAC_EXPAND: possible recursion involving: \'%s\' in\n%s",
  1247.             macrop->name, in_buff ) ;
  1248.         abort( errline ) ;
  1249.     }
  1250.     
  1251.  
  1252. /* get the parameters if there are any for this macro */
  1253.     for ( i=0; i<MAX_TOKENS; i++ ) parms[i] = NULL ;
  1254.     rest_of_text = &name[ strlen( macrop->name ) ] ;
  1255.     if ( macrop->parmcount != 0 ) {
  1256.         open_parens = &rest_of_text[ strspn( rest_of_text, " \t" ) ] ;
  1257.         if ( (NULL != strchr( "([{\'\"", *open_parens )) &
  1258.              (NULL != *open_parens )) {
  1259.             if (NULL == (close_parens=mat_del(open_parens)) ) {
  1260.                 sprintf( errline,
  1261.                 "MAC_EXPAND: missing delimeter: %s", in_buff ) ;
  1262.                 abort( errline ) ;
  1263.             }
  1264.             i = (int)(close_parens - open_parens) - 1 ;
  1265.             pntr = open_parens + 1 ;
  1266.             c = *close_parens ;        /* save *close_parens */
  1267.             *close_parens = NULL ;        /* make parm block a string */
  1268.             i = tokenize( pntr, parms ) ;    /* break out the parms */
  1269.             *close_parens = (char)c ;     /* restore text */
  1270.             rest_of_text = close_parens + 1 ;
  1271.         }
  1272.     }
  1273.  
  1274.     
  1275. /* find out how much memory we will need, then allocate */
  1276.     size = strlen(text) ;
  1277.     if ( NULL != ( pntr = macrop->text ) ) size += strlen(pntr) ;
  1278.     for ( i=0; NULL != (c=pntr[i]); i++ ) {
  1279.         if ( c > 127 & parms[c-128] != NULL )
  1280.             size += strlen(parms[c-128]) ;
  1281.     }
  1282.     GET_MEM( newtext, size ) ;
  1283.  
  1284.  
  1285. /* copy up to macro verbatim */
  1286.     *name = NULL ;
  1287.     strcpy( newtext, text ) ;
  1288.  
  1289. /* expand the macro itself if there is text */
  1290.     if ( NULL != (pntr = macrop->text) ) {
  1291.         for ( i=0, j=strlen(newtext); NULL != (c=pntr[i]); i++, j++ ) {
  1292.             if ( c > 127 ) {
  1293.                 if ( parms[c-128] != NULL ) {
  1294.                     strcat( newtext, parms[c-128] ) ;
  1295.                     j += strlen( parms[c-128] ) - 1 ;
  1296.                 }
  1297.                 else j-- ;
  1298.             }
  1299.             else {        /* keep null terminated */
  1300.                 newtext[j] = c ;
  1301.                 newtext[j+1] = NULL ;
  1302.             }
  1303.         }
  1304.     }
  1305.     
  1306.  
  1307. /* finish off trailing text */
  1308.     strcat( newtext, rest_of_text ) ;
  1309.     
  1310. /* free up temporary storage and return pointer to new allocation */
  1311.     for ( i=0; i<MAX_TOKENS & NULL != parms[i]; i++ ) free( parms[i] ) ;
  1312.     free( text ) ;
  1313.     return( newtext ) ;
  1314. }
  1315.  
  1316.  
  1317.  
  1318.  
  1319. /* isalnum: returns nonzero value if the character argument belongs to the 
  1320.  * sets { a-z, A-Z, 0-9 }.
  1321.  */
  1322.  
  1323. int    isalnum( c )
  1324. char    c ;
  1325. {
  1326.     if ( c >= 97 & c <= 122 ) return (1) ;    /* a-z */
  1327.     if ( c >= 65 & c <= 90 ) return (2) ;    /* A-Z */
  1328.     if ( c >= 48 & c <= 57 ) return (3) ;    /* 0-9 */
  1329.     return(0) ;                /* miss */
  1330. }
  1331.  
  1332.  
  1333.  
  1334.  
  1335. /* Return TRUE is the pointer is quoted in the string (pntr marks
  1336.  * a position in the string).  The quote character the apostrophe.
  1337.  * If pntr is not in the the result will be meaningless.
  1338.  */
  1339.  
  1340. int    quoted( pntr, string )
  1341. char    *pntr, *string ;
  1342. {
  1343. int    i, quote=FALSE ;
  1344.  
  1345.     for ( i=0; NULL != string[i] && &string[i] < pntr; i++ )
  1346.         if ( string[i] == '\'' ) quote = !quote ;
  1347.         
  1348.     return( quote ) ;
  1349. }
  1350. @//E*O*F macro.c//
  1351. chmod u=rw,g=r,o=r macro.c
  1352.  
  1353. echo x - vec.c
  1354. sed 's/^@//' > "vec.c" <<'@//E*O*F vec.c//'
  1355. /* Routines related to vector shorthand extensions */
  1356.  
  1357. #include "prep.h"
  1358.  
  1359.  
  1360.  
  1361.  
  1362. /* Function CSQB_PROC.C
  1363.  *
  1364.  * Process close square brackets.  Abort if called while
  1365.  * not in a vector loop, else finish off vector loop processing
  1366.  * with a call to end_vec.
  1367.  *
  1368.  * P. R. OVE  11/9/85
  1369.  */
  1370.  
  1371. csqb_proc() 
  1372. {
  1373. int    i, quote=1 ;
  1374.  
  1375. /* if vec_flag not set this call is an error */
  1376. if ( NOT vec_flag ) {
  1377.     sprintf( errline, "CSQB: not in vector loop: %s", in_buff ) ;
  1378.     abort( errline ) ;
  1379. }
  1380.                       
  1381. /* see what in_buff contains and replace unquoted ] by NULL */
  1382. for ( i = 0; in_buff[i] != NULL; i++ ) {
  1383.     switch ( in_buff[i] ) {
  1384.     
  1385.     case '\'' :    quote = -quote ;
  1386.             break ;
  1387.     case ']' :    if ( quote == 1 ) {
  1388.                 in_buff[i] = NULL ;
  1389.                 i-- ;        /* force termination */
  1390.                 break ;
  1391.             }
  1392.     }
  1393. }
  1394.  
  1395. dump( in_buff ) ;    /* --> mem_store */
  1396. end_vec();        /* terminate vector loop */
  1397.  
  1398. IN_BUFF_DONE ;
  1399. }
  1400.  
  1401.  
  1402.  
  1403.  
  1404. /* Function DO_LIMITS_PROC
  1405.  *
  1406.  * Process do_limits statements: Parse variable string.
  1407.  *
  1408.  * P. R. OVE  11/9/85
  1409.  */
  1410.  
  1411. char    *tokens[MAX_TOKENS] ;
  1412.  
  1413. do_limits_proc()
  1414. {                  
  1415. int    i, j, k ;
  1416. char    *temp[MAX_TOKENS], *open_parens, *close_parens ;
  1417.  
  1418. /* free allocation from previous call */
  1419. free_loop_vars() ;
  1420.  
  1421. /* find the open and close delimeters */
  1422. open_parens = &in_buff[ strcspn( in_buff, "[({\'\"" ) ] ;
  1423. if ( NULL == ( close_parens = mat_del( open_parens ) ) ) {
  1424.     sprintf( errline, "DO_LIMITS: missing delimeter: %s", in_buff ) ;
  1425.     abort( errline ) ;
  1426. }
  1427. *close_parens = NULL ;    /* make arg string null terminated */
  1428.  
  1429.  
  1430. /* get the (initial,limit,increment) triples */
  1431. var_count = tokenize( open_parens+1, tokens ) ;
  1432.  
  1433. /* handle wierd numbers of tokens */
  1434. if ( var_count <= 0 ) abort( "ERROR: no variables found" ) ;
  1435. for ( i = NESTING; i < var_count; i++ ) {
  1436.     var_count = NESTING ; free( tokens[i] ) ; }
  1437.  
  1438.  
  1439. /* At this stage the tokens are strings like
  1440.  *
  1441.  *  "(initial , limit , increment)  ==>  do i = initial, limit, increment.
  1442.  *
  1443.  * If one is missing it is assumed to be the increment.  If two are
  1444.  * missing the single item is assumed to be the limit.  The parens are
  1445.  * unnecessary if there is only the limit.
  1446.  *
  1447.  * break out the tokens (delimeted by commas)
  1448.  */
  1449. alloc_loop_vars() ;
  1450. for ( i = 0; i < var_count; i++ ) {
  1451.  
  1452.     /* find the open and close delimeters if present, and handle them*/
  1453.     open_parens = &tokens[i][ strcspn( tokens[i], "[({\'\"" ) ] ;
  1454.     if ( NULL != ( close_parens = mat_del( open_parens ) ) ) {
  1455.         *close_parens = NULL ;
  1456.         *open_parens = BLANK ;
  1457.     }
  1458.  
  1459.     k = tokenize( tokens[i], temp ) ;
  1460.  
  1461.     /* case of too many tokens, ignore trailers */
  1462.     for ( j = 3; j < k; j++ ) { k = 3 ; free( temp[j] ) ; }
  1463.  
  1464.     switch ( k ) {
  1465.     case 1:    strcpy(initial_name[i], "1") ;
  1466.         sprintf(limit_name[i], "(%s)", temp[0]) ; free( temp[0] ) ;
  1467.         strcpy(increment_name[i], "1") ;
  1468.         break;
  1469.  
  1470.     case 2:    sprintf(initial_name[i], "(%s)", temp[0]) ; free( temp[0] ) ;
  1471.         sprintf(limit_name[i], "(%s)", temp[1]) ; free( temp[1] ) ;
  1472.         strcpy(increment_name[i], "1") ;
  1473.         break;
  1474.  
  1475.     case 3:    sprintf(initial_name[i], "(%s)", temp[0]) ; free( temp[0] ) ;
  1476.         sprintf(limit_name[i], "(%s)", temp[1]) ; free( temp[1] ) ;
  1477.         sprintf(increment_name[i], "(%s)", temp[2]) ; free( temp[2] ) ;
  1478.         break;
  1479.  
  1480.     default:strcpy(initial_name[i], "1") ;
  1481.         sprintf(limit_name[i], "(%s)", "undefined" ) ;
  1482.         strcpy(increment_name[i], "1") ;
  1483.         break;
  1484.     }
  1485. }                
  1486.  
  1487. IN_BUFF_DONE
  1488. }
  1489.  
  1490. /* release allocation from previous call */
  1491. free_loop_vars() {
  1492. int    i ;
  1493.  
  1494. for ( i = 0; i < var_count; i++ ) {
  1495.     free( tokens[i] ) ;
  1496.     free( initial_name[i] ) ;
  1497.     free( limit_name[i] ) ;
  1498.     free( increment_name[i] ) ;
  1499. }
  1500. }
  1501.  
  1502. /* allocate space for do loop variables */
  1503. alloc_loop_vars() {
  1504. int    i, size ;
  1505.  
  1506. for ( i = 0; i < var_count; i++ ) {
  1507.     size = strlen( tokens[i] ) + 10 ;
  1508.     GET_MEM( initial_name[i], size ) ;
  1509.     GET_MEM( limit_name[i], size ) ;
  1510.     GET_MEM( increment_name[i], size ) ;
  1511. }
  1512. }
  1513.  
  1514.  
  1515.  
  1516.  
  1517. /* Function END_VEC.C
  1518.  *
  1519.  * This routine is called when a cluster of vector arithmetic
  1520.  * is ready to be terminated (a closing ] has been found
  1521.  * or the statement was a single line vector * statement.  The
  1522.  * core of the loop has by now been pushed into MEM_STORE and
  1523.  * will now be extracted and processed.  On completion MEM_STORE
  1524.  * is released.
  1525.  *
  1526.  * P. R. OVE  11/9/85
  1527.  */
  1528.  
  1529. end_vec() 
  1530. {
  1531. int    i, j ;
  1532.  
  1533. /* reset the flag */
  1534. vec_flag = FALSE ;
  1535.  
  1536. make_do() ;    /* write the initial do loop statements */
  1537.  
  1538. if ( NOT UNROLLING ) {
  1539.     /* process all of the pushed statements through transvec */
  1540.     for ( i = 0; i < mem_count; i++ )
  1541.         transvec( mem_store[i], 0 ) ;
  1542.  
  1543.     make_continue() ;    /* write continue statements */
  1544. }
  1545.  
  1546. else {
  1547.     /* process the statements though transvec unroll_depth times */
  1548.     for ( j = 0; j < unroll_depth; j++ ) {
  1549.         for ( i = 0; i < mem_count; i++ )
  1550.             transvec( mem_store[i], j ) ;
  1551.     }
  1552.     make_continue() ;
  1553.  
  1554.     /* write the clean up part of the unrolled loop */
  1555.     make_labels() ;
  1556.     make_clean_do() ;
  1557.     for ( i = 0; i < mem_count; i++ )
  1558.         transvec( mem_store[i], 0 ) ;
  1559.     make_continue() ;
  1560. }
  1561.  
  1562. /* release the memory held by MEM_STORE and return to main level */
  1563. while ( push(NULL) >= 0 ) ;
  1564. IN_BUFF_DONE
  1565. }
  1566.  
  1567.  
  1568.  
  1569.  
  1570. /* Make the initial do statements */
  1571. make_do() {
  1572. int    i ;
  1573.  
  1574. /* outermost do statement is different if unrolling is on */
  1575. i = var_count - 1 ;
  1576.  
  1577. if ( UNROLLING ) {
  1578. /* This section unrolls: do i = a, b, c   (depth = d)   into
  1579.  *
  1580.  *             b-a+c
  1581.  * do i = a, (-------)*(c*d) + a - c, c*d  
  1582.  *              c*d
  1583.  *
  1584.  * for the outermost loop.  Inner loops are unchanged.
  1585.  */
  1586.     sprintf( out_buff,
  1587.     "      do %s %s=%s,int((1.0*(%s-%s+%s))/(%s*%d))*%s*%d+%s-%s,%s*%d",
  1588.         label[i], var_name[i], initial_name[i],
  1589.         limit_name[i], initial_name[i], increment_name[i],
  1590.         increment_name[i], unroll_depth,
  1591.         increment_name[i], unroll_depth,
  1592.         initial_name[i], increment_name[i],
  1593.         increment_name[i], unroll_depth ) ;
  1594.     dump( out_buff ) ; }
  1595. else {
  1596.     sprintf( out_buff, "      do %s %s = %s, %s, %s",
  1597.         label[i], var_name[i],
  1598.         initial_name[i], limit_name[i], increment_name[i] ) ;
  1599.     dump( out_buff ) ; }
  1600.  
  1601. /* handle the rest of the do statements */
  1602. for ( i = var_count-2; i >= 0; i-- ) {
  1603.     sprintf( out_buff, "      do %s %s = %s, %s, %s",
  1604.         label[i], var_name[i],
  1605.         initial_name[i], limit_name[i], increment_name[i] ) ;
  1606.     dump( out_buff ) ; }
  1607. }
  1608.  
  1609.  
  1610.  
  1611.  
  1612. /* make the do statements for the clean up part of the unrolled loop */
  1613. make_clean_do() {
  1614. int    i ;
  1615.  
  1616. /* make the outer do statement.
  1617.  * This section unrolls: do i = a, b, c   (depth = d)   into
  1618.  *
  1619.  *          b-a+c
  1620.  * do i = (-------)*(c*d) + a, b, c
  1621.  *           c*d
  1622.  *
  1623.  * for the outermost loop.  Inner loops are unchanged.  The initial
  1624.  * value is the first element that missed the main do loop */
  1625. i = var_count - 1 ;
  1626. sprintf( out_buff,
  1627.     "      do %s %s=int((1.0*(%s-%s+%s))/(%s*%d))*%s*%d+%s,%s,%s",
  1628.     label[i], var_name[i],
  1629.     limit_name[i], initial_name[i], increment_name[i],
  1630.     increment_name[i], unroll_depth,
  1631.     increment_name[i], unroll_depth,
  1632.     initial_name[i], limit_name[i], increment_name[i] ) ;
  1633. dump( out_buff ) ;
  1634.  
  1635. /* make the remaining do statements */
  1636. for ( i = var_count-2; i >= 0; i-- ) {
  1637.     sprintf( out_buff, "      do %s %s = %s, %s, %s",
  1638.         label[i], var_name[i],
  1639.         initial_name[i], limit_name[i], increment_name[i] ) ;
  1640.     dump( out_buff ) ;
  1641. }
  1642. }
  1643.  
  1644.  
  1645. /* make the continue statements */
  1646. make_continue() {
  1647. int    i ;
  1648.  
  1649. for ( i = 0; i < var_count; i++ ) {
  1650.     sprintf( out_buff, "%s continue", label[i] ) ;
  1651.     dump( out_buff ) ; }
  1652. }
  1653.  
  1654.  
  1655.  
  1656.  
  1657. /* Function MAKE_LABELS.C
  1658.  *
  1659.  * Make var_count labels, starting with label_count
  1660.  * + 10000.
  1661.  *
  1662.  * P. R. OVE  11/9/85
  1663.  */
  1664.  
  1665. make_labels()
  1666. {                  
  1667. int    i, count ;
  1668.                     
  1669. for ( i = 0; i < var_count; i++ ) {
  1670.      
  1671.     count = 10000 + label_count ;
  1672.     label_count++ ;              
  1673.     if ( count > 12499 ) { 
  1674.         sprintf( errline, "MAKE_LABELS: too many labels: %s", in_buff ) ;
  1675.         abort( errline ) ;
  1676.     }
  1677.     sprintf( label[i], "%d", count ) ;
  1678. }
  1679. }
  1680.  
  1681.  
  1682.  
  1683. /* Function OSQB_PROC.C
  1684.  *
  1685.  *   Process open square brackets.  This routine will be
  1686.  * called when an open square bracket is found in the
  1687.  * record (start cluster of vector arithmetic).  It sets
  1688.  * up the labels and sets vec_flag so that dump will direct
  1689.  * output to mem_store instead of the output file.
  1690.  *   The initial do statements are not written here, so that
  1691.  * unrolling can be turned off if there are too many lines
  1692.  * ( > line_limit ) in the loop.  Endvec will write them.
  1693.  *   If a closing ] is also found in the same record then
  1694.  * the statement is passed through transvec immediately, since
  1695.  * it has already been processed by the rest of the preprocessor.
  1696.  *
  1697.  * P. R. OVE  11/9/85
  1698.  */
  1699.  
  1700. osqb_proc() 
  1701. {
  1702. int    i, quote=1 ;
  1703.  
  1704. /* if default loop limits have not been set abort here */
  1705. if ( var_count <= 0 ) {
  1706.     sprintf( errline, "Vector loop without default limits set: %s", in_buff ) ;
  1707.     abort( errline ) ;
  1708. }
  1709.  
  1710. make_labels() ;        /* get a list of labels */
  1711.  
  1712. vec_flag = TRUE ;    /* now force output --> mem_store */
  1713.                       
  1714. /* see what in_buff contains and replace unquoted [] by blanks */
  1715. for ( i = 0; in_buff[i] != NULL; i++ ) {
  1716.  
  1717.     switch ( in_buff[i] ) {
  1718.     
  1719.     case '\'' :    quote = -quote ;
  1720.             break ;
  1721.     case '[' :    if ( quote == 1 ) {
  1722.                 in_buff[i] = BLANK ;
  1723.                 break ;
  1724.             }
  1725.     case ']' :    if ( quote == 1 ) {
  1726.                 vec_flag = FALSE ;
  1727.                 in_buff[i] = BLANK ;
  1728.                 break ;
  1729.             }
  1730.     }
  1731. }
  1732.  
  1733. /* if there is a closing ] process the line now */
  1734. if ( NOT vec_flag ) {
  1735.     vec_flag = TRUE ;    /* force line to mem_store */
  1736.     dump( in_buff ) ;
  1737.     end_vec() ;        /* flag will be reset here */
  1738. }
  1739. else dump( in_buff ) ;        /* this will go to mem_store */
  1740.  
  1741. IN_BUFF_DONE ;
  1742. }
  1743.  
  1744.  
  1745.  
  1746.  
  1747. /* Function TRANSVEC.C
  1748.  *
  1749.  * Translate a record of vectored arithmetic and expand
  1750.  * out the # signs.  The resulting expanded record is
  1751.  * placed in out_buff and dumped.  The second argument
  1752.  * is related to unrolling, and is the amount to be
  1753.  * added to the index of the outermost loop.  This
  1754.  * should be zero if unrolling is off.  Quoted characters
  1755.  * are ignored ( ' is the fortran quote character ).
  1756.  *
  1757.  * P. R. OVE  11/9/85
  1758.  */
  1759.  
  1760. /* copy character verbatim to the output buffer */
  1761. #define    VERBATIM    out_buff[i_out] = string[i_in] ;\
  1762.             out_buff[i_out + 1] = NULL ;    \
  1763.             i_out++ ;
  1764.  
  1765.  
  1766. transvec( string, outer_loop_inc ) 
  1767. char    *string ;
  1768. int    outer_loop_inc ;
  1769. {
  1770. int    i_in, i_out = 0, i_var = 0, quote = 1 ;
  1771. char    *pntr ;
  1772.  
  1773. /* make string version of loop counter increment */
  1774. if ( UNROLLING ) {
  1775.     GET_MEM( pntr, strlen(increment_name[var_count-1])
  1776.              + abs(outer_loop_inc) + 10 ) ;
  1777.     sprintf( pntr, "+%s*%d", increment_name[ var_count - 1 ],
  1778.         outer_loop_inc ) ;
  1779. }
  1780.  
  1781. /* loop over the input record */
  1782. for ( i_in = 0; string[i_in] != NULL; i_in++ ) {
  1783.  
  1784. /* pass characters straight through if quoted */
  1785. if ( string[i_in] == '\'' ) quote = -quote ;
  1786. if ( quote == -1 ) {
  1787.     VERBATIM ;
  1788.     continue ;
  1789. }
  1790.  
  1791. switch( string[i_in] ) {
  1792.  
  1793.     /* replace #'s with variable names */
  1794.     case '#' :    strcat( out_buff, var_name[i_var] ) ;
  1795.             i_out += 4 ;
  1796.             i_var++ ;   
  1797.             if ( i_var >= var_count ) {
  1798.                 i_var = 0 ;
  1799.                 if (UNROLLING & outer_loop_inc != 0) {
  1800.                     strcat( out_buff, pntr ) ;
  1801.                     i_out += strlen( pntr ) ;
  1802.                 }
  1803.             }
  1804.             break ;
  1805.  
  1806.     /* reset variable counter */
  1807.     case ')' :    out_buff[i_out] = ')' ;
  1808.             out_buff[i_out + 1] = NULL ;
  1809.             i_out++ ;
  1810.             i_var = 0 ;
  1811.             break ;
  1812.  
  1813.     /* copy character verbatim */
  1814.     default :     VERBATIM ;
  1815.  
  1816. }
  1817. }
  1818.  
  1819. if (UNROLLING) free( pntr ) ;
  1820. dump( out_buff ) ;
  1821.  
  1822. IN_BUFF_DONE ;
  1823. }
  1824.  
  1825.  
  1826.  
  1827.  
  1828. /* Function UNROLL_PROC
  1829.  *
  1830.  * Change the unrolling depth.  If depth is less than 2 unrolling is off.
  1831.  *
  1832.  * P. R. OVE  6/18/86
  1833.  */
  1834.  
  1835. unroll_proc()     
  1836. {                  
  1837. int    n ;
  1838. char    *open_parens, *close_parens ;
  1839.  
  1840. /* get the expression delimeters */
  1841. open_parens = line_end( first_nonblank + name_length ) ;
  1842. close_parens = mat_del( open_parens ) ;
  1843.                                            
  1844. /* if there is stuff on the line (open_parens != NULL) and no            */
  1845. /* open parens (close_parens == NULL) assume variable name like UNROLLit */
  1846. if ( (open_parens != NULL) & (close_parens == NULL) ) return ;
  1847.  
  1848. /* get the depth if it is there (error ==> depth = 0 (OFF)) */
  1849. if (open_parens != NULL) {
  1850.     n = close_parens - open_parens - 1 ;
  1851.     *close_parens == NULL ;
  1852.     unroll_depth = atoi( open_parens + 1 ) ;
  1853. }
  1854. else {    unroll_depth = DEF_UNROLL_DEPTH ; }
  1855.  
  1856. IN_BUFF_DONE
  1857. }
  1858.  
  1859.  
  1860.  
  1861.  
  1862. /* Function VEC_PROC.C
  1863.  *
  1864.  * This routine's functions when a "naked"
  1865.  * (with out surrounding [ ]) vector statement is found.
  1866.  * The action depends on whether vec_flag is set or not.
  1867.  * If set:
  1868.  *   The record is dumped (to mem_store).
  1869.  * If not:
  1870.  *   It is handled by placing a [ at the beginning and a
  1871.  * ] at the end and then starting over.  OSQB_PROC will
  1872.  * then trap it and pass it to END_VEC to be processed.
  1873.  *
  1874.  * P. R. OVE  11/9/85
  1875.  */
  1876.  
  1877. vec_proc()
  1878. {
  1879. int    i, length ;
  1880.  
  1881. /* if default loop limits have not been set abort here */
  1882. if ( var_count <= 0 ) {
  1883.     sprintf( errline, "Vector loop without default limits set: %s", in_buff ) ;
  1884.     abort( errline ) ;
  1885. }
  1886.                       
  1887. if ( vec_flag ) {
  1888.     dump( in_buff ) ;    /* --> mem_store */
  1889.     IN_BUFF_DONE ;
  1890. }
  1891. else {
  1892.     length = strlen( in_buff ) ;
  1893.     for ( i = length - 1; i >= 0; i-- ) in_buff[i+1] = in_buff[i] ;
  1894.     in_buff[ length + 1 ] = ']' ;
  1895.     in_buff[ length + 2 ] = NULL ;
  1896.     in_buff[ 0 ] = '[' ;
  1897. }
  1898. }
  1899. @//E*O*F vec.c//
  1900. chmod u=rw,g=r,o=r vec.c
  1901.  
  1902. echo x - str.c
  1903. sed 's/^@//' > "str.c" <<'@//E*O*F str.c//'
  1904. /* A few string functions missing from the Sun unix library */
  1905.  
  1906. #include <stdio.h>
  1907. #include "string.h"
  1908.  
  1909. /* Find the first occurrence of c in string */
  1910. char    *strchr( s, c )
  1911. char    *s, c ;
  1912. {
  1913. int    length, i ;
  1914.     length = strlen(s) ;
  1915.  
  1916.     for ( i=0; i<=length; i++ ) if ( s[i] == c ) return( &s[i] ) ;
  1917.     return( NULL ) ;
  1918. }
  1919.  
  1920. /* find the index of the first char in s1 that is not in s2 */
  1921. int    strspn( s1, s2 )
  1922. char    *s1, *s2 ;
  1923. {
  1924. int    i ;
  1925.  
  1926.     for ( i=0 ; s1[i] != NULL ; i++ ) {
  1927.         if ( NULL == strchr(s2,s1[i]) ) break ;
  1928.         }
  1929.     return(i) ;
  1930. }
  1931.  
  1932.  
  1933. /* find the index of the first char in s1 that is in s2 */
  1934. int    strcspn( s1, s2 )
  1935. char    *s1, *s2 ;
  1936. {
  1937. int    i ;
  1938.  
  1939.     for ( i=0 ; s1[i] != NULL ; i++ ) {
  1940.         if ( NULL != strchr(s2,s1[i]) ) break ;
  1941.         }
  1942.     return(i) ;
  1943. }
  1944. @//E*O*F str.c//
  1945. chmod u=rw,g=r,o=r str.c
  1946.  
  1947. echo Inspecting for damage in transit...
  1948. temp=/tmp/shar$$; dtemp=/tmp/.shar$$
  1949. trap "rm -f $temp $dtemp; exit" 0 1 2 3 15
  1950. cat > $temp <<\!!!
  1951.      607    4325   25859 prep.doc
  1952.       17      43     252 Makefile
  1953.       21      55     503 makemsc
  1954.      225    1067    5831 prep.c
  1955.      433    2228   12268 macro.c
  1956.      544    2302   12944 vec.c
  1957.       40     168     728 str.c
  1958.     1887   10188   58385 total
  1959. !!!
  1960. wc  prep.doc Makefile makemsc prep.c macro.c vec.c str.c | sed 's=[^ ]*/==' | diff -b $temp - >$dtemp
  1961. if [ -s $dtemp ]
  1962. then echo "Ouch [diff of wc output]:" ; cat $dtemp
  1963. else echo "No problems found."
  1964. fi
  1965. exit 0
  1966.  
  1967.  
  1968.