-- JaMAttributes.mesa
-- Written by John Warnock/Martin Newell, February, 1979.
-- Last changed by Doug Wyatt, February 10, 1981 4:53 PM

DIRECTORY
JaMAttributesDefs,
JaMMasterDefs USING [Object, Stack],
JaMControlDefs USING [GetCurrentFrame, RegisterCommand],
JaMDictionaryDefs USING [Length],
JaMExecDefs USING [JaMError, rangechk, typechk],
JaMFnsDefs USING [PushBoolean, PushInteger],
JaMLiteralDefs USING [IntegerLit, MakeStringObject],
JaMScannerDefs USING [StringToken],
JaMStackDefs USING [CountStk, Exch, Pop, Push],
JaMTypeChkDefs USING [DescIntegerType, DescUserType],
InlineDefs USING [LowHalf],
Real USING [Fix, FixI];

JaMAttributes: PROGRAM
IMPORTS JaMControlDefs,JaMDictionaryDefs,JaMExecDefs,JaMFnsDefs,
JaMLiteralDefs,JaMScannerDefs,JaMStackDefs,JaMTypeChkDefs,
InlineDefs,Real
EXPORTS JaMAttributesDefs =
BEGIN OPEN JaMControlDefs,JaMLiteralDefs,JaMStackDefs,JaMMasterDefs;

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

Length: PUBLIC PROCEDURE =
BEGIN
SLength[GetOpStk[]];
END;

SLength: PUBLIC PROCEDURE [stack: Stack] =
--Does stack: (object) => (length of object)
BEGIN
ob: Object ← Pop[stack];
WITH dob:ob SELECT FROM
StringType=> IntegerLit[dob.Length,stack];
ArrayType=> IntegerLit[dob.Length,stack];
DictType=> BEGIN
dict: DictType Object = dob;
IntegerLit[JaMDictionaryDefs.Length[dict],stack];
END;
StackType=> BEGIN
stk: StackType Object = dob;
IntegerLit[CountStk[stk.StkPtr],stack];
END;
ENDCASE=> IntegerLit[1,stack];
END;

LitType: PUBLIC PROCEDURE =
BEGIN
opstk: Stack ← GetOpStk[];
ob: Object ← Pop[opstk];
JaMFnsDefs.PushBoolean[ob.litflag = lit];
END;

UserType: PUBLIC PROCEDURE =
BEGIN
opstk: Stack ← GetOpStk[];
ob: UserType Object ← JaMTypeChkDefs.DescUserType[Pop[opstk]];
JaMFnsDefs.PushInteger[ob.Type];
END;

Type: PUBLIC PROCEDURE =
BEGIN
opstk: Stack ← GetOpStk[];
ob: Object ← Pop[opstk];
WITH dob:ob SELECT FROM
IntegerType => Push[IntegerOb,opstk];
LongIntegerType => Push[LongIntegerOb,opstk];
RealType => Push[RealOb,opstk];
BooleanType => Push[BooleanOb,opstk];
StringType => Push[StringOb,opstk];
StreamType => Push[StreamOb,opstk];
CommandType => Push[CommandOb,opstk];
DictType => Push[DictOb,opstk];
ArrayType => Push[ArrayOb,opstk];
StackType => Push[StackOb,opstk];
FrameType => Push[FrameOb,opstk];
MarkType => Push[MarkOb,opstk];
UserType => Push[UserOb,opstk];
NullType => Push[NullOb,opstk];
ENDCASE;
END;

IType: PUBLIC PROCEDURE =
BEGIN OPEN JaMFnsDefs;
opstk: Stack ← GetOpStk[];
ob: Object ← Pop[opstk];
WITH dob:ob SELECT FROM
IntegerType => PushInteger[1];
LongIntegerType => PushInteger[2];
RealType => PushInteger[3];
BooleanType => PushInteger[4];
StringType => PushInteger[5];
StreamType => PushInteger[6];
CommandType => PushInteger[7];
DictType => PushInteger[8];
ArrayType => PushInteger[9];
StackType => PushInteger[10];
FrameType => PushInteger[11];
MarkType => PushInteger[12];
UserType => PushInteger[13];
NullType => PushInteger[0];
ENDCASE;
END;

ConvertToLiteral: PUBLIC PROCEDURE =
BEGIN
opstk: Stack ← GetOpStk[];
ob: Object ← Pop[opstk];
ob.litflag ← lit;
Push[ob,opstk];
END;

ConvertToExec: PUBLIC PROCEDURE =
BEGIN
opstk: Stack ← GetOpStk[];
ob: Object ← Pop[opstk];
ob.litflag ← nolit;
Push[ob,opstk];
END;

ConvertToInteger: PUBLIC PROCEDURE =
BEGIN
opstk: Stack ← GetOpStk[];
ob: Object ← Pop[opstk];
iob: IntegerType Object ← [lit,IntegerType[0]];
WITH dob:ob SELECT FROM
IntegerType => Push[ob,opstk];
LongIntegerType => BEGIN
l:LONG INTEGER←dob.LongIntegerVal;
IF l NOT IN [lloweri..lupperi] THEN
{ OPEN JaMExecDefs; ERROR JaMError[rangechk,TRUE] };
iob.IntegerVal ← LOOPHOLE[InlineDefs.LowHalf[l],INTEGER];
Push[iob,opstk];
END;
RealType => BEGIN
r:REAL←dob.RealVal;
IF r NOT IN [rloweri..rupperi] THEN
{ OPEN JaMExecDefs; ERROR JaMError[rangechk,TRUE] };
iob.IntegerVal←Real.FixI[r];
Push[iob,opstk];
END;
StringType => BEGIN
s:StringType Object←dob;
[]←JaMScannerDefs.StringToken[s,opstk];
Exch[opstk];
[]←Pop[opstk];
Push[JaMTypeChkDefs.DescIntegerType[Pop[opstk]],opstk];
END;
ENDCASE => { OPEN JaMExecDefs; ERROR JaMError[typechk,TRUE] };
END;

