浏览代码

DumpLiveObjects call

Michaël Van Canneyt 10 月之前
父节点
当前提交
ae83472a06
共有 1 个文件被更改,包括 22 次插入0 次删除
  1. 22 0
      packages/wasm-job/src/job.js.pas

+ 22 - 0
packages/wasm-job/src/job.js.pas

@@ -1379,6 +1379,7 @@ function VarRecToJSValue(const V: TVarRec): TJOB_JSValue;
 Procedure DebugObject(const Message: String; aObject : IJSObject);
 Procedure DebugObject(const Message: String; aObject : TJSObject);
 Procedure DebugObject(const Message: String; aObject : TJOB_JSValue);
+Procedure ShowLiveObjects(const Message: String);
 
 Type
   TJobCallbackErrorEvent = Procedure (E : Exception; M : TMethod; H : TJobCallbackHelper; Var ReRaise : Boolean) of Object;
@@ -1406,7 +1407,11 @@ var
   msg : Rawbytestring;
 
 begin
+  {$IF SIZEOF(CHAR)=2}
   msg:=UTF8Encode(Message);
+  {$ELSE}
+  msg:=Message;
+  {$ENDIF}
   __job_debug_object(aObject.GetJSObjectID,PByte(Msg),Length(Msg),0);
 end;
 
@@ -1416,7 +1421,11 @@ var
   msg : Rawbytestring;
 
 begin
+  {$IF SIZEOF(CHAR)=2}
   msg:=UTF8Encode(Message);
+  {$ELSE}
+  msg:=Message;
+  {$ENDIF}
   __job_debug_object(aObject.GetJSObjectID,PByte(Msg),Length(Msg),0);
 end;
 
@@ -1435,6 +1444,19 @@ begin
     Writeln(Message,': ',TJOB_Double(aObject).AsString);
 end;
 
+procedure ShowLiveObjects(const Message: String);
+var
+  msg : Rawbytestring;
+begin
+  {$IF SIZEOF(CHAR)=2}
+  msg:=UTF8Encode(Message);
+  {$ELSE}
+  msg:=Message;
+  {$ENDIF}
+  if not __job_debug_object(-1,PByte(msg),Length(msg),0)=JOBResult_Success then
+    Writeln('Failed to show live objects');
+end;
+
 {$IFDEF VerboseJOB}
 function GetVarRecName(vt: word): string;
 begin