[Indigo]<Cedar5.3>TJaM>JaMTypeImpl.mesa!1

JaMTypeImpl.mesa

Doug Wyatt, 8-Oct-81 0:16:49

Russ Atkinson, July 22, 1983 7:25 pm

DIRECTORY

Basics USING [LowHalf],

JaMBasic USING [Object, ObType],

JaMInternal USING [Frame, Stack],

JaMOps USING

[DictLength, Equality, Error, Install, InstallReason, limitchk, MakeName, NameToString, Pop, Push, PushBoolean, PushInteger, PushReal, rangechk, RegisterExplicit, StringCompare, StringToken, Top, typechk],

Real USING [Fix];

JaMTypeImpl: PROGRAM

IMPORTS JaMOps, Basics, Real

EXPORTS JaMOps = {

OPEN JaMOps, JaMInternal, JaMBasic;

Globals

typeName: ARRAY ObType OF name Object;

Procedures

Length: PUBLIC PROC[ob: Object] RETURNS[CARDINAL] = {

len: CARDINAL ← 1; -- default length is 1

WITH ob:ob SELECT FROM

string => len ← ob.length;

array => len ← ob.length;

dict => len ← DictLength[ob];

name => len ← NameToString[ob].length;

ENDCASE;

RETURN[len];

};

Compare: PUBLIC PROC[a,b: Object] RETURNS[Equality] = {

Checks for equality of values of objects

WITH a:a SELECT FROM

null => WITH b:b SELECT FROM

null => RETURN[T];

ENDCASE;

integer => WITH b:b SELECT FROM

integer => RETURN[IF a.ivalue=b.ivalue THEN T ELSE F];

real => RETURN[IF a.ivalue=b.rvalue THEN T ELSE F];

ENDCASE;

real => WITH b:b SELECT FROM

integer => RETURN[IF a.rvalue=b.ivalue THEN T ELSE F];

real => RETURN[IF a.rvalue=b.rvalue THEN T ELSE F];

ENDCASE;

boolean => WITH b:b SELECT FROM

boolean => RETURN[IF a.bvalue=b.bvalue THEN T ELSE F];

ENDCASE;

name => WITH b:b SELECT FROM

name => RETURN[IF a.id=b.id THEN T ELSE F];

string => RETURN[IF StringMatch[NameToString[a],b] THEN T ELSE F];

ENDCASE;

string => WITH b:b SELECT FROM

name => RETURN[IF StringMatch[a,NameToString[b]] THEN T ELSE F];

string => RETURN[IF StringMatch[a,b] THEN T ELSE F];

ENDCASE;

stream => WITH b:b SELECT FROM

stream => RETURN[IF a.index=b.index AND a.stamp=b.stamp THEN T ELSE F];

ENDCASE;

command => WITH b:b SELECT FROM

command => RETURN[IF a.index=b.index THEN T ELSE F];

ENDCASE;

dict => WITH b:b SELECT FROM

dict => RETURN[IF a.dict=b.dict THEN T ELSE F];

ENDCASE;

array => WITH b:b SELECT FROM

array => RETURN[IF a.length=b.length AND a.base=b.base THEN T ELSE F];

ENDCASE;

mark => WITH b:b SELECT FROM

mark => RETURN[T];

ENDCASE;

user => WITH b:b SELECT FROM

user => RETURN[IF a.data=b.data AND a.stamp=b.stamp THEN T ELSE F];

ENDCASE;

exec => WITH b:b SELECT FROM

exec => RETURN[T];

ENDCASE;

loop => WITH b:b SELECT FROM

loop => RETURN[T];

ENDCASE;

scope => WITH b:b SELECT FROM

scope => RETURN[IF a.top=b.top AND a.id=b.id THEN T ELSE F];

ENDCASE;

RETURN[nil];

};

StringMatch: PROC[a,b: string Object] RETURNS[BOOLEAN] = INLINE {

IF a.length=b.length THEN RETURN[StringCompare[a,b]=0]

ELSE RETURN[FALSE] };

Type-specific stack operations

PopInteger: PUBLIC PROC[stack: Stack] RETURNS[INT] = {

ob: Object ← Pop[stack];

WITH ob:ob SELECT FROM

integer => RETURN[ob.ivalue];

ENDCASE => ERROR Error[typechk] };

PopCardinal: PUBLIC PROC[stack: Stack, limit: CARDINAL ← 0]

RETURNS[CARDINAL] = {

ob: Object ← Pop[stack];

max: CARDINAL ← limit;

IF max=0 THEN max ← LAST[CARDINAL];

WITH ob:ob SELECT FROM

integer => { i: INT ← ob.ivalue;

IF i<0 THEN ERROR Error[rangechk];

IF i>max THEN ERROR Error[IF limit=0 THEN rangechk ELSE limitchk];

RETURN[Basics.LowHalf[i]] };

ENDCASE => ERROR Error[typechk] };

PopReal: PUBLIC PROC[stack: Stack] RETURNS[REAL] = {

ob: Object ← Pop[stack];

WITH ob:ob SELECT FROM

integer => RETURN[ob.ivalue];

real => RETURN[ob.rvalue];

ENDCASE => ERROR Error[typechk] };

PopBoolean: PUBLIC PROC[stack: Stack] RETURNS[BOOLEAN] = {

ob: Object ← Pop[stack];

WITH ob:ob SELECT FROM

boolean => RETURN[ob.bvalue];

ENDCASE => ERROR Error[typechk] };

PopString: PUBLIC PROC[stack: Stack] RETURNS[string Object] = {

ob: Object ← Pop[stack];

WITH ob:ob SELECT FROM

string => RETURN[ob];

ENDCASE => ERROR Error[typechk] };

PopArray: PUBLIC PROC[stack: Stack] RETURNS[array Object] = {

ob: Object ← Pop[stack];

WITH ob:ob SELECT FROM

array => RETURN[ob];

ENDCASE => ERROR Error[typechk] };

PopDict: PUBLIC PROC[stack: Stack] RETURNS[dict Object] = {

ob: Object ← Pop[stack];

WITH ob:ob SELECT FROM

dict => RETURN[ob];

ENDCASE => ERROR Error[typechk] };

PopCommand: PUBLIC PROC[stack: Stack] RETURNS[command Object] = {

ob: Object ← Pop[stack];

WITH ob:ob SELECT FROM

command => RETURN[ob];

ENDCASE => ERROR Error[typechk] };

PopStream: PUBLIC PROC[stack: Stack] RETURNS[stream Object] = {

ob: Object ← Pop[stack];

WITH ob:ob SELECT FROM

stream => RETURN[ob];

ENDCASE => ERROR Error[typechk] };

TopInteger: PUBLIC PROC[stack: Stack] RETURNS[INT] = {

ob: Object ← Top[stack];

WITH ob:ob SELECT FROM

integer => RETURN[ob.ivalue];

ENDCASE => ERROR Error[typechk] };

TopDict: PUBLIC PROC[stack: Stack] RETURNS[dict Object] = {

ob: Object ← Top[stack];

WITH ob:ob SELECT FROM

dict => RETURN[ob];

ENDCASE => ERROR Error[typechk] };

Intrinsics

JLength: PUBLIC PROC[frame: Frame] = {

ob: Object ← Pop[frame.opstk];

PushInteger[frame.opstk,Length[ob]];

};

JLitChk: PUBLIC PROC[frame: Frame] = {

ob: Object ← Pop[frame.opstk];

PushBoolean[frame.opstk,(ob.tag=L)];

};

JType: PUBLIC PROC[frame: Frame] = {

ob: Object ← Pop[frame.opstk];

name: name Object ← typeName[ob.type];

Push[frame.opstk,name];

};

JCvLit: PUBLIC PROC[frame: Frame] = {

ob: Object ← Pop[frame.opstk];

ob.tag ← L; Push[frame.opstk,ob];

};

JCvX: PUBLIC PROC[frame: Frame] = {

ob: Object ← Pop[frame.opstk];

ob.tag ← X; Push[frame.opstk,ob];

};

StringToInteger: PROC[frame: Frame, string: string Object]

RETURNS[INT] = {

found: BOOLEAN; token: Object;

[found: found, token: token] ← StringToken[frame,string];

IF found THEN WITH tok:token SELECT FROM

integer => RETURN[tok.ivalue];

ENDCASE;

ERROR Error[typechk];

};

StringToReal: PROC[frame: Frame, string: string Object]

RETURNS[REAL] = {

found: BOOLEAN; token: Object;

[found: found, token: token] ← StringToken[frame,string];

IF found THEN WITH tok:token SELECT FROM

integer => RETURN[tok.ivalue];

real => RETURN[tok.rvalue];

ENDCASE;

ERROR Error[typechk];

};

JCvI: PUBLIC PROC[frame: Frame] = {

ob: Object ← Pop[frame.opstk];

i: INT;

WITH ob:ob SELECT FROM

integer => i ← ob.ivalue;

real => {

lowest: REAL = FIRST[INT];

highest: REAL = LAST[INT];

IF ob.rvalue IN [lowest..highest]

THEN i ← Real.Fix[ob.rvalue]

ELSE ERROR Error[rangechk];

};

string => i ← StringToInteger[frame,ob];

ENDCASE => ERROR Error[typechk];

PushInteger[frame.opstk,i];

};

JCvR: PUBLIC PROC[frame: Frame] = {

ob: Object ← Pop[frame.opstk];

r: REAL;

WITH ob:ob SELECT FROM

integer => r ← ob.ivalue;

real => r ← ob.rvalue;

string => r ← StringToReal[frame,ob];

ENDCASE => ERROR Error[typechk];

PushReal[frame.opstk,r];

};

Initialization

InstallType: PROC[why: InstallReason, frame: Frame] = { SELECT why FROM

register => {

typeName ← [

null: MakeName[".nulltype"L],

integer: MakeName[".integertype"L],

real: MakeName[".realtype"L],

boolean: MakeName[".booleantype"L],

name: MakeName[".nametype"L],

string: MakeName[".stringtype"L],

stream: MakeName[".streamtype"L],

command: MakeName[".commandtype"L],

dict: MakeName[".dicttype"L],

array: MakeName[".arraytype"L],

mark: MakeName[".marktype"L],

exec: MakeName[".exectype"L],

loop: MakeName[".looptype"L],

scope: MakeName[".scopetype"L]

];

RegisterExplicit[frame, ".length"L, JLength];

RegisterExplicit[frame, ".litchk"L, JLitChk];

RegisterExplicit[frame, ".type"L, JType];

RegisterExplicit[frame, ".cvlit"L, JCvLit];

RegisterExplicit[frame, ".cvi"L, JCvI];

RegisterExplicit[frame, ".cvli"L, JCvI]; -- just in case

RegisterExplicit[frame, ".cvr"L, JCvR];

RegisterExplicit[frame, ".cvx"L, JCvX];

};

ENDCASE;

};

Install[InstallType];

}.