Source file: /~heha/messtech/pasmex.zip/PASMEX.PAS

unit pasmex;
(************************************************************************
 * Unit zur Erstellung von Matlab-DLL-MEX-Dateien mit Borland Pascal.	*
 * Verwendbar für 16bit Matlab für Windows. Die Funktionen sind gleich-	*
 * namig, jedoch in Pascal-Aufrufkonvention in einer externen DLL.	*
 *									*
 * h#s 07/97, Idee: EA							*
 ************************************************************************
 * Die zu erstellende DLL muß folgenden Aufbau haben:			*
--------------------------------------------------------------------------
library example; {$N+,E-} {MATLAB setzt ohnehin Koprozessor voraus}
uses pasmex,winprocs,wintypes;

procedure mexFunction(nlhs:Integer; var plhs:TMatArr;
  nrhs:Integer; const prhs:TMatArr); export;
 begin
  MessageBox(hWndMATLABCmd,'Hallo Welt','Hi',MB_OK);
 end;

exports
 set_entry_point index 2,
 mexFunction 	 index 3,
 mexAtExitFcn	 index 4;

begin
end.
--------------------------------------------------------------------------
 *									*
 ************************************************************************)

interface
uses WinTypes,DDEML;	{DDEML nur wegen "HConv"-Typ}

const
 mxMAXNAM	=20;
 mxMAXTAG	=4;
 mxMAXDIM	=2;
type
 HPDouble=^Double;	{Symbolischer Huge-Zeiger}
 TDblArr=array[0..8190]of Double; {solange die Zeiger noch nicht HUGE sind}
 HPLongInt=PLongInt;	{Symbolischer Huge-Zeiger}
 TLongArr=array[0..16382]of LongInt; {solange die Zeiger noch nicht HUGE sind}
 PMatrix=^TMatrix;
 TMatrix=record
  name: array[0..mxMAXNAM-1] of Char;
  struc: LongInt;
  mtype: LongInt;
  dmode: LongInt;
  tag: array[0..mxMAXTAG-1] of Char;
  dim: array[0..mxMAXDIM-1] of LongInt;
  case integer of
  0: (pr: HPDouble;	{Huge Pointer!}
      pi: HPDouble;	{Huge Pointer!}
      nzmax: LongInt;
      jc: HPLongInt;	{Huge Pointer!}
      ir: HPLongInt);	{Huge Pointer!}
  1: (pra: ^TDblArr;	{Benutzungsvariante, falls kleiner 64K}
      pia: ^TDblArr;
      nzmaxa: LongInt;	{Füller}
      jca: ^TLongArr;
      ira: ^TLongArr);
 end;
 TMatArr=array[0..16382]of PMatrix;	{Symbolisches Array für plhs, prhs}
const
 mxFULL		=0;
 mxSPARSE	=1;
 mxCOLON	=2;
 mxGLOBAL	=3;
 mxUNASSIGNED	=4;
 mxCLEARMAT	=5;
 mxUNASSARG	=6;
 mxRHSUNASSIGNED=7;
 mxASSIGNED	=8;
 mxSPAM		=9;
const
 mxDOUBLE	=0;
 mxFLOAT	=1;
 mxLONGINT	=2;
 mxSHORTINT	=3;
 mxUSHORTINT	=4;
 mxUCHAR	=5;
const
 mxNUMBER	=0;
 mxSTRING	=1;

type
 HPChar=PChar;
 PPChar=^PChar;
type
 PMatFile=Pointer;	{Keine genaueren Angaben}
 PFile=^TFile;
 TFile=record
  level: Integer;
  flags: Word;
  fd: Char;
  hold: Char;
  bsize: Integer;
  buffer,curp: PChar;
  istemp: Bool;
  token: Integer;
 end;

const
 mxREAL=false;
 mxCOMPLEX=true;
 mxIMAG=true;

const
 matREAD	=0;
 matWRITE	=1;
 matAPPEND	=2;

type
 PEngine=^TEngine;
 TEngine=record
  hgEngine: THandle;
  hConvWithMatlab: HConv;
  UserFcn: TFarProc;
  lTimeout: LongInt;
  pszBuffer: PChar;
  iBufSize: Integer;
 end;


