Vector and matrix procedures and functions for TURBO- PASCAL

lisp2arx
Visual Programming for AutoLisp Mathématiques en programmation Lisp.. doc2cpp,doc2lsp, sld2lsp, bmp2dcl, free__GifCcapture for all-CAD'platforms..

Lista Forumurilor Pe Tematici

lisp2arx | Reguli | Inregistrare | Login

POZE LISP2ARX

Nu sunteti logat.

Nou pe simpatie:
christyna1993 pe Simpatie.ro

Femeie
19 ani
Bucuresti
cauta Barbat
30 - 44 ani

lisp2arx / Delphi, webdesign / Vector and matrix procedures and functions for TURBO- PASCAL,

Autor

Mesaj

Pagini: 1

zauchan
Moderator

Inregistrat: acum 13 ani
Postari: 180

How to initialize ESI in Win32?

I found "Vector and matrix procedures and functions for TURBO- PASCAL,"
partly written as inline assembler code for a 387 coprocessor.
I wan't import inside Delphi32

Code:

unit Vmath10;
interface

type Matrix4  = array[0..3,0..3] of double;
     Vector4  = array[0..3] of double;
     Matrix3  = array[0..2,0..2] of double;
     Vector3  = array[0..2] of double;

const
  ZeroV3   : Vector3 = (0.0,0.0,0.0);
  XunityV3 : Vector3 = (1.0,0.0,0.0);
  YunityV3 : Vector3 = (0.0,1.0,0.0);
  ZunityV3 : Vector3 = (0.0,0.0,1.0);

