📄 untpasscriptcompile.~pas
字号:
unit untPasScriptCompile;
interface
Uses
Variants, Windows, Messages, Classes, SysUtils, MConnect, ScktComp, WinSock,
WinInet, ComObj, Dialogs;
Type
TCharSet = Set of char;
Const
{ 源程序字符集 }
WhiteSpaces: TCharSet = ['+', '-', '/', '*', '(', ')', ':', '=', ',', ';', '>', '<',
'$', '.', '#', '[', ']', '^', '@', '&', '~', '|', '%'];
BlackSpaces: TCharSet = [#1..#32];
StopChars: TCharSet = [#0..#32, '+', '-', '/', '*', '(', ')', ':', '=', ',', '''',
'{', '}', ';', '>', '<', '$', '.', '#', '[', ']', '"', '^',
'@', '&', '~', '|', '%'];
FirstIdentChar: TCharSet = ['A'..'Z', 'a'..'z', '_'];
IdentBackChars: TCharSet = ['A'..'Z', 'a'..'z', '_', '0'..'9'];
Digit: TCharSet = ['0'..'9'];
HexDigit: TCharSet = ['0'..'9', 'A'..'F'];
{ 单个保留字符 Reserve Char }
rcidEndOfFile = 0;
rcidEndOfLine = 13;
rcidNewLine = 10;
rcidPower = Integer('^');
rcidPoint = Integer('.');
rcidDelimeter = Integer(';');
rcidGreater = Integer('>');
rcidLess = Integer('<');
rcidComma = Integer(',');
rcidPlus = Integer('+');
rcidMinus = Integer('-');
rcidSlash = Integer('/');
rcidStar = Integer('*');
rcidOpenBracket = Integer('(');
rcidCloseBracket = Integer(')');
rcidOpenComment = Integer('{');
rcidCloseComment = Integer('}');
rcidEqual = Integer('=');
rcidNotEqual = integer('#');
rcid2Points = Integer(':');
rcidStringChar = Integer('''');
rc2idStringChar = Integer('"');
rcidSqopenBracket = integer('[');
rcidSqcloseBracket = integer(']');
{ 保留字 Reserve Word }
ReserveWordBase = 1000;
ReserveWordEnd = 1999;
rwidProgram = ReserveWordBase + 0;
rwidLabel = ReserveWordBase + 1;
rwidGoto = ReserveWordBase + 2;
rwidVar = ReserveWordBase + 3;
rwidBegin = ReserveWordBase + 4;
rwidEnd = ReserveWordBase + 5;
rwidAnd = ReserveWordBase + 6;
rwidOr = ReserveWordBase + 7;
rwidXor = ReserveWordBase + 8;
rwidNot = ReserveWordBase + 9;
rwidShl = ReserveWordBase + 10;
rwidShr = ReserveWordBase + 11;
rwidDiv = ReserveWordBase + 12;
rwidMod = ReserveWordBase + 13;
rwidTrue = ReserveWordBase + 14;
rwidFalse = ReserveWordBase + 15;
rwidIf = ReserveWordBase + 16;
rwidThen = ReserveWordBase + 17;
rwIdElse = ReserveWordBase + 18;
rwidWhile = ReserveWordBase + 19;
rwidRepeat = ReserveWordBase + 20;
rwidUntil = ReserveWordBase + 21;
rwidFor = ReserveWordBase + 22;
rwidTo = ReserveWordBase + 23;
rwidDownto = ReserveWordBase + 24;
rwidDo = ReserveWordBase + 25;
rwidNil = ReserveWordBase + 27;
rwidNull = ReserveWordBase + 28;
rwidUnitinit = ReserveWordBase + 31;
rwidUnitfinal = ReserveWordBase + 32;
rwidClass = ReserveWordBase + 33;
rwidType = ReserveWordBase + 34;
rwidConstr = ReserveWordBase + 35;
rwidDestr = ReserveWordBase + 36;
rwidUses = ReserveWordBase + 37;
rwidUnit = ReserveWordBase + 38;
rwidInterface = ReserveWordBase + 39;
rwidImplement = ReserveWordBase + 40;
rwidProcedure = ReserveWordBase + 41;
rwidPrivate = ReserveWordBase + 42;
rwidPublic = ReserveWordBase + 43;
rwidProtected = ReserveWordBase + 44;
rwidPublished = ReserveWordBase + 45;
rwidFunction = ReserveWordBase + 46;
rwidConst = ReserveWordBase + 47;
rwidProperty = ReserveWordBase + 48;
rwidVirtual = ReserveWordBase + 49;
rwidOverride = ReserveWordBase + 50;
rwidDynamic = ReserveWordBase + 51;
rwidRecord = ReserveWordBase + 52;
rwidForward = ReserveWordBase + 53;
rwidIndex = ReserveWordBase + 54;
rwidRead = ReserveWordBase + 55;
rwidWrite = ReserveWordBase + 56;
rwidStored = ReserveWordBase + 57;
rwidDefault = ReserveWordBase + 58;
rwidAbstract = ReserveWordBase + 59;
rwidStdcall = ReserveWordBase + 69;
{ 用户自定义的标识 User Define Identifier }
UserDefineIdentBase = 256;
udIdentifier = UserDefineIdentBase + 0;
udStringConst = UserDefineIdentBase + 1;
udNumberConst = UserDefineIdentBase + 2;
udHexConst = UserDefineIdentBase + 6;
{ PCode命令常量 }
ocAdd = 0;
ocSub = 1;
ocMul = 2;
ocDiv = 3;
ocMod = 4;
ocSlash = 5;
ocShl = 6;
ocShr = 7;
ocNot = 8;
ocOr = 9;
ocXor = 10;
ocAnd = 11;
ocGreaterEqual = 12;
ocEqual = 13;
ocLessEqual = 14;
ocNotEqual = 15;
ocGreater = 16;
ocLess = 17;
ocNeg = 18;
ocGoto = 19;
ocIF = 20;
ocIfFalseGoto = 21;
ocLoadConst = 23;
ocHalt = 26;
ocIncVar = 29;
ocDecVar = 30;
ocBackDode = 34;
ocExtFun = 42;
ocExtProc = 43;
ocSetSelf = 44;
ocLoadextvar = 45;
ocStoreextvar = 46;
ocSelffromvar = 47;
ocMov = 48;
ocCall = 49;
ocReturn = 50;
ocVarraycreate = 51;
ocSetvarray = 52;
ocSto = 53;
type
TToken = record
ID: Integer;
Data: Variant;
end;
TTokenReader = class
private
FSourceCode: string;
FCurPos: integer;
FSourceLen: integer;
FCurToken: TToken;
FResWords: TStringList; //保留字
function ReadByte: byte;
function NextByte: byte;
function Next2Byte: byte;
procedure BackByte(aNum: integer);
procedure SetSourceCode(aSrcCode: string);
function GetSourceCode: string;
{ 滤去不可见字符 }
procedure FilterBalckChar;
{ 滤去注释 }
procedure FilterNote;
{ 滤去不可见字符和注释 }
procedure FilterBlackAndNote;
function SetToken(ID: integer; V: Variant): TToken;
{ 读出字符串常量 }
function getStringConst: TToken;
{ 读出数字常量 }
function getNumberConst: TToken;
{ 是否是保留字符 }
function IsReserveChar(aChar: char): boolean;
{ 读出保留字符 }
function getReserveChar: TToken;
{ 读出用户标识符或保留字 }
function getIdentOrReservWord: TToken;
procedure Error(astr: string);
function ReadToken: TToken;
function NextToken: TToken;
function Next2Token: TToken;
procedure getDelimeter;
procedure getComma;
procedure getCloseBracket;
function GetCurToken: TToken;
public
constructor Create;
destructor Destroy; override;
property CurToken: TToken read GetCurToken;
property SourceCode: string read GetSourceCode write SetSourceCode;
end;
TVarType = (vtStatic, vtDynamic, vtParam, vtResult);
TDataType = (dtUnknown, dtInt, dtFloat, dtBool, dtStr, dtDateTime, dtOther);
TUserVar = class
private
FID: Integer;
FName: string;
FValue: variant;
FDataType: TDataType;
FVarType: TVarType; //变量类别，静态变量，动态变量，参数变量
FOffPos: integer; //位移
function getText: string;
public
procedure Clone(aUserVar: TUserVar);
property ID: integer read FID write FID;
property Name: string read FName write FName;
property Value: variant read FValue write FValue;
property DataType: TDataType read FDataType write FDataType;
property VarType: TVarType read FVarType write FVarType;
property OffPos: integer read FOffPos write FOffPos;
property Text: string read getText;
end;
TArrayUserVar = array of TUserVar;
TUserVarList = class
private
FUserVarList: TArrayUserVar;
FCount: integer;
procedure CheckArray;
function getText: string;
public
constructor Create;
destructor Destroy; override;
procedure Clear;
function AddVar(aName: string): TUserVar; overload;
function AddVar(aID: integer; aName: string; aValue: variant; aDataType: TDataType;
aVarType: TVarType; aOffPos: integer): TUserVar; overload;
procedure AddVar(aUserVar: TUserVar); overload;
function GetVarByName(aName: string): TUserVar;
function GetVarByIndex(aIndex: integer): TUserVar;
function getVarByID(aID: integer): TUserVar;
procedure DelVarByID(aID: integer);
procedure DelVarByIndex(aIndex: integer);
procedure DelLastVar;
property Count: integer read FCount;
property Text: string read getText;
end;
TMethodType = (mtProc, mtFun);
TSysProcMethod = procedure(v: TUserVarList);
TUserMethod = class
private
FID: Integer;
FName: string;
FMethodType: TMethodType; //过程，函数
FParamList: TList;
FDynaVarList: TList;
FCurOffPos: integer; //当前位移数
FResultVar: TUserVar;
FAddr: integer;
FSysMethodFlag: boolean;
FSysProcMethod: TSysProcMethod;
function getText: string;
public
constructor Create;
procedure AddParamVar(aUserVar: TUserVar);
procedure AddDynaVar(aUserVar: TUserVar);
procedure AddResultVar(aUserVar: TUserVar);
procedure Clone(aUserMethod: TUserMethod);
function GetParamVarByIndex(aIndex: integer): TUserVar;
function GetDyanVarByIndex(aIndex: integer): TUserVar;
property ID: integer read FID write FID;
property Name: string read FName write FName;
property MethodType: TMethodType read FMethodType write FMethodType;
property ParamList: TList read FParamList;
property DynaVarList: TList read FDynaVarList;
property CurOffPos: integer read FCurOffPos write FCurOffPos;
property ResultVar: TUserVar read FResultVar;
property Addr: integer read FAddr write FAddr;
property Text: string read getText;
property SysMethodFlag: boolean read FSysMethodFlag write FSysMethodFlag;
property SysProcMethod: TSysProcMethod read FSysProcMethod write FSysProcMethod;
end;
TArrayUserMethod = array of TUserMethod;
TUserMethodList = class
private
FUserMethodList: TArrayUserMethod;
FCount: integer;
procedure CheckArray;
function getMethodByID(aID: integer): TUserMethod;
function getText: string;
public
constructor Create;
destructor Destroy; override;
procedure Clear;
function AddMethod(aName: string): TUserMethod; overload;
function AddMethod(aID: integer; aName: string; aMethodType: TMethodType;
aCurOffPos: integer; aAddr: integer): TUserMethod; overload;
function AddMethod(aMethod: TUserMethod): TUserMethod; overload;
function GetMethodByName(aName: string): TUserMethod;
property UserMethod[aID: integer]: TUserMethod read getMethodByID;
property Count: integer read FCount;
property UserMethodList: TArrayUserMethod read FUserMethodList;
property Text: string read getText;
end;
TVMPCode = class //虚拟机代码
private
FCmd, FP1, FP2, FAddr: integer;
function getText: string;
public
class function getCmdStr(aCmd: integer): string;
property Cmd: integer read FCmd write FCmd;
property P1: integer read FP1 write FP1;
property P2: integer read FP2 write FP2;
property Addr: integer read FAddr;
property Text: string read getText;
end;
TArrayVMPCode = array of TVMPCode;
TVMPCodeList = class
private
FVMPCodeList: TArrayVMPCode;
FCount: integer;
procedure CheckArray;
function getVMPCodeByIndex(aIndex: integer): TVMPCode;
function getLastVMPCode: TVMPCode;
function getText: string;
public
constructor Create;
destructor Destroy; override;
procedure Clear;
function AddVMPCode(aCmd, aP1, aP2: integer): TVMPCode;
property VMPCodeList[aIndex: integer]: TVMPCode read getVMPCodeByIndex;
property Count: integer read FCount;
property LastVMPCode: TVMPCode read getLastVMPCode;
property Text: string read getText;
end;
TCodeMaker = class
private
FVarList: TList;
FConstVarList: TList;
FMethodList: TList;
FAnalyDepth: integer;
FParentCodeMaker: TCodeMaker;
FParentTokenReader: TTokenReader;
public
function RegisterVar(aName: string; aAnalyDepth: integer = -1): TUserVar; virtual;
function RegisterConstVar(aName: string): TUserVar; virtual;
function FindVarByName(aName: string; var aLevel: integer): TUserVar; virtual;
function FindVarByID(aID: integer): TUserVar; virtual;
function RegisterMethod(aName: string; aAnalyDepth: integer = -1): TUserMethod; virtual;
function FindMethodByName(aName: string; var aLevel: integer): TUserMethod; virtual;
function PutCode(aCmd, aP1, aP2: integer): TVMPCode; virtual;
function GetLastVMPCode: TVMPCode; virtual;
function GetAnalyDepth: integer; virtual;
public
constructor Create(aCodeMaker: TCodeMaker; aTokenReader: TTokenReader); virtual;
destructor Destroy; override;
property LastVMPCode: TVMPCode read GetLastVMPCode;
property AnalyDepth: integer read GetAnalyDepth;
property VarList: TList read FVarList;
property ConstVarList: TList read FConstVarList;
property MethodList: TList read FMethodList;
end;
TStack = class
private
FDatas: array of variant;
FCount: integer;
public
constructor Create;
destructor Destroy; override;
procedure Put(v: Variant);
function Pop: variant;
function getData(aIndex: integer): variant;
procedure Clear;
end;
TCallInfo = class
private
FBaseDynaVarAddr: integer;
FVarCount: integer;
FCallAddr: integer;
FMethod: TUserMethod;
public
property BaseDynaVarAddr: integer read FBaseDynaVarAddr;
property VarCount: integer read FVarCount;
property CallAddr: integer read FCallAddr;
property Method: TUserMethod read FMethod;
end;
TArrayCallInfo = array of TCallInfo;
TCallStack = class
private
FCallInfoList: TArrayCallInfo;
FCount: integer;
procedure CheckArray;
function getLastCallInfo: TCallInfo;
public
constructor Create;
destructor Destroy; override;
function PutMethodCall(aMethod: TUserMethod; aCallAddr: integer): TCallInfo;
procedure RemoveLastCall;
function GetPreCallInfo(aOffPos: integer): TCallInfo;
procedure Clear;
property LastCallInfo: TCallInfo read getLastCallInfo;
property Count: integer read FCount;
end;
TDynaVarStack = class
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -