ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/UTILITY/MISC/RSORT.ZIP/RPTAB.PAS

Pascal/Delphi Source File | 1991-08-16 | 20.6 KB | 533 lines

{$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S-,V-,X-}

program RPTab;


{-------------------------Syntax Of RPTAB ----------------------------------}

{ RPTAB input-filespec  output-filespec  [tabstop...]

 The input is a file containing tabs to be expanded.  The contents of the
 output file will be the same except that all tabs will have been expanded
 to the appropriate number of spaces.

 If you don't specify any tab stops, the default tab stops are at columns
 1, 9, 17, 25, 33 and so on at intervals of 8 columns.  If you specify tab
 stops, they must be a sequence of integers each greater than the preceding
 one.  The first tab stop is always at column 1 and you need not specify it.
 RPTAB follows the rule that the interval between the last two tab stops,
 you specify, implies subsequent tab stops at the same interval.  For
 example, the command:

    RPTAB  MYTABS.DAT  MYSPACES.DAT  6 15 27

 tells RPTAB that the tab stops are at columns 1, 6, 15, 27, 39, 51 and etc.
 The interval of 12 between 15 and 27 is propagated to subsequent tab stops.}


 {-------------- Const, Type and Variable Declarations ---------------------}

  const
    BuffSize = 32768;

  type
    TabArray = array[1..50] of Word;
    DataArray = array[0..BuffSize-1] of Char;
    DataPtr = ^DataArray;

  var
    Tab : TabArray;         {This array holds the tab stops to be used.}
    TabCt : Byte;           {Number of tab stops specified or implied.}
    IpFile, OpFile : file;
    IpPtr, OpPtr : DataPtr; {Pointers to buffers for input and output files.}
    IpNext, OpNext : Word;  {Offset of next byte in input and output buffers.}
    IpRead, OpWritten : Word; {Actual bytes read/written by each I/O request.}
    MoreData : Boolean;      {Set to False at end of input file.}
    Column : Word;          {Current column in current output line.}
    FillCt : Word;          {Spaces required to fill out tab.}


