paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-09 23:12:57 +01:00
Code Issues Packages Projects Releases Wiki Activity

* all internal RTL functions start with FPC_

Browse Source
This commit is contained in:
peter 1998-09-14 10:43:44 +00:00
parent c23f66b8be
commit 181d4769a2
19 changed files with 243 additions and 212 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
compiler/cg386add.pas
View File

@ -139,7 +139,7 @@ implementation
secondpass(p^.right); secondpass(p^.right);
del_reference(p^.right^.location.reference); del_reference(p^.right^.location.reference);
emitpushreferenceaddr(exprasmlist,p^.right^.location.reference); emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
emitcall('ANSISTRCMP',true); emitcall('FPC_ANSISTRCMP',true);
maybe_loadesi; maybe_loadesi;
popusedregisters(pushedregs); popusedregisters(pushedregs);
end; end;
@ -216,7 +216,7 @@ implementation
pushusedregisters(pushedregs,$ff); pushusedregisters(pushedregs,$ff);
emitpushreferenceaddr(exprasmlist,p^.left^.location.reference); emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
emitpushreferenceaddr(exprasmlist,p^.right^.location.reference); emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
emitcall('STRCONCAT',true); emitcall('FPC_STRCONCAT',true);
maybe_loadesi; maybe_loadesi;
popusedregisters(pushedregs); popusedregisters(pushedregs);
end; end;
@ -259,7 +259,7 @@ implementation
secondpass(p^.right); secondpass(p^.right);
del_reference(p^.right^.location.reference); del_reference(p^.right^.location.reference);
emitpushreferenceaddr(exprasmlist,p^.right^.location.reference); emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
emitcall('STRCMP',true); emitcall('FPC_STRCMP',true);
maybe_loadesi; maybe_loadesi;
popusedregisters(pushedregs); popusedregisters(pushedregs);
end; end;
@ -310,7 +310,7 @@ implementation
pushusedregisters(pushedregs,$ff); pushusedregisters(pushedregs,$ff);
emitpushreferenceaddr(exprasmlist,p^.right^.location.reference); emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
emitpushreferenceaddr(exprasmlist,p^.left^.location.reference); emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
emitcall('SET_COMP_SETS',true); emitcall('FPC_SET_COMP_SETS',true);
maybe_loadesi; maybe_loadesi;
popusedregisters(pushedregs); popusedregisters(pushedregs);
ungetiftemp(p^.left^.location.reference); ungetiftemp(p^.left^.location.reference);
@ -332,13 +332,13 @@ implementation
pushsetelement(p^.right^.right); pushsetelement(p^.right^.right);
pushsetelement(p^.right^.left); pushsetelement(p^.right^.left);
emitpushreferenceaddr(exprasmlist,href); emitpushreferenceaddr(exprasmlist,href);
emitcall('SET_SET_RANGE',true); emitcall('FPC_SET_SET_RANGE',true);
end end
else else
begin begin
pushsetelement(p^.right^.left); pushsetelement(p^.right^.left);
emitpushreferenceaddr(exprasmlist,href); emitpushreferenceaddr(exprasmlist,href);
emitcall('SET_SET_BYTE',true); emitcall('FPC_SET_SET_BYTE',true);
end; end;
end end
else else
@ -347,7 +347,7 @@ implementation
emitpushreferenceaddr(exprasmlist,href); emitpushreferenceaddr(exprasmlist,href);
emitpushreferenceaddr(exprasmlist,p^.right^.location.reference); emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
emitpushreferenceaddr(exprasmlist,p^.left^.location.reference); emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
emitcall('SET_ADD_SETS',true); emitcall('FPC_SET_ADD_SETS',true);
end; end;
maybe_loadesi; maybe_loadesi;
popusedregisters(pushedregs); popusedregisters(pushedregs);
@ -369,9 +369,9 @@ implementation
emitpushreferenceaddr(exprasmlist,p^.right^.location.reference); emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
emitpushreferenceaddr(exprasmlist,p^.left^.location.reference); emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
case p^.treetype of case p^.treetype of
subn : emitcall('SET_SUB_SETS',true); subn : emitcall('FPC_SET_SUB_SETS',true);
symdifn : emitcall('SET_SYMDIF_SETS',true); symdifn : emitcall('FPC_SET_SYMDIF_SETS',true);
muln : emitcall('SET_MUL_SETS',true); muln : emitcall('FPC_SET_MUL_SETS',true);
end; end;
maybe_loadesi; maybe_loadesi;
popusedregisters(pushedregs); popusedregisters(pushedregs);
@ -889,7 +889,7 @@ implementation
emitl(A_JNB,hl4) emitl(A_JNB,hl4)
else else
emitl(A_JNO,hl4); emitl(A_JNO,hl4);
emitcall('RE_OVERFLOW',true); emitcall('FPC_OVERFLOW',true);
emitl(A_LABEL,hl4); emitl(A_LABEL,hl4);
end; end;
end; end;
@ -1277,7 +1277,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.11 1998-09-07 18:45:52 peter Revision 1.12 1998-09-14 10:43:44 peter
* all internal RTL functions start with FPC_
Revision 1.11 1998/09/07 18:45:52 peter
* update smartlinking, uses getdatalabel * update smartlinking, uses getdatalabel
* renamed ptree.value vars to value_str,value_real,value_set * renamed ptree.value vars to value_str,value_real,value_set

11
compiler/cg386cal.pas
View File

@ -1053,7 +1053,7 @@ implementation
if (cs_check_range in aktlocalswitches) then if (cs_check_range in aktlocalswitches) then
begin begin
exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,r^.base))); exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,r^.base)));
emitcall('CHECK_OBJECT',true); emitcall('FPC_CHECK_OBJECT',true);
end; end;
exprasmlist^.concat(new(pai386,op_ref(A_CALL,S_NO,r))); exprasmlist^.concat(new(pai386,op_ref(A_CALL,S_NO,r)));
end end
@ -1268,9 +1268,7 @@ implementation
if iolabel<>nil then if iolabel<>nil then
begin begin
exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,newcsymbol(lab2str(iolabel),0)))); exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,newcsymbol(lab2str(iolabel),0))));
{ this was wrong, probably an error due to diff3 emitcall('FPC_IOCHECK',true);
emitcall(p^.procdefinition^.mangledname);}
emitcall('IOCHECK',true);
end; end;
if must_pop then if must_pop then
exprasmlist^.concat(new(pai386,op_const_reg(A_ADD,S_L,pop_size,R_ESP))); exprasmlist^.concat(new(pai386,op_const_reg(A_ADD,S_L,pop_size,R_ESP)));
@ -1408,7 +1406,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.22 1998-09-04 08:41:37 peter Revision 1.23 1998-09-14 10:43:45 peter
* all internal RTL functions start with FPC_
Revision 1.22 1998/09/04 08:41:37 peter
* updated some error messages * updated some error messages
Revision 1.21 1998/09/01 12:47:57 peter Revision 1.21 1998/09/01 12:47:57 peter

11
compiler/cg386cnv.pas
View File

@ -1032,7 +1032,7 @@ implementation
gettempofsizereference(32,href); gettempofsizereference(32,href);
emitpushreferenceaddr(exprasmlist,p^.left^.location.reference); emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
emitpushreferenceaddr(exprasmlist,href); emitpushreferenceaddr(exprasmlist,href);
emitcall('SET_LOAD_SMALL',true); emitcall('FPC_SET_LOAD_SMALL',true);
maybe_loadesi; maybe_loadesi;
popusedregisters(pushedregs); popusedregisters(pushedregs);
p^.location.loc:=LOC_MEM; p^.location.loc:=LOC_MEM;
@ -1193,7 +1193,7 @@ implementation
end; end;
else internalerror(100); else internalerror(100);
end; end;
emitcall('DO_IS',true); emitcall('FPC_DO_IS',true);
exprasmlist^.concat(new(pai386,op_reg_reg(A_OR,S_B,R_AL,R_AL))); exprasmlist^.concat(new(pai386,op_reg_reg(A_OR,S_B,R_AL,R_AL)));
popusedregisters(pushed); popusedregisters(pushed);
end; end;
@ -1242,7 +1242,7 @@ implementation
end; end;
else internalerror(100); else internalerror(100);
end; end;
emitcall('DO_AS',true); emitcall('FPC_DO_AS',true);
{ restore register, this restores automatically the } { restore register, this restores automatically the }
{ result } { result }
popusedregisters(pushed); popusedregisters(pushed);
@ -1252,7 +1252,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.18 1998-09-11 12:29:40 pierre Revision 1.19 1998-09-14 10:43:46 peter
* all internal RTL functions start with FPC_
Revision 1.18 1998/09/11 12:29:40 pierre
* removed explicit range_checking as it is buggy * removed explicit range_checking as it is buggy
Revision 1.17.2.1 1998/09/11 12:08:54 pierre Revision 1.17.2.1 1998/09/11 12:08:54 pierre

