CD Actual 14/CDACTUAL.iso/cdactual/demobin/share/program/asm/RPSRT102.ZIP/RPTAB.PAS

Pascal/Delphi Source File | 1991-10-02 | 30.4 KB | 677 lines

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

program RPTab;

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

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

 The two filespecs are required parameters while the /T and tabstops are
 optional.  The parameters must be entered in the sequence indicated above.

 The input file is a text file that may or may not contain tabs.  The
 contents of the output file will be the same except that:

 . If /T is NOT specified, any tabs in the input will be expanded to the
   appropriate number of spaces in the output file.

 . If /T is specified,  spaces in the input file will be contracted to tabs
   in the output file, wherever possible.

 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;
    StartFiles : Byte = 1;
    StartTabs  : Byte = 3;
    Contract   : Boolean = False;
  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.}
    SpaceCt : Word;         {Spaces at end of input buffer.}

{----------------------- 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; Start : Byte) : Boolean;
    var
      HoldIOResult : Word;
    begin
    {Must have enough parameters to include both input and output filespecs.}
      if ParamCount < (Start + 1) 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(Start));
      Assign(OpFile, ParamStr(Start+1));
    {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(Start));
            3 :   Writeln('Invalid input file spec: ', ParamStr(Start));
            else  Writeln('Unable to open input file: ', ParamStr(Start));
          end;
          GotFiles := False;
          Exit
        end;
    {If Rewrite fails, display error message, 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(Start+1));
            else  Writeln('Unable to open output file: ', ParamStr(Start+1));
          end;
          GotFiles := False;
          Exit
        end;
    {If both files opened successfully, return function result True.}
      GotFiles := True
    end; {GotFiles}

 {------------------- 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; Start:Byte) : Boolean;
    var
      Temp : LongInt;
      Code : Integer;
      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 less than Start, no tab stops were specified.  Thus,
     RPTAB sticks with the default tab stops set above.}
      if ParamCount < Start then Exit;
    {If the first specified tab stop (ParamStr(Start)) is a valid integer and
     equals 1, then having already set the first tab stop at 1, we will
     increment Start.}
      Val(ParamStr(Start), Temp, Code);
      if (Code = 0) and (Temp = 1) then
        if ParamCount > Start
          then Start := Start + 1
          else Exit; {Exit if the only tab stop specified is 1.}
      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 > 32767) then
            begin
              Writeln('Tab stop must be integer between 1 and 32767: ',
                      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;
          if ((Temp - 1) - Tab[I - 1]) > 255 then
            begin
              Writeln('Tab stop at ', Temp, ' must not exceed ',
                      'previous tab stop at ', Tab[I - 1]+1,
                      ' by more than 255.');
              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;

 {-------------------- function ExpandTabs --------------------------------
  I coded ExpandTabs in assembly language for efficiency.  It scans the data
  in the input buffer and copies it to the output buffer expanding tabs as
  required.  It continues until it has filled up the output buffer or used
  the entire input buffer.  Values are returned in the four var parameters as
  follows:
    IpNext : The offset of the next byte in the input buffer.  If this is
             at buffer end, the entire buffer was used.  Else, it will be the
             first byte used the next time  ExpandTabs is called.
    OpNext : The offset of the next byte in the output buffer.  If this is
             at buffer end, the entire buffer was filled.  Else, it will be
             the first byte to be filled the next time ExpandTabs is called.
    Column : The last line in the output buffer will often be incomplete.
             Column is the offset, within that line, of the next byte to be
             moved to it.  ExpandTabs will use this, the next time, to
             correctly expand any subsequent tabs in the line.  Column
             reflects the expansion of any earlier tabs in the line.
    FillCt:  If a tab, in the input buffer, expands to more spaces than can
             be held in the remainder of the output buffer,  the number of
             additional spaces, required, is returned in FillCt.
  Also, the result False is returned if a line longer than 32767 bytes is
  found otherwise the result True is returned.}
  function ExpandTabs(IpPtr, OpPtr : DataPtr; var IpNext, OpNext : Word;
                       IpLen, OpLen : Word; TabCt : Byte; Tab : TabArray;
                       var Column, FillCt : Word) : Boolean;
    begin
      asm
        cld
        mov  @Result,1      {Assume no long lines.}
        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.}
        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.}
        mov   bx,IpLen
        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.}
        js  @LongLine2     {Jump if line exceeds 32767 bytes.}
      @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.}
        jnz @NextByte      {If more room in op buffer, go and get next byte.}
        jmp @FinishUp      {We are done if OpLen is used up.}
      @IsItCr:
        jnz @IsItLF
        xor  cx,cx         {Set Column = 0 when we find CR.}
        jmp @StoreOp
      @LongLine:
        add  sp,4          {Clear TabCt and output pointer from stack.}
      @LongLine2:
        pop  bp            {Retore stack frame pointer.}
        mov @Result,0      {If line exceeds 32767 bytes, set Result NG.}
        jmp @Finished
      @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         {di = value for column at next tab stop.}
        jns @DoSpaces
        jmp @LongLine      {Jump if line exceeds 32767 bytes.}
      @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; {ExpandTabs}

 {-------------------- function ContractSpaces -----------------------------
  I coded ContractSpaces in assembly language for efficiency.  It scans the
  data in the input buffer and copies it to the output buffer contracting
  spaces where possible.  It continues until it has filled up the output
  buffer or used the entire input buffer.  Values are returned in the four
  var parameters as follows:
    IpNext : The offset of the next byte in the input buffer.  If this is
             at buffer end, the entire buffer was used.  Else, it will be the
             first byte used the next time  ExpandTabs is called.
    OpNext : The offset of the next byte in the output buffer.  If this is
             at buffer end, the entire buffer was filled.  Else, it will be
             the first byte to be filled the next time ExpandTabs is called.
    Column : The last line in the input buffer will often be incomplete.
             Column is the offset, within that line, of the next byte.
             ContractSpaces will use this, the next time, to correctly
             contract any subsequent spaces in the line.  If the line
             contained any tabs, Column reflects the position in the line as
             if the tabs had been expanded.
    SpaceCt: If there are one or more spaces at the end of an input buffer
             and if the next position after the end of the input buffer is
             not a tab stop, the count of these spaces is returned in
             SpaceCt.
  Also, the result False is returned if a line longer than 32767 bytes is
  found otherwise the result True is returned.}
  function ContractSpaces(IpPtr, OpPtr : DataPtr; var IpNext, OpNext : Word;
                       IpLen, OpLen : Word; TabCt : Byte; Tab : TabArray;
                       var Column, SpaceCt : Word) : Boolean;
    var
      PrevTab : Word;
    begin
      asm
        cld
        mov  @Result,1      {Assume no long lines.}
        mov   PrevTab,0
        push  ds
        les   bx,SpaceCt    {Address of SpaceCt.}
        mov   dx,es:[bx]    {Value of SpaceCt.}
        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.}
      @NextByte:
        lodsb               {Get next input byte.}
        dec   IpLen
        cmp   al,20h
        je   @DoSpace
        cmp   al,09h
        je   @DoTab
        or    dx,dx         {Is SpaceCt equal to zero.}
        jz   @StoreOp       {If not then jump else store spaces.}
        mov   ah,al         {Hold ip character.}
        mov   al,20h
        mov   bx,cx         {Hold Column.}
        cmp   dx,OpLen
        jb   @StoreSpaces   {Jump if SpaceCt < OpLen.}
        dec   si            {Point back to ip character.}
        mov   cx,OpLen
        sub   dx,cx         {Subtract OpLen from SpaceCt.}
        rep stosb           {Store OpLen spaces.}
        mov   cx,bx         {Recover Column.}
        jmp  @FinishUp
      @StoreSpaces:
        mov   cx,dx         {SpaceCt.}
        sub   OpLen,dx      {Adjust remaining OpLen for spaces.}
        rep stosb           {Store SpaceCt spaces.}
        mov   cx,bx         {Recover Column.}
        mov   al,ah         {Recover ip character.}
        xor   dx,dx         {SpaceCt = 0.}
      @StoreOp:
        stosb               {Store character in output buffer.}
        dec   OpLen
        cmp   al,0ah
        jz   @CheckDone     {Jump if character is linefeed.}
        cmp   al,0dh
        jnz  @StoreOp2
        xor   cx,cx         {If carriage return, Column is set to zero.}
        mov   PrevTab,0
        jmp  @CheckDone
      @StoreOp2:
        inc   cx            {Increment Column}
        js   @LongLine      {Jump if line exceeds 32767 bytes.}
      @CheckDone:
        cmp   IpLen,0
        jz   @FinishUp      {We are done if IpLen is used up.}
        Cmp   OpLen,0
        jz   @FinishUp      {We are done if OpLen is used up.}
        jmp  @NextByte
      @DoTab:
        inc   cx            {Increment Column.}
        js   @LongLine      {Jump if line exceeds 32767 bytes.}
        call @GetNextStop
        mov   PrevTab,ax
        mov   cx,ax         {Set Column equal to next tab stop.}
      @StoreTab:
        mov   al,09h
        stosb               {Store the tab or space.}
        dec   OpLen
        xor   dx,dx         {Set SpaceCt to zero.}
        jmp  @CheckDone
      @DoSpace:
        inc   dx            {Increment SpaceCt.}
        inc   cx            {Increment Column.}
        js   @LongLine      {Jump if line exceeds 32767 bytes.}
        cmp   cx,PrevTab    {Compare Column to prev tab stop.}
        jb   @CheckDone     {If before tab stop, not yet time to store tab.}
        je   @StoreTab      {If at tab stop, then store tab.}
        call @GetNextStop
        mov   PrevTab,ax
        cmp   cx,ax         {Compare Column to next tab stop.}
        je   @StoreTab      {If at tab stop, then store tab.}
        jmp  @CheckDone     {Else not yet time to store tab.}
      @LongLine:
        mov  @Result,0      {If line exceeds 32767 bytes, set result NG.}
        jmp  @Finished
      @GetNextStop:
        lea   bx,Tab-2      {Index for tab array search.}
        mov   ah,Tabct
      @ScanTabs:
        inc   bx
        inc   bx            {Point to next tab stop in Tab array.}
        cmp   cx,ss:[bx]    {Compare Column to tab stop.}
        jbe  @FoundTab      {We want the first tab stop GE Column.}
        dec   ah            {Decrement TabCt.}
        jnz  @ScanTabs      {If more tabs in table, continue scan.}
        push  dx            {Save SpaceCt.}
        mov   ax,ss:[bx-2]  {Next to last tab stop in Tab array.}
        mov   bx,ss:[bx]    {Last tab stop in Tab array.}
        sub   bx,ax         {Difference between last two tab stops.}
        sub   ax,cx         {Next to last tab stop - Column.}
        not   ax            {Column - next to last tab stop.}
        xor   dx,dx         {High word of zero.}
        div   bx            {dx=((Column-NextLast) mod (Last-NextLast))}
        sub   bx,dx         {bx = Number of spaces required for tab.}
        mov   ax,bx
        add   ax,cx         {NextTabStop = Number of spaces plus Column.}
        dec   ax
        pop   dx            {Retrieve SpaceCt.}
        jns  @ScanTabsRet
        mov   ax,32767      {Never return a tab stop greater than 32767.}
      @ScanTabsRet:
        ret
      @FoundTab:
        mov  ax,ss:[bx]    {Next tab stop.}
        ret
      @FinishUp:
        les  bx,SpaceCt
        mov  es:[bx],dx
        les  bx,Column
        mov  es:[bx],cx    {Update Column}
        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; {ContractSpaces}

 {-------------- procedure LongLineMsgAndHalt ------------------------------
  This procedure displays an error message to the effect that a line exceeded
  32767 bytes.  It then calls the CloseDelete procedure which closes the
  files and deletes the output file.  Finally it executes Halt.}
  procedure LongLineMsgAndHalt;
    begin
      Write('Error: Input line exceeds 32767 bytes.  ');
      Writeln('Input is probably not a text file.');
      CloseDelete;
      Halt
    end;

 {------------------- Main program block -----------------------------------}
  begin
    Writeln; {Leave a blank line before completion or error message}
  {If /T is specified, then we will contract spaces to tabs.}
    if (ParamCount >= 1) and
       ((ParamStr(1) = '/T') or (ParamStr(1) = '/t')) then
      begin
        Contract   := True;
        StartFiles := 2;  {Input file parameter must be ParamStr(2).}
        StartTabs  := 4   {First tab stop parameter must be ParamStr(4).}
      end;
  {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, StartFiles) then Halt;
    if not GotTabs(Tab, Tabct, StartTabs) then Halt;
  {Get 32K buffers for input and output. Reading and writing 32K at a time is
   more efficient than a line at a time.}
    New(IpPtr);
    New(OpPtr);
    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.}
    SpaceCt := 0; {Indicate no spaces unused from previous time.}
  {Repeat until entire input file has been read and processed.}
    repeat
      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 until all data in the input buffer has been copied to the output
   buffer with tabs expanded.}
      repeat
  {ContractSpaces copies input to output buffer with spaces contracted until
   output buffer is full or entire input buffer has been used.
   ExpandTabs copies input output buffer with tabs expanded until output
   buffer is full or entire input buffer has been used.
   The if statement, below, takes advantage of Turbo Pascal's short circuit
   Boolean evaluation which proceeds left to right and stops as soon as the
   result of an expression is known.  This means that the boolean function
   ContractSpaces is only executed if Contract is True.  If ContractSpaces
   is successful, it returns a True value and the null "then" clause is
   executed.  If it fails (only possible error is too long a line), then
   the entire expression is False since "not Contract" in the second half of
   the expression is False.  This means that the "else" clause will be
   executed.  If Contract is False, we do ExpandTabs and the explanation is
   similar.}
        if  (Contract and
             ContractSpaces(IpPtr, OpPtr, IpNext, OpNext, IpRead-IpNext,
                            BuffSize-OpNext, TabCt, Tab, Column, SpaceCt))
         or (not Contract and
             ExpandTabs(IpPtr, OpPtr, IpNext, OpNext, IpRead-IpNext,
                        BuffSize-OpNext, TabCt, Tab, Column, FillCt)) then
        else
          LongLineMsgAndHalt;
  {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;
  {If input file ended with one or more trailing spaces, write them to the
   output file.}
    while Contract and (SpaceCt <> 0) do
      begin
        if SpaceCt > BuffSize then OpNext := BuffSize else OpNext := SpaceCt;
        SpaceCt := SpaceCt - OpNext;
        FillChar(OpPtr^, OpNext, Chr(32));
        if not WriteOK(OpFile, OpPtr^, OpNext, OpWritten) then Halt
      end;
    Close(IpFile);
    Close(OpFile);
    if Contract then
      Writeln('Contraction of spaces to tabs completed.')
    else
      Writeln('Tab expansion completed.')
  end. {Main program block.}