-- (C) Copyright International Business Machines Corporation 23 January 
-- 1990.  All Rights Reserved. 
--  
-- See the file USERAGREEMENT distributed with this software for full 
-- terms and conditions of use. 
-- File: cgnamedlit.pp
-- Author: Andy Lowry
-- SCCS Info: @(#)cgnamedlit.pp	1.4 3/13/90

-- This module translates a 'named_literal' statement into the
-- appropriate instruction.  If the operand's primitive type is
-- boolean, a 'boolean' instruction is generated; ordered enumeration
-- yields 'ordenum_lit', while unordered enumeration yields
-- 'enum_lit'.

#include "typemark.h"
#include "codegen.h"

cgNamedLit: using (cgInternal, interpform)

process (Q: cgStmtQ)
  
declare
  args: cgStmt;
  tdef: type_definition;
  op: interpform!operation;
begin
  receive args from Q;
  reveal args.stmt.qualifier.literal;
  
  -- Get the type definition of the destination operand, and dispatch
  -- according to its primitive type
  tdef <- type_definition#(FNS.typeDef(typename#(args.cgData.Proc.objType(
	  objectname#(AREF(tmp,args.stmt.operands,ZERO))))));
  select primitive_types#(case of tdef.specification)
  where (primitive_types#'booleantype')
    -- boolean literal... lit string must match one of the boolean
    -- names for this type; figure out which one, and generate a
    -- 'boolean' instruction
    reveal tdef.specification.boolean;
    if (B(args.stmt.qualifier.literal = tdef.specification.boolean.true_name))
    then
      op := args.cgData.Tplt.boolT;
    else
      op := args.cgData.Tplt.boolF;
    end if;
    
  where (primitive_types#'enumerationtype')
    -- enumeration could be ordered or not... we do the same work, but
    -- the instruction opcode is different in the two cases.
    reveal tdef.specification.enumeration;
    new op;
    if tdef.specification.enumeration.ordered then
      op.opcode <- interpform!opcode#'ordenum_lit';
    else
      op.opcode <- interpform!opcode#'enum_lit';
    end if;
    new op.operands;		-- filled in below
    -- qualifier gives the integer value corresponding to the given
    -- name... equal to its position in the list of names in the
    -- enumeration
    inspect name in tdef.specification.enumeration.values
	  where (B(name = args.stmt.qualifier.literal)) begin
      unite op.qualifier.integer from I(position of name);
    end inspect;

  otherwise
    -- no other types can be the destination of a named_literal stmt
    exit cantHappen;
  end select;
  
  -- Fill in the single destintation operand address
  insert interpform!operand#(args.cgData.Proc.objAddr(
      objectname#(AREF(tmp,args.stmt.operands,ZERO)))) into op.operands;
  
  -- All done... install the instruction and get lost
  ADDINSTR(op);
  return args;

on exit(cantHappen)
  print S("CantHappen exit taken in cgnamedlit");
end process
    

    
    