function  mxGetName(pm:PMatrix):PChar;
procedure mxSetName(pm:PMatrix; S:PChar);
function  mxGetM(pm:PMatrix):LongInt;
procedure mxSetM(pm:PMatrix; m:LongInt);
function  mxGetN(pm:PMatrix):LongInt;
procedure mxSetN(pm:PMatrix; n:LongInt);
function  mxGetPr(pm:PMatrix):HPDouble;
procedure mxSetPr(pm:PMatrix; pr:HPDouble);
function  mxGetPi(pm:PMatrix):HPDouble;
procedure mxSetPi(pm:PMatrix; pi:HPDouble);
function  mxGetNzmax(pm:PMatrix):LongInt;
procedure mxSetNzmax(pm:PMatrix; nzmax:LongInt);
function  mxGetIr(pm:PMatrix):HPLongInt;
procedure mxSetIr(pm:PMatrix; ir:HPLongInt);
function  mxGetJc(pm:PMatrix):HPLongInt;
procedure mxSetJc(pm:PMatrix; jc:HPLongInt);
function  mxIsComplex(pm:PMatrix):Bool;
function  mxIsDouble(pm:PMatrix):Bool;
function  mxIsFull(pm:PMatrix):Bool;
function  mxIsNumeric(pm:PMatrix):Bool;
function  mxIsSparse(pm:PMatrix):Bool;
function  mxIsString(pm:PMatrix):Bool;
function  mxGetString(pm:PMatrix; str:HPChar; strlen:LongInt):
  Integer;
function  mxGetScalar(pm:PMatrix):Double;
function  mxCreateFull(m,n:LongInt; ComplexFlag:LongBool):PMatrix;
procedure mxFreeMatrix(pm:PMatrix);
function  mxCalloc(n,size:Word):HPChar;
procedure mxFree(p:HPChar);
function  mxCreateSparse(m,n,nzmax:LongInt; ComplexFlag:LongBool):PMatrix;
function  mxCreateString(str:HPChar):PMatrix;
const
 ExitP:TFarProc=nil;
function  mexAtExit(ExitFcn:TFarProc):Integer;
 inline($66/$8F/$06/>ExitP/$31/$C0);	{pop [ExitP]; xor ax,ax}
function  mexGetGlobal(name:PChar):PMatrix;
function  mexGetMatrixPtr(name: PChar):PMatrix;
function  mexCallMATLAB(nlhs:Integer; var plhs:TMatArr;
  nrhs:Integer; const prhs:TMatArr; name:PChar):Integer;
procedure mexSetTrapFlag(trap_flag:Bool);
procedure mexErrMsgTxt(error_msg:PChar);
{$IFDEF VER80}	{Delphi unterstützt cdecl, jedoch leider keine ...-Listen}
procedure mexPrintf(format:PChar); cdecl;
{$ELSE}
procedure mexPrintf;		{unter BP7 nur in ASM-Blöcken verwendbar}
{$ENDIF}
function  mexEvalString(str:PChar):Integer;
function  mexGetMatrix(name:PChar):PMatrix;
function  mexPutMatrix(pm:PMatrix):Integer;
function  mexGetFull(name:PChar; var m,n:LongInt; var pr,pi:HPDouble):Integer;
function  mexPutFull(name:PChar; m,n:LongInt; pr,pi:HPDouble):Integer;

function  matOpen(filename,mode:PChar):PMatFile;
function  matClose(ph:PMatFile):Integer;
function  matGetFp(ph:PMatFile):PFile;
function  matGetDir(ph:PMatFile; var num:LongInt):PPChar;
function  matDeleteMatrix(ph:PMatFile; name:PChar):Integer;
function  matGetMatrix(ph:PMatFile; name:PChar):PMatrix;
function  matPutMatrix(ph:PMatFile; pm:PMatrix):Integer;
function  matGetNextMatrix(ph:PMatFile):PMatrix;
function  matGetFull(ph:PMatFile; name:PChar; var m,n:LongInt;
  var pr,pi:HPDouble):Integer;
function  matPutFull(ph:PMatFile; name:PChar; m,n:LongInt;
  pr,pi:HPDouble):Integer;
function  matGetString(ph:PMatFile; name:PChar;
  str_ptr:HPChar; str_len:LongInt):Integer;
function  matPutString(ph:PMatFile; name:PChar; str_ptr:HPChar):Integer;

