home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 16 / CD_ASCQ_16_0994.iso / news / 573 / 3dlab101 / asmsys.pas < prev    next >
Pascal/Delphi Source File  |  1994-05-26  |  12KB  |  420 lines
  1. {────────────────────────────────────────────────────────────────────────────}
  2. {───( C ) Copyright 1994 By Kimmo Fredriksson.───────────────────────────────}
  3. {────────────────────────────────────────────────────────────────────────────}
  4. {───You may use this unit freely in your programs, and distribute them,──────}
  5. {───but you are *NOT* allowed to distribute any modified form of this────────}
  6. {───unit, not source, nor the compiled TPU, TPP or whatsoever, *without*─────}
  7. {───my permission! In it's original form, this source is freeware.───────────}
  8. {────────────────────────────────────────────────────────────────────────────}
  9. {───Internet email: Kimmo.Fredriksson@Helsinki.FI────────────────────────────}
  10. {────────────────────────────────────────────────────────────────────────────}
  11.  
  12. {────────────────────────────────────────────────────────────────────────────}
  13. {───This Unit contains some useful BASM functions and procedures.────────────}
  14. {────────────────────────────────────────────────────────────────────────────}
  15. {───( C ) Copyright 1994 By Kimmo Fredriksson. ──────────────────────────────}
  16. {────────────────────────────────────────────────────────────────────────────}
  17.  
  18. {$A+,B-,D-,E-,F-,G+,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X+}
  19.  
  20. {────────────────────────────────────────────────────────────────────────────}
  21.  
  22. UNIT    AsmSys;
  23.  
  24. {────────────────────────────────────────────────────────────────────────────}
  25.                   INTERFACE
  26. {────────────────────────────────────────────────────────────────────────────}
  27.  
  28. CONST    Copyright = '(C) Copyright 1992 - 1994 by Kimmo Fredriksson.';
  29.  
  30.     RSeed     : LongInt = 0;
  31.     RValue   : LongInt = 0;
  32.  
  33.     CRSeed   : LongInt = 0;
  34.  
  35.     CoinSeed : Word = 0;
  36.  
  37. {────────────────────────────────────────────────────────────────────────────}
  38. FUNCTION  R16b  : Word;        { Random number 0-65535 }
  39. {
  40. FUNCTION  R32b  : LongInt;
  41. FUNCTION  CRand : Word;
  42. }
  43. PROCEDURE InitR16b;
  44. PROCEDURE FillCharFast( VAR D; Cnt : Word; B : Byte );
  45. PROCEDURE FillWord( VAR D; Cnt : Word; W : Word );
  46. PROCEDURE Copy16( S, D : Pointer; Cnt : Word );
  47. PROCEDURE SwapInt( VAR a, b );
  48. PROCEDURE SwapPtrA( VAR a, b : Pointer );
  49. PROCEDURE BasePtr( VAR p : Pointer );
  50. FUNCTION  ASqrt( a : Word )       : Word;
  51. FUNCTION  KeyHit                  : Boolean;
  52. FUNCTION  Max( a, b : Integer )    : Integer;
  53. FUNCTION  Min( a, b : Integer )    : Integer;
  54. FUNCTION  Sgn( a : Integer )     : Integer;
  55.  
  56.  
  57. { Divide integer by two's power }
  58.  
  59. FUNCTION SAR( a : Integer; cnt : Byte ) : Integer;
  60.   INLINE( $59 /        { POP    CX    }
  61.       $58 /         { POP    AX    }
  62.       $D3 / $F8 );  { SAR    AX,CL }
  63.  
  64.  
  65. { Divide integer by two }
  66.  
  67. FUNCTION SAR1( a : Integer ) : Integer;
  68.   INLINE( $58 /         { POP    AX   }
  69.       $D1 / $F8 );  { SAR    AX,1 }
  70.  
  71. { Return greater of two LongInts }
  72.  
  73. FUNCTION MaxL( a, b : LongInt ) : LongInt;
  74.   INLINE( $5B /         {   pop    bx    }
  75.       $59 /         {   pop    cx    }
  76.       $58 /         {   pop    ax    }
  77.       $5A /         {   pop    dx    }
  78.       $39 / $CA /   {   cmp    dx,cx }
  79.       $7F / $0A /   {   jg     $+0Ah }
  80.       $7C / $04 /   {   jl     $+04h }
  81.       $39 / $D8 /   {   cmp    ax,bx }
  82.       $77 / $04 /   {   ja     $+04h }
  83.       $89 / $D8 /   {   mov    ax,bx }
  84.       $89 / $CA );  {   mov    dx,cx }
  85.  
  86. { Return greater of two Integers }
  87.  
  88. FUNCTION MaxIn( a, b : Integer ) : Integer;
  89.   INLINE( $5A /          {   pop    dx    }
  90.       $58 /          {   pop    ax    }
  91.       $29 / $C2 /    {   sub    dx,ax }
  92.       $F5 /          {   cmc          }
  93.       $19 / $C9 /    {   sbb    cx,cx }
  94.       $21 / $CA /    {   and    dx,cx }
  95.       $01 / $D0 );   {   add    ax,dx }
  96.  
  97. { Return smaller of two Integers }
  98.  
  99. FUNCTION MinIn( a, b : Integer ) : Integer;
  100.   INLINE( $5A /          {   pop    dx    }
  101.       $58 /          {   pop    ax    }
  102.       $29 / $C2 /    {   sub    dx,ax }
  103.       $19 / $C9 /    {   sbb    cx,cx }
  104.       $21 / $CA /    {   and    dx,cx }
  105.       $01 / $D0 );   {   add    ax,dx }
  106.  
  107. { Like TP's FillChar, but faster }
  108.  
  109. PROCEDURE FillByteIn( D : Pointer; Bytes : Word; B : Byte );
  110.   INLINE( $58 /         {     pop    ax    }
  111.       $59 /         {     pop    cx    }
  112.       $5F /         {     pop    di    }
  113.       $07 /         {     pop    es    }
  114.       $88 / $C4 /   {     mov    ah,al }
  115.       $FC /         {     cld          }
  116.       $D1 / $E9 /   {     shr    cx,1  }
  117.       $F3 / $AB /   { rep stosw        }
  118.       $13 / $C9 /   {     adc    cx,cx }
  119.       $F3 / $AA );  { rep stosb        }
  120.  
  121. { Copy from S to D, Cnt bytes, S and D may not overlap }
  122.  
  123. PROCEDURE Copy16In( S, D : Pointer; Cnt : Word );
  124.   INLINE( $59 /         {    pop    cx    }
  125.       $5F /         {    pop    di       }
  126.       $07 /         {    pop    es       }
  127.       $5E /         {    pop    si       }
  128.       $58 /         {    pop    ax       }
  129.       $1E /         {    push   ds       }
  130.       $8E / $D8 /   {       mov    ds,ax    }
  131.       $FC /         {    cld             }
  132.       $D1 / $E9 /   {       shr    cx,1     }
  133.       $F3 / $A5 /   {   rep movsw           }
  134.       $13 / $C9 /   {       adc    cx,cx    }
  135.       $F3 / $A4 /   {   rep movsb           }
  136.       $1F );        {       pop    ds       }
  137.  
  138. { Swap two pointers }
  139.  
  140. PROCEDURE SwapPtr( VAR a, b : Pointer );
  141.   INLINE( $8C / $DB /                   {    mov    bx,ds         }
  142.       $5E /                     {    pop    si            }
  143.       $1F /                     {    pop    ds            }
  144.       $5F /                     {    pop    di            }
  145.       $07 /                     {    pop    es            }
  146.       $8B / $04 /                   {    mov    ax,[si]       }
  147.       $8B / $54 / $02 /          {    mov    dx,[si+02]    }
  148.       $26 / $87 / $05 /          {    xchg   es:[di],ax    }
  149.       $26 / $87 / $55 / $02 /    {     xchg   es:[di+02],dx }
  150.       $89 / $04 /                   {    mov    [si],ax       }
  151.       $89 / $54 / $02 /          {    mov    [si+02],dx    }
  152.       $8E / $DB );               {    mov    ds,bx         }
  153.  
  154.  
  155. FUNCTION AFire1 : Boolean;               { joysticks fire1 }
  156.   INLINE( $BA / $01 / $02 /              { MOV  DX,201h }
  157.       $EC /                          { IN   AL,DX   }
  158.       $F6 / $D0 /                    { NOT  AL      }
  159.       $24 / $10 /                    { AND  AL,10h  }
  160.       $C0 / $E8 / $04 );             { SHR  AL,4    }
  161.  
  162.  
  163. FUNCTION AFire2 : Boolean;               { joysticks fire2 }
  164.   INLINE( $BA / $01 / $02 /              { MOV  DX,201h }
  165.       $EC /                          { IN   AL,DX   }
  166.       $F6 / $D0 /                    { NOT  AL      }
  167.       $24 / $20 /                    { AND  AL,20h  }
  168.       $C0 / $C0 / $03 );             { ROL  AL,3    }
  169.  
  170.  
  171. FUNCTION FOdd( a : Word ) : Boolean;     { Slow(!) Odd }
  172.   INLINE( $58 /                          { POP  AX     }
  173.       $24 / $01 );                   { AND  AL,01  }
  174.  
  175.  
  176. FUNCTION PreInc( VAR a ) : Word;         { Inc & Succ combined }
  177.   INLINE ( $5F /                         { POP    DI                }
  178.        $07 /                         { POP    ES                }
  179.        $26 / $FF / $05 /             { INC    WORD PTR ES:[DI]  }
  180.        $26 / $8B / $05 );            { MOV    AX,ES:[DI]        }
  181.  
  182.  
  183. FUNCTION PostInc( VAR a ) : Word;        { Inc & Succ combined }
  184.   INLINE ( $5F /                         { POP    DI                }
  185.        $07 /                         { POP    ES                }
  186.        $26 / $8B / $05 /             { MOV    AX,ES:[DI]        }
  187.        $26 / $FF / $05 );            { INC    WORD PTR ES:[DI]  }
  188.  
  189.  
  190. FUNCTION PreDec( VAR a ) : Word;         { Dec & Pred combined }
  191.   INLINE ( $5F /                         { POP    DI                }
  192.        $07 /                         { POP    ES                }
  193.        $26 / $FF / $0D /             { DEC    WORD PTR ES:[DI]  }
  194.        $26 / $8B / $05 );            { MOV    AX,ES:[DI]        }
  195.  
  196.  
  197. FUNCTION PostDec( VAR a ) : Word;        { Dec & Pred combined }
  198.   INLINE ( $5F /                         { POP    DI                }
  199.        $07 /                         { POP    ES                }
  200.        $26 / $8B / $05 /             { MOV    AX,ES:[DI]        }
  201.        $26 / $FF / $0D );            { DEC    WORD PTR ES:[DI]  }
  202.  
  203.  
  204. FUNCTION InKeyHit : Boolean;             { Key hit ? }
  205.   INLINE( $BB / $40 / $00 /              { MOV  BX,0040      }
  206.       $8E / $C3 /                    { MOV  ES,BX        }
  207.       $26 / $A1 / $1C / $00 /        { MOV  AX,ES:[001C] }
  208.       $26 / $2B / $06 / $1A / $00 ); { SUB  AX,ES:[001A] }
  209.  
  210.  
  211. FUNCTION R16bIn : Word;                 { fast random numbers }
  212.   INLINE( $8B / $1E / RValue /        { mov    bx,[RValue] }
  213.       $A1 / RSeed /            { mov    ax,[RSeed]  }
  214.       $C1 / $C0 / $03 /        { rol    ax,03       }
  215.       $2D / $07 / $00 /        { sub    ax,0007     }
  216.       $31 / $D8 /            { xor    ax,bx       }
  217.       $A3 / RValue /        { mov    [RValue],ax }
  218.       $89 / $1E / RSeed );        { mov    [RSeed],bx  }
  219.  
  220.  
  221. FUNCTION CRandIn : Word;              { Fast random numbers }
  222.   INLINE( $66/$69/$06/CRSeed/$6D/$4E/$C6/$41/ { imul eax,[CRSeed],41C64E6D }
  223.       $66/$05/$39/$30/$00/$00/            { add  eax,00003039          }
  224.       $66/$A3/CRSeed/                    { mov  [CRSeed],eax          }
  225.       $66/$C1/$E8/$10 );                  { shr  eax,10                }
  226.  
  227.  
  228. PROCEDURE CLI; INLINE( $FA );
  229. PROCEDURE STI; INLINE( $FB );
  230.  
  231.  
  232. {────────────────────────────────────────────────────────────────────────────}
  233.                 IMPLEMENTATION
  234. {────────────────────────────────────────────────────────────────────────────}
  235.  
  236. { Return a's square root. Fast, but not precise (integer calculations...)}
  237.  
  238. FUNCTION ASqrt( a : Word ) : Word; ASSEMBLER;
  239. LABEL LOOPTOP;
  240. ASM
  241.     MOV    AX,1
  242.     MOV    CX,[a]
  243. LOOPTOP:MOV    BX,AX
  244.     MOV    AX,CX
  245.     XOR    DX,DX
  246.     DIV    BX
  247.     ADD    AX,BX
  248.     SHR    AX,1
  249.     MOV    DX,AX
  250.     SUB    DX,BX
  251.     CMP    DX,1
  252.     JA    LOOPTOP
  253. END;
  254.  
  255. { Like TP's FillChar, only faster }
  256.  
  257. PROCEDURE FillCharFast( VAR D; Cnt : Word; B : Byte ); ASSEMBLER;
  258. ASM
  259.     LES    DI,[D]
  260.     MOV    CX,[Cnt]
  261.     MOV    AL,B
  262.     MOV    AH,AL
  263.     CLD
  264.     SHR    CX,1
  265.     REP STOSW
  266.     ADC    CX,CX
  267.     REP STOSB
  268. END;
  269.  
  270. { Like FillChar, but fills words }
  271.  
  272. PROCEDURE FillWord( VAR D; Cnt : Word; W : Word ); ASSEMBLER;
  273. ASM
  274.     LES    DI,[D]
  275.     MOV    CX,[Cnt]
  276.     MOV    AX,[W]
  277.     CLD
  278.     REP STOSW
  279. END;
  280.  
  281. { Copy from S to D, Cnt bytes, S and D may not overlap }
  282.  
  283. PROCEDURE Copy16( S, D : Pointer; Cnt : Word ); ASSEMBLER;
  284. ASM
  285.     MOV    DX,DS
  286.     LDS    SI,[S]
  287.     LES    DI,[D]
  288.     MOV    CX,[Cnt]
  289.     CLD
  290.     SHR    CX,1
  291.     REP MOVSW
  292.     ADC    CX,CX
  293.     REP MOVSB
  294.     MOV    DS,DX
  295. END;
  296.  
  297. { Return pointer, where offset is < 0Fh }
  298.  
  299. PROCEDURE BasePtr( VAR p : Pointer ); ASSEMBLER;
  300. ASM
  301.     LES    DI,[P]
  302.     MOV    AX,ES:[DI]
  303.     MOV    DX,AX
  304.     SHR    DX,4
  305.     ADD    WORD PTR ES:[DI+2],DX
  306.     AND    AX,000Fh
  307.     STOSW
  308. END;
  309.  
  310. { Swap two Itegers or Words }
  311.  
  312. PROCEDURE SwapInt( VAR a, b ); ASSEMBLER;
  313. ASM
  314.     LES     DI,[A]
  315.     MOV    AX,ES:[DI]
  316.     LES    DI,[B]
  317.     XCHG    AX,ES:[DI]
  318.     LES    DI,[A]
  319.     MOV    ES:[DI],AX
  320. END;
  321.  
  322. { Swap two pointers }
  323.  
  324. PROCEDURE SwapPtrA( VAR a, b : Pointer ); ASSEMBLER;
  325. ASM
  326.     MOV    BX,DS
  327.  
  328.     LES    DI,[a]
  329.     LDS    SI,[b]
  330.  
  331.     MOV    AX,[SI]
  332.     MOV    DX,[SI+2]
  333.  
  334.     XCHG    AX,ES:[DI]
  335.     XCHG    DX,ES:[DI+2]
  336.  
  337.     MOV    [SI],AX
  338.     MOV    [SI+2],DX
  339.  
  340.     MOV    DS,BX
  341. END;
  342.  
  343. { Key hit ? }
  344.  
  345. FUNCTION KeyHit : Boolean; ASSEMBLER;
  346. ASM
  347.     MOV    BX,$0040;
  348.     MOV    ES,BX
  349.     MOV    AX,ES:[$001C]
  350.     SUB    AX,ES:[$001A]
  351. END;
  352.  
  353. { Return greater Integer }
  354.  
  355. FUNCTION Max( a, b : Integer ) : Integer; ASSEMBLER;
  356. ASM
  357.     MOV    AX,[a]
  358.     MOV    DX,[b]
  359.     SUB    DX,AX
  360.     CMC
  361.     SBB    CX,CX
  362.     AND    DX,CX
  363.     ADD    AX,DX
  364. END;
  365.  
  366. { Return smaller Integer }
  367.  
  368. FUNCTION Min( a, b : Integer ) : Integer; ASSEMBLER;
  369. ASM
  370.     MOV    AX,[a]
  371.     MOV    DX,[b]
  372.     SUB    DX,AX
  373.     SBB    CX,CX
  374.     AND    DX,CX
  375.     ADD    AX,DX
  376. END;
  377.  
  378. { Sign }
  379.  
  380. FUNCTION Sgn( a : Integer ) : Integer; ASSEMBLER;
  381. ASM
  382.     MOV    AX,[a]
  383.     SAR    AX,$0E
  384.     AND    AL,$FE
  385.     INC    AX
  386. END;
  387. {
  388. FUNCTION R32b : LongInt; EXTERNAL;
  389.  
  390. FUNCTION CRand : Word; EXTERNAL;
  391.  
  392. $L FRAND386.OBJ
  393. }
  394. { Fast random 0-65535 }
  395.  
  396. FUNCTION R16b : Word; ASSEMBLER;
  397. ASM
  398.     MOV    BX,WORD PTR [RValue]
  399.     MOV    AX,WORD PTR [RSeed]
  400.     ROL    AX,3
  401.     SUB    AX,7
  402.     XOR    AX,BX
  403.     MOV    WORD PTR [RValue],AX
  404.     MOV     WORD PTR [RSeed],BX
  405. END;
  406.  
  407. { Initialize R16b-generators seed }
  408.  
  409. PROCEDURE InitR16b; ASSEMBLER;
  410. ASM
  411.     MOV    AX,0040h
  412.     MOV    ES,AX
  413.     MOV    AX,ES:[006Ch]
  414.     MOV    WORD PTR [RSeed],AX
  415.     MOV    AX,ES:[006Ch+2]
  416.     MOV    WORD PTR [RSeed+2],AX
  417. END;
  418.  
  419. END.
  420.