17
compiler/cg386flw.pas
View File

@ -719,13 +719,6 @@ do_jmp:
var var
hp : preference; hp : preference;
begin begin
{if procinfo.exceptions then
aktproccode.concat(gennasmrec(CALL,S_NO,'HELP_DESTRUCTOR_E'))
else }
{ we should know if the constructor is called with a new or not,
how can we do that ???
exprasmlist^.concat(new(pai386,op_csymbol(A_CALL,S_NO,newcsymbol('HELP_DESTRUCTOR',0))));
}
exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_L,R_ESI,R_ESI))); exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_L,R_ESI,R_ESI)));
{ also reset to zero in the stack } { also reset to zero in the stack }
new(hp); new(hp);
@ -740,7 +733,10 @@ do_jmp:
end. end.
{ {
$Log$ $Log$
Revision 1.15 1998-09-04 08:41:39 peter Revision 1.16 1998-09-14 10:43:48 peter
* all internal RTL functions start with FPC_
Revision 1.15 1998/09/04 08:41:39 peter
* updated some error messages * updated some error messages
Revision 1.14 1998/09/03 17:08:39 pierre Revision 1.14 1998/09/03 17:08:39 pierre
@ -758,7 +754,10 @@ end.
Revision 1.11 1998/08/05 16:00:10 florian Revision 1.11 1998/08/05 16:00:10 florian
* some fixes for ansi strings * some fixes for ansi strings
* $log$ to $Log$ * $log$ to $Log$
* $log$ to Revision 1.15 1998-09-04 08:41:39 peter * $log$ to Revision 1.16 1998-09-14 10:43:48 peter
* $log$ to * all internal RTL functions start with FPC_
* $log$ to
* $log$ to Revision 1.15 1998/09/04 08:41:39 peter
* $log$ to * updated some error messages * $log$ to * updated some error messages
* $log$ to * $log$ to
* $log$ to Revision 1.14 1998/09/03 17:08:39 pierre * $log$ to Revision 1.14 1998/09/03 17:08:39 pierre

80
compiler/cg386inl.pas
View File

@ -225,9 +225,9 @@ implementation
{ allways read only one record by element } { allways read only one record by element }
push_int(typedtyp^.size); push_int(typedtyp^.size);
if doread then if doread then
emitcall('TYPED_READ',true) emitcall('FPC_TYPED_READ',true)
else else
emitcall('TYPED_WRITE',true); emitcall('FPC_TYPED_WRITE',true);
end end
else else
begin begin
@ -281,34 +281,34 @@ implementation
push_int(pstringdef(pararesult)^.len); push_int(pstringdef(pararesult)^.len);
case pstringdef(pararesult)^.string_typ of case pstringdef(pararesult)^.string_typ of
st_shortstring: st_shortstring:
emitcall ('READ_TEXT_STRING',true); emitcall ('FPC_READ_TEXT_STRING',true);
st_ansistring: st_ansistring:
emitcall ('READ_TEXT_ANSISTRING',true); emitcall ('FPC_READ_TEXT_ANSISTRING',true);
st_longstring: st_longstring:
emitcall ('READ_TEXT_LONGSTRING',true); emitcall ('FPC_READ_TEXT_LONGSTRING',true);
st_widestring: st_widestring:
emitcall ('READ_TEXT_ANSISTRING',true); emitcall ('FPC_READ_TEXT_ANSISTRING',true);
end end
end end
else else
Case pstringdef(Pararesult)^.string_typ of Case pstringdef(Pararesult)^.string_typ of
st_shortstring: st_shortstring:
emitcall ('WRITE_TEXT_STRING',true); emitcall ('FPC_WRITE_TEXT_STRING',true);
st_ansistring: st_ansistring:
emitcall ('WRITE_TEXT_ANSISTRING',true); emitcall ('FPC_WRITE_TEXT_ANSISTRING',true);
st_longstring: st_longstring:
emitcall ('WRITE_TEXT_LONGSTRING',true); emitcall ('FPC_WRITE_TEXT_LONGSTRING',true);
st_widestring: st_widestring:
emitcall ('WRITE_TEXT_ANSISTRING',true); emitcall ('FPC_WRITE_TEXT_ANSISTRING',true);
end; end;
end; end;
pointerdef : begin pointerdef : begin
if is_equal(ppointerdef(pararesult)^.definition,cchardef) then if is_equal(ppointerdef(pararesult)^.definition,cchardef) then
begin begin
if doread then if doread then
emitcall('READ_TEXT_PCHAR_AS_POINTER',true) emitcall('FPC_READ_TEXT_PCHAR_AS_POINTER',true)
else else
emitcall('WRITE_TEXT_PCHAR_AS_POINTER',true); emitcall('FPC_WRITE_TEXT_PCHAR_AS_POINTER',true);
end; end;
end; end;
arraydef : begin arraydef : begin
@ -316,46 +316,45 @@ implementation
is_equal(parraydef(pararesult)^.definition,cchardef) then is_equal(parraydef(pararesult)^.definition,cchardef) then
begin begin
if doread then if doread then
emitcall('READ_TEXT_PCHAR_AS_ARRAY',true) emitcall('FPC_READ_TEXT_PCHAR_AS_ARRAY',true)
else else
emitcall('WRITE_TEXT_PCHAR_AS_ARRAY',true); emitcall('FPC_WRITE_TEXT_PCHAR_AS_ARRAY',true);
end; end;
end; end;
floatdef : begin floatdef : begin
if doread then if doread then
emitcall('READ_TEXT_'+float_name[pfloatdef(pararesult)^.typ],true) emitcall('FPC_READ_TEXT_'+float_name[pfloatdef(pararesult)^.typ],true)
else else
emitcall('WRITE_TEXT_'+float_name[pfloatdef(pararesult)^.typ],true); emitcall('FPC_WRITE_TEXT_'+float_name[pfloatdef(pararesult)^.typ],true);
end; end;
orddef : begin orddef : begin
case porddef(pararesult)^.typ of case porddef(pararesult)^.typ of
u8bit : if doread then u8bit : if doread then
emitcall('READ_TEXT_BYTE',true); emitcall('FPC_READ_TEXT_BYTE',true);
s8bit : if doread then s8bit : if doread then
emitcall('READ_TEXT_SHORTINT',true); emitcall('FPC_READ_TEXT_SHORTINT',true);
u16bit : if doread then u16bit : if doread then
emitcall('READ_TEXT_WORD',true); emitcall('FPC_READ_TEXT_WORD',true);
s16bit : if doread then s16bit : if doread then
emitcall('READ_TEXT_INTEGER',true); emitcall('FPC_READ_TEXT_INTEGER',true);
s32bit : if doread then s32bit : if doread then
emitcall('READ_TEXT_LONGINT',true) emitcall('FPC_READ_TEXT_LONGINT',true)
else else
emitcall('WRITE_TEXT_LONGINT',true); emitcall('FPC_WRITE_TEXT_LONGINT',true);
u32bit : if doread then u32bit : if doread then
emitcall('READ_TEXT_CARDINAL',true) emitcall('FPC_READ_TEXT_CARDINAL',true)
else else
emitcall('WRITE_TEXT_CARDINAL',true); emitcall('FPC_WRITE_TEXT_CARDINAL',true);
uchar : if doread then uchar : if doread then
emitcall('READ_TEXT_CHAR',true) emitcall('FPC_READ_TEXT_CHAR',true)
else else
emitcall('WRITE_TEXT_CHAR',true); emitcall('FPC_WRITE_TEXT_CHAR',true);
bool8bit, bool8bit,
bool16bit, bool16bit,
bool32bit : if doread then bool32bit : if doread then
{ emitcall('READ_TEXT_BOOLEAN',true) }
Message(parser_e_illegal_parameter_list) Message(parser_e_illegal_parameter_list)
else else
emitcall('WRITE_TEXT_BOOLEAN',true); emitcall('FPC_WRITE_TEXT_BOOLEAN',true);
end; end;
end; end;
end; end;
@ -373,16 +372,16 @@ implementation
if doread then if doread then
begin begin
if doln then if doln then
emitcall('READLN_END',true) emitcall('FPC_READLN_END',true)
else else
emitcall('READ_END',true); emitcall('FPC_READ_END',true);
end end
else else
begin begin
if doln then if doln then
emitcall('WRITELN_END',true) emitcall('FPC_WRITELN_END',true)
else else
emitcall('WRITE_END',true); emitcall('FPC_WRITE_END',true);
end; end;
popusedregisters(pushed); popusedregisters(pushed);
maybe_loadesi; maybe_loadesi;
@ -392,7 +391,7 @@ implementation
begin begin
{ registers are saved in the procedure } { registers are saved in the procedure }
exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,newcsymbol(lab2str(iolabel),0)))); exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,newcsymbol(lab2str(iolabel),0))));
emitcall('IOCHECK',true); emitcall('FPC_IOCHECK',true);
end; end;
{ Freeup all used temps } { Freeup all used temps }
ungetiftemp(aktfile); ungetiftemp(aktfile);
@ -498,11 +497,11 @@ implementation
exit; exit;
if is_real then if is_real then
emitcall('STR_'+float_name[pfloatdef(hp^.resulttype)^.typ],true) emitcall('FPC_STR_'+float_name[pfloatdef(hp^.resulttype)^.typ],true)
else if porddef(hp^.resulttype)^.typ=u32bit then else if porddef(hp^.resulttype)^.typ=u32bit then
emitcall('STR_CARDINAL',true) emitcall('FPC_STR_CARDINAL',true)
else else
emitcall('STR_LONGINT',true); emitcall('FPC_STR_LONGINT',true);
popusedregisters(pushed); popusedregisters(pushed);
end; end;
@ -842,9 +841,9 @@ implementation
secondload(p^.left); secondload(p^.left);
emitpushreferenceaddr(exprasmlist,p^.left^.location.reference); emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
if p^.inlinenumber=in_reset_typedfile then if p^.inlinenumber=in_reset_typedfile then
emitcall('RESET_TYPED',true) emitcall('FPC_RESET_TYPED',true)
else else
emitcall('REWRITE_TYPED',true); emitcall('FPC_REWRITE_TYPED',true);
popusedregisters(pushed); popusedregisters(pushed);
end; end;
in_write_x : in_write_x :
@ -930,7 +929,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.3 1998-09-05 23:03:57 florian Revision 1.4 1998-09-14 10:43:49 peter
* all internal RTL functions start with FPC_
Revision 1.3 1998/09/05 23:03:57 florian
* some fixes to get -Or work: * some fixes to get -Or work:
- inc/dec didn't take care of CREGISTER - inc/dec didn't take care of CREGISTER
- register calculcation of inc/dec was wrong - register calculcation of inc/dec was wrong

