-- 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)(600)\920b13B340b6B58b7B488b7B132b8B162b4B692b5B626b16B126b13B128b16B877b20B1001b13B