(* Copyright (C) 1992, Digital Equipment Corporation           *)
(* All rights reserved.                                        *)
(* See the file COPYRIGHT for a full description.              *)

(* File: UserProc.m3                                           *)
(* Last Modified On Mon Jun  8 13:29:45 PDT 1992 By kalsow     *)

MODULE UserProc;

IMPORT Type, Expr, ProcType, Error, Emit, Formal, Value, Temp, Void;
IMPORT Scope, String, Procedure, NamedExpr, Variable, QualifyExpr;
IMPORT CallExpr, Closure, ProcExpr, Frame;

PROCEDURE TypeOf (proc: Expr.T;  <*UNUSED*> VAR args: Expr.List): Type.T =
  VAR t: Type.T;
  BEGIN
    t := Expr.TypeOf (proc);
    IF (t = NIL) OR (t = Void.T) THEN t := QualifyExpr.MethodType (proc) END;
    RETURN ProcType.Result (Type.Base (t));
  END TypeOf;

PROCEDURE CheckCall (proc: Expr.T;  VAR args: Expr.List;
                                             VAR cs: Expr.CheckState): Type.T =
  VAR n: INTEGER;  t: Type.T;  formals: Scope.ValueList; names: Scope.NameList;
  BEGIN
    t := Expr.TypeOf (proc);
    IF (t = NIL) OR (t = Void.T) THEN t := QualifyExpr.MethodType (proc) END;
    t := Type.Base (t);
    Scope.ToListWithAliases (ProcType.Formals (t), formals, n, names);
    IF Formal.CheckArgs (cs, args, formals^, names, TRUE, n) THEN END;
    RETURN ProcType.Result (t);
  END CheckCall;

PROCEDURE GenCall (proc: Expr.T;  args: Expr.List): Temp.T =
  VAR
    n := NUMBER (args^);
    targs: ARRAY [0..19] OF Temp.T;
    indirect: ARRAY [0..19] OF BOOLEAN;
  BEGIN
    IF (n <= NUMBER (targs))
      THEN RETURN DoGenCall (proc, args, targs, indirect);
      ELSE RETURN DoGenCall (proc, args,
                             NEW (REF ARRAY OF Temp.T, n)^,
                             NEW (REF ARRAY OF BOOLEAN, n)^);
    END;
  END GenCall;

