Oakland CPM Archive/oakcpm.iso/cpm/filutl/decuf13.ark/DECUF.IF2

Text File | 1989-09-27 | 11KB | 310 lines

{* ----------------------------------------------------------------- *
 *                                                                   *
 *      S T A T E   P R O C E S S O R    P R O C E D U R E S         *
 *                                                                   *
 * ----------------------------------------------------------------- *}

procedure ProcesBegin ;
{*
 * ProcesBegin - Extract the result file name from the 'begin'
 *               statement and open a file with that name.
 *}
const
   PathDelimiter : array[0..2] of char = ':\/' ;
var
   KeyWord  : KeyWordString ;  { Keyword from line }
   Mode     : KeyWordString ;  { Octal encoded permission flags }
   FileName : KeyWordString ;  { Original file name }
   I        :       Integer ;  { Loop control variable }
begin
   LineIndex:= 1 ;  { Preset index for interpretation of header }
   Keyword:= NextWord ;
   if KeyWord='begin' then
    begin
     Mode    := NextWord ;
     FileName:= NextWord ;
     if FileName<>'' then
      begin
{*
 * Remove any path indication from the file name.  CP/M paths, MS-DOS
 * paths as well as UNIX paths are removed from the supplied name.
 *}
       for I:= 0 to 2 do
         while Pos( PathDelimiter[I], FileName ) <> 0 do
           FileName:= Copy( Filename,
                            Succ(Pos(PathDelimiter[I],FileName)), 255 ) ;
{*
 * Open the output file and swap to the Reading_Data state.  WARNING: The
 * procedure OpenOutputFile might change the processing state as well, in
 * case of an error. Thus the order of the 4 statements below is crucial!
 *}
       OutputFileName := OutputFilePath + FileName ;
       ProcessingState:= Reading_Data ;
       OpenOutputFile ;
       if ProcessingState=Reading_Data then
         WriteLn( 'Decoding to file ', OutputFileName ) ;
      end
     else  { there is no filename on begin statement }
       Panic( Fatal, 'File name missing in begin statement' ) ;
    end
   else  { the line is not a begin statement }
     Panic( Fatal, 'Expecting a begin statement' ) ;
end ;  { of ProcesBegin }

procedure CheckForStart ;
{*
 * CheckForStart - Check the line read for the keywords TABLE or BEGIN,
 *                 which indicate the start of the encoded file.
 *}
var
   KeyWord : KeyWordString ;  { Keyword from line }
begin
   if ErrorsInLine=[] then
     if Length(NextLine)>=5 then
      begin
       KeyWord:= Copy( NextLine, 1, 5 ) ;
       if Keyword='table' then
         ProcessingState:= Reading_Table
       else
         if KeyWord='begin' then
           ProcesBegin ;
      end ;  { of if/if }
end ;  { of CheckForStart }

procedure ReadConversionTable ;
{*
 * ReadConversionTable - Read the conversion table from the input file
 *                       and save it in the DecodeTable.
 *}
var
   EntryCount : Integer ;  { Number of entries in conversion table }
   I0         :    Char ;  { Loop control variable }
   I1         : Integer ;  { Loop control variable }
begin
   for I0:=' ' to Chr(255) do   { Preset conversion table .. }
     DecodeTable[I0]:= $FF ;    { with invalid entriers }

   if (ErrorsInLine<>[]) or (Length(NextLine)<>32) then
    begin
     Panic( Fatal, 'Illegal conversion table' ) ;
     Exit ;
    end ;  { of if }
   for I1:= 1 to 32 do
     DecodeTable[NextLine[I1]]:= Pred(I1) ;

   ReadNextLine ;
   if (ErrorsInLine<>[]) or (Length(NextLine)<>32) then
    begin
     Panic( Fatal, 'Illegal conversion table' ) ;
     Exit ;
    end ;  { of if }
   for I1:= 1 to 32 do
     DecodeTable[NextLine[I1]]:= Pred(I1) + 32 ;

   EntryCount:= 0 ;
   for I0:= ' ' to Chr(255) do
     if DecodeTable[I0]<>$FF then
       Inc( EntryCount ) ;
   if EntryCount<>64 then
    begin
     Panic( Fatal, 'Ambiguous conversion table' ) ;
     Exit ;
    end ;  { of if }

   ProcessingState:= Reading_Begin ;
