{ -------------------------------------------------------------	}
{ This UNIT defines CONSTs, TYPEs, PROCEDUREs and FUNCTIONs of  }
{ general utility to the program.  It also enables a Heap Error }
{ Function which causes the Heap Manager to return NIL if any   }
{ Heap Allocation Request (NEW or GETMEM) finds insufficient    }
{ Heap Space to satisfy the request.  Two variables are defined }
{ which allow tracking of Heap utilization to be performed by a }
{ using program.  There is very little in this unit that is     }
{ specific to ".TPU" files per-se.				}
{ ------------------------------------------------------------- }

Unit TWU1EQU;

(*****************)
(**) INTERFACE (**)	Uses Dos;
(*****************)

Const
	_FilNamLen = SizeOf(Dos.NameStr)+SizeOf(Dos.ExtStr)-2;
        _FilDirLen = SizeOf(Dos.DirStr)-1+_FilNamLen;

Type
	_FileSpec = String[_FilNamLen];	{ Max Size of Name.Extension   }
        _FileXpnd = String[_FilDirLen];	{ Max Size of above plus Path  }
  	_StrByte  = String[2];		{ String for Hex Byte Display  }
	_StrWord  = String[4];          { String for Hex Word Display  }
        _StrAddr  = String[5];		{ String for Hex Addr Display  }
	_DateStr  = String[10];		{ String for Date/Time Display }

        _Paragraph= Array[0..15] of Byte;	{ 8086 Paragraph Size  }
	_Compare  = Function(VAR A,B):Boolean;  { QuickSort Calls This }


Var     _HeapHighWaterMark,		{ Max Heap Utilization Pointer }
	_HeapOriginalMark : Pointer;	{ Min Heap Utilization Pointer }

Function  PtrDelta(P,Q: Pointer): LongInt;	{ Pointer Differential }
Function  HexB(Arg:Byte): _StrByte;		{ Byte to Hex String   }
Function  HexW(Arg:Word): _StrWord;		{ Word to Hex String   }
Function  HexA(Arg:LongInt): _StrAddr;          { Addr to Hex String   }
Function  FormatDate(Date: Word): _DateStr;     { Date Stamp to String }
Function  FormatTime(Time: Word): _DateStr;     { Time Stamp to String }

Procedure QuickSort(V: Pointer;			{ To Array of Records }
		    Cnt: Word;			{ Record Count	      }
		    Len: Word;			{ Record Length       }
		 ALessB: _Compare);		{ Compare Function    }

Procedure TrimString(VAR S: String);	{ Removes Trailing Blanks }

function LoWord(A: LongInt): Word;
inline(
  $58/    { POP AX }
  $5A);   { POP DX }

function HiWord(A: LongInt): Word;
inline(
  $5A/    { POP DX }
  $58);   { POP AX }

function LoByte(A: Word): Byte;
inline(
  $5A/       { POP AX    }
  $32/$E4);  { XOR AH,AH }

function HiByte(A: Word): Byte;
inline(
  $5A/       { POP AX    }
  $8A/$C4/   { MOV AL,AH }
  $32/$E4);  { XOR AH,AH }

Function PtrAdjust(A: Pointer; I: Word):Pointer;
INLINE( $5A/			{ POP DX	;I		}
	$58/			{ POP AX	;Ofs(A^)	}
        $03/$C2/		{ ADD AX,DX	;Ofs(A^)+I	}
        $5A);			{ POP DX	;Seg(A^)	}

(**********************)
(**) IMPLEMENTATION (**)
(**********************)

  { Procedure Below Removes Trailing Blanks from a String }	{.CP27}

Procedure TrimString(VAR S: String);
{ begin while	(Length(S)>0) AND (S[Length(S)]=' ') Do
		Delete(S,Length(s),1) end }
