home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 277.lha / PatternLibrary / Pattern / compile.d < prev    next >
Encoding:
Text File  |  1989-08-08  |  5.3 KB  |  216 lines
  1. #patternInternal.g
  2.  
  3. /*
  4.  * nextItem - move up to the next item in the input pattern. Here, an item
  5.  *    is either a single character or an escaped character.
  6.  */
  7.  
  8. proc nextItem(register *PatternState_t ps)void:
  9.     register *[2]char pattern;
  10.     register ulong pos;
  11.  
  12.     pattern := ps*.ps_pattern;
  13.     pos := ps*.ps_position;
  14.     if ps*.ps_char = '\'' then
  15.     if pos ~= ps*.ps_length then
  16.         ps*.ps_char := pattern*[pos];
  17.         pos := pos + 1;
  18.     else
  19.         ps*.ps_char := ' ';
  20.         ps*.ps_end := true;
  21.     fi;
  22.     fi;
  23.     if pos ~= ps*.ps_length then
  24.     ps*.ps_char := pattern*[pos];
  25.     pos := pos + 1;
  26.     else
  27.     ps*.ps_char := ' ';
  28.     ps*.ps_end := true;
  29.     fi;
  30.     ps*.ps_position := pos;
  31. corp;
  32.  
  33. /*
  34.  * primary - recursive descent parser for expression primaries. Return the
  35.  *    head of the exit chain within the compiled vector for this primary.
  36.  */
  37.  
  38. proc primary(register *PatternState_t ps)ulong:
  39.     extern expression(*PatternState_t ps; ulong chain)ulong;
  40.     register *[2]ulong comp;
  41.     register *ulong pComp;
  42.     register ulong startPos, chain;
  43.     register char operator;
  44.  
  45.     startPos := ps*.ps_position;
  46.     if ps*.ps_end then
  47.     ps*.ps_error := pse_missingPrimary;
  48.     else
  49.     operator := ps*.ps_char;
  50.     nextItem(ps);
  51.     if operator = ')' then
  52.         ps*.ps_error := pse_unexpectedRightParen;
  53.     elif operator = '|' then
  54.         ps*.ps_error := pse_unexpectedOr;
  55.     elif operator = '\#' then
  56.         chain := primary(ps);
  57.         /* point all of the exits from the primary to the '#', thus
  58.            forming the repetition loop */
  59.         comp := ps*.ps_compiled;
  60.         while chain ~= 0 do
  61.         pComp := &comp*[chain];
  62.         chain := pComp*;
  63.         pComp* := startPos;
  64.         od;
  65.     elif operator = '(' then
  66.         /* recurse down to get a nested subpattern */
  67.         startPos := expression(ps, startPos);
  68.         if ps*.ps_end then
  69.         ps*.ps_error := pse_missingRightParen;
  70.         else
  71.         if ps*.ps_char ~= ')' then
  72.             ps*.ps_error := pse_missingRightParen;
  73.         fi;
  74.         /* skip the ')' */
  75.         nextItem(ps);
  76.         fi;
  77.     fi;
  78.     fi;
  79.     startPos
  80. corp;
  81.  
  82. /*
  83.  * expression - recursive descent parser - parse an alternation.
  84.  *    'chain' is the head of a chain in the compiled vector of the
  85.  *    exits that already exist on the same level as this expression. The
  86.  *    same chain, augmented by the alternatives here, is returned.
  87.  */
  88.  
  89. proc expression(register *PatternState_t ps; ulong oldChain)ulong:
  90.     register *[2]ulong comp;
  91.     register *ulong pComp;
  92.     register ulong newChain, exits, temp;
  93.     register char operator;
  94.  
  95.     comp := ps*.ps_compiled;
  96.     exits := 0;
  97.     while
  98.     newChain := primary(ps);
  99.     if ps*.ps_end then
  100.         /* end of the pattern - join together the exits built from any
  101.            alternation at this level with those from the primary */
  102.         if exits = 0 then
  103.         exits := newChain;
  104.         else
  105.         temp := exits;
  106.         while
  107.             pComp := &comp*[temp];
  108.             pComp* ~= 0
  109.         do
  110.             temp := pComp*;
  111.         od;
  112.         pComp* := newChain;
  113.         fi;
  114.         false
  115.     else
  116.         operator := ps*.ps_char;
  117.         if operator = '|' or operator = ')' then
  118.         /* end of an alterative sub-pattern - join the exits from it
  119.            with those from any previous alteratives at this level */
  120.         if exits = 0 then
  121.             exits := newChain;
  122.         else
  123.             temp := exits;
  124.             while
  125.             pComp := &comp*[temp];
  126.             pComp* ~= 0
  127.             do
  128.             temp := pComp*;
  129.             od;
  130.             pComp* := newChain;
  131.         fi;
  132.         if operator = '|' then
  133.             /* there should be another alterative - make the last
  134.                '|' or '(' point to this one */
  135.             comp*[oldChain] := ps*.ps_position;
  136.             oldChain := ps*.ps_position;
  137.             nextItem(ps);
  138.             true
  139.         else
  140.             /* ')' - end of this subpattern */
  141.             false
  142.         fi
  143.         else
  144.         /* a non-special character - make all of the exits from the
  145.            primary point to this element as their successors */
  146.         while newChain ~= 0 do
  147.             pComp := &comp*[newChain];
  148.             temp := pComp*;
  149.             pComp* := ps*.ps_position;
  150.             newChain := temp;
  151.         od;
  152.         true
  153.         fi
  154.     fi
  155.     do
  156.     od;
  157.     exits
  158. corp;
  159.  
  160. /*
  161.  * Compile - the top-level entry for pattern compilation.
  162.  */
  163.  
  164. proc Compile(/* register *PatternState_t ps */)void:
  165.     uint
  166.     R_A0 = 0,
  167.     R_FP = 6,
  168.     OP_MOVEL = 0x2000,
  169.     M_ADIR = 1,
  170.     M_DISP = 5;
  171.     *PatternState_t patternState;
  172.     register *PatternState_t ps;
  173.     register *[2]ulong comp;
  174.     register *ulong cPtr;
  175.     register ulong i, temp;
  176.  
  177.     /* This peculiar looking stuff is generating a move instruction to take
  178.        the value from register A0, and put it into local variable
  179.        'patternState'. This handles the special register linkage used for
  180.        library entry points in AmigaDOS. See the Draco documentation for
  181.        details on the 'code' construct. */
  182.  
  183.     code(
  184.     OP_MOVEL | R_FP << 9 | M_DISP << 6 | M_ADIR << 3 | R_A0,
  185.     patternState
  186.     );
  187.     ps := patternState;
  188.     if ps*.ps_length = 0 then
  189.     ps*.ps_error := pse_missingPrimary;
  190.     else
  191.     cPtr := &ps*.ps_compiled*[0];
  192.     for i from ps*.ps_length downto 0 do
  193.         cPtr* := 0;
  194.         cPtr := cPtr + sizeof(ulong);
  195.     od;
  196.     ps*.ps_error := pse_ok;
  197.     ps*.ps_end := false;
  198.     ps*.ps_char := ps*.ps_pattern*[0];
  199.     ps*.ps_position := 1;
  200.     i := expression(ps, 0);
  201.     if ps*.ps_char = ')' then
  202.         ps*.ps_error := pse_unexpectedRightParen;
  203.     fi;
  204.     /* Any pointers left coming out of the expression subpattern will
  205.        be for a successful match. Give them a compiled value of 0, which
  206.        indicates the final success. */
  207.     comp := ps*.ps_compiled;
  208.     while i ~= 0 do
  209.         cPtr := &comp*[i];
  210.         temp := cPtr*;
  211.         cPtr* := 0;
  212.         i := temp;
  213.     od;
  214.     fi;
  215. corp;
  216.