13
compiler/cg386ld.pas
View File

@ -403,10 +403,10 @@ implementation
emitpushreferenceaddr(exprasmlist,p^.right^.location.reference); emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
exprasmlist^.concat(new(pai386, exprasmlist^.concat(new(pai386,
op_csymbol(A_CALL,S_NO,newcsymbol('ADDREF',0)))); op_csymbol(A_CALL,S_NO,newcsymbol('FPC_ADDREF',0))));
if not (cs_compilesystem in aktmoduleswitches) then if not (cs_compilesystem in aktmoduleswitches) then
concat_external('ADDREF',EXT_NEAR); concat_external('FPC_ADDREF',EXT_NEAR);
{ decrement destination reference counter } { decrement destination reference counter }
new(r); new(r);
@ -416,10 +416,10 @@ implementation
emitpushreferenceaddr(exprasmlist,p^.left^.location.reference); emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
exprasmlist^.concat(new(pai386, exprasmlist^.concat(new(pai386,
op_csymbol(A_CALL,S_NO,newcsymbol('DECREF',0)))); op_csymbol(A_CALL,S_NO,newcsymbol('FPC_DECREF',0))));
if not(cs_compilesystem in aktmoduleswitches) then if not(cs_compilesystem in aktmoduleswitches) then
concat_external('DECREF',EXT_NEAR); concat_external('FPC_DECREF',EXT_NEAR);
end; end;
concatcopy(p^.right^.location.reference, concatcopy(p^.right^.location.reference,
@ -551,7 +551,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.13 1998-09-04 12:24:24 florian Revision 1.14 1998-09-14 10:43:50 peter
* all internal RTL functions start with FPC_
Revision 1.13 1998/09/04 12:24:24 florian
* bug0159 fixed * bug0159 fixed
Revision 1.12 1998/09/04 11:55:17 florian Revision 1.12 1998/09/04 11:55:17 florian

13
compiler/cg386mem.pas
View File

@ -156,13 +156,13 @@ implementation
LOC_REFERENCE: LOC_REFERENCE:
emitpushreferenceaddr(exprasmlist,p^.left^.location.reference); emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
end; end;
emitcall('FINALIZE',true); emitcall('FPC_FINALIZE',true);
end; end;
emitcall('FREEMEM',true); emitcall('FPC_FREEMEM',true);
end; end;
simplenewn: simplenewn:
begin begin
emitcall('GETMEM',true); emitcall('FPC_GETMEM',true);
if ppointerdef(p^.left^.resulttype)^.definition^.needs_inittable then if ppointerdef(p^.left^.resulttype)^.definition^.needs_inittable then
begin begin
new(r); new(r);
@ -176,7 +176,7 @@ implementation
LOC_REFERENCE: LOC_REFERENCE:
emitpushreferenceaddr(exprasmlist,p^.left^.location.reference); emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
end; end;
emitcall('INITIALIZE',true); emitcall('FPC_INITIALIZE',true);
end; end;
end; end;
end; end;
@ -643,7 +643,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.9 1998-09-03 16:03:15 florian Revision 1.10 1998-09-14 10:43:52 peter
* all internal RTL functions start with FPC_
Revision 1.9 1998/09/03 16:03:15 florian
+ rtti generation + rtti generation
* init table generation changed * init table generation changed

7
compiler/cg386set.pas
View File

@ -413,7 +413,7 @@ implementation
del_reference(p^.right^.location.reference); del_reference(p^.right^.location.reference);
{ registers need not be save. that happens in SET_IN_BYTE } { registers need not be save. that happens in SET_IN_BYTE }
{ (EDI is changed) } { (EDI is changed) }
emitcall('SET_IN_BYTE',true); emitcall('FPC_SET_IN_BYTE',true);
{ ungetiftemp(p^.right^.location.reference); } { ungetiftemp(p^.right^.location.reference); }
p^.location.loc:=LOC_FLAGS; p^.location.loc:=LOC_FLAGS;
p^.location.resflags:=F_C; p^.location.resflags:=F_C;
@ -783,7 +783,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.15 1998-09-09 17:51:59 florian Revision 1.16 1998-09-14 10:43:53 peter
* all internal RTL functions start with FPC_
Revision 1.15 1998/09/09 17:51:59 florian
* the next try to fix the case problem ... * the next try to fix the case problem ...
Revision 1.14 1998/09/09 16:44:21 florian Revision 1.14 1998/09/09 16:44:21 florian

51
compiler/cg68kadd.pas
View File

@ -239,7 +239,7 @@ implementation
secondpass(p^.right); secondpass(p^.right);
del_reference(p^.right^.location.reference); del_reference(p^.right^.location.reference);
emitpushreferenceaddr(exprasmlist,p^.right^.location.reference); emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
emitcall('ANSISTRCMP',true); emitcall('FPC_ANSISTRCMP',true);
maybe_loada5; maybe_loada5;
popusedregisters(pushedregs); popusedregisters(pushedregs);
end; end;
@ -278,7 +278,7 @@ implementation
{ Because parameters are inversed in the rtl } { Because parameters are inversed in the rtl }
emitpushreferenceaddr(p^.right^.location.reference); emitpushreferenceaddr(p^.right^.location.reference);
emitpushreferenceaddr(p^.left^.location.reference); emitpushreferenceaddr(p^.left^.location.reference);
emitcall('STRCONCAT',true); emitcall('FPC_STRCONCAT',true);
maybe_loadA5; maybe_loadA5;
popusedregisters(pushedregs); popusedregisters(pushedregs);
set_location(p^.location,p^.left^.location); set_location(p^.location,p^.left^.location);
@ -334,7 +334,7 @@ implementation
{ {
emitpushreferenceaddr(p^.left^.location.reference); emitpushreferenceaddr(p^.left^.location.reference);
emitpushreferenceaddr(p^.right^.location.reference); } emitpushreferenceaddr(p^.right^.location.reference); }
emitcall('STRCMP',true); emitcall('FPC_STRCMP',true);
maybe_loada5; maybe_loada5;
popusedregisters(pushedregs); popusedregisters(pushedregs);
end; end;
@ -386,7 +386,7 @@ implementation
pushusedregisters(pushedregs,$ff); pushusedregisters(pushedregs,$ff);
emitpushreferenceaddr(p^.right^.location.reference); emitpushreferenceaddr(p^.right^.location.reference);
emitpushreferenceaddr(p^.left^.location.reference); emitpushreferenceaddr(p^.left^.location.reference);
emitcall('SET_COMP_SETS',true); emitcall('FPC_SET_COMP_SETS',true);
maybe_loada5; maybe_loada5;
popusedregisters(pushedregs); popusedregisters(pushedregs);
ungetiftemp(p^.left^.location.reference); ungetiftemp(p^.left^.location.reference);
@ -408,13 +408,13 @@ implementation
loadsetelement(p^.right^.right); loadsetelement(p^.right^.right);
loadsetelement(p^.right^.left); loadsetelement(p^.right^.left);
emitpushreferenceaddr(href); emitpushreferenceaddr(href);
emitcall('SET_SET_RANGE',true); emitcall('FPC_SET_SET_RANGE',true);
end end
else else
begin begin
loadsetelement(p^.right^.left); loadsetelement(p^.right^.left);
emitpushreferenceaddr(href); emitpushreferenceaddr(href);
emitcall('SET_SET_BYTE',true); emitcall('FPC_SET_SET_BYTE',true);
end; end;
end end
else else
@ -423,7 +423,7 @@ implementation
emitpushreferenceaddr(href); emitpushreferenceaddr(href);
emitpushreferenceaddr(p^.right^.location.reference); emitpushreferenceaddr(p^.right^.location.reference);
emitpushreferenceaddr(p^.left^.location.reference); emitpushreferenceaddr(p^.left^.location.reference);
emitcall('SET_ADD_SETS',true); emitcall('FPC_SET_ADD_SETS',true);
end; end;
maybe_loada5; maybe_loada5;
popusedregisters(pushedregs); popusedregisters(pushedregs);
@ -445,9 +445,9 @@ implementation
emitpushreferenceaddr(p^.right^.location.reference); emitpushreferenceaddr(p^.right^.location.reference);
emitpushreferenceaddr(p^.left^.location.reference); emitpushreferenceaddr(p^.left^.location.reference);
case p^.treetype of case p^.treetype of
subn : emitcall('SET_SUB_SETS',true); subn : emitcall('FPC_SET_SUB_SETS',true);
symdifn : emitcall('SET_SYMDIF_SETS',true); symdifn : emitcall('FPC_SET_SYMDIF_SETS',true);
muln : emitcall('SET_MUL_SETS',true); muln : emitcall('FPC_SET_MUL_SETS',true);
end; end;
maybe_loada5; maybe_loada5;
popusedregisters(pushedregs); popusedregisters(pushedregs);
@ -858,7 +858,7 @@ implementation
emit_reg_reg(A_MOVE,opsize,p^.right^.location.register, emit_reg_reg(A_MOVE,opsize,p^.right^.location.register,
R_D0); R_D0);
emit_reg_reg(A_MOVE,opsize,p^.location.register,R_D1); emit_reg_reg(A_MOVE,opsize,p^.location.register,R_D1);
emitcall('LONGMUL',true); emitcall('FPC_LONGMUL',true);
emit_reg_reg(A_MOVE,opsize,R_D0,p^.location.register); emit_reg_reg(A_MOVE,opsize,R_D0,p^.location.register);
end end
else else
@ -887,7 +887,7 @@ implementation
exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE, opsize, exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE, opsize,
newreference(p^.right^.location.reference),R_D1))); newreference(p^.right^.location.reference),R_D1)));
emit_reg_reg(A_MOVE,opsize,p^.location.register,R_D0); emit_reg_reg(A_MOVE,opsize,p^.location.register,R_D0);
emitcall('LONGMUL',true); emitcall('FPC_LONGMUL',true);
emit_reg_reg(A_MOVE,opsize,R_D0,p^.location.register); emit_reg_reg(A_MOVE,opsize,R_D0,p^.location.register);
end end
else else
@ -941,7 +941,7 @@ implementation
emit_reg_reg(A_MOVE,opsize,p^.right^.location.register, emit_reg_reg(A_MOVE,opsize,p^.right^.location.register,
R_D0); R_D0);
emit_reg_reg(A_MOVE,opsize,p^.location.register,R_D1); emit_reg_reg(A_MOVE,opsize,p^.location.register,R_D1);
emitcall('LONGMUL',true); emitcall('FPC_LONGMUL',true);
emit_reg_reg(A_MOVE,opsize,R_D0,p^.location.register); emit_reg_reg(A_MOVE,opsize,R_D0,p^.location.register);
end end
else else
@ -1112,11 +1112,11 @@ implementation
{ probably a faster way to do this but... } { probably a faster way to do this but... }
case op of case op of
A_FADD: emitcall('SINGLE_ADD',true); A_FADD: emitcall('FPC_SINGLE_ADD',true);
A_FMUL: emitcall('SINGLE_MUL',true); A_FMUL: emitcall('FPC_SINGLE_MUL',true);
A_FSUB: emitcall('SINGLE_SUB',true); A_FSUB: emitcall('FPC_SINGLE_SUB',true);
A_FDIV: emitcall('SINGLE_DIV',true); A_FDIV: emitcall('FPC_SINGLE_DIV',true);
A_FCMP: emitcall('SINGLE_CMP',true); A_FCMP: emitcall('FPC_SINGLE_CMP',true);
end; end;
if not cmpop then { only flags are affected with cmpop } if not cmpop then { only flags are affected with cmpop }
exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D0, exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D0,
@ -1177,11 +1177,11 @@ implementation
emit_reg_reg(A_MOVE,S_L,p^.left^.location.fpureg,R_D1); emit_reg_reg(A_MOVE,S_L,p^.left^.location.fpureg,R_D1);
{ probably a faster way to do this but... } { probably a faster way to do this but... }
case op of case op of
A_FADD: emitcall('SINGLE_ADD',true); A_FADD: emitcall('FPC_SINGLE_ADD',true);
A_FMUL: emitcall('SINGLE_MUL',true); A_FMUL: emitcall('FPC_SINGLE_MUL',true);
A_FSUB: emitcall('SINGLE_SUB',true); A_FSUB: emitcall('FPC_SINGLE_SUB',true);
A_FDIV: emitcall('SINGLE_DIV',true); A_FDIV: emitcall('FPC_SINGLE_DIV',true);
A_FCMP: emitcall('SINGLE_CMP',true); A_FCMP: emitcall('FPC_SINGLE_CMP',true);
end; end;
if not cmpop then { only flags are affected with cmpop } if not cmpop then { only flags are affected with cmpop }
exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D0, exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D0,
@ -1263,7 +1263,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.3 1998-09-07 18:45:55 peter Revision 1.4 1998-09-14 10:43:54 peter
* all internal RTL functions start with FPC_
Revision 1.3 1998/09/07 18:45:55 peter
* update smartlinking, uses getdatalabel * update smartlinking, uses getdatalabel
* renamed ptree.value vars to value_str,value_real,value_set * renamed ptree.value vars to value_str,value_real,value_set

