mirror of
https://github.com/byteworksinc/ORCA-Pascal.git
synced 2024-11-23 06:31:55 +00:00
This patch allows forward object declarations, in the same manner as delphi. To pre-declare an object, use a semicolon after the object keyword.
Example: Type forwardObject = Object; {forward declaration} myObject = Object count: integer; procedure init; function createForwardObject: forwardObject; end; fowardObject = Object (myObject) procedure init; override; end; --- outstanding issues: new(forward_declared_object); -> error 44, "error in type of standard procedure parameter" OtherObject = Object (ForwardDeclaredObject) end; -> errror 129, "type of variable must be object" debugger symbol tables
This commit is contained in:
parent
0548a011a9
commit
7d6b083546
2
call.pas
2
call.pas
@ -1281,7 +1281,7 @@ if gattr.typtr <> nil then
|
|||||||
lsp := eltype^.recvar;
|
lsp := eltype^.recvar;
|
||||||
end; {if}
|
end; {if}
|
||||||
end {if}
|
end {if}
|
||||||
else if form = objects then begin
|
else if (form = objects) and (objdef) then begin
|
||||||
lsize := objsize;
|
lsize := objsize;
|
||||||
ofld := objfld;
|
ofld := objfld;
|
||||||
end {else if}
|
end {else if}
|
||||||
|
173
parser.pas
173
parser.pas
@ -117,6 +117,7 @@ var
|
|||||||
objectcp: ctp; {last procedure or function identifier}
|
objectcp: ctp; {last procedure or function identifier}
|
||||||
objectName: pString; {object name (for methods)}
|
objectName: pString; {object name (for methods)}
|
||||||
objectType: stp; {type of method's object}
|
objectType: stp; {type of method's object}
|
||||||
|
objptr: ctp; {linked list of objects}
|
||||||
|
|
||||||
{structured constants:}
|
{structured constants:}
|
||||||
{---------------------}
|
{---------------------}
|
||||||
@ -356,7 +357,7 @@ end; {DoConstant}
|
|||||||
Duplicate(ncp^.llink, ocp^.llink);
|
Duplicate(ncp^.llink, ocp^.llink);
|
||||||
Duplicate(ncp^.rlink, ocp^.rlink);
|
Duplicate(ncp^.rlink, ocp^.rlink);
|
||||||
end; {if}
|
end; {if}
|
||||||
end; {Dulpicate}
|
end; {Duplicate}
|
||||||
|
|
||||||
|
|
||||||
procedure SimpleType (fsys:setofsys; var fsp:stp; var fsize:addrrange);
|
procedure SimpleType (fsys:setofsys; var fsp:stp; var fsize:addrrange);
|
||||||
@ -979,80 +980,113 @@ end; {DoConstant}
|
|||||||
if not isType then
|
if not isType then
|
||||||
Error(127);
|
Error(127);
|
||||||
|
|
||||||
{set up a new display}
|
{ check for previous foward declaration }
|
||||||
oldtop := top;
|
lsp := nil;
|
||||||
if top < displimit then begin
|
lcp := objptr;
|
||||||
top := top+1;
|
while (lcp <> nil) and (CompNames(objectName, lcp^.name^) <> 0)
|
||||||
with display[top] do begin
|
do lcp := lcp^.next;
|
||||||
fname := nil;
|
|
||||||
flabel := nil;
|
if lcp <> nil then lsp := lcp^.idtype;
|
||||||
labsused := nil;
|
if (sy <> semicolon) and (lsp <> nil) and (lsp^.objdef) then lsp := nil;
|
||||||
occur := rec;
|
|
||||||
|
if lsp = nil then begin
|
||||||
|
{set up the type}
|
||||||
|
lsp := pointer(Malloc(sizeof(structure)));
|
||||||
|
with lsp^ do begin
|
||||||
|
form := objects;
|
||||||
|
objname := nil;
|
||||||
|
objsize := 6;
|
||||||
|
objlevel := 1;
|
||||||
|
objparent := nil;
|
||||||
|
objdef := true;
|
||||||
|
size := ptrsize;
|
||||||
|
hasSFile := false;
|
||||||
|
end; {with}
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ handle forward declaration }
|
||||||
|
if sy = semicolon then begin
|
||||||
|
{ if lcp is defined, then we're already inserted, nothing to do}
|
||||||
|
if lcp = nil then begin
|
||||||
|
lsp^.objdef := false;
|
||||||
|
objectcp^.idtype := lsp;
|
||||||
|
EnterId(objectcp);
|
||||||
|
objectcp^.next := objptr;
|
||||||
|
objptr := objectcp;
|
||||||
|
end;
|
||||||
|
end else begin
|
||||||
|
|
||||||
|
{set up a new display}
|
||||||
|
oldtop := top;
|
||||||
|
if top < displimit then begin
|
||||||
|
top := top+1;
|
||||||
|
with display[top] do begin
|
||||||
|
fname := nil;
|
||||||
|
flabel := nil;
|
||||||
|
labsused := nil;
|
||||||
|
occur := rec;
|
||||||
|
end
|
||||||
end
|
end
|
||||||
end
|
else
|
||||||
else
|
Error(107);
|
||||||
Error(107);
|
disp1 := 6;
|
||||||
disp1 := 6;
|
|
||||||
|
|
||||||
{set up the type}
|
|
||||||
lsp := pointer(Malloc(sizeof(structure)));
|
|
||||||
with lsp^ do begin
|
|
||||||
form := objects;
|
|
||||||
objname := nil;
|
|
||||||
objsize := 6;
|
|
||||||
objlevel := 1;
|
|
||||||
objparent := nil;
|
|
||||||
size := ptrsize;
|
|
||||||
hasSFile := false;
|
|
||||||
end; {with}
|
|
||||||
|
|
||||||
{handle inheritance}
|
{handle inheritance}
|
||||||
if sy = lparent then begin
|
if sy = lparent then begin
|
||||||
InSymbol;
|
InSymbol;
|
||||||
if sy = ident then begin
|
if sy = ident then begin
|
||||||
SearchId([types], lcp2);
|
SearchId([types], lcp2);
|
||||||
if lcp2 <> nil then begin
|
if lcp2 <> nil then begin
|
||||||
if lcp2^.idtype <> nil then
|
if lcp2^.idtype <> nil then
|
||||||
if lcp2^.idtype^.form = objects then begin
|
if (lcp2^.idtype^.form = objects) and (lcp2^.idtype^.objdef)
|
||||||
Duplicate(display[top].fname, lcp2^.idtype^.objfld);
|
then begin
|
||||||
disp1 := lcp2^.idtype^.objsize;
|
Duplicate(display[top].fname, lcp2^.idtype^.objfld);
|
||||||
lsp^.objparent := lcp2^.idtype;
|
disp1 := lcp2^.idtype^.objsize;
|
||||||
lsp^.objlevel := lcp2^.idtype^.objlevel + 1;
|
lsp^.objparent := lcp2^.idtype;
|
||||||
end {if}
|
lsp^.objlevel := lcp2^.idtype^.objlevel + 1;
|
||||||
else
|
end {if}
|
||||||
Error(129);
|
else
|
||||||
|
Error(129);
|
||||||
|
end {if}
|
||||||
|
else
|
||||||
|
Error(33);
|
||||||
|
InSymbol;
|
||||||
end {if}
|
end {if}
|
||||||
else
|
else
|
||||||
Error(33);
|
Error(128);
|
||||||
InSymbol;
|
Match(rparent,4);
|
||||||
end {if}
|
end; {if}
|
||||||
else
|
|
||||||
Error(128);
|
|
||||||
Match(rparent,4);
|
|
||||||
end; {if}
|
|
||||||
|
|
||||||
{compile the fields and methods}
|
{compile the fields and methods}
|
||||||
if sy in typebegsys then
|
if sy in typebegsys then
|
||||||
FieldList(fsys-[semicolon]+[endsy,procsy,funcsy], lsp1,
|
FieldList(fsys-[semicolon]+[endsy,procsy,funcsy], lsp1,
|
||||||
lsp^.hasSFile, true);
|
lsp^.hasSFile, true);
|
||||||
objectType := lsp;
|
objectType := lsp;
|
||||||
ttop := top;
|
if lsp^.objdef then begin
|
||||||
top := oldtop;
|
ttop := top;
|
||||||
EnterId(objectcp);
|
top := oldtop;
|
||||||
top := ttop;
|
objectcp^.idtype := lsp;
|
||||||
objectcp^.idtype := lsp;
|
EnterId(objectcp);
|
||||||
ProcList(fsys-[semicolon]+[endsy]);
|
objectcp^.next := objptr;
|
||||||
if disp1 > $010000 then
|
objptr := objectcp;
|
||||||
if SmallMemoryModel then
|
top := ttop;
|
||||||
Error(122);
|
end;
|
||||||
lsp^.objfld := display[top].fname;
|
lsp^.objdef := true;
|
||||||
lsp^.objsize := disp1;
|
|
||||||
|
|
||||||
lsp^.ispacked := ispacked;
|
ProcList(fsys-[semicolon]+[endsy]);
|
||||||
ExportUses;
|
if disp1 > $010000 then
|
||||||
top := oldtop;
|
if SmallMemoryModel then
|
||||||
Match(endsy,13);
|
Error(122);
|
||||||
end {else if}
|
lsp^.objfld := display[top].fname;
|
||||||
|
lsp^.objsize := disp1;
|
||||||
|
|
||||||
|
lsp^.ispacked := ispacked;
|
||||||
|
ExportUses;
|
||||||
|
top := oldtop;
|
||||||
|
Match(endsy,13);
|
||||||
|
end; {if not forward declaration}
|
||||||
|
end {else if}
|
||||||
{set} else if sy = setsy then begin
|
{set} else if sy = setsy then begin
|
||||||
InSymbol;
|
InSymbol;
|
||||||
Match(ofsy,8);
|
Match(ofsy,8);
|
||||||
@ -1268,7 +1302,7 @@ end; {DoConstant}
|
|||||||
else
|
else
|
||||||
Error(16);
|
Error(16);
|
||||||
objectName := lcp^.name^;
|
objectName := lcp^.name^;
|
||||||
objectCp := lcp;
|
objectcp := lcp;
|
||||||
Typ(fsys+[semicolon], lsp, lsize, true); {get the type}
|
Typ(fsys+[semicolon], lsp, lsize, true); {get the type}
|
||||||
if lsp^.form = objects then
|
if lsp^.form = objects then
|
||||||
lsp^.objname := lcp^.name;
|
lsp^.objname := lcp^.name;
|
||||||
@ -5020,6 +5054,7 @@ end; {DoConstant}
|
|||||||
code := pointer(Calloc(sizeof(intermediate_code)));
|
code := pointer(Calloc(sizeof(intermediate_code)));
|
||||||
{code^.lab := nil;}
|
{code^.lab := nil;}
|
||||||
fwptr := nil;
|
fwptr := nil;
|
||||||
|
objptr := nil;
|
||||||
fextfilep := nil;
|
fextfilep := nil;
|
||||||
thisType := nil; {not declaring a type}
|
thisType := nil; {not declaring a type}
|
||||||
tempList := nil; {no temp variables}
|
tempList := nil; {no temp variables}
|
||||||
|
@ -132,6 +132,7 @@ type
|
|||||||
objname: pstringptr; {object name}
|
objname: pstringptr; {object name}
|
||||||
objlevel: integer; {generation level}
|
objlevel: integer; {generation level}
|
||||||
objparent: stp; {parent or nil}
|
objparent: stp; {parent or nil}
|
||||||
|
objdef: boolean; {false if not defined}
|
||||||
);
|
);
|
||||||
files: (filtype: stp; filsize: addrrange);
|
files: (filtype: stp; filsize: addrrange);
|
||||||
tagfld: (tagfieldp: ctp; fstvar: stp);
|
tagfld: (tagfieldp: ctp; fstvar: stp);
|
||||||
|
Loading…
Reference in New Issue
Block a user