-- 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