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