Browse Source

+ more more more documentation
+ first version include/exclude (can't test though, not enough scratch for i386 :()...

carl 23 years ago
parent
commit
eff31e8524
8 changed files with 270 additions and 103 deletions
  1. 31 13
      compiler/aasmtai.pas
  2. 40 10
      compiler/cgbase.pas
  3. 6 4
      compiler/cginfo.pas
  4. 35 7
      compiler/cgobj.pas
  5. 44 35
      compiler/defbase.pas
  6. 24 16
      compiler/ncginl.pas
  7. 24 6
      compiler/paramgr.pas
  8. 66 12
      compiler/rgobj.pas

+ 31 - 13
compiler/aasmtai.pas

@@ -121,6 +121,7 @@ interface
           constructor Create;
           constructor Create;
        end;
        end;
 
 
+       {# Generates an assembler string } 
        tai_string = class(tai)
        tai_string = class(tai)
           str : pchar;
           str : pchar;
           { extra len so the string can contain an \0 }
           { extra len so the string can contain an \0 }
@@ -131,7 +132,7 @@ interface
           destructor Destroy;override;
           destructor Destroy;override;
        end;
        end;
 
 
-       { generates a common label }
+       {# Generates a common label }
        tai_symbol = class(tai)
        tai_symbol = class(tai)
           is_global : boolean;
           is_global : boolean;
           sym : tasmsymbol;
           sym : tasmsymbol;
@@ -149,19 +150,21 @@ interface
           constructor Createname(const _name : string);
           constructor Createname(const _name : string);
        end;
        end;
 
 
+       {# Generates an assembler label } 
        tai_label = class(tai)
        tai_label = class(tai)
           is_global : boolean;
           is_global : boolean;
           l : tasmlabel;
           l : tasmlabel;
           constructor Create(_l : tasmlabel);
           constructor Create(_l : tasmlabel);
        end;
        end;
 
 
+       {# Directly output data to final assembler file }
        tai_direct = class(tai)
        tai_direct = class(tai)
           str : pchar;
           str : pchar;
           constructor Create(_str : pchar);
           constructor Create(_str : pchar);
           destructor Destroy; override;
           destructor Destroy; override;
        end;
        end;
 
 
-       { to insert a comment into the generated assembler file }
+       {# Generates an assembler comment }
        tai_asm_comment = class(tai)
        tai_asm_comment = class(tai)
           str : pchar;
           str : pchar;
           constructor Create(_str : pchar);
           constructor Create(_str : pchar);
@@ -169,14 +172,14 @@ interface
        end;
        end;
 
 
 
 
-       { Insert a section/segment directive }
+       {# Generates a section / segment directive }
        tai_section = class(tai)
        tai_section = class(tai)
           sec : TSection;
           sec : TSection;
           constructor Create(s : TSection);
           constructor Create(s : TSection);
        end;
        end;
 
 
 
 
-       { generates an uninitializised data block }
+       {# Generates an uninitializised data block }
        tai_datablock = class(tai)
        tai_datablock = class(tai)
           is_global : boolean;
           is_global : boolean;
           sym  : tasmsymbol;
           sym  : tasmsymbol;
@@ -186,7 +189,7 @@ interface
        end;
        end;
 
 
 
 
-       { generates a long integer (32 bit) }
+       {# Generates a long integer (32 bit) }
        tai_const = class(tai)
        tai_const = class(tai)
           value : longint;
           value : longint;
           constructor Create_32bit(_value : longint);
           constructor Create_32bit(_value : longint);
@@ -205,31 +208,35 @@ interface
           constructor Createname_rva(const name:string);
           constructor Createname_rva(const name:string);
        end;
        end;
 
 
-       { generates a single (32 bit real) }
+       {# Generates a single float (32 bit real) }
        tai_real_32bit = class(tai)
        tai_real_32bit = class(tai)
           value : ts32real;
           value : ts32real;
           constructor Create(_value : ts32real);
           constructor Create(_value : ts32real);
        end;
        end;
 
 
-       { generates a double (64 bit real) }
+       {# Generates a double float (64 bit real) }
        tai_real_64bit = class(tai)
        tai_real_64bit = class(tai)
           value : ts64real;
           value : ts64real;
           constructor Create(_value : ts64real);
           constructor Create(_value : ts64real);
        end;
        end;
 
 
-       { generates an extended (80 bit real) }
+       {# Generates an extended float (80 bit real) }
        tai_real_80bit = class(tai)
        tai_real_80bit = class(tai)
           value : ts80real;
           value : ts80real;
           constructor Create(_value : ts80real);
           constructor Create(_value : ts80real);
        end;
        end;
 
 
-       { generates an comp (integer over 64 bits) }
+       {# Generates a comp int (integer over 64 bits) 
+         
+          This is Intel 80x86 specific, and is not
+          really supported on other processors.
+       }
        tai_comp_64bit = class(tai)
        tai_comp_64bit = class(tai)
           value : ts64comp;
           value : ts64comp;
           constructor Create(_value : ts64comp);
           constructor Create(_value : ts64comp);
        end;
        end;
 
 
-       { insert a cut to split into several smaller files }
+       {# Insert a cut to split assembler into several smaller files }
        tai_cut = class(tai)
        tai_cut = class(tai)
           place : tcutplace;
           place : tcutplace;
           constructor Create;
           constructor Create;
@@ -237,7 +244,7 @@ interface
           constructor Create_end;
           constructor Create_end;
        end;
        end;
 
 
-       { insert a marker for assembler and inline blocks }
+       {# Insert a marker for assembler and inline blocks }
        tai_marker = class(tai)
        tai_marker = class(tai)
          Kind: TMarker;
          Kind: TMarker;
          Constructor Create(_Kind: TMarker);
          Constructor Create(_Kind: TMarker);
@@ -258,14 +265,21 @@ interface
          constructor dealloc(r : tregister);
          constructor dealloc(r : tregister);
       end;
       end;
 
 
+      {# Class template for assembler instructions
+      }
       taicpu_abstract = class(tai)
       taicpu_abstract = class(tai)
+        {# Condition flags for instruction }
         condition : TAsmCond;
         condition : TAsmCond;
+        {# Number of operands to instruction }
         ops       : longint;
         ops       : longint;
+        {# Operands of instruction }
         oper      : array[0..max_operands-1] of toper;
         oper      : array[0..max_operands-1] of toper;
+        {# Actual opcode of instruction }
         opcode    : tasmop;
         opcode    : tasmop;
 {$ifdef i386}
 {$ifdef i386}
         segprefix : tregister;
         segprefix : tregister;
 {$endif i386}
 {$endif i386}
+        {# true if instruction is a jmp }
         is_jmp    : boolean; { is this instruction a jump? (needed for optimizer) }
         is_jmp    : boolean; { is this instruction a jump? (needed for optimizer) }
         Constructor Create(op : tasmop);
         Constructor Create(op : tasmop);
         Destructor Destroy;override;
         Destructor Destroy;override;
@@ -278,7 +292,7 @@ interface
         procedure SetCondition(const c:TAsmCond);
         procedure SetCondition(const c:TAsmCond);
       end;
       end;
 
 
-      { alignment for operator }
+      {# alignment for operator }
       tai_align_abstract = class(tai)
       tai_align_abstract = class(tai)
          buf       : array[0..63] of char; { buf used for fill }
          buf       : array[0..63] of char; { buf used for fill }
          aligntype : byte;   { 1 = no align, 2 = word align, 4 = dword align }
          aligntype : byte;   { 1 = no align, 2 = word align, 4 = dword align }
@@ -969,7 +983,11 @@ uses
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.1  2002-07-01 18:46:20  peter
+  Revision 1.2  2002-08-05 18:27:48  carl
+    + more more more documentation
+    + first version include/exclude (can't test though, not enough scratch for i386 :()...
+
+  Revision 1.1  2002/07/01 18:46:20  peter
     * internal linker
     * internal linker
     * reorganized aasm layer
     * reorganized aasm layer
 
 

+ 40 - 10
compiler/cgbase.pas

@@ -20,6 +20,8 @@
 
 
  ****************************************************************************
  ****************************************************************************
 }
 }
+{# Some helpers for the code generator.
+}
 unit cgbase;
 unit cgbase;
 
 
 {$i fpcdefs.inc}
 {$i fpcdefs.inc}
@@ -58,6 +60,9 @@ unit cgbase;
        pi_needs_implicit_finally = $80;
        pi_needs_implicit_finally = $80;
 
 
     type
     type
+       {# This object gives information on the current routine being
+          compiled.
+       }   
        pprocinfo = ^tprocinfo;
        pprocinfo = ^tprocinfo;
        tprocinfo = object
        tprocinfo = object
           {# pointer to parent in nested procedures }
           {# pointer to parent in nested procedures }
@@ -66,19 +71,22 @@ unit cgbase;
           _class : tobjectdef;
           _class : tobjectdef;
           {# the definition of the routine itself }
           {# the definition of the routine itself }
           procdef : tprocdef;
           procdef : tprocdef;
-          {# frame pointer offset??? }
+          {# offset from frame pointer to get parent frame pointer reference
+             (used in nested routines only)
+          }
           framepointer_offset : longint;
           framepointer_offset : longint;
-          { self pointer offset???? }
+          {# offset from frame pointer to get self reference }
           selfpointer_offset : longint;
           selfpointer_offset : longint;
           {# result value offset in stack (functions only) }
           {# result value offset in stack (functions only) }
           return_offset : longint;
           return_offset : longint;
           {# firsttemp position }
           {# firsttemp position }
           firsttemp_offset : longint;
           firsttemp_offset : longint;
-          {# parameter offset in stack }
+          {# offset from frame pointer to parameters }
           para_offset : longint;
           para_offset : longint;
 
 
           {# some collected informations about the procedure
           {# some collected informations about the procedure
-             see pi_xxxx above                               }
+             see pi_xxxx constants above                               
+          }
           flags : longint;
           flags : longint;
 
 
           {# register used as frame pointer }
           {# register used as frame pointer }
@@ -113,13 +121,28 @@ unit cgbase;
              or classes are used. It holds the location where
              or classes are used. It holds the location where
              temporary storage of the setjmp result is stored.
              temporary storage of the setjmp result is stored.
              
              
-             This reference can be nil, if the result is instead
+             This reference can be unused, if the result is instead
              saved on the stack.
              saved on the stack.
           }
           }
           exception_result_ref :treference;
           exception_result_ref :treference;
-
-          aktproccode,aktentrycode,
-          aktexitcode,aktlocaldata : taasmoutput;
+          {# Holds the reference used to store alll saved registers.
+          
+             This is used on systems which do not have direct stack
+             operations (such as the PowerPC), it is unused on other
+             systems
+          }
+          save_regs_ref : treference;
+          {# The code for the routine itself, excluding entry and
+             exit code. This is a linked list of tai classes.
+          }   
+          aktproccode : taasmoutput;
+          {# The code for the routine entry code.
+          }
+          aktentrycode: taasmoutput;
+          {# The code for the routine exit code.
+          }
+          aktexitcode: taasmoutput;
+          aktlocaldata : taasmoutput;
           constructor init;
           constructor init;
           destructor done;
           destructor done;
        end;
        end;
@@ -180,9 +203,12 @@ unit cgbase;
     procedure codegen_newmodule;
     procedure codegen_newmodule;
     procedure codegen_newprocedure;
     procedure codegen_newprocedure;
 
 
-    {# From a definition return the abstract code generator size (@var(tcgsize) enum). It is
+    {# From a definition return the abstract code generator size enum. It is
        to note that the value returned can be @var(OS_NO) }
        to note that the value returned can be @var(OS_NO) }
     function def_cgsize(def: tdef): tcgsize;
     function def_cgsize(def: tdef): tcgsize;
+    {# From a constant numeric value, return the abstract code generator
+       size.
+    }   
     function int_cgsize(const l: aword): tcgsize;
     function int_cgsize(const l: aword): tcgsize;
 
 
     {# return the inverse condition of opcmp }
     {# return the inverse condition of opcmp }
@@ -554,7 +580,11 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.20  2002-08-04 19:06:41  carl
+  Revision 1.21  2002-08-05 18:27:48  carl
+    + more more more documentation
+    + first version include/exclude (can't test though, not enough scratch for i386 :()...
+
+  Revision 1.20  2002/08/04 19:06:41  carl
     + added generic exception support (still does not work!)
     + added generic exception support (still does not work!)
     + more documentation
     + more documentation
 
 

+ 6 - 4
compiler/cginfo.pas

@@ -31,10 +31,8 @@ interface
 
 
     type
     type
        {# Generic opcodes, which must be supported by all processors 
        {# Generic opcodes, which must be supported by all processors 
-          The order of this table should not be changed, since table
-          lookups are used in the different CPU code generators!
        }   
        }   
-       TOpCg =
+       topcg =
        (
        (
           OP_NONE,
           OP_NONE,
           OP_ADD,       { simple addition          }
           OP_ADD,       { simple addition          }
@@ -109,7 +107,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.14  2002-08-04 19:06:41  carl
+  Revision 1.15  2002-08-05 18:27:48  carl
+    + more more more documentation
+    + first version include/exclude (can't test though, not enough scratch for i386 :()...
+
+  Revision 1.14  2002/08/04 19:06:41  carl
     + added generic exception support (still does not work!)
     + added generic exception support (still does not work!)
     + more documentation
     + more documentation
 
 

+ 35 - 7
compiler/cgobj.pas

@@ -25,6 +25,11 @@
 {# @abstract(Abstract code generator unit)
 {# @abstract(Abstract code generator unit)
    Abstreact code generator unit. This contains the base class
    Abstreact code generator unit. This contains the base class
    to implement for all new supported processors.
    to implement for all new supported processors.
+   
+   WARNING: None of the routines implemented in these modules,
+   or their descendants, should use the temp. allocator, as
+   these routines may be called inside genentrycode, and the
+   stack frame is already setup!
 }
 }
 unit cgobj;
 unit cgobj;
 
 
@@ -108,7 +113,7 @@ unit cgobj;
 
 
              @param(size size of the operand in the register)
              @param(size size of the operand in the register)
              @param(r register source of the operand)
              @param(r register source of the operand)
-             @param(nr parameter number (starting from one) of routine (from left to right))
+             @param(locpara where the parameter will be stored)
           }
           }
           procedure a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;const locpara : tparalocation);virtual;
           procedure a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;const locpara : tparalocation);virtual;
           {# Pass a parameter, which is a constant, to a routine.
           {# Pass a parameter, which is a constant, to a routine.
@@ -117,7 +122,7 @@ unit cgobj;
 
 
              @param(size size of the operand in constant)
              @param(size size of the operand in constant)
              @param(a value of constant to send)
              @param(a value of constant to send)
-             @param(nr parameter number (starting from one) of routine (from left to right))
+             @param(locpara where the parameter will be stored)
           }
           }
           procedure a_param_const(list : taasmoutput;size : tcgsize;a : aword;const locpara : tparalocation);virtual;
           procedure a_param_const(list : taasmoutput;size : tcgsize;a : aword;const locpara : tparalocation);virtual;
           {# Pass the value of a parameter, which is located in memory, to a routine.
           {# Pass the value of a parameter, which is located in memory, to a routine.
@@ -126,7 +131,7 @@ unit cgobj;
 
 
              @param(size size of the operand in constant)
              @param(size size of the operand in constant)
              @param(r Memory reference of value to send)
              @param(r Memory reference of value to send)
-             @param(nr parameter number (starting from one) of routine (from left to right))
+             @param(locpara where the parameter will be stored)
           }
           }
           procedure a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;const locpara : tparalocation);virtual;
           procedure a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;const locpara : tparalocation);virtual;
           {# Pass the value of a parameter, which can be located either in a register or memory location,
           {# Pass the value of a parameter, which can be located either in a register or memory location,
@@ -136,9 +141,12 @@ unit cgobj;
 
 
              @param(l location of the operand to send)
              @param(l location of the operand to send)
              @param(nr parameter number (starting from one) of routine (from left to right))
              @param(nr parameter number (starting from one) of routine (from left to right))
+             @param(locpara where the parameter will be stored)
           }
           }
           procedure a_param_loc(list : taasmoutput;const l : tlocation;const locpara : tparalocation);
           procedure a_param_loc(list : taasmoutput;const l : tlocation;const locpara : tparalocation);
-          {# Pass the address of a reference to a routine.
+          {# Pass the address of a reference to a routine. This routine
+             will calculate the address of the reference, and pass this
+             calculated address as a parameter.
 
 
              A generic version is provided.
              A generic version is provided.
 
 
@@ -327,6 +335,8 @@ unit cgobj;
              the runtime library. The default behavior
              the runtime library. The default behavior
              does not need to be modified, as it is generic
              does not need to be modified, as it is generic
              for all platforms.
              for all platforms.
+             
+             @param(stackframesize Number of bytes which will be allocated on the stack)
           }
           }
           procedure g_stackcheck(list : taasmoutput;stackframesize : longint);virtual;
           procedure g_stackcheck(list : taasmoutput;stackframesize : longint);virtual;
 
 
@@ -340,7 +350,7 @@ unit cgobj;
           procedure g_rangecheck(list: taasmoutput; const p: tnode;
           procedure g_rangecheck(list: taasmoutput; const p: tnode;
             const todef: tdef); virtual;
             const todef: tdef); virtual;
 
 
-          { generates overflow checking code for a node }
+          {# Generates overflow checking code for a node }
           procedure g_overflowcheck(list: taasmoutput; const p: tnode); virtual; abstract;
           procedure g_overflowcheck(list: taasmoutput; const p: tnode); virtual; abstract;
 
 
           {**********************************}
           {**********************************}
@@ -364,9 +374,23 @@ unit cgobj;
              behavior does nothing, should be overriden as required.
              behavior does nothing, should be overriden as required.
           }
           }
           procedure g_profilecode(list : taasmoutput);virtual;
           procedure g_profilecode(list : taasmoutput);virtual;
+          {# Emits instruction for allocating the locals in entry
+             code of a routine. This is one of the first
+             routine called in @var(genentrycode).
+             
+             @param(localsize Number of bytes to allocate as locals)
+          }
           procedure g_stackframe_entry(list : taasmoutput;localsize : longint);virtual; abstract;
           procedure g_stackframe_entry(list : taasmoutput;localsize : longint);virtual; abstract;
-          { restores the frame pointer at procedure exit }
+          {# Emits instructiona for restoring the frame pointer 
+             at routine exit. For some processors, this routine
+             may do nothing at all.
+          }
           procedure g_restore_frame_pointer(list : taasmoutput);virtual; abstract;
           procedure g_restore_frame_pointer(list : taasmoutput);virtual; abstract;
+          {# Emits instructions for returning from a subroutine.
+             Should also restore the stack. 
+             
+             @param(parasize  Number of bytes of parameters to deallocate from stack)   
+          }
           procedure g_return_from_proc(list : taasmoutput;parasize : aword);virtual; abstract;
           procedure g_return_from_proc(list : taasmoutput;parasize : aword);virtual; abstract;
           procedure g_call_constructor_helper(list : taasmoutput);virtual;
           procedure g_call_constructor_helper(list : taasmoutput);virtual;
           procedure g_call_destructor_helper(list : taasmoutput);virtual;
           procedure g_call_destructor_helper(list : taasmoutput);virtual;
@@ -1498,7 +1522,11 @@ finalization
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.42  2002-08-04 19:08:21  carl
+  Revision 1.43  2002-08-05 18:27:48  carl
+    + more more more documentation
+    + first version include/exclude (can't test though, not enough scratch for i386 :()...
+
+  Revision 1.42  2002/08/04 19:08:21  carl
     + added generic exception support (still does not work!)
     + added generic exception support (still does not work!)
     + more documentation
     + more documentation
 
 

+ 44 - 35
compiler/defbase.pas

@@ -45,34 +45,39 @@ interface
                           Basic type functions
                           Basic type functions
  *****************************************************************************}
  *****************************************************************************}
 
 
-    {# Returns true, if def defines an ordinal type }
+    {# Returns true, if definition defines an ordinal type }
     function is_ordinal(def : tdef) : boolean;
     function is_ordinal(def : tdef) : boolean;
 
 
-    {# Returns the min. value of the type }
+    {# Returns the minimal integer value of the type }
     function get_min_value(def : tdef) : TConstExprInt;
     function get_min_value(def : tdef) : TConstExprInt;
 
 
-    {# Returns basetype of the specified range }
+    {# Returns basetype of the specified integer range }
     function range_to_basetype(low,high:TConstExprInt):tbasetype;
     function range_to_basetype(low,high:TConstExprInt):tbasetype;
 
 
-    {# Returns true, if def defines an ordinal type }
+    {# Returns true, if definition defines an integer type }
     function is_integer(def : tdef) : boolean;
     function is_integer(def : tdef) : boolean;
 
 
-    {# Returns true if p is a boolean }
+    {# Returns true if definition is a boolean }
     function is_boolean(def : tdef) : boolean;
     function is_boolean(def : tdef) : boolean;
 
 
-    {# Returns true if p is a char }
+    {# Returns true if definition is a char 
+    
+       This excludes the unicode char.
+    }
     function is_char(def : tdef) : boolean;
     function is_char(def : tdef) : boolean;
 
 
-    {# Returns true if p is a widechar }
+    {# Returns true if definition is a widechar }
     function is_widechar(def : tdef) : boolean;
     function is_widechar(def : tdef) : boolean;
 
 
-    {# Returns true if p is a void}
+    {# Returns true if definition is a void}
     function is_void(def : tdef) : boolean;
     function is_void(def : tdef) : boolean;
 
 
-    {# Returns true if p is a smallset def }
+    {# Returns true if definition is a smallset}
     function is_smallset(p : tdef) : boolean;
     function is_smallset(p : tdef) : boolean;
 
 
-    {# Returns true, if def defines a signed data type (only for ordinal types) }
+    {# Returns true, if def defines a signed data type 
+       (only for ordinal types) 
+    }
     function is_signed(def : tdef) : boolean;
     function is_signed(def : tdef) : boolean;
 
 
     {# Returns true whether def_from's range is comprised in def_to's if both are
     {# Returns true whether def_from's range is comprised in def_to's if both are
@@ -91,13 +96,13 @@ interface
     }
     }
     function is_zero_based_array(p : tdef) : boolean;
     function is_zero_based_array(p : tdef) : boolean;
 
 
-    {# Returns true if p points to an open array def }
+    {# Returns true if p points to an open array definition }
     function is_open_array(p : tdef) : boolean;
     function is_open_array(p : tdef) : boolean;
 
 
-    {# Returns true if p points to a dynamic array def }
+    {# Returns true if p points to a dynamic array definition }
     function is_dynamic_array(p : tdef) : boolean;
     function is_dynamic_array(p : tdef) : boolean;
 
 
-    {# Returns true, if p points to an array of const def }
+    {# Returns true, if p points to an array of const definition }
     function is_array_constructor(p : tdef) : boolean;
     function is_array_constructor(p : tdef) : boolean;
 
 
     {# Returns true, if p points to a variant array }
     {# Returns true, if p points to a variant array }
@@ -124,19 +129,19 @@ interface
                           String helper functions
                           String helper functions
  *****************************************************************************}
  *****************************************************************************}
 
 
-    {# Returns true if p points to an open string def }
+    {# Returns true if p points to an open string type }
     function is_open_string(p : tdef) : boolean;
     function is_open_string(p : tdef) : boolean;
 
 
-    {# Returns true if p is an ansi string def }
+    {# Returns true if p is an ansi string type }
     function is_ansistring(p : tdef) : boolean;
     function is_ansistring(p : tdef) : boolean;
 
 
-    {# Returns true if p is a long string def }
+    {# Returns true if p is a long string type }
     function is_longstring(p : tdef) : boolean;
     function is_longstring(p : tdef) : boolean;
 
 
-    {# returns true if p is a wide string def }
+    {# returns true if p is a wide string type }
     function is_widestring(p : tdef) : boolean;
     function is_widestring(p : tdef) : boolean;
 
 
-    {# Returns true if p is a short string def }
+    {# Returns true if p is a short string type }
     function is_shortstring(p : tdef) : boolean;
     function is_shortstring(p : tdef) : boolean;
 
 
     {# Returns true if p is a pchar def }
     {# Returns true if p is a pchar def }
@@ -148,7 +153,7 @@ interface
     {# Returns true if p is a voidpointer def }
     {# Returns true if p is a voidpointer def }
     function is_voidpointer(p : tdef) : boolean;
     function is_voidpointer(p : tdef) : boolean;
 
 
-    {# Returns true, if definition is float }
+    {# Returns true, if definition is a float }
     function is_fpu(def : tdef) : boolean;
     function is_fpu(def : tdef) : boolean;
 
 
     {# Returns true, if def is a currency type }
     {# Returns true, if def is a currency type }
@@ -215,16 +220,16 @@ interface
 
 
     function equal_constsym(sym1,sym2:tconstsym):boolean;
     function equal_constsym(sym1,sym2:tconstsym):boolean;
 
 
+    { if acp is cp_all the var const or nothing are considered equal }
+    type
+      compare_type = ( cp_none, cp_value_equal_const, cp_all);
+
     {# true, if two parameter lists are equal
     {# true, if two parameter lists are equal
       if acp is cp_none, all have to match exactly
       if acp is cp_none, all have to match exactly
       if acp is cp_value_equal_const call by value
       if acp is cp_value_equal_const call by value
       and call by const parameter are assumed as
       and call by const parameter are assumed as
       equal
       equal
     }
     }
-    { if acp is cp_all the var const or nothing are considered equal }
-    type
-      compare_type = ( cp_none, cp_value_equal_const, cp_all);
-
     function equal_paras(paralist1,paralist2 : tlinkedlist; acp : compare_type) : boolean;
     function equal_paras(paralist1,paralist2 : tlinkedlist; acp : compare_type) : boolean;
 
 
 
 
@@ -1268,22 +1273,22 @@ implementation
           assignment_overloaded:=nil;
           assignment_overloaded:=nil;
           if not assigned(overloaded_operators[_ASSIGNMENT]) then
           if not assigned(overloaded_operators[_ASSIGNMENT]) then
             exit;
             exit;
-	
+    
           { look for an exact match first }
           { look for an exact match first }
-	  assignment_overloaded:=overloaded_operators[_ASSIGNMENT].
-	   search_procdef_byretdef_by1paradef(to_def,from_def,dm_exact);
-	  if assigned(assignment_overloaded) then
-	    exit;
+      assignment_overloaded:=overloaded_operators[_ASSIGNMENT].
+       search_procdef_byretdef_by1paradef(to_def,from_def,dm_exact);
+      if assigned(assignment_overloaded) then
+        exit;
 
 
           { .... then look for an equal match }
           { .... then look for an equal match }
-	  assignment_overloaded:=overloaded_operators[_ASSIGNMENT].
-	   search_procdef_byretdef_by1paradef(to_def,from_def,dm_equal);
-	  if assigned(assignment_overloaded) then
-	    exit;
+      assignment_overloaded:=overloaded_operators[_ASSIGNMENT].
+       search_procdef_byretdef_by1paradef(to_def,from_def,dm_equal);
+      if assigned(assignment_overloaded) then
+        exit;
 
 
           {  .... then for convert level 1 }
           {  .... then for convert level 1 }
-	  assignment_overloaded:=overloaded_operators[_ASSIGNMENT].
-	   search_procdef_byretdef_by1paradef(to_def,from_def,dm_convertl1);
+      assignment_overloaded:=overloaded_operators[_ASSIGNMENT].
+       search_procdef_byretdef_by1paradef(to_def,from_def,dm_convertl1);
        end;
        end;
 
 
 
 
@@ -1881,7 +1886,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.2  2002-07-23 09:51:22  daniel
+  Revision 1.3  2002-08-05 18:27:48  carl
+    + more more more documentation
+    + first version include/exclude (can't test though, not enough scratch for i386 :()...
+
+  Revision 1.2  2002/07/23 09:51:22  daniel
   * Tried to make Tprocsym.defs protected. I didn't succeed but the cleanups
   * Tried to make Tprocsym.defs protected. I didn't succeed but the cleanups
     are worth comitting.
     are worth comitting.
 
 

+ 24 - 16
compiler/ncginl.pas

@@ -39,7 +39,7 @@ interface
           procedure second_predsucc;virtual;
           procedure second_predsucc;virtual;
           procedure second_incdec;virtual;
           procedure second_incdec;virtual;
           procedure second_typeinfo;virtual;
           procedure second_typeinfo;virtual;
-          procedure second_includeexclude;virtual; abstract;
+          procedure second_includeexclude;virtual; 
           procedure second_pi; virtual;
           procedure second_pi; virtual;
           procedure second_arctan_real; virtual;
           procedure second_arctan_real; virtual;
           procedure second_abs_real; virtual;
           procedure second_abs_real; virtual;
@@ -445,7 +445,6 @@ implementation
 {*****************************************************************************
 {*****************************************************************************
                      INCLUDE/EXCLUDE GENERIC HANDLING
                      INCLUDE/EXCLUDE GENERIC HANDLING
 *****************************************************************************}
 *****************************************************************************}
-(*
       procedure tcginlinenode.second_IncludeExclude;
       procedure tcginlinenode.second_IncludeExclude;
         var
         var
          scratch_reg : boolean;
          scratch_reg : boolean;
@@ -455,7 +454,9 @@ implementation
          pushedregs : TMaybesave;
          pushedregs : TMaybesave;
          cgop : topcg;
          cgop : topcg;
          addrreg, hregister2: tregister;
          addrreg, hregister2: tregister;
-         {!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
+         use_small : boolean;
+         cgsize : tcgsize;
+         href : treference;
         begin
         begin
           location_copy(location,left.location);
           location_copy(location,left.location);
           secondpass(tcallparanode(left).left);
           secondpass(tcallparanode(left).left);
@@ -509,16 +510,16 @@ implementation
               
               
               case tcallparanode(tcallparanode(left).right).left.location.loc of
               case tcallparanode(tcallparanode(left).right).left.location.loc of
                  LOC_CREGISTER,
                  LOC_CREGISTER,
-                 LOC_REGISTER
+                 LOC_REGISTER:
                    begin
                    begin
                      cg.a_load_reg_reg(exprasmlist,OS_INT,
                      cg.a_load_reg_reg(exprasmlist,OS_INT,
-                       tcallparanode(tcallparanode(left).right).left.location.loc.register),hregister);
+                       tcallparanode(tcallparanode(left).right).left.location.register,hregister);
                    end;
                    end;
                  LOC_REFERENCE:
                  LOC_REFERENCE:
                    begin
                    begin
                      cgsize := def_cgsize(tcallparanode(tcallparanode(left).right).left.resulttype.def);
                      cgsize := def_cgsize(tcallparanode(tcallparanode(left).right).left.resulttype.def);
                      cg.a_load_ref_reg(exprasmlist,cgsize,
                      cg.a_load_ref_reg(exprasmlist,cgsize,
-                       tcallparanode(tcallparanode(left).right).left.location.loc.reference),hregister);
+                       tcallparanode(tcallparanode(left).right).left.location.reference,hregister);
                    end;
                    end;
                else
                else
                  internalerror(20020727);
                  internalerror(20020727);
@@ -540,14 +541,14 @@ implementation
                      if inlinenumber=in_include_x_y then
                      if inlinenumber=in_include_x_y then
                        begin
                        begin
                          cg.a_op_reg_ref(exprasmlist, OP_OR, OS_32, hregister2, 
                          cg.a_op_reg_ref(exprasmlist, OP_OR, OS_32, hregister2, 
-                         tcallparanode(left).left.location.loc.reference);
+                         tcallparanode(left).left.location.reference);
                        end
                        end
                      else
                      else
                        begin
                        begin
                          cg.a_op_reg_reg(exprasmlist, OP_NOT, OS_32, hregister2, 
                          cg.a_op_reg_reg(exprasmlist, OP_NOT, OS_32, hregister2, 
                          hregister2);
                          hregister2);
                          cg.a_op_reg_ref(exprasmlist, OP_AND, OS_32, hregister2, 
                          cg.a_op_reg_ref(exprasmlist, OP_AND, OS_32, hregister2, 
-                         tcallparanode(left).left.location.loc.reference);
+                         tcallparanode(left).left.location.reference);
                        end;
                        end;
                       
                       
                     end
                     end
@@ -561,9 +562,10 @@ implementation
                        set value : LOC_REFERENCE
                        set value : LOC_REFERENCE
                   }
                   }
                   { hregister contains the bitnumber (div 32 to get the correct offset) }
                   { hregister contains the bitnumber (div 32 to get the correct offset) }
-                  cg.a_op_const_reg(exprasmlist, OP_SHR, OS_INT, 5, hregister);
+                  cg.a_op_const_reg(exprasmlist, OP_SHR, 5, hregister);
+                  addrreg := cg.get_scratch_reg_address(exprasmlist);
                   { calculate the correct address of the operand }
                   { calculate the correct address of the operand }
-                  cg.a_loadaddr_ref_reg(exprasmlist, tcallparanode(left).left.location.loc.reference,addrreg);
+                  cg.a_loadaddr_ref_reg(exprasmlist, tcallparanode(left).left.location.reference,addrreg);
                   cg.a_op_reg_reg(exprasmlist, OP_ADD, OS_INT, hregister, addrreg);
                   cg.a_op_reg_reg(exprasmlist, OP_ADD, OS_INT, hregister, addrreg);
                   reference_reset_base(href,addrreg,0);
                   reference_reset_base(href,addrreg,0);
                   
                   
@@ -573,15 +575,17 @@ implementation
                        end
                        end
                      else
                      else
                        begin
                        begin
-                         cg.a_op_reg_reg(exprasmlist, OP_NOT, OS_32, hregister2, 
-                         hregister2);
+                         cg.a_op_reg_reg(exprasmlist, OP_NOT, OS_32, hregister2, hregister2);
                          cg.a_op_reg_ref(exprasmlist, OP_AND, OS_32, hregister2, href);
                          cg.a_op_reg_ref(exprasmlist, OP_AND, OS_32, hregister2, href);
                        end;
                        end;
                        
                        
-                  end;
-                  
+                  cg.free_scratch_reg(exprasmlist, addrreg);
+                end;
+                cg.free_scratch_reg(exprasmlist,hregister);
+                rg.ungetregisterint(exprasmlist,hregister2); 
+            end;
         end;
         end;
-*)
+
 {*****************************************************************************
 {*****************************************************************************
                             FLOAT GENERIC HANDLING
                             FLOAT GENERIC HANDLING
 *****************************************************************************}
 *****************************************************************************}
@@ -637,7 +641,11 @@ end.
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.9  2002-08-04 19:06:41  carl
+  Revision 1.10  2002-08-05 18:27:48  carl
+    + more more more documentation
+    + first version include/exclude (can't test though, not enough scratch for i386 :()...
+
+  Revision 1.9  2002/08/04 19:06:41  carl
     + added generic exception support (still does not work!)
     + added generic exception support (still does not work!)
     + more documentation
     + more documentation
 
 

+ 24 - 6
compiler/paramgr.pas

@@ -19,7 +19,8 @@
     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  ****************************************************************************
  ****************************************************************************
 }
 }
-{
+{# Parameter passing manager. Used to manage how
+   parameters are passed to routines.
 }
 }
 unit paramgr;
 unit paramgr;
 
 
@@ -32,22 +33,35 @@ unit paramgr;
        symtype,symdef;
        symtype,symdef;
 
 
     type
     type
+       {# This class defines some methods to take care of routine 
+          parameters. It should be overriden for each new processor
+       }   
        tparamanager = class
        tparamanager = class
-          { Returns true if the return value can be put in accumulator }
+          {# Returns true if the return value can be put in accumulator }
           function ret_in_acc(def : tdef) : boolean;virtual;
           function ret_in_acc(def : tdef) : boolean;virtual;
 
 
-          { Returns true if uses a parameter as return value (???) }
+          {# Returns true if the return value is actually a parameter
+             pointer.
+          }
           function ret_in_param(def : tdef) : boolean;virtual;
           function ret_in_param(def : tdef) : boolean;virtual;
 
 
           function push_high_param(def : tdef) : boolean;virtual;
           function push_high_param(def : tdef) : boolean;virtual;
 
 
-          { Returns true if a parameter is too large to copy and only the address is pushed
+          {# Returns true if a parameter is too large to copy and only 
+            the address is pushed
           }
           }
           function push_addr_param(def : tdef) : boolean;virtual;
           function push_addr_param(def : tdef) : boolean;virtual;
+          {# Returns a structure giving the information on
+             the storage of the parameter (which must be
+             an integer parameter)
+             
+             @param(nr Parameter number of routine, starting from 1)
+          }   
           function getintparaloc(nr : longint) : tparalocation;virtual;abstract;
           function getintparaloc(nr : longint) : tparalocation;virtual;abstract;
           procedure create_param_loc_info(p : tabstractprocdef);virtual;abstract;
           procedure create_param_loc_info(p : tabstractprocdef);virtual;abstract;
 
 
-          { Returns the location where the invisible parameter for structured
+          {# 
+            Returns the location where the invisible parameter for structured
             function results will be passed.
             function results will be passed.
           }
           }
           function getfuncretloc(p : tabstractprocdef) : tparalocation;virtual;abstract;
           function getfuncretloc(p : tabstractprocdef) : tparalocation;virtual;abstract;
@@ -154,7 +168,11 @@ end.
 
 
 {
 {
    $Log$
    $Log$
-   Revision 1.6  2002-07-30 20:50:43  florian
+   Revision 1.7  2002-08-05 18:27:48  carl
+     + more more more documentation
+     + first version include/exclude (can't test though, not enough scratch for i386 :()...
+
+   Revision 1.6  2002/07/30 20:50:43  florian
      * the code generator knows now if parameters are in registers
      * the code generator knows now if parameters are in registers
 
 
    Revision 1.5  2002/07/26 21:15:39  florian
    Revision 1.5  2002/07/26 21:15:39  florian

+ 66 - 12
compiler/rgobj.pas

@@ -23,6 +23,11 @@
 
 
 {$i fpcdefs.inc}
 {$i fpcdefs.inc}
 
 
+{# @abstract(Abstract register allocator unit)
+   This unit contains services to allocate, free
+   references and registers which are used by
+   the code generator.
+}
 unit rgobj;
 unit rgobj;
 
 
   interface
   interface
@@ -90,7 +95,11 @@ unit rgobj;
              is no more free registers which can be allocated
              is no more free registers which can be allocated
           }
           }
           function getregisterint(list: taasmoutput) : tregister; virtual;
           function getregisterint(list: taasmoutput) : tregister; virtual;
-          {# Free a general purpose register }
+          {# Free a general purpose register
+          
+             @param(r register to free)
+
+          }
           procedure ungetregisterint(list: taasmoutput; r : tregister); virtual;
           procedure ungetregisterint(list: taasmoutput; r : tregister); virtual;
 
 
           {# Allocate a floating point register 
           {# Allocate a floating point register 
@@ -99,7 +108,11 @@ unit rgobj;
              is no more free registers which can be allocated
              is no more free registers which can be allocated
           }
           }
           function getregisterfpu(list: taasmoutput) : tregister; virtual;
           function getregisterfpu(list: taasmoutput) : tregister; virtual;
-          {# Free a floating point register }
+          {# Free a floating point register 
+          
+             @param(r register to free)
+
+          }
           procedure ungetregisterfpu(list: taasmoutput; r : tregister); virtual;
           procedure ungetregisterfpu(list: taasmoutput; r : tregister); virtual;
 
 
           function getregistermm(list: taasmoutput) : tregister; virtual;
           function getregistermm(list: taasmoutput) : tregister; virtual;
@@ -117,32 +130,66 @@ unit rgobj;
           }
           }
           function getaddressregister(list: taasmoutput): tregister; virtual;
           function getaddressregister(list: taasmoutput): tregister; virtual;
           procedure ungetaddressregister(list: taasmoutput; r: tregister); virtual;
           procedure ungetaddressregister(list: taasmoutput; r: tregister); virtual;
-          { the following must only be called for address and integer }
-          { registers, otherwise the result is undefined              }
+          {# Verify if the specified register is an address or
+             general purpose register. Returns TRUE if @var(reg)
+             is an adress register.
+             
+             This routine should only be used to check on 
+             general purpose or address register. It will
+             not work on multimedia or floating point
+             registers
+             
+             @param(reg register to verify)
+          }   
           function isaddressregister(reg: tregister): boolean; virtual;
           function isaddressregister(reg: tregister): boolean; virtual;
 
 
-          {# tries to allocate the passed register, if possible }
+          {# Tries to allocate the passed register, if possible 
+          
+             @param(r specific register to allocate)
+          }
           function getexplicitregisterint(list: taasmoutput; r : tregister) : tregister;virtual;
           function getexplicitregisterint(list: taasmoutput; r : tregister) : tregister;virtual;
 
 
-          {# deallocate any kind of register }
+          {# Deallocate any kind of register }
           procedure ungetregister(list: taasmoutput; r : tregister); virtual;
           procedure ungetregister(list: taasmoutput; r : tregister); virtual;
 
 
-          {# deallocate any kind of register }
+          {# Deallocate all registers which are allocated
+             in the specified reference. On most systems,
+             this will free the base and index registers
+             of the specified reference.
+             
+             @param(ref reference which must have its registers freed)
+          }
           procedure ungetreference(list: taasmoutput; const ref : treference); virtual;
           procedure ungetreference(list: taasmoutput; const ref : treference); virtual;
 
 
-          {# reset the register allocator information (usable registers etc) }
+          {# Reset the register allocator information (usable registers etc) }
           procedure cleartempgen;virtual;
           procedure cleartempgen;virtual;
 
 
-          {# convert a register to a specified register size, and return that register size }
+          {# Convert a register to a specified register size, and return that register size }
           function makeregsize(reg: tregister; size: tcgsize): tregister; virtual;
           function makeregsize(reg: tregister; size: tcgsize): tregister; virtual;
 
 
 
 
           {# saves register variables (restoring happens automatically) }
           {# saves register variables (restoring happens automatically) }
           procedure saveregvars(list: taasmoutput; const s: tregisterset);
           procedure saveregvars(list: taasmoutput; const s: tregisterset);
 
 
-          {# saves and restores used registers }
+          {# Saves in temporary references (allocated via the temp. allocator)
+             the registers defined in @var(s). The registers are only saved
+             if they are currently in use, otherwise they are left as is.
+             
+             On processors which have instructions which manipulate the stack,
+             this routine should be overriden for performance reasons.
+             
+             @param(list)   List to add the instruction to
+             @param(saved)  Array of saved register information
+             @param(s)      Registers which might require saving
+          }
           procedure saveusedregisters(list: taasmoutput;
           procedure saveusedregisters(list: taasmoutput;
             var saved : tpushedsaved;const s: tregisterset);virtual;
             var saved : tpushedsaved;const s: tregisterset);virtual;
+          {# Restores the registers which were saved with a call
+             to @var(saveusedregisters).
+             
+             On processors which have instructions which manipulate the stack,
+             this routine should be overriden for performance reasons.
+          }
           procedure restoreusedregisters(list: taasmoutput;
           procedure restoreusedregisters(list: taasmoutput;
             const saved : tpushedsaved);virtual;
             const saved : tpushedsaved);virtual;
 
 
@@ -176,10 +223,13 @@ unit rgobj;
        end;
        end;
 
 
      const
      const
-       { this value is used in tsaved, if the register isn't saved }
+       {# This value is used in tsaved. If the array value is equal 
+          to this, then this means that this register is not used.
+       }
        reg_not_saved = $7fffffff;
        reg_not_saved = $7fffffff;
 
 
      var
      var
+       {# This is the class instance used to access the register allocator class }
        rg: trgobj;
        rg: trgobj;
 
 
      { trerefence handling }
      { trerefence handling }
@@ -892,7 +942,11 @@ end.
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.14  2002-08-04 19:06:41  carl
+  Revision 1.15  2002-08-05 18:27:48  carl
+    + more more more documentation
+    + first version include/exclude (can't test though, not enough scratch for i386 :()...
+
+  Revision 1.14  2002/08/04 19:06:41  carl
     + added generic exception support (still does not work!)
     + added generic exception support (still does not work!)
     + more documentation
     + more documentation