end ;  { of ReadConversionTable }

procedure ProcesData ;
{*
 * ProcesData - Decode the (encoded) line read if the end of input
 *              is not encountered.  The end of input is signalled
 *              by the END statement.
 *}
var
   ExpectedLength : Integer ;  { Length encoded in line image }
   DeltaLength    : Integer ;  { Expected minus actual length }
   Byte1          :    Byte ;  { Decode bytes }
   Byte2          :    Byte ;
   Byte3          :    Byte ;
   I              : Integer ;  { Loop control variable }

 procedure DecodeCharacter( NextChar : Char ) ;
 {*
  * DecodeCharacter - Decode one character.
  *}
 var
    Sextet : Byte ;  { One decoded character }
 begin
    Sextet  := DecodeTable[NextChar] ;
    CheckSum:= CheckSum + Sextet ;
    if Sextet<>$FF then
      case DecodeState of
        Sextet0 : begin
                    Byte1:= Sextet shl 2 ;
                    DecodeState:= Sextet1 ;
                  end ;  { of case 0 }
        Sextet1 : begin
                    Byte1:= Byte1 + ( (Sextet shr 4) and $03 ) ;
                    Byte2:=           (Sextet shl 4) and $F0   ;
                    WriteByteToChunk( Byte1 ) ;
                    DecodeState:= Sextet2 ;
                  end ;  { of case 1 }
        Sextet2 : begin
                    Byte2:= Byte2 + (Sextet          shr 2) ;
                    Byte3:=         (Sextet and $03) shl 6  ;
                    WriteByteToChunk( Byte2 ) ;
                    DecodeState:= Sextet3 ;
                  end ;  { of case 2 }
        Sextet3 : begin
                    Byte3:= Byte3 + Sextet ;
                    WriteByteToChunk( Byte3 ) ;
                    DecodeState:= Sextet0 ;
                  end ;  { of case 3 }
      end   { of cases }
    else  { character cannot be decoded }
      ErrorsInLine:= ErrorsInLine + [IllegalCharacter] ;
 end ;  { of DecodeCharacter }

begin
{*
 * If in verbose mode, give an indication of the progres.
 *}
   if VerboseMode then
     if (LinesRead and $000F)=0 then
       Write( ^M'Line ', LinesRead ) ;
{*
 * Check if the current line contains the statement 'end'.  If so,
 * swap to the processingstate Completed.
 *}
   if Length(NextLine)=3 then
     if NextLine='end' then
      begin
       FileEpilogue ;  { Finish processing current file }
       FilePrologue ;  { Setup to convert next file }
       ProcessingState:= Completed ;
       Exit ;
      end ;  { of if }

