OTypes.pas
上传用户:yj_qiu
上传日期:2022-08-08
资源大小:23636k
文件大小:12k
源码类别:

游戏引擎

开发平台:

Delphi

  1. (*
  2.  @Abstract(Compiler types unit)
  3.  (C) 2006-2007 George "Mirage" Bakhtadze. <a href="http://www.casteng.com">www.casteng.com</a> <br>
  4.  The source code may be used under either MPL 1.1 or LGPL 2.1 license. See included license.txt file <br>
  5.  Started Jul 15, 2004
  6.  The unit contains the compiler basic constants and types
  7. *)
  8. unit OTypes;
  9. interface
  10. uses BaseTypes, SysUtils;
  11. type TToken = (tNone, tIdentifier, tOperator, tExpression, tRelation, tOperation, tEndToken);
  12. const
  13. //  // Types. Must be in size-accending order
  14.   dtBoolean = 0; dtChar = 1;
  15.   dtInt8 = 2; dtInt16 = 3; dtInt32 = 4; dtInt = 5;
  16.   dtNat8 = 6; dtNat16 = 7; dtNat32 = 8; dtNat = 9;
  17.   dtSingle = 10; dtReal = 11; dtDouble = 12;
  18.   dtString = 13;
  19.   dtSet = 14;
  20.   dtArray = 16;
  21.   dtRecord = 17;
  22.   dtPointer = 18;
  23.   dtProcedure = 19;
  24.   dtConstant = 32;
  25.   dtVariable = 33; dtVariableRef = 34; dtVariableByOfs = 35;
  26.   dtStackVariable = 36; dtStackVariableByOfs = 37;
  27.   dtExtVariable = 38; dtExtVariableRef = 39; dtExtVariableByOfs = 40;
  28. // Result types
  29.   rtModule = -2; rtProcedure = -1;
  30.   TotalSTDTypes = 15;
  31.   TypeStr: array[0..TotalSTDTypes-1] of string[8] =
  32.            ('BOOLEAN', 'CHAR',
  33.             'SHORTINT', 'SMALLINT', 'LONGINT', 'INTEGER',
  34.             'SHORTINT', 'SMALLINT', 'LONGINT', 'INTEGER',
  35.             'SINGLE', 'REAL', 'LONGREAL',
  36.             'STRING', 'SET');
  37. //  TypeKind: array[0..TotalSTDTypes-1] of Integer = (dtBoolean, dtChar, dtInt16, dtInt, dtInt32, dtSingle, dtReal, dtDouble, dtString, dtSet);
  38. //  Operations
  39.   oAdd = $80 + 1; oSub = $80 + 5; oMul = $80 + 9; oDiv = $80 + 13; oOr = $80 + 17; oAnd = $80 + 19; oIDiv = $80 + 21; oMod = $80 + 22; oNeg = $80 + 23; oInv = $80 + 26;
  40.   rEqual = $80 + 28; rGreater = $80 + 32; rLess = $80 + 36; rGreaterEqual = $80 + 40; rLessEqual = $80 + 44; rNotEqual = $80 + 48; rIN = $80 + 52; rIS = $80 + 53;
  41. // Operators
  42.   oAssign = $80 + 54;
  43. //  All actions
  44.   aoNull = $80 + 0;
  45.   aoAddII = $80 + 1; aoAddIR = $80 + 2; aoAddRI = $80 + 3; aoAddRR = $80 + 4; aoAddSS = $80 + 105;
  46.   aoSubII = $80 + 5; aoSubIR = $80 + 6; aoSubRI = $80 + 7; aoSubRR = $80 + 8; aoSubSS = $80 + 109;
  47.   aoMulII = $80 + 9;  aoMulIR = $80 + 10; aoMulRI = $80 + 11; aoMulRR = $80 + 12; aoMulSS = $80 + 113;
  48.   aoDivII = $80 + 13; aoDivIR = $80 + 14; aoDivRI = $80 + 15; aoDivRR = $80 + 16; aoDivSS = $80 + 117;
  49.   aoOrII = $80 + 17; aoOrBB = $80 + 18;
  50.   aoAndII = $80 + 19; aoAndBB = $80 + 20;
  51.   aoIDivII = $80 + 21; aoModII = $80 + 22;
  52.   aoNegI = $80 + 23; aoNegR = $80 + 24; aoNegS = $80 + 125;
  53.   aoInvI = $80 + 25; aoInvB = $80 + 26;
  54. //  Relations
  55.   arEqualII = $80 + 28; arEqualIR = $80 + 29; arEqualRI = $80 + 30; arEqualRR = $80 + 31;
  56.   arGreaterII = $80 + 32; arGreaterIR = $80 + 33; arGreaterRI = $80 + 34; arGreaterRR = $80 + 35;
  57.   arLessII = $80 + 36; arLessIR = $80 + 37; arLessRI = $80 + 38; arLessRR = $80 + 39;
  58.   arGreaterEqualII = $80 + 40; arGreaterEqualIR = $80 + 41; arGreaterEqualRI = $80 + 42; arGreaterEqualRR = $80 + 43;
  59.   arLessEqualII = $80 + 44; arLessEqualIR = $80 + 45; arLessEqualRI = $80 + 46; arLessEqualRR = $80 + 47;
  60.   arNotEqualII = $80 + 48; arNotEqualIR = $80 + 49; arNotEqualRI = $80 + 50; arNotEqualRR = $80 + 51;
  61.   arIn = $80 + 52; arIS = $80 + 53;
  62. //  Operators
  63.   aoAssign1 = $80 + 54;
  64.   aoAssign2 = $80 + 55;
  65.   aoAssign4 = $80 + 56; aoAssign4RI = $80 + 57;
  66.   aoAssignSize = $80 + 58;
  67.   aoStackAssign4 = $80 + 59; aoStackAssign4RI = $80 + 60;
  68.   aoStackAssignSize = $80 + 61;
  69.   aoGoto = $80 + 62; aoJumpIfZero = $80 + 63;
  70.   aoCall = $80 + 64; aoReturnF = $80 + 65; aoReturnP = $80 + 66;
  71.   aoExit = $80 + 67;
  72.   aoSetStackBase = $80 + 69;
  73.   aoExpandStack = $80 + 70;
  74. // Operations with external variables for scripting only
  75.   aoExtAssign1 = $80 +  71;
  76.   aoExtAssign2 = $80 +  72;
  77.   aoExtAssign4 = $80 +  73;
  78.   aoExtAssign4RI = $80 + 74;
  79.   aoExtAssignSize = $80 + 75;
  80. // Standard functions
  81.   sfSin = $80 + 76;
  82.   sfCos = $80 + 77;
  83.   sfTan = $80 + 78;
  84.   sfArcTan = $80 + 79;
  85.   sfSqrt = $80 + 80;
  86.   sfInvSqrt = $80 + 81;
  87.   sfRnd = $80 + 82;
  88.   sfEntier = $80 + 83;
  89.   sfLn = $80+84;
  90.   sfBlend = $80+85;
  91. //  aoIndex
  92. // Comments
  93.   TotalComments = 2;
  94.   CommentStr: array[0..TotalComments-1] of record Open, Close: string[10]; end = ((Open: '(*'; Close: '*)'), (Open: '//'; Close: #10));
  95. //  Type modifiers
  96.   tmInt = 0; tmSingle = 256;
  97.   TotalReservedWords = 34;
  98.   ReservedWord: array[0..TotalReservedWords-1] of string[9] = (
  99.    'ARRAY', 'BEGIN', 'BY', 'CASE', 'CONST',
  100.    'DIV', 'DO', 'ELSE', 'ELSEIF', 'END',
  101.    'EXIT', 'FOR', 'IF', 'IMPORT', 'IN',
  102.    'IS', 'LOOP', 'MOD', 'MODULE', 'NIL',
  103.    'OF', 'OR', 'POINTER', 'PROCEDURE', 'RECORD',
  104.    'REPEAT', 'RETURN', 'THEN', 'TO', 'TYPE',
  105.    'UNTIL', 'VAR', 'WHILE', 'WITH' );
  106.   TotalStandardProcedures = 10;
  107.   StandardProcedureCommandIDs: array[0..TotalStandardProcedures-1] of Integer = (
  108.     sfSin, sfCos, sfTan, sfArcTan, sfSqrt, sfInvSqrt, sfRnd, sfEntier, sfLn, sfBlend
  109.   );
  110.   TotalOperations1 = 3;
  111.   Op1Str: array[0..TotalOperations1-1] of string[3] = ('+', '-', 'OR');
  112.   Op1ID: array[0..TotalOperations1-1] of Cardinal = (oAdd, oSub, oOr);
  113.   TotalOperations2 = 5;
  114.   Op2Str: array[0..TotalOperations2-1] of string[3] = ('*', '/', '&', 'DIV', 'MOD');
  115.   Op2ID: array[0..TotalOperations2-1] of Cardinal = (oMul, oDiv, oAnd, oIDiv, oMod);
  116.   TotalUnarOperations = 2;
  117.   UnarOpStr: array[0..TotalUnarOperations-1] of string[3] = ('-', '~');
  118.   UnarOpID: array[0..TotalUnarOperations-1] of Cardinal = (oNeg, oInv);
  119.   TotalRelations = 8;
  120.   RelationStr: array[0..TotalRelations-1] of string[2] = ('=', '>', '<', '>=', '<=', '#', 'IN', 'IS');
  121.   RelationID: array[0..TotalRelations-1] of Cardinal = (rEqual, rGreater, rLess, rGreaterEqual, rLessEqual, rNotEqual, rIN, rIS);
  122.   TotalEndTokens = 9;
  123.   EndTokenStr: array[0..TotalEndTokens-1] of string[5] = ('END', 'DO', 'UNTIL', 'TO', 'EXIT', 'THEN', 'ELSIF', 'ELSE', 'OF');
  124.   etEnd = 0; etDo = 1; etUntil = 2; etTo = 3; etExit = 4; etThen = 5; etElseIf = 6; etElse = 7;
  125.   TotalOperators = 8;
  126.   OperatorStr: array[0..TotalOperators-1] of string[6] = (':=', 'LOOP', 'WHILE', 'REPEAT', 'FOR', 'IF', 'EXIT', 'RETURN');
  127.   opAssign = 0; opLopp = 1; opWhile = 2; opRepeat = 3; opFor = 4; opIf = 5; opExit = 6; opReturn = 7;
  128.   TotalDeclarations = 4;
  129.   DeclarationStr: array[0..TotalDeclarations-1] of string[9] = ('VAR', 'CONST', 'TYPE', 'PROCEDURE');
  130.   dVar = 0; dConst = 1; dType = 2; dProc = 3;
  131.   eeSum = 1; exExpression = 2; exOperation = 3; exRelation = 4;
  132. // Compile errors
  133.   eUnexpectedOperation = 1; eUnexpectedExpression = 2; eUnexpectedNumber = 3;
  134.   eUnexpectedExpEnd = 4; eUnexpectedSimbol = 5; eUnexpectedOperator = 6;
  135.   eUnexpectedIdentifier = 7;
  136.   eUndeclaredIdentifier = 8;
  137.   eIncompatibleTypes = 9;
  138.   eIncomparableTypes = 10;
  139.   eCannotAssign = 11;
  140.   eUnexpectedSequenceEnd = 12;
  141.   eSequenceEndNotFound = 13;
  142.   eVariableExpected = 14;
  143.   eAssignationExpected = 15;
  144.   eUntilExpected = 16;
  145.   eDoExpected = 17;
  146.   eToExpected = 18;
  147.   eEndExpected = 19;
  148.   eThenExpected = 20;
  149.   eBooleanExpExpected = 21;
  150.   eUnexpectedBreak = 22;
  151.   eIdentRedeclared = 23;
  152.   eUnknownType = 24;
  153.   eColonExpected = 25;
  154.   eSemicolonExpected = 26;
  155.   eEqualExpected = 27;
  156.   eBeginExpected = 28;
  157.   eOperationExpected = 29;
  158.   eRightParenthesisExpected = 30;
  159.   eRightBraceExpected = 31;
  160.   eProcNameMismatch = 32;
  161.   eNotEnoughParameters = 33;
  162.   eTooManyParameters = 34;
  163.   eMustBeFunction = 35;
  164.   eMustBeProcedure = 36;
  165.   eUnexpectedReturn = 37;
  166.   eReturnExpected = 38;
  167.   eConstExpExpected = 39;
  168.   eInternalError = 40;
  169.   eIntExpExpected = 41;
  170.   ePositiveIntExpExpected = 42;
  171.   eOfExpected = 43;
  172.   eRightBracketExpected = 44;
  173.   eUnexpectedResWord = 45;
  174.   eExternalVarUnknownType = 46;
  175.   eInvalidNumber = 47;
  176.   TotalErrors = 47;
  177. // Runtime errors
  178.   rteRangeError = 1; rteStackEmpty = 2;
  179.   ikConstant = 0; ikVariable = 1; ikProcedure = 2; ikType = 3;
  180.   
  181.   TypeToStr: array[1..15] of string[10] = ('Boolean', 'Char', 'Int8', 'Int16', 'Int32', 'Int',
  182.     'Nat8', 'Nat16', 'Nat32', 'Nat', 'Single', 'Double', 'Real', 'String', 'Set');
  183. // Namespace kind
  184.   nskModule = 0; nskProcedure = 1; nskRecord = 2;
  185. // Type kind
  186.   tkCommon = 0; tkArray = 1; tkRecord = 2; tkPointer = 3; tkProcedure = 4;
  187. // Ident location
  188.   ilGlobal = 0; ilStack = 1; ilExternal = 2;
  189. type
  190.   Int8  = ShortInt; Int16 = SmallInt; Int32 = LongInt;  Int = Integer;
  191.   Nat8  = Byte;     Nat16 = Word;     Nat32 = LongWord; Nat = Cardinal;
  192.   TName = string[32];
  193.   TPINItem = Integer;
  194.   TPIN = array of TPINItem;
  195.   PNamespace = ^TNamespace;
  196.   PType = ^TType;
  197.   TNamespace = record
  198.     Name: TName;                     // Name of module, record or procedure
  199.     UID: Integer;                    // Unique namespace ID (for saving/loading namespaces)
  200.     Kind: Int32;                     // Module, procedure or record
  201.     ParamCount: Int32;               // Only for procedures: number of parameters
  202.     ID: Int32;                       // Index in Data.Procedures
  203.     StackLength: Int32;              // Length of variables declared local and in all child namespaces
  204.     TotalConstants, TotalVariables, TotalProcedures, TotalTypes: Int32;
  205.     Constants, Variables, Types: array of Longword;
  206.     Procedures: array of PNameSpace;
  207.     Parent: PNamespace;
  208.   end;
  209.   TType = record
  210.     Name: TName;
  211.     Kind: Int32;                     // Type kind
  212.     ID: Int32;                       // Index of arrays base type, or index in Types[] in case of simple type 
  213.     Dimension, Size: Int32;          // Dimension of array (if the type is array) and size of the entire type
  214.     Namespace: PNamespace;           // In case of record type record's namespace
  215.   end;
  216.   TIdent = packed record
  217.     Name: TName;
  218.     TypeID, Location, ExportMode, Index: Int32;
  219.     Namespace: PNamespace;           // Namespace where identifier is declared
  220.   case StdProcedure: Boolean of
  221.     True: (CommandID: Integer);
  222.     False: (Size: Integer);
  223.   end;
  224.   TCompilationError = record
  225.     Source: string;
  226.     Number, Line, Position: Integer;
  227.     Data: Integer;
  228.   end;
  229.   TDataPool = array[0..MaxInt-1] of Byte;
  230.   PDataPool = ^TDataPool;
  231.   TRTData = class
  232.     PIN: TPIN; PINItems: Integer;
  233.     EntryPIN: Integer;                                      // First command index
  234.     Namespace: PNamespace;                                  // Root namespace
  235.     BaseData: PDataPool;
  236.     Data: array of Byte;                            // Dynamic data pool
  237.     DataLength: Int32;                                      // Dynamic data pool size
  238.     Constants, Variables, Procedures: array of TIdent;
  239.     Types: array of PType;
  240.     TotalConstants, TotalVariables, TotalProcedures, TotalTypes: Int32;
  241.     TotalExternalVariables, ExternalVarsOfs: Int32;
  242.     destructor Destroy; override;
  243.   end;
  244.   function GetVTypeInt(Value: Int32): Int32;
  245. implementation
  246. function GetVTypeInt(Value: Int32): Int32;
  247. begin
  248.   case Value of
  249. //    0..$FF: Result := etNat8;
  250. //    $FF+1..$FFFF: Result := etNat16;
  251. //    $FFFF+1..$80000000-1: Result := etNat32;
  252.     -$80..$80-1: Result := dtInt8;
  253.     -$8000..-$81, $80..$8000-1: Result := dtInt16;
  254.     else {if (Value < -$8000) or (Value >= $8000) then} Result := dtInt32;
  255.   end;
  256. end;
  257. { TRTData }
  258. destructor TRTData.Destroy;
  259.   procedure FreeNamespace(var Namespace: PNamespace);
  260.   var i: Integer;
  261.   begin
  262.     if Namespace = nil then Exit;
  263.     NameSpace^.Name := '';
  264.     Namespace^.Constants := nil;
  265.     Namespace^.Variables := nil;
  266.     Namespace^.Types     := nil;
  267.     for i := 0 to High(Procedures) do FreeNamespace(Namespace^.Procedures[i]);
  268.     Dispose(Namespace);
  269.     Namespace := nil;
  270.   end;
  271. var i: Integer;
  272. begin
  273.   PIN := nil;
  274.   FreeNamespace(Namespace);
  275.   FreeMem(BaseData);
  276.   Data := nil;
  277.   for i := 0 to TotalConstants-1 do FreeNamespace(Constants[i].Namespace);
  278.   Constants := nil;
  279.   for i := 0 to TotalVariables-1 do FreeNamespace(Variables[i].Namespace);
  280.   Variables := nil;
  281.   for i := 0 to TotalProcedures-1 do FreeNamespace(Procedures[i].Namespace);
  282.   Procedures := nil;
  283.   for i := 0 to TotalTypes-1 do FreeNamespace(Types[i]^.Namespace);
  284.   Types := nil;
  285.   inherited;
  286. end;
  287. end.