ConvertToLongInteger: PUBLIC PROCEDURE =
BEGIN
opstk: Stack ← GetOpStk[];
ob: Object ← Pop[opstk];
liob: LongIntegerType Object ← [lit,LongIntegerType[0]];
WITH dob:ob SELECT FROM
IntegerType => BEGIN
i:INTEGER←dob.IntegerVal;
liob.LongIntegerVal←i;
Push[liob,opstk];
END;
LongIntegerType => Push[ob,opstk];
RealType => BEGIN
l:LONG INTEGER;
r:REAL←dob.RealVal;
IF r NOT IN [rlowerl..rupperl] THEN
{ OPEN JaMExecDefs; ERROR JaMError[rangechk,TRUE] };
l←Real.Fix[r];
liob.LongIntegerVal←l;
Push[liob,opstk];
END;
StringType => BEGIN
s:StringType Object←dob;
obj:Object;
[]←JaMScannerDefs.StringToken[s,opstk];
Exch[opstk];
[]←Pop[opstk];
obj←Pop[opstk];
WITH d1ob:obj SELECT FROM
IntegerType => liob.LongIntegerVal ← LONG[d1ob.IntegerVal];
LongIntegerType => liob.LongIntegerVal ← d1ob.LongIntegerVal;
ENDCASE => { OPEN JaMExecDefs; ERROR JaMError[typechk,TRUE] };
Push[liob,opstk];
END;
ENDCASE => { OPEN JaMExecDefs; ERROR JaMError[typechk,TRUE] };
END;

ConvertToReal: PUBLIC PROCEDURE =
BEGIN
opstk: Stack ← GetOpStk[];
ob: Object ← Pop[opstk];
riob: RealType Object ← [lit,RealType[0]];
WITH dob:ob SELECT FROM
IntegerType => BEGIN
i:INTEGER←dob.IntegerVal;
riob.RealVal←i;
Push[riob,opstk];
END;
LongIntegerType => BEGIN
l: LONG INTEGER←dob.LongIntegerVal;
riob.RealVal←l;
Push[riob,opstk];
END;
RealType => Push[ob,opstk];
StringType => BEGIN
s:StringType Object←dob;
obj:Object;
[]←JaMScannerDefs.StringToken[s,opstk];
Exch[opstk];
[]←Pop[opstk];
obj←Pop[opstk];
WITH d1ob:obj SELECT FROM
IntegerType => BEGIN
riob.RealVal ← d1ob.IntegerVal;
Push[riob,opstk];
END;
LongIntegerType => BEGIN
riob.RealVal ← d1ob.LongIntegerVal;
Push[riob,opstk];
END;
RealType => Push[obj,opstk];
ENDCASE => { OPEN JaMExecDefs; ERROR JaMError[typechk,TRUE] };
END;
ENDCASE => { OPEN JaMExecDefs; ERROR JaMError[typechk,TRUE] };
END;

rlowerl: REAL ← -214748364;
rupperl: REAL ← 214748363;
lloweri: LONG INTEGER ← -LONG[32768];
lupperi: LONG INTEGER ← 32767;
rloweri: REAL ← lloweri;
rupperi: REAL ← lupperi;

IntegerOb,LongIntegerOb,RealOb,BooleanOb,StringOb,
StreamOb,CommandOb,DictOb,ArrayOb,StackOb,FrameOb,MarkOb,
UserOb,NullOb: StringType Object;

-- Initialization

STOP;

{ OPEN JaMLiteralDefs;
IntegerOb ← MakeStringObject[".integertype"L];
LongIntegerOb ← MakeStringObject[".longintegertype"L];
RealOb ← MakeStringObject[".realtype"L];
BooleanOb ← MakeStringObject[".booleantype"L];
StringOb ← MakeStringObject[".stringtype"L];
StreamOb ← MakeStringObject[".streamtype"L];
CommandOb ← MakeStringObject[".commandtype"L];
DictOb ← MakeStringObject[".dicttype"L];
ArrayOb ← MakeStringObject[".arraytype"L];
StackOb ← MakeStringObject[".stacktype"L];
FrameOb ← MakeStringObject[".frametype"L];
MarkOb ← MakeStringObject[".marktype"L];
UserOb ← MakeStringObject[".usertype"L];
NullOb ← MakeStringObject[".nulltype"L];
};

{ OPEN JaMControlDefs;
RegisterCommand[".litchk"L,LitType];
RegisterCommand[".usertype"L,UserType];
RegisterCommand[".type"L,Type];
RegisterCommand[".itype"L,IType];
RegisterCommand[".length"L,Length];
RegisterCommand[".cvlit"L,ConvertToLiteral];
RegisterCommand[".cvi"L,ConvertToInteger];
RegisterCommand[".cvli"L,ConvertToLongInteger];
RegisterCommand[".cvr"L,ConvertToReal];
RegisterCommand[".cvx"L,ConvertToExec];
};

END.

DKW March 28, 1980 4:47 PM
added StartAttributes

DKW March 29, 1980 2:49 PM
fixed a bug in the StringType case of ConvertToLongInteger

DKW March 29, 1980 3:08 PM
added GetOpStk, substituted opstk for frame.opstk everywhere

DKW April 1, 1980 3:06 PM
now uses NotifyCommand, NotifyStringObject

DKW August 4, 1980 4:24 PM
added Mesa5RealType (in case an old VM contains Mesa5-style REALs)

DKW February 10, 1981 2:32 PM
eliminated Mesa5RealType
imports errors from JaMExecDefs
initializes after STOP