{----------------------------------------------------------------------------}
procedure DirectionV3(P1,P2:Vector3; var R:Vector3);
{         ===========                                                        }
{         Function     Calculates the unity direction vector from P1 to P2   }
{                                                                            }
{         Result type  Vector3                                               }
{----------------------------------------------------------------------------}
procedure MulV3V3(V1,V2:Vector3; var R:Vector3);
{         =======                                                            }
{         Function     Multiplies the components of two vectors              }
{                                                                            }
{         Result type  Vector3                                               }
{----------------------------------------------------------------------------}
function  MulV3(V1,V2:Vector3):double;
{         =====                                                              }
{         Function     Scalar multiplication (dot product) of two vectors    }
{                                                                            }
{         Result type  double                                                }
{----------------------------------------------------------------------------}
procedure CrossV3(V1,V2:Vector3; var R:Vector3);
{         =======                                                            }
{         Function     Vector multiplication (cross product) of two vectors  }
{                                                                            }
{         Result type  Vector3                                               }
{----------------------------------------------------------------------------}
procedure NormalizeV3(var V:Vector3);
{         ===========                                                        }
{         Function     Transforms a vector into a unity vector with the same }
{                      direction                                             }
{                                                                            }
{         Result type  Vector                                                }
{----------------------------------------------------------------------------}
function  AbsV3(V:Vector3):double;
{         =====                                                              }
{         Function     Returns the length of a vector                        }
{                                                                            }
{         Result type  double                                                }
{----------------------------------------------------------------------------}
function  QuickAbsV3(V:Vector3):double;
{         ==========                                                         }
{         Function     Returns a rough estimate of the length of a vector    }
{                      by simply adding the absolute values of the components}
{                                                                            }
{         Result type  double                                                }
{----------------------------------------------------------------------------}
procedure MulV3D(V:Vector3; S:double; var R:Vector3);
{         ======                                                             }
{         Function     Multiplies the components of a vector with a scalar   }
{                                                                            }
{         Result type  Vector3                                               }
{----------------------------------------------------------------------------}
procedure DivV3D(V:Vector3; S:double; var R:Vector3);
{         ======                                                             }
{         Function     Divides the components of a vector by a scalar        }
{                                                                            }
{         Result type  double                                                }
{----------------------------------------------------------------------------}
procedure DivV3V3(V1,V2:Vector3; R:Vector3);
{         =======                                                            }
{         Function     Divides the components of two vectors                 }
{                                                                            }
{         Result type  double                                                }
{----------------------------------------------------------------------------}
procedure AddV3(V1,V2:Vector3; var R:Vector3);
{         =====                                                              }
{         Function     Adds two vectors                                      }
{                                                                            }
{         Result type  Vector3                                               }
{----------------------------------------------------------------------------}
procedure SubV3(V1,V2:Vector3; var R:Vector3);
{         =====                                                              }
{         Function     Subtracts two vectors                                 }
{                                                                            }
{         Result type  Vector3                                               }
{----------------------------------------------------------------------------}
procedure DtoV3(X,Y,Z:double; var V:Vector3);
{         =====                                                              }
{         Function     Copies three scalars into the components of a vector  }
{                                                                            }
{         Result type  Vector3                                               }
{----------------------------------------------------------------------------}
procedure InvertV3(var V:Vector3);
{         ========                                                           }
{         Function     Inverts the sign of all vector components             }
{                                                                            }
{         Result type  Vector3                                               }
{----------------------------------------------------------------------------}
procedure RandomUnitV3(var V:Vector3);
{         ============                                                       }
{         Function     Generates a random unit vector                        }
{                                                                            }
{         Result type  Vector3                                               }
{----------------------------------------------------------------------------}
procedure MulM4V4 (A:Matrix4; B:Vector4; var C:Vector4);
{         =======                                                            }
{         Function     Multiplies a 4x4 matrix with a 4-element vector       }
{                                                                            }
{         Result type  Vector4                                               }
{                                                                            }
{         Remark       Uses the register page switching and matrix functions }
{                      of the IIT coprocessors                               }
{----------------------------------------------------------------------------}
function Det3V3(V1,V2,V3:Vector3):double;
{        ======                                                              }
{         Function     Calculates the determinant of a matrix who's columns  }
{                      are formed by three vectors                           }
{                                                                            }
{         Result type  double                                                }
{----------------------------------------------------------------------------}
implementation

procedure MulM4V4(A:Matrix4; B:Vector4; var C:Vector4); assembler;
asm
  PUSH DS
  FINIT
  LES    ESI,dword ptr A
  DW     $EBDB               { The first IIT switch opcode }
  FLD    qword ptr[ESI+$10]
  FLD    qword ptr[ESI+$30]
  FLD    qword ptr[ESI+$50]
  FLD    qword ptr[ESI+$70]
  FLD    qword ptr[ESI+$18]
  FLD    qword ptr[ESI+$38]
  FLD    qword ptr[ESI+$58]
  FLD    qword ptr[ESI+$78]
  FINIT
  DW     $EADB               { The second IIT switch opcode }
  FLD    qword ptr[ESI]
  FLD    qword ptr[ESI+$20]
  FLD    qword ptr[ESI+$40]
  FLD    qword ptr[ESI+$60]
  FLD    qword ptr[ESI+$08]
  FLD    qword ptr[ESI+$28]
  FLD    qword ptr[ESI+$48]
  FLD    qword ptr[ESI+$68]
  FINIT
  LDS    ESI,dword ptr B
  DW     $E8DB               { And the last IIT switch opcode }
  FLD    qword ptr[ESI+$18]
  FLD    qword ptr[ESI+$10]
  FLD    qword ptr[ESI+$08]
  FLD    qword ptr[ESI]
  LDS    ESI,dword ptr C
  DW     $F1DB               { This IIT opcode triggers the operation }
  FSTP   qword ptr[ESI]
  FSTP   qword ptr[ESI+$08]
  FSTP   qword ptr[ESI+$10]
  FSTP   qword ptr[ESI+$18]
  POP    DS
end;


function Det3V3(V1,V2,V3:Vector3):double; assembler;
asm
  PUSH   DS
  LDS    ESI,dword ptr V3
  FLD    qword ptr[ESI+$10]
  FLD    qword ptr[ESI+$08]
  LDS    ESI,dword ptr V2
  FLD    qword ptr[ESI+$10]
  FLD    qword ptr[ESI+$08]
  FMULP  ST(3),ST(0)
  FMULP  ST(1),ST(0)
  FSUBP  ST(1),ST(0)
  LDS    ESI,dword ptr V1
  FLD    qword ptr [ESI]
  FMULP  ST(1),ST(0)  
  FLD    qword ptr [ESI+$08]
  FLD    qword ptr [ESI+$10]
  LDS    ESI,dword ptr V3
  FLD    qword ptr [ESI+$08]
  FLD    qword ptr [ESI+$10]
  FMULP  ST(3),ST(0)
  FMULP  ST(1),ST(0)
  FSUBP  ST(1),ST(0)
  LDS    ESI,dword ptr V2
  FLD    qword ptr [ESI]
  FMULP  ST(1),ST(0)
  FSUBP  ST(1),ST(0)   
  LDS    ESI,dword ptr V2
  FLD    qword ptr [ESI+$10]
  FLD    qword ptr [ESI+$08]
  LDS    ESI,dword ptr V1
  FLD    qword ptr [ESI+$10]
  FLD    qword ptr [ESI+$08]
  FMULP  ST(3),ST(0)
  FMULP  ST(1),ST(0)
  FSUBP  ST(1),ST(0)
  LDS    ESI,dword ptr V3
  FLD    qword ptr [ESI]
  FMULP  ST(1),ST(0)
  FADDP  ST(1),ST(0)
  POP    DS
end;


procedure InvertV3(var V:Vector3); assembler;
asm
  PUSH   DS
  PUSH   AX
  LDS    ESI,dword ptr V
  MOV    AL,$80
  XOR    [ESI+$07],AL
  XOR    [ESI+$0F],AL
  XOR    [ESI+$17],AL
  POP    AX
  POP    DS
end;


procedure DtoV3(X,Y,Z:double; var V:Vector3); assembler;
asm
  PUSH   DS
  LDS    ESI,dword ptr  V
  FLD    X
  FSTP   qword ptr [ESI]
  FLD    Y
  FSTP   qword ptr [ESI+$08]
  FLD    Z
  FSTP   qword ptr [ESI+$10]
  POP    DS
end;



procedure SubV3(V1,V2:Vector3; var R:Vector3); assembler;
asm
  PUSH   DS
  LDS    ESI,dword ptr V1
  FLD    qword ptr[ESI]
  FLD    qword ptr[ESI+$08]
  FLD    qword ptr[ESI+$10]
  LDS    ESI,dword ptr V2
  FLD    qword ptr[ESI]
  FLD    qword ptr[ESI+$08]
  FLD    qword ptr[ESI+$10]
  FSUBP  ST(3),ST(0)
  FSUBP  ST(3),ST(0)
  FSUBP  ST(3),ST(0)
  LDS    ESI,dword ptr R
  FSTP   qword ptr[ESI+$10]
  FSTP   qword ptr[ESI+$08]
  FSTP   qword ptr[ESI]
  POP    DS
end;


procedure AddV3(V1,V2:Vector3; var R:Vector3); assembler;
asm
  PUSH   DS
  LDS    ESI,dword ptr V1
  FLD    qword ptr[ESI]
  FLD    qword ptr[ESI+$08]
  FLD    qword ptr[ESI+$10]
  LDS    ESI,dword ptr V2
  FLD    qword ptr[ESI]
  FLD    qword ptr[ESI+$08]
  FLD    qword ptr[ESI+$10]
  FADDP  ST(3),ST(0)
  FADDP  ST(3),ST(0)
  FADDP  ST(3),ST(0)
  LDS    ESI,dword ptr R
  FSTP   qword ptr[ESI+$10]
  FSTP   qword ptr[ESI+$08]
  FSTP   qword ptr[ESI]
  POP    DS
end;


procedure MulV3V3(V1,V2:Vector3; var R:Vector3); assembler;
asm
  PUSH   DS
  LDS    ESI,dword ptr V1
  FLD    qword ptr[ESI]
  FLD    qword ptr[ESI+$08]
  FLD    qword ptr[ESI+$10]
  LDS    ESI,dword ptr V2
  FLD    qword ptr[ESI]
  FLD    qword ptr[ESI+$08]
  FLD    qword ptr[ESI+$10]
  FMULP  ST(3),ST(0)
  FMULP  ST(3),ST(0)
  FMULP  ST(3),ST(0)
  LDS    ESI,dword ptr R
  FSTP   qword ptr[ESI+$10]
  FSTP   qword ptr[ESI+$08]
  FSTP   qword ptr[ESI]
  POP    DS
end;


procedure DivV3V3(V1,V2:Vector3; R:Vector3);  assembler;
asm
  PUSH   DS
  LDS    ESI,dword ptr V1
  FLD    qword ptr[ESI]
  FLD    qword ptr[ESI+$08]
  FLD    qword ptr[ESI+$10]
  LDS    ESI,dword ptr V2
  FLD    qword ptr[ESI]
  FLD    qword ptr[ESI+$08]
  FLD    qword ptr[ESI+$10]
  FDIVP  ST(3),ST(0)
  FDIVP  ST(3),ST(0)
  FDIVP  ST(3),ST(0)
  LDS    ESI,dword ptr R
  FSTP   qword ptr[ESI+$10]
  FSTP   qword ptr[ESI+$08]
  FSTP   qword ptr[ESI]
  POP    DS
end;


procedure MulV3D(V:Vector3; S:double; var R:Vector3); assembler;
asm
  PUSH   DS
  LDS    ESI,dword ptr V
  FLD    qword ptr[ESI]
  FLD    qword ptr[ESI+$08]
  FLD    qword ptr[ESI+$10]
  FLD    S
  FMUL   ST(3),ST(0)
  FMUL   ST(2),ST(0)
  FMULP  ST(1),ST(0)
  LDS    ESI,dword ptr R
  FSTP   qword ptr[ESI+$10]
  FSTP   qword ptr[ESI+$08]
  FSTP   qword ptr[ESI]
  POP    DS
end;

procedure DivV3D(V:Vector3; S:double; var R:Vector3); assembler;
asm
  PUSH   DS
  LDS    ESI,dword ptr V
  FLD    qword ptr[ESI]
  FLD    qword ptr[ESI+$08]
  FLD    qword ptr[ESI+$10]
  FLD    S
  FDIV   ST(3),ST(0)
  FDIV   ST(2),ST(0)
  FDIVP  ST(1),ST(0)
  LDS    ESI,dword ptr R
  FSTP   qword ptr[ESI+$10]
  FSTP   qword ptr[ESI+$08]
  FSTP   qword ptr[ESI]
  POP    DS
end;


function AbsV3(V:Vector3):double; assembler;
asm
  PUSH   DS
  LDS    ESI,dword ptr V
  FLD    qword ptr[ESI]
  FLD    ST(0)
  FMULP  ST(1),ST(0)
  FLD    qword ptr[ESI+$08]
  FLD    ST(0)
  FMULP  ST(1),ST(0)
  FADDP  ST(1),ST(0)
  FLD    qword ptr[ESI+$10]
  FLD    ST(0)
  FMULP  ST(1),ST(0)
  FADDP  ST(1),ST(0)
  FSQRT
  POP    DS
end;

function QuickAbsV3(V:Vector3):double; assembler;
asm
  PUSH   DS
  LDS    ESI,dword ptr V
  FLD    qword ptr[ESI]
  FABS
  FLD    qword ptr[ESI+$08]
  FABS
  FADDP  ST(1),ST(0)
  FLD    qword ptr[ESI+$10]
  FABS
  FADDP  ST(1),ST(0)
  POP    DS
end;


procedure NormalizeV3(var V:Vector3); assembler;
asm
  PUSH   DS
  LDS    ESI,dword ptr V
  FLD    qword ptr[ESI]
  FLD    qword ptr[ESI+$08]
  FLD    qword ptr[ESI+$10]
  FLD    ST(2)
  FLD    ST(0)
  FMULP  ST(1),ST(0)
  FLD    ST(2)
  FLD    ST(0)
  FMULP  ST(1),ST(0)
  FADDP  ST(1),ST(0)
  FLD    ST(1)
  FLD    ST(0)
  FMULP  ST(1),ST(0)
  FADDP  ST(1),ST(0)
  FSQRT
  FDIV   ST(3),ST(0)
  FDIV   ST(2),ST(0)
  FDIVP  ST(1),ST(0)
  FSTP   qword ptr[ESI+$10]
  FSTP   qword ptr[ESI+$08]
  FSTP   qword ptr[ESI]
  POP    DS
end;


function MulV3(V1,V2:Vector3):double;  assembler;
asm
  PUSH   DS
  LDS    ESI,dword ptr V1
  FLD    qword ptr[ESI]
  FLD    qword ptr[ESI+$08]
  FLD    qword ptr[ESI+$10]
  LDS    ESI,dword ptr V2
  FLD    qword ptr[ESI]
  FLD    qword ptr[ESI+$08]
  FLD    qword ptr[ESI+$10]
  FMULP  ST(3),ST(0)
  FMULP  ST(3),ST(0)
  FMULP  ST(3),ST(0)
  FADDP  ST(1),ST(0)
  FADDP  ST(1),ST(0)
  POP    DS
end;


procedure CrossV3(V1,V2:Vector3; var R:Vector3); assembler;
asm
  PUSH   DS
  LDS    ESI,dword ptr V1
  FLD    qword ptr[ESI]
  FLD    qword ptr[ESI+$08]
  FLD    qword ptr[ESI+$10]
  LDS    ESI,dword ptr V2
  FLD    qword ptr[ESI]
  FLD    qword ptr[ESI+$08]
  FLD    qword ptr[ESI+$10]
  LDS    ESI,dword ptr R
  FLD    ST(4)
  FMUL   ST(0),ST(1)
  FLD    ST(2)
  FMUL   ST(0),ST(5)
  FSUBP  ST(1),ST(0)
  FSTP   qword ptr[ESI]
  FLD    ST(3)
  FMUL   ST(0),ST(3)
  FLD    ST(6)
  FMUL   ST(0),ST(2)
  FSUBP  ST(1),ST(0)
  FSTP   qword ptr[ESI+$08]
  FLD    ST(5)
  FMUL   ST(0),ST(2)
  FLD    ST(3)
  FMUL   ST(0),ST(6)
  FSUBP  ST(1),ST(0)
  FSTP   qword ptr[ESI+$10]
  FINIT
  POP    DS
end;

procedure DirectionV3(P1,P2:Vector3; var R:Vector3);
begin
  SubV3(P2,P1,R);
  NormalizeV3(R);
end;

procedure RandomUnitV3(var V:Vector3);
begin
  DtoV3(Random-0.5,Random-0.5,Random-0.5,V);
  NormalizeV3(V);
end;
end.

{--------------------------------> Vmath <---------------------------------}
{ This unit contains vector and matrix procedures and functions for TURBO- }
{ PASCAL, partly written as inline assembler code for a 387 coprocessor. }
{ They are about two to three times faster than the equivalent "pure PASCAL" }
{ code. }
{ Known features/limitations/bugs etc.: }
{ - The unit has been written with TP6.0 on an 386SX/IIT387SX machine }
{ - The procedure MulM4V4 needs an IIT coprocessor }
{ - The 287 coprocessor needs additional FWAIT commands in of strategic }
{ places all over the code, since I don't have one I didn't bother. }
{ - All routines PUSH DS on entry, use long pointers (You don't want to }
{ be limited to 64K won't You ?) for operand access and POP DS on exit }
{ - No testing of the routines has been carried out except that they work }
{ fine and fast in my application - NO WARRANTY ! }
{ - I wrote the routines as I needed them (or as I wanted to find out how to }
{ do it, in the case of MulM4V4) but at least the Vector3 operations are }
{ quite complete by now. If I find the time some more Matrix3 code may }
{ follow. }
{----------------------------------------------------------------------------}
{ These routines contain no special artifice, but are straightforward }
{ coded "mathematical common knowledge", so everybody is free to copy }
{ and modify the whole unit or parts of it. And remember: Distributing }
{ sourcecode advances the "Art of Computing" by allowing others to learn }
{ from Your mistakes ! }
{----------------------------------------------------------------------------}
{ I would be pleased to get some feedback (comments/additions/questions or }
{ even a sample application using this unit) from users of Vmath -preferably }
{ via Email - Internet: .edu.au }
{ }
{ _--_|\ Wolfgang Lieff }
{ / \ Flinders Institute for Atmospheric and Marine Sciences }
{ \_.--x_/ Bedford Park , South Australia 5042 }
{ v }
{----------------------------------------------------------------------------}
{ Version 1.0 of 20/05/1991 by Wolfgang Lieff }
{----------------------------------------------------------------------------}

_______________________________________
psw: cea de la wjndowsXP gigabyte..

pus acum 3 ani

Pagini: 1

Mergi la