home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / fort2rex.zip / Fortran2Rexx.cmd next >
OS/2 REXX Batch file  |  2000-08-24  |  40KB  |  1,113 lines
  1. /* Assist in the conversion of FORTRAN source to REXX source.  This does not */
  2. /* attempt to convert the logic of the source, only the syntax related       */
  3. /* characteristics.  It is assumed the programmer will manually check and    */
  4. /* complete the conversion.                                                  */
  5. /*                                                                           */
  6. /* FORTRAN2REXX is not intended to make "pretty" output.  To format the REXX */
  7. /* program I recommend something like RexxCodeFormater by RKE_Software.      */
  8. /*                                                                           */
  9. /* The following actions are performed:                                      */
  10. /*   Convert comment lines to REXX format.                                   */
  11. /*   Continuations are removed.                                              */
  12. /*   Type Declarations, including DIMENSION, are converted to comments and   */
  13. /*       all variable names retained in the variables:                       */
  14. /*          VariableList._Simple.                                            */
  15. /*          VariableList._Array.                                             */
  16. /*          VariableList._MIndexArray. (multiple indexed arrays)             */
  17. /*      Array and multiple indexed arrays have the 0th value set.            */
  18. /*   First lines containing "SUBROUTINE" or "FUNCTION" are made into         */
  19. /*      subroutines and the call list made into expose variables.            */
  20. /*   DATA and PARAMETER statements are made into lines of REXX code.         */
  21. /*   Logical operations such as ".GT." are converted to REXX ">".            */
  22. /*   IF statements have "THEN" added after the last ")". *                   */
  23. /*   FORMAT statements are partially interpreted into REXX, the              */
  24. /*      interpretations are stored and used with WRITE(6,... statements.     */
  25. /*      The original FORMAT statement is then converted to a comment.        */
  26. /*   WRITE(6,nnn) statements are partially converted to SAY and marked for   */
  27. /*      further manual editing.                                              */
  28. /*   DO statements are found, recorded and converted to REXX format.         */
  29. /*   END statements are add for the do loops.  DO variables are specified.   */
  30. /*   Single indexed arrays are converted to compound variables.  For example */
  31. /*      a(i) becomes a.i  For these variables indeices that are computed by  */
  32. /*      addition or subtraction of a constant are converted as following:    */
  33. /*         a(i+1) = ... becomes                                              */
  34. /*         ap1 = a+1                                                         */
  35. /*         a.ap1 =                                                           */
  36. /*   CONTINUE statements are converted to "nop".                             */
  37. /*   Code containing array variables which use multiple indices are flagged. */
  38. /*   The last last line of the source is dropped.                            */
  39. /*   "STOP" statements are converted to "RETURN 1"                           */
  40. /*   GO TO nnn pointing to the final return are converted to RETURN          */
  41. /*   GO TO nnn within a DO loop and pointing to the DO's END are changed to  */
  42. /*      ITERATE statements.                                                  */
  43. /*   CALL statements have the bounding "( )" removed.                        */
  44. /*   Line numbers are moved to the end of each line as comments.             */
  45. /*                                                                           */
  46. /*   * Means there is a known limitation to the logic used.  See appropriate */
  47. /*     subroutine.                                                           */
  48. /*                                                                           */
  49. /* The variable "messages." is used to record notes to the user.  These are  */
  50. /* appended to the output program as comments.                               */
  51. /*                                                                           */
  52. /* Be sure to look through the fortran source for function references.       */
  53. /*  Calls to subroutines have to be checked and formated manually.           */
  54. /*  Calls to functions having the form abs(v) will be converted as though    */
  55. /*  they are simple arrays.                                                  */
  56. /*                                                                           */
  57. /* A simple way to handle the swapping of variables which FORTRAN permits in */
  58. /* subroutine calls adds an intermediate subroutine, as follows:             */
  59. /*                                                                           */
  60. /*    Source has --                                                          */
  61. /*              call splev(t,n,c,k,x,sp,m,ier)                               */
  62. /*       . . .                                                               */
  63. /*              subroutine splev(t,n,c,k,x,y,m,ier)                          */
  64. /*                                                                           */
  65. /*    REXX has --                                                            */
  66. /*              call SplevStarter /* t,n,c,k,x,sp,m,ier */                   */
  67. /*       . . .                                                               */
  68. /*              SplevStarter:                                                */
  69. /*              procedure expose t. n c. k x. sp. m ier                      */
  70. /*              rc= arraycopy(sp.,y.)                                        */
  71. /*              call splev                                                   */
  72. /*              rc= arraycopy(y.,sp.)                                        */
  73. /*              return                                                       */
  74. /*       . . .                                                               */
  75. /*              splev:                                                       */
  76. /*              procedure expose  t. n c. k x. y. m ier                      */
  77. /*                                                                           */
  78. /*                                                                           */
  79. /* You are invited to extend or improve this code.  Please add your name to  */
  80. /* the author list below, send a copy to D. Rickman. and I will repost it to */
  81. /* the web.                                                                  */
  82. /*                                                                           */
  83. /* Doug Rickman August 23, 2000  doug@hotrocks.msfc.nasa.gov                 */
  84.  
  85. signal on Halt
  86. signal on NotReady
  87.  
  88. if rxfuncquery('rexxlibregister') then do         /* this will start rexxlib */
  89.     call rxfuncadd 'rexxlibregister', 'rexxlib', 'rexxlibregister'  
  90.     call rexxlibregister
  91.     end
  92. if rxfuncquery('sysloadfuncs') then do           /* this will start rexxutil */
  93.     CALL RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs' 
  94.     CALL SysLoadFuncs
  95.     end
  96.  
  97. arg in 
  98. in=strip(in)
  99. out=strip(out)
  100.  
  101. if in='' | in='?' | in='-?' | in='/?' then call Help
  102. if dosisfile(in)<>1 then do
  103.    say 'The input file: ' in' is not a valid file.'
  104.     exit
  105.     end /* do */
  106.  
  107. out     = left(in,length(in)-2) || '.cmd'
  108. rc = dosdel(out)
  109.  
  110. /* --------------------------------------------------------------------------*/
  111. /* --- begin MAIN                                               -------------*/
  112.  
  113. rc=stream(in,'c','open read')
  114.  
  115. /* Read in the source code. */
  116. do i = 1
  117.    line.i = linein(in)
  118.    if lines(in) = 0 then leave i
  119.    end i
  120. Line.0 = i
  121. rc=lineout(in)
  122.  
  123. messages.0 = 0
  124. VariableList._Simple.0      = 0
  125. VariableList._Array.0       = 0
  126. VariableList._MIndexArray.0 = 0
  127.  
  128.  
  129. rc = ConvertCommentLines()
  130.  
  131. rc = RemoveContinuations()
  132.  
  133. rc = ConvertTypeDeclarations() /* Includes DIMENSION */
  134.  
  135. rc = ConvertFirstLines() /* Looks for subroutines and functions. */
  136.  
  137. rc = ConvertData()
  138.  
  139. rc = ConvertParameter()
  140.  
  141. rc = Convert_GT_Lines()
  142.  
  143. rc = AddThen2IFStatements()
  144.  
  145. rc = EditFormatsStatements()
  146.  
  147. rc = EditWriteStatements()
  148.  
  149. rc = FindDO_Statements()
  150.  
  151. rc = AddEnds4DOs()
  152.  
  153. rc = MakeArrays()
  154.  
  155. rc = ConvertContinue() /* convert to "nop" */
  156.  
  157. rc = Check4MultiIndexArrayVariable()
  158.  
  159. /* Drop last line. */
  160. Line.0 = Line.0 - 1
  161.  
  162. rc = ConvertGOTO_END()
  163.  
  164. rc = ConvertSTOP()
  165.  
  166. rc = EditCALLStatements()
  167.  
  168. rc = MoveLineNumbers()
  169.  
  170.  
  171. /* Write out the REXX source. */
  172. do i = 1 to Line.0
  173.    rc=lineout(out,Line.i)
  174.    end i
  175.  
  176. rc  = lineout(out,' ')
  177.  
  178. txt = 'Converted from 'in
  179. txt = left(txt,74)
  180. rc  = lineout(out,'/*' txt '*/')
  181.  
  182. txt = 'with the aid of FORTRAN2REXX, version Aug 23, 2000, by D. Rickman.'
  183. txt = left(txt,74)
  184. rc  = lineout(out,'/*' txt '*/')
  185.  
  186. txt = Date('L') Time('C')
  187. txt = left(txt,74)
  188. rc  = lineout(out,'/*' txt '*/')
  189.  
  190. /* Setup variable lists. */
  191. txt1 = "Simple variables declared:"
  192. do i = 1 to VariableList._Simple.0
  193.    txt1 = txt1 VariableList._Simple.i',' 
  194.    end i
  195. txt1 = strip(txt1,'T',',')
  196. messageN = messages.0 + 1
  197. messages.messageN = txt1
  198. messages.0 = messageN
  199.  
  200. txt1 = "Single indexed compound variables declared:"
  201. do i = 1 to VariableList._Array.0
  202.    txt1 = txt1 VariableList._Array.i','
  203.    end i
  204. txt1 = strip(txt1,'T',',')
  205. messageN = messages.0 + 1
  206. messages.messageN = txt1
  207. messages.0 = messageN
  208.  
  209. txt1 = "Multiply indexed compound variables declared:"
  210. do i = 1 to VariableList._MIndexArray.0 
  211.    txt1 = txt1 VariableList._MIndexArray.i','
  212.    end i
  213. txt1 = strip(txt1,'T',',')
  214. messageN = messages.0 + 1
  215. messages.messageN = txt1
  216. messages.0 = messageN
  217.  
  218. do i = 1 to messages.0
  219.    if length(messages.i) < 75 then
  220.       rc = lineout(out,'/* 'left(messages.i,74)' */')
  221.    else
  222.       rc = lineout(out,'/* 'messages.i' */')
  223.    end
  224.  
  225. rc=lineout(out)
  226. return 1
  227.  
  228. rc = stream(out,'c','close')
  229.  
  230. /* --- end MAIN                                                 -------------*/
  231. /* --------------------------------------------------------------------------*/
  232.  
  233. /* Find numbered statements, insert 'end' statements if matched to a 'do'.   */
  234. AddEnds4DOs:
  235. procedure expose Line. Do.
  236. do j = 1 to do.0
  237.    do i = 1 to line.0
  238.       if left(Line.i,1) \= ' ' then iterate i      /* Skip comments.         */
  239.       parse var Line.i LineN 7 Stuff
  240.       if words(LineN) = 0 then iterate i           /* Skip unnumbered lines. */
  241.       /* Does this match a do loop? */
  242.       LineN = strip(LineN)
  243.       if do._LineN.j = LineN then do               /* Goes with a do loop.   */
  244.          rc=MoveUp1Line(i)
  245.          Line.i = '         end 'Do._Var.j' /* 'LineN' */'
  246.          i = i + 1
  247.          iterate j
  248.          end /* do */
  249.       end i
  250.    end j
  251. return 1
  252. /*    -    -    -    -    -    -    -    -    -    -    -    -    -    -     */
  253.  
  254.  
  255. /* Look for 'if' statements and add 'then'.                                  */
  256. /* This logic has a problem if there is a ")" after the if clause.           */
  257. AddThen2IFStatements:
  258. procedure expose Line.
  259. do i = 1 to Line.0
  260.    if left(Line.i,1) \= ' ' then iterate i         /* Skip comments.         */
  261.    parse var Line.i LineN 7 Stuff
  262.    Stuff = translate(strip(Stuff))
  263.    if left(Stuff,3) = 'IF(' then do
  264.       v = lastpos(')',Line.i)
  265.       Line.i = insert(' then',Line.i,v)
  266.       end /* do */
  267.    end i
  268. return 1
  269. /*    -    -    -    -    -    -    -    -    -    -    -    -    -    -     */
  270.  
  271. Check4MultiIndexArrayVariable:
  272. procedure expose Line. messages. VariableList.
  273. do i = 1 to Line.0
  274.    if left(Line.i,1) \= ' ' then iterate i /* Skip comments.    */
  275.    if pos(')',Line.i) < 12 then iterate i
  276.    if pos(',',Line.i) < 10 then iterate i
  277.    /* Only lines that have "( , )" will be checked. */
  278.    CleanStuff = translate(Line.i,'        ','+-/*,).=')
  279.    do j = 1 to VariableList._MIndexArray.0
  280.       pattern = VariableList._MIndexArray.j || '('
  281.       rc = grep(pattern,CleanStuff)
  282.       if word(rc,1) > 0 then do
  283.          Line.i = strip(Line.i,'T') '   <<--'
  284.          txt1= 'Probable multi-index array at approx. line' i
  285.          messageN = messages.0 + 1
  286.          messages.messageN = txt1
  287.          messages.0 = messageN
  288.          end /* do */
  289.       end j
  290.    end i
  291. return 1
  292. /*    -    -    -    -    -    -    -    -    -    -    -    -    -    -     */
  293.  
  294.  
  295. /* Convert .gt. lines. */
  296. Convert_GT_Lines:
  297. procedure expose Line.
  298. do i = 1 to Line.0
  299.    if left(Line.i,1) \= ' ' then iterate i /* Skip comments. */
  300.    Line.i = change(Line.i,'.gt.',' > ')
  301.    Line.i = change(Line.i,'.lt.',' < ')
  302.    Line.i = change(Line.i,'.ge.',' >= ')
  303.    Line.i = change(Line.i,'.le.',' <= ')
  304.    Line.i = change(Line.i,'.and.',') & (')
  305.    Line.i = change(Line.i,'.or.' ,') | (')
  306.    Line.i = change(Line.i,'.eq.',' = ')
  307.    Line.i = change(Line.i,'.ne.',' \= ')
  308.  
  309.    Line.i = change(Line.i,'.GT.',' > ')
  310.    Line.i = change(Line.i,'.LT.',' < ')
  311.    Line.i = change(Line.i,'.GE.',' >= ')
  312.    Line.i = change(Line.i,'.LE.',' <= ')
  313.    Line.i = change(Line.i,'.AND.',') & (')
  314.    Line.i = change(Line.i,'.OR.' ,') | (')
  315.    Line.i = change(Line.i,'.EQ.',' = ')
  316.    Line.i = change(Line.i,'.NE.',' \= ')
  317.    end i
  318. return 1
  319. /*    -    -    -    -    -    -    -    -    -    -    -    -    -    -     */
  320.  
  321.  
  322. /* Convert comment lines. */
  323. ConvertCommentLines:
  324. procedure expose Line.
  325. do i = 1 to Line.0
  326.    if left(Line.i,1) \= ' ' then 
  327.       Line.i = '/*'||substr(Line.i,2,75,' ')||'*/'
  328.    end i
  329. return 1
  330. /*    -    -    -    -    -    -    -    -    -    -    -    -    -    -     */
  331.  
  332. /* Find 'continue' statements and convert to 'nop'.                          */
  333. ConvertContinue:
  334. procedure expose Line.
  335. do i = 1 to Line.0
  336.    if left(Line.i,1) \= ' ' then iterate i /* Skip comments.    */
  337.    parse var Line.i LineN 7 Stuff
  338.    if words(LineN) = 0 then iterate i /* Skip unnumbered lines. */
  339.    Stuff2 = translate(Stuff)
  340.    if Stuff2 = 'CONTINUE' then 
  341.       Line.i = change(Line.i,Stuff,'nop')
  342.    end i
  343. return 1
  344. /*    -    -    -    -    -    -    -    -    -    -    -    -    -    -     */
  345.  
  346. /* Convert DATA statements.                                                  */
  347. ConvertData:
  348. procedure expose Line.
  349. do i = 1 to Line.0
  350.    if left(Line.i,1) \= ' ' then iterate i /* Skip comments.    */
  351.    parse var Line.i LineN 7 Stuff
  352.    CapStuff = strip(translate(Stuff))
  353.    if left(CapStuff,4) = 'DATA ' then do
  354.       data = ''
  355.  
  356.       /* parse the list of variables */
  357.       parse var Stuff . VariablesList '/' ValuesList '/' .
  358.       Start  = 2
  359.       pcomma = 1
  360.       do j = 1
  361.          if pcomma = 0 then leave j
  362.          pcomma = pos(',',VariablesList,Start)
  363.          popen  = pos('(',VariablesList,Start)
  364.          pclose = pos(')',VariablesList,Start+1)
  365.  
  366.          if pcomma < pclose then 
  367.             pcomma = pos(',',VariablesList,pclose)
  368.  
  369.          if pcomma = 0 then do
  370.             variable = VariablesList
  371.             VariablesList = ''
  372.             end
  373.          else 
  374.             parse var VariablesList variable =(pcomma) . ',' VariablesList
  375.          /* "variable" is the declaration of the jth variable. */
  376.          variable = strip(variable) 
  377.  
  378.          parse var ValuesList value ',' ValuesList
  379.          data = data strip(variable) || '=' || value || ';'
  380.          end j
  381.       Line.i = LineN || data
  382.       end
  383.    end i
  384. return 1
  385. /*    -    -    -    -    -    -    -    -    -    -    -    -    -    -     */
  386.  
  387. /* Convert first line. */
  388. ConvertFirstLines:
  389. procedure expose Line. VariableList.
  390. parse var Line.1 v1 v2 v3 v4
  391. select
  392.    when 'FUNCTION'= translate(v2) then
  393.       parse var Line.1 . . name '(' variables ')'
  394.    when 'SUBROUTINE' = translate(v1) then
  395.       parse var Line.1 . name '(' variables ')'
  396.    otherwise return 0
  397.    end  /* select */
  398.  
  399. Line.1 = name||':'
  400. rc = MoveUp1Line(2)
  401.  
  402. /* Add "." to all array variables. */
  403. ExposeList = ''
  404. do j = 1
  405.    if variables = '' then leave j
  406.    parse var variables v ',' variables
  407.    v = strip(v)
  408.    do i = 1 to VariableList._Array.0
  409.       if v = VariableList._Array.i then do
  410.          ExposeList = ExposeList v||'.'
  411.          iterate j
  412.          end /* do */
  413.       end i
  414.    do i = 1 to VariableList._MIndexArray.0 
  415.       if v = VariableList._MIndexArray.i then do
  416.          ExposeList = ExposeList v||'.'
  417.          iterate j
  418.          end /* do */
  419.       end i
  420.    ExposeList = ExposeList v
  421.    end j
  422.  
  423. Line.2 = 'procedure expose 'ExposeList
  424. return 1
  425.  
  426. /*    -    -    -    -    -    -    -    -    -    -    -    -    -    -     */
  427.  
  428. /* Get line number of return at end of program and replace all go to returns.*/
  429. ConvertGOTO_END:
  430. procedure expose Line.
  431. i = Line.0
  432. parse var Line.i LineN 7 Stuff
  433. if words(LineN) \= 0 then do
  434.    LineN = strip(LineN)
  435.    do i = 1 to Line.0
  436.       if left(Line.i,1) \= ' ' then iterate i /* Skip comments.    */
  437.       if pos('go to',Line.i) > 0 then do
  438.          Line.i = change(Line.i,'go to' LineN,'return')
  439.          iterate i
  440.          end /* do */
  441.       if pos('GO TO',Line.i) > 0 then do
  442.          Line.i = change(Line.i,'GO TO' LineN,'return')
  443.          iterate i
  444.          end /* do */
  445.       end i
  446.    end 
  447. return 1
  448. /*    -    -    -    -    -    -    -    -    -    -    -    -    -    -     */
  449.  
  450. /* Convert Parameter Statements into lines of code. */
  451. ConvertParameter:
  452. procedure expose Line.
  453. do i = 1 to Line.0
  454.    if left(Line.i,1) \= ' ' then iterate i /* Skip comments.    */
  455.    parse var Line.i LineN 7 Stuff
  456.    if left(Stuff,9) = 'PARAMETER' | left(Stuff,9) = 'parameter' then do
  457.       v = pos('(',Stuff)
  458.       parse var Stuff . =(v) v2
  459.       v2 = strip(v2,'T')
  460.       v2 = strip(v2,'T',')')
  461.       v2 = strip(v2,'T')
  462.       v2 = change(v2,',',';')
  463.       end /* do */
  464.    end i
  465. return 1
  466. /*    -    -    -    -    -    -    -    -    -    -    -    -    -    -     */
  467.  
  468. /* Convert STOP to RETURN 1                                                  */
  469. ConvertSTOP:
  470. procedure expose Line.
  471. do i = 1 to Line.0
  472.    if left(Line.i,1) \= ' ' then iterate i /* Skip comments.    */
  473.    parse var Line.i LineN 7 Stuff
  474.    CapStuff = translate(strip(Stuff))
  475.    if left(CapStuff,4) = 'STOP' then 
  476.       Line.i = 'Return 1'
  477.    end i
  478. return 1
  479. /*    -    -    -    -    -    -    -    -    -    -    -    -    -    -     */
  480.  
  481.  
  482. /* Convert type declarations to comments.  Store names of declared variables.*/
  483. /* Generate compound variable 0th terms from array dimensions.               */
  484. ConvertTypeDeclarations:
  485. procedure expose Line. messages. VariableList.
  486.  
  487. m = 0
  488. do i = 1
  489.    if i > Line.0 then leave i
  490.    if left(Line.i,1) \= ' ' then iterate i /* Skip comments.    */
  491.    if i = 1 then iterate i
  492.    parse var Line.i LineN 7 Stuff
  493.    CapStuff = translate(strip(Stuff))
  494.    if left(CapStuff,4) = 'REAL' |,
  495.       left(CapStuff,7) = 'INTEGER' |,
  496.       left(CapStuff,9) = 'DIMENSION' then do
  497.  
  498.       /* Break line into variables.                                       */
  499.       parse var Stuff . MoreStuff  /* Remove the leading "type".          */
  500.       MoreStuff = strip(MoreStuff)
  501.       Start  = 2
  502.       pcomma = 1
  503.       do j = 1
  504.          if pcomma = 0 then leave j
  505.          pcomma = pos(',',MoreStuff,Start)
  506.          popen  = pos('(',MoreStuff,Start)
  507.          pclose = pos(')',MoreStuff,Start+1)
  508.  
  509.          if pcomma < pclose then 
  510.             pcomma = pos(',',MoreStuff,pclose)
  511.  
  512.          if pcomma = 0 then do
  513.             variable = MoreStuff
  514.             MoreStuff = ''
  515.             end
  516.          else 
  517.             parse var MoreStuff variable =(pcomma) . ',' MoreStuff
  518.          /* "variable" is the declaration of the jth variable. */
  519.          variable = strip(variable) 
  520.  
  521.          select 
  522.             when pos('(',variable) = 0 then do
  523.                N = VariableList._Simple.0 + 1
  524.                VariableList._Simple.N = variable
  525.                VariableList._Simple.0 = N
  526.                iterate j
  527.                end /* do */
  528.  
  529.             when pos(',',variable) = 0 then do
  530.                parse var variable name '(' v ')'
  531.                N = VariableList._Array.0 + 1
  532.                VariableList._Array.N = name
  533.                VariableList._Array.0 = N
  534.  
  535.                rc = MoveUp1Line(i)
  536.                ip1 = i + 1
  537.                line.ip1 = name'.0 = 'v
  538.                
  539.                iterate j
  540.                end /* do */
  541.  
  542.             otherwise do
  543.                parse var variable name '(' v 
  544.                v = strip(v,'T',')')
  545.                /* Count the number of commas in the definition. */
  546.                StartCommaCount = 1
  547.                NCommas = 0
  548.                do k = 1
  549.                   StartCommaCount = pos(',',v,StartCommaCount+1)
  550.                   if StartCommaCount = 0 then leave k
  551.                   NCommas = NCommas + 1
  552.                   end k
  553.                N = VariableList._MIndexArray.0 + 1
  554.                VariableList._MIndexArray.N = name
  555.                VariableList._MIndexArray.0 = N
  556.                txt1= 'There are 'NCommas+1' indices in the variable 'name
  557.                messageN = messages.0 + 1
  558.                messages.messageN = txt1
  559.                messages.0 = messageN
  560.                insert = ''
  561.                do k = 1 to NCommas+1
  562.                   parse var v v1 ',' v
  563.                   rc = MoveUp1Line(i)
  564.                   ip1 = i + 1
  565.                   line.ip1 = name||insert||'.0 = 'v1 '   /* <<<<<-----  Compound variable */'                 
  566.                   insert = insert || '.i'k
  567.                   end k
  568.                end /* otherwise ... */
  569.  
  570.             end  /* select */
  571.          end j
  572.  
  573.       rc = MakeIntoComments(i,Line.i)
  574.       end /* if then ... */
  575.    end i
  576. /* 
  577. do i = 1 to line.0
  578.    say i line.i
  579. end /* do */
  580. */
  581. MultiIndexArrayVariable.0 = m
  582. return 1
  583. /*    -    -    -    -    -    -    -    -    -    -    -    -    -    -     */
  584.  
  585. /* Remove the bounding "( ) from CALL statements.                            */
  586. EditCALLStatements:
  587. procedure expose Line.
  588. do i = 1 to Line.0
  589.    if left(Line.i,1) \= ' ' then iterate i /* Skip comments.    */
  590.    parse var Line.i LineN 7 Stuff
  591.    CapStuff = translate(strip(Stuff))
  592.    pos =  pos('CALL ',CapStuff)
  593.    if pos > 0  then do
  594.       pos = pos + 5
  595.       parse var Stuff =(pos) SubroutineName '(' MoreStuff 
  596.       if datatype(SubroutineName,'A') &,
  597.          SubroutineName == strip(SubroutineName) then do
  598.          pos   = pos('(',Stuff,pos+5)
  599.          pos2  = lastpos(')',Stuff)
  600.          Stuff = overlay(' ',Stuff,pos)
  601.          Stuff = overlay(' ',Stuff,pos2)
  602.          Stuff = space(Stuff)
  603.          line.i = LineN Stuff
  604.          end /* do */
  605.       end /* if pos> 0 then ... */
  606.    end i
  607. return 1
  608. /*    -    -    -    -    -    -    -    -    -    -    -    -    -    -     */
  609.  
  610.  
  611. /* Edit formats into something that is pseudo REXX, store this in "Format."  */
  612. /* and convert format statements into comments.                              */
  613. EditFormatsStatements:
  614. procedure expose Line. messages. Format.
  615. do i = 1 to Line.0
  616.    if left(Line.i,1) \= ' ' then iterate i /* Skip comments.    */
  617.    parse var Line.i LineN 7 Stuff
  618.    CapStuff = translate(strip(Stuff))
  619.    if left(CapStuff,7) = 'FORMAT(' then do
  620.  
  621.       len   = length(Stuff)
  622.       Stuff = substr(Stuff,1,len-1) /* Get rid of trailing ")". */
  623.       parse var Stuff . 8 MoreStuff
  624.       LineN2 = strip(LineN)
  625.       do j = 1
  626.          if strip(MoreStuff) = '' then leave j
  627.  
  628.          /* Check for hollerith */
  629.          temp = translate(MoreStuff)
  630.          hpos = pos('H',temp)
  631.          if hpos > 1 then do
  632.             parse var temp v =(hpos) 'H' v2
  633.             if datatype(v,'W') & v == strip(v) then do /* This is a hollerith. */
  634.                hpos = hpos + 1
  635.                v = v + hpos
  636.                parse var MoreStuff . =(hpos) FormatPart.LineN2.j =(v) ',' MoreStuff
  637.                iterate j
  638.                end /* do */
  639.             end
  640.  
  641.          /* Find 1st comma outside of a ( ). */
  642.          rc = ParseUsingCommas(i,MoreStuff)
  643.          select
  644.             when rc > 0 then do
  645.                parse var MoreStuff FormatPart.LineN2.j =(rc) ',' MoreStuff
  646.                end /* do */
  647.             when rc = 0 then do
  648.                FormatPart.LineN2.j = MoreStuff
  649.                MoreStuff = ''
  650.                end
  651.             when rc < 0 then do
  652.                say 'In EditFormatsStatements() - Error in parsing line 'i
  653.                say '---' Line.i
  654.                iterate i
  655.                end
  656.             end /* select */
  657.          end j  
  658.       FormatPart.LineN2.0 = j - 1
  659.  
  660.       Format.LineN2 = ''
  661.       do j = 1 to FormatPart.LineN2.0
  662.          /* Find and expand blank spaces. */
  663.          len = length(FormatPart.LineN2.j)
  664.          v = substr(FormatPart.LineN2.j,1,len-1)
  665.          if translate(right(FormatPart.LineN2.j,1)) = 'X' &,
  666.            datatype(v,'W') &  v == strip(v) then do
  667.             Format.LineN2 = Format.LineN2||"'"||left(' ',v-1)||"'"
  668.             iterate j
  669.             end
  670.  
  671.          /* Check for repeated stuff. */
  672.          pos = pos('(',FormatPart.LineN2.j)
  673.          parse var FormatPart.LineN2.j v =(pos) v2
  674.          if datatype(v,'W') &  v == strip(v) then do
  675.             do k = 1 to v
  676.                Format.LineN2 = Format.LineN2 v2
  677.                end k
  678.             iterate j
  679.             end
  680.  
  681.          pos = pos('F',translate(FormatPart.LineN2.j))
  682.          parse var FormatPart.LineN2.j v =(pos) v2
  683.          if datatype(v,'W') &  v == strip(v) then do
  684.             parse var v2 . 2 before '.' after
  685.             v2 = 'format(vvvv,'before','after')'
  686.             do k = 1 to v
  687.                Format.LineN2 = Format.LineN2 v2
  688.                end k
  689.             iterate j
  690.             end
  691.  
  692.          pos = pos('E',translate(FormatPart.LineN2.j))
  693.          parse var FormatPart.LineN2.j v =(pos) v2
  694.          if datatype(v,'W') &  v == strip(v) then do
  695.             parse var v2 . 2 before '.' after
  696.             v2 = 'format(vvvv,4,'after',,0)'
  697.             do k = 1 to v
  698.                Format.LineN2 = Format.LineN2 v2
  699.                end k
  700.             iterate j
  701.             end
  702.  
  703.          pos = pos('I',translate(FormatPart.LineN2.j))
  704.          parse var FormatPart.LineN2.j v =(pos) v2
  705.          if datatype(v,'W') &  v == strip(v) then do
  706.             parse var v2 . 2 before
  707.             v2 = 'format(vvvv,'before',,,)'
  708.             do k = 1 to v
  709.                Format.LineN2 = Format.LineN2 v2
  710.                end k
  711.             iterate j
  712.             end
  713.  
  714.          Format.LineN2 = Format.LineN2 "'"FormatPart.LineN2.j"'"
  715.          end j
  716.       /* say LineN2 Format.LineN2 */
  717.       rc = MakeIntoComments(i,Line.i)
  718.       end  /* if this is a format statement ... */
  719.  
  720.    end i
  721. return 1
  722. /*    -    -    -    -    -    -    -    -    -    -    -    -    -    -     */
  723.  
  724. EditWriteStatements:
  725. procedure expose Line. Format.
  726. do i = 1 to Line.0
  727.    if left(Line.i,1) \= ' ' then iterate i /* Skip comments.    */
  728.    parse var Line.i LineN 7 Stuff
  729.    CapStuff = translate(strip(Stuff))
  730.    if left(CapStuff,7) = 'WRITE(6' then do 
  731.  
  732.       parse var CapStuff .  ',' LineN2 ')' v3
  733.       if Format.LineN2 \= 'FORMAT.'LineN2 then do
  734.          line.i = 'say 'Format.LineN2  '   |--- EDITING WRITE STATEMENT --->> 'line.i
  735.          end 
  736.       end /* if left( ) then ... */
  737.    end i
  738. return 1
  739. /*    -    -    -    -    -    -    -    -    -    -    -    -    -    -     */
  740.  
  741.  
  742. /* Find all do statements.  Record the end line number and variable name.    */
  743. /* Convert GO TO statements within limits of each DO to iterate.             */
  744. FindDO_Statements:
  745. procedure expose Line. do.
  746. j=0
  747. do i = 1 to Line.0
  748.    if left(Line.i,1) \= ' ' then iterate i /* Skip comments.    */
  749.    parse var Line.i LineN 7 Stuff
  750.    CapStuff = translate(strip(Stuff))
  751.    if word(CapStuff,1) = 'DO' then do
  752.       /* First reformat the DO statement into REXX. */
  753.       v  = pos(',',Stuff)
  754.       v2 = pos(',',Stuff,v+1)
  755.       if v2 > 0 then do
  756.          Stuff = insert(' by ',Stuff,v2)
  757.          Stuff = delstr(Stuff,v2,1)
  758.          end
  759.       Stuff = insert(' to ',Stuff,v)
  760.       Stuff = delstr(Stuff,v,1)
  761.  
  762.       parse var Stuff  Stuff1 ELineN Stuff2
  763.       Line.i = LineN||Stuff1 strip(Stuff2) '/* do 'ELineN' */'
  764.       /* Record associated line number for later use. */
  765.       j=j+1
  766.       do._LineN.j = strip(ELineN)
  767.       parse var Stuff2 Do._Var.j '=' .
  768.  
  769.  
  770.       /* Now look for GO TO statements to convert to ITERATE.                */
  771.       do k = i+1 to Line.0
  772.          parse var Line.k LineN 7 Stuff
  773.          if strip(LineN) = ELineN then leave k
  774.          CapStuff = translate(strip(Stuff))
  775.          pos = pos('GO TO',CapStuff)
  776.          if pos > 0 then do
  777.             parse var CapStuff v 'GO TO' GLineN
  778.             if ELineN = strip(GLineN) then 
  779.                Line.k = LineN v 'iterate 'Do._Var.j
  780.             end /* if pos > 0 then ... */         
  781.          end k
  782.  
  783.       end /* do */
  784.    end i
  785. do.0 = j
  786. return 1
  787. /*    -    -    -    -    -    -    -    -    -    -    -    -    -    -     */
  788.  
  789. /* Treat numbers and variables of form  string(nnn) as array indexes.        */
  790. /* This does not handle double indexed arrays.                               */
  791. MakeArrays:
  792. procedure expose line. messages.
  793. do i = 1
  794.    if i > Line.0 then leave i
  795.    if left(Line.i,1) \= ' ' then iterate i /* Skip comments.               */
  796.    parse var Line.i LineN 7 Stuff
  797.    Start = 1
  798.    Stuff = strip(Stuff)
  799.    do j = 1
  800.       /* Begin looking for opening parentheses. */
  801.       v  = pos('(',Stuff,Start)
  802.       v2 = pos(')',Stuff,v+1)
  803.       if v = 0 | v2 = 0 then 
  804.          /* No "(" or ")" in rest of line. */
  805.          leave j                
  806.  
  807.       if v = 1 then do
  808.          /* Paren. at start of line??? */
  809.          Start = v +1
  810.          iterate j
  811.          end
  812.  
  813.       if v > 2 then do
  814.          if translate(substr(Stuff,v-2,2)) = 'IF' then do
  815.             /* This is an IF statement. */
  816.             Start = v +1
  817.             iterate j
  818.             end
  819.          end
  820.  
  821.       if datatype(substr(Stuff,v-1,1),'A') \= 1 then do
  822.          /* "(" preceded by blank space or a non Alphanumeric character. */
  823.          Start = v +1
  824.          iterate j
  825.          end
  826.  
  827.       /* Is this the first variable of a call statement? */
  828.       RStuff = reverse(Stuff)
  829.       RStuff2 = translate(translate(RStuff,'   ',',()'))
  830.       BlankN1 = pos(' ',RStuff2,length(RStuff2)-v)
  831.       if pos(' LLAC',RStuff2, length(RStuff2)-v) = BlankN1 then do
  832.          Start = v +1
  833.          iterate j
  834.          end /* if then ... */
  835.  
  836.       v3 = substr(Stuff,v+1,v2-v-1)
  837.       /* v3 holds what was between the ( ) */
  838.       if pos(',',v3) > 0 then do
  839.           /* Contains "," */
  840.          Start = v +1
  841.          iterate j
  842.          end /* if then ... */
  843.  
  844.       if datatype(v3,'W') then do
  845.          /* A whole number.  This has to be an index. */
  846.          Stuff = overlay('.',Stuff,v)
  847.          Stuff = overlay(' ',Stuff,v2)
  848.          Start = v +1
  849.          iterate j
  850.          end /* if then ... */
  851.  
  852.       if datatype(v3,'A') & words(v3) = 1 then do
  853.          /* A single alphanumeric string.  This has to be an index. */
  854.          Stuff = overlay('.',Stuff,v)
  855.          Stuff = overlay(' ',Stuff,v2)
  856.          Start = v +1
  857.          iterate j
  858.          end /* if then ... */
  859.  
  860.       /* Looking for indexes of the form (variable-variable) */
  861.       v4 = pos('-',v3)
  862.       if v4 > 0 then do
  863.          parse var v3 before '-' after
  864.          if datatype(before,'A') & words(before)=1 & datatype(after,'W') then do
  865.             /* A variable minus an offset. */
  866.             string = '.'before'm'after
  867.             Stuff = overlay(string,Stuff,v)
  868.             Stuff = overlay(' ',Stuff,v2)
  869.             rc = MoveUp1Line(i)
  870.             Line.i = before'm'after '=' v3
  871.             i = i+1
  872.             txt1= 'Array index variable 'before'm'after' created.  Approx. output line 'i+3
  873.             messageN = messages.0 + 1
  874.             messages.messageN = txt1
  875.             messages.0 = messageN
  876.             txt1= line.i
  877.             messageN = messages.0 + 1
  878.             messages.messageN = txt1
  879.             messages.0 = messageN
  880.             end
  881.          Start = v +1
  882.          iterate j
  883.          end /* if then ... */
  884.  
  885.       /* Looking for indexes of the form (variable+variable) */
  886.       v4 = pos('+',v3)
  887.       if v4 > 0 then do
  888.          parse var v3 before '+' after
  889.          if datatype(before,'A') & words(before)=1 & datatype(after,'W') then do
  890.             /* A variable minus an offset. */
  891.             string = '.'before'p'after
  892.             Stuff = overlay(string,Stuff,v)
  893.             Stuff = overlay(' ',Stuff,v2)
  894.             rc = MoveUp1Line(i)
  895.             Line.i = before'p'after '=' v3
  896.             i = i+1
  897.             txt1= 'Array index variable 'before'p'after' created.  Approx. output line 'i+3
  898.             messageN = messages.0 + 1
  899.             messages.messageN = txt1
  900.             messages.0 = messageN
  901.             txt1= line.i
  902.             messageN = messages.0 + 1
  903.             messages.messageN = txt1
  904.             messages.0 = messageN
  905.             end
  906.          Start = v +1
  907.          iterate j
  908.          end /* if then ... */
  909.  
  910.       end j
  911.    Line.i = LineN||Stuff
  912.    end i
  913. return 1
  914. /*    -    -    -    -    -    -    -    -    -    -    -    -    -    -     */
  915.  
  916. /* Convert the input string into comments. */
  917. MakeIntoComments:
  918. procedure expose Line.
  919. i     = arg(1)
  920. Stuff = arg(2)
  921. k = length(strip(Stuff,'T'))/76
  922. do j = 1 to k
  923.    rc = MoveUp1Line(i)
  924.    end j
  925. do j = 0 to k
  926.    parse var Stuff v 76 Stuff
  927.    ipj = i + j        
  928.    Line.ipj = '/*'||left(v,76)||'*/'
  929.    end j
  930. return 1
  931. /*    -    -    -    -    -    -    -    -    -    -    -    -    -    -     */
  932.  
  933. MoveDown1Line:
  934. procedure expose Line.
  935. i = arg(1) /* Line at which to start moving down, i.e. from line 4 to line 3. */
  936. do j = i to Line.0
  937.    jp1 = j + 1
  938.    Line.j = Line.jp1
  939.    end j
  940. Line.0 = Line.0 - 1
  941. return 1
  942. /*    -    -    -    -    -    -    -    -    -    -    -    -    -    -     */
  943.  
  944. MoveLineNumbers:
  945. procedure expose Line.
  946. /* Move line numbers to end of each line as comments. */
  947. do i = 1 to Line.0
  948.    if left(Line.i,1) \= ' ' then iterate i /* Skip comments. */
  949.    parse var Line.i LineN 7 Stuff
  950.    if words(LineN) = 0 then
  951.       Line.i = strip(Stuff,'T')
  952.    else
  953.       Line.i = strip(Stuff,'T') '/* Line Number 'strip(LineN)' */'
  954.    end i
  955. return 1
  956. /*    -    -    -    -    -    -    -    -    -    -    -    -    -    -     */ 
  957.  
  958. MoveUp1Line:
  959. procedure expose line.
  960. i = arg(1)  /* Line at which to start moving up, i.e. from line 3 to line 4. */
  961. do j = Line.0 to i by -1
  962.    jp1 = j + 1
  963.    Line.jp1 = Line.j
  964.    end j
  965. Line.0 = Line.0 + 1
  966. return 1
  967. /*    -    -    -    -    -    -    -    -    -    -    -    -    -    -     */
  968.  
  969.  
  970. /* Find the end position of the first logical portion of the input string.   */
  971. ParseUsingCommas:
  972. procedure expose Line. messages.
  973. LineN = arg(1)
  974. data  = arg(2)
  975.  
  976. pcomma.1 = pos(',',Data,2)
  977. popen.1  = pos('(',Data,1)
  978. pclose.1 = pos(')',Data,1)
  979.  
  980. if pcomma.1 = 0       then return 0         /* No commas present.            */
  981. if popen.1  = 0       then return pcomma.1  /* No ( ) before first comma.    */
  982. if pcomma.1 < popen.1 then return pcomma.1  /* 1st unit has no ( )           */
  983.  
  984. /* 1st unit must have ( ), now be sure the "," is outside of them.           */
  985. /* Count the number of "(" and the number of ")".                            */
  986. do j = 2
  987.    jm1 = j - 1
  988.    popen.j    = pos('(',Data,popen.jm1+1)
  989.    if popen.j = 0 then leave j
  990.    end j
  991. popen.0 = j - 1
  992.  
  993. do j = 2
  994.    jm1 = j - 1
  995.    pclose.j    = pos(')',Data,pclose.jm1+1)
  996.    if pclose.j = 0 then leave j
  997.    end j
  998. pclose.0 = j - 1
  999.  
  1000. if popen.0 <> pclose.0 then do
  1001.    txt1= 'Warning - There is a mismatch in ( and ) in approx. line 'LineN' :' data
  1002.    messageN = messages.0 + 1
  1003.    messages.messageN = txt1
  1004.    messages.0 = messageN
  1005.    end
  1006.  
  1007. /* Count "(" before first ")". */
  1008. do j = 1 to pclose.0
  1009.    do k = 1 to popen.0
  1010.       if popen.k > pclose.j then leave k
  1011.       end k
  1012.    if k > popen.0 then do /* Use position of last ")"  */
  1013.       j = pclose.0
  1014.       leave j
  1015.    else do
  1016.       k = k - 1
  1017.       if k = j then leave j   /* pclose.k is last ")" in this set.           */
  1018.       if k < j then return -1 /* Something is wrong. */
  1019.       if k > j then iterate j /* More "(" and ")" so far.  Add another ")".  */
  1020.       end
  1021.  
  1022.    end j
  1023. pcomma = pos(',',data,pclose.j)
  1024. return pcomma
  1025. /*    -    -    -    -    -    -    -    -    -    -    -    -    -    -     */
  1026.  
  1027.  
  1028. /* Remove continuations. */
  1029. RemoveContinuations:
  1030. procedure expose Line.
  1031. do i = 1 
  1032.    /* say right(i,4) line.0 */
  1033.    if i > Line.0 then leave i
  1034.    if left(Line.i,1) \= ' ' then iterate i /* Skip comments. */
  1035.    if substr(Line.i,6,1) \= '' then do
  1036.       im1 = i - 1
  1037.       line.im1 = line.im1 || substr(Line.i,7,70)
  1038.       Line.im1 = strip(line.im1,'T')
  1039.       rc=MoveDown1Line(i)
  1040.       i = i-1
  1041.       end
  1042.    end i
  1043. return 1
  1044. /*    -    -    -    -    -    -    -    -    -    -    -    -    -    -     */ 
  1045.  
  1046. /* --------------------------------------------------------------------------*/
  1047. /* --- begin subroutine - Help:                                 -------------*/
  1048. Help:
  1049. rc= charout(,'1b'x||'[31;7m'||'FORTRAN2REXX:'||'1b'x||'[0m'||'0d0a'x)
  1050. say 'Assist in conversion of FORTRAN source to REXX code.'
  1051.  
  1052. say ''
  1053. rc= charout(,'1b'x||'[33;1m'||'usage:'||'1b'x||'[0m')
  1054. say ' FORTRAN2REXX in'
  1055. say ''
  1056.  
  1057. rc= charout(,'1b'x||'[33;1m'||'where:'||'1b'x||'[0m')
  1058. say ' in = FORTRAN source file, must end in ".f" '
  1059. say ''
  1060.  
  1061. rc= charout(,'1b'x||'[33;1m'||'Exam: '||'1b'x||'[0m')
  1062. say ' FORTRAN2REXX curfit.f'
  1063. say ''
  1064.  
  1065. rc= charout(,'1b'x||'[33;1m'||'notes:'||'1b'x||'[0m')
  1066. say ' The output is named using the input with .f replaced by .cmd'
  1067. say ''
  1068.  
  1069. say ''
  1070. say 'Doug Rickman  August 24, 2000'
  1071. exit
  1072. return
  1073.  
  1074. /* --- end  subroutine - Help:                                  -------------*/
  1075. /* --------------------------------------------------------------------------*/
  1076.  
  1077. /* --------------------------------------------------------------------------*/
  1078. /* --- begin subroutine - Halt:                                 -------------*/
  1079. Halt:
  1080. say 'This is a graceful exit from a Cntl-C'
  1081. exit
  1082. /* --- end  subroutine - Halt:                                  -------------*/
  1083. /* --------------------------------------------------------------------------*/
  1084. /* --- begin subroutine - NotReady:                             -------------*/
  1085. NotReady:
  1086. say 'It would seem that you are pointing at non-existant data.  Oops.  Bye!'
  1087. exit
  1088. /* --- end  subroutine - NotReady:                              -------------*/
  1089. /* --------------------------------------------------------------------------*/
  1090.  
  1091.  
  1092. * --- begin subroutine - Change:                               -------------*/
  1093. /*Here's my [Mike Cowlishaw] CHANGE.REX (circa 1982). It should be reasonably*/
  1094. /*fast on most platforms.                                                    */
  1095. /*Provided to Dick Thaxter <rtha@loc.gov> Thu Aug 20 08:32:23 1998 in        */
  1096. /*comp.lang.rexx  Comments edited by DLR Aug 20, 1998.                       */
  1097. /* CHANGE(string,old,new)                                                    */
  1098. /* Changes all occurrences of "old" in "string" to "new".                    */
  1099. /* If "old"=='', then "new" is prefixed to "string".  MFC                    */
  1100.  
  1101. Change: procedure
  1102. parse arg string, old, new
  1103. if old='' then return new||string
  1104. out=''
  1105. do while pos(old,string)\=0
  1106.    parse var string prefix (old) string
  1107.    out=out||prefix||new
  1108.    end
  1109. return out||string
  1110. /* --- end subroutine  - Change:                                -------------*/
  1111. /* --------------------------------------------------------------------------*/
  1112.  
  1113.