home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Misc / Rexx2exe.lha / aREXX / EXXEC.REXX < prev    next >
Encoding:
OS/2 REXX Batch file  |  1994-02-13  |  11.7 KB  |  367 lines
  1. /* exxec.rexx - Convert ARexx script to an executable program.
  2.  
  3.    Usage: rx exxec <scriptname> [CRUNCH]
  4.  
  5.    The input file name is matched according to ARexx's own rules, in the
  6.    following sequence:
  7.  
  8.       <scriptname>.rexx
  9.       <scriptname>
  10.       rexx:<scriptname>.rexx
  11.       rexx:<scriptname>
  12.  
  13.    The output file is placed in RAM: with its ".rexx" extension, if it
  14.    had one, removed. Warning: If your original file did NOT have a ".rexx"
  15.    extension, and was itself in RAM:, exxec will write over it.
  16.  
  17.    The output file will be 540 or so bytes longer than the original script.
  18.    The script itself is contained whole within the output file.
  19.  
  20.    Optionally, though, exxec will `crunch' the script by removing comments
  21.    and multiple spaces. This is specified with the CRUNCH keyword on the
  22.    command line (following the script file name). Depending on the coding
  23.    style used in the script, crunching can produce substantial space savings,
  24.    and may also make the resulting program execute very slightly faster.
  25.  
  26.    The crunching is done intelligently, with due allowance for nesting of
  27.    both quotes and comments, and treating all quoted material as strictly
  28.    literal. It will cause problems only for scripts that call the SOURCELINE
  29.    built-in function or that depend on particular values of SIGL.
  30.  
  31.    The crunching process itself is quite time-consuming, increasing exxec's
  32.    execution time by a factor of perhaps 4. If you don't care about the
  33.    space savings, but do care about the time it takes, don't use crunching.
  34.  
  35.    =========================================================================
  36.  
  37.    Theory of operation
  38.    -------------------
  39.  
  40.    The ARexx script (either crunched or not crunched, as described above),
  41.    is augmented with an assembler front end that passes the script to
  42.    ARexx as a string file to be executed as a function. Why not execute
  43.    it as a command? Because you can't give command-line arguments to a
  44.    string file executed as a command. However, by treating the script as
  45.    a function to which the command line is the sole argument, the command
  46.    line can be accessed as ARG(1) (or equivalently with ARG or PARSE ARG)
  47.    just as though you executed it with RX.
  48.  
  49.    The script is still contained in the executable file, starting a little
  50.    more than 500 bytes in. You can see it for yourself, if you like, with:
  51.  
  52.       type <filename> hex
  53.  
  54.    =========================================================================
  55.  
  56.    This script is freely redistributable but remains...
  57.  
  58.       Copyright (c) 1991 AHA! Software (Nick Sullivan, Chris Zamara)
  59.  
  60. ****************************************************************************/
  61.  
  62.  
  63. parse arg in_name    /* The source file */
  64.  
  65. crunch = 0
  66.  
  67. w = words(in_name)
  68.  
  69. if w > 1 then do
  70.    if upper(word(in_name, w)) = 'CRUNCH' then do
  71.       in_name = subword(in_name, 1, w - 1)
  72.       crunch  = 1
  73.       end
  74.    end
  75.  
  76. call time('r')
  77.  
  78. /* Set-up:
  79.       Read input file name; match it using same procedure as ARexx itself
  80.       uses to match script names given to RX; create output file name; open
  81.       the input file.
  82. */
  83. if ~exists(in_name'.rexx') then
  84.    if ~exists(in_name) then
  85.       if ~exists('rexx:'in_name'.rexx') then
  86.          if ~exists('rexx:'in_name) then do
  87.             say "Unable to locate input file."
  88.             exit
  89.             end
  90.          else
  91.             in_name = 'rexx:'in_name
  92.       else
  93.          in_name = 'rexx:'in_name'.rexx'
  94.    else
  95.       nop
  96. else
  97.    in_name = in_name'.rexx'
  98.  
  99. parse value 'ram:'GetFileName(in_name) with out_name '.rexx'
  100.  
  101. if ~open('fpr',in_name) then do
  102.    say "Can't open input file."
  103.    exit
  104.    end
  105.  
  106. /* Initialize the compound variable `out.' with the lines of hex containing
  107.    the assembler code. The InitBinary routine returns the number of lines
  108.    used for the assembler. We leave another line free to patch later on with
  109.    the number of longwords used by the script itself, and start reading
  110.    script lines and adding them from there.
  111. */
  112.  
  113. endbin   = InitBinary()+1        /* Make room for data-hunk-length longword */
  114. lines    = endbin                /* Current line                            */
  115. datasize = 0                     /* Size of script data in bytes            */
  116. mode     = 0                     /* Code-type mode: quoted/commented/NORMAL */
  117. incount  = 1                     /* Count of incoming lines (for report)    */
  118.  
  119.  
  120. /* Start reading lines till there aren't any left, then close the file. If
  121.    crunching is on, call CrunchLine in addition to other processing. Store
  122.    the line, accumulate its size and loop.
  123. */
  124.  
  125. line = readln('fpr')
  126. say
  127.  
  128. do while ~eof('fpr')
  129.    say '0b'x"Processing line" incount
  130.  
  131.    if crunch then do
  132.       line = CrunchLine(line)
  133.  
  134.       if line = '' then
  135.          line = ''               /* Reject lines of only spaces */
  136.       end
  137.  
  138.    if length(line) > 0 | ~crunch then do
  139.       lines     = lines + 1
  140.       out.lines = line'0a'x
  141.       datasize  = datasize + length(out.lines)
  142.       end
  143.  
  144.    line    = readln('fpr')
  145.    incount = incount + 1
  146.    end
  147.  
  148. call close('fpr')
  149.  
  150. /* The script must be zero-padded to a longword boundary. At least one zero
  151.    must be present to delimit the string. The number of zeros to add is
  152.    saved in `pad'.
  153. */
  154.  
  155. pad      = 4 - (datasize // 4)
  156. datasize = (datasize + pad) % 4   /* convert padded size to longwords */
  157.  
  158. /* We have to patch hunk size information in two places: the `endbin'
  159.    line noted after calling InitBinary(), and the 7th longword in the
  160.    assembler part.
  161. */
  162. out.endbin = d2c(datasize,4)
  163. out.2      = overlay(out.endbin, out.2, 9)
  164.  
  165. /* We need a final line with the zero padding and `hunk end' code */
  166. lines     = lines + 1
  167. out.lines = copies('00'x,pad)'000003f2'x
  168.  
  169. /* At last we can write out the file */
  170. if ~open('fpw',out_name,'w') then do
  171.    say "Can't open output file '"out_name"'."
  172.    exit
  173.    end
  174.  
  175. do i=1 to lines
  176.    call writech('fpw', out.i)
  177.    end
  178.  
  179. call close('fpw')
  180.  
  181. say "Done! Time =" time('e') "seconds."
  182.  
  183. exit
  184.  
  185.  
  186. /* GetFileName(path)
  187.  
  188.    Return file portion of path name given in arg(1).
  189. */
  190. GetFileName:
  191.    path = arg(1)
  192.    n = lastpos("/",path)
  193.  
  194.    if n = 0 then
  195.       n = lastpos(":",path)
  196.  
  197.    return substr(path, n + 1)
  198.  
  199.  
  200. /* CrunchLine
  201.  
  202.    Compress a single line (or even less) by removing excess spaces and
  203.    commentary. Since various exceptional conditions have to be handled,
  204.    possibly extending over multiple lines, the behavior of this function
  205.    is controlled by a global mode variable that corresponds to the type
  206.    of text presently being scanned:
  207.  
  208.    Mode:    0  Normal script text
  209.            -1  Single quoted
  210.            -2  Double quoted
  211.             1+ Commented (increase for each level of nesting)
  212.  
  213.    Here's what happens:
  214.  
  215.    If the current mode is non-zero, look on this line for quote mode to be
  216.    cancelled, or for nested comment to begin or end. If none of these, return
  217.    line unchanged if mode is < 0, else return empty line.
  218.  
  219.    If quote mode IS cancelled, split line into head and tail. Set mode to 0,
  220.    and return head CrunchLine(tail).
  221.  
  222.    If nested comment begins or ends, change mode count accordinly and return
  223.    CrunchLine(tail).
  224.  
  225.    If the current mode is zero, look on this line for the start of a new
  226.    mode. If not found, return the line collapsing runs of spaces to 1.
  227.  
  228.    If the start of a new mode is found, split line into head and tail.
  229.    Set new mode and return head CrunchLine(tail).
  230.  
  231.    NB: This would probably be more efficient if we took a more ARexx-like
  232.    view of the source, and treated the whole script as one line line with
  233.    semicolon terminators, and removed comments before other processing.
  234. */
  235.  
  236. CrunchLine: procedure expose mode
  237.  
  238.    line = arg(1)
  239.  
  240.    /* If we're already in quotes or a comment, look for the ending token
  241.       to cancel the mode. Where two identical quotes occur in a row we
  242.       don't want to change mode, but that's okay, we'll just pop out of
  243.       the mode then immediately back in.
  244.    */
  245.    if mode ~= 0 then do
  246.       if mode<0 then do                /* we begin within quotes     */
  247.          qt = substr("""'",mode+3,1)   /* get quote for current mode */
  248.          n  = 0
  249.  
  250.          do until n=0 | c              /* to EOL or find cancel  */
  251.             n = pos(qt, line, n + 1)   /* pos'n of quote in line */
  252.             c = n > 0
  253.             end
  254.  
  255.          if ~c then
  256.             return line
  257.          else do
  258.             mode = 0
  259.             tail = substr(line, n + 1)
  260.  
  261.             if left(tail'.',1)=' ' then
  262.                return left(line,n) CrunchLine(strip(tail,'l'))
  263.             else
  264.                return left(line, n) || CrunchLine(tail)
  265.             end
  266.          end
  267.       else do
  268.          n  = pos("*/", line)
  269.          n2 = pos("/*", line)
  270.  
  271.          if n2>0 & n2<n then do
  272.             mode = mode + 1
  273.             n    = n2
  274.             end
  275.          else if n > 0 then
  276.             mode = mode - 1
  277.  
  278.          if n = 0 then
  279.             return ''
  280.          else
  281.             return CrunchLine(substr(line, n + 2))
  282.          end
  283.       end
  284.    else do
  285.  
  286.       /* Check line for first instance of a token that would force a
  287.          change in mode, then determine which (if any) occurs first.
  288.       */
  289.  
  290.       tkn.1 = '"'
  291.       tkn.2 = "'"
  292.       tkn.3 = "/*"
  293.  
  294.       n1 = pos(tkn.1, line)
  295.       n2 = pos(tkn.2, line)
  296.       n3 = pos(tkn.3, line)
  297.  
  298.       if n1>0 & (n1<n2 | n2=0) & (n1<n3 | n3=0) then
  299.          mode = -2
  300.       else if n2>0 & (n2<n1 | n1=0) & (n2<n3 | n3=0) then
  301.          mode = -1
  302.       else if n3>0 & (n3<n1 | n1=0) & (n3<n2 | n2=0) then
  303.          mode = 1
  304.       else
  305.          return space(line, 1)   /* Nothing special, return line as-is */
  306.  
  307.       /* Break line to right of found token */
  308.  
  309.       i = min(mode,0) + 3
  310.       n = value('n'i) + length(tkn.i)
  311.  
  312.       parse var line head =n tail
  313.  
  314.       /* Strip the token from the end of the line */
  315.  
  316.       head = left(head, length(head) - length(tkn.i))
  317.  
  318.       /* Reserve a trailing space for head if there is at least one there
  319.          now, and note the quote to be tacked on as well.
  320.       */
  321.  
  322.       sp=''; if head ~== '' then if right(head,1)=' ' then sp=' '
  323.       qt=''; if mode < 0 then qt = substr("""'", i, 1)
  324.  
  325.       return space(head, 1)sp || qt || CrunchLine(tail)
  326.       end
  327.  
  328.  
  329. /* This is the front-end - mostly the code hunk - of the eventual ARexx
  330.    executable. I just put it down here to get it out of the way.
  331. */
  332. InitBinary: procedure expose out.
  333.    out.1 = '000003F3 00000000 00000002 00000000'x
  334.    out.2 = '00000001 0000006F 00000010 000003E9'x
  335.    out.3 = '0000006F 48E73F3E 24002648 284F2002'x
  336.    out.4 = '5E400280 FFFFFFFE 9FC0244F 224A200B'x
  337.    out.5 = '67207020 7209740A 161B6716 B6026712'x
  338.    out.6 = 'B60067F4 B60167F0 12C3161B 6704B602'x
  339.    out.7 = '66F64211 B5C96708 B02167F6 B21167F2'x
  340.    out.8 = '7E142C78 00046100 00DE4A80 670000AA'x
  341.    out.9 = '2A4043F9 0000011A 4EAEFE7A 4A806700'x
  342.    out.10= '009243F9 0000011F 70004EAE FDD84A80'x
  343.    out.11= '67000080 2C00CD8E 204D93C9 70004EAE'x
  344.    out.12= 'FF706768 2648277C 00000000 0028274A'x
  345.    out.13= '002C7002 72004EAE FF5E6746 CD8E277C'x
  346.    out.14= '02040001 001C4EAE FF7C43F9 0000011A'x
  347.    out.15= '4EAEFE7A 2A006708 2040224B 4EAEFE92'x
  348.    out.16= '4EAEFF76 4A85670E 204D4EAE FE80204D'x
  349.    out.17= '4EAEFE8C 7E00CD8E 204B7002 4EAEFF64'x
  350.    out.18= 'CD8ECD8E 204B4EAE FF6ACD8E 22464EAE'x
  351.    out.19= 'FE62204D 6100008C 20072E4C 4CDF7CFC'x
  352.    out.20= '4E750000 00000000 00000000 00005245'x
  353.    out.21= '58580072 65787873 79736C69 622E6C69'x
  354.    out.22= '62726172 790048E7 20222C78 000470FF'x
  355.    out.23= '4EAEFEB6 74FFB400 67402400 7022223C'x
  356.    out.24= '00010001 4EAEFF3A 4A806728 2440157C'x
  357.    out.25= '00040008 1542000F 93C94EAE FEDA2540'x
  358.    out.26= '001041EA 00142548 001C43EA 00182089'x
  359.    out.27= '200A6008 20024EAE FEB07000 4CDF4404'x
  360.    out.28= '4E7548E7 00222448 2C780004 70FF1540'x
  361.    out.29= '00082540 00147000 102A000F 4EAEFEB0'x
  362.    out.30= '224A7022 4EAEFF2E 4CDF4400 4E750000'x
  363.    out.31= '000003EC 00000003 00000000 00000060'x
  364.    out.32= '00000070 000000B8 00000001 00000001'x
  365.    out.33= '00000094 00000000 000003F2 000003EA'x
  366.    return 33
  367.