11
compiler/cg68kcal.pas
View File

@ -814,7 +814,7 @@ implementation
{ If the base is already A0, the no instruction will } { If the base is already A0, the no instruction will }
{ be emitted! } { be emitted! }
emit_reg_reg(A_MOVE,S_L,r^.base,R_A0); emit_reg_reg(A_MOVE,S_L,r^.base,R_A0);
emitcall('CHECK_OBJECT',true); emitcall('FPC_CHECK_OBJECT',true);
end; end;
{ This was wrong we must then load the address into the } { This was wrong we must then load the address into the }
{ register a0 and/or a5 } { register a0 and/or a5 }
@ -1008,9 +1008,7 @@ implementation
if iolabel<>nil then if iolabel<>nil then
begin begin
exprasmlist^.concat(new(pai68k,op_csymbol(A_PEA,S_L,newcsymbol(lab2str(iolabel),0)))); exprasmlist^.concat(new(pai68k,op_csymbol(A_PEA,S_L,newcsymbol(lab2str(iolabel),0))));
{ this was wrong, probably an error due to diff3 emitcall('FPC_IOCHECK',true);
emitcall(p^.procdefinition^.mangledname);}
emitcall('IOCHECK',true);
end; end;
{ restore registers } { restore registers }
@ -1046,7 +1044,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.3 1998-09-04 08:41:43 peter Revision 1.4 1998-09-14 10:43:55 peter
* all internal RTL functions start with FPC_
Revision 1.3 1998/09/04 08:41:43 peter
* updated some error messages * updated some error messages
Revision 1.2 1998/09/01 12:47:59 peter Revision 1.2 1998/09/01 12:47:59 peter