{*
 * Extract the length of the line from the line itself: it is encoded
 * in the first character of the line.  This length should match the
 * actual length of the line.
 *}
   if ErrorsInLine=[] then
    begin
     ExpectedLength:= (DecodeTable[NextLine[1]]*4) div 3 ;
     if (ExpectedLength>=0) then
      begin
       DeltaLength:= Length(NextLine) - ExpectedLength ;
       Terminator := ' ' ;
       case LineFormat of
         Unknown : case DeltaLength of
                     1 : begin
                          LineFormat:= Basic ;
                          NextLine:= Copy( NextLine, 2, ExpectedLength ) ;
                         end ;  { of case 1 }
                     2 : begin
                          LineFormat:= Extended ;  { Either Trmntr or ChckSm }
                          Terminator:= NextLine[Length(NextLine)] ;
                          CheckSum  := -DecodeTable[Terminator] ;
                          NextLine  := Copy( NextLine, 2, ExpectedLength ) ;
                         end ;  { of case 2 }
                   else
                     ErrorsInLine:= ErrorsInLine + [WrongLength] ;
                   end ;  { of case Unknown }
         Basic   : if DeltaLength=1 then
                     NextLine:= Copy( NextLine, 2, ExpectedLength )
                   else
                     ErrorsInLine:= ErrorsInLine + [WrongLength] ;
         Extended: if DeltaLength<>2 then
                     ErrorsInLine:= ErrorsInLine + [WrongLength]
                   else
                    begin
                     Terminator:= NextLine[Length(NextLine)] ;
                     CheckSum  := -DecodeTable[Terminator] ;
                     NextLine  := Copy( NextLine, 2, ExpectedLength ) ;
                    end ;  { of case Extended }
         Trmntr  : if DeltaLength<>2 then
                     ErrorsInLine:= ErrorsInLine + [WrongLength]
                   else
                     if NextLine[Length(NextLine)]<>'M' then
                       ErrorsInLine:= ErrorsInLine + [WrongTerminator]
                     else
                       NextLine:= Copy( NextLine, 2, ExpectedLength ) ;
         ChckSm  : if DeltaLength<>2 then
                     ErrorsInLine:= ErrorsInLine + [WrongLength]
                   else
                    begin
                     Terminator:= NextLine[Length(NextLine)] ;
                     CheckSum  := -DecodeTable[Terminator] ;
                     NextLine  := Copy( NextLine, 2, ExpectedLength ) ;
                    end ;  { of case ChckSm }
       end ;  { of cases }
      end
     else  { the length field cannot be decoded }
       ErrorsInLine:= ErrorsInLine + [IllegalFormat] ;
   end ;  { of if }

{*
 * If any errors are found, the reaction will depend on the checking mode:
 * strict or relaxed.  In the latter case the line and the error(s) are
 * ignored.
 *}
   if ErrorsInLine<>[] then
    begin
     Inc( LinesSkipped ) ;
     Panic( Warning, 'Illegal format of line' ) ;
    end
   else  { there are no errors found }
{*
 * Decode the line.
 *}
    begin
     I:= 0 ;
     while (ErrorsInLine=[]) and (I<Length(NextLine)) do
      begin
       Inc( I ) ;
       DecodeCharacter( NextLine[I] ) ;
       if ErrorsInLine<>[] then
         Panic( Fatal, 'Illegal character : '+NextLine[I] ) ;
      end ;  { of while }
{*
 * if no errors are encountered while decoding the line, and the line format
 * is extended, that is it is either Trmntr or ChckSm, check both the
 * checksum and the line terminator to determine the actual line format.
 * The following table shows the decision algorithm:
 *
 *    Terminator   CheckSum   New LineFormat   Remarks
 *         = 'M'      Match         Extended   No change in line format
 *         = 'M'   No match           Trmntr
 *        <> 'M'      Match           ChckSm
 *        <> 'M'   No match                ?   Some other format ?
 *}
     CheckSum:= CheckSum and $003F ;  { Finsh checksum computation }
     if LineFormat=Extended then
       if ErrorsInLine=[] then
         if Terminator='M' then
          begin
           if CheckSum<>0 then
             LineFormat:= Trmntr
          end
         else
          begin
           if CheckSum=0 then
             LineFormat:= ChckSm
           else
             Panic( Fatal, 'Unknown line format' ) ;
          end ;  { of if/if/if }
{*
 * If the line includes a checksum, it is now the time to see if the checksum
 * is correct.
 *}
     if LineFormat=ChckSm then
       if ErrorsInLine=[] then
         if CheckSum<>0 then
           Panic( Fatal, 'Checksum error' ) ;
    end ;  { of else }
end ;  { of ProcesData }