-- JaMAttributes.mesa
-- Written by John Warnock/Martin Newell, February, 1979.
-- Last changed by Doug Wyatt, September 29, 1980 11:46 AM

DIRECTORY
JaMAttributesDefs: FROM "JaMAttributesDefs",
JaMMasterDefs: FROM "JaMMasterDefs" USING [
Object, Stack],
JaMControlDefs: FROM "JaMControlDefs" USING [
GetCurrentFrame, NotifyCommand, NotifyStringObject],
JaMDictionaryDefs: FROM "JaMDictionaryDefs" USING [
Length],
JaMExecDefs: FROM "JaMExecDefs" USING [
JaMError],
JaMFnsDefs: FROM "JaMFnsDefs" USING [
PushBoolean, PushInteger],
JaMLiteralDefs: FROM "JaMLiteralDefs" USING [
IntegerLit],
JaMScannerDefs: FROM "JaMScannerDefs" USING [
StringToken],
JaMStackDefs: FROM "JaMStackDefs" USING [
CountStk, Exch, Pop, Push],
JaMTypeChkDefs: FROM "JaMTypeChkDefs" USING [
DescIntegerType, DescUserType],
InlineDefs: FROM "InlineDefs" USING [
LowHalf],
Real: FROM "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];
Mesa5RealType => Push[Mesa5RealOb,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];
Mesa5RealType => PushInteger[14];
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
ERROR JaMExecDefs.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
ERROR JaMExecDefs.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 => ERROR JaMExecDefs.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
ERROR JaMExecDefs.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 => ERROR JaMExecDefs.JaMError[TypeChk,TRUE];
Push[liob,opstk];
END;
ENDCASE => ERROR JaMExecDefs.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 => ERROR JaMExecDefs.JaMError[TypeChk,TRUE];
END;
ENDCASE => ERROR JaMExecDefs.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,Mesa5RealOb: StringType Object;

RangeChk,TypeChk: StringType Object;

StartAttributes: PROCEDURE =
BEGIN
NotifyStringObject[@IntegerOb, ".integertype"L];
NotifyStringObject[@LongIntegerOb, ".longintegertype"L];
NotifyStringObject[@RealOb, ".realtype"L];
NotifyStringObject[@Mesa5RealOb, ".oldrealtype"L];
NotifyStringObject[@BooleanOb, ".booleantype"L];
NotifyStringObject[@StringOb, ".stringtype"L];
NotifyStringObject[@StreamOb, ".streamtype"L];
NotifyStringObject[@CommandOb, ".commandtype"L];
NotifyStringObject[@DictOb, ".dicttype"L];
NotifyStringObject[@ArrayOb, ".arraytype"L];
NotifyStringObject[@StackOb, ".stacktype"L];
NotifyStringObject[@FrameOb, ".frametype"L];
NotifyStringObject[@MarkOb, ".marktype"L];
NotifyStringObject[@UserOb, ".usertype"L];
NotifyStringObject[@NullOb, ".nulltype"L];

NotifyStringObject[@RangeChk, ".rangechk"L];
NotifyStringObject[@TypeChk, ".typechk"L];

NotifyCommand[".litchk"L,LitType];
NotifyCommand[".usertype"L,UserType];
NotifyCommand[".type"L,Type];
NotifyCommand[".itype"L,IType];
NotifyCommand[".length"L,Length];
NotifyCommand[".cvlit"L,ConvertToLiteral];
NotifyCommand[".cvi"L,ConvertToInteger];
NotifyCommand[".cvli"L,ConvertToLongInteger];
NotifyCommand[".cvr"L,ConvertToReal];
NotifyCommand[".cvx"L,ConvertToExec];
END;

-- Initialization
StartAttributes;

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)