17
compiler/cg68kcnv.pas
View File

@ -736,7 +736,7 @@ implementation
begin begin
p^.location.fpureg := getregister32; p^.location.fpureg := getregister32;
exprasmlist^.concat(new(pai68k, op_ref_reg(A_MOVE, S_L, r, R_D0))); exprasmlist^.concat(new(pai68k, op_ref_reg(A_MOVE, S_L, r, R_D0)));
emitcall('LONG2SINGLE',true); emitcall('FPC_LONG2SINGLE',true);
emit_reg_reg(A_MOVE,S_L,R_D0,p^.location.fpureg); emit_reg_reg(A_MOVE,S_L,R_D0,p^.location.fpureg);
end end
else else
@ -765,7 +765,7 @@ implementation
begin begin
exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.left^.location.reference),R_D0))); exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.left^.location.reference),R_D0)));
exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,65536,R_D1))); exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,65536,R_D1)));
emitcall('LONGMUL',true); emitcall('FPC_LONGMUL',true);
emit_reg_reg(A_MOVE,S_L,R_D0,rreg); emit_reg_reg(A_MOVE,S_L,R_D0,rreg);
end end
else else
@ -781,7 +781,7 @@ implementation
begin begin
exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,p^.left^.location.fpureg,R_D0))); exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,p^.left^.location.fpureg,R_D0)));
exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,65536,R_D1))); exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,65536,R_D1)));
emitcall('LONGMUL',true); emitcall('FPC_LONGMUL',true);
emit_reg_reg(A_MOVE,S_L,R_D0,rreg); emit_reg_reg(A_MOVE,S_L,R_D0,rreg);
end end
else else
@ -1179,7 +1179,7 @@ implementation
gettempofsizereference(32,href); gettempofsizereference(32,href);
emitpushreferenceaddr(p^.left^.location.reference); emitpushreferenceaddr(p^.left^.location.reference);
emitpushreferenceaddr(href); emitpushreferenceaddr(href);
emitcall('SET_LOAD_SMALL',true); emitcall('FPC_SET_LOAD_SMALL',true);
maybe_loada5; maybe_loada5;
popusedregisters(pushedregs); popusedregisters(pushedregs);
p^.location.loc:=LOC_MEM; p^.location.loc:=LOC_MEM;
@ -1344,7 +1344,7 @@ implementation
end; end;
else internalerror(100); else internalerror(100);
end; end;
emitcall('DO_IS',true); emitcall('FPC_DO_IS',true);
exprasmlist^.concat(new(pai68k,op_reg(A_TST,S_B,R_D0))); exprasmlist^.concat(new(pai68k,op_reg(A_TST,S_B,R_D0)));
popusedregisters(pushed); popusedregisters(pushed);
end; end;
@ -1368,7 +1368,7 @@ implementation
S_L,newcsymbol(pobjectdef(p^.right^.resulttype)^.vmt_mangledname,0),R_SPPUSH))); S_L,newcsymbol(pobjectdef(p^.right^.resulttype)^.vmt_mangledname,0),R_SPPUSH)));
concat_external(pobjectdef(p^.right^.resulttype)^.vmt_mangledname,EXT_NEAR); concat_external(pobjectdef(p^.right^.resulttype)^.vmt_mangledname,EXT_NEAR);
emitpushreferenceaddr(p^.location.reference); emitpushreferenceaddr(p^.location.reference);
emitcall('DO_AS',true); emitcall('FPC_DO_AS',true);
popusedregisters(pushed); popusedregisters(pushed);
end; end;
@ -1376,7 +1376,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.3 1998-09-11 12:29:43 pierre Revision 1.4 1998-09-14 10:43:56 peter
* all internal RTL functions start with FPC_
Revision 1.3 1998/09/11 12:29:43 pierre
* removed explicit range_checking as it is buggy * removed explicit range_checking as it is buggy
Revision 1.2.2.1 1998/09/11 12:08:57 pierre Revision 1.2.2.1 1998/09/11 12:08:57 pierre

12
compiler/cg68kflw.pas
View File

