-- (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: cgnew.pp
-- Author: Andy Lowry
-- SCCS Info: @(#)cgnew.pp	1.13 3/13/90

-- This process translates a 'new' statement.  The generated opcode
-- is determined from the primitive type of the operand.  As a special
-- case, for a record type with the "program" pragma, 'new_program'
-- opcode is generated instead of 'new_record'.  For a table type, the
-- qualifier describes the table representation(s) to be used.

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

cgnew: using (interpform, cgInternal)

process (Q: cgStmtQ)

declare
  args: cgStmt;
  op: interpform!operation;
  tdef: type_definition;
  empty: empty;
begin
  receive args from Q;

  -- allocate the instruction and generate the single operand address
  new op;
  new op.operands;
  insert interpform!operand#(args.cgData.Proc.objAddr(
      objectname#(AREF(tmp,args.stmt.operands,ZERO)))) into op.operands;

  -- Get the destination type defintion
  tdef <- type_definition#(FNS.typeDef(typename#(args.cgData.Proc.objType(
	  objectname#(AREF(tmp,args.stmt.operands,ZERO))))));

  -- dispatch according to object's primitive type
  select (primitive_types#(case of tdef.specification))

  where (primitive_types#'recordtype')
    -- If the "program" pragma is present, we generate 'new_program'
    -- with an empty qualifier; otherwise, generate 'new_record' and
    -- put the record size in the qualifier
    if B(tdef.prag = S("program")) then
      op.opcode <- interpform!opcode#'new_program';
      unite op.qualifier.empty from empty;
    else
      op.opcode <- interpform!opcode#'new_record';
      unite op.qualifier.integer from I(size of tdef.component_declarations);
    end if;

  where (primitive_types#'inporttype')
    -- opcode is 'new_inport', empty qualifier
    op.opcode <- interpform!opcode#'new_inport';
    unite op.qualifier.empty from empty;

  where (primitive_types#'tabletype')
    -- opcode is 'new_table';  qualifier is fairly tricky, so there's
    -- a special process whose job it is to figure it out!
    reveal tdef.specification.table_info;
    op.opcode <- interpform!opcode#'new_table';
    unite op.qualifier.new_table from new_table_info#(
	FNS.newTableInfo(tdef.specification.table_info,
	    FNS.typeDef,FNS.compOffsets));

  otherwise
    -- that's all the newable primitive types
    exit cantHappen;

  end select;

  -- Add the new instruction to the current basic block
  ADDINSTR(op);

  return args;

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


