-- JaMFns.mesa
-- Written by John Warnock
-- Last changed by Doug Wyatt, February 10, 1981  5:30 PM

DIRECTORY
	JaMFnsDefs,
	JaMMasterDefs USING [Object, Stack],
	JaMControlDefs USING [GetCurrentFrame,
		RegisterCommand, RegisterIntCommand],
	JaMExecDefs USING [JaMError, typechk, GetWakeUp, SetWakeUp],
	JaMIODefs USING [SetMouseXYProc],
	JaMLiteralDefs USING [BooleanLit, IntegerLit, LongIntegerLit,
		MakeStringObject, RealLit, StreamLit, StringLit, UserLit],
	JaMStackDefs USING [Pop, Push],
	JaMStartDefs USING [GetJaMStream],
	JaMVMDefs USING [GetCharVM],
	String USING [StringBoundsFault],
	StreamDefs USING [StreamHandle];

JaMFns: PROGRAM
IMPORTS String,JaMStackDefs,JaMControlDefs,JaMLiteralDefs,
	JaMExecDefs,JaMVMDefs,JaMStartDefs,JaMIODefs
EXPORTS JaMFnsDefs =
BEGIN OPEN JaMMasterDefs;

Register: PUBLIC PROCEDURE[string:STRING, proc: PROCEDURE] =
	BEGIN
	JaMControlDefs.RegisterCommand[string,proc];
	END;

RegisterInternal: PUBLIC PROCEDURE[proc: PROCEDURE]
	RETURNS[co: CommandType Object] =
	BEGIN
	RETURN[JaMControlDefs.RegisterIntCommand[proc]];
	END;

JaMExec: PUBLIC PROCEDURE[s: STRING] =
	BEGIN
	ob: StringType Object _ JaMLiteralDefs.MakeStringObject[s];
	ob.litflag _ nolit;
	JaMStackDefs.Push[ob,JaMControlDefs.GetCurrentFrame[].execstk];
	END;

JaMStream: PUBLIC PROCEDURE RETURNS[StreamDefs.StreamHandle] =
	BEGIN
	RETURN[JaMStartDefs.GetJaMStream[]];
	END;


GetOpStk: PROCEDURE RETURNS[Stack] = INLINE
	BEGIN RETURN[JaMControlDefs.GetCurrentFrame[].opstk] END;

PushInteger: PUBLIC PROCEDURE[i: INTEGER] =
	BEGIN
	JaMLiteralDefs.IntegerLit[i,GetOpStk[]];
	END;

PopInteger: PUBLIC PROCEDURE RETURNS[i: INTEGER] =
	BEGIN
	stack: Stack _ GetOpStk[];
	ob: Object = JaMStackDefs.Pop[stack];
	WITH dob:ob SELECT FROM
		IntegerType => RETURN[dob.IntegerVal];
		ENDCASE =>
			BEGIN
			JaMStackDefs.Push[ob,stack];
			{ OPEN JaMExecDefs; ERROR JaMError[typechk,TRUE] };
			END;
	END;

PushLongInteger: PUBLIC PROCEDURE[l: LONG INTEGER] =
	BEGIN
	JaMLiteralDefs.LongIntegerLit[l,GetOpStk[]];
	END;

PopLongInteger: PUBLIC PROCEDURE RETURNS[l: LONG INTEGER] =
	BEGIN
	stack: Stack _ GetOpStk[];
	ob: Object = JaMStackDefs.Pop[stack];
	WITH dob:ob SELECT FROM
		LongIntegerType => RETURN[dob.LongIntegerVal];
		ENDCASE =>
			BEGIN
			JaMStackDefs.Push[ob,stack];
			{ OPEN JaMExecDefs; ERROR JaMError[typechk,TRUE] };
			END;
	END;

GetLongInteger: PUBLIC PROCEDURE RETURNS[l: LONG INTEGER] =
	BEGIN
	stack: Stack _ GetOpStk[];
	ob: Object = JaMStackDefs.Pop[stack];
	WITH dob:ob SELECT FROM
		IntegerType => l_dob.IntegerVal;
		LongIntegerType => l_dob.LongIntegerVal;
		ENDCASE =>
			BEGIN
			JaMStackDefs.Push[ob,stack];
			{ OPEN JaMExecDefs; ERROR JaMError[typechk,TRUE] };
			END;
	RETURN[l];
	END;

PushReal: PUBLIC PROCEDURE[r: REAL] =
	BEGIN
	JaMLiteralDefs.RealLit[r,GetOpStk[]];
	END;

PopReal: PUBLIC PROCEDURE RETURNS[r: REAL] =
	BEGIN
	stack: Stack _ GetOpStk[];
	ob: Object = JaMStackDefs.Pop[stack];
	WITH dob:ob SELECT FROM
		RealType => RETURN[dob.RealVal];
		ENDCASE =>
			BEGIN
			JaMStackDefs.Push[ob,stack];
			{ OPEN JaMExecDefs; ERROR JaMError[typechk,TRUE] };
			END;
	END;

GetReal: PUBLIC PROCEDURE RETURNS[r: REAL] = 
	BEGIN
	stack: Stack _ GetOpStk[];
	ob: Object _ JaMStackDefs.Pop[stack];
	WITH dob:ob SELECT FROM
		IntegerType => r_dob.IntegerVal;
		LongIntegerType => r_dob.LongIntegerVal;
		RealType => r_dob.RealVal;
		ENDCASE =>
			BEGIN
			JaMStackDefs.Push[ob,stack];
			{ OPEN JaMExecDefs; ERROR JaMError[typechk,TRUE] };
			END;
	RETURN[r];
	END;