@ -756,13 +756,6 @@ do_jmp:
var var
hp : preference; hp : preference;
begin begin
{if procinfo.exceptions then
aktproccode.concat(gennasmrec(CALL,S_NO,'HELP_DESTRUCTOR_E'))
else }
{ we should know if the constructor is called with a new or not,
how can we do that ???
exprasmlist^.concat(new(pai68k,op_csymbol(A_CALL,S_NO,newcsymbol('HELP_DESTRUCTOR',0))));
}
exprasmlist^.concat(new(pai68k,op_reg(A_CLR,S_L,R_A5))); exprasmlist^.concat(new(pai68k,op_reg(A_CLR,S_L,R_A5)));
{ also reset to zero in the stack } { also reset to zero in the stack }
new(hp); new(hp);
@ -776,7 +769,10 @@ do_jmp:
end. end.
{ {
$Log$ $Log$
Revision 1.3 1998-09-04 08:41:47 peter Revision 1.4 1998-09-14 10:43:58 peter
* all internal RTL functions start with FPC_
Revision 1.3 1998/09/04 08:41:47 peter
* updated some error messages * updated some error messages
Revision 1.2 1998/09/01 12:48:01 peter Revision 1.2 1998/09/01 12:48:01 peter

80
compiler/cg68kinl.pas
View File

@ -224,9 +224,9 @@ implementation
{ allways read only one record by element } { allways read only one record by element }
push_int(typedtyp^.size); push_int(typedtyp^.size);
if doread then if doread then
emitcall('TYPED_READ',true) emitcall('FPC_TYPED_READ',true)
else else
emitcall('TYPED_WRITE',true); emitcall('FPC_TYPED_WRITE',true);
end end
else else
begin begin
@ -280,34 +280,34 @@ implementation
push_int(pstringdef(pararesult)^.len); push_int(pstringdef(pararesult)^.len);
case pstringdef(pararesult)^.string_typ of case pstringdef(pararesult)^.string_typ of
st_shortstring: st_shortstring:
emitcall ('READ_TEXT_STRING',true); emitcall ('FPC_READ_TEXT_STRING',true);
st_ansistring: st_ansistring:
emitcall ('READ_TEXT_ANSISTRING',true); emitcall ('FPC_READ_TEXT_ANSISTRING',true);
st_longstring: st_longstring:
emitcall ('READ_TEXT_LONGSTRING',true); emitcall ('FPC_READ_TEXT_LONGSTRING',true);
st_widestring: st_widestring:
emitcall ('READ_TEXT_ANSISTRING',true); emitcall ('FPC_READ_TEXT_ANSISTRING',true);
end end
end end
else else
Case pstringdef(Pararesult)^.string_typ of Case pstringdef(Pararesult)^.string_typ of
st_shortstring: st_shortstring:
emitcall ('WRITE_TEXT_STRING',true); emitcall ('FPC_WRITE_TEXT_STRING',true);
st_ansistring: st_ansistring:
emitcall ('WRITE_TEXT_ANSISTRING',true); emitcall ('FPC_WRITE_TEXT_ANSISTRING',true);
st_longstring: st_longstring:
emitcall ('WRITE_TEXT_LONGSTRING',true); emitcall ('FPC_WRITE_TEXT_LONGSTRING',true);
st_widestring: st_widestring:
emitcall ('WRITE_TEXT_ANSISTRING',true); emitcall ('FPC_WRITE_TEXT_ANSISTRING',true);
end; end;
end; end;
pointerdef : begin pointerdef : begin
if is_equal(ppointerdef(pararesult)^.definition,cchardef) then if is_equal(ppointerdef(pararesult)^.definition,cchardef) then
begin begin
if doread then if doread then
emitcall('READ_TEXT_PCHAR_AS_POINTER',true) emitcall('FPC_READ_TEXT_PCHAR_AS_POINTER',true)
else else
emitcall('WRITE_TEXT_PCHAR_AS_POINTER',true); emitcall('FPC_WRITE_TEXT_PCHAR_AS_POINTER',true);
end; end;
end; end;
arraydef : begin arraydef : begin
@ -315,46 +315,45 @@ implementation
is_equal(parraydef(pararesult)^.definition,cchardef) then is_equal(parraydef(pararesult)^.definition,cchardef) then
begin begin
if doread then if doread then
emitcall('READ_TEXT_PCHAR_AS_ARRAY',true) emitcall('FPC_READ_TEXT_PCHAR_AS_ARRAY',true)
else else
emitcall('WRITE_TEXT_PCHAR_AS_ARRAY',true); emitcall('FPC_WRITE_TEXT_PCHAR_AS_ARRAY',true);
end; end;
end; end;
floatdef : begin floatdef : begin
if doread then if doread then
emitcall('READ_TEXT_'+float_name[pfloatdef(pararesult)^.typ],true) emitcall('FPC_READ_TEXT_'+float_name[pfloatdef(pararesult)^.typ],true)
else else
emitcall('WRITE_TEXT_'+float_name[pfloatdef(pararesult)^.typ],true); emitcall('FPC_WRITE_TEXT_'+float_name[pfloatdef(pararesult)^.typ],true);
end; end;
orddef : begin orddef : begin
case porddef(pararesult)^.typ of case porddef(pararesult)^.typ of
u8bit : if doread then u8bit : if doread then
emitcall('READ_TEXT_BYTE',true); emitcall('FPC_READ_TEXT_BYTE',true);
s8bit : if doread then s8bit : if doread then
emitcall('READ_TEXT_SHORTINT',true); emitcall('FPC_READ_TEXT_SHORTINT',true);
u16bit : if doread then u16bit : if doread then
emitcall('READ_TEXT_WORD',true); emitcall('FPC_READ_TEXT_WORD',true);
s16bit : if doread then s16bit : if doread then
emitcall('READ_TEXT_INTEGER',true); emitcall('FPC_READ_TEXT_INTEGER',true);
s32bit : if doread then s32bit : if doread then
emitcall('READ_TEXT_LONGINT',true) emitcall('FPC_READ_TEXT_LONGINT',true)
else else
emitcall('WRITE_TEXT_LONGINT',true); emitcall('FPC_WRITE_TEXT_LONGINT',true);
u32bit : if doread then u32bit : if doread then
emitcall('READ_TEXT_CARDINAL',true) emitcall('FPC_READ_TEXT_CARDINAL',true)
else else
emitcall('WRITE_TEXT_CARDINAL',true); emitcall('FPC_WRITE_TEXT_CARDINAL',true);
uchar : if doread then uchar : if doread then
emitcall('READ_TEXT_CHAR',true) emitcall('FPC_READ_TEXT_CHAR',true)
else else
emitcall('WRITE_TEXT_CHAR',true); emitcall('FPC_WRITE_TEXT_CHAR',true);
bool8bit, bool8bit,
bool16bit, bool16bit,
bool32bit : if doread then bool32bit : if doread then
{ emitcall('READ_TEXT_BOOLEAN',true) }
Message(parser_e_illegal_parameter_list) Message(parser_e_illegal_parameter_list)
else else
emitcall('WRITE_TEXT_BOOLEAN',true); emitcall('FPC_WRITE_TEXT_BOOLEAN',true);
end; end;
end; end;
end; end;
@ -372,16 +371,16 @@ implementation
if doread then if doread then
begin begin
if doln then if doln then
emitcall('READLN_END',true) emitcall('FPC_READLN_END',true)
else else
emitcall('READ_END',true); emitcall('FPC_READ_END',true);
end end
else else
begin begin
if doln then if doln then
emitcall('WRITELN_END',true) emitcall('FPC_WRITELN_END',true)
else else
emitcall('WRITE_END',true); emitcall('FPC_WRITE_END',true);
end; end;
popusedregisters(pushed); popusedregisters(pushed);
maybe_loada5; maybe_loada5;
@ -391,7 +390,7 @@ implementation
begin begin
{ registers are saved in the procedure } { registers are saved in the procedure }
exprasmlist^.concat(new(pai68k,op_csymbol(A_PEA,S_L,newcsymbol(lab2str(iolabel),0)))); exprasmlist^.concat(new(pai68k,op_csymbol(A_PEA,S_L,newcsymbol(lab2str(iolabel),0))));
emitcall('IOCHECK',true); emitcall('FPC_IOCHECK',true);
end; end;
{ Freeup all used temps } { Freeup all used temps }
ungetiftemp(aktfile); ungetiftemp(aktfile);
@ -489,11 +488,11 @@ implementation
exit; exit;
if is_real then if is_real then
emitcall('STR_'+float_name[pfloatdef(hp^.resulttype)^.typ],true) emitcall('FPC_STR_'+float_name[pfloatdef(hp^.resulttype)^.typ],true)
else if porddef(hp^.resulttype)^.typ=u32bit then else if porddef(hp^.resulttype)^.typ=u32bit then
emitcall('STR_CARDINAL',true) emitcall('FPC_STR_CARDINAL',true)
else else
emitcall('STR_LONGINT',true); emitcall('FPC_STR_LONGINT',true);
popusedregisters(pushed); popusedregisters(pushed);
end; end;
@ -812,9 +811,9 @@ implementation
secondload(p^.left); secondload(p^.left);
emitpushreferenceaddr(p^.left^.location.reference); emitpushreferenceaddr(p^.left^.location.reference);
if p^.inlinenumber=in_reset_typedfile then if p^.inlinenumber=in_reset_typedfile then
emitcall('RESET_TYPED',true) emitcall('FPC_RESET_TYPED',true)
else else
emitcall('REWRITE_TYPED',true); emitcall('FPC_REWRITE_TYPED',true);
popusedregisters(pushed); popusedregisters(pushed);
end; end;
in_write_x : in_write_x :
@ -904,7 +903,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.2 1998-09-04 08:41:48 peter Revision 1.3 1998-09-14 10:43:59 peter
* all internal RTL functions start with FPC_
Revision 1.2 1998/09/04 08:41:48 peter
* updated some error messages * updated some error messages
Revision 1.1 1998/09/01 09:07:09 peter Revision 1.1 1998/09/01 09:07:09 peter

11
compiler/cg68kmat.pas
View File

@ -136,7 +136,7 @@ implementation
{ if not zero then simply continue on } { if not zero then simply continue on }
emitl(A_BNE,hl1); emitl(A_BNE,hl1);
exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,200,R_D0))); exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,200,R_D0)));
emitcall('HALT_ERROR',true); emitcall('FPC_HALT_ERROR',true);
emitl(A_LABEL,hl1); emitl(A_LABEL,hl1);
if (p^.treetype = modn) then if (p^.treetype = modn) then
Begin Begin
@ -174,9 +174,9 @@ implementation
{ routines... d0/d1 } { routines... d0/d1 }
{ return result in d0 } { return result in d0 }
if p^.treetype = divn then if p^.treetype = divn then
emitcall('LONGDIV',true) emitcall('FPC_LONGDIV',true)
else else
emitcall('LONGMOD',true); emitcall('FPC_LONGMOD',true);
emit_reg_reg(A_MOVE,S_L,R_D0,hreg1); emit_reg_reg(A_MOVE,S_L,R_D0,hreg1);
end; { endif } end; { endif }
end; end;
@ -446,7 +446,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.1 1998-09-01 09:07:09 peter Revision 1.2 1998-09-14 10:44:01 peter
* all internal RTL functions start with FPC_
Revision 1.1 1998/09/01 09:07:09 peter
* m68k fixes, splitted cg68k like cgi386 * m68k fixes, splitted cg68k like cgi386
} }

