changed hcl_geterrnum() to HCL_ERRNUM().
All checks were successful
continuous-integration/drone/push Build is passing
All checks were successful
continuous-integration/drone/push Build is passing
reintroduced hcl_geterrnum() as a function
This commit is contained in:
@ -8,7 +8,7 @@ hcl_DEPENDENCIES = hcl.bin
|
||||
hcl_LINK = cp -pf hcl.bin $(builddir)/hcl$(EXEEXT) || echo
|
||||
|
||||
hcl.bin: $(hcl_SOURCES) ../lib/libhcl.la $(hcl_OBJECTS)
|
||||
fpc -o$(builddir)/$@ -FcUTF-8 -Fl../lib -Fl../lib/.libs -Fl/usr/lib/gcc/x86_64-linux-gnu/11 $(srcdir)/main.pas
|
||||
fpc -o$(builddir)/$@ -g -Mobjfpc -FcUTF8 -Fl../lib -Fl../lib/.libs -Fl/usr/lib/gcc/x86_64-linux-gnu/11 $(srcdir)/main.pas
|
||||
|
||||
clean-local:
|
||||
rm -f *.ppu *.res hcl.bin
|
||||
|
||||
@ -621,7 +621,7 @@ uninstall-am: uninstall-binPROGRAMS
|
||||
|
||||
|
||||
hcl.bin: $(hcl_SOURCES) ../lib/libhcl.la $(hcl_OBJECTS)
|
||||
fpc -o$(builddir)/$@ -FcUTF-8 -Fl../lib -Fl../lib/.libs -Fl/usr/lib/gcc/x86_64-linux-gnu/11 $(srcdir)/main.pas
|
||||
fpc -o$(builddir)/$@ -g -Mobjfpc -FcUTF8 -Fl../lib -Fl../lib/.libs -Fl/usr/lib/gcc/x86_64-linux-gnu/11 $(srcdir)/main.pas
|
||||
|
||||
clean-local:
|
||||
rm -f *.ppu *.res hcl.bin
|
||||
|
||||
94
pas/hcl.pas
94
pas/hcl.pas
@ -8,17 +8,11 @@ unit HCL;
|
||||
|
||||
interface
|
||||
|
||||
type
|
||||
type
|
||||
Interp = class
|
||||
public
|
||||
protected
|
||||
handle: pointer;
|
||||
private
|
||||
handle1: integer;
|
||||
handle2: integer;
|
||||
handle3: integer;
|
||||
handle4: integer;
|
||||
handle5: integer;
|
||||
handle6: integer;
|
||||
|
||||
public
|
||||
constructor Create (x: integer);
|
||||
destructor Destroy; override;
|
||||
@ -34,12 +28,29 @@ type
|
||||
function FetchErrorMsg(): string;
|
||||
end;
|
||||
|
||||
InterpPtr = ^Interp;
|
||||
Location = record
|
||||
line: sizeint;
|
||||
colm: sizeint;
|
||||
filp: pwidechar;
|
||||
end;
|
||||
Synerr = record
|
||||
num: integer;
|
||||
loc: Location;
|
||||
tgt: record
|
||||
val: array[0..255] of widechar;
|
||||
len: sizeint;
|
||||
end;
|
||||
end;
|
||||
|
||||
SynerrPtr = ^Synerr;
|
||||
|
||||
(*----- external hcl function -----*)
|
||||
function hcl_errnum_to_errbcstr(errnum: integer; errbuf: pointer; errbufsz: sizeint): pointer; cdecl; external;
|
||||
function hcl_errnum_is_synerr(errnum: integer): boolean; cdecl; external;
|
||||
|
||||
function hcl_openstd(xtnsize: sizeint; errnum: pointer): pointer; cdecl; external;
|
||||
procedure hcl_close(handle: pointer); cdecl; external;
|
||||
function hcl_geterrnum(handle: pointer): integer; cdecl; external;
|
||||
function hcl_geterrbmsg(handle: pointer): pansichar; cdecl; external;
|
||||
function hcl_ignite(handle: pointer; heapsize: sizeint): integer; cdecl; external;
|
||||
function hcl_addbuiltinprims(handle: pointer): integer; cdecl; external;
|
||||
@ -53,18 +64,19 @@ procedure hcl_detachccio(handle: pointer); cdecl; external;
|
||||
function hcl_attachudiostdwithbcstr(handle: pointer; udi: pansichar; udo: pansichar): integer; cdecl; external;
|
||||
procedure hcl_detachudio(handle: pointer); cdecl; external;
|
||||
function hcl_compile(handle: pointer; cnode: pointer; flags: integer): integer; cdecl; external;
|
||||
function hcl_execute(handle: pointer): integer; cdecl; external;
|
||||
function hcl_execute(handle: pointer): pointer; cdecl; external;
|
||||
procedure hcl_abort(handle: pointer) cdecl; external;
|
||||
|
||||
procedure hcl_getsynerr(handle: pointer; synerr: SynerrPtr) cdecl; external;
|
||||
function hcl_count_ucstr(ptr: pwidechar): sizeint; cdecl; external;
|
||||
(*----- end external hcl function -----*)
|
||||
|
||||
implementation
|
||||
|
||||
uses sysutils;
|
||||
uses sysutils, math;
|
||||
|
||||
constructor Interp.Create (x: integer);
|
||||
var
|
||||
var
|
||||
h: pointer;
|
||||
errnum: integer;
|
||||
errmsg: array[0..255] of AnsiChar;
|
||||
@ -89,11 +101,30 @@ end;
|
||||
|
||||
function Interp.FetchErrorMsg(): string;
|
||||
var
|
||||
bmsg: PAnsiChar;
|
||||
num: integer;
|
||||
bmsg: pansichar;
|
||||
serr: Synerr;
|
||||
filp: pwidechar;
|
||||
tgt: array[0..255] of widechar;
|
||||
begin
|
||||
(* TODO: if the errocode is syntax error. use the systax error message and locations info *)
|
||||
bmsg := hcl_geterrbmsg(self.handle);
|
||||
exit(string(bmsg))
|
||||
num := hcl_geterrnum(self.handle);
|
||||
if hcl_errnum_is_synerr(num) then begin
|
||||
hcl_getsynerr(self.handle, @serr);
|
||||
bmsg := hcl_geterrbmsg(self.handle);
|
||||
filp := pwidechar(widestring(''));
|
||||
if serr.loc.filp <> nil then filp := serr.loc.filp;
|
||||
if serr.tgt.len > 0 then begin
|
||||
sysutils.strlcopy(@tgt, serr.tgt.val, math.min(serr.tgt.len, length(tgt) - 1));
|
||||
exit(format('%s at %s[%u:%u] - %s', [string(bmsg), string(filp), serr.loc.line, serr.loc.colm, string(tgt)]));
|
||||
end
|
||||
else begin
|
||||
exit(format('%s at %s[%u:%u]', [string(bmsg), string(filp), serr.loc.line, serr.loc.colm]));
|
||||
end;
|
||||
end
|
||||
else begin
|
||||
bmsg := hcl_geterrbmsg(self.handle);
|
||||
exit(string(bmsg))
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Interp.Ignite(heapsize: sizeint);
|
||||
@ -121,6 +152,7 @@ end;
|
||||
|
||||
procedure Interp.Compile(text: pansichar; len: sizeint);
|
||||
var
|
||||
errnum: integer;
|
||||
errmsg: string;
|
||||
begin
|
||||
if hcl_attachcciostdwithbcstr(self.handle, nil) <= -1 then begin
|
||||
@ -132,12 +164,16 @@ begin
|
||||
hcl_detachccio(self.handle);
|
||||
raise Exception.Create('failed to begin feeding - ' + errmsg)
|
||||
end;
|
||||
|
||||
|
||||
if hcl_feedbchars(self.handle, text, len) <= -1 then begin
|
||||
errnum := hcl_geterrnum(self.handle);
|
||||
errmsg := self.FetchErrorMsg();
|
||||
hcl_endfeed(self.handle);
|
||||
hcl_detachccio(self.handle);
|
||||
raise Exception.Create('failed to feed text - ' + errmsg)
|
||||
if hcl_errnum_is_synerr(errnum) then
|
||||
raise Exception.Create(errmsg)
|
||||
else
|
||||
raise Exception.Create('failed to feed text - ' + errmsg);
|
||||
end;
|
||||
|
||||
if hcl_endfeed(self.handle) <= -1 then begin
|
||||
@ -156,6 +192,7 @@ end;
|
||||
|
||||
procedure Interp.Compile(text: pwidechar; len: sizeint);
|
||||
var
|
||||
errnum: integer;
|
||||
errmsg: string;
|
||||
begin
|
||||
if hcl_attachcciostdwithbcstr(self.handle, nil) <= -1 then begin
|
||||
@ -169,10 +206,14 @@ begin
|
||||
end;
|
||||
|
||||
if hcl_feeduchars(self.handle, text, len) <= -1 then begin
|
||||
errnum := hcl_geterrnum(self.handle);
|
||||
errmsg := self.FetchErrorMsg();
|
||||
hcl_endfeed(self.handle);
|
||||
hcl_detachccio(self.handle);
|
||||
raise Exception.Create('failed to feed text - ' + errmsg)
|
||||
if hcl_errnum_is_synerr(errnum) then
|
||||
raise Exception.Create(errmsg)
|
||||
else
|
||||
raise Exception.Create('failed to feed text - ' + errmsg);
|
||||
end;
|
||||
|
||||
if hcl_endfeed(self.handle) <= -1 then begin
|
||||
@ -187,17 +228,18 @@ end;
|
||||
|
||||
procedure Interp.Execute();
|
||||
var
|
||||
n: integer;
|
||||
errmsg: string;
|
||||
begin
|
||||
if hcl_attachudiostdwithbcstr(self.handle, nil, nil) <= -1 then begin
|
||||
raise Exception.Create('failed to attach udio handlers - ' + self.FetchErrorMsg())
|
||||
end;
|
||||
n := hcl_execute(self.handle);
|
||||
hcl_detachudio(self.handle);
|
||||
if n <= -1 then
|
||||
begin
|
||||
raise Exception.Create('failed to execute - ' + self.FetchErrorMsg())
|
||||
if hcl_execute(self.handle) = nil then begin
|
||||
errmsg := self.FetchErrorMsg();
|
||||
hcl_detachudio(self.handle);
|
||||
raise Exception.Create('failed to execute - ' + errmsg)
|
||||
end;
|
||||
|
||||
hcl_detachudio(self.handle);
|
||||
end;
|
||||
|
||||
end. (* unit *)
|
||||
|
||||
57
pas/main.pas
57
pas/main.pas
@ -4,55 +4,6 @@ program main;
|
||||
|
||||
uses HCL, sysutils;
|
||||
|
||||
(*
|
||||
function Make(): HCL.InterpPtr;
|
||||
var
|
||||
x: HCL.Interp;
|
||||
begin
|
||||
x := HCL.Interp.Create(20);
|
||||
Make := @x;
|
||||
end;
|
||||
|
||||
function Make2(): HCL.Interp;
|
||||
begin
|
||||
Make2 := HCL.Interp.Create(20);
|
||||
end;
|
||||
|
||||
|
||||
var
|
||||
x: HCL.Interp;
|
||||
x2: ^HCL.Interp;
|
||||
begin
|
||||
Write ('sizeof X=>');
|
||||
Writeln (SizeOf(x));
|
||||
x := HCL.Interp.Make(20);
|
||||
Write ('instance sizeof X=>');
|
||||
Writeln (x.InstanceSize());
|
||||
// x.Open();
|
||||
// x.Close();
|
||||
x.Destroy();
|
||||
//x.Free();
|
||||
|
||||
Write ('sizeof X2=>');
|
||||
Writeln (SizeOf(x2));
|
||||
|
||||
// New(x2);
|
||||
// x2^.Open();
|
||||
// //x2^.Destroy();
|
||||
// //x2^.Free();
|
||||
// Dispose (x2);
|
||||
|
||||
x := Make2();
|
||||
//Writeln (x.handle);
|
||||
x.Destroy();
|
||||
x := nil;
|
||||
|
||||
// x2 := Make();
|
||||
// Writeln (x2^.handle);
|
||||
// x2^.Destroy();
|
||||
end.
|
||||
*)
|
||||
|
||||
var
|
||||
x: HCL.Interp = nil;
|
||||
begin
|
||||
@ -65,11 +16,11 @@ begin
|
||||
//x.AttachUDIO();
|
||||
|
||||
x.Compile(pwidechar('(printf "hello 동키콩\n")'));
|
||||
x.Compile('(printf "hello 동키콩월드\n")');
|
||||
x.Compile('(a := 20)');
|
||||
x.Compile('(printf "%d\n" a)');
|
||||
x.Compile('(printf "hello 동키콩월드\n") ');
|
||||
x.Compile('(동가리오 := 20)');
|
||||
x.Compile('(printf "%d %d\n" 동가리오 (* 동가리오 동가리오))');
|
||||
|
||||
x.Execute();
|
||||
x.Execute(); // check if exception...
|
||||
except
|
||||
on e: Exception do
|
||||
writeln ('exception:', e.Message);
|
||||
|
||||
Reference in New Issue
Block a user