procedure engWinInit(hInstance:THandle);
function  engOpen(startcmd:PChar):PEngine;
procedure engSetEvalTimeout(ep: PEngine; timeout:LongInt);
procedure engSetEvalCallback(ep: PEngine; callback:TFarProc);
function  engEvalString(ep: PEngine; str:PChar):Integer;
function  engClose(ep: PEngine):Integer;
function  engGetMatrix(ep: PEngine; name:PChar):PMatrix;
function  engPutMatrix(ep: PEngine; pm:PMatrix):Integer;
function  engGetFull(ep: PEngine; name:PChar;
  var m,n:LongInt; var pr,pi:HPDouble):Integer;
function  engPutFull(ep: PEngine; name:PChar;
  m,n:LongInt; pr,pi:HPDouble):Integer;
procedure engOutputBuffer(ep: PEngine; p:PChar; n:Integer);

function  hInstMATLAB: THandle;
function  hWndMATLABCmd: HWnd;
function  hInstDLL: THandle;
function  wDataSegment: Word;
function  wHeapSize: Word;

procedure IncHP(var P:PChar; by:Word);
procedure DecHP(var P:PChar; by:Word);
procedure IncHPL(var P:PChar; by:LongInt);

procedure mexVPrintf(format:PChar; const Args; arglen:Word);
function  mxGetLibVersion:Word;

procedure set_entry_point; export;
procedure mexAtExitFcn; export;

type
 PtrRec=record
  ofs,sel: Word;
 end;
 LongRec=record
  lo,hi: Word;
 end;

implementation
{zu reexportierende Funktionen; direkter Reexport ist mit BP nicht möglich}
procedure pipe_SEP; far;	external 'CMEX' index 2;
procedure pipe_AEF; far;	external 'CMEX' index 4;
{MX-Funktionen: ab 100}
function  mxGetName;		external 'CMEX' index 100;
procedure mxSetName;		external 'CMEX' index 101;
function  mxGetM;		external 'CMEX' index 102;
procedure mxSetM;		external 'CMEX' index 103;
function  mxGetN;		external 'CMEX' index 104;
procedure mxSetN;		external 'CMEX' index 105;
function  mxGetPr;		external 'CMEX' index 106;
procedure mxSetPr;		external 'CMEX' index 107;
function  mxGetPi;		external 'CMEX' index 108;
procedure mxSetPi;		external 'CMEX' index 109;
function  mxGetNzmax;		external 'CMEX' index 110;
procedure mxSetNzmax;		external 'CMEX' index 111;
function  mxGetIr;		external 'CMEX' index 112;
procedure mxSetIr;		external 'CMEX' index 113;
function  mxGetJc;		external 'CMEX' index 114;
procedure mxSetJc;		external 'CMEX' index 115;
function  mxIsComplex;		external 'CMEX' index 116;
function  mxIsDouble;		external 'CMEX' index 117;
function  mxIsFull;		external 'CMEX' index 118;
function  mxIsNumeric;		external 'CMEX' index 119;
function  mxIsSparse;		external 'CMEX' index 120;
function  mxIsString;		external 'CMEX' index 121;
function  mxGetString;		external 'CMEX' index 122;
function  mxGetScalar;		external 'CMEX' index 123;
function  mxCreateFull; 	external 'CMEX' index 124;
procedure mxFreeMatrix;		external 'CMEX' index 125;
function  mxCalloc;		external 'CMEX' index 126;
procedure mxFree;		external 'CMEX' index 127;
function  mxCreateSparse;	external 'CMEX' index 128;
function  mxCreateString;	external 'CMEX' index 129;
{MEX-Funktionen: ab 200}
function  pipe_MAE(EP:TFarProc):Integer; far;	external 'CMEX' index 200;
function  mexGetGlobal;		external 'CMEX' index 201;
function  mexGetMatrixPtr;	external 'CMEX' index 202;
function  mexCallMATLAB;	external 'CMEX' index 203;
procedure mexSetTrapFlag;	external 'CMEX' index 204;
procedure mexErrMsgTxt;		external 'CMEX' index 205;
procedure mexPrintf;		external 'CMEX' index 206;
function  mexEvalString;	external 'CMEX' index 207;
function  mexGetMatrix;		external 'CMEX' index 208;
function  mexPutMatrix;		external 'CMEX' index 209;
function  mexGetFull;		external 'CMEX' index 210;
function  mexPutFull;		external 'CMEX' index 211;
{MAT-Funktionen: ab 300}
function  matOpen;		external 'CMEX' index 300;
function  matClose;		external 'CMEX' index 301;
function  matGetFp;		external 'CMEX' index 302;
function  matGetDir;		external 'CMEX' index 303;
function  matDeleteMatrix;	external 'CMEX' index 304;
function  matGetMatrix;		external 'CMEX' index 305;
function  matPutMatrix;		external 'CMEX' index 306;
function  matGetNextMatrix;	external 'CMEX' index 307;
function  matGetFull;		external 'CMEX' index 308;
function  matPutFull;		external 'CMEX' index 309;
function  matGetString;		external 'CMEX' index 310;
function  matPutString;		external 'CMEX' index 311;
{ENG-Funktionen: ab 400}
procedure engWinInit;		external 'CMEX' index 400;
function  engOpen;		external 'CMEX' index 401;
procedure engSetEvalTimeout;	external 'CMEX' index 402;
procedure engSetEvalCallback;	external 'CMEX' index 403;
function  engEvalString	;	external 'CMEX' index 404;
function  engClose;		external 'CMEX' index 405;
function  engGetMatrix;		external 'CMEX' index 406;
function  engPutMatrix;		external 'CMEX' index 407;
function  engGetFull;		external 'CMEX' index 408;
function  engPutFull;		external 'CMEX' index 409;
procedure engOutputBuffer;	external 'CMEX' index 410;
{Variablen-Zugriffe}
function  hInstMATLAB;		external 'CMEX' index 500;
function  hWndMATLABCmd;	external 'CMEX' index 501;
function  hInstDLL;		external 'CMEX' index 502;
function  wDataSegment;		external 'CMEX' index 503;
function  wHeapSize;		external 'CMEX' index 504;
{HugeMem-Zugriffe}
{11.05.99: Sind in CMEX.DLL rätselhafterweise fehlerhaft!!
procedure IncHP;		external 'CMEX' index 600;
procedure DecHP;		external 'CMEX' index 601;
procedure IncHPL;		external 'CMEX' index 602;}

