home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 December / Chip_2001-12_cd1.bin / zkuste / delphi / kompon / d23456 / CAJSCRTP.ZIP / ifs_var.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-10-03  |  33.1 KB  |  1,197 lines
  1. //  Filename: ifs_var.pas
  2. //  Author: Carlo Kok (ckok.1@hccnet.nl)
  3. //
  4. // Innerfuse Pascal Script Variable management, Procedure management and Type Management
  5.  
  6. unit ifs_var;
  7. {$I ifs_def.inc}
  8.  
  9. interface
  10.  
  11. uses
  12.   ifs_utl;
  13.  
  14. type
  15.   TIfPasScriptError = Word;
  16.   TCS2Error = TIfPasScriptError;
  17.  
  18. const
  19.   ERuntimeError = 32768;
  20.   ECompileError = 1;
  21.  
  22.   ENoError = 0;
  23.   ECanNotReadProperty = 1;
  24.   ECanNotWriteProperty = 2;
  25.   EUnknownIdentifier = 3;
  26.   EIdentifierExpected = 4;
  27.   ESemicolonExpected = 5;
  28.   EBeginExpected = 6;
  29.   EDuplicateIdentifier = 7;
  30.   EUnexpectedEndOfFile = 8;
  31.   EColonExpected = 9;
  32.   ESyntaxError = 10;
  33.   EStringError = 11;
  34.   EErrorInStatement = 12;
  35.   EAssignmentExpected = 13;
  36.   ETypeMismatch = 14;
  37.   EErrorInExpression = 15;
  38.   ERoundOpenExpected = 16;
  39.   ERoundCloseExpected = 17;
  40.   EVariableExpected = 18;
  41.   ECommaExpected = 19;
  42.   EThenExpected = 20;
  43.   EPeriodExpected = 21;
  44.   EParameterError = 22;
  45.   EToExpected = 23;
  46.   EDoExpected = 24;
  47.   EOfExpected = 25;
  48.   EEndExpected = 26;
  49.   EOpenBlockExpected = 27;
  50.   ECloseBlockExpected = 28;
  51.   EConstantExpected = 29;
  52.   EIsExpected = 30;
  53.   EIntegerExpected = 31;
  54.   ECloseRoundExpected = 32;
  55.   EUntilExpected = 33;
  56.   {$IFNDEF NOCLASSES}
  57.   EClassNotAllowedHere = 34;
  58.   EClassTypeExpected = 35;
  59.   ECanNotOverride = 36;
  60.   EConstructorExpected = 38;
  61.   ENoInheritedAllowedHere = 39;
  62.   ECanNotReadOrWriteProperty = 40;
  63.   EObjectExpected = 41;
  64.   {$ENDIF}
  65.   EUnsatisfiedForward = 37;
  66.   ECommentError = 42;
  67.   ECharError = 43;
  68.   EExceptExpected = 44;
  69.   EStringExpected = 45;
  70.  
  71.   EUnitNotFound = ERuntimeError + 0;
  72.   EClassNotCreated = ERuntimeError + 1;
  73.   EOutOfRange = ERuntimeError + 2;
  74.   EDivideByZero = ERuntimeError + 3;
  75.   ENotSupported = ERuntimeError + 4;
  76.   EExitCommand = ERuntimeError + 5;
  77.   EClassAlreadyFreed = ERuntimeError + 6;
  78.   EClassReferenceNotAssigned = ERuntimeError + 7;
  79. {$IFNDEF NOVARIANTS}
  80.   EVariantIsNil = ERuntimeError + 8;
  81. {$ENDIF}
  82.   ECustomError = ERuntimeError + 9;
  83.   EOutOfMemoryError = ERuntimeError + 10;
  84.  
  85. const
  86.   CSV_NONE = 0; { Void/ERROR }
  87.   CSV_UByte = 1; { Byte }
  88.   CSV_SByte = 2; { ShortInt }
  89.   CSV_UInt16 = 3; { Word }
  90.   CSV_SInt16 = 4; { Integer (Delphi : SmallInt) }
  91.   CSV_UInt32 = 5; { Longint (Delphi : Cardinal) }
  92.   CSV_SInt32 = 6; { Longint }
  93.   CSV_Char = 7; { Char }
  94.   CSV_String = 8; { String }
  95.   CSV_Real = 9; { Real }
  96.   CSV_Single = 10; { Single }
  97.   CSV_Double = 11; { Double }
  98.   CSV_Extended = 12; { Extended }
  99.   CSV_Comp = 13; { Comp }
  100.   CSV_Bool = 14; { Boolean }
  101.   CSV_Var = 15; { Variable in function call }
  102.   CSV_Array = 16; { Array }
  103.   CSV_Record = 17; { Record }
  104.   CSV_Internal = 19; { Internal }
  105.   {$IFNDEF NOCLASSES}
  106.   CSV_Class = 18; { Class }
  107.   CSV_ClassRef = 20; { Class of Class }
  108.   CSV_Property = 21; { Property }
  109.   {$ENDIF}
  110.   CSV_TypeCopy = 22;
  111.   CSV_ProcVariable = 23;
  112.   CSV_Special = 24;
  113.   {$IFNDEF NOCLASSES}
  114.   CSV_ExternalObject = 25;
  115.   CSV_ExternalObjectProperty = 26;
  116.   {$ENDIF}
  117. {$IFNDEF NOVARIANTS}
  118.   CSV_Variant = 27;
  119. {$ENDIF}
  120.   CSV_Enum = 28;
  121.  
  122. type
  123.   PTypeManager = ^TTypeManager;
  124.   TTypeManager = packed record
  125.     List: TIfList;
  126.   end;
  127.   PTypeRec = ^TTypeRec;
  128.   TTypeRec = record
  129.     Ident: string;
  130.     identhash: cardinal;
  131.     atypeid: Word;
  132.     ext: Pointer;
  133.     { When using records, this will be a pointer to a TIFSRecordType type,
  134.      using string, it is used for the dll call library: 0 = normal string and 1 = pchar
  135.      using arrays it will be a Pointer to TTypeRec
  136.      using classes it will be a pointer to TIfsClassType
  137.      using classreferences it will be a pointer to an TTypeRec
  138.      using property it will be a pointer to the type of the property
  139.      using TypeCopy it will be a pointer an other PTyperec
  140.      using ProcVariable it will be a pointer to an TIfsProcType
  141.      using ExternalObject it will be of type TIFsCustomObjectType
  142.     }
  143.   end;
  144.  
  145.   PIFSProcType = ^TIfsProcType;
  146.   TIfsProcType = packed record
  147.     Decl: string;
  148.     Method: Boolean;
  149.   end;
  150.  
  151.   PIFSRecordType = ^TIFSRecordType;
  152.   TIFSRecordType = packed record
  153.     u: string; // stored like 'Name1 Type1 Name2 Type2' Types as pointers casted to longints.
  154.   end;
  155.  
  156.  
  157.   {$IFNDEF NOCLASSES}
  158.   PIFSClassType = ^TIFSClassType;
  159.   TIFSClassType = packed record
  160.     InheritsFrom: PTypeRec; {until it's nil}
  161.     PropStart, VarNoStart, VarCount: Cardinal; { Used in the variable manager; It's for finding the fields of the class}
  162.     Variables: TIFsRecordType;
  163.     {
  164.       Things before name:                    
  165.       1 Private
  166.       2 Public
  167.       3 Protected
  168.     }
  169.     Properties: TIFList; { of PPropertyDef }
  170.     Procedures: TIfList; { of PProcedure }
  171.     { Flags:
  172.        $1    = Private
  173.        $2    = Public
  174.        $1+$2 = Protected
  175.        $10   = Virtual begin
  176.        $20   = Virtual override
  177.        $40   = Constructor
  178.        $80   = Destructor
  179.     }
  180.     Ext: Pointer;
  181.   end;
  182.   PCreatedClass = ^TCreatedClass;
  183.   TCreatedClass = packed record
  184.     Variables: Pointer;{TVariableManager}
  185.     ClassType: PTypeRec;
  186.     AlreadyFreed: Boolean;
  187.     Ext: Pointer;
  188.   end;
  189.  
  190.   PPropertyDef = ^TPropertyDef;
  191.   TPropertyDef = packed record
  192.     Name: string;
  193.     CV_Type: PTypeRec;
  194.     Cv_PropRead,
  195.     CV_PropWrite: Pointer;
  196.     CV_PropFlags: Word;
  197.       { CSV_Property flags:
  198.          $1 = Readable
  199.          $2 = Writeable
  200.          $4 = CV_Read = Procedure (if not CV_Read = Longint(no) absolute number in TCreatedClass.Variables )
  201.          $8 = CV_Write = Procedure (if not CV_Write = Longint(no) absolute number in TCreatedClass.Variables )
  202.          $10 = Private
  203.          $20 = Public
  204.          $30 = Protected
  205.       }
  206.    end;
  207.   {$ENDIF}
  208.  
  209.   TCSV_UByte = Byte;
  210.   TCSV_SByte = ShortInt;
  211.   TCSV_Char = Char;
  212.   TCSV_UInt16 = Word;
  213.   TCSV_SInt16 = SmallInt;
  214.   TCSV_UInt32 = Cardinal;
  215.   TCSV_SInt32 = Longint;
  216.   PIfVariant = ^TCajVariant;
  217.   PCajVariant = PIfVariant;
  218.   TIfVariant = packed record
  219.     VType: PTypeRec;
  220.     Flags: Byte;
  221.     {
  222.       Readonly(Const) = 1
  223.       Only for classes:
  224.       $2    Private
  225.       $4    Public
  226.       $2+$4 Protected
  227.  
  228.     }
  229.     CV_Str: string;
  230.     case Word of
  231.       CSV_UByte: (CV_UByte: TCSV_UByte);
  232.       CSV_SByte: (CV_SByte: TCSV_SByte);
  233.       CSV_Char: (CV_Char: TCSV_Char);
  234.       CSV_UInt16: (CV_UInt16: TCSV_UInt16);
  235.       CSV_SInt16: (CV_SInt16: TCSV_SInt16);
  236.       CSV_UInt32: (CV_UInt32: TCSV_UInt32);
  237.       CSV_SInt32: (CV_SInt32: TCSV_SInt32);
  238.       CSV_String: ();
  239.       CSV_Real: (CV_Real: Real);
  240.       CSV_Single: (CV_Single: Single);
  241.       CSV_Double: (CV_Double: Double);
  242.       CSV_Extended: (CV_Extended: Extended);
  243.       CSV_Comp: (CV_Comp: Comp);
  244.       CSV_Bool: (CV_Bool: Boolean);
  245.       CSV_Var: (CV_Var: Pointer); {Pointer to a CajVariant}
  246.       CSV_Array: (CV_ArrItems: TifList); {of PIfVariant}
  247.       CSV_Record: (CV_RecItems: TIfList); {of PIfVariant}
  248.   {$IFNDEF NOCLASSES}
  249.       CSV_Class: (CV_Class: PCreatedClass);
  250.       CSV_ClassRef: (Cv_ClassRef: PTypeRec);
  251.       CSV_Property: (CV_Self, Cv_PropRead, CV_PropWrite: Pointer; CV_PropFlags: Word);
  252.   {$ENDIF}
  253.       CSV_Internal: (Cv_Int1,CV_Int2: Pointer);
  254.       CSV_ProcVariable: (Cv_Proc: pointer{$IFNDEF NOCLASSES};Cv_ProcSelf: PCreatedClass{$ENDIF});
  255.       CSV_Special: (CV_Spec: Byte { 0 = nil pointer });
  256.   {$IFNDEF NOCLASSES}
  257.       CSV_ExternalObject: (CV_ExternalObject: Pointer {PCreatedCustomObject});
  258.       CSV_ExternalObjectProperty: (CV_ExtObj: Pointer; CV_PropertyNo: Longint);
  259.   {$ENDIF}
  260.   {$IFNDEF NOVARIANTS}
  261.       CSV_Variant: (CV_Variant: PIfVariant); // always created!
  262.   {$ENDIF}
  263.       CSV_Enum: (CV_Enum: Longint);
  264.   end;
  265.   TCajVariant = TIfVariant;
  266. { Array:
  267.   SubType(s): IntToStr(TypeNo);
  268. }
  269. function CreateCajVariant(PType: PTypeRec): PIfVariant;
  270. procedure DestroyCajVariant(p: PIfVariant);
  271. function ChangeType(p: PIfVariant; newtype: PTypeRec): PIfVariant;
  272. {Changetype changes the type of p but also returns P}
  273.  
  274. type
  275.   PIFNamedVariable = ^TIFNamedVariable;
  276.   TIFNamedVariable = packed record
  277.     Name: string;
  278.     NameHash: Cardinal;
  279.     FVar: PIFVariant;
  280.   end;
  281.   TVariableManager = TIFList;
  282.   PVariableManager = TVariableManager;
  283.  
  284. function VM_Create: PVariableManager;
  285. procedure VM_Destroy(p: PVariableManager);
  286. function VM_Add(P: PVariableManager; D: PIfVariant; const Name: string): PIfVariant;
  287. procedure VM_Delete(p: PVariableManager; Idx: LongInt);
  288. function VM_Get(p: PVariableManager; Idx: LongInt): PIfVariant;
  289. function VM_GetName(p: PVariableManager; Idx: LongInt): String;
  290. procedure VM_SetName(p: PVariableManager; Idx: LongInt; const S: string);
  291. procedure VM_Set(p: PVariableManager; Idx: LongInt; N: PIfVariant);
  292. function VM_Count(p: PVariableManager): LongInt;
  293. function VM_Find(p: PVariableManager; const Name: string): LongInt;
  294. procedure VM_Clear(p: PVariableManager);
  295.  
  296.  
  297.  
  298. type
  299.   PProcedure = ^TProcedure;
  300.   TRegisteredProc = function(Sender, ScriptID: Pointer; Proc: PProcedure; Params: PVariableManager; res: PIfVariant): TIfPasScriptError;
  301.   TRegisteredProcObject = function(Sender, ScriptID: Pointer; Proc: PProcedure; Params: PVariableManager; res: PIfVariant): TIfPasScriptError of object;
  302.   TProcedure = packed record
  303.     FScriptEngine: Pointer;
  304.     Mode: Byte; { 0 = Internal; 1 = RegisteredProc; 2 = RegisteredProc of Object }
  305.     Flags: Word;
  306.     Name,
  307.     Decl: string;
  308.     NameHash: Cardinal;
  309.  {  Spec: RESTYPE PARAM1NAME PARAM1TYPE PARAM2NAME PARAM2TYPE
  310.     an ! before the paramname means is VARIABLE
  311.     an ^ before the paramname means is CONSTANT
  312.  
  313.     an ! before the name means that it's a method (class)
  314.     }
  315.     {$IFNDEF NOCLASSES}ClassType: PTypeRec;{$ENDIF}
  316.     _Ext: Pointer; 
  317.     case Byte of
  318.     0: (Offset: Longint);
  319.     1: (Proc1: TRegisteredProc; _Ext2: Pointer); // _Ext2 can not be used with Proc2, because Proc2 is already 8 bytes.
  320.     2: (Proc2: TRegisteredProcObject);
  321.   end;
  322.  
  323.   TProcedureManager = TIfList;
  324.   PProcedureManager = TProcedureManager;
  325.  
  326. function PM_Create: PProcedureManager;
  327. procedure PM_Destroy(p: PProcedureManager);
  328. procedure PM_Clear(p: PProcedureManager);
  329.  
  330. function PM_AddExtOfObject(p: PProcedureManager; ScriptEngine: Pointer; const Name, Decl: string; {$IFNDEF NOCLASSES}ClassType: PTypeRec;{$ENDIF} Ext: Pointer; Addr: TRegisteredProcObject): PProcedure;
  331. function PM_AddExt(p: PProcedureManager; ScriptEngine: Pointer; const Name, Decl: string; {$IFNDEF NOCLASSES}ClassType: PTypeRec;{$ENDIF} Ext, Addr: Pointer): PProcedure;
  332. function PM_AddInt(p: PProcedureManager; ScriptEngine: Pointer; const Name, Decl: string; {$IFNDEF NOCLASSES}ClassType: PTypeRec;{$ENDIF} Ext: Pointer; Offset: Longint): PProcedure;
  333.  
  334. function PM_Find(p: PProcedureManager; const Name: string): Integer;
  335. function PM_Get(p: PProcedureManager; i: LongInt): PProcedure;
  336.  
  337. function DoMinus(p: PIfVariant): Boolean;
  338. function DoNot(p: PIfVariant): Boolean;
  339.  
  340.  
  341. procedure SetInteger(p: PIfVariant; I: LongInt);
  342. procedure SetReal(p: PIfVariant; i: Extended);
  343. procedure SetString(p: PIfVariant; const I: string);
  344. procedure SetBoolean(p: PIfVariant; i: Boolean);
  345.  
  346. function IsStringType(v: PIfVariant): Boolean;
  347. function IsIntRealType(v: PIfVariant): Boolean;
  348. function IsIntegerType(v: PIfVariant): Boolean;
  349. function IsBooleanType(v: PIfVariant): Boolean;
  350. function IsRealType(v: PIfVariant): Boolean;
  351.  
  352. function GetString(v: PIfVariant): string;
  353. function GetReal(v: PIfVariant): Extended;
  354. function GetInteger(v: PIfVariant): LongInt;
  355. function GetBoolean(v: PIfVariant): Boolean;
  356.  
  357. function ErrorToString(e: TIfPasScriptError; const ErrorString: string): string;
  358.  
  359. function TM_Create: PTypeManager;
  360. function TM_Add(P: PTypeManager; const Name: string; FType: Word; ex: Pointer): Pointer;
  361. function TM_Get(P: PTypeManager; const Name: string): PTypeRec;
  362. procedure TM_Destroy(p: PTypeManager);
  363. {s format of S is: IntToHex(Longint(FType1),8)+IntToHex(Longint(FType2), 8)+etc;}
  364.  
  365. function GetVarLink(p: PIfVariant): PIfVariant;
  366. function GetTypeLink(p: PTypeRec): PTypeRec;
  367.  
  368.  
  369. implementation
  370.  
  371.  
  372. //
  373. //  Function: ErrorToString
  374. //   Purpose: Convert an error code to a string description
  375. //-----------------------------------------------------------
  376.  
  377. function ErrorToString(e: TIfPasScriptError; const ErrorString: string): string;
  378. begin
  379.   case e of
  380.     ENoError: ErrorToString := 'no error';
  381.     ECanNotReadProperty: ErrorToString := 'can not read property';
  382.     ECanNotWriteProperty: ErrorToString := 'can not write property';
  383.     EUnknownIdentifier:
  384.       begin
  385.         if ErrorString <> '' then
  386.           ErrorToString := 'unknown identifier: '+ErrorString
  387.         else
  388.           ErrorToString := 'unknown identifier';
  389.       end;
  390.     EIdentifierExpected: ErrorToString := 'identifier expected';
  391.     ESemicolonExpected: ErrorToString := 'semicolon expected';
  392.     EBeginExpected: ErrorToString := 'begin expected';
  393.     EDuplicateIdentifier: ErrorToString := 'duplicate identifier';
  394.     EUnexpectedEndOfFile: ErrorToString := 'unexpected end of file';
  395.     EColonExpected: ErrorToString := 'colon expected';
  396.     ESyntaxError: ErrorToString := 'syntax error';
  397.     EStringError: ErrorToString := 'string error';
  398.     EErrorInStatement: ErrorToString := 'error in statement';
  399.     EAssignmentExpected: ErrorToString := 'assignment expected';
  400.     ETypeMismatch: ErrorToString := 'type mismatch';
  401.     EErrorInExpression: ErrorToString := 'error in expression';
  402.     ERoundOpenExpected: ErrorToString := 'round open expected';
  403.     ERoundCloseExpected: ErrorToString := 'round close expected';
  404.     EVariableExpected: ErrorToString := 'variable expected';
  405.     ECommaExpected: ErrorToString := 'comma expected';
  406.     EThenExpected: ErrorToString := 'then expected';
  407.     EPeriodExpected: ErrorToString := 'period expected';
  408.     EParameterError: ErrorToString := 'parameter error';
  409.     EToExpected: ErrorToString := 'to expected';
  410.     EDoExpected: ErrorToString := 'do expected';
  411.     EOfExpected: ErrorToString := 'of expected';
  412.     EEndExpected: ErrorToString := 'end expected';
  413.     EOutOfRange: ErrorToString := 'out of range';
  414.     EOpenBlockExpected: ErrorToString := 'open block expected';
  415.     ECloseBlockExpected: ErrorToString := 'close block expected';
  416.     EConstantExpected: ErrorToString := 'constant expected';
  417.     EIsExpected: ErrorToString := 'is expected';
  418.     EUnitNotFound: ErrorToString := 'unit is not found';
  419.     EIntegerExpected: ErrorToString := 'integer variable expected';
  420.     ENotSupported: ErrorToString := 'command is not supported';
  421.     ECloseRoundExpected: ErrorToString := 'close round expected';
  422.     EUntilExpected: ErrorToString := 'until expected';
  423.     EDivideByZero: ErrorToString := 'divide by zero';
  424.     {$IFNDEF NOCLASSES}
  425.     EClassNotCreated: ErrorToString := 'class is not created';
  426.     EClassNotAllowedHere: ErrorToString := 'class not allowed here';
  427.     EClassTypeExpected: ErrorToString := 'class type expected';
  428.     ECanNotOverride: ErrorToString := 'can not override';
  429.     EUnsatisfiedForward: ErrortoString := 'unsatisfied forward: '+ErrorString;
  430.     EConstructorExpected: ErrorToString := 'constructor expected';
  431.     ENoInheritedAllowedHere: errorToString := 'no inherited allowed here';
  432.     EClassAlreadyFreed: ErrorToString := 'class already freed';
  433.     EClassReferenceNotAssigned: ErrorToString := 'class reference not assigned';
  434.     ECanNotReadOrWriteProperty: ErrorToString := 'can not read or write property';
  435.     EObjectExpected: ErrorToString := 'object expected';
  436.     {$ENDIF}
  437. {$IFNDEF NOVARIANTS}
  438.     EVariantIsNil: ErrorToString := 'variant is nil';
  439. {$ENDIF}
  440.     ECustomError: ErrorToString := ErrorString;
  441.     ECommentError: ErrorToString := 'comment error';
  442.     ECharError: ErrorToString := 'char error';
  443.     EOutOfMemoryError: ErrorToString := 'out of memory';
  444.     EExceptExpected: ErrorToString := 'except expected';
  445.     EStringExpected: ErrorToString := 'string expected'
  446.  
  447.   else
  448.     ErrorToString := 'unknown error';
  449.   end;
  450. end;
  451.  
  452. function GetTypeLink(p: PTypeRec): PTypeRec;
  453. begin
  454.   while (p<>nil) and (p^.atypeid = CSV_TypeCopy) do
  455.   begin
  456.     p := p^.ext;
  457.   end;
  458.   GetTypeLink := p;
  459. end;
  460.  
  461.  
  462. function CreateCajVariant(PType: PTypeRec): PIfVariant;
  463. {
  464.   Creates an instance of a CajVariant.
  465. }
  466. var
  467.   p: PIfVariant;
  468.   n: PTypeRec;
  469.   s: string;
  470. begin
  471.   PType := GetTypeLink(PType);
  472.   if PTYpe = nil then begin CreatecajVariant := nil; exit;end;
  473.   New(p);
  474.   FillChar(p^, Sizeof(P^), 0);
  475.   p^.VType := PType;
  476.   p^.Flags := 0;
  477.   {$IFNDEF NOVARIANTS}
  478.   if PType^.ATypeID = CSV_Variant then
  479.   begin
  480.     p^.CV_Variant := nil;
  481.   end else
  482.   {$ENDIF}
  483.   {$IFNDEF NOCLASSES}
  484.   if PType^.ATypeId = CSV_ExternalObject then
  485.   begin
  486.     p^.CV_ExternalObject := nil;
  487.   end else
  488.   if PType^.AtypeID = CSV_ClassRef then
  489.   begin
  490.     p^.Cv_ClassRef := nil;
  491.   end else {$ENDIF}
  492.   if Ptype^.AtypeID = CSV_Internal then
  493.   begin
  494.     p^.Cv_Int1 := nil;
  495.     p^.Cv_Int2 := nil;
  496.   end else{$IFNDEF NOCLASSES}
  497.   if pType^.Atypeid = CSV_Class then
  498.   begin
  499.     p^.CV_Class := nil;
  500.   end else
  501.   if PType^.ATypeid = CSV_Property then
  502.   begin
  503.     p^.CV_PropFlags := 0;
  504.   end else{$ENDIF}
  505.   if PType^.atypeid = CSV_Var then
  506.     p^.CV_Var := nil
  507.   else if PType^.atypeid = CSV_Array then
  508.   begin
  509.     p^.CV_ArrItems := TIfList.Create;
  510.   end else if PType^.Atypeid = CSV_Record then
  511.   begin
  512.     p^.CV_RecItems := TIfList.Create;
  513.     s := PIFsRecordType(Ptype^.ext)^.u;
  514.     while length(s) > 0 do
  515.     begin
  516.       rfw(S); {remove name}
  517.       n := Pointer(longint(StrToIntDef(Fw(s), 0)));
  518.       if n = nil then break;
  519.       p^.Cv_RecItems.Add(CreateCajVariant(n));
  520.       rfw(s); {remove type}
  521.     end;
  522.   end else if PType^.AtypeID = CSV_String then
  523.   begin
  524.     p^.CV_Str := ''
  525.   end else if PType^.ATypeId = CSV_ProcVariable then
  526.   begin
  527.     P^.Cv_Proc := nil;
  528.     {$IFNDEF NOCLASSES}
  529.     p^.CV_ProcSelf := nil;
  530.     {$ENDIF}
  531.   end;
  532.   CreateCajVariant := p;
  533. end;
  534.  
  535.  
  536. function ChangeType(p: PIfVariant; newtype: PTypeRec): PIfVariant;
  537. { Changes the type of a variant }
  538. var
  539.   n: PTypeRec;
  540.   s: string;
  541.   i: Integer;
  542. begin
  543.   if NewType = nil then begin ChangeType := nil; exit;end;
  544.   newtype := GetTypeLink(newtype);
  545.   {$IFNDEF NOVARIANTS}
  546.   if p^.VType^.ATypeID = CSV_variant then
  547.   begin
  548.     if assigned(p^.CV_Variant) then
  549.       DestroyCajVariant(P^.CV_Variant);
  550.   end else {$ENDIF}
  551.   if P^.Vtype^.atypeid = CSV_Array then
  552.   begin
  553.     for i := 0 to Longint(p^.CV_ArrItems.count) - 1 do
  554.     begin
  555.       DestroyCajVariant(p^.CV_ArrItems.GetItem(i));
  556.     end;
  557.     p^.CV_ArrItems.Free;
  558.   end else if p^.Vtype^.atypeid = CSV_Record then
  559.   begin
  560.     for i := 0 to Longint(p^.CV_RecItems.count) - 1 do
  561.     begin
  562.       DestroyCajVariant(p^.CV_RecItems.GetItem(i));
  563.     end;
  564.     p^.CV_RecItems.Free;
  565.   end;
  566.   FillChar(p^, Sizeof(P), 0);
  567.   p^.VType := newtype;
  568.   {$IFNDEF NOVARIANTS}
  569.   if newtype^.ATypeID = CSV_Variant then
  570.   begin
  571.     p^.CV_Variant := nil;
  572.   end else
  573.   {$ENDIF}
  574.   if NewType.AtypeID = CSV_Internal then
  575.   begin
  576.     p^.Cv_Int1 := nil;
  577.     p^.Cv_Int2 := nil;
  578.   end else{$IFNDEF NOCLASSES}
  579.   if newtype^.ATypeId = CSV_ExternalObject then
  580.   begin
  581.     p^.CV_ExternalObject := nil;
  582.   end else
  583.   if NewType.ATypeid = CSV_Class then
  584.   begin
  585.     P^.CV_Class := nil;
  586.   end else {$ENDIF}
  587.   if newtype.atypeid = CSV_Var then
  588.     p^.CV_Var := nil
  589.   else if newtype.atypeid = CSV_Array then
  590.   begin
  591.     p^.CV_ArrItems := TIfList.Create;
  592.   end else if newtype.Atypeid = CSV_Record then
  593.   begin
  594.     p^.CV_RecItems := TIfList.Create;
  595.     s := PIFsRecordType(newtype^.ext)^.u;
  596.     while length(s) > 0 do
  597.     begin
  598.       rfw(S); {remove name}
  599.       n := Pointer(longint(StrToIntDef(Fw(s), 0)));
  600.       if n = nil then break;
  601.       p^.Cv_RecItems.Add(CreateCajVariant(n));
  602.       rfw(s); {remove type}
  603.     end;
  604.   end else if newtype^.ATypeId = CSV_String then
  605.     p^.CV_Str := ''
  606.   else if newtype^.ATypeId = CSV_ProcVariable then
  607.   begin
  608.     P^.Cv_Proc := nil;
  609.     {$IFNDEF NOCLASSES}
  610.     P^.Cv_ProcSelf := nil;
  611.     {$ENDIF}
  612.   end;
  613.   changeType := P;
  614. end;
  615.  
  616. procedure DestroyCajVariant(p: PIfVariant);
  617. { Destroys an instance of a CajVariant.}
  618. var
  619.   i: Longint;
  620. begin
  621.   if Assigned(p) then
  622.   begin
  623.     {$IFNDEF NOVARIANTS}
  624.     if p^.VType^.ATypeID = CSV_variant then
  625.     begin
  626.       if assigned(p^.CV_Variant) then
  627.         DestroyCajVariant(P^.CV_Variant);
  628.     end else {$ENDIF}
  629.     if P^.Vtype^.atypeid = CSV_Array then
  630.     begin
  631.       for i := 0 to Longint(p^.CV_ArrItems.count) - 1 do
  632.       begin
  633.         DestroyCajVariant(p^.CV_ArrItems.GetItem(i));
  634.       end;
  635.       p^.CV_ArrItems.Free;
  636.     end else if p^.Vtype^.atypeid = CSV_Record then
  637.     begin
  638.       for i := 0 to Longint(p^.CV_RecItems.count) - 1 do
  639.       begin
  640.         DestroyCajVariant(p^.CV_RecItems.GetItem(i));
  641.       end;
  642.       p^.CV_RecItems.Free;
  643.     end;
  644.     Dispose(p);
  645.   end;
  646. end;
  647.  
  648. function VM_Create: PVariableManager;
  649. {Creates an instance of a VariableManger}
  650. begin
  651.   VM_Create := TIFList.Create;
  652. end;
  653.  
  654. procedure VM_Destroy(p: PVariableManager);
  655. {Destroys an instance of a VariableManager}
  656. var
  657.   i: Integer;
  658.   x: PIFNamedVariable;
  659. begin
  660.   for i := 0 to Longint(p.count) - 1 do
  661.   begin
  662.     x := p.GetItem(I);
  663.     DestroyCajVariant(x^.FVar);
  664.     Dispose(x);
  665.   end;
  666.   p.Free;
  667. end;
  668.  
  669. function VM_Add(P: PVariableManager; D: PIfVariant; const Name: string): PIfVariant;
  670. var
  671.   temp: PIFNamedVariable;
  672. begin
  673.   new(temp);
  674.   temp^.Name := name;
  675.   temp^.NameHash := MKHash(name);
  676.   temp^.FVar := d;
  677.   p.Add(temp);
  678.   result := d;
  679. end;
  680.  
  681. procedure VM_Clear(p: PVariableManager);
  682. var
  683.   i: Integer;
  684.   x: PIFNamedVariable;
  685. begin
  686.   for i := 0 to Longint(p.count) - 1 do
  687.   begin
  688.     x := p.GetItem(I);
  689.     DestroyCajVariant(x^.FVar);
  690.     Dispose(x);
  691.   end;
  692.   p.Clear;
  693. end;
  694.  
  695. procedure VM_Delete(p: PVariableManager; Idx: LongInt);
  696. var
  697.   x: PIFNamedVariable;
  698. begin
  699.   x := p.GetItem(idx);
  700.   if x <> nil then
  701.   begin
  702.     dispose(x);
  703.   end;
  704.   p.Delete(idx);
  705. end;
  706.  
  707. function VM_Find(p: PVariableManager; const Name: string): LongInt;
  708. var
  709.   i: Integer;
  710.   h: LongWord;
  711. begin
  712.   h := mkhash(name);
  713.   for i := 0 to Longint(p.Count) - 1 do
  714.   begin
  715.     if (PIFNamedVariable(p.GetItem(i))^.NameHash = h) and (PIFNamedVariable(p.getitem(i))^.Name = Name) then
  716.     begin
  717.       VM_Find := I;
  718.       Exit;
  719.     end;
  720.   end;
  721.   VM_Find := -1;
  722. end;
  723.  
  724. function VM_Count(p: PVariableManager): LongInt;
  725. begin
  726.   VM_Count := P.Count;
  727. end;
  728.  
  729. function VM_Get(p: PVariableManager; Idx: LongInt): PIfVariant;
  730. var
  731.   tmp: PIFNamedVariable;
  732. begin
  733.   tmp := P.GetItem(idx);
  734.   if tmp = nil then
  735.     vm_get := nil
  736.   else
  737.     VM_Get := tmp^.FVar;
  738. end;
  739. function VM_GetName(p: PVariableManager; Idx: LongInt): String;
  740. var
  741.   tmp: PIFNamedVariable;
  742. begin
  743.   tmp := P.GetItem(idx);
  744.   if tmp <> nil then
  745.     VM_GetName := tmp^.Name;
  746. end;
  747.  
  748. procedure VM_Set(p: PVariableManager; Idx: LongInt; N: PIfVariant);
  749. var
  750.   tmp: PIFNamedVariable;
  751. begin
  752.   tmp := P.GetItem(idx);
  753.   if tmp <> nil then
  754.     tmp^.FVar := n;
  755. end;
  756.  
  757. procedure VM_SetName(p: PVariableManager; Idx: LongInt; const S: string);
  758. var
  759.   tmp: PIFNamedVariable;
  760. begin
  761.   tmp := P.GetItem(idx);
  762.   if tmp <> nil then
  763.   begin
  764.     tmp^.Name := s;
  765.     tmp^.NameHash := mkhash(s);
  766.   end;
  767. end;
  768.  
  769.  
  770. function PM_Create: PProcedureManager;
  771. {Creates an instance of a Procedure Manager}
  772. begin
  773.   PM_Create := TIFList.Create;
  774. end;
  775.  
  776. procedure PM_Clear(p: PProcedureManager);
  777. var
  778.   n: PProcedure;
  779.   i: Integer;
  780. begin
  781.   for i := 0 to Longint(p.Count) -1 do
  782.   begin
  783.     n := p.GetItem(I);
  784.     Dispose(n);
  785.   end;
  786.   p.Clear;
  787. end;
  788.  
  789. procedure PM_Destroy(p: PProcedureManager);
  790. begin
  791.   PM_Clear(p);
  792.   p.Free;
  793. end;
  794.  
  795. function PM_AddExtOfObject(p: PProcedureManager; ScriptEngine: Pointer; const Name, Decl: string; {$IFNDEF NOCLASSES}ClassType: PTypeRec;{$ENDIF} Ext: Pointer; Addr: TRegisteredProcObject): PProcedure;
  796. var
  797.   n: PProcedure;
  798. begin
  799.   new(n);
  800.   n^.FScriptEngine := ScriptEngine;
  801.   N^.Flags := 0;
  802.   n^.Mode := 2;
  803.   n^.Name := Name;
  804.   n^.NameHash := mkhash(name);
  805.   N^.Decl := Decl;
  806.   N^._Ext := Ext;
  807.   n^.Proc2 := Addr;
  808.   {$IFNDEF NOCLASSES}
  809.   n^.ClassType := ClassType;
  810.   {$ENDIF}
  811.   P.Add(n);
  812.   PM_AddExtOfObject:= N;
  813. end;
  814. function PM_AddExt(p: PProcedureManager; ScriptEngine: Pointer; const Name, Decl: string; {$IFNDEF NOCLASSES}ClassType: PTypeRec;{$ENDIF} Ext, Addr: Pointer): PProcedure;
  815. var
  816.   n: PProcedure;
  817. begin
  818.   new(n);
  819.   n^.FScriptEngine := ScriptEngine;
  820.   N^.Flags := 0;
  821.   n^.Mode := 1;
  822.   n^.Name := Name;
  823.   n^.NameHash := mkhash(name);
  824.   N^.Decl := Decl;
  825.   N^._Ext := Ext;
  826.   n^.Proc1 := Addr;
  827.   {$IFNDEF NOCLASSES}
  828.   n^.ClassType := ClassType;
  829.   {$ENDIF}
  830.   P.Add(n);
  831.   PM_AddExt:= N;
  832. end;
  833.  
  834. function PM_AddInt(p: PProcedureManager; ScriptEngine: Pointer; const Name, Decl: string; {$IFNDEF NOCLASSES}ClassType: PTypeRec;{$ENDIF} Ext: Pointer; Offset: Longint): PProcedure;
  835. var
  836.   n: PProcedure;
  837. begin
  838.   new(n);
  839.   N^.FScriptEngine := ScriptEngine;
  840.   N^.Flags := 0;
  841.   n^.Mode := 0;
  842.   n^.Name := Name;
  843.   n^.NameHash := mkhash(name);
  844.   N^.Decl := Decl;
  845.   N^._Ext := Ext;
  846.   {$IFNDEF NOCLASSES}
  847.   N^.ClassType := ClassType;
  848.   {$ENDIF}
  849.   n^.Offset := Offset;
  850.   P.Add(n);
  851.   PM_AddInt:= N;
  852. end;
  853.  
  854.  
  855. function PM_Find(p: PProcedureManager; const Name: string): Integer;
  856. var
  857.   i: Integer;
  858.   c: Cardinal;
  859. begin
  860.   c := mkhash(name);
  861.   for i := 0 to Longint(p.Count) - 1 do
  862.   begin
  863.     if (PProcedure(p.GetItem(i))^.NameHash = c) and (PProcedure(p.GetItem(i))^.Name = Name) then
  864.     begin
  865.       PM_Find:= I;
  866.       exit;
  867.     end;
  868.   end;
  869.   PM_Find := -1;
  870. end;
  871.  
  872. function PM_Get(p: PProcedureManager; i: LongInt): PProcedure;
  873. begin
  874.   PM_Get := p.GetItem(i);
  875. end;
  876.  
  877. function GetVarLink(p: PIfVariant): PIfVariant;
  878. begin
  879.   if assigned(p) then
  880.   begin
  881.     while p.VType.atypeid = CSV_VAR do
  882.     begin
  883.       if assigned(p^.CV_Var) then
  884.         p := p^.CV_Var
  885.       else
  886.         break;
  887.     end;
  888.   end;
  889.   GetVarLink := p;
  890. end;
  891.  
  892. function DoMinus(p: PIfVariant): Boolean;
  893. begin
  894.   p := GetVarLink(p);
  895.   DoMinus := True;
  896.   case P^.VType^.atypeid of
  897.     CSV_UByte: p^.Cv_UByte := -p^.Cv_UByte;
  898.     CSV_SByte: p^.Cv_SByte := -p^.Cv_SByte;
  899.     CSV_UInt16: p^.Cv_UInt16 := -p^.Cv_UInt16;
  900.     CSV_SInt16: p^.Cv_SInt16 := -p^.Cv_SInt16;
  901.     CSV_UInt32: p^.Cv_UInt32 := -p^.Cv_UInt32;
  902.     CSV_SInt32: p^.Cv_SInt32 := -p^.Cv_SInt32;
  903.     CSV_Real: p^.Cv_Real := -p^.Cv_Real;
  904.     CSV_Single: p^.Cv_Single := -p^.cv_Single;
  905.     CSV_Double: p^.Cv_Double := -p^.Cv_Double;
  906.     CSV_Extended: p^.Cv_Extended := -p^.Cv_Extended;
  907.     CSV_Comp: p^.Cv_Comp := -p^.Cv_Comp;
  908.   else
  909.     DoMinus := False;
  910.   end;
  911. end;
  912.  
  913. function DoNot(p: PIfVariant): Boolean;
  914. begin
  915.   p := GetVarLink(p);
  916.   DoNot := True;
  917.   case P^.VType^.atypeid of
  918.     CSV_UByte: p^.Cv_UByte := not p^.Cv_UByte;
  919.     CSV_SByte: p^.Cv_SByte := not p^.Cv_SByte;
  920.     CSV_UInt16: p^.Cv_UInt16 := not p^.Cv_UInt16;
  921.     CSV_SInt16: p^.Cv_SInt16 := not p^.Cv_SInt16;
  922.     CSV_UInt32: p^.Cv_UInt32 := not p^.Cv_UInt32;
  923.     CSV_SInt32: p^.Cv_SInt32 := not p^.Cv_SInt32;
  924.     CSV_Bool: p^.CV_Bool := not p^.CV_Bool;
  925.   else
  926.     DoNot := False;
  927.   end;
  928. end;
  929.  
  930. procedure SetInteger(p: PIfVariant; I: LongInt);
  931. begin
  932.   p := GetVarLink(p);
  933.   case P^.VType^.atypeid of
  934.     CSV_UByte: p^.Cv_UByte := i;
  935.     CSV_SByte: p^.Cv_SByte := i;
  936.     CSV_UInt16: p^.Cv_UInt16 := i;
  937.     CSV_SInt16: p^.Cv_SInt16 := i;
  938.     CSV_UInt32: p^.Cv_UInt32 := i;
  939.     CSV_SInt32: p^.Cv_SInt32 := i;
  940.   end;
  941. end;
  942.  
  943. procedure SetReal(p: PIfVariant; i: Extended);
  944. begin
  945.   p := GetVarLink(p);
  946.   case P^.VType^.atypeid of
  947.     CSV_Real: P^.CV_Real := i;
  948.     CSV_Single: P^.CV_Single := i;
  949.     CSV_Double: P^.CV_Double := i;
  950.     CSV_Extended: P^.CV_Extended := i;
  951.     CSV_Comp: P^.CV_Comp := i;
  952.   end;
  953. end;
  954.  
  955. procedure SetBoolean(p: PIfVariant; i: Boolean);
  956. begin
  957.   p := GetVarLink(p);
  958.   case P^.VType^.atypeid of
  959.     CSV_Bool: P^.CV_Bool := i;
  960.   end;
  961. end;
  962.  
  963. procedure SetString(p: PIfVariant; const I: string);
  964. begin
  965.   p := GetVarLink(p);
  966.   case P^.VType^.atypeid of
  967.     CSV_String: P^.Cv_Str := i;
  968.   end;
  969. end;
  970.  
  971. function IsRealType(v: PIfVariant): Boolean;
  972. begin
  973.   v := GetVarLink(v);
  974.   IsRealType := (V^.VType^.atypeid = CSV_Real) or
  975.     (v^.Vtype^.atypeid = CSV_Single) or
  976.     (v^.Vtype^.atypeid = CSV_Double) or
  977.     (v^.Vtype^.atypeid = CSV_Extended) or
  978.     (v^.Vtype^.atypeid = CSV_Comp);
  979. end;
  980.  
  981. function IsIntegerType(v: PIfVariant): Boolean;
  982. begin
  983.   v := GetVarLink(v);
  984.   IsIntegerType := (v^.VType^.atypeid = CSV_UByte) or
  985.     (v^.Vtype^.atypeid = CSV_SByte) or
  986.     (v^.VType^.atypeid = CSV_UInt16) or
  987.     (v^.VType^.atypeid = CSV_SInt16) or
  988.     (v^.VType^.atypeid = CSV_UInt32) or
  989.     (v^.VType^.atypeid = CSV_SInt32);
  990. end;
  991.  
  992. function IsBooleanType(v: PIfVariant): Boolean;
  993. begin
  994.   v := GetVarLink(v);
  995.   IsBooleanType := (v^.VType^.atypeid = CSV_Bool);
  996. end;
  997.  
  998. function IsIntRealType(v: PIfVariant): Boolean;
  999. begin
  1000.   v := GetVarLink(v);
  1001.   IsIntRealType := (v^.VType^.atypeid = CSV_UByte) or
  1002.     (v^.VType^.atypeid = CSV_SByte) or
  1003.     (v^.VType^.atypeid = CSV_UInt16) or
  1004.     (v^.VType^.atypeid = CSV_SInt16) or
  1005.     (v^.VType^.atypeid = CSV_UInt32) or
  1006.     (v^.VType^.atypeid = CSV_SInt32) or
  1007.     (V^.VType^.atypeid = CSV_Real) or
  1008.     (v^.VType^.atypeid = CSV_Single) or
  1009.     (v^.VType^.atypeid = CSV_Double) or
  1010.     (v^.VType^.atypeid = CSV_Extended) or
  1011.     (v^.VType^.atypeid = CSV_Comp);
  1012. end;
  1013.  
  1014. function IsStringType(v: PIfVariant): Boolean;
  1015. begin
  1016.   v := GetVarLink(v);
  1017.   IsStringType := (v^.VType^.atypeid = CSV_Char) or
  1018.     (v^.VType^.atypeid = CSV_String);
  1019. end;
  1020.  
  1021. function GetInteger(v: PIfVariant): LongInt;
  1022. begin
  1023.   v := GetVarLink(v);
  1024.   case v^.VType^.aTypeid of
  1025.     CSV_UByte: GetInteger := V^.CV_UByte;
  1026.     CSV_SByte: GetInteger := V^.CV_SByte;
  1027.     CSV_UInt16: GetInteger := V^.CV_UInt16;
  1028.     CSV_SInt16: GetInteger := V^.CV_SInt16;
  1029.     CSV_UInt32: GetInteger := V^.CV_UInt32;
  1030.     CSV_SInt32: GetInteger := V^.CV_SInt32;
  1031.   else GetInteger := 0;
  1032.   end;
  1033. end;
  1034.  
  1035. function GetReal(v: PIfVariant): Extended;
  1036. begin
  1037.   v := GetVarLink(v);
  1038.   case v^.VType^.aTypeid of
  1039.     CSV_Real: GetReal := V^.CV_Real;
  1040.     CSV_Single: GetReal := V^.CV_single;
  1041.     CSV_Double: GetReal := V^.CV_double;
  1042.     CSV_Extended: GetReal := V^.CV_Extended;
  1043.     CSV_Comp: GetReal := V^.CV_Comp;
  1044.     CSV_UByte: GetReal := V^.CV_UByte;
  1045.     CSV_SByte: GetReal := V^.CV_SByte;
  1046.     CSV_UInt16: GetReal := V^.CV_UInt16;
  1047.     CSV_SInt16: GetReal := V^.CV_SInt16;
  1048.     CSV_UInt32: GetReal := V^.CV_UInt32;
  1049.     CSV_SInt32: GetReal := V^.CV_SInt32;
  1050.   else
  1051.     GetReal := 0;
  1052.   end;
  1053. end;
  1054.  
  1055. function GetString(v: PIfVariant): string;
  1056. begin
  1057.   v := GetVarLink(v);
  1058.   case v^.VType^.aTypeid of
  1059.     CSV_String: GetString := V^.CV_Str;
  1060.     CSV_Char: GetString := V^.CV_Char;
  1061.   end;
  1062. end;
  1063.  
  1064. function GetBoolean(v: PIfVariant): Boolean;
  1065. begin
  1066.   v := GetVarLink(v);
  1067.   case v^.VType^.aTypeid of
  1068.     CSV_Bool: GetBoolean := V^.CV_Bool;
  1069.   else
  1070.     GetBoolean := False;
  1071.   end;
  1072. end;
  1073.  
  1074.  
  1075. function TM_Create: PTypeManager;
  1076. var
  1077.   x: PTypeManager;
  1078. begin
  1079.   new(X);
  1080.   X^.List := TIFList.Create;
  1081.   TM_Create := x;
  1082. end;
  1083.  
  1084. function TM_Add(P: PTypeManager; const Name: string; FType: Word; ex: Pointer): Pointer;
  1085. var
  1086.   n: PTypeRec;
  1087.   i: Integer;
  1088. begin
  1089.   if (Name = '') then
  1090.   begin
  1091.     {$IFNDEF NOCLASSES}if FType <> CSV_Class then
  1092.     begin{$ENDIF}
  1093.       for i := 0 to Longint(p.List.Count) - 1 do
  1094.       begin
  1095.         if (PTypeRec(p.List.GetItem(i))^.atypeid = FType) and (PTypeRec(p.List.GetItem(i))^.ext = Ex) then
  1096.         begin
  1097.           TM_Add := p.List.GetItem(i);
  1098.           Exit;
  1099.         end;
  1100.       end;
  1101.     {$IFNDEF NOCLASSES}end;{$ENDIF}
  1102.     new(n);
  1103.     N^.Ident := Name;
  1104.     n^.identhash := mkhash(n^.Ident);
  1105.     N^.atypeid := FType;
  1106.     N^.ext := ex;
  1107.     p^.List.Add(n);
  1108.     TM_Add := N;
  1109.   end else
  1110.     if (TM_GET(p, Name) = nil) then
  1111.     begin
  1112.       new(n);
  1113.       N^.Ident := Name;
  1114.       n^.identhash := mkhash(n^.Ident);
  1115.       N^.atypeid := FType;
  1116.       N^.ext := ex;
  1117.       p^.List.Add(n);
  1118.       TM_ADD := n;
  1119.     end else
  1120.       TM_Add := nil;
  1121. end;
  1122.  
  1123. procedure DisposeTypeRec(p: PTypeRec);
  1124.   procedure DestroyRecord(p: PIFSRecordType);
  1125.   begin
  1126.     Dispose(p);
  1127.   end;
  1128.   procedure DestroyProc(p: PIFSProcType);
  1129.   begin
  1130.     Dispose(p);
  1131.   end;
  1132.   {$IFNDEF NOCLASSES}
  1133.   procedure DestroyClass(c: PIFSClassType);
  1134.   var
  1135.     i: Longint;
  1136.     p: PPropertyDef;
  1137.   begin
  1138.     for i := 0 to Longint(c^.Properties.Count) -1 do
  1139.     begin
  1140.       p := c^.Properties.GetItem(i);
  1141.       Dispose(p);
  1142.     end;
  1143.     c^.Properties.Free;
  1144.     c^.Procedures.Free;
  1145.     Dispose(c);
  1146.   end;
  1147.   {$ENDIF}
  1148.  
  1149. begin
  1150.   if (p^.atypeid = CSV_Record) and (assigned(p^.ext)) then
  1151.   begin
  1152.     DestroyRecord(p^.ext);
  1153.   end else
  1154.   if (P^.ATypeID = CSV_ProcVariable) and (Assigned(P^.Ext)) then
  1155.   begin
  1156.     DestroyProc(p^.Ext);
  1157.   end {$IFNDEF NOCLASSES} else
  1158.   if (p^.AtypeId = CSV_Class) and assigned(p^.Ext) then
  1159.   begin
  1160.     DestroyClass(p^.ext);
  1161.   end{$ENDIF};
  1162.   Dispose(p);
  1163. end;
  1164.  
  1165. function TM_Get(P: PTypeManager; const Name: string): PTypeRec;
  1166. var
  1167.   i: Integer;
  1168.   c: Cardinal;
  1169. begin
  1170.   c := mkhash(name);
  1171.   for i := 0 to Longint(p^.List.Count) - 1 do
  1172.   begin
  1173.     if (c = PTypeRec(p^.List.GetItem(i))^.identhash) and (name = PTypeRec(p^.List.GetItem(i))^.ident) then
  1174.     begin
  1175.       TM_Get := p^.List.GetItem(i);
  1176.       exit;
  1177.     end;
  1178.   end;
  1179.   TM_Get := nil;
  1180. end;
  1181.  
  1182. procedure TM_Destroy(p: PTypeManager);
  1183. var
  1184.   I: Integer;
  1185. begin
  1186.   for i := 0 to Longint(p^.List.Count) - 1 do
  1187.   begin
  1188.     DisposeTypeRec(p^.List.GetItem(i));
  1189.   end;
  1190.   p.List.Free;
  1191.   Dispose(p);
  1192. end;
  1193.  
  1194.  
  1195. end.
  1196.  
  1197.