module:    harp-constant-references
Synopsis:  The <constant-reference> class, for symbolic constants.
Author:    Tony Mann
Copyright:    Original Code is Copyright (c) 1995-2004 Functional Objects, Inc.
              All rights reserved.
License:      See License.txt in this distribution for details.
Warranty:     Distributed WITHOUT WARRANTY OF ANY KIND

// The <constant-reference> class
//
// Describes a single reference to a constant for compiler use.
// Constant references may be generated by the code generator and
// passed to the backend, or directly generated by the backend.

// The hierarchy has now got rather complicated. There is a type hierarchy
// of integer (meaning integer/pointer) and float, and float is subdivided
// into single & double (as for registers). Into this we mixin the concepts 
// of address constants and indirect constants. There is also a notion of
// an imported constant (imported from another library). Currently, this
// is supported for indirect constants only, since DLL importing implies
// an indirection.

define primary open abstract class <constant-reference> (<object>)
  constant slot cr-refers-to-object,           // Canonical Object we refer to  
    required-init-keyword: refers-to:;
  constant slot cr-const-offset :: <integer>,  // Address offset from the constant
    required-init-keyword: const-offset:;
end class;


// Constant-references now refer to model-objects

// cr-refers-to coerces models to strings
// cr-refers-to-object retrieves the model-object


define method cr-refers-to(cref :: <constant-reference>) => (name :: <string>)
  let object = cref.cr-refers-to-object;
  select (object by instance?)
    <string> => object;
    otherwise => model-object-as-string(object);
  end select
end method;

define open generic model-object-as-string(object) => (name :: <string>);

// The indirection specifying classes:

define abstract open class <address-constant-reference> (<constant-reference>)
end class;

define abstract open class <indirect-constant-reference> (<constant-reference>)
end class;

define abstract open class <thread-constant-reference> (<constant-reference>)
end class;

define abstract open class <imported-constant-reference> (<constant-reference>)
end class;

define abstract open class <interactor-constant-reference> (<constant-reference>)
end class;



// The type specifying classes:

define abstract open class <i-constant-reference> (<constant-reference>)
end class;

define abstract open class <f-constant-reference> (<constant-reference>)
end class;

define abstract open class <sf-constant-reference> (<f-constant-reference>)
end class;

define abstract open class <df-constant-reference> (<f-constant-reference>)
end class;


// Now the concrete classes

// The instantiable general constant reference classes

define abstract open class <i-address-constant-reference> 
      (<i-constant-reference>, <address-constant-reference>)
// THIS ONE GETS SUBCLASSED BY IDVM 
end class;

define class <i-address-constant-reference-internal>
      (<i-address-constant-reference>) 
end class;