procedure __AHShift; far;	external 'KERNEL' index 113;
procedure __AHIncr; far;	external 'KERNEL' index 114;
{IncHugePointer - Erhöhen eines Zeigers
 auf Speicher mit mehr als 64 Kilobyte; Windows-Version mit AHIncr}
procedure IncHP(var P:PChar; By: Word); assembler;
 asm
  les di,[P]			{Adresse von P}
  mov ax,[By]
  add es:PtrRec[di].Ofs,ax	{Offset inkrementieren}
  jnc @@e			{kein sberlauf: Selektor belassen!}
  add es:PtrRec[di].Sel,offset __AHIncr	{Selektor erhöhen}
@@e:
 end;

{DecHugePointer - Erniedrigen eines Zeigers
 auf Speicher mit mehr als 64 Kilobyte; Windows-Version mit AHIncr}
procedure DecHP(var P:PChar; By: Word); assembler;
 asm
  les di,[P]			{Adresse von P}
  mov ax,[By]
  sub es:PtrRec[di].Ofs,ax	{Offset inkrementieren}
  jnc @@e			{kein Überlauf: Selektor belassen!}
  sub es:PtrRec[di].Sel,offset __AHIncr	{Selektor erniedrigen}
@@e:
 end;

{IncHugePointerLong - Erhöhen und Erniedrigen eines Zeigers
auf Speicher mit mehr als 64 Kilobyte; Windows-Version mit AHIncr}
procedure IncHPL(var P:PChar; By: LongInt); assembler;
 asm
  les di,[P]			{Adresse von P}
  mov cx,LongRec[By].Lo		{Hier AX:CX: ungewöhnlich!}
  mov ax,LongRec[By].Hi
  add es:PtrRec[di].Ofs,cx	{Offset inkrementieren}
  adc ax,0			{Anzahl der 64-K-Übergänge}
  mov cx,offset __AHShift
  shl ax,cl			{Vielfaches erzeugen}
  add es:PtrRec[di].Sel,ax	{Selektor erhöhen bzw. erniedrigen}
 end;

{Extrawurst mexVPrintf}
procedure mexVPrintf;		external 'CMEX' index 700;
function  mxGetLibVersion;	external 'CMEX' index 701;

procedure set_entry_point; external;
procedure mexAtExitFcn; external;
{$L pasmex}

end.
Detected encoding: OEM (CP437)1
Wrong umlauts? - Assume file is ANSI (CP1252) encoded