package Debug;

/* This package provides a facility for outputting debug messages and doing
   other debug-related activities. The presense of the messages and activities
   can be controlled both at compile time and at run time. There are 10 levels
   of debug: 0 through 9. Level 0 messages/activities will happen if any others
   do. Typically, lower levels are used for less detailed, less bulky output
   and cheaper activities. Higher levels are used when more detail is needed
   or more work is needed.

   All of the debug output procs here will append a newline to their output -
   i.e. they correspond to Fmt/FmtL rather than to Fmt/Fmt. In the unusual
   situations in which that newline is not wanted, the statement forms of debug
   can be used, containing explicit calls to Fmt/Fmt.

   To use these facilities, a using package must "use Fmt" and "use Debug".
   The former is required because the Debug facility uses the Fmt formatting
   facility. Thus, debug output can use any of the formatting capabilities,
   including custom record formatters, that Fmt has. The "use Fmt" is strictly
   only necessary if Debug print procs are used.

   The using package must declare a private package-level uint constant
   "DEBUG_LEVEL". This constant controls which debug statements (including
   their run-time 'if') are present in the code. If DEBUG_LEVEL is 0, then no
   level-specific debug statements are compiled in. If DEBUG_LEVEL is 1, then
   only level 0 debug statements (Debug/P0 and Debug/S0) are compiled in.
   DEBUG_LEVEL must be 10 to compile in all debug statements.

   The using package must also declare a private package-level uint variable
   "DebugLevel". This controls the execution of debug statements at run time.
   If the current value of DebugLevel is 0, then only level 0 statements are
   executed. If the current value is 4, then levels 0 - 4 are executed, etc.
   A value of 9 is sufficient to enable all levels.

   Debug provides both direct output procs (P0 - P9) which are 'ioProcs' which
   use Fmt to format output, as well as construct procs (S0 - S9) which allow
   arbitrary code to be controlled by the level values.

   For example, assume a package has DEBUG_LEVEL defined as 4, then:

	DebugLevel := 2;
	Debug/P2("hello #1");		// This will come out.
	Debug/P3("hello #2");		// This will not come out.
	Debug/P4("hello #3");		// This is not compiled in at all.
	DebugLevel := 3;
	Debug/P3("hello #4");		// This will come out.
	Debug/S3() begin
	    ...
	    /* This will execute. */
	    ...
	end;
	Debug/S4() begin
	    ...
	    /* This will not be compiled in. */
	    ...
	end;

    Implementation note: all of the code in this package executes only at
    compile time. The 'if' statements generated by "startIf" and "finishIf"
    execute at run time if they are compiled in.

    Users may have more complex requirements, such as needing more than one
    debug level within a given package. They may wish to clone and modify this
    package appropriately for use with their project.
 */

use ../Types;
use ../Names;
use ../Package;
use ../Proc;
use ../Exec;
use ../Fmt;


/**************************** Utility Routines *******************************/

/*
 * emitError - emit an error message at compile time.
 */

proc
emitError(Package/PContext_t pctx; uint errorCode)void:
    Package/EmitError(pctx, "Debug", false, errorCode, nil, 0, nil, 0);
corp;

/*
 * checkNames - check for all of the needed names in the package containing
 *	the call to us. If all is well return 'true', else return 'false'.
 */

proc
checkNames(Package/PContext_t pctx; uint level)bool:
    bool allOk := false;
    Names/Table_t tb := pctx.pctx_containingPackage.pk_privates;
    Names/Info_t inf1 := Names/Lookup(tb, "DEBUG_LEVEL");
    if inf1 = nil then
	/* Cannot find "DEBUG_LEVEL" in using package */
	emitError(pctx, 2);
    else
	case inf1.inf_kind
	incase Names/infk_uintConstant:
	    /* This 'if' is the compile-time test against DEBUG_LEVEL. We
	       return 'false' if we do not want to generate any runtime for
	       this call. */
	    if inf1.inf_uintConstant.theUint > level then
		Names/Info_t inf2 := Names/Lookup(tb, "DebugLevel");
		if inf2 = nil then
		    /* Cannot find "DebugLevel" in using package */
		    emitError(pctx, 4);
		else
		    case inf2.inf_kind
		    incase Names/infk_packageVar:
			Package/PackageVarInfo_t pvi :=
			    inf2.inf_packageVar;
			if pvi.pvi_type = Types/Uint then
			    /* Everything checks out. */
			    allOk := true;
			else
			    /* Name "DebugLevel" is not a uint variable */
			    emitError(pctx, 6);
			fi;
		    default:
			/* Name "DebugLevel" is not a package variable */
			emitError(pctx, 5);
		    esac;
		fi;
	    fi;
	default:
	    /* Name "DEBUG_LEVEL" is not a uint constant */
	    emitError(pctx, 3);
	esac;
    fi;
    allOk
corp;

/*
 * startIf - do the first part of the creation of an 'if' construct. This is
 *	simply the 'if' condition. We do not need a scope for the body of the
 *	'if', but we do need a sequence for the debug statement constructs.
 */

