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
|
|
|