fmain_nodebug.pas  |  Makefile

// fmain 0.0.89 beta ( nodebug )
// - string matching still somewhat dirty
// - zero sized input file not allowed though it should

program fmain_list_structure;

const
  ptrArrSize = 32;

type
  ChLstElmPtr = ^ChLstElm;
  ChLstElm = packed record
                     succElm: ChLstElmPtr;
                      ch: Char;
                   end;

  PtrArr = packed array[1..ptrArrSize] of ChLstElmPtr;

  PtrLstElmPtr = ^PtrLstElm;
  PtrLstElm = packed record
                       succElm: PtrLstElmPtr;
                       ptr: ptrArr;
                     end;

  RuleElmPtr = ^RuleElm;
  RuleElm = packed record
                     succElm: RuleElmPtr;
                     terminate: Boolean;
                     priority, srcStrLen, dstStrLen: Cardinal;
                     srcStrPtr, dstStrPtr: ^Char;
                   end;

var
  inputFileName : String(255) value 'input';
  outputFileName: String(255) value 'output';
  ruleFileName  : String(255) value 'rules';

  chBufElmNum: Cardinal value 32768;
  isSort, isCheck: Boolean value true;

  fstChLstElmPtr: ChLstElmPtr;
  fstEmpChLstElmPtr: ChLstElmPtr value nil;

  fstPtrLstElmPtr: PtrLstElmPtr value nil;
  wrkPtrLstElmPtr: PtrLstElmPtr;

  fstRulePtr: RuleElmPtr;
  talRulePtr: RuleElmPtr;

  ptrCnt: Cardinal value 0;
  
procedure EvaluateParams;
label
  evaluateParams_fnd,
  evaluateParams_err;
var
  i: Cardinal value 1;
  errCode: Integer;
begin
  while i <= ParamCount do
  begin
    if (ParamStr(i) = '-i') or (ParamStr(i) = '--inputFile') then
    begin
      Inc(i);
      inputFileName := ParamStr(i);
      goto evaluateParams_fnd;
    end;
    if (ParamStr(i) = '-o') or (ParamStr(i) = '--outputFile') then
    begin
      Inc(i);
      outputFileName := ParamStr(i);
      goto evaluateParams_fnd;
    end;
    if (ParamStr(i) = '-r') or (ParamStr(i) = '--rulesFile') then
    begin
      Inc(i);
      ruleFileName := ParamStr(i);
      goto evaluateParams_fnd;
    end;
    if (ParamStr(i) = '-bs') or (ParamStr(i) = '--bufferSize') then
    begin
      Inc(i);
      Val(ParamStr(i), chBufElmNum, errCode);
      if errCode <> 0 then
        goto evaluateParams_err;
      if chBufElmNum < 16 then
        chBufElmNum := 16;
      goto evaluateParams_fnd;
    end;
    if (ParamStr(i) = '-ns') or (ParamStr(i) = '--noSort') then
    begin
      isSort := false;
      goto evaluateParams_fnd;
    end;
    if (ParamStr(i) = '-nc') or (ParamStr(i) = '--noCheck') then
    begin
      isCheck := false;
      goto evaluateParams_fnd;
    end;
    if (ParamStr(i) = '-a') or (ParamStr(i) = '--about') then
    begin
      WriteLn('fmain 0.0.89 beta - fast markov algorithm interpreter');
      WriteLn;
      WriteLn('  compiled for   gnu/linux on i386 isa');
      WriteLn('  compiled via   gnu pascal 2.1');
      WriteLn('  author         jörg meyer, j.meyer@stud.fh-sm.de');
      Halt($00);
    end;
    if (ParamStr(i) = '-h') or (ParamStr(i) = '--help') then
    begin
      WriteLn('fmain [ -i file  | --inputFile file  ] - specify file name, default is input');
      WriteLn('      [ -o file  | --outputFile file ] - specify file name, default is output');
      WriteLn('      [ -r file  | --rulesFile file  ] - specify file name, default is rules');
      WriteLn;
      WriteLn('      [ -bs size | --bufferSize size ] - specify buffer size, default is 32768');
      WriteLn;
      WriteLn('      [ -ns      | --noSort          ] - don''t sort rules, not recommended');
      WriteLn('      [ -nc      | --noCheck         ] - don''t check rules for multiple use of');
      WriteLn('                                         equal priority etc, not recommended');
      WriteLn;
      WriteLn('      [ -a       | --about           ] - show some info about fmain');
      WriteLn('      [ -h       | --help            ] - show this help screen');
      Halt($00);
    end;

    evaluateParams_err:
      WriteLn(stdErr, 'error evaluating parameter "', ParamStr(i), '", halting');
      Halt($01);
    
    evaluateParams_fnd:
    Inc(i);
  end;