PROCEDURE DoGenCall (proc     : Expr.T;
                     args     : Expr.List;
                 VAR targs    : ARRAY OF Temp.T;
                 VAR indirect : ARRAY OF BOOLEAN): Temp.T =
  VAR
    e: Expr.T;
    t1, t2, t3, t_obj: Temp.T;
    procType, resultType: Type.T;
    commaNeeded: BOOLEAN;
    formals: Scope.ValueList;
    n: INTEGER;
    procV: Value.T;
    block: INTEGER;
    formal: Formal.Info;
  BEGIN
    commaNeeded := FALSE;
    procType := Expr.TypeOf (proc);
    IF (procType = NIL) OR (procType = Void.T) THEN
      procType := QualifyExpr.MethodType (proc);
    END;
    procType := Type.Base (procType);
    resultType := ProcType.Result (procType);
    IF (resultType = Void.T) THEN resultType := NIL END;

    (* grab the formals list *)
    Scope.ToList (ProcType.Formals (procType), formals, n);
    <* ASSERT NUMBER (args^) = n *>

    (* precompile the procedure value *)
    t1 := QualifyExpr.CompileProc (proc, t_obj);

    (* precompile the arguments *)
    FOR i := 0 TO LAST (args^) DO
      Formal.Split (formals[i], formal);
      indirect [i] := (formal.mode # Formal.Mode.mVALUE);
      IF RequiresClosure (args[i]) THEN
        IF IsExternalProcedure (proc) THEN
          Error.Warn (1, "passing nested procedure to external procedure");
        END;
        t2 := Expr.Compile (args[i]);
        t3 := Temp.AllocEmpty (Closure.T);
        Emit.OpT  ("@.marker = _CLOSURE_MARKER;\n", t3);
	Emit.OpTT ("@.proc = (_PROC) @;\n", t3, t2);
    	Emit.OpT  ("@.arg  = (_ADDRESS) ", t3); 
        IF NOT GenFrame (args[i]) THEN Emit.Op ("_NIL"); END;
    	Emit.Op   (";\n");
	Temp.Free (t2);
	targs[i] := t3;
        indirect[i] := TRUE;
      ELSIF Expr.IsDesignator (args[i]) THEN
        targs[i] := Expr.CompileLValue (args[i]);
      ELSE
        targs[i] := Expr.Compile (args[i]);
        IF indirect [i] AND NOT Temp.IsLValue (targs[i]) THEN
          t2 := Temp.AllocEmpty (Expr.TypeOf (args[i]), TRUE);
          Emit.OpTT ("@ = @;\n", t2, targs[i]); (* BUG should be full assign *)
          Temp.Free (targs[i]);
          targs[i] := t2;
        END;
      END;
    END;

    (* check for an inline expansion *)
    procV := IsInlineProcedure (proc);
    IF (procV # NIL) THEN
      RETURN Procedure.ExpandInline (procV, targs);
    END;

    (* allocate a holder for the result *)
    IF (resultType = NIL)
      THEN t2 := t1; (*DUMMY*)
      ELSE t2 := Temp.AllocEmpty (resultType);
    END;

    IF CouldBeClosure (proc) THEN
      <*ASSERT t_obj = NIL *>

      (* generate a runtime check for a closure value *)

      Frame.PushBlock (block, 1);
      Emit.OpF ("@ _proc", procType);
      Emit.OpT (" = @;\n", t1);  Temp.Free (t1);
        Emit.Op ("if (!_IS_CLOSURE(_proc)) {\001\n");
	  (* proc is not a closure *)
          IF (resultType # NIL) AND (NOT ProcType.LargeResult(resultType))THEN
            Emit.OpT ("@ = ", t2);
          END;
          Emit.Op ("_proc (");
          commaNeeded := FALSE;

          (* generate the arguments *)
          FOR i := 0 TO LAST (args^) DO
            e := args[i];
            IF commaNeeded THEN Emit.Op (", "); END;
            IF (i MOD 8 = 7) THEN Emit.Op ("\n") END;
            IF indirect[i] THEN Emit.Op ("&"); END;
            Emit.OpT ("@", targs[i]);
            commaNeeded := TRUE;
          END;

          (* generate the additional argument for large results *)
          IF ProcType.LargeResult (resultType) THEN
            IF commaNeeded THEN Emit.Op (", "); END;
            Emit.OpT ("&@", t2);
          END;

          Emit.Op  (");\n");
        Emit.Op  ("\002\n} else {\001\n");
	  (* proc is a closure *)
          IF (resultType # NIL) AND (NOT ProcType.LargeResult(resultType))THEN
            Emit.OpT ("@ = ", t2);
          END;
          Emit.OpF ("((@) _CLOSURE_PROC(_proc)) ", procType);
          Emit.Op  ("(_CLOSURE_FRAME(_proc)");
          commaNeeded := TRUE;

          (* generate the arguments *)
          FOR i := 0 TO LAST (args^) DO
            e := args[i];
            IF commaNeeded THEN Emit.Op (", "); END;
            IF (i MOD 8 = 7) THEN Emit.Op ("\n") END;
            IF indirect[i] THEN Emit.Op ("&"); END;
            Emit.OpT ("@", targs[i]);  (* BUG! reused the temporary *)
            commaNeeded := TRUE;
            Temp.Free (targs[i]);
          END;

          (* generate the additional argument for large results *)
          IF ProcType.LargeResult (resultType) THEN
            IF commaNeeded THEN Emit.Op (", "); END;
            Emit.OpT ("&@", t2);
          END;

          Emit.Op  (");\n");
        Emit.Op  ("\002}\n");
      Frame.PopBlock (block);
    ELSE
      (* simple procedure call *)
      IF (resultType # NIL) AND (NOT ProcType.LargeResult (resultType)) THEN
        Emit.OpT ("@ = ", t2);
      END;
      Emit.OpT ("@ (", t1);

      (* add the magic arguments (self object or static link) *)
      commaNeeded := FALSE;
      IF (t_obj # NIL) THEN
        Emit.OpT ("@", t_obj);
        commaNeeded := TRUE;
      ELSIF GenFrame (proc) THEN
        commaNeeded := TRUE;
      END;
      Temp.Free (t1); (* also frees t_obj *)

      (* generate the arguments *)
      FOR i := 0 TO LAST (args^) DO
        e := args[i];
        IF commaNeeded THEN Emit.Op (", "); END;
	IF (i MOD 8 = 7) THEN Emit.Op ("\n") END;
        IF indirect[i] THEN Emit.Op ("&"); END;
        Emit.OpT ("@", targs[i]);
        commaNeeded := TRUE;
        Temp.Free (targs[i]);
      END;

      (* generate the additional argument for large results *)
      IF ProcType.LargeResult (resultType) THEN
        IF commaNeeded THEN Emit.Op (", "); END;
        Emit.OpT ("&@", t2);
      END;

      Emit.Op  (");\n");
    END;

    RETURN t2;
  END DoGenCall;

PROCEDURE CouldBeClosure (proc: Expr.T): BOOLEAN =
  VAR name: String.T;  value: Value.T;
  BEGIN
    RETURN (NamedExpr.Split (proc, name, value))
        AND (Value.ClassOf (value) = Value.Class.Var)
        AND (Variable.HasClosure (value));
  END CouldBeClosure;

PROCEDURE GenFrame (e: Expr.T): BOOLEAN =
  VAR proc: Value.T;
  BEGIN
    IF IsProcedureLiteral (e, proc)
      THEN RETURN Procedure.EmitFrameName (proc);
      ELSE RETURN FALSE;
    END;
  END GenFrame;

PROCEDURE RequiresClosure (e: Expr.T): BOOLEAN =
  VAR proc: Value.T;
  BEGIN
    RETURN IsProcedureLiteral (e, proc) AND Procedure.RequiresClosure (proc);
  END RequiresClosure;

PROCEDURE IsExternalProcedure (e: Expr.T): BOOLEAN =
  VAR proc: Value.T;
  BEGIN
    RETURN IsProcedureLiteral (e, proc) AND Value.IsExternal (proc);
  END IsExternalProcedure;

PROCEDURE IsInlineProcedure (e: Expr.T): Value.T =
  VAR proc: Value.T;
  BEGIN
    IF IsProcedureLiteral (e, proc) AND Procedure.CanBeInlined (proc)
      THEN RETURN proc;
      ELSE RETURN NIL;
    END;
  END IsInlineProcedure;

PROCEDURE IsProcedureLiteral (e: Expr.T;  VAR proc: Value.T): BOOLEAN =
  VAR name: String.T;  v: Value.T;  vc: Value.Class;
  BEGIN
    e := Expr.ConstValue (e);
    IF (e = NIL) THEN RETURN FALSE END;
    IF NOT (NamedExpr.Split (e, name, v)
            OR QualifyExpr.Split (e, v)
            OR ProcExpr.Split (e, v)) THEN RETURN FALSE END;
    vc := Value.ClassOf (v);
    IF (vc = Value.Class.Procedure)
      THEN  proc := Value.Base (v);  RETURN TRUE;
      ELSE  RETURN FALSE;
    END;

    (*******
    RETURN (NamedExpr.Split (e, name, proc)
              OR QualifyExpr.Split (e, proc)
	      OR ProcExpr.Split (e, proc))
          AND (Value.ClassOf (proc) = Value.Class.Procedure);
    *******)
  END IsProcedureLiteral;

PROCEDURE Initialize () =
  BEGIN
    Methods := CallExpr.NewMethodList (0, 99999, FALSE, TRUE, NIL,
                                 TypeOf,
                                 CheckCall,
                                 GenCall,
                                 CallExpr.NoValue,
                                 CallExpr.IsNever, (* writable *)
                                 CallExpr.IsNever  (* designator *));
  END Initialize;

BEGIN
END UserProc.