ASSEMBLER; {$S-}
ASM                 
        LES	DI,S			{ Get String Pointer	}
        MOV	CX,ES			{ Get Segment Value	}
        CMP	CX,DI			{ Check for Nil Pointer	}
        JNZ	@RUN			{ Don't Match-Not Nil	}
        JCXZ	@SKIP			{ Nil if Selector zero	}
  @RUN:
	XOR	CX,CX			{ Clean-Up CX		}
        MOV	CL,ES:[DI]		{ Fetch String Length	}
        JCXZ	@SKIP			{ Exit if Null String	}
        STD				{ Set RTL Direction	}
        MOV	DX,DI			{ Save String Offset	}
        MOV	AL,' '			{ Load Blank Comparand	}
        ADD	DI,CX			{ Point to String End	}
   REPZ SCASB				{ Scan for Non-Blank	}
  	JZ	@NONE			{ NONE FOUND		}
        INC	CX			{ Repair CX		}
  @NONE:
  	MOV	DI,DX			{ Point to String	}
        MOV	ES:[DI],CL		{ Save New Length Byte	}
  @SKIP:
END;		{$S+}

  { Function Below Computes the SIGNED Difference between the }	{.CP36}
  { EFFECTIVE Values of two pointers, P and Q.  The result is }
  { negative if P^ < Q^, non-negative otherwise.	      }

Function PtrDelta(P, Q: Pointer): LongInt;	{ Pointer Differential }
(* --------------------- Equivalent Pascal Code
Var Lp, Lq : LongInt;
Begin
   Lp := LongInt(Seg(P^)) SHL 4 + Ofs(P^);	{ Convert P to LongInt }
   Lq := LongInt(Seg(Q^)) SHL 4 + Ofs(Q^);	{ Convert Q to LongInt }
   PtrDelta := Lp - Lq;				{ Return Difference    }
*)
ASSEMBLER; {$S-}
ASM
	MOV	CL,04h			{ Set Shift Amount 		}
        XOR	DH,DH			{ Zero DH			}
        LES	DI,[DWORD PTR P]	{ Fetch P to ES:DI		}
        MOV	AX,ES			{ AX = Seg(P^)			}
        MOV	DL,AH			{ Copy Hi Byte to DL		}
        SHR	DL,CL			{ Align Hi Bits in DL		}
        SHL	AX,CL			{ Align Lo Bits in AX		}
        ADD	DI,AX			{ Lo Order Sum in DI		}
        ADC	DX,0			{ Hi Order Sum in DX		}
        				{ DX:DI = LongInt(P^)		}
        XOR	BH,BH
        LES	SI,[DWORD PTR Q]	{ Fetch Q to ES:SI		}
        MOV	AX,ES			{ AX = Seg(Q^)			}
        MOV	BL,AH			{ Copy Hi Byte to BL		}
        SHR	BL,CL			{ Align Hi Bits in BL		}
        SHL	AX,CL			{ Align Lo Bits in AX		}
        ADD	SI,AX			{ Lo Order Sum in SI		}
        ADC	BX,0			{ Hi Order Sum in BX		}
        MOV	AX,DI			{ AX = LO(LongInt(P^))		}
        SUB	AX,SI			{ AX = Lo Difference		}
        SBB	DX,BX			{ DX = Hi Difference		}
End; {PtrDelta}  	{$S+}

  { Function Below Formats Directory Time-Stamp for Display }	{.CP44}

Function FormatTime(Time : Word): _DateStr;
VAR Ww: _DateStr;
BEGIN
     ASM	{ Emit Tight Fast Code  }
        CLD     			{ Clear Direction Flag	}
     	MOV	AX,SS			{ Load String Segment	}
        MOV	ES,AX
	LEA	DI,[BYTE PTR Ww]	{ Load String Offset	}
        MOV	AL,8			{ String Length = 8	}
        STOSB
	MOV	DX,'00'			{ Load ASCII Zero Zones	}

	MOV	AX,Time			{ Fetch Time		}
	MOV	CL,11			{ Set Shift Bit Count	}
	SHR	AX,CL			{ Align Hours		}
        CALL	@Emit			{ Encode and Store it	}
	MOV	AL,':'			{ Insert : after Hours	}
        STOSB

	MOV	AX,Time			{ Fetch Time		}
	MOV	CL,5			{ Set Shift Bit Count	}
	SHR	AX,CL			{ Align Minutes		}
	AND	AL,3Fh			{ Extract Minutes	}
        CALL	@Emit			{ Encode and Store it	}
	MOV	AL,':'			{ Insert : after Minutes}
        STOSB

	MOV	AL,[Byte Ptr Time]	{ Fetch Low Time Byte	}
	AND	AL,1Fh			{ Extract Seconds / 2	}
	SHL	AL,1			{ Convert to Seconds	}
	CALL	@Emit			{ Encode and Store it	}
        JMP	@Exit			{ Skip Around Proc	}
     @Emit:
	AAM				{ Convert AL to Decimal	}
	XCHG	AH,AL			{ Swap Resulting Digits }
	OR	AX,DX			{ Add ASCII Zones	}
	STOSW				{ Store String Result	}
        RETN				{ Return to caller	}
     @Exit:
     End;
        FormatTime := Ww;
END; {FormatTime}

  { Function Below Formats Directory Date-Stamp for Display }	{.CP49}

Function FormatDate(Date : Word): _DateStr;
VAR Ww: _DateStr;
BEGIN
     ASM	{ Emit Tight Fast Code  }
        CLD     			{ Clear Direction Flag	}
     	MOV	AX,SS			{ Load String Segment	}
        MOV	ES,AX
	LEA	DI,[BYTE PTR Ww]	{ Load String Offset	}
        MOV	AL,10			{ String Length = 10	}
        STOSB
	MOV	DX,'00'			{ Load ASCII Zero Zones	}

	MOV	AX,Date			{ Fetch Date		}
	MOV	CL,5			{ Set Shift Bit Count	}
	SHR	AX,CL			{ Align Month		}
	AND	AL,0Fh  		{ Extract Month		}
        CALL	@Emit			{ Encode and Store it	}
	MOV	AL,'/'			{ Insert / after Month	}
        STOSB

	MOV	AL,[Byte Ptr Date]	{ Fetch Date		}
	AND	AL,1Fh			{ Extract Day of Month	}
        CALL	@Emit			{ Encode and Store it	}
	MOV	AL,'/'			{ Insert / after Day	}
        STOSB

	MOV	CL,9			{ Set Shift Bit Count	}
	MOV	AX,Date			{ Fetch Date		}
	SHR	AX,CL			{ Align Year Bits	}
	ADD	AX,1980			{ Add 1980		}
	MOV	BL,100  		{ Set up Divisor	}
	DIV	BL			{ AH= Year, AL= Century	}
	MOV	BL,AH			{ Save Year Byte	}
        CALL	@Emit			{ Encode and Store Cent }
	MOV	AX,BX			{ Fetch Year Byte	}
	CALL	@Emit			{ Encode and Store Year	}
        JMP	@Exit			{ Skip Around Proc	}
     @Emit:
	AAM				{ Convert AL to Decimal	}
	XCHG	AH,AL			{ Swap Resulting Digits }
	OR	AX,DX			{ Add ASCII Zones	}
	STOSW				{ Store String Result	}
        RETN				{ Return to caller	}
     @Exit:
     End;
        FormatDate := Ww;
END; {FormatDate}

  { Function Below Converts a byte to Printable Hex }		{.CP22}
(*
	FUNCTION HexB(Arg:byte): _StrByte;
	CONST HexTab : ARRAY[0..15] OF Char = '0123456789ABCDEF';
	BEGIN HexB := HexTab[Arg SHR 4] + HexTab[Arg AND $F] END;
*)
{$S-} FUNCTION HexB(Arg:byte): _StrByte; ASSEMBLER;
CONST HexTab : ARRAY[0..15] OF Char = '0123456789ABCDEF';
ASM
	LES	DI,@RESULT	{ Point to Function Result  }
	MOV	AX,2		{ Get Result String Length  }
	STOSB			{ Store in Result String    }
	LEA	BX,HexTab	{ Point to Translate Table  }
	MOV	AL,Arg		{ Fetch Argument Byte	    }
	MOV	CL,4		{ Set Shift Counter	    }
	SHL	AX,CL		{ Put Hi Nibble in AH	    }
	SHR	AL,CL		{ Put Lo Nibble	in AL	    }
	XLAT			{ Translate Lo Nibble	    }
	XCHG	AH,AL		{ Swap Hi and Lo Nibbles    }
	XLAT			{ Translate Hi Nibble	    }
	STOSW			{ Emit Translated Nibbles   }
END;	{HexB}{$S+}

  { Function Below Converts a Word to Printable Hex }		{.CP04}

FUNCTION HexW(Arg:Word): _StrWord;
BEGIN HexW := HexB(HI(Arg)) + HexB(LO(Arg)) END;

  { Function Below Converts a Addr to Printable Hex }		{.CP08}

FUNCTION HexA(Arg:LongInt): _StrAddr;
Var PreFix : _StrByte;
BEGIN
   PreFix := HexB(LoByte(HiWord(Arg)));
   HexA   := PreFix[2] + HexW(LoWord(Arg))
END;


  { Heap Error Function Returns NIL if Allocation Fails }	{.CP11}

Function HeapErrorProc(Arg : Word): Integer; FAR;
Begin
	If Arg = 0 Then		{ Heap Pointer Being Raised   }

        If PtrDelta(System.HeapPtr,_HeapHighWaterMark) > 0
	Then _HeapHighWaterMark := System.HeapPtr;

        HeapErrorProc := 1;     { Allow NIL Return by HeapMgr }
End;   {HeapErrorProc}

{ --------------------------------------------------------------- }
{ QuickSort Algorithm by C.A.R. Hoare.  Non-Recursive adaptation  }
{ from "ALGORITHMS + DATA STRUCTURES = PROGRAMS" by Niklaus Wirth }
{ Prentice-Hall, 1976.	Generalized for untyped arguments.	  }
{ --------------------------------------------------------------- }

Procedure QuickSort(V: Pointer;		{ To Array of Records }
		    Cnt: Word;		{ Record Count	      }
		    Len: Word;		{ Record Length       }
		 ALessB: _Compare);	{ Compare Function    }

Type	SortRec  = Record Lt, Rt: Integer End;
	SortStak = Array[0..1] of SortRec;

Var StkT, StkM, Ki, Kj, M: Word; Rt, Lt, I, J: Integer;
    Ps: ^SortStak; Pw, Px: Pointer;

    Procedure Push(Left, Right: Integer);
    Begin Ps^[StkT].Lt := Left; Ps^[StkT].Rt := Right; Inc(StkT); End;

    Procedure Pop(VAR Left, Right: Integer);
    Begin Dec(StkT); Left := Ps^[StkT].Lt; Right := Ps^[StkT].Rt; End;

Begin {QSort}
   If (Cnt > 1) AND (V <> Nil) Then
   Begin
      StkT := Cnt - 1;				{ Record Count - 1 }
      Lt := 1;                                  { Safety Valve	   }

      { We need a stack of Log2(n-1) entries plus 1 spare for safety }

      Repeat StkT := StkT SHR 1; Inc(Lt); Until StkT = 0; { 1+Log2(n-1) }

      StkM := Lt * SizeOf(SortRec) + Len + Len;	{ Stack Size + 2 records }

      GetMem(Ps,StkM);			{ Allocate Memory    }

      If Ps = Nil Then RunError(215);	{ Catastrophic Error }

      Pw := @Ps^[Lt];			{ Swap Area Pointer  }
      Px := Ptr(Seg(Pw^),Ofs(Pw^)+Len);	{ Hold Area Pointer  }

      Lt := 0; Rt := Cnt - 1;		{ Initial Partition  }
      Push(Lt,Rt);			{ Push Entire Table  }

      WHILE StkT > 0 Do Begin		{ QuickSort Main Loop }
         Pop(Lt,Rt);			{ Get Next Partition  }
         Repeat
            I := Lt; J := Rt;		{ Set Work Pointers }

            { Save Record at Partition Mid-Point in Hold Area }

            M := (LongInt(Lt) + Rt) DIV 2;
            Move(Ptr(Seg(V^),Ofs(V^)+ M * Len)^,Px^,Len);

            { Get Useful Offsets to speed loops }

            Ki := I * Len + Ofs(V^); Kj := J * Len + Ofs(V^);

            Repeat

               { Find Left-Most Entry >= Mid-Point Entry }

	       While ALessB(Ptr(Seg(V^),Ki)^,Px^) Do
	             Begin Inc(Ki,Len); Inc(I) End;

               { Find Right-Most Entry <= Mid-Point Entry }

	       While ALessB(Px^,Ptr(Seg(V^),Kj)^) Do
	             Begin Dec(Kj,Len); Dec(J) End;

               { If I > J, the partition has been exhausted }

               If I <= J Then
               Begin

                  If I < J Then  { we have two records to exchange }
                  Begin
               	     Move(Ptr(Seg(V^),Ki)^,Pw^,Len);
               	     Move(Ptr(Seg(V^),Kj)^,Ptr(Seg(V^),Ki)^,Len);
               	     Move(Pw^,Ptr(Seg(V^),Kj)^,Len);
                  End;

                  Inc(I); Dec(J); Inc(Ki,Len); Dec(Kj,Len);
               End;	{ If I <= J }
            Until I > J;		{ Until All Swaps Done }

            { We now have two partitions.  At left are all records }
            { < X, and at right are all records > X.  The larger   }
            { partition is stacked and we re-partition the residue }
            { until time to pop a deferred partition.              }

            If (J-Lt) < (Rt-I)
	    Then		{ Right-Most Partition is Larger }
	    Begin
	       If I < Rt Then Push(I,Rt);	{ Stack Right Side }
	       Rt := J;				{ Resume with Left }
	    End
	    Else		{  Left-Most Partition is Larger }
	    Begin
	       If Lt < J Then Push(Lt,J);	{ Stack Left Side   }
	       Lt := I;				{ Resume with Right }
	    End;

         Until Lt >= Rt;		{ QuickSort is now Complete }
      END;
      FreeMem(Ps,StkM);			{ Free Stack and Work Areas }
   End;
End; {QSort}

Begin   {Unit Initialization}
	System.HeapError   := @HeapErrorProc;
        _HeapHighWaterMark := System.HeapPtr;
        _HeapOriginalMark  := System.HeapOrg;
End.