end;

function GetChLstMemory(elmNum: Cardinal): Pointer;
var
  tmpPtr: Pointer;
begin
  GetMem(tmpPtr, SizeOf(ChLstElm) * elmNum);
  GetChLstMemory := tmpPtr;
end;

procedure ReadInputFile;
var
  inputFile: File;
  chBuf: array[0..Pred(chBufElmNum)] of Char;
  tmpPtr: ChLstElmPtr value nil;
  chNumRead, b, e: Cardinal;

begin
  Assign(inputFile, inputFileName);
  Reset(inputFile, 1);
  BlockRead(inputFile, chBuf, chBufElmNum, chNumRead);

  if chNumRead = 0 then
  begin
    WriteLn(stdErr, 'zero sized input file not allowed, halting');
    Halt($E0);
  end;

  repeat
    if fstPtrLstElmPtr = nil then
    begin
      New(fstPtrLstElmPtr);
      wrkPtrLstElmPtr := fstPtrLstElmPtr;
    end;
    Inc(ptrCnt);  // store next ptr at next position of current ptr-array
    if ptrCnt > ptrArrSize then  // ptr-array already completely filled
    begin
      New(wrkPtrLstElmPtr^.succElm);
      wrkPtrLstElmPtr := wrkPtrLstElmPtr^.succElm;
      ptrCnt := 1;  // store next ptr at the beginning of new ptr-array
    end;
    wrkPtrLstElmPtr^.ptr[ptrCnt] := GetChLstMemory(chBufElmNum);
    if tmpPtr <> nil then
      // last chListElm of old chElm-block points to begin of curr chElm-block
      // pointer to new chElm-block may be stored in old or curr ptrArr-block
      tmpPtr^.succElm := wrkPtrLstElmPtr^.ptr[ptrCnt];
    if chNumRead <> 1 then  // ensures chNumRead - 2 to be always defined
    begin
      for e := 0 to Pred(Pred(chNumRead)) do
        with wrkPtrLstElmPtr^ do
        begin
          (ptr[ptrCnt] + e)^.ch := chBuf[e];
          (ptr[ptrCnt] + e)^.succElm := (ptr[ptrCnt] + Succ(e));
        end;
      Inc(e);
    end
    else
      e := 0;
    (wrkPtrLstElmPtr^.ptr[ptrCnt] + e)^.ch := chBuf[e];
    tmpPtr := (wrkPtrLstElmPtr^.ptr[ptrCnt] + e);
    BlockRead(inputFile, chBuf, chBufElmNum, chNumRead);
  until chNumRead = 0;

  Close(inputFile);
  tmpPtr^.succElm := nil;  // terminate chElmLst by setting last succElm to nil
  for e := Succ(e) to Pred(chBufElmNum) do   // for first to last empty element
    if fstEmpChLstElmPtr = nil then
    begin
      fstEmpChLstElmPtr          := (wrkPtrLstElmPtr^.ptr[ptrCnt] + e);
      fstEmpChLstElmPtr^.succElm := nil;
    end
    else
    begin
      tmpPtr                     := fstEmpChLstElmPtr;
      fstEmpChLstElmPtr          := (wrkPtrLstElmPtr^.ptr[ptrCnt] + e);
      fstEmpChLstElmPtr^.succElm := tmpPtr;
    end;
  fstChLstElmPtr := fstPtrLstElmPtr^.ptr[1];  // first chElm can be found here
end;

procedure ReadRuleFile;
var
  ruleFile: File;
  chBuf: array[0..Pred(chBufElmNum)] of Char;
  chNumRead: Cardinal;
  ruleChNum: Cardinal;
  fstRuleChPtr: ^Char;
  b, m: Cardinal value 0;

procedure FileRules;
const
  attrib          = 0;
  fromStrDef_cnt  = 1;
  fromStrDef_copy = 2;
  toStrDef_cnt    = 3;
  toStrDef_copy   = 4;