15
compiler/cg68kmem.pas
View File

@ -161,13 +161,13 @@ implementation
LOC_REFERENCE: LOC_REFERENCE:
emitpushreferenceaddr(exprasmlist,p^.left^.location.reference); emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
end; end;
emitcall('FINALIZE',true); *) emitcall('FPC_FINALIZE',true); *)
end; end;
emitcall('FREEMEM',true); emitcall('FPC_FREEMEM',true);
end; end;
simplenewn: simplenewn:
begin begin
emitcall('GETMEM',true); emitcall('FPC_GETMEM',true);
if ppointerdef(p^.left^.resulttype)^.definition^.needs_inittable then if ppointerdef(p^.left^.resulttype)^.definition^.needs_inittable then
begin begin
{!!!!!!!} {!!!!!!!}
@ -183,7 +183,7 @@ implementation
LOC_REFERENCE: LOC_REFERENCE:
emitpushreferenceaddr(exprasmlist,p^.left^.location.reference); emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
end; end;
emitcall('INITIALIZE',true); *) emitcall('FPC_INITIALIZE',true); *)
end; end;
end; end;
end; end;
@ -392,7 +392,7 @@ implementation
begin begin
exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,l1,R_D0))); exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,l1,R_D0)));
exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,ind,R_D1))); exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,ind,R_D1)));
emitcall('LONGMUL',true); emitcall('FPC_LONGMUL',true);
exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D0,ind))); exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D0,ind)));
end; end;
end; end;
@ -691,7 +691,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.3 1998-09-11 12:29:44 pierre Revision 1.4 1998-09-14 10:44:02 peter
* all internal RTL functions start with FPC_
Revision 1.3 1998/09/11 12:29:44 pierre
* removed explicit range_checking as it is buggy * removed explicit range_checking as it is buggy
Revision 1.2.2.1 1998/09/11 12:08:59 pierre Revision 1.2.2.1 1998/09/11 12:08:59 pierre

7
compiler/cg68kset.pas
View File

@ -473,7 +473,7 @@ implementation
newreference(p^.right^.location.reference),R_A0)));; newreference(p^.right^.location.reference),R_A0)));;
{ emitpushreferenceaddr(p^.right^.location.reference);} { emitpushreferenceaddr(p^.right^.location.reference);}
del_reference(p^.right^.location.reference); del_reference(p^.right^.location.reference);
emitcall('SET_IN_BYTE',true); emitcall('FPC_SET_IN_BYTE',true);
{ ungetiftemp(p^.right^.location.reference); } { ungetiftemp(p^.right^.location.reference); }
p^.location.loc:=LOC_FLAGS; p^.location.loc:=LOC_FLAGS;
p^.location.resflags:=F_C; p^.location.resflags:=F_C;
@ -812,7 +812,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.3 1998-09-07 18:45:59 peter Revision 1.4 1998-09-14 10:44:03 peter
* all internal RTL functions start with FPC_
Revision 1.3 1998/09/07 18:45:59 peter
* update smartlinking, uses getdatalabel * update smartlinking, uses getdatalabel
* renamed ptree.value vars to value_str,value_real,value_set * renamed ptree.value vars to value_str,value_real,value_set

47
compiler/cga68k.pas
View File