PushBoolean: PUBLIC PROCEDURE[b: BOOLEAN] =
	BEGIN
	JaMLiteralDefs.BooleanLit[b,GetOpStk[]];
	END;

PopBoolean: PUBLIC PROCEDURE RETURNS[b: BOOLEAN] =
	BEGIN
	stack: Stack _ GetOpStk[];
	ob: Object = JaMStackDefs.Pop[stack];
	WITH dob:ob SELECT FROM
		BooleanType => RETURN[dob.BooleanVal];
		ENDCASE =>
			BEGIN
			JaMStackDefs.Push[ob,stack];
			{ OPEN JaMExecDefs; ERROR JaMError[typechk,TRUE] };
			END;
	END;

PushString: PUBLIC PROCEDURE[s: STRING] =
	BEGIN
	empty: STRING_[0];
	IF s=NIL THEN s_empty; -- treat NIL as an empty string
	JaMLiteralDefs.StringLit[s,GetOpStk[]];
	END;

PopString: PUBLIC PROCEDURE[s: STRING] =
-- Note different calling sequence: user supplies string.
-- Generates String.StringBoundsFault if s too small (or NIL), and
-- expects another string into which it can continue putting chars.
-- This other string can be the same one, emptied, or a new bigger one
--	into which the old string has been copied, or whatever.
	BEGIN
	stack: Stack _ GetOpStk[];
	ob: Object = JaMStackDefs.Pop[stack];
	WITH dob:ob SELECT FROM
		StringType =>
			BEGIN
			i: CARDINAL;
			FOR i IN [0..dob.Length)
				DO
				UNTIL s#NIL AND s.length<s.maxlength
					DO s _ SIGNAL String.StringBoundsFault[s] ENDLOOP;
				s[s.length] _ JaMVMDefs.GetCharVM[dob.Address, dob.Offset,i];
				s.length _ s.length + 1;
				ENDLOOP;
			END;
		ENDCASE =>
			BEGIN
			JaMStackDefs.Push[ob,stack];
			{ OPEN JaMExecDefs; ERROR JaMError[typechk,TRUE] };
			END;
	END;

PushStream: PUBLIC PROCEDURE[s: StreamDefs.StreamHandle] =
	BEGIN
	JaMLiteralDefs.StreamLit[s,GetOpStk[]];
	END;

PopStream: PUBLIC PROCEDURE RETURNS[s: StreamDefs.StreamHandle] =
	BEGIN
	stack: Stack _ GetOpStk[];
	ob: Object = JaMStackDefs.Pop[stack];
	WITH dob:ob SELECT FROM
		StreamType => RETURN[dob.SHandle];
		ENDCASE =>
			BEGIN
			JaMStackDefs.Push[ob,stack];
			{ OPEN JaMExecDefs; ERROR JaMError[typechk,TRUE] };
			END;
	END;


PushUser: PUBLIC PROCEDURE[type: INTEGER, address: LONG POINTER] =
	BEGIN
	JaMLiteralDefs.UserLit[type,address,GetOpStk[]];
	END;

PopUser: PUBLIC PROCEDURE RETURNS[type: INTEGER, address:LONG POINTER] =
	BEGIN
	stack: Stack _ GetOpStk[];
	ob: Object = JaMStackDefs.Pop[stack];
	WITH dob:ob SELECT FROM
		UserType => RETURN[dob.Type,dob.Address];
		ENDCASE =>
			BEGIN
			JaMStackDefs.Push[ob,stack];
			{ OPEN JaMExecDefs; ERROR JaMError[typechk,TRUE] };
			END;
	END;

PushObject: PUBLIC PROCEDURE[obj: Object] =
	BEGIN
	JaMStackDefs.Push[obj,GetOpStk[]];
	END;

PopObject: PUBLIC PROCEDURE RETURNS[Object] =
	BEGIN
	RETURN[JaMStackDefs.Pop[GetOpStk[]]];
	END;

SetMouseProc: PUBLIC PROCEDURE[stream: StreamDefs.StreamHandle,
	mouseXYProc: PROCEDURE[CARDINAL,CARDINAL]] =
	BEGIN
	JaMIODefs.SetMouseXYProc[stream,mouseXYProc];
	END;

GetJaMBreak: PUBLIC PROCEDURE RETURNS[BOOLEAN] =
	BEGIN RETURN[JaMExecDefs.GetWakeUp[]] END;
SetJaMBreak: PUBLIC PROCEDURE[flag: BOOLEAN] =
	BEGIN JaMExecDefs.SetWakeUp[flag] END;


-- Initialization
STOP;

END.

DKW  March 25, 1980  3:28 PM
	added SetMouseProc
DKW  March 28, 1980  4:38 PM
	added StartFns
DKW  April 1, 1980  4:18 PM
	now uses NotifyStringObject
	Register calls RegisterExtCommand
DKW  July 25, 1980  4:51 PM
	added GetLongInteger
DKW  September 30, 1980  5:41 PM
	added GetJaMBreak, SetJaMBreak
DKW  October 14, 1980  5:54 PM
	PushString and PopString now handle NIL better
DKW  February 10, 1981  5:29 PM
	imports errors from JaMExecDefs; initializes after STOP
(670)