{----------------------- function GotFiles ---------------------------------}

 {Function GotFiles returns the value True if it successfully opens both the
 input and output files.  Otherwise it returns False.}

  function GotFiles(var IpFile, OpFile : file) : Boolean;
    var
      HoldIOResult : Word;

    begin

 {Must specify two or more parameters including input and output files.}
      if ParamCount < 2 then
        begin
          Writeln('Must specify an input file and an output file.');
          GotFiles := False;
          exit
        end;

 {Setting FileMode=0 tells the Reset procedure to open file as read only.}
      FileMode := 0;

      Assign(IpFile, ParamStr(1));
      Assign(OpFile, ParamStr(2));

 {If Reset fails, display error message and set function result to False.}
      Reset(IpFile, 1);
      HoldIOResult := IOResult;
      if HoldIOResult > 0 then
        begin
          case HoldIOResult of
            2 :   Writeln('Input file not found: ', ParamStr(1));
            3 :   Writeln('Invalid input file spec: ', ParamStr(1));
            else  Writeln('Unable to open input file: ', ParamStr(1));
          end;
          GotFiles := False;
          Exit
        end;

 {If Rewrite fails, display error message and set function result to False.}
      Rewrite(OpFile, 1);
      HoldIOResult := IOResult;
      if HoldIOResult > 0 then
        begin
          case HoldIOResult of
            3 :   Writeln('Invalid output file spec: ', ParamStr(2));
            else  Writeln('Unable to open output file: ', ParamStr(2));
          end;
          GotFiles := False;
          Exit
        end;

 {If both files opened successfully, return function result True.}
      GotFiles := True

    end;


 {------------------- procedure CloseDelete --------------------------------}

  procedure CloseDelete;
    begin
      Close(IpFile);
      Close(OpFile);
      Erase(OpFile)
    end;


 {--------------------- function GotTabs -----------------------------------}

 {Function GotTabs returns the value True if it successfully creates the
   array of tab stops.  Otherwise it returns False.}

  function GotTabs(var Tab : TabArray; var TabCt : Byte) : Boolean;

    var
      Temp : LongInt;
      Code : Integer;
      Start, I : Byte;
    begin


 {The default tab stops are at columns 1, 9, 17, 25 (and so on at intervals
  of eight columns).  Internally, RPTab represents these as 0, 8, 16, 24 etc.
  Since the interval between the last two explicit tab stops is propagated to
  subsequent tab stops, EXPTABS sets two tab stops at columns 0 and 8 in the
  Tab array and sets TabCT = 2.  It also sets GotTabs to True on the
  assumption that tab stops will be OK.}

      Tab[1] := 0;
      Tab[2] := 8;
      TabCt  := 2;
      GotTabs := True;


 {If ParamCount is 2 then only files were specified and no tab stops.  Thus,
  RPTAB sticks with the default tab stops set above.}

      if ParamCount = 2 then Exit;


 {If the first specified tab stop (ParamStr(3)) is a valid integer and equals
  1, then having already set the first tab stop at 1, we will start with the
  4th parameter.}

      Val(ParamStr(3), Temp, Code);
      if (Code = 0) and (Temp = 1) then
        if ParamCount > 3
          then Start := 4
          else Exit
      else Start := 3;
      TabCt := ParamCount - Start + 2;


 {Get each tab stop in turn.  Check that it is an integer between 1 and
  65535 and that it is greater than the previous tab stop.  If not, display
  an error message and return with GotTabs = False.}
 {If a tab stop is OK, decrement it by 1 and store it in the corresponding
  Tab array bucket.  I decrement it because internally I count columns
  starting with zero while externally I count them starting with one.}

      for I := 2 to TabCt do
        begin
          Val(ParamStr(Start + I - 2), Temp, Code);
          if (Code <> 0) or (Temp < 1) or (Temp > 65535) then
            begin
              Writeln('Tab stop must be integer between 1 and 65535: ',
                      ParamStr(Start + I - 2));
              GotTabs := False;
              CloseDelete;
              Exit
            end;
          if Tab[I - 1] >= (Temp - 1) then
            begin
              Writeln('Tab stop at ', Temp, ' must exceed the ',
                      'previous tab stop at ', Tab[I - 1]+1, '.');
              GotTabs := False;
              CloseDelete;
              Exit
            end;
          Tab[I] := Temp - 1
        end
    end;


 {-------------------- function  ReadOk ------------------------------------}

 {Function ReadOk returns the value True if it successfully reads from the
  input file.  Otherwise it displays an error message and returns False.}

  function ReadOK(var IpFile : file; var Buff : DataArray; BuffSize : Word;
                  var IpRead : Word) : Boolean;
    var
      HoldIOResult : Word;
    begin
      BlockRead(IpFile, Buff, BuffSize, IpRead);
      HoldIOResult := IOResult;
      if HoldIOResult <> 0 then
        begin
          Writeln('Error reading input file.');
          ReadOK := False;
          CloseDelete
        end
      else ReadOK := True
    end;


 {---------------------- function WriteOK ----------------------------------}

 {Function WriteOk returns the value True if it successfully writes to the
  output file.  Otherwise it displays an error message and returns False.}

  function WriteOK(var OpFile : file; var Buff : DataArray; WriteLen : Word;
                   var OpWritten : Word) : Boolean;
    var
      HoldIOResult : Word;
    begin
      WriteOK := True;
      BlockWrite(OpFile, Buff, WriteLen, OpWritten);
      HoldIOResult := IOResult;
      if HoldIOResult <> 0 then
        begin
          Writeln('Error writing output file.');
          CloseDelete;
          WriteOk := False
        end;
      if OpWritten <> WriteLen then
        begin
          Writeln('Ran out of space on disk writing output file.');
          CloseDelete;
          WriteOk := False
        end;
    end;


 {-------------------- procedure ExpandTabs --------------------------------}

 {The ExpandTabs procedure is really the guts of the program.  I coded it in
  assembly language for efficiency.  It scans the data in the input buffer
  and copies it to the output buffer expanding tabs as necessary.  It
  continues until it has filled up the output buffer or used the entire input
  buffer.}

  {It returns values in the four var parameters as follows:

    IpNext : The offset of the next available character in the input buffer.
             This will either be one byte beyond the end of the buffer
             implying that the entire input buffer was used or it will be
             somewhere in the middle of the buffer and thus will be the first
             byte to be processed the next time ExpandTabs is called.

    OpNext : The offset of the next available byte in the output buffer. This
             will either be one byte beyond the end of the buffer implying
             that the entire output buffer has been filled or it will be
             somewhere in the middle of the buffer and thus will be the first
             byte to be filled the next time ExpandTabs is called.

    Column : The last line moved to the output buffer will often be
             incomplete and will have to be finished the next time ExpandTabs
             is called.  Column is the offset, within that line, of the next
             character to be moved to it.  ExpandTabs will need this the next
             time around in order to correctly expand any tabs that occur
             later in the line.  Note that Column reflects the expansion of
             any earlier tabs in the line.

    FillCt:  Sometimes a tab will be found in the input buffer when there is
             very little room left in the output buffer.  If the tab expands
             to more spaces than can be accomodated in the remainder of the\
             output buffer,  the number of additional spaces required will be
             returned in FillCt.  Otherwise it will be zero.}

  procedure ExpandTabs(IpPtr, OpPtr : DataPtr; var IpNext, OpNext : Word;
                       IpLen, OpLen : Word; TabCt : Byte; Tab : TabArray;
                       var Column, FillCt : Word);
    begin
      asm
        cld
        push ds

        les   bx,FillCt     {Address of FillCt.}
        mov   cx,es:[bx]    {Value of FillCt.  If FillCt zero, then didn't}
        jcxz @GetCol        {have unfinished tab at end of last op buffer.}
        cmp   cx,OpLen      {If FillCt less than or equal OpLen.}
        jbe  @FinTab        {then fill with spaces for rest of tab.}
        mov   cx,OpLen      {Value of OpLen.}
        sub   es:[bx],cx    {Subtract fill length from FillCt.}
        les   bx,Column     {Address of Column.}
        add   es:[bx],cx    {Add fill length to Column.}
        les   di,OpPtr      {Points to output  buffer.}
        lds   bx,OpNext     {Address of OpNext.}
        add   di,ds:[bx]    {Offset of next byte in output buffer.}
        add   ds:[bx],cx    {Add fill length to OpNext.}
        mov   al,20h
        rep   stosb         {Fill with spaces.}
        jmp  @Finished

      @FinTab:
        dec   IpLen         {Decrement Iplen because tab now used.}
        mov   es:word ptr[bx],0 {Set FillCt to zero.}
        les   bx,IpNext
        inc   es:word ptr[bx] {Increment IpNext pointer past the tab.}
        les   bx,Column     {Address of Column.}
        add   es:[bx],cx    {Add fill length to Column.}
        les   di,OpPtr      {Points to output  buffer.}
        lds   bx,OpNext     {Address of OpNext.}
        add   di,ds:[bx]    {Offset of next byte in output buffer.}
        add   ds:[bx],cx    {Add fill length to OpNext.}
        sub   OpLen,cx      {Reduce OpLen by length of fill.}
        mov   al,20h
        rep   stosb         {Fill with spaces.}
        jz   @Finished      {Check zero flag from sub Oplen,cx.}
        or    bx,bx
        jz   @Finished      {Finished if IpLen = 0.}

      @GetCol:
        les   bx,Column     {Address of Column.}
        mov   cx,es:[bx]    {Value of Column.}
        lds   si,IpPtr      {Points to input  buffer.}
        les   bx,IpNext     {Address of IpNext.}
        add   si,es:[bx]    {Offset of next byte in input buffer.}
        les   bx,OpNext     {Address of OpNext.}
        mov   ax,es:[bx]    {Value of OpNext.}
        les   di,OpPtr      {Points to output buffer.}
        add   di,ax         {Offset of next byte in output buffer.}
        mov   bx,IpLen      {Length of data in input buffer.}
        mov   dx,OpLen      {Available space in output buffer.}
        mov   ah,TabCt      {Number of specified tab stops.}
        push  bp            {Save stack frame pointer.}
        lea   bp,Tab        {Offset in SS of Tab array.}

      @NextByte:
        lodsb               {Get next input byte.}
        cmp  al,0dh
        jbe  @IsItCR
      @DoReg:              {If above CR (0dh) it is a regular character.}
        inc  cx            {Increment Column.}
      @StoreOP:
        stosb              {Store character in output buffer.}
        dec  bx            {Decrement IpLen.}
        jz  @FinishUp      {We are done if IpLen is used up.}
        dec  dx            {Decrement OpLen.}
        jz  @FinishUp      {We are done if OpLen is used up.}
        jmp @NextByte      {Go and get next byte.}
      @IsItCr:
        jnz @IsItLF
        mov  cx,0          {Set Column = 0 when we find CR.}
        jmp @StoreOp
      @IsItLF:
        cmp  al,0ah
        jz  @StoreOp       {If LF, then don't change Column.}
      @IsItTab:
        cmp  al,09h
        jnz  @DoReg        {If not CR, LF or Tab it is a regular character.}

        push ax            {Save TabCt.}
        push di            {Save offset of next op byte.}
        mov  di,-2         {Index for tab array search.}
      @ScanTabs:
        inc  di
        inc  di            {Point to next tab stop in Tab array.}
        cmp  cx,[bp+di]    {Compare Column to tab stop.}
        jb   @FoundTab     {The first tab stop greater than Column is the}
                           {tab stop we want to space out to.}
        dec  ah            {Decrement TabCt.}
        jnz  @ScanTabs     {If more tabs in table, continue scan.}

 {Column is beyond the last tab in the Tab array, so we must propagate the
  interval between the last two explicit tab stops to find the tab stop to
  space out to.  To do this we compute:

  1. Column MINUS NextToLastTabStop
  2. LastTabStop MINUS NextToLastTabStop
  3. The result of line 1 MOD the result of line 2
  4. The result of line 2 MINUS the result of line 3

  If the interval from NextToLastStop to Column (line 1) was an exact
  multiple of the interval from the NextToLastTabStop to the LastTabStop
  (line 2) then clearly Column would fall on one of the propagated tab stops.
  In this case we would want to tab to the next tab stop or the full interval
  between two tab stops.  Since the MOD (line3) would be zero, in this case,
  line 4 will produce the correct result for the number of spaces.  In any
  other case, the MOD will not be zero and we will tab less than the full
  interval to the next tab stop as we should.}

        push dx            {Save OpLen.}
        mov  ax,[bp+di-2]  {Next to last tab stop in Tab array.}
        mov  di,[bp+di]    {Last tab stop in Tab array.}
        sub  di,ax         {Difference between last two tab stops.}
        sub  ax,cx         {Next to last tab stop - Column.}
        neg  ax            {Column - next to last tab stop.}
        xor  dx,dx         {High word of zero.}
        div  di            {dx=((Column-NextLast) mod (Last-NextLast))}
        sub  di,dx         {di = Number of spaces required for tab.}
        mov  ax,di
        pop  dx            {Retrieve OpLen.}
        add  di,cx         {Add Column to number of spaces for tab.}
        jnc @DoSpaces      {If no carry, then doesn't go beyond 65535.}
        sub  ax,di         {Subtract length beyond 65535 from # of spaces.}
        jmp @DoSpaces      {If ax=0 because cx=65535, @DoSpaces works right.}
      @FoundTab:
        mov  ax,[bp+di]    {Tab stop to space out to.}
        sub  ax,cx         {Spaces required = tab stop - Column.}

      @DoSpaces:
        pop  di            {Restore offset of next output byte.}
        cmp  ax,dx         {Compare spaces required to OpLen.}
        ja  @SpaceBeyond
        xchg ax,cx         {ax = Column, cx = spaces required.}
        add  ax,cx         {ax = adjusted Column.}
        sub  dx,cx         {dx = adjusted OpLen.}
        push ax            {Save Column.}
        mov  al,20h
        rep  stosb         {Store spaces.}
        pop  cx            {Restore Column.}
        pop  ax            {Restore TabCt.}
        jz  @FinishUp      {Jump if OpLen reduced to zero.}
        dec  bx            {Decrement IpLen.}
        jz  @FinishUp      {We are done if IpLen is used up.}
        jmp @NextByte      {Else go and get next ip byte.}


 {This routine is executed if the number of spaces for the tab would carry
  beyond the end of the output buffer.  In this case, I fill as many spaces
  as possible and then set FillCt to the number of spaces needed to finish
  the tab before returning.}

      @SpaceBeyond:
        dec  si            {Point back to tab.}
        sub  ax,dx         {Value for FillCt.}
        add  cx,dx         {Adjust Column for OpLen.}
        push ax            {Save FillCt.}
        push cx            {Save Column.}
        mov  cx,dx         {cx = OpLen.}
        mov  al,20h
        rep  stosb         {Store spaces.}
        pop  cx            {Restore Column.}
        pop  dx            {Restore FillCt.}
        pop  ax            {Restore TabCt.}
        pop  bp            {Restore stack frame pointer.}
        les  bx,FillCt
        mov  es:[bx],dx    {Set FillCt to remaining spaces for tab.}
        jmp @FinishUp1

      @FinishUp:
        pop  bp            {Restore stack frame pointer}
      @FinishUp1:
        les  bx,Column
        mov  es:[bx],cx    {Update Column}
      @FinishUp2:
        les  bx,IpPtr      {Points to input buffer}
        sub  si,bx         {New value of IpNext}
        les  bx,IpNext     {Address of IpNext}
        mov  es:[bx],si    {Update IpNext.}
        les  bx,OpPtr      {Points to output buffer}
        sub  di,bx         {New value of OpNext}
        les  bx,OpNext     {Address of OpNext}
        mov  es:[bx],di
      @Finished:
        pop  ds
      end
    end;


 {------------------- Main program block -----------------------------------}

  begin
    Writeln; {Leave a blank line before completion or error message}


 {If unable to open the files or to create the table of tab stops, I halt
  since the error message would have been displayed by the called routine.}

    if not GotFiles(IpFile, OpFile) then Halt;
    if not GotTabs(Tab, Tabct) then Halt;

    New(IpPtr); {Get 32K buffers for input and output. Reading and writing}
    New(OpPtr); {32K at a time is more efficient than a line at a time.}

    OpNext := 0; {Start at position zero of output buffer.}
    Column := 0; {Start at position zero of the first line.}
    FillCT := 0; {Indicate no tab to be finished from previous time.}

    repeat {Repeat until entire input file has been read and processed.}

      IpNext := 0; {Reading new input, so start position in buffer is zero.}


      {Read 32K (BuffSize) into the input buffer.  If read is nogood, halt.}
      if not ReadOK(IpFile, IpPtr^, BuffSize, IpRead) then Halt;

      {If read full buffer then MoreData is True, else False.}
      MoreData := IpRead = BuffSize;


      repeat {Repeat until all data in the input buffer has been copied to
              the output buffer with tabs expanded.}

       {ExpandTabs copies input data to output buffer with tabs expanded
        until output buffer is full or entire input buffer has been used.}

        ExpandTabs(IpPtr, OpPtr, IpNext, OpNext, IpRead-IpNext,
                   BuffSize-OpNext, TabCt, Tab, Column, FillCt);

        {If output buffer full, write it to the output file.}
        if OpNext = BuffSize then
          begin
            if not WriteOK(OpFile, OpPtr^, BuffSize, OpWritten) then Halt;
            OpNext := 0
          end

      until IpNext = IpRead;

    until not MoreData;

    {If have partial unwritten output buffer, at end, then write it.}
    if OpNext <> 0 then
      if not WriteOK(OpFile, OpPtr^, OpNext, OpWritten) then Halt;

    Close(IpFile);
    Close(OpFile);
    Writeln('Tab expansion completed.')
  end.