Category : Pascal Source Code
Archive   : 3DLAB110.ZIP
Filename : ASMSYS.PAS

 
Output of file : ASMSYS.PAS contained in archive : 3DLAB110.ZIP
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄ( C ) Copyright 1994 By Kimmo Fredriksson.ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄYou may use this unit freely in your programs, and distribute them,ÄÄÄÄÄÄ}
{ÄÄÄbut you are *NOT* allowed to distribute any modified form of thisÄÄÄÄÄÄÄÄ}
{ÄÄÄunit, not source, nor the compiled TPU, TPP or whatsoever, *without*ÄÄÄÄÄ}
{ÄÄÄmy permission! In it's original form, this source is freeware.ÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄInternet email: [email protected]ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}

{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄThis Unit contains some useful BASM functions and procedures.ÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄ( C ) Copyright 1994 By Kimmo Fredriksson. ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}

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

{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}

UNIT AsmSys;

{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
INTERFACE
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}

CONST Copyright = '(C) Copyright 1992 - 1994 by Kimmo Fredriksson.';

RSeed : LongInt = 0;
RValue : LongInt = 0;

CRSeed : LongInt = 0;

CoinSeed : Word = 0;

StackPtr : Word = 0;

StackTop = 64;

VAR Stack : ARRAY[ 0..StackTop ] OF Integer;

{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
FUNCTION R16b : Word; { Random number 0-65535 }
{
FUNCTION R32b : LongInt;
FUNCTION CRand : Word;
}
PROCEDURE InitR16b;
PROCEDURE FillCharFast( VAR D; Cnt : Word; B : Byte );
PROCEDURE FillWord( VAR D; Cnt : Word; W : Word );
PROCEDURE Copy16( S, D : Pointer; Cnt : Word );
PROCEDURE Move16( VAR S, D; Cnt : Word );
PROCEDURE SwapInt( VAR a, b );
PROCEDURE SwapPtrA( VAR a, b : Pointer );
PROCEDURE BasePtr( VAR p : Pointer );
FUNCTION ASqrt( a : Word ) : Word;
FUNCTION KeyHit : Boolean;
FUNCTION Max( a, b : Integer ) : Integer;
FUNCTION Min( a, b : Integer ) : Integer;
FUNCTION Sgn( a : Integer ) : Integer;


PROCEDURE Push( a : Integer );
INLINE( $8B / $1E / StackPtr / { mov bx,[StackPtr] }
$FF / $06 / StackPtr / { inc [StackPtr] }
$01 / $DB / { add bx,bx }
$8F / $87 / Stack ); { pop [Stack+bx] }

PROCEDURE Pop( VAR a : Integer );
INLINE( $5F / { pop di }
$07 / { pop es }
$FF / $0E / StackPtr / { dec [StackPtr] }
$8B / $36 / StackPtr / { mov si,[StackPtr] }
$01 / $F6 / { add si,si }
$8D / $B4 / Stack / { lea si,[Stack+si] }
$FC / { cld }
$A5 ); { movsw }

FUNCTION StackNotEmpty : Boolean;
INLINE( $A1 / StackPtr / { mov ax,[StackPtr] }
$08 / $E0 ); { or al,ah }

PROCEDURE InitStack;
INLINE( $C7 / $06 / StackPtr / $0000 ); { mov [StackPtr],0 }

{ Divide integer by two's power }

FUNCTION SAR( a : Integer; cnt : Byte ) : Integer;
INLINE( $59 / { POP CX }
$58 / { POP AX }
$D3 / $F8 ); { SAR AX,CL }


{ Divide integer by two }

FUNCTION SAR1( a : Integer ) : Integer;
INLINE( $58 / { POP AX }
$D1 / $F8 ); { SAR AX,1 }

{ Return greater of two LongInts }

FUNCTION MaxL( a, b : LongInt ) : LongInt;
INLINE( $5B / { pop bx }
$59 / { pop cx }
$58 / { pop ax }
$5A / { pop dx }
$39 / $CA / { cmp dx,cx }
$7F / $0A / { jg $+0Ah }
$7C / $04 / { jl $+04h }

$39 / $D8 / { cmp ax,bx }
$77 / $04 / { ja $+04h }
$89 / $D8 / { mov ax,bx }
$89 / $CA ); { mov dx,cx }

{ Return greater of two Integers }

FUNCTION MaxIn( a, b : Integer ) : Integer;
INLINE( $5A / { pop dx }
$58 / { pop ax }
$29 / $C2 / { sub dx,ax }
$F5 / { cmc }
$19 / $C9 / { sbb cx,cx }
$21 / $CA / { and dx,cx }
$01 / $D0 ); { add ax,dx }

{ Return smaller of two Integers }

FUNCTION MinIn( a, b : Integer ) : Integer;
INLINE( $5A / { pop dx }
$58 / { pop ax }
$29 / $C2 / { sub dx,ax }
$19 / $C9 / { sbb cx,cx }
$21 / $CA / { and dx,cx }
$01 / $D0 ); { add ax,dx }

{ Like TP's FillChar, but faster }

PROCEDURE FillByteIn( D : Pointer; Bytes : Word; B : Byte );
INLINE( $58 / { pop ax }
$59 / { pop cx }
$5F / { pop di }
$07 / { pop es }
$88 / $C4 / { mov ah,al }
$FC / { cld }
$D1 / $E9 / { shr cx,1 }
$F3 / $AB / { rep stosw }
$13 / $C9 / { adc cx,cx }
$F3 / $AA ); { rep stosb }

{ Copy from S to D, Cnt bytes, S and D may not overlap }

PROCEDURE Copy16In( S, D : Pointer; Cnt : Word );
INLINE( $8C / $DA / { mov dx,ds }
$59 / { pop cx }
$5F / { pop di }
$07 / { pop es }
$5E / { pop si }
$1F / { pop ds }
$FC / { cld }
$D1 / $E9 / { shr cx,1 }
$F3 / $A5 / { rep movsw }
$13 / $C9 / { adc cx,cx }
$F3 / $A4 / { rep movsb }
$8E / $DA ); { mov ds,dx }

{ Copy from S to D, Cnt bytes, S and D may overlap }

PROCEDURE Move16In( VAR S, D; Cnt : Word );
INLINE( $8C / $DA / { mov dx,ds }
$59 / { pop cx }
$5F / { pop di }
$07 / { pop es }
$5E / { pop si }
$1F / { pop ds }
$39 / $FE / { cmp si,di }
$72 / $0B / { jb $+Bh }
$FC / { cld }
$D1 / $E9 / { shr cx,1 }
$F3 / $A5 / { rep movsw }
$11 / $C9 / { adc cx,cx }
$F3 / $A4 / { rep movsb }
$EB / $13 / { jmp $+13h }
$FD / { std }
$01 / $CE / { add si,cx }
$4E / { dec si }
$4E / { dec si }
$01 / $CF / { add di,cx }
$4F / { dec di }
$4F / { dec di }
$D1 / $E9 / { shr cx,1 }
$F3 / $A5 / { rep movsw }
$46 / { inc si }
$47 / { inc di }
$11 / $C9 / { adc cx,cx }
$F3 / $A4 / { rep movsb }
$8E / $DA ); { mov ds,dx }

{ Copy from S to D, Cnt bytes, starting from the *last* byte. }

PROCEDURE Move16InRev( VAR S, D; Cnt : Word );
INLINE( $8C / $DA / { mov dx,ds }
$59 / { pop cx }
$5F / { pop di }
$07 / { pop es }
$5E / { pop si }
$1F / { pop ds }
$FD / { std }
$01 / $CE / { add si,cx }
$4E / { dec si }
$4E / { dec si }
$01 / $CF / { add di,cx }
$4F / { dec di }
$4F / { dec di }
$D1 / $E9 / { shr cx,1 }
$F3 / $A5 / { rep movsw }
$46 / { inc si }
$47 / { inc di }
$11 / $C9 / { adc cx,cx }
$F3 / $A4 / { rep movsb }
$8E / $DA ); { mov ds,dx }

{ Swap two pointers }

PROCEDURE SwapPtr( VAR a, b : Pointer );
INLINE( $8C / $DB / { mov bx,ds }
$5E / { pop si }
$1F / { pop ds }
$5F / { pop di }
$07 / { pop es }
$8B / $04 / { mov ax,[si] }
$8B / $54 / $02 / { mov dx,[si+02] }
$26 / $87 / $05 / { xchg es:[di],ax }
$26 / $87 / $55 / $02 / { xchg es:[di+02],dx }
$89 / $04 / { mov [si],ax }
$89 / $54 / $02 / { mov [si+02],dx }
$8E / $DB ); { mov ds,bx }


FUNCTION AFire1 : Boolean; { joysticks fire1 }
INLINE( $BA / $01 / $02 / { MOV DX,201h }
$EC / { IN AL,DX }
$F6 / $D0 / { NOT AL }
$24 / $10 / { AND AL,10h }
$C0 / $E8 / $04 ); { SHR AL,4 }


FUNCTION AFire2 : Boolean; { joysticks fire2 }
INLINE( $BA / $01 / $02 / { MOV DX,201h }
$EC / { IN AL,DX }
$F6 / $D0 / { NOT AL }
$24 / $20 / { AND AL,20h }
$C0 / $C0 / $03 ); { ROL AL,3 }


FUNCTION FOdd( a : Word ) : Boolean; { Slow(!) Odd }
INLINE( $58 / { POP AX }
$24 / $01 ); { AND AL,01 }


FUNCTION PreInc( VAR a ) : Word; { Inc & Succ combined }
INLINE ( $5F / { POP DI }
$07 / { POP ES }
$26 / $FF / $05 / { INC WORD PTR ES:[DI] }
$26 / $8B / $05 ); { MOV AX,ES:[DI] }


FUNCTION PostInc( VAR a ) : Word; { Inc & Succ combined }
INLINE ( $5F / { POP DI }
$07 / { POP ES }
$26 / $8B / $05 / { MOV AX,ES:[DI] }
$26 / $FF / $05 ); { INC WORD PTR ES:[DI] }


FUNCTION PreDec( VAR a ) : Word; { Dec & Pred combined }
INLINE ( $5F / { POP DI }
$07 / { POP ES }
$26 / $FF / $0D / { DEC WORD PTR ES:[DI] }
$26 / $8B / $05 ); { MOV AX,ES:[DI] }


FUNCTION PostDec( VAR a ) : Word; { Dec & Pred combined }
INLINE ( $5F / { POP DI }
$07 / { POP ES }
$26 / $8B / $05 / { MOV AX,ES:[DI] }
$26 / $FF / $0D ); { DEC WORD PTR ES:[DI] }


FUNCTION InKeyHit : Boolean; { Key hit ? }
INLINE( $BB / $40 / $00 / { MOV BX,0040 }
$8E / $C3 / { MOV ES,BX }
$26 / $A1 / $1C / $00 / { MOV AX,ES:[001C] }
$26 / $2B / $06 / $1A / $00 ); { SUB AX,ES:[001A] }


FUNCTION R16bIn : Word; { fast random numbers }
INLINE( $8B / $1E / RValue / { mov bx,[RValue] }
$A1 / RSeed / { mov ax,[RSeed] }
$C1 / $C0 / $03 / { rol ax,03 }
$2D / $07 / $00 / { sub ax,0007 }
$31 / $D8 / { xor ax,bx }
$A3 / RValue / { mov [RValue],ax }
$89 / $1E / RSeed ); { mov [RSeed],bx }


FUNCTION CRandIn : Word; { Fast random numbers }
INLINE( $66/$69/$06/CRSeed/$6D/$4E/$C6/$41/ { imul eax,[CRSeed],41C64E6D }
$66/$05/$39/$30/$00/$00/ { add eax,00003039 }
$66/$A3/CRSeed/ { mov [CRSeed],eax }
$66/$C1/$E8/$10 ); { shr eax,10 }


FUNCTION M16_16( a, b : Integer ) : LongInt;
INLINE( $58 / { pop ax }
$5A / { pop dx }
$F7 / $EA ); { imul dx }


FUNCTION M32_16( a : LongInt; b : Integer ) : LongInt;
INLINE( $59 / { pop cx }
$5B / { pop bx }
$58 / { pop ax }
$F7 / $E9 / { imul cx }
$87 / $C3 / { xchg bx,ax }
$F7 / $E1 / { mul cx }
$01 / $DA ); { add dx,bx }


FUNCTION SqrI( a : Integer ) : LongInt;
INLINE( $58 / { pop ax }
$F7 / $E8 ); { imul ax }


PROCEDURE CLI; INLINE( $FA );
PROCEDURE STI; INLINE( $FB );


{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
IMPLEMENTATION
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}

{ Return a's square root. Fast, but not precise (integer calculations...)}

FUNCTION ASqrt( a : Word ) : Word; ASSEMBLER;
LABEL LOOPTOP;
ASM
MOV AX,1
MOV CX,[a]
LOOPTOP:MOV BX,AX
MOV AX,CX
XOR DX,DX
DIV BX
ADD AX,BX
SHR AX,1
MOV DX,AX
SUB DX,BX
CMP DX,1
JA LOOPTOP
END;

{ Like TP's FillChar, only faster }

PROCEDURE FillCharFast( VAR D; Cnt : Word; B : Byte ); ASSEMBLER;
ASM
LES DI,[D]
MOV CX,[Cnt]
MOV AL,B
MOV AH,AL
CLD
SHR CX,1
REP STOSW
ADC CX,CX
REP STOSB
END;

{ Like FillChar, but fills words }

PROCEDURE FillWord( VAR D; Cnt : Word; W : Word ); ASSEMBLER;
ASM
LES DI,[D]
MOV CX,[Cnt]
MOV AX,[W]
CLD
REP STOSW
END;

{ Copy from S to D, Cnt bytes, S and D may not overlap }

PROCEDURE Copy16( S, D : Pointer; Cnt : Word ); ASSEMBLER;
ASM
MOV DX,DS
LDS SI,[S]
LES DI,[D]
MOV CX,[Cnt]
CLD
SHR CX,1
REP MOVSW
ADC CX,CX
REP MOVSB
MOV DS,DX
END;

{ Copy from S to D, Cnt bytes, S and D may overlap }

PROCEDURE Move16( VAR S, D; Cnt : Word ); ASSEMBLER;
ASM
mov dx,ds
lds si,[S]
les di,[D]
mov cx,[Cnt]
cmp si,di
jb @Rev

cld
shr cx,1
rep movsw
adc cx,cx
rep movsb

jmp @Done

@Rev: std
add si,cx
dec si
dec si

add di,cx
dec di
dec di
shr cx,1
rep movsw
inc si
inc di
adc cx,cx
rep movsb

@Done: mov ds,dx
END;

{ Return pointer, where offset is < 0Fh }

PROCEDURE BasePtr( VAR p : Pointer ); ASSEMBLER;
ASM
LES DI,[P]
MOV AX,ES:[DI]
MOV DX,AX
SHR DX,4
ADD WORD PTR ES:[DI+2],DX
AND AX,000Fh
STOSW
END;

{ Swap two Itegers or Words }

PROCEDURE SwapInt( VAR a, b ); ASSEMBLER;
ASM
LES DI,[A]
MOV AX,ES:[DI]
LES DI,[B]
XCHG AX,ES:[DI]
LES DI,[A]
MOV ES:[DI],AX
END;

{ Swap two pointers }

PROCEDURE SwapPtrA( VAR a, b : Pointer ); ASSEMBLER;
ASM
MOV BX,DS

LES DI,[a]
LDS SI,[b]

MOV AX,[SI]
MOV DX,[SI+2]

XCHG AX,ES:[DI]
XCHG DX,ES:[DI+2]

MOV [SI],AX
MOV [SI+2],DX

MOV DS,BX
END;

{ Key hit ? }

FUNCTION KeyHit : Boolean; ASSEMBLER;
ASM
MOV BX,$0040;
MOV ES,BX
MOV AX,ES:[$001C]
SUB AX,ES:[$001A]
END;

{ Return greater Integer }

FUNCTION Max( a, b : Integer ) : Integer; ASSEMBLER;
ASM
MOV AX,[a]
MOV DX,[b]
SUB DX,AX
CMC
SBB CX,CX
AND DX,CX
ADD AX,DX
END;

{ Return smaller Integer }

FUNCTION Min( a, b : Integer ) : Integer; ASSEMBLER;
ASM
MOV AX,[a]
MOV DX,[b]
SUB DX,AX
SBB CX,CX
AND DX,CX
ADD AX,DX
END;

{ Sign }

FUNCTION Sgn( a : Integer ) : Integer; ASSEMBLER;
ASM
MOV AX,[a]
SAR AX,$0E
AND AL,$FE
INC AX
END;
{
FUNCTION R32b : LongInt; EXTERNAL;

FUNCTION CRand : Word; EXTERNAL;

$L FRAND386.OBJ
}
{ Fast random 0-65535 }

FUNCTION R16b : Word; ASSEMBLER;
ASM
MOV BX,WORD PTR [RValue]
MOV AX,WORD PTR [RSeed]
ROL AX,3
SUB AX,7
XOR AX,BX
MOV WORD PTR [RValue],AX
MOV WORD PTR [RSeed],BX
END;

{ Initialize R16b-generators seed }

PROCEDURE InitR16b; ASSEMBLER;
ASM
MOV AX,0040h
MOV ES,AX
MOV AX,ES:[006Ch]
MOV WORD PTR [RSeed],AX
MOV AX,ES:[006Ch+2]
MOV WORD PTR [RSeed+2],AX
END;

END.


  3 Responses to “Category : Pascal Source Code
Archive   : 3DLAB110.ZIP
Filename : ASMSYS.PAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/