Commit 207623ee authored by Martin Schreiber's avatar Martin Schreiber

* MSElang -> mselang repo.

parent f87a499c
This diff is collapsed.
{ MSElang Copyright (c) 2013-2014 by Martin Schreiber
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
}
unit classhandler;
{$ifdef FPC}{$mode objfpc}{$h+}{$endif}
interface
uses
parserglob;
procedure handleclassdefstart();
procedure handleclassdeferror();
procedure handleclassdefreturn();
procedure handleclassdefparam2();
procedure handleclassdefparam3a();
procedure handleclassprivate();
procedure handleclassprotected();
procedure handleclasspublic();
procedure handleclasspublished();
procedure handleclassfield();
procedure handlemethfunctionentry();
procedure handlemethprocedureentry();
procedure handlemethconstructorentry();
procedure handlemethdestructorentry();
procedure handleconstructorentry();
procedure handledestructorentry();
implementation
uses
elements,handler,errorhandler,unithandler,grammar,handlerglob,handlerutils,
parser,typehandler,opcode;
{
const
vic_private = vis_3;
vic_protected = vis_2;
vic_public = vis_1;
vic_published = vis_0;
}
{
procedure classesscopeset();
var
po2: pclassesdataty;
begin
po2:= @pelementinfoty(
ele.eleinfoabs(info.unitinfo^.classeselement))^.data;
po2^.scopebefore:= ele.elementparent;
ele.elementparent:= info.unitinfo^.classeselement;
end;
procedure classesscopereset();
var
po2: pclassesdataty;
begin
po2:= @pelementinfoty(
ele.eleinfoabs(info.unitinfo^.classeselement))^.data;
ele.elementparent:= po2^.scopebefore;
end;
}
procedure handleclassdefstart();
var
po1: ptypedataty;
// po2: pclassdataty;
// po3: pvisibledataty;
id1: identty;
begin
{$ifdef mse_debugparser}
outhandle('CLASSDEFSTART');
{$endif}
outinfo('**1**');
with info do begin
if stackindex < 3 then begin
internalerror('H20140325D');
exit;
end;
include(currentstatementflags,stf_classdef);
with contextstack[stackindex] do begin
d.kind:= ck_classdef;
d.cla.visibility:= classpublishedvisi;
d.cla.fieldoffset:= 0;
// d.cla.parentclass:= 0;
end;
with contextstack[stackindex-2] do begin
if (d.kind = ck_ident) and
(contextstack[stackindex-1].d.kind = ck_typetype) then begin
id1:= d.ident.ident; //typedef
end
else begin
errormessage(err_anonclassdef,[]);
exit;
end;
end;
contextstack[stackindex].b.eleparent:= ele.elementparent;
with contextstack[stackindex-1] do begin
if not ele.pushelement(id1,globalvisi,ek_type,d.typ.typedata) then begin
identerror(stacktop-stackindex,err_duplicateidentifier,erl_fatal);
end;
currentclass:= d.typ.typedata;
po1:= ele.eledataabs(currentclass);
with po1^ do begin
kind:= dk_class;
datasize:= das_pointer;
bytesize:= pointersize;
bitsize:= pointersize*8;
ancestor:= 0;
infoclass.impl:= 0;
infoclass.defs:= 0;
end;
end;
{
if not ele.addelement(id1,vis_max,ek_type,po1) then begin
identerror(stacktop-stackindex,err_duplicateidentifier,erl_fatal);
end
else begin
classesscopeset();
ele.pushelement(id1,vis_max,ek_class,po2);
currentclass:= ele.eledatarel(po2);
currentclassvislevel:= vic_published; //default
end;
}
end;
outinfo('**2**');
end;
procedure handleclassdefparam2();
var
po1,po2: ptypedataty;
begin
{$ifdef mse_debugparser}
outhandle('CLASSDEFPARAM2');
{$endif}
outinfo('***');
with info do begin
po1:= ele.eledataabs(currentclass);
ele.pushelementparent();
ele.decelementparent; //interface or implementation
if findkindelementsdata(1,[ek_type],allvisi,po2) then begin
if po2^.kind <> dk_class then begin
errormessage(err_classidentexpected,[]);
end
else begin
po1^.ancestor:= ele.eledatarel(po2);
with contextstack[stackindex-2] do begin
d.cla.fieldoffset:= po2^.infoclass.allocsize;
end;
end;
end;
ele.popelementparent;
// dec(stackindex);
end;
end;
procedure handleclassdefparam3a();
begin
{$ifdef mse_debugparser}
outhandle('CLASSDEFPARAM3A');
{$endif}
outinfo('***');
with info do begin
// dec(stackindex);
end;
end;
procedure handleclassdefreturn();
var
po2: pclassesdataty;
ele1: elementoffsetty;
begin
{$ifdef mse_debugparser}
outhandle('CLASSDEFRETURN');
{$endif}
// classesscopereset();
with info do begin
exclude(currentstatementflags,stf_classdef);
with contextstack[stackindex-1],ptypedataty(ele.eledataabs(
d.typ.typedata))^ do begin
indirectlevel:= d.typ.indirectlevel;
outinfo('***');
// infoclass.impl:= 0;
infoclass.defs:= getglobconstaddress(sizeof(classdefinfoty));
with contextstack[stackindex] do begin
infoclass.allocsize:= d.cla.fieldoffset;
with pclassdefinfoty(pointer(constseg)+infoclass.defs)^ do begin
fieldsize:= d.cla.fieldoffset;
// parentclass:= d.cla.parentclass; //todo: pointer to parent in const
end;
end;
// if not ele.addelement(tks_classimp,globalvisi,ek_classimp,ele1) then begin
// internalerror('C20140415B');
// end;
ele1:= ele.addelementduplicate1(tks_classimp,globalvisi,ek_classimp);
ptypedataty(ele.eledataabs(d.typ.typedata))^.infoclass.impl:= ele1;
//possible capacity change
end;
ele.elementparent:= contextstack[stackindex].b.eleparent;
currentclass:= 0;
end;
end;
procedure handleclassdeferror();
begin
{$ifdef mse_debugparser}
outhandle('CLASSDEFERROR');
{$endif}
tokenexpectederror(tk_end);
end;
procedure handleclassprivate();
begin
{$ifdef mse_debugparser}
outhandle('CLASSPRIVATE');
{$endif}
outinfo('***');
with info,contextstack[stackindex] do begin
d.cla.visibility:= classprivatevisi;
end;
end;
procedure handleclassprotected();
begin
{$ifdef mse_debugparser}
outhandle('CLASSPROTECTED');
{$endif}
with info,contextstack[stackindex] do begin
d.cla.visibility:= classprotectedvisi;
end;
end;
procedure handleclasspublic();
begin
{$ifdef mse_debugparser}
outhandle('CLASSPUBLIC');
{$endif}
with info,contextstack[stackindex] do begin
d.cla.visibility:= classpublicvisi;
end;
end;
procedure handleclasspublished();
begin
{$ifdef mse_debugparser}
outhandle('CLASSPUBLISHED');
{$endif}
with info,contextstack[stackindex] do begin
d.cla.visibility:= classpublishedvisi;
end;
end;
procedure handleclassfield();
var
po1: pvardataty;
po2: ptypedataty;
ele1: elementoffsetty;
begin
{$ifdef mse_debugparser}
outhandle('CLASSFIELD');
{$endif}
outinfo('***');
with info,contextstack[stackindex-1] do begin
checkrecordfield(d.cla.visibility,[vf_classfield],d.cla.fieldoffset);
end;
{
with info do begin
ele.addelement(contextstack[stackindex+2].d.ident.ident,
currentclassvislevel,ek_var,po1);
if po1 = nil then begin
identerror(2,err_duplicateidentifier);
end;
ele1:= ele.elementparent;
classesscopereset();
if findkindelementsdata(3,[ek_type],vis_max,po2) then begin
end
else begin
identerror(stacktop-stackindex,err_identifiernotfound);
end;
ele.elementparent:= ele1;
end;
}
end;
procedure handlemethprocedureentry();
begin
{$ifdef mse_debugparser}
outhandle('METHPROCEDUREENTRY');
{$endif}
with info,contextstack[stackindex].d do begin
kind:= ck_subdef;
subdef.flags:= [sf_header,sf_method];
end;
end;
procedure handlemethfunctionentry();
begin
{$ifdef mse_debugparser}
outhandle('METHFUNCTIONENTRY');
{$endif}
outinfo('****');
with info,contextstack[stackindex].d do begin
kind:= ck_subdef;
subdef.flags:= [sf_function,sf_header,sf_method];
end;
end;
procedure handlemethconstructorentry();
begin
{$ifdef mse_debugparser}
outhandle('METHCONSTRUCTORENTRY');
{$endif}
outinfo('****');
with info,contextstack[stackindex].d do begin
kind:= ck_subdef;
subdef.flags:= [sf_header,sf_method,sf_constructor];
end;
end;
procedure handlemethdestructorentry();
begin
{$ifdef mse_debugparser}
outhandle('METHDESTRUCTORENTRY');
{$endif}
outinfo('****');
with info,contextstack[stackindex].d do begin
kind:= ck_subdef;
subdef.flags:= [sf_header,sf_method,sf_destructor];
end;
end;
procedure handleconstructorentry();
begin
{$ifdef mse_debugparser}
outhandle('CONSTRUCTORENTRY');
{$endif}
outinfo('****');
with info,contextstack[stackindex].d do begin
kind:= ck_subdef;
subdef.flags:= [sf_method,sf_constructor];
end;
end;
procedure handledestructorentry();
begin
{$ifdef mse_debugparser}
outhandle('DESTRUCTORENTRY');
{$endif}
outinfo('****');
with info,contextstack[stackindex].d do begin
kind:= ck_subdef;
subdef.flags:= [sf_method,sf_destructor];
end;
end;
end.
This diff is collapsed.
This diff is collapsed.
{ MSElang Copyright (c) 2013 by Martin Schreiber
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
}
unit filehandler;
{$ifdef FPC}{$mode objfpc}{$h+}{$endif}
interface
uses
msestrings;
function getunitfile(const aname: lstringty): filenamety;
function getincludefile(const aname: lstringty): filenamety;
implementation
uses
msefileutils;
function getunitfile(const aname: lstringty): filenamety;
begin
// result:= filepath(utf8tostring(aname)+'.pas');
result:= filepath(utf8tostring(aname)+'.mla');
if not findfile(result) then begin
result:= '';
end;
end;
function getincludefile(const aname: lstringty): filenamety;
begin
result:= filepath(utf8tostring(aname));
if not findfile(result) then begin
result:= '';
end;
end;
end.
This diff is collapsed.
This diff is collapsed.
{ MSElang Copyright (c) 2013 by Martin Schreiber
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
}
program grammargen;
{$ifdef FPC}{$mode objfpc}{$h+}{$endif}
{$ifdef mswindows}{$apptype console}{$endif}
uses
{$ifdef FPC}{$ifdef unix}cthreads,cwstring,{$endif}{$endif}
sysutils,mainmodule,msenogui;
begin
application.createdatamodule(tmainmo,mainmo);
application.run;
end.
This diff is collapsed.
object mainmo: tmainmo
bounds_cx = 298
bounds_cy = 105
oneventloopstart = eventloopexe
left = 47
top = 216
moduleclassname = 'tmsedatamodule'
object sysenv: tsysenvmanager
options = [seo_appterminateonexception, seo_terminateonerror, seo_tooutput, seo_toerror]
onafterinit = afterinitexe
left = 16
top = 8
defs = (
(
ak_pararg
'g'
( )
[arf_mandatory]
''
'GRAMMARFILE'
''
''
''
)
(
ak_pararg
'p'
( )
[arf_mandatory]
''
'PASCALFILE'
''
''
''
)
)
end
end
This diff is collapsed.
unit mainmodule_mfm;
{$ifdef FPC}{$mode objfpc}{$h+}{$endif}
interface
implementation
uses
mseclasses,mainmodule;
const
objdata: record size: integer; data: array[0..385] of byte end =
(size: 386; data: (
84,80,70,48,7,116,109,97,105,110,109,111,6,109,97,105,110,109,111,9,
98,111,117,110,100,115,95,99,120,3,42,1,9,98,111,117,110,100,115,95,
99,121,2,105,16,111,110,101,118,101,110,116,108,111,111,112,115,116,97,114,
116,7,12,101,118,101,110,116,108,111,111,112,101,120,101,4,108,101,102,116,
2,47,3,116,111,112,3,216,0,15,109,111,100,117,108,101,99,108,97,115,
115,110,97,109,101,6,14,116,109,115,101,100,97,116,97,109,111,100,117,108,
101,0,14,116,115,121,115,101,110,118,109,97,110,97,103,101,114,6,115,121,
115,101,110,118,7,111,112,116,105,111,110,115,11,27,115,101,111,95,97,112,
112,116,101,114,109,105,110,97,116,101,111,110,101,120,99,101,112,116,105,111,
110,20,115,101,111,95,116,101,114,109,105,110,97,116,101,111,110,101,114,114,
111,114,12,115,101,111,95,116,111,111,117,116,112,117,116,11,115,101,111,95,
116,111,101,114,114,111,114,0,11,111,110,97,102,116,101,114,105,110,105,116,
7,12,97,102,116,101,114,105,110,105,116,101,120,101,4,108,101,102,116,2,
16,3,116,111,112,2,8,4,100,101,102,115,1,1,7,9,97,107,95,112,
97,114,97,114,103,6,1,103,1,0,11,13,97,114,102,95,109,97,110,100,
97,116,111,114,121,0,6,0,6,11,71,82,65,77,77,65,82,70,73,76,
69,6,0,6,0,6,0,0,1,7,9,97,107,95,112,97,114,97,114,103,
6,1,112,1,0,11,13,97,114,102,95,109,97,110,100,97,116,111,114,121,
0,6,0,6,10,80,65,83,67,65,76,70,73,76,69,6,0,6,0,6,
0,0,0,0,0,0)
);
initialization
registerobjectdata(@objdata,tmainmo,'');
end.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
object mainfo: tmainfo
bounds_x = 4
bounds_y = 186
bounds_cx = 628
bounds_cy = 450
anchors = [an_top, an_right]
container.bounds = (
0
0
628
450
)
options = [fo_main, fo_terminateonclose, fo_autoreadstat, fo_delayedreadstat, fo_autowritestat, fo_savepos, fo_savezorder, fo_savestate]
statfile = statf
caption = 'MSElang'
moduleclassname = 'tmainform'
object tbutton1: tbutton
bounds_x = 560
bounds_y = 7
bounds_cx = 50
bounds_cy = 20
anchors = [an_top, an_right]
state = [as_localcaption, as_localonexecute]
caption = 'parse'
onexecute = parseexe
end
object grid: tstringgrid
taborder = 1
bounds_x = 16
bounds_y = 327
bounds_cx = 595
bounds_cy = 115
anchors = [an_left, an_top, an_right, an_bottom]
font.name = 'stf_fixed'
font.xscale = 1
font.dummy = 0
datacols.count = 1
datacols.items = <
item
width = 539
options = [co_fill, co_savevalue, co_savestate, co_mousescrollrow]
valuefalse = '0'
valuetrue = '1'
end>
fixcols.count = 1
fixcols.items = <
item
numstart = -1
numstep = 1
end>
datarowheight = 16
reffontheight = 14
end
object tsplitter1: tsplitter
color = -1879048189
taborder = 2
bounds_x = 16
bounds_y = 324
bounds_cx = 595
bounds_cy = 3
anchors = [an_left, an_top, an_right]
options = [spo_vmove, spo_dockleft, spo_docktop, spo_dockright, spo_dockbottom]
linktop = edgrid
linkbottom = grid
statfile = statf
end
object edgrid: twidgetgrid
taborder = 3
bounds_x = 16
bounds_y = 32
bounds_cx = 595
bounds_cy = 292
anchors = [an_left, an_top, an_right]
optionsgrid = [og_focuscellonenter, og_autofirstrow, og_colchangeontabkey, og_wrapcol, og_autopopup, og_mousescrollcol]
fixcols.count = 1
fixcols.width = 30
fixcols.items = <
item
width = 30
numstart = 1
numstep = 1
end>
datacols.count = 1
datacols.options = [co_savestate, co_mousescrollrow]
datacols.items = <
item[ed]
width = 2016
options = [co_savestate, co_mousescrollrow]
widgetname = 'ed'
dataclass = tgridrichstringdatalist
end>
datarowlinewidth = 0
datarowheight = 14
statfile = statf
reffontheight = 14
object ed: tsyntaxedit
optionsskin = [osk_framebuttononly]
taborder = 1
visible = False
bounds_x = 0
bounds_y = 0
bounds_cx = 2016
bounds_cy = 14
font.height = 12
font.name = 'stf_fixed'
font.xscale = 1
font.dummy = 0
optionsedit = [oe_closequery, oe_checkmrcancel, oe_linebreak, oe_eatreturn, oe_exitoncursor, oe_nofirstarrownavig, oe_focusrectonreadonly, oe_savestate, oe_checkvaluepaststatread]
oneditnotifcation = editnotiexe
reffontheight = 14
end
end
object coldi: tintegerdisp
frame.dummy = 0
taborder = 4
bounds_x = 16
bounds_y = 8
bounds_cx = 52
bounds_cy = 18
reffontheight = 14
end
object tbutton5: tbutton
taborder = 5
bounds_x = 512
bounds_y = 7
bounds_cx = 42
bounds_cy = 20
anchors = [an_top, an_right]
state = [as_localcaption, as_localonexecute]
caption = 'save'
onexecute = saveexe
end
object tbutton2: tbutton
taborder = 6
bounds_x = 464
bounds_y = 7
bounds_cx = 42
bounds_cy = 20
anchors = [an_top, an_right]
state = [as_localcaption, as_localonexecute]
caption = 'load'
onexecute = loadexe
end
object filena: tfilenameedit
frame.button.imagenr = 17
taborder = 7
bounds_x = 72
bounds_y = 7
bounds_cx = 388
anchors = [an_left, an_top, an_right]
statfile = statf
textflags = [tf_ycentered, tf_noselect, tf_ellipseleft]
controller.filterlist.data = (
(
'MSElang source'
'*.mla'
)
)
reffontheight = 14
end
object statf: tstatfile
filename = 'status.sta'
onstatbeforewrite = befwriteexe
onstatafterread = aftreadexe
left = 232
top = 32
end
end
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment