Поздравляю, лол.
скалогрыз>runewalsh, проблемы с Си++ исключенияи из lua модулей решил как-нибудь?Решил
правда, мысленно. В
большинстве случаев сработает простой atpanic, бросающий исключение языка (оттуда даже Lua-стек раскрутить можно!), и try-lua_call()-except вместо lua_pcall:
Код: Выделить всё
{$mode objfpc} {$h+} {$coperators on}
uses
heaptrc, SysUtils, ctypes;
const
LuaLib = 'lua53';
LUA_OK = 0;
LUA_FIRSTPSEUDOIDX = -1001000;
LUA_REGISTRYINDEX = LUA_FIRSTPSEUDOIDX;
LUA_RIDX_GLOBALS = 2;
LUA_IDSIZE = 60;
type
lua_State = record ptr: pointer; end;
lua_Alloc = function(ud: pointer; ptr: pointer; osize, nsize: csize_t): pointer; cdecl;
lua_Chunkreader = function(L: lua_State; ud: pointer; out sz: csize_t): pcchar; cdecl;
lua_CFunction = function(L: lua_State): cint; cdecl;
lua_KContext = PtrInt;
lua_KFunction = function(L: lua_State; status: cint; ctx: lua_KContext): cint; cdecl;
lua_Debug = record
event: cint;
name: pcchar; // (n)
namewhat: pcchar; // (n) 'global', 'local', 'field', 'method'
what: pcchar; // (S) 'Lua', 'C', 'main', 'tail'
source: pcchar; // (S)
currentline: cint; // (l)
linedefined: cint; // (S)
lastlinedefined: cint; // (S)
nups: cuchar; // (u) number of upvalues
nparams: cuchar; // (u) number of parameters
isvararg: cschar; // (u)
istailcall: cuchar; // (t)
short_src: array[0 .. LUA_IDSIZE - 1] of cchar; // (S)
&private: pointer;
end;
function lua_newstate(f: lua_Alloc; ud: pointer): lua_State; cdecl; external LuaLib;
function lua_atpanic (L: lua_State; panicf: lua_CFunction): lua_CFunction; cdecl; external LuaLib;
procedure lua_close(L: lua_State); cdecl; external LuaLib;
function lua_load(L: lua_State; reader: lua_Chunkreader; dt: pointer; chunkname, mode: pcchar): cint; cdecl; external LuaLib;
procedure lua_callk(L: lua_State; nargs, nresults: cint; ctx: lua_KContext; k: lua_KFunction); cdecl; external LuaLib;
procedure lua_settop(L: lua_State; index: cint); cdecl; external LuaLib;
procedure lua_pushlstring(L: lua_State; s: pcchar; ls: csize_t); cdecl; external LuaLib;
procedure lua_pushcclosure(L: lua_State; fn: lua_CFunction; n: cint); cdecl; external LuaLib;
procedure lua_rawgeti(L: lua_State; idx, n: cint); cdecl; external LuaLib;
procedure lua_rawset(L: lua_State; idx: cint); cdecl; external LuaLib;
function lua_tolstring(L: lua_State; idx: cint; out len: csize_t): pcchar; cdecl; external LuaLib;
function lua_getstack(L: lua_State; level: cint; out ar: lua_Debug): cint; cdecl; external LuaLib;
function lua_getinfo(L: lua_State; what: pcchar; var ar: lua_Debug): cint; cdecl; external LuaLib;
procedure lua_pushstring(L: lua_State; const s: string);
begin
lua_pushlstring(L, pcchar(s), length(s));
end;
function lua_tostring(L: lua_State; idx: cint): string;
var
p: pcchar;
len: csize_t;
begin
p := lua_tolstring(L, idx, len);
SetLength(result, len);
Move(p^, pointer(result)^, len * sizeof(result[1]));
end;
type
TLoadStringParam = record
s: pcchar;
rest: size_t;
end;
function LuaStringReader(L: lua_State; ud: pointer; out sz: csize_t): pcchar; cdecl;
var
p: ^TLoadStringParam absolute ud;
begin
result := pcchar(p^.s);
sz := p^.rest * sizeof(p^.s^);
p^.rest := 0;
end;
function lua_loadstring(L: lua_State; const s, name: string): cint;
var
p: TLoadStringParam;
begin
p.s := pcchar(s);
p.rest := length(s);
result := lua_load(L, @LuaStringReader, @p, pcchar(name), nil);
end;
procedure lua_call(L: lua_State; nargs, nresults: cint);
begin
lua_callk(L, nargs, nresults, 0, nil);
end;
procedure lua_pop(L: lua_State; n: cint);
begin
lua_settop(L, -1 - n);
end;
function LuaAllocator(ud: pointer; ptr: pointer; osize, nsize: csize_t): pointer; cdecl;
begin
Assert(@ud = @ud); Assert(@osize = @osize);
result := ReallocMem(ptr, nsize);
end;
const
EOL = LineEnding;
function StackTrace(L: lua_State; lim: cardinal): string;
var
level: cardinal;
ar: lua_Debug;
begin
result := '';
level := 0;
while (level < lim) and (lua_getstack(L, level, ar) = 1) do
begin
if lua_getinfo(L, pcchar(PChar('lnS')), ar) <> 0 then
begin
result += EOL;
if Assigned(ar.name) and (PChar(ar.name) <> 'C') then
result += PChar(ar.name) + '() at ';
result += PChar(pcchar(ar.short_src));
if ar.currentline > 0 then result += ':' + IntToStr(ar.currentline);
end else
result += EOL + IntToStr(level) + ': N/A';
inc(level);
end;
if result <> '' then result := EOL + 'Stack trace:' + result;
end;
function WrapLuaPanicToException(L: lua_State): cint; cdecl;
begin
raise Exception.Create(lua_tostring(L, -1) + StackTrace(L, 20));
end;
function LuaWriteln(L: lua_State): cint; cdecl;
begin
writeln(lua_tostring(L, 1));
result := 0;
end;
function ErrorFromMessage(L: lua_State): Exception;
begin
result := Exception.Create(lua_tostring(L, -1));
lua_pop(L, 1);
end;
procedure Main;
const
Script =
{1} 'function F()' + EOL +
' G()' + EOL +
'end' + EOL +
EOL +
{5} 'function G()' + EOL +
' H()' + EOL +
'end' + EOL +
EOL +
'function H()' + EOL +
{10} ' CallToNonExistingFunction()' + EOL +
'end' + EOL +
EOL +
'for i = 1, 10 do' + EOL +
' writeln("Test " .. i)' + EOL +
{15} ' if i == 8 then F() end' + EOL +
'end' + EOL +
EOL +
'return "string result"';
var
L: lua_State;
begin
L := lua_newstate(@LuaAllocator, nil);
if not Assigned(L.ptr) then
raise Exception.Create('Not enough memory for Lua state.');
lua_atpanic(L, @WrapLuaPanicToException);
lua_rawgeti(L, LUA_REGISTRYINDEX, LUA_RIDX_GLOBALS);
lua_pushstring(L, 'writeln');
lua_pushcclosure(L, @LuaWriteln, 0);
lua_rawset(L, -3);
lua_pop(L, 1);
try
if lua_loadstring(L, Script, '=source') <> LUA_OK then
raise ErrorFromMessage(L);
lua_call(L, 0, 1);
writeln(lua_tostring(L, -1));
lua_pop(L, 1);
finally
lua_close(L);
end;
end;
begin
try
Main;
except
on E: Exception do writeln(E.Message);
end;
end.
⇓
Код: Выделить всё
Test 1
Test 2
Test 3
Test 4
Test 5
Test 6
Test 7
Test 8
source:10: attempt to call a nil value (global 'CallToNonExistingFunction')
Stack trace:
H() at source:10
G() at source:6
F() at source:2
source:15
Главное условие при использовании этого варианта — ни в каком виде не делать «защищённый вызов» (т. к. он и превращается в longjmp при ошибке). Но кроме lua_pcall он используется и в других местах (внутренние функции luaD_rawrunprotected или luaD_pcall). Обычно ты едва ли захочешь бросать оттуда ошибки в здравом уме (например, из метаметода __gc), но вот lua_resume тоже использует, а требование отказаться от корутин уже не столь тривиально (хотя и их нечасто юзают так-то).
В общем, если ВДРУГ простой вариант неприемлем, полностью корректно будет пропатчить исходники:
— добавить в global_State обработчики вроде неких условных protf и throwf.
— передать их прямо в аргументы lua_newstate (т. к. они там уже используются) и сохранить в свежесозданном global_State.
— реализовать на стороне FPC
Код: Выделить всё
type
lua_PFunc = procedure(L: lua_State; ud: pointer); cdecl;
function protf(f: lua_PFunc; L: lua_State; param: pointer): cint; cdecl;
begin
try
f(L, param);
result := 1;
except
result := 0;
end;
end;
procedure throwf(); cdecl;
begin
raise TObject.Create;
end;
...
L := lua_newstate2(..., @protf, @throwf);
(пустое исключение никогда не вылетит наружу, необработанные Lua-ошибки прилетят в panic, с которым можно поступить как выше)
— заменить LUAI_TRY в luaD_rawrunprotected (ldo.c) на if (!g->protf(f, L, param) && lj.status == 0) lj.status = -1;
— заменить макрос LUAI_THROW(L, _) на G(L)->throwf().
Т. е. слегка расширить систему с TRY-THROW, что уже есть, но из коробки предлагает только выбор между longjmp и исключениями C++.