define sealed method make
    (class == <i-address-constant-reference>, #key const-offset = 0, refers-to) 
    => (r :: <i-address-constant-reference-internal>)
  make(<i-address-constant-reference-internal>,
       const-offset: const-offset, refers-to: refers-to);
end method;



define abstract class <i-indirect-constant-reference> 
      (<i-constant-reference>, <indirect-constant-reference>)
end class;

define class <i-indirect-constant-reference-internal> 
      (<i-indirect-constant-reference>) 
end class;

// On Windows, DLL imports require indirections, and code is compiled
// differently statically and dynamically. This is not the case on Linux,
// where there is no extra indirection for imports.

define class <i-address-constant-reference-imported>
      (<i-address-constant-reference>, <imported-constant-reference>) 
end class;

define class <i-indirect-constant-reference-imported>
      (<i-indirect-constant-reference>, <imported-constant-reference>) 
end class;

define class <i-thread-constant-reference> 
    (<i-address-constant-reference>, <thread-constant-reference>)
end class;

define class <interactor-indirect-constant-reference>
      (<i-indirect-constant-reference>, <interactor-constant-reference>) 
end class;

define sealed method make
    (class == <interactor-constant-reference>, #key const-offset = 0, refers-to) 
    => (r :: <interactor-indirect-constant-reference>)
  make(<interactor-indirect-constant-reference>,
       const-offset: const-offset, refers-to: refers-to);
end method;



// The instantiable float constant reference classes


define class <sf-address-constant-reference> 
      (<sf-constant-reference>, <address-constant-reference>)
end class;

define abstract class <sf-indirect-constant-reference> 
      (<sf-constant-reference>, <indirect-constant-reference>)
end class;

define class <sf-indirect-constant-reference-internal> 
      (<sf-indirect-constant-reference>)
end class;


define class <sf-address-constant-reference-imported> 
      (<sf-address-constant-reference>, <imported-constant-reference>)
end class;

define class <sf-indirect-constant-reference-imported> 
      (<sf-indirect-constant-reference>, <imported-constant-reference>)
end class;


define class <df-address-constant-reference> 
      (<df-constant-reference>, <address-constant-reference>)
end class;

define abstract class <df-indirect-constant-reference> 
      (<df-constant-reference>, <indirect-constant-reference>)
end class;

define class <df-indirect-constant-reference-internal> 
      (<df-indirect-constant-reference>)
end class;


define class <df-address-constant-reference-imported> 
      (<df-address-constant-reference>, <imported-constant-reference>)
end class;

define class <df-indirect-constant-reference-imported> 
      (<df-indirect-constant-reference>, <imported-constant-reference>)
end class;


define method constant-reference-class-selector
    (address-class :: <class>, indirect-class :: <class>,
     address-import-class :: <class>, indirect-import-class :: <class>,
     address-mode :: <symbol>, import? :: <boolean>)
    => (class :: <class>)
  if (import?)
    select (address-mode)
      #"address"  => address-import-class;
      #"indirect" => indirect-import-class;
    end select;
  else
    select (address-mode)
      #"address"  => address-class;
      #"indirect" => indirect-class;
    end select;
  end if;
end method;


define sealed method make 
    (class == <i-constant-reference>, 
     #key address-mode :: <symbol> = #"address",
          import? :: <boolean> = #f,
          const-offset = 0, refers-to) 
    => (r :: <i-constant-reference>)
  let wanted-class = 
    constant-reference-class-selector(<i-address-constant-reference>,
                                      <i-indirect-constant-reference-internal>,
                                      <i-address-constant-reference-imported>,
                                      <i-indirect-constant-reference-imported>,
                                      address-mode, import?);
  make(wanted-class, const-offset: const-offset, refers-to: refers-to);
end method;


define sealed method make 
    (class == <sf-constant-reference>, 
     #key address-mode :: <symbol> = #"address",
          import? :: <boolean> = #f,
          const-offset = 0, refers-to) 
    => (r :: <sf-constant-reference>)
  let wanted-class = 
    constant-reference-class-selector(<sf-address-constant-reference>,
                                      <sf-indirect-constant-reference-internal>,
                                      <sf-address-constant-reference-imported>,
                                      <sf-indirect-constant-reference-imported>,
                                      address-mode, import?);
  make(wanted-class, const-offset: const-offset, refers-to: refers-to);
end method;


define sealed method make 
    (class == <df-constant-reference>, 
     #key address-mode :: <symbol> = #"address",
          import? :: <boolean> = #f,
          const-offset = 0, refers-to) 
    => (r :: <df-constant-reference>)
  let wanted-class = 
    constant-reference-class-selector(<df-address-constant-reference>,
                                      <df-indirect-constant-reference-internal>,
                                      <df-address-constant-reference-imported>,
                                      <df-indirect-constant-reference-imported>,
                                      address-mode, import?);
  make(wanted-class, const-offset: const-offset, refers-to: refers-to);
end method;


define sealed method make 
    (class == <constant-reference>, #rest keys, #key, #all-keys)
    => (r :: <i-constant-reference>)
  apply(make, <i-constant-reference>, keys);
end method;

define sealed method make 
    (class == <address-constant-reference>, #rest keys, #key, #all-keys) 
    => (r :: <i-address-constant-reference>)
  apply(make, <i-address-constant-reference>, keys);
end method;


define sealed method make 
    (class == <indirect-constant-reference>, #rest keys, #key, #all-keys) 
    => (r :: <i-indirect-constant-reference-internal>)
  apply(make, <i-indirect-constant-reference-internal>, keys);
end method;


define sealed method make 
    (class == <imported-constant-reference>, #rest keys, #key, #all-keys) 
    => (r :: <i-indirect-constant-reference-imported>)
  error("Not yet implemented");
end method;



/// Finally, the <labelled-constant> class. This is generated from
/// constant references to represent labels in the code stream.
/// Instances of this class may appear in <compiled-lambda> objects
/// for later outputting.


define abstract open primary class <labelled-constant> (<object>)
  // The location in the code vector. This must be set after SDI resolution
  slot labelled-constant-index :: <integer> = 0; 
  // The size of the constant (in backend dependent units). 
  constant slot labelled-constant-size  :: <integer>, required-init-keyword: size:;
end class;


define abstract open primary class <explicit-labelled-constant> (<labelled-constant>)
  slot labelled-constant-reference :: <constant-reference>, 
       init-keyword: constant-reference:;
end class;


/// And a subclass for absolute constants.

define class <labelled-absolute-constant> (<explicit-labelled-constant>)
end class;

// Support generation of split high/low constant references for multi-instruction 
// construction of constant references for back-ends like PowerPC.

define class <labelled-absolute-constant-high> (<labelled-absolute-constant>)
end class;

define class <labelled-absolute-constant-low> (<labelled-absolute-constant>)
end class;

define class <labelled-absolute-thread-constant> (<labelled-absolute-constant>)
end class;

/// And a subclass for relative constants.

define class <labelled-relative-constant> (<explicit-labelled-constant>)
end class;


/// And a subclass for opcodes with constants (some assemblers - 
/// especially the Intel X86 - make it difficult to build these by steam.


define class <labelled-constant-with-opcode> (<explicit-labelled-constant>)
  constant slot opcode :: <symbol>, required-init-keyword: opcode:;
  constant slot opcode-value :: <integer>, required-init-keyword: value:;
end class;


/// <code-address-constant> describes a reference which is based on the 
/// current code location

define abstract class <code-address-constant> (<labelled-constant>)
end class;




// The <relative-address-constant> class
//
// Describes a reference to an address in the current lambda, relative to
// the current location. This may be used by LEA etc.


define class <relative-address-constant> (<code-address-constant>)
  slot relative-offset :: <integer>, required-init-keyword: offset:;
end class;

define class <relative-address-constant-high> (<relative-address-constant>)
end class;

define class <relative-address-constant-low> (<relative-address-constant>)
end class;




/// <debug-info-constant> describes a reference which will only appear
/// in debug info, and has no representation in the actual code.

define abstract class <debug-info-constant> (<code-address-constant>)
end class;


/// <start-frame-marker> describes a stack frame creation (i.e. a transition
/// out of leaf-case)

define class <start-frame-marker> (<debug-info-constant>)
end class;


/// <end-frame-marker> describes a stack frame removal (i.e. a transition
/// back to leaf-case)

define class <end-frame-marker> (<debug-info-constant>)
end class;


// The <code-locator-constant> class
//
// Describes a source code locator in the current lambda, at the current location.


define class <code-locator-constant> (<debug-info-constant>)

  // The live variables slot is used during code generation, but will be 
  // emptied after HARP has done its work
  slot locator-live-variables :: <vector> = #[],
    init-keyword: variables:;

  slot locator-data :: <object>, 
    required-init-keyword: data:;

  slot locator-with-stack? :: <boolean>,
    required-init-keyword: stack:;

end class;