var
  wrkRulePtr: RuleElmPtr;
  pChar: Char;
  priorStr, asciiStr: String (10);
  priorVal, asciiVal: Cardinal;
  errCode: Integer;
  wrkSrcStrPtr, wrkDstStrPtr: ^Char;
  remInSideRuleLPref: Cardinal;
  blChars: Set of Char value [#9, #10, #13, #32];  // <- Pascal 4 ever!
  dgChars: Set of Char value ['0'..'9'];
  anotherRule: Boolean value false; // <- grosser Schrott
  tmpRuleChPtr: ^Char;
  tmpM: Cardinal;
  priorDefVal: Cardinal value 0;
  
label
  outSideRule,
  inSideRule_attrib,
  inSideRule_attrib_beyondInit,
  inSideRule_attrib_beyondRead,
  setTerminus,
  setPriority,
  setPriority_beyondInit,
  inSideRule_fromStrDef_cnt,
  inSideRule_fromStrDef_cnt_beyondRead,
  inSideRule_fromStrDef_cntStrict,
  inSideRule_fromStrDef_cntStrict_beyondInit,
  inSideRule_fromStrDef_cntLoose,
  inSideRule_fromStrDef_cntLoose_beyondInit,
  maySubstOperator_cnt,
  inSideRule_fromStrDef_copy,
  inSideRule_fromStrDef_copy_beyondInit,
  inSideRule_fromStrDef_copy_beyondRead,
  inSideRule_fromStrDef_copyStrict,
  inSideRule_fromStrDef_copyLoose,
  inSideRule_fromStrDef_copyLoose_beyondInit,
  maySubstOperator_copy,
  maySubstOperator_copy_confirmed,
  inSideRule_toStrDef_cnt,
  inSideRule_toStrDef_cnt_beyondRead,
  inSideRule_toStrDef_cntStrict,
  inSideRule_toStrDef_cntStrict_beyondInit,
  inSideRule_toStrDef_cntLoose,
  inSideRule_toStrDef_cntLoose_beyondInit,
  inSideRule_toStrDef_copy,
  inSideRule_toStrDef_copy_beyondInit,
  inSideRule_toStrDef_copy_beyondRead,
  inSideRule_toStrDef_copyStrict,
  inSideRule_toStrDef_copyLoose,
  inSideRule_toStrDef_copyLoose_beyondInit,
  mayAlnRem_outSideRule,
  isSlnRem_outSideRule,
  isMlnRem_outSideRule,
  isMlnRem_outSideRule_beyondRead,
  mayNoMlnRem_outSideRule,
  mayAlnRem_inSideRule,
  isSlnRem_inSideRule,
  isMlnRem_inSideRule,
  isMlnRem_inSideRule_beyondRead,
  mayNoMlnRem_inSideRule,
  isSrRem,
  isSrRem_strict,
  error,
  done;
  
inline procedure pRead;
begin
  if m = ruleChNum then goto done;
  pChar := (fstRuleChPtr + m)^;
  Inc(m);
end;

begin
  m := 0;  // <- somewhat dirty

  new(fstRulePtr);  // dummy - works as head
  new(fstRulePtr^.succElm);
  wrkRulePtr := fstRulePtr^.succElm;

  outSideRule:
    pRead;
    if pChar = '(' then goto inSideRule_attrib;
    if pChar = '[' then goto isSrRem;
    if pChar = '-' then goto mayAlnRem_outSideRule;
    if pChar in blChars then goto outSideRule;
    goto error;

  inSideRule_attrib:
    if anotherRule then
    begin
      priorDefVal := Succ(wrkRulePtr^.priority);

      new(wrkRulePtr^.succElm);
      wrkRulePtr := wrkRulePtr^.succElm;

    end;
    wrkRulePtr^.priority := priorDefVal;
    anotherRule := true;

  inSideRule_attrib_beyondInit:
    pRead;
  inSideRule_attrib_beyondRead:
    if pChar = '$' then goto setTerminus;
    if pChar = 'p' then goto setPriority;
    if pChar = '"' then begin
                          // tmpRuleChPtr := Pred(wrkRuleChPtr);
                          tmpM := Pred(m);
                          goto inSideRule_fromStrDef_cntStrict;
                        end;
    if pChar = '#' then begin
                          // tmpRuleChPtr := Pred(wrkRuleChPtr);
                          tmpM := Pred(m);
                          goto inSideRule_fromStrDef_cntLoose;
                        end;
    if pChar = '-' then begin
                          remInSideRuleLPref := attrib;
                          goto mayAlnRem_inSideRule;
                        end;
    if pChar in blChars then goto inSideRule_attrib_beyondInit;
    goto error;

  setTerminus:
    wrkRulePtr^.terminate := true;
    goto inSideRule_attrib_beyondInit;

  setPriority:
    SetLength(priorStr, 0);
  setPriority_beyondInit:
    pRead;
    if pChar in dgChars then
    begin
     SetLength(priorStr, Succ(Length(priorStr)));
     priorStr[Length(priorStr)] := pChar;
    end
    else
    begin
      Val(priorStr, priorVal, errCode);
      if errCode <> 0 then goto error;
      wrkRulePtr^.priority := priorVal;
      goto inSideRule_attrib_beyondRead;
    end;
    goto setPriority_beyondInit;

  inSideRule_fromStrDef_cnt:                      // <- fromStrDef_cnt
    pRead;
  inSideRule_fromStrDef_cnt_beyondRead:
    if pChar = '"' then goto inSideRule_fromStrDef_cntStrict_beyondInit;
    if pChar = '#' then goto inSideRule_fromStrDef_cntLoose_beyondInit;
    if pChar = '=' then goto maySubstOperator_cnt;
    if pChar = '-' then begin
                          remInSideRuleLPref := fromStrDef_cnt;
                          goto mayAlnRem_inSideRule;
                        end;
    if pChar in blChars then goto inSideRule_fromStrDef_cnt;
    goto error;

  inSideRule_fromStrDef_cntStrict:
    wrkRulePtr^.srcStrLen := 0;
  inSideRule_fromStrDef_cntStrict_beyondInit:
    pRead;
    if pChar = '"' then goto inSideRule_fromStrDef_cnt;
    Inc(wrkRulePtr^.srcStrLen);
    goto inSideRule_fromStrDef_cntStrict_beyondInit;

  inSideRule_fromStrDef_cntLoose:
    wrkRulePtr^.srcStrLen := 0;
  inSideRule_fromStrDef_cntLoose_beyondInit:
    pRead;
    if pChar in dgChars then goto inSideRule_fromStrDef_cntLoose_beyondInit;
    Inc(wrkRulePtr^.srcStrLen);
    goto inSideRule_fromStrDef_cnt_beyondRead;

  maySubstOperator_cnt:
    pRead;
    if pChar = '>' then
    begin
      // wrkRuleChPtr := tmpRuleChPtr;
      m := tmpM;
      goto inSideRule_fromStrDef_copy;
    end;
    goto error;

  inSideRule_fromStrDef_copy:                     // <- fromStrDef_copy
    GetMem(wrkRulePtr^.srcStrPtr, wrkRulePtr^.srcStrLen);
    wrkSrcStrPtr := wrkRulePtr^.srcStrPtr;
  inSideRule_fromStrDef_copy_beyondInit:
    pRead;
  inSideRule_fromStrDef_copy_beyondRead:
    if pChar = '"' then goto inSideRule_fromStrDef_copyStrict;
    if pChar = '#' then goto inSideRule_fromStrDef_copyLoose;
    if pChar = '=' then goto maySubstOperator_copy;
    if pChar = '-' then begin
                          remInSideRuleLPref := fromStrDef_copy;
                          goto mayAlnRem_inSideRule;
                        end;  
    if pChar in blChars then goto inSideRule_fromStrDef_copy_beyondInit;
    goto error;

  inSideRule_fromStrDef_copyStrict:
    pRead;
    if pChar = '"' then goto inSideRule_fromStrDef_copy_beyondInit;
    wrkSrcStrPtr^ := pChar;
    Inc(wrkSrcStrPtr);
    goto inSideRule_fromStrDef_copyStrict;

  inSideRule_fromStrDef_copyLoose:
    setLength(asciiStr, 0);
  inSideRule_fromStrDef_copyLoose_beyondInit:
    pRead;
    if pChar in dgChars then
    begin
      SetLength(asciiStr, Succ(Length(asciiStr)));
      asciiStr[Length(asciiStr)] := pChar;
    end
    else
    begin
      Val(asciiStr, asciiVal, errCode);
      if errCode <> 0 then goto error;
      wrkSrcStrPtr^ := Char(asciiVal);
      Inc(wrkSrcStrPtr);
      goto inSideRule_fromStrDef_copy_beyondRead;
    end;
    goto inSideRule_fromStrDef_copyLoose_beyondInit;

  maySubstOperator_copy:
    pRead;
    if pChar = '>' then
    begin
      maySubstOperator_copy_confirmed:
      pRead;
      if pChar = '"' then begin
                            // tmpRuleChPtr := Pred(wrkRuleChPtr);
                            tmpM := Pred(m);
                            goto inSideRule_toStrDef_cntStrict;
                          end;
      if pChar = '#' then begin
                            // tmpRuleChPtr := Pred(wrkRuleChPtr);
                            tmpM := Pred(m);
                            goto inSideRule_toStrDef_cntLoose;
                          end;  
      if pChar in blChars then goto maySubstOperator_copy_confirmed;
      goto error;
    end;
    goto error;

  inSideRule_toStrDef_cnt:                      // <- toStrDef_cnt
    pRead;
  inSideRule_toStrDef_cnt_beyondRead:
    if pChar = '"' then goto inSideRule_toStrDef_cntStrict_beyondInit;
    if pChar = '#' then goto inSideRule_toStrDef_cntLoose_beyondInit;
    if pChar = ')' then begin
                          // wrkRuleChPtr := tmpRuleChPtr;                          
                          m := tmpM;
                          goto insideRule_toStrDef_copy;
                        end;
    if pChar = '-' then begin
                          remInSideRuleLPref := toStrDef_cnt;
                          goto mayAlnRem_inSideRule;
                        end;
    if pChar in blChars then goto inSideRule_toStrDef_cnt;
    goto error;
    
  inSideRule_toStrDef_cntStrict:
    wrkRulePtr^.dstStrLen := 0;
  inSideRule_toStrDef_cntStrict_beyondInit:
    pRead;
    if pChar = '"' then goto inSideRule_toStrDef_cnt;
    Inc(wrkRulePtr^.dstStrLen);
    goto inSideRule_toStrDef_cntStrict_beyondInit;

  inSideRule_toStrDef_cntLoose:
    wrkRulePtr^.dstStrLen := 0;
  inSideRule_toStrDef_cntLoose_beyondInit:
    pRead;
    if pChar in dgChars then goto inSideRule_toStrDef_cntLoose_beyondInit;
    Inc(wrkRulePtr^.dstStrLen);
    goto inSideRule_toStrDef_cnt_beyondRead;

  inSideRule_toStrDef_copy:                      // <- toStrDef_copy
    GetMem(wrkRulePtr^.dstStrPtr, wrkRulePtr^.dstStrLen);
    wrkDstStrPtr := wrkRulePtr^.dstStrPtr;
  inSideRule_toStrDef_copy_beyondInit:
    pRead;
  inSideRule_toStrDef_copy_beyondRead:
    if pChar = '"' then goto inSideRule_toStrDef_copyStrict;
    if pChar = '#' then goto inSideRule_toStrDef_copyLoose;
    if pChar = ')' then goto outSideRule;
    if pChar = '-' then begin
                          remInSideRuleLPref := toStrDef_copy;
                          goto mayAlnRem_inSideRule;
                        end;  
    if pChar in blChars then goto inSideRule_toStrDef_copy_beyondInit;
    goto error;

  inSideRule_toStrDef_copyStrict:
    pRead;
    if pChar = '"' then goto inSideRule_toStrDef_copy_beyondInit;
    wrkDstStrPtr^ := pChar;
    Inc(wrkDstStrPtr);
    goto inSideRule_toStrDef_copyStrict;
    
  inSideRule_toStrDef_copyLoose:
    SetLength(asciiStr, 0);
  inSideRule_toStrDef_copyLoose_beyondInit:
    pRead;
    if pChar in dgChars then
    begin
      SetLength(asciiStr, Succ(Length(asciiStr)));
      asciiStr[Length(asciiStr)] := pChar;
    end
    else
    begin
      Val(asciiStr, asciiVal, errCode);
      if errCode <> 0 then goto error;
      wrkDstStrPtr^ := Char(asciiVal);
      Inc(wrkDstStrPtr);
      goto inSideRule_toStrDef_copy_beyondRead;
    end;
    goto inSideRule_toStrDef_copyLoose_beyondInit;

  mayAlnRem_outSideRule:                        // <- mayAlnRem_outSideRule
    pRead;
    if pChar = '-' then goto isSlnRem_outSideRule;
    if pChar = '/' then goto isMlnRem_outSideRule;
    goto error;
  
  isSlnRem_outSideRule:
    pRead;
    if pChar = #10 then goto outSideRule;
    goto isSlnRem_outSideRule;
  
  isMlnRem_outSideRule:
    pRead;
  isMlnRem_outSideRule_beyondRead:
    if pChar = '/' then goto mayNoMlnRem_outSideRule;
    goto isMlnRem_outSideRule;

  mayNoMlnRem_outSideRule:
    pRead;
    if pChar = '-' then goto outSideRule;
    goto isMlnRem_outSideRule_beyondRead;

  mayAlnRem_inSideRule:                  // <- mayAlnRem_inSideRule
    pRead;
    if pChar = '-' then goto isSlnRem_inSideRule;
    if pChar = '/' then goto isMlnRem_inSideRule;
    goto error;

  isSlnRem_inSideRule:
    pRead;
    if pChar = #10 then
    begin
      if remInSideRuleLPref = attrib          then goto inSideRule_attrib_beyondInit;
      if remInSideRuleLPref = fromStrDef_cnt  then goto inSideRule_fromStrDef_cnt;
      if remInSideRuleLPref = fromStrDef_copy then goto inSideRule_fromStrDef_copy;
      if remInSideRuleLPref = toStrDef_cnt    then goto inSideRule_toStrDef_cnt;
      if remInSideRuleLPref = toStrDef_copy   then goto inSideRule_toStrDef_copy;
    end;  
    goto isSlnRem_inSideRule;

  isMlnRem_inSideRule:
    pRead;
  isMlnRem_inSideRule_beyondRead:
    if pChar = '/' then goto mayNoMlnRem_inSideRule;
    goto isMlnRem_inSideRule;
  
  mayNoMlnRem_inSideRule:
    pRead;
    if pChar = '-' then
    begin
      if remInSideRuleLPref = attrib          then goto inSideRule_attrib_beyondInit;
      if remInSideRuleLPref = fromStrDef_cnt  then goto inSideRule_fromStrDef_cnt;
      if remInSideRuleLPref = fromStrDef_copy then goto inSideRule_fromStrDef_copy;
      if remInSideRuleLPref = toStrDef_cnt    then goto inSideRule_toStrDef_cnt;
      if remInSideRuleLPref = toStrDef_copy   then goto inSideRule_toStrDef_copy;
    end;
    goto isMlnRem_inSideRule_beyondRead;

  isSrRem:
    pRead;
    if pChar = '"' then goto isSrRem_strict;
    if pChar = ')' then goto outSideRule;
    goto isSrRem;
  isSrRem_strict:
    pRead;
    if pChar = '"' then goto isSrRem;
    goto isSrRem_strict;

  error:
    WriteLn(stdErr, 'error parsing ', ruleFileName, ' at offset ', m, ', halting');
    Halt($10);

  done:
    new(talRulePtr);  // dummy - works as tail
    wrkRulePtr^.succElm := talRulePtr;
    talRulePtr^.succElm := talRulePtr;
    // letting point talRulePtr^.succElm to itself allows
    // swapping last two numbers without looking
    // on them as a special case while sorting
end;

procedure SortRules;
var
  sorted: Boolean;
  prvRulePtr, tmpRulePtr, wrkRulePtr: RuleElmPtr;
begin
  repeat
    sorted := true;
    prvRulePtr := fstRulePtr;
    wrkRulePtr := fstRulePtr^.succElm;

    while wrkRulePtr^.succElm <> talRulePtr do
    begin
      if wrkRulePtr^.priority > wrkRulePtr^.succElm^.priority then
      begin
        sorted := false;
        prvRulePtr^.succElm := wrkRulePtr^.succElm;
        tmpRulePtr := wrkRulePtr^.succElm^.succElm;
        wrkRulePtr^.succElm^.succElm := wrkRulePtr;
        wrkRulePtr^.succElm := tmpRulePtr;
      end;
      prvRulePtr := wrkRulePtr;
      wrkRulePtr := wrkRulePtr^.succElm;
    end;
  until sorted;
end;

procedure FreeDummyRules;
var
  wrkRulePtr: RuleElmPtr;
begin
  // no more sorting - head and tail may go play now
  wrkRulePtr := fstRulePtr^.succElm;
  Dispose(fstRulePtr);
  fstRulePtr := wrkRulePtr;

  while wrkRulePtr^.succElm <> talRulePtr do
    wrkRulePtr := wrkRulePtr^.succElm;
  Dispose(talRulePtr);
  wrkRulePtr^.succElm := nil;
end;

procedure CheckRules;
var
  wrkRulePtr: RuleElmPtr;
  savedPrior: Cardinal;
begin
  with fstRulePtr^ do
    if (srcStrLen = 0) and (terminate = false) then
    begin
      WriteLn(stdErr, 'lowest rule searches empty word and doesn''t terminate, halting');
      Halt($11);
    end;

  savedPrior := fstRulePtr^.priority;
  wrkRulePtr := fstRulePtr^.succElm;
  while wrkRulePtr <> nil do
  with wrkRulePtr^ do
  begin  
    if priority = savedPrior then
    begin
      WriteLn(stdErr, 'more then one rule owns priority ', priority, ', halting');
      Halt($12);
    end;
    savedPrior := priority;
    wrkRulePtr := succElm;
  end;
end;

begin
  Assign(ruleFile, ruleFileName);
  Reset(ruleFile, 1);
  ruleChNum := FileSize(ruleFile);
  GetMem(fstRuleChPtr, ruleChNum);
  BlockRead(ruleFile, chBuf, chBufElmNum, chNumRead);

  while chNumRead <> 0 do
  begin
    for b := 0 to Pred(chNumRead) do
      (fstRuleChPtr + m + b)^ := chBuf[b];
    Inc(m, chBufElmNum);
    BlockRead(ruleFile, chBuf, chBufElmNum, chNumRead);
  end;

  Close(ruleFile);
  FileRules; // increment pointer directly for higher speed?!?

  if isSort then
    SortRules;
  FreeDummyRules;

  if isCheck then
    CheckRules;
end;

procedure WriteOutputFile;
var
  actChLstElmPtr: ChLstElmPtr;
  outputFile: File;
  chBuf: array[1..chBufElmNum] of Char;
  r: Cardinal value 1;
  w: Cardinal;
begin
  actChLstElmPtr := fstChLstElmPtr;

  Assign(outputFile, outputFileName);
  Rewrite(outputFile, 1);
  
  while actChLstElmPtr <> nil do
  begin
    chBuf[r] := actChLstElmPtr^.ch;
    if r = chBufElmNum then
    begin
      BlockWrite(outputFile, chBuf, r, w);
      r := 1;
    end
    else
      Inc(r);

    actChLstElmPtr := actChLstElmPtr^.succElm;
  end;
  BlockWrite(outputFile, chBuf, Pred(r), w);
  Close(outputFile);
end;

procedure Interpret;
var
  wrkRulePtr: RuleElmPtr;
  matChPos, prvChPos, wrkChPos: ChLstElmPtr;
  shorterStrLen, i: Cardinal;
  
inline function GotMatchPos: Boolean;  // still very dirty
var
  actChElmPtr: ChLstElmPtr;
  tmpChElmPtr: ChLstElmPtr;
  equal: Boolean;
  emptyMatch: Boolean value false;

begin
  matChPos := nil;
  prvChPos := nil;
  actChElmPtr := fstChLstElmPtr;
  if wrkRulePtr^.srcStrLen = 0 then
  begin
    emptyMatch := true;
    matChPos := actChElmPtr;  // nil if chElmLst empty -> match var
  end
  else
    while actChElmPtr <> nil do
    begin
      if wrkRulePtr^.srcStrPtr^ = actChElmPtr^.ch then
      begin
        equal := true;
        if wrkRulePtr^.srcStrLen > 1 then
        begin
          tmpChElmPtr := actChElmPtr;
          for i := 1 to Pred(wrkRulePtr^.srcStrLen) do
          begin
            if tmpChElmPtr^.succElm = nil then
            begin
              equal := false;
              Break;
            end
            else
              tmpChElmPtr := tmpChElmPtr^.succElm;
            if (wrkRulePtr^.srcStrPtr + i)^ <> tmpChElmPtr^.ch then
            begin
              equal := false;
              Break;
            end;
          end;
        end;
      end
      else
        equal := false;
      if equal then
      begin
        matChPos := actChElmPtr;
        Break;
      end;
      prvChPos := actChElmPtr;
      actChElmPtr := actChElmPtr^.succElm;
    end;

  GotMatchPos := (emptyMatch or (matChPos <> nil));
end;

inline procedure SetShorterStrLen;
begin
  shorterStrLen := wrkRulePtr^.srcStrLen;
  if wrkRulePtr^.dstStrLen < shorterStrLen then
    shorterStrLen := wrkRulePtr^.dstStrLen;
end;

inline procedure SwpStrChars;
begin
  wrkChPos := matChPos;
  for i := 0 to Pred(shorterStrLen) do
  begin
    wrkChPos^.ch := (wrkRulePtr^.dstStrPtr + i)^;
    prvChPos := wrkChPos;
    wrkChPos := wrkChPos^.succElm;
  end;
end;

inline procedure DelStrChars;
var
  hlpChPtr: Pointer;
  wrkChPtr: ChLstElmPtr;
begin
  wrkChPtr := prvChPos;
  if prvChPos = nil then                     // if no previous element
    for i := (wrkRulePtr^.srcStrLen - shorterStrLen) downto 1 do
      if fstEmpChLstElmPtr = nil then
      begin
        fstEmpChLstElmPtr          := fstChLstElmPtr;
        fstChLstElmPtr             := fstChLstElmPtr^.succElm;
        fstEmpChLstElmPtr^.succElm := nil;
      end
      else
      begin
        hlpChPtr                   := fstEmpChLstElmPtr;
        fstEmpChLstElmPtr          := fstChLstElmPtr;
        fstChLstElmPtr             := fstChLstElmPtr^.succElm;
        fstEmpChLstElmPtr^.succElm := hlpChPtr;
      end
  else
    for i := (wrkRulePtr^.srcStrLen - shorterStrLen) downto 1 do
      if fstEmpChLstElmPtr = nil then
      begin
        fstEmpChLstElmPtr          := wrkChPtr^.succElm;
        wrkChPtr^.succElm          := wrkChPtr^.succElm^.succElm;
        fstEmpChLstElmPtr^.succElm := nil;
      end
      else
      begin
        hlpChPtr                   := fstEmpChLstElmPtr;
        fstEmpChLstElmPtr          := wrkChPtr^.succElm;
        wrkChPtr^.succElm          := wrkChPtr^.succElm^.succElm;
        fstEmpChLstElmPtr^.succElm := hlpChPtr;
      end;
end;

inline procedure InsStrChars;
var
  hlpChPtr: ChLstElmPtr;
  wrkChPtr: ChLstElmPtr;
  e: Cardinal;
begin
  wrkChPtr := prvChPos;
  for i := wrkRulePtr^.dstStrLen downto Succ(shorterStrLen) do
  begin
    if fstEmpChLstElmPtr = nil then
    begin
      Inc(ptrCnt);  // store next ptr at next position of current ptr-array
      if ptrCnt > ptrArrSize then  // ptr-array already completely filled
      begin
        New(wrkPtrLstElmPtr^.succElm);
        wrkPtrLstElmPtr := wrkPtrLstElmPtr^.succElm;
        ptrCnt := 1;  // store next ptr at the beginning of new ptr-array
      end;
      wrkPtrLstElmPtr^.ptr[ptrCnt] := GetChLstMemory(chBufElmNum);

      for e := 0 to Pred(chBufElmNum) do   // for first to last empty element
        if fstEmpChLstElmPtr = nil then
        begin
          fstEmpChLstElmPtr          := (wrkPtrLstElmPtr^.ptr[ptrCnt] + e);
          fstEmpChLstElmPtr^.succElm := nil;
        end
        else
        begin
          hlpChPtr                   := fstEmpChLstElmPtr;
          fstEmpChLstElmPtr          := (wrkPtrLstElmPtr^.ptr[ptrCnt] + e);
          fstEmpChLstElmPtr^.succElm := hlpChPtr;
        end;
    end;

    if prvChPos = nil then
    begin
      hlpChPtr                  := fstEmpChLstElmPtr;
      fstEmpChLstElmPtr         := fstEmpChLstElmPtr^.succElm;
       
      hlpChPtr^.succElm         := fstChLstElmPtr;
      fstChLstElmPtr            := hlpChPtr;
        
      fstChLstElmPtr^.ch        := (wrkRulePtr^.dstStrPtr + Pred(i))^;  // swap
    end
    else
    begin
      hlpChPtr              := fstEmpChLstElmPtr;
      fstEmpChLstElmPtr     := fstEmpChLstElmPtr^.succElm;

      hlpChPtr^.succElm     := wrkChPtr^.succElm;
      wrkChPtr^.succElm     := hlpChPtr;

      wrkChPtr^.succElm^.ch := (wrkRulePtr^.dstStrPtr + Pred(i))^;  // swap
    end;
  end;
end;

begin
  repeat
    wrkRulePtr := fstRulePtr;

    repeat
      if GotMatchPos then                      // sets matChPos and prvChPos
        Break                                  // current rule will work fine
      else                                     // if nothing matched
        wrkRulePtr := wrkRulePtr^.succElm      //   try next rule in new loop
    until wrkRulePtr = nil;                    // no more rules available

    if wrkRulePtr = nil then                   // no rule matches anymore
      Break                                    //   substitution done.
    else
    begin                                      // apply rule ...
      SetShorterStrLen;
      if shorterStrLen <> 0 then               // if there are chars to swap
          SwpStrChars;                         //   swap these chars

      if wrkRulePtr^.srcStrLen > shorterStrLen then
        DelStrChars;                           // del chars using prvChPos

      if wrkRulePtr^.dstStrLen > shorterStrLen then
        InsStrChars;

      if wrkRulePtr^.terminate then            // break after terminative rule
        Break;                                 //   substitution done.
    end;
  until false;                                 // left via several breaks
end;

begin
  EvaluateParams;
  ReadInputFile;
  ReadRuleFile;
  Interpret;
  WriteOutputFile;
end.