-- JaMFns.mesa
-- Written by John Warnock
-- Last changed by Doug Wyatt, October 14, 1980  5:54 PM

DIRECTORY
	JaMFnsDefs: FROM "JaMFnsDefs",
	JaMMasterDefs: FROM "JaMMasterDefs" USING [
		Object, Stack],
	JaMControlDefs: FROM "JaMControlDefs" USING [
		GetCurrentFrame, NotifyStringObject,
		RegisterExtCommand, RegisterIntCommand],
	JaMExecDefs: FROM "JaMExecDefs" USING [
		JaMError, GetWakeUp, SetWakeUp],
	JaMIODefs: FROM "JaMIODefs" USING [
		SetMouseXYProc],
	JaMLiteralDefs: FROM "JaMLiteralDefs" USING [
		BooleanLit, IntegerLit, LongIntegerLit, MakeStringObject,
		RealLit, StreamLit, StringLit, UserLit],
	JaMStackDefs: FROM "JaMStackDefs" USING [
		Pop, Push],
	JaMStartDefs: FROM "JaMStartDefs" USING [
		GetJaMStream],
	JaMVMDefs: FROM "JaMVMDefs" USING [
		GetCharVM],
	IODefs: FROM "IODefs" USING [
		LineOverflow],
	StreamDefs: FROM "StreamDefs" USING [
		StreamHandle];

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

Register: PUBLIC PROCEDURE[string:STRING, proc: PROCEDURE] =
	BEGIN
	JaMControlDefs.RegisterExtCommand[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];
			ERROR JaMExecDefs.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];
			ERROR JaMExecDefs.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];
			ERROR JaMExecDefs.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];
			ERROR JaMExecDefs.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];
			ERROR JaMExecDefs.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];
			ERROR JaMExecDefs.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 IODefs.LineOverflow 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 IODefs.LineOverflow[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];
			ERROR JaMExecDefs.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];
			ERROR JaMExecDefs.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];
			ERROR JaMExecDefs.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;

TypeChk: StringType Object;

StartFns: PROCEDURE =
	BEGIN
	JaMControlDefs.NotifyStringObject[@TypeChk, ".typechk"L];
	END;

-- Initialization
StartFns;

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
(600)\889b6B163b8B115b17B135b7B193b9B105b2B104b11B89b10B295b15B98b14B308b14B349b8B83b7B286b7B369b1B1b11B88b11B294b11B163b9B851b10B104b9B308b8B123b7B323b10B84b9B90b12B159b11B82b11B77b7B22b8B