@ -123,7 +123,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,newreference(dref),R_A1))); exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,newreference(dref),R_A1)));
exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,newreference(sref),R_A0))); exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,newreference(sref),R_A0)));
exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,len,R_D0))); exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,len,R_D0)));
emitcall('STRCOPY',true); emitcall('FPC_STRCOPY',true);
maybe_loada5; maybe_loada5;
popusedregisters(pushed); popusedregisters(pushed);
end; end;
@ -266,14 +266,14 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
getlabel(hl); getlabel(hl);
emitl(A_BCC, hl); emitl(A_BCC, hl);
exprasmlist^.concat(new(pai68k, op_const_reg(A_MOVE,S_L,201,R_D0))); exprasmlist^.concat(new(pai68k, op_const_reg(A_MOVE,S_L,201,R_D0)));
emitcall('HALT_ERROR',true); emitcall('FPC_HALT_ERROR',true);
emitl(A_LABEL, hl); emitl(A_LABEL, hl);
end end
else else
begin begin
exprasmlist^.concat(new(pai68k, op_ref_reg(A_LEA,S_L,newreference(hp), R_A1))); exprasmlist^.concat(new(pai68k, op_ref_reg(A_LEA,S_L,newreference(hp), R_A1)));
exprasmlist^.concat(new(pai68k, op_reg_reg(A_MOVE, S_L, index, R_D0))); exprasmlist^.concat(new(pai68k, op_reg_reg(A_MOVE, S_L, index, R_D0)));
emitcall('RE_BOUNDS_CHECK',true); emitcall('FPC_RE_BOUNDS_CHECK',true);
end; end;
end; end;
@ -395,7 +395,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
emitl(A_BVC,hl) emitl(A_BVC,hl)
else else
emitl(A_BCC,hl); emitl(A_BCC,hl);
emitcall('RE_OVERFLOW',true); emitcall('FPC_OVERFLOW',true);
emitl(A_LABEL,hl); emitl(A_LABEL,hl);
end; end;
end; end;
@ -539,7 +539,7 @@ begin
(target_info.target=target_linux) then (target_info.target=target_linux) then
begin begin
procinfo.aktentrycode^.insert(new(pai68k, procinfo.aktentrycode^.insert(new(pai68k,
op_csymbol(A_JSR,S_NO,newcsymbol('INIT_STACK_CHECK',0)))); op_csymbol(A_JSR,S_NO,newcsymbol('FPC_INIT_STACK_CHECK',0))));
end end
else else
{ The main program has already allocated its stack - so we simply compare } { The main program has already allocated its stack - so we simply compare }
@ -547,10 +547,10 @@ begin
if (cs_check_stack in aktlocalswitches) then if (cs_check_stack in aktlocalswitches) then
begin begin
procinfo.aktentrycode^.insert(new(pai68k,op_csymbol(A_JSR,S_NO, procinfo.aktentrycode^.insert(new(pai68k,op_csymbol(A_JSR,S_NO,
newcsymbol('STACKCHECK',0)))); newcsymbol('FPC_STACKCHECK',0))));
procinfo.aktentrycode^.insert(new(pai68k,op_const_reg(A_MOVE,S_L, procinfo.aktentrycode^.insert(new(pai68k,op_const_reg(A_MOVE,S_L,
0,R_D0))); 0,R_D0)));
concat_external('STACKCHECK',EXT_NEAR); concat_external('FPC_STACKCHECK',EXT_NEAR);
end; end;
@ -579,15 +579,15 @@ begin
begin begin
procinfo.aktentrycode^.insert(new(pai_labeled,init(A_BEQ,quickexitlabel))); procinfo.aktentrycode^.insert(new(pai_labeled,init(A_BEQ,quickexitlabel)));
procinfo.aktentrycode^.insert(new(pai68k,op_csymbol(A_JSR,S_NO, procinfo.aktentrycode^.insert(new(pai68k,op_csymbol(A_JSR,S_NO,
newcsymbol('NEW_CLASS',0)))); newcsymbol('FPC_NEW_CLASS',0))));
concat_external('NEW_CLASS',EXT_NEAR); concat_external('FPC_NEW_CLASS',EXT_NEAR);
end end
else else
begin begin
procinfo.aktentrycode^.insert(new(pai_labeled,init(A_BEQ,quickexitlabel))); procinfo.aktentrycode^.insert(new(pai_labeled,init(A_BEQ,quickexitlabel)));
procinfo.aktentrycode^.insert(new(pai68k,op_csymbol(A_JSR,S_NO, procinfo.aktentrycode^.insert(new(pai68k,op_csymbol(A_JSR,S_NO,
newcsymbol('HELP_CONSTRUCTOR',0)))); newcsymbol('FPC_HELP_CONSTRUCTOR',0))));
concat_external('HELP_CONSTRUCTOR',EXT_NEAR); concat_external('FPC_HELP_CONSTRUCTOR',EXT_NEAR);
end; end;
end; end;
{ don't load ESI, does the caller } { don't load ESI, does the caller }
@ -620,9 +620,9 @@ begin
if (aktprocsym^.definition^.options and poproginit=0) then if (aktprocsym^.definition^.options and poproginit=0) then
Begin Begin
procinfo.aktentrycode^.insert(new(pai68k, procinfo.aktentrycode^.insert(new(pai68k,
op_csymbol(A_JSR,S_NO,newcsymbol('STACKCHECK',0)))); op_csymbol(A_JSR,S_NO,newcsymbol('FPC_STACKCHECK',0))));
procinfo.aktentrycode^.insert(new(pai68k,op_const_reg(A_MOVE,S_L,stackframe,R_D0))); procinfo.aktentrycode^.insert(new(pai68k,op_const_reg(A_MOVE,S_L,stackframe,R_D0)));
concat_external('STACKCHECK',EXT_NEAR); concat_external('FPC_STACKCHECK',EXT_NEAR);
end; end;
end; end;
{ to allocate stack space } { to allocate stack space }
@ -646,10 +646,10 @@ begin
and (aktprocsym^.definition^.options and poproginit=0) then and (aktprocsym^.definition^.options and poproginit=0) then
begin begin
procinfo.aktentrycode^.insert(new(pai68k, procinfo.aktentrycode^.insert(new(pai68k,
op_csymbol(A_JSR,S_NO,newcsymbol('STACKCHECK',0)))); op_csymbol(A_JSR,S_NO,newcsymbol('FPC_STACKCHECK',0))));
procinfo.aktentrycode^.insert(new(pai68k,op_const_reg(A_MOVE,S_L, procinfo.aktentrycode^.insert(new(pai68k,op_const_reg(A_MOVE,S_L,
stackframe,R_D0))); stackframe,R_D0)));
concat_external('STACKCHECK',EXT_NEAR); concat_external('FPC_STACKCHECK',EXT_NEAR);
end; end;
procinfo.aktentrycode^.insert(new(pai68k,op_reg_reg(A_MOVE,S_L,R_SP,R_A6))); procinfo.aktentrycode^.insert(new(pai68k,op_reg_reg(A_MOVE,S_L,R_SP,R_A6)));
procinfo.aktentrycode^.insert(new(pai68k,op_reg_reg(A_MOVE,S_L,R_A6,R_SPPUSH))); procinfo.aktentrycode^.insert(new(pai68k,op_reg_reg(A_MOVE,S_L,R_A6,R_SPPUSH)));
@ -735,14 +735,14 @@ begin
if procinfo._class^.isclass then if procinfo._class^.isclass then
begin begin
procinfo.aktexitcode^.insert(new(pai68k,op_csymbol(A_JSR,S_NO, procinfo.aktexitcode^.insert(new(pai68k,op_csymbol(A_JSR,S_NO,
newcsymbol('DISPOSE_CLASS',0)))); newcsymbol('FPC_DISPOSE_CLASS',0))));
concat_external('DISPOSE_CLASS',EXT_NEAR); concat_external('FPC_DISPOSE_CLASS',EXT_NEAR);
end end
else else
begin begin
procinfo.aktexitcode^.insert(new(pai68k,op_csymbol(A_JSR,S_NO, procinfo.aktexitcode^.insert(new(pai68k,op_csymbol(A_JSR,S_NO,
newcsymbol('HELP_DESTRUCTOR',0)))); newcsymbol('FPC_HELP_DESTRUCTOR',0))));
concat_external('HELP_DESTRUCTOR',EXT_NEAR); concat_external('FPC_HELP_DESTRUCTOR',EXT_NEAR);
end; end;
end; end;
@ -751,8 +751,8 @@ begin
if ((aktprocsym^.definition^.options and poproginit)<>0) and if ((aktprocsym^.definition^.options and poproginit)<>0) and
(target_info.target<>target_PalmOS) then (target_info.target<>target_PalmOS) then
begin begin
procinfo.aktexitcode^.concat(new(pai68k,op_csymbol(A_JSR,S_NO,newcsymbol('__EXIT',0)))); procinfo.aktexitcode^.concat(new(pai68k,op_csymbol(A_JSR,S_NO,newcsymbol('FPC_DO_EXIT',0))));
externals^.concat(new(pai_external,init('__EXIT',EXT_NEAR))); externals^.concat(new(pai_external,init('FPC_DO_EXIT',EXT_NEAR)));
end; end;
{ handle return value } { handle return value }
@ -1345,7 +1345,10 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.15 1998-09-07 18:46:00 peter Revision 1.16 1998-09-14 10:44:04 peter
* all internal RTL functions start with FPC_
Revision 1.15 1998/09/07 18:46:00 peter
* update smartlinking, uses getdatalabel * update smartlinking, uses getdatalabel
* renamed ptree.value vars to value_str,value_real,value_set * renamed ptree.value vars to value_str,value_real,value_set

13
compiler/innr.inc
View File

@ -23,14 +23,6 @@ const
in_ord_x = 5; in_ord_x = 5;
in_length_string = 6; in_length_string = 6;
in_chr_byte = 7; in_chr_byte = 7;
{$ifdef VER0_99_5}
in_inc_byte = 8;
in_inc_word = 9;
in_inc_dword = 10;
in_dec_byte = 11;
in_dec_word = 12;
in_dec_dword = 13;
{$endif}
in_write_x = 14; in_write_x = 14;
in_writeln_x = 15; in_writeln_x = 15;
in_read_x = 16; in_read_x = 16;
@ -74,7 +66,10 @@ const
{ {
$Log$ $Log$
Revision 1.7 1998-09-01 17:39:46 peter Revision 1.8 1998-09-14 10:44:07 peter
* all internal RTL functions start with FPC_
Revision 1.7 1998/09/01 17:39:46 peter
+ internal constant functions + internal constant functions
} }

8
compiler/messages.pas
View File

@ -103,8 +103,7 @@ begin
while not eof(f) do while not eof(f) do
begin begin
readln(f,s); readln(f,s);
inc(line); if (s<>'') and not(s[1] in ['#',';','%']) then
if (s<>'') and not(s[1] in ['#',';']) then
begin begin
i:=pos('=',s); i:=pos('=',s);
if i>0 then if i>0 then
@ -225,7 +224,10 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.3 1998-08-29 13:52:31 peter Revision 1.4 1998-09-14 10:44:08 peter
* all internal RTL functions start with FPC_
Revision 1.3 1998/08/29 13:52:31 peter
+ new messagefile + new messagefile
* merged optione.msg into errore.msg * merged optione.msg into errore.msg