DEFINITION MODULE LowLevel; (********************************************************) (* *) (* Miscellaneous low-level procedures *) (* *) (* Programmer: P. Moylan *) (* Last edited: 11 March 1995 *) (* Status: OK *) (* *) (* Note that the implementation of this module *) (* is heavily compiler-dependent. This version *) (* is for use with the TopSpeed compiler, *) (* version 1 or version 3. *) (* *) (* Now making changes so that I can use it with *) (* more compilers. *) (* *) (********************************************************) FROM SYSTEM IMPORT (* type *) BYTE, WORD, ADDRESS; FROM Types IMPORT (* type *) FarPointer; (* off) *) CONST (*%T _fcall *) Ret = 0CBH; (*%E *) (*%F _fcall *) Ret = 0C3H; (*%E *) TYPE Code1=ARRAY [0..0] OF BYTE; Code2=ARRAY [0..1] OF BYTE; Code3=ARRAY [0..2] OF BYTE; Code5=ARRAY [0..4] OF BYTE; Code7=ARRAY [0..6] OF BYTE; Code9=ARRAY [0..8] OF BYTE; (*>*) (************************************************************************) (* BITWISE LOGIC *) (************************************************************************) (* on, reg_param => (ax, bx), reg_return => (ax)) *) (*# call(reg_saved => (bx,cx,dx,si,di,ds,es,st1,st2)) *) INLINE (*>*) PROCEDURE IAND (first, second: WORD): WORD (* Bit-by-bit logical AND. *) (**); (************************************************************************) (**) PROCEDURE IANDB (first, second: BYTE): BYTE (* Bit-by-bit logical AND for bytes. *) (**); (************************************************************************) (**) PROCEDURE IOR (first, second: WORD): WORD (* Bit-by-bit inclusive OR. *) (**); (************************************************************************) (**) PROCEDURE IORB (first, second: BYTE): BYTE (* Bit-by-bit inclusive OR. *) (**); (************************************************************************) (**) PROCEDURE IXOR (first, second: WORD): WORD (* Bit-by-bit exclusive OR. *) (**); (************************************************************************) (**) PROCEDURE IXORB (first, second: BYTE): BYTE (* Bit-by-bit exclusive OR. *) (**); (************************************************************************) (**) PROCEDURE INOT (value: WORD): WORD (* Bit-by-bit Boolean complement. *) (**); (************************************************************************) (**) PROCEDURE INOTB (value: BYTE): BYTE (* Bit-by-bit Boolean complement. *) (**); (************************************************************************) (* on, reg_param => (ax, cx), reg_return => (ax)) *) INLINE (*>*) PROCEDURE ROL (value: WORD; count: CARDINAL): WORD (* Left rotation of "value" by "count" bit positions. *) (**); (************************************************************************) (**) PROCEDURE ROLB (value: BYTE; count: CARDINAL): BYTE (* Left rotation of "value" by "count" bit positions. *) (**); (************************************************************************) (**) PROCEDURE LS (value: WORD; count: CARDINAL): WORD (* Left shift of "value" by "count" bit positions, with zero fill. *) (**); (************************************************************************) (**) PROCEDURE LSB (value: BYTE; count: CARDINAL): BYTE (* Left shift of "value" by "count" bit positions, with zero fill. *) (**); (************************************************************************) (**) PROCEDURE ROR (value: WORD; count: CARDINAL): WORD (* Right rotation of "value" by "count" bit positions. *) (**); (************************************************************************) (**) PROCEDURE RORB (value: BYTE; count: CARDINAL): BYTE (* Right rotation of "value" by "count" bit positions. *) (**); (************************************************************************) (**) PROCEDURE RS (value: WORD; count: CARDINAL): WORD (* Right shift of "value" by "count" bit positions, with zero fill. *) (**); (************************************************************************) (**) PROCEDURE RSB (value: BYTE; count: CARDINAL): BYTE (* Right shift of "value" by "count" bit positions, with zero fill. *) (**); (************************************************************************) (* POINTER OPERATIONS *) (************************************************************************) (* (ax,dx), reg_return => (ax,dx)) *) (*# call(reg_saved => (bx,cx,si,di,ds,es,st1,st2)) *) INLINE (*>*) PROCEDURE Far (A: ADDRESS): FarPointer (* Converts a pointer to a far pointer. *) (**); (************************************************************************) (* (dx, ax), reg_return => (ax,dx)) *) INLINE (*>*) PROCEDURE MakePointer (segment, offset: WORD): FarPointer (* Creates a pointer, given the segment and offset within segment. *) (**); (************************************************************************) (* (ax,bx), reg_return => (bx)) *) (*# call(reg_saved => (cx,dx,si,di,ds,es,st1,st2)) *) INLINE (*>*) PROCEDURE SEGMENT (A: ADDRESS): WORD (* Returns the segment part of an address. *) (**); (************************************************************************) (* (ax,bx,cx,dx,si,di,ds,es,st1,st2)) *) INLINE (*>*) PROCEDURE FarSEGMENT (A: FarPointer): WORD (* Returns the segment part of an address. *) (**); (************************************************************************) (* on, reg_param => (ax,bx), reg_return => (ax)) *) INLINE (*>*) PROCEDURE OFFSET (A: ADDRESS): WORD (* Returns the offset part of an address. *) (**); (************************************************************************) (* (bx,cx,dx,si,di,ds,es,st1,st2)) *) (*# call(reg_return => (ax,dx)) *) (*%T _fptr *) (*# call(reg_param => (ax,dx,bx)) *) (*%E*) (*%F _fptr *) (*# call(reg_param => (ax,bx)) *) (*%E*) INLINE (*>*) PROCEDURE AddOffset (A: ADDRESS; increment: CARDINAL): ADDRESS (* Returns a pointer to the memory location whose physical address *) (* is Physical(A)+increment. In the present version, it is assumed *) (* that the caller will never try to run off the end of a segment. *) (**); (************************************************************************) (**) PROCEDURE SubtractOffset (A: ADDRESS; decrement: CARDINAL): ADDRESS (* Like AddOffset, except that we go backwards in memory. Running *) (* off the beginning of the segment is an undetected error. *) (**); (************************************************************************) (* (ax,dx,bx)) *) INLINE (*>*) PROCEDURE FarAddOffset (A: FarPointer; increment: CARDINAL): FarPointer (* Like AddOffset, except for the parameter types. *) (**); (************************************************************************) (**) PROCEDURE FarSubtractOffset (A: FarPointer; decrement: CARDINAL): FarPointer (* Like SubtractOffset, except for the parameter types. *) (**); (************************************************************************) (* off) *) (*# call(reg_param => (ax, dx), reg_return => (dx, ax)) *) (*# call(reg_saved => (bx,cx,si,di,ds,es,st1,st2)) *) (*>*) PROCEDURE Virtual (PA: LONGCARD): FarPointer; (* Converts a physical address to a virtual address, if possible. *) (* There are no guarantees in the case where there is no such *) (* virtual address. *) (************************************************************************) (* (ax,bx), reg_return => (ax, bx)) *) (*# call(reg_saved => (cx,dx,si,di,ds,es,st1,st2)) *) (*>*) PROCEDURE Physical (A: ADDRESS): LONGCARD; (* Converts a virtual address to a physical address. Use with care!*) (************************************************************************) (* BYTE/WORD/LONGCARD CONVERSIONS *) (************************************************************************) (* on, reg_param => (ax), reg_return => (ax)) *) (*# call(reg_saved => (bx,cx,dx,si,di,ds,es,st1,st2)) *) INLINE (*>*) PROCEDURE LowByte (w: WORD): BYTE (* Returns the low-order byte of its argument. *) (**); (************************************************************************) (**) PROCEDURE HighByte (w: WORD): BYTE (* Returns the high-order byte of its argument. *) (**); (************************************************************************) (* (bx, ax), reg_return => (ax)) *) INLINE (*>*) PROCEDURE MakeWord (high, low: BYTE): WORD (* Combines two bytes into a word. The first argument becomes the *) (* most significant byte of the result. *) (**); (************************************************************************) (* (ax), reg_return => (ax)) *) INLINE (*>*) PROCEDURE SignExtend (val: BYTE): INTEGER (* Converts a signed 8-bit number to signed integer. *) (**); (************************************************************************) (* on, reg_param => (ax,bx), reg_return => (ax)) *) INLINE (*>*) PROCEDURE LowWord (w: LONGCARD): WORD (* Returns the low-order word of its argument. *) (**); (************************************************************************) (* on, reg_param => (bx, ax), reg_return => (ax)) *) INLINE (*>*) PROCEDURE HighWord (w: LONGCARD): WORD (* Returns the high-order word of its argument. *) (**); (************************************************************************) (* on, reg_param => (dx,ax), reg_return => (ax,dx)) *) INLINE (*>*) PROCEDURE MakeLongword (high, low: WORD): LONGCARD (* Combines two words into a longword. The first argument becomes *) (* the most significant word of the result. *) (**); (************************************************************************) (* MISCELLANEOUS ARITHMETIC *) (************************************************************************) (* on, reg_return => (ax)) *) (*%T _fptr *) (*%T _fdata*) (*# call(reg_param => (si,ds,ax)) *) (*%E*) (*%F _fdata*) (*# call(reg_param => (si,bx,ax)) *) (*%E*) (*%E*) (*%F _fptr *) (*# call(reg_param => (si,ax)) *) (*%E*) INLINE (*>*) PROCEDURE INCV (VAR (*INOUT*) dest: CARDINAL; src: CARDINAL): BOOLEAN (* Computes dest := dest + src, and returns TRUE iff the addition *) (* produced a carry. *) (**); (************************************************************************) (**) PROCEDURE INCVB (VAR (*INOUT*) dest: BYTE; src: BYTE): BOOLEAN (* Computes dest := dest + src, and returns TRUE iff the addition *) (* produced a carry. *) (**); (************************************************************************) (**) PROCEDURE DECV (VAR (*INOUT*) dest: CARDINAL; src: CARDINAL): BOOLEAN (* Computes dest := dest - src, and returns TRUE iff the *) (* subtraction produced a borrow. *) (**); (************************************************************************) (**) PROCEDURE DECVB (VAR (*INOUT*) dest: BYTE; src: BYTE): BOOLEAN (* Computes dest := dest - src, and returns TRUE iff the *) (* subtraction produced a borrow. *) (**); (************************************************************************) (* on, reg_param => (ax, bx), reg_return => (ax,dx)) *) (*# call(reg_saved => (bx,cx,si,di,ds,es,st1,st2)) *) INLINE (*>*) PROCEDURE Mul (A, B: CARDINAL): LONGCARD (* Same as A*B, except for the type of the result. We provide this *) (* as a general-purpose function since this combination of operands *) (* is often precisely what is wanted. *) (**); (************************************************************************) (**) PROCEDURE MulB (A, B: BYTE): CARDINAL (* Same as A*B, except for the type of the result. We provide this *) (* as a general-purpose function since this combination of operands *) (* is often precisely what is wanted. *) (**); (************************************************************************) (**) PROCEDURE IMul (A, B: INTEGER): LONGINT (* Like Mul, but signed. *) (**); (************************************************************************) (**) PROCEDURE IMulB (A, B: BYTE): INTEGER (* Like MulB, but signed. *) (**); (************************************************************************) (**) PROCEDURE DivB (A: CARDINAL; B: BYTE): BYTE (* Same as A DIV B, except for the type of A. We provide this as *) (* a general-purpose function since this combination of operands *) (* is often precisely what is wanted. *) (**); (************************************************************************) (* on, reg_param => (ax,dx,bx), reg_return => (ax)) *) INLINE (*>*) PROCEDURE Div (A: LONGCARD; B: CARDINAL): CARDINAL (* Same as A DIV B, except for the type of A. We provide this as *) (* a general-purpose function since this combination of operands *) (* is often precisely what is wanted. *) (**); (************************************************************************) (* BLOCK MOVES *) (************************************************************************) (* on) *) (*# call(reg_saved => (ax,bx,dx,ds,st1,st2)) *) (*%T _fptr*) (*%T _fdata*) (*# call(reg_param => (si, ds, di, es, cx)) *) (*%E*) (*%F _fdata*) (*# call(reg_param => (si, ax, di, es, cx)) *) (*%E*) (*%E*) (*%F _fptr*) (*# call(reg_param => (si, di, cx)) *) (*%E*) INLINE (*>*) PROCEDURE Copy (source, destination: ADDRESS; bytecount: CARDINAL) (* Copies an array of bytes from the source address to the *) (* destination address. In the case where the two arrays overlap, *) (* the destination address should be lower in physical memory than *) (* the source address. *) (**); (************************************************************************) (* on) *) (*# call(reg_saved => (ax,bx,dx,ds,es,st1,st2)) *) (*%T _fdata*) (*# call(reg_param => (si, ds, di, es, cx)) *) (*%E*) (*%F _fdata*) (*# call(reg_param => (si, ax, di, es, cx)) *) (*%E*) INLINE (*>*) PROCEDURE FarCopy (source, destination: FarPointer; bytecount: CARDINAL) (* Copies an array of bytes from the source address to the *) (* destination address. In the case where the two arrays overlap, *) (* the destination address should be lower in physical memory than *) (* the source address. *) (**); (************************************************************************) (* off) *) (*>*) PROCEDURE CopyUp (source, destination: FarPointer; bytecount: CARDINAL); (* A variant of Copy which does the move backwards, in order *) (* to handle the case where the destination address is inside the *) (* source array. In this special case Copy cannot be used, *) (* because it would overwrite data it was about to copy. *) (************************************************************************) (* on, reg_param => (di, es, cx, ax)) *) (*# call(reg_saved => (ax,bx,dx,si,ds,es,st1,st2)) *) INLINE (*>*) PROCEDURE BlockFill (destination: FarPointer; bytecount: CARDINAL; value: BYTE) (* Fills the destination array with the given value. *) (**); (************************************************************************) (**) PROCEDURE BlockFillWord (destination: FarPointer; wordcount: CARDINAL; value: WORD) (* Fills the destination array with the given value. *) (**); (************************************************************************) (* INPUT AND OUTPUT *) (************************************************************************) (* on, reg_param => (dx, ax)) *) (*# call(reg_saved => (bx,cx,dx,si,di,ds,es,st1,st2)) *) INLINE (*>*) PROCEDURE OutByte (port: CARDINAL; value: BYTE) (* Puts the value out to an output port. *) (**); (************************************************************************) (* on, reg_param => (dx), reg_return => (ax)) *) INLINE (*>*) PROCEDURE InByte (port: CARDINAL): BYTE (* Reads a byte from an input port. *) (**); (************************************************************************) (* off) *) (*# call(reg_saved => (ax,bx,dx,si,di,ds,es,st1,st2)) *) (*%T _fptr *) (*# call(reg_param => (dx, di, es, cx)) *) (*%E*) (*%F _fptr *) (*# call(reg_param => (dx, di, cx)) *) (*%E*) (*>*) PROCEDURE InStringWord (port: CARDINAL; BufferAddress: ADDRESS; count: CARDINAL); (* Reads count words from an input port. *) (************************************************************************) (* (dx, si, ds, cx)) *) (*%E*) (*%F _fdata*) (*# call(reg_param => (dx, si, ax, cx)) *) (*%E*) (*%E*) (*%F _fptr*) (*# call(reg_param => (dx, si, cx)) *) (*%E*) (*>*) PROCEDURE OutStringWord (port: CARDINAL; BufferAddress: ADDRESS; count: CARDINAL); (* Writes count words to an output port. *) (************************************************************************) (**) END LowLevel.