proc
startIf(Package/PContext_t pctx; uint level; @ Exec/TempIf_t tif)void:
    Package/NameReference_t nr :=
	Package/CreateReference(pctx, pctx.pctx_containingSubpackage,
				"DebugLevel");
    Exec/Exec_t varRef := Exec/PackageNameRefNew(pctx, nr);
    Exec/TempBinary_t tbin;
    Exec/BinaryStart(@tbin, pctx, varRef, Exec/bo_greaterOrEqual);
    Exec/Exec_t ex := Exec/UintConstantNew(nil, level);
    ex := Exec/BinaryNew(@tbin, ex);
    Exec/IfFirstCondition(tif, pctx, ex);
    Exec/SequenceStart(pctx);
corp;

/*
 * finishIf - the body inside the 'if' has been handled. Close off the sequence
 *	we created for the body and finish off the 'if' construct itself. We
 *	return the Exec_t for the 'if' construct.
 */

proc
finishIf(Package/PContext_t pctx; @ Exec/TempIf_t tif)Exec/Exec_t:
    Exec/IfFirst(tif, Exec/SequenceNew(pctx));
    Exec/IfNew(tif)
corp;


/************************** Code for debug output ****************************/

/*capsule
 *
 * DebugActiveIoCall_t is our implementation of Exec/ActiveIoCall_t which
 *	contains state information for debug output procs. It includes a
 *	Fmt/FmtCookie_t since we use Fmt to do the actual output. This capsule
 *	allows us to interact with the Exec code (and the parser) to process
 *	the various pieces of user's debug statements.
 */

capsule DebugActiveIoCall_t implements Exec/ActiveIoCall_t {
    fields {
	Fmt/FmtCookie_t daiocl_fc;
	Exec/TempIf_t daiocl_tif;	// the 'if' construct we are building
	bool daiocl_noTest;		// output is unconditional
	bool daiocl_doingIf;		// everything is working properly
	bool daiocl_hasError;		// want error on callout returns
    };

    procs Exec/ActiveIoCall_t {
	/*
	 * PhaseHandler - this is our ioProc phase handler which is called by
	 *	the Exec code to give us information about the debug statement.
	 *	If we are allowing code generation, then we just pass the data
	 *	on to the Fmt code. For phase iop_done (the last phase of the
	 *	debug print statement), we use "finishIf" to wrap the generated
	 *	code in an 'if' on "DebugLevel". That 'if' is then appended to
	 *	the statement sequence containing the call to the debug print
	 *	routine.
	 */

	proc
	PhaseHandler(DebugActiveIoCall_t daiocl; Exec/Exec_t ex;
		     Exec/IoPhase_t iop)bool:
	    Fmt/FmtCookie_t fc := daiocl.daiocl_fc;
	    bool hasError := daiocl.daiocl_hasError;
	    if daiocl.daiocl_noTest or daiocl.daiocl_doingIf then
		if iop = Exec/iop_complete then
		    /* Unconditionally append a newline. Here, we are just
		       adding another normal sequence of calls to the Fmt code,
		       inserted before the iop_complete from Exec. There is no
		       Exec_t passed on an iop_complete, so doing this before
		       passing on our parameters to FmtPhaseHandler is not a
		       problem. */
		    Exec/Exec_t nlEx := Exec/CharConstantNew('\n');
		    if Fmt/FmtPhaseHandler(fc, nlEx, Exec/iop_main) or
			Fmt/FmtPhaseHandler(fc, nil, Exec/iop_done)
		    then
			hasError := true;
		    fi;
		fi;
		if Fmt/FmtPhaseHandler(fc, ex, iop) then
		    hasError := true;
		fi;
	    fi;
	    if iop = Exec/iop_complete and daiocl.daiocl_doingIf then
		Package/PContext_t pctx := fc.fc_pctx;
		ex := finishIf(pctx, @daiocl.daiocl_tif);
		Exec/SequenceAppend(pctx, ex);
	    fi;
	    hasError
	corp;

	/*
	 * FormatHandler - this is our ioProc format handler. We simply pass
	 *	the information on to Fmt if we are allowing code generation.
	 */

	proc
	FormatHandler(DebugActiveIoCall_t daiocl; string format)bool:
	    if daiocl.daiocl_noTest or daiocl.daiocl_doingIf then
		if Fmt/FmtFormatHandler(daiocl.daiocl_fc, format) then
		    daiocl.daiocl_hasError := true;
		fi;
	    fi;
	    daiocl.daiocl_hasError
	corp;
    };
};

/*
 * pCommon - common code for setting up the interaction between Exec and the
 *	above debug print handling routines. We build our magic cookie, and
 *	provide our handlers.
 */

proc
pCommon(Package/PContext_t pctx; bool noTest, doingIf; uint level)void:
    bool hasError := false;
    if not Package/FindDirectUse(pctx.pctx_containingPackage, Fmt) then
	/* Package using "Debug" must use "Fmt" */
	emitError(pctx, 1);
	hasError := true;
    fi;
    DebugActiveIoCall_t daiocl :=
	DebugActiveIoCall_t(Fmt/Cookie(pctx), noTest, doingIf, hasError);
    if doingIf then
	startIf(pctx, level, @daiocl.daiocl_tif);
    fi;
    Exec/ProvideIoHandler(pctx, daiocl);
corp;

/*
 * P - this ioProc provides unconditional debug output. It does not depend
 *	on either "DEBUG_LEVEL" or "DebugLevel", and so is equivalent to
 *	using Fmt/FmtL. However, using this routine, which is exported from
 *	package Debug, makes searching for debug calls easier.
 */

export proc ioProc
P(Package/PContext_t pctx)void:
    pCommon(pctx, true, false, 0);
corp;

/*
 * pLevel - common code for all of our level-based debug print calls.
 */

proc
pLevel(Package/PContext_t pctx; uint level)void:
    pCommon(pctx, false, checkNames(pctx, level), level);
corp;

/*
 * P0 - P9 - these are the level-specific debug calls exported to users.
 *	They all just pass the appropriate debug level to pLevel.
 */

export proc ioProc
P0(Package/PContext_t pctx)void:
    pLevel(pctx, 0);
corp;

export proc ioProc
P1(Package/PContext_t pctx)void:
    pLevel(pctx, 1);
corp;

export proc ioProc
P2(Package/PContext_t pctx)void:
    pLevel(pctx, 2);
corp;

export proc ioProc
P3(Package/PContext_t pctx)void:
    pLevel(pctx, 3);
corp;

export proc ioProc
P4(Package/PContext_t pctx)void:
    pLevel(pctx, 4);
corp;

export proc ioProc
P5(Package/PContext_t pctx)void:
    pLevel(pctx, 5);
corp;

export proc ioProc
P6(Package/PContext_t pctx)void:
    pLevel(pctx, 6);
corp;

export proc ioProc
P7(Package/PContext_t pctx)void:
    pLevel(pctx, 7);
corp;

export proc ioProc
P8(Package/PContext_t pctx)void:
    pLevel(pctx, 8);
corp;

export proc ioProc
P9(Package/PContext_t pctx)void:
    pLevel(pctx, 9);
corp;


/************************* Code for debug constructs *************************/

/*capsule
 *
 * DebugActiveConstruct_t is our implementation of Exec/ActiveConstruct_t for
 *	the statement debug constructs we provide. It needs only the temporary
 *	'if' structure to allow creation of the 'if', and a flag indicating
 *	that everything is proceeding correctly.
 */

capsule DebugActiveConstruct_t implements Exec/ActiveConstruct_t {
    fields {
	Exec/TempIf_t dac_tif;		// the 'if' construct we are building
	bool dac_doingIf;		// everything is working properly
    };

    procs Exec/ActiveConstruct_t {
	/*
	 * Complete - handler called by Exec at the end of handling the
	 *	body of this construct. Uses "finishIf" to complete the 'if'
	 *	around the body of the construct. The interface with Exec for
	 *	these is that the Exec_t returned from here replaces the entire
	 *	construct.
	 */

	proc
	Complete(DebugActiveConstruct_t dac; Package/PContext_t pctx;
		 Exec/Exec_t body)Exec/Exec_t:
	    if dac.dac_doingIf then
		Exec/SequenceAppend(pctx, body);
		finishIf(pctx, @dac.dac_tif)
	    else
		Exec/NothingNew()
	    fi
	corp;
    };
};

/*
 * sLevel - common code for all level-based debug statement constructs. Uses
 *	"checkNames" to check for "DEBUG_LEVEL" and "DebugLevel".
 */

proc
sLevel(Package/PContext_t pctx; uint level)void:
    bool doingIf := checkNames(pctx, level);
    DebugActiveConstruct_t dac := DebugActiveConstruct_t(doingIf);
    if doingIf then
	startIf(pctx, level, @dac.dac_tif);
    fi;
    Exec/ProvideCompleter(pctx, dac);
corp;

/*
 * S0 - S9 - level-specific debug statement constructs. These all just call
 *	sLevel with the appropriate level.
 */

export proc construct
S0(Package/PContext_t pctx)void:
    sLevel(pctx, 0);
corp;

export proc construct
S1(Package/PContext_t pctx)void:
    sLevel(pctx, 1);
corp;

export proc construct
S2(Package/PContext_t pctx)void:
    sLevel(pctx, 2);
corp;

export proc construct
S3(Package/PContext_t pctx)void:
    sLevel(pctx, 3);
corp;

export proc construct
S4(Package/PContext_t pctx)void:
    sLevel(pctx, 4);
corp;

export proc construct
S5(Package/PContext_t pctx)void:
    sLevel(pctx, 5);
corp;

export proc construct
S6(Package/PContext_t pctx)void:
    sLevel(pctx, 6);
corp;

export proc construct
S7(Package/PContext_t pctx)void:
    sLevel(pctx, 7);
corp;

export proc construct
S8(Package/PContext_t pctx)void:
    sLevel(pctx, 8);
corp;

export proc construct
S9(Package/PContext_t pctx)void:
    sLevel(pctx, 9);
corp;