-- BasicFunction.mesa
-- edited by Brotz and Hilton, August 11, 1982 1:10 PM

DIRECTORY
BasicDefs,
BasicImpDefs,
Inline,
IODefs,
Real,
RealFns,
RealOps,
Storage,
String;

BasicFunction: PROGRAM
IMPORTS BasicDefs, BasicImpDefs, Inline, IODefs, Real, RealFns, RealOps, Storage, String
EXPORTS BasicImpDefs =

BEGIN
OPEN BasicDefs, BasicImpDefs;

pi: REAL ← Real.StringToReal["3.14159265359"];


InitBuiltInFunctionRegistry: PUBLIC PROCEDURE =
BEGIN
RegisterBuiltInFunction["ABS"L, AbsFunction];
RegisterBuiltInFunction["ACS"L, Arcosine];
RegisterBuiltInFunction["ASN"L, Arcsine];
RegisterBuiltInFunction["ATN"L, Arctangent];
RegisterBuiltInFunction["ATN2"L, ArctangentYX];
RegisterBuiltInFunction["CEIL"L, CeilFunction];
RegisterBuiltInFunction["CHR$"L, CharStringFunction];
RegisterBuiltInFunction["COS"L, Cosine];
RegisterBuiltInFunction["COT"L, Cotangent];
RegisterBuiltInFunction["CSC"L, Cosecant];
RegisterBuiltInFunction["DTR"L, DegToRadian];
RegisterBuiltInFunction["ESP"L, Epsilon];
RegisterBuiltInFunction["EXP"L, Exponential];
RegisterBuiltInFunction["FLOOR"L, GreatestIntLE];
RegisterBuiltInFunction["FP"L, FractionalPart];
RegisterBuiltInFunction["IP"L, IntegerPart];
RegisterBuiltInFunction["INT"L, GreatestIntLE];
RegisterBuiltInFunction["LEN"L, LengthOfString];
RegisterBuiltInFunction["LGT"L, LogBaseTen];
RegisterBuiltInFunction["LOG"L, Ln];
RegisterBuiltInFunction["MAX"L, Maximum];
RegisterBuiltInFunction["MIN"L, Minimum];
RegisterBuiltInFunction["NUM"L, NumFunction];
RegisterBuiltInFunction["PI"L, PiFunction];
RegisterBuiltInFunction["POS"L, PosFunction];
RegisterBuiltInFunction["RTD"L, RadToDegree];
RegisterBuiltInFunction["RMD"L, Remainder];
RegisterBuiltInFunction["SEC"L, Secant];
RegisterBuiltInFunction["SGN"L, SignFunction];
RegisterBuiltInFunction["SIN"L, Sine];
RegisterBuiltInFunction["SQR"L, SquareRoot];
RegisterBuiltInFunction["TAN"L, Tangent];
RegisterBuiltInFunction["UPC$"L, UpperCase];
RegisterBuiltInFunction["VAL"L, ValFunction];
RegisterBuiltInFunction["VAL$"L, ValStringFunction];
END; -- of InitBuiltInFunctionRegistry --


AbsFunction: PROCEDURE [in1, in2: BasicValue] RETURNS [out: BasicValue] =
BEGIN
value: REAL;
IF in2.type = string THEN Storage.FreeString[in2.stringValue];
SELECT in1.type FROM
real => value ← in1.realValue;
integer => value ← RealOps.Float[in1.integerValue];
ENDCASE =>
BEGIN
Storage.FreeString[in1.stringValue];
RunTimeError["ABS cannot accept a string argument"L];
END;
IF RealOps.FComp[value,0] > -1 THEN out ← BasicValue[real, real[realValue: value]]
ELSE out ← BasicValue[real, real[realValue: RealOps.FMul[value,-1]]];
END; -- of AbsFunction --


Arcosine: PROCEDURE [in1, in2: BasicValue] RETURNS [out: BasicValue] =
-- Cosine = x/sqrt(x↑2 + y↑2) = c. x/y = c/sqrt(1 - c↑2).
BEGIN
negative: BOOLEAN ← FALSE;
radBV, value: BasicValue;
radSqrd, numer, tan, radian, arcosine, absValue: REAL;
IF in2.type = string THEN Storage.FreeString[in2.stringValue];
SELECT in1.type FROM
real => radian ← in1.realValue;
integer => radian ← RealOps.Float[in1.integerValue];
ENDCASE => BEGIN
Storage.FreeString[in1.stringValue];
RunTimeError["ASN function cannot accept a string argument."L];
END;
IF RealOps.FComp[radian,0] < 0 THEN
{absValue ← RealOps.FMul[radian,-1]; negative ← TRUE}
ELSE absValue ← radian;
IF RealOps.FComp[absValue, .5] <= 0 THEN
BEGIN
radBV ← BasicValue[real, real[realValue: radian]];
value ← Arcsine[radBV, BasicValueZero];
SELECT value.type FROM
real => SELECT trigMode FROM
radians => arcosine ← RealOps.FSub[1.570796327, value.realValue];
degrees => arcosine ← RealOps.FSub[90.0, value.realValue];
ENDCASE => IODefs.WriteLine["GRAD mode not implemented yet."L];
integer => RETURN[BasicValueZero];
ENDCASE;
END
ELSE BEGIN
radSqrd ← RealFns.Power[absValue, 2.0];
numer ← RealFns.SqRt[RealOps.FSub[1.0, radSqrd]];
tan ← RealOps.FDiv[numer, radian];
SELECT trigMode FROM
radians => BEGIN
arcosine ← RealFns.ArcTan[tan, 1.0];
IF negative THEN arcosine ← RealOps.FAdd[3.14159265, arcosine];
END;
degrees => BEGIN
arcosine ← RealFns.ArcTanDeg[tan, 1.0];
IF negative THEN arcosine ← RealOps.FAdd[180.0, arcosine];
END;
ENDCASE => IODefs.WriteLine["GRAD mode not implemented yet."L];
END;
out ← BasicValue[real, real[realValue: arcosine]];
END; -- of Arcosine --


Arcsine: PROCEDURE [in1, in2: BasicValue] RETURNS [out: BasicValue] =
BEGIN
radBV, value: BasicValue;
radSqrd, denom, tan, radian, arcsine, absValue: REAL;
IF in2.type = string THEN Storage.FreeString[in2.stringValue];
SELECT in1.type FROM
real => radian ← in1.realValue;
integer => radian ← RealOps.Float[in1.integerValue];
ENDCASE =>
BEGIN
Storage.FreeString[in1.stringValue];
RunTimeError["ASN function cannot accept a string argument."L];
END;
IF RealOps.FComp[radian,0] < 0 THEN absValue ← RealOps.FMul[radian,-1]
ELSE absValue ← radian;
IF RealOps.FComp[absValue, .5] = 1 THEN
BEGIN
radBV ← BasicValue[real, real[realValue: radian]];
value ← Arcosine[radBV, BasicValueZero];
SELECT value.type FROM
real => SELECT trigMode FROM
radians => arcsine ← RealOps.FSub[1.570796327, value.realValue];
degrees => arcsine ← RealOps.FSub[90.0, value.realValue];
ENDCASE => IODefs.WriteLine["GRAD mode not implemented yet."L];
integer => RETURN[BasicValueZero];
ENDCASE;
END
ELSE BEGIN
radSqrd ← RealFns.Power[absValue, 2.0];
denom ← RealFns.SqRt[RealOps.FSub[1.0, radSqrd]];
tan ← RealOps.FDiv[radian, denom];
SELECT trigMode FROM
radians => arcsine ← RealFns.ArcTan[tan, 1.0];
degrees => arcsine ← RealFns.ArcTanDeg[tan, 1.0];
ENDCASE => IODefs.WriteLine["GRAD mode not implemented yet."L];
END;
out ← BasicValue[real, real[realValue: arcsine]];
END; -- of Arcsine --


Arctangent: PROCEDURE [in1, in2: BasicValue] RETURNS [out: BasicValue] =
BEGIN
y: REAL;
IF in2.type = string THEN Storage.FreeString[in2.stringValue];
SELECT in1.type FROM
real => y ← in1.realValue;
integer => y ← RealOps.Float[in1.integerValue];
ENDCASE =>
BEGIN
Storage.FreeString[in2.stringValue];
RunTimeError["ATN function cannot accept a string argument."L];
END;
SELECT trigMode FROM
radians => out ← BasicValue[real, real[realValue: RealFns.ArcTan[y, 1.0]]];
degrees => out ← BasicValue[real, real[realValue: RealFns.ArcTanDeg[y, 1.0]]];
ENDCASE => IODefs.WriteLine["GRAD mode not implemented yet."L];
END; -- of Arctangent --


ArctangentYX: PROCEDURE [in1, in2: BasicValue] RETURNS [out: BasicValue] =
BEGIN
x, y: REAL;
out ← BasicValueZero;
SELECT in1.type FROM
real => y ← in1.realValue;
integer => y ← RealOps.Float[in1.integerValue];
ENDCASE =>
BEGIN
Storage.FreeString[in1.stringValue];
IF in2.type = string THEN Storage.FreeString[in2.stringValue];
RunTimeError["ATN cannot accept a string argument."L];
END;
SELECT in2.type FROM
real => x ← in2.realValue;
integer => x ← RealOps.Float[in2.integerValue];
ENDCASE =>
BEGIN
Storage.FreeString[in2.stringValue];
RunTimeError["ATN cannot accept a string argument."L];
END;
SELECT trigMode FROM
radians => out ← BasicValue[real, real[realValue: RealFns.ArcTan[y, x]]];
degrees => out ← BasicValue[real, real[realValue: RealFns.ArcTanDeg[y, x]]];
ENDCASE => IODefs.WriteLine["GRAD mode not implemented yet."L];
END; -- of ArctangentYX --


CeilFunction: PROCEDURE [in1, in2: BasicValue] RETURNS [out: BasicValue] =
BEGIN
int: REAL;
IF in2.type = string THEN Storage.FreeString[in2.stringValue];
SELECT in1.type FROM
real => int ← in1.realValue;
integer => RETURN[in1];
ENDCASE =>
BEGIN
Storage.FreeString[in2.stringValue];
RunTimeError["CEIL function cannot accept string arguments."L];
END;
out ← BasicValue[integer, integer[integerValue: RealOps.RoundLI[RealOps.FAdd[int,0.5]]]];
END; -- of CeilFunction --


CharStringFunction: PROCEDURE [in1, in2: BasicValue] RETURNS [out: BasicValue] =
BEGIN
char: CHARACTER;
charString: STRING;
num: LONG INTEGER;
IF in2.type = string THEN Storage.FreeString[in2.stringValue];
SELECT in1.type FROM
real => num ← RealOps.RoundI[in1.realValue];
integer => num ← in1.integerValue;
ENDCASE =>
BEGIN
Storage.FreeString[in1.stringValue];
RunTimeError["CHR$ function accepts numeric arguments only."L];
END;
char ← LOOPHOLE[Inline.LowHalf[num] MOD 128];
charString ← Storage.String[1];
String.AppendChar[charString, char];
out ← BasicValue[string, string[stringValue: charString]];
END; -- of CharStringFunction --


Cosine: PROCEDURE [in1, in2: BasicValue] RETURNS [out: BasicValue] =
BEGIN
angle: REAL;
IF in2.type = string THEN Storage.FreeString[in2.stringValue];
out ← BasicValueZero;
SELECT in1.type FROM
real => angle ← in1.realValue;
integer => angle ← RealOps.Float[in1.integerValue];
ENDCASE =>
BEGIN
Storage.FreeString[in1.stringValue];
RunTimeError["COS cannot accept a string argument."L];
END;
SELECT trigMode FROM
radians => out ← BasicValue[real, real[realValue: RealFns.Cos[angle]]];
degrees => out ← BasicValue[real, real[realValue: RealFns.CosDeg[angle]]];
ENDCASE => IODefs.WriteLine["GRAD mode not implemented yet."L];
END; -- of Cosine --


Cotangent: PROCEDURE [in1, in2: BasicValue] RETURNS [out: BasicValue] =
BEGIN
tanValue: BasicValue ← Tangent[in1, in2];
out ← BasicValueZero;
IF tanValue.type = real THEN
out ← BasicValue[real, real[realValue:
RealOps.FDiv[1.0, tanValue.realValue]]]
ELSE RunTimeError["COT: error in argument type."L];
END; -- of Cotangent --


Cosecant: PROCEDURE [in1, in2: BasicValue] RETURNS [out: BasicValue] =
BEGIN
sineValue: BasicValue ← Sine[in1, in2];
out ← BasicValueZero;
IF sineValue.type = real THEN
out ← BasicValue[real, real[realValue:
RealOps.FDiv[1.0, sineValue.realValue]]]
ELSE RunTimeError["CSC: error in argument type."L];
END; -- of Cosecant --


DegToRadian: PROCEDURE [in1, in2: BasicValue] RETURNS [out: BasicValue] =
BEGIN
degrees: REAL;
IF in2.type = string THEN Storage.FreeString[in2.stringValue];
SELECT in1.type FROM
real => degrees ← in1.realValue;
integer => degrees ← RealOps.Float[in1.integerValue];
ENDCASE =>
BEGIN
Storage.FreeString[in1.stringValue];
RunTimeError["DTR cannot accept a string argument."L];
END;
out ← BasicValue[real, real[realValue: RealOps.FMul
[degrees, RealOps.FDiv[3.14159265, 180.0]]]];
END; -- of DegToRadian --


Epsilon: PROCEDURE [in1, in2: BasicValue] RETURNS [out: BasicValue] =
-- a constant --
BEGIN
IF in1.type = string OR in2.type = string THEN
BEGIN
IF in1.type = string THEN Storage.FreeString[in1.stringValue];
IF in2.type = string THEN Storage.FreeString[in2.stringValue];
RunTimeError["EPS does not take parameters."L];
END
ELSE out ← BasicValue[real, real[realValue: .0099]];
END; -- of Epsilon --


Exponential: PROCEDURE [in1, in2: BasicValue] RETURNS [out: BasicValue] =
BEGIN
exp: REAL;
IF in2.type = string THEN Storage.FreeString[in2.stringValue];
SELECT in1.type FROM
real => exp ← in1.realValue;
integer => exp ← RealOps.Float[in1.integerValue];
ENDCASE =>
BEGIN
Storage.FreeString[in1.stringValue];
RunTimeError["EXP cannot accept a string argument."L];
END;
out ← BasicValue[real, real[realValue: RealFns.Exp[exp]]];
END; -- of Exponential --


FractionalPart: PROCEDURE [in1, in2: BasicValue] RETURNS [out: BasicValue] =
BEGIN
intPart: LONG INTEGER;
fracPart: REAL;
IF in2.type = string THEN Storage.FreeString[in2.stringValue];
SELECT in1.type FROM
real => intPart ← RealOps.RoundLI[RealOps.FSub[in1.realValue, 0.5]];
integer => RETURN[BasicValueZero];
ENDCASE =>
BEGIN
Storage.FreeString[in1.stringValue];
RunTimeError["FP does not take a string argument."L];
END;
fracPart ← RealOps.FSub[in1.realValue, RealOps.Float[intPart]];
out ← BasicValue[real, real[realValue: fracPart]];
END; -- of FractionalPart --


GreatestIntLE: PROCEDURE [in1, in2: BasicValue] RETURNS [out: BasicValue] =
BEGIN
int: REAL;
IF in2.type = string THEN Storage.FreeString[in2.stringValue];
SELECT in1.type FROM
real => int ← in1.realValue;
integer => RETURN[in1];
ENDCASE =>
BEGIN
Storage.FreeString[in2.stringValue];
RunTimeError["CEIL function cannot accept string arguments."L];
END;
out ← BasicValue[integer, integer[integerValue: RealOps.RoundLI[RealOps.FSub[int, 0.5]]]];
END; -- of GreatestIntLE --


IntegerPart: PROCEDURE [in1, in2: BasicValue] RETURNS [out: BasicValue] =
BEGIN
int: REAL;
IF in2.type = string THEN Storage.FreeString[in2.stringValue];
SELECT in1.type FROM
real => int ← in1.realValue;
integer => RETURN[in1];
ENDCASE =>
BEGIN
Storage.FreeString[in1.stringValue];
RunTimeError["IP cannot accept a string argument."L];
END;
IF RealOps.FComp[int, 0] < 0 THEN -- it is a negative number --
out ← BasicValue[integer, integer[integerValue: RealOps.RoundLI[RealOps.FAdd[int, 0.5]]]]
ELSE out ← BasicValue[integer, integer[integerValue: RealOps.RoundLI[
RealOps.FSub[int, 0.5]]]];
END; -- of IntegerPart --


LengthOfString: PROCEDURE [in1, in2: BasicValue] RETURNS [out: BasicValue] =
BEGIN
IF in2.type = string THEN Storage.FreeString[in2.stringValue];
IF in1.type = string THEN
BEGIN
out ← BasicValue[integer, integer[integerValue: in1.stringValue.length]];
Storage.FreeString[in1.stringValue];
END
ELSE RunTimeError["LEN cannot accept a numeric argument."L];
END; -- of LengthOfString --


LogBaseTen: PROCEDURE [in1, in2: BasicValue] RETURNS [out: BasicValue] =
BEGIN
base: REAL;
IF in2.type = string THEN Storage.FreeString[in2.stringValue];
SELECT in1.type FROM
real => base ← in1.realValue;
integer => base ← RealOps.Float[in1.integerValue];
ENDCASE =>
BEGIN
Storage.FreeString[in1.stringValue];
RunTimeError["LGT cannot accept a string argument."L];
END;
out ← BasicValue[real, real[realValue: RealFns.Log[base, 10.0]]];
END; -- of LogBaseTen --


Ln: PROCEDURE [in1, in2: BasicValue] RETURNS [out: BasicValue] =
BEGIN
base: REAL;
IF in2.type = string THEN Storage.FreeString[in2.stringValue];
SELECT in1.type FROM
real => base ← in1.realValue;
integer => base ← RealOps.Float[in1.integerValue];
ENDCASE =>
BEGIN
Storage.FreeString[in1.stringValue];
ParseError["LN cannot accept a string argument."L];
END;
out ← BasicValue[real, real[realValue: RealFns.Ln[base]]];
END; -- of Ln --


Maximum: PROCEDURE [in1, in2: BasicValue] RETURNS [out: BasicValue] =
BEGIN
x, y: REAL;
SELECT in1.type FROM
real => x ← in1.realValue;
integer => x ← RealOps.Float[in1.integerValue];
ENDCASE =>
BEGIN
Storage.FreeString[in1.stringValue];
IF in2.type = string THEN Storage.FreeString[in2.stringValue];
RunTimeError["MAX cannot accept a string argument."L];
END;
SELECT in2.type FROM
real => y ← in2.realValue;
integer => y ← RealOps.Float[in2.integerValue];
ENDCASE =>
BEGIN
Storage.FreeString[in2.stringValue];
RunTimeError["MAX cannot accept a string argument."L];
END;
out ← BasicValue[real, real[realValue: IF RealOps.FComp[x, y] = 1 THEN x ELSE y]]
END; -- of Maximum --


Minimum: PROCEDURE [in1, in2: BasicValue] RETURNS [out: BasicValue] =
BEGIN
x, y: REAL;
SELECT in1.type FROM
real => x ← in1.realValue;
integer => x ← RealOps.Float[in1.integerValue];
ENDCASE =>
BEGIN
Storage.FreeString[in1.stringValue];
IF in2.type = string THEN Storage.FreeString[in2.stringValue];
RunTimeError["MIN cannot accept a string argument."L];
END;
SELECT in2.type FROM
real => y ← in2.realValue;
integer => y ← RealOps.Float[in2.integerValue];
ENDCASE =>
BEGIN
Storage.FreeString[in2.stringValue];
RunTimeError["MIN cannot accept a string argument."L];
END;
out ← BasicValue[real, real[realValue: IF RealOps.FComp[x, y] = -1 THEN x ELSE y]]
END; -- of Minimum --


NumFunction: PROCEDURE [in1, in2: BasicValue] RETURNS [out: BasicValue] =
BEGIN
i: CARDINAL ← 0;
charCode: INTEGER;
IF in2.type = string THEN Storage.FreeString[in2.stringValue];
IF in1.type # string THEN RunTimeError["NUM function accepts string arguments only."L];
IF in1.stringValue.length = 0 THEN
BEGIN
Storage.FreeString[in1.stringValue];
RunTimeError["NUM of zero-length string."L];
END;
charCode ← LOOPHOLE[in1.stringValue[0]];
Storage.FreeString[in1.stringValue];
out ← BasicValue[integer, integer[integerValue: charCode]];
END; -- of NumFunction --


PiFunction: PROCEDURE [in1, in2: BasicValue] RETURNS [out: BasicValue] =
BEGIN
out ← BasicValue[real, real[realValue: pi]];
END; -- of PiFunction --


PosFunction: PROCEDURE [in1, in2: BasicValue] RETURNS [out: BasicValue] =
BEGIN
i, j, savedIndex: CARDINAL ← 0;
textString: STRING ← [40];
IF in1.type # string OR in2.type # string THEN
BEGIN
IF in1.type = string THEN Storage.FreeString[in1.stringValue];
IF in2.type = string THEN Storage.FreeString[in2.stringValue];
RunTimeError["POS accepts string arguments only."L];
END;
IF in2.stringValue.length > in1.stringValue.length THEN
BEGIN
Storage.FreeString[in1.stringValue];
Storage.FreeString[in2.stringValue];
RETURN[BasicValueZero];
END;
UNTIL i > in1.stringValue.length DO
savedIndex ← i;
IF String.LowerCase[in1.stringValue[i]] =
String.LowerCase[in2.stringValue[0]] THEN
BEGIN
FOR j ← 1, j+1
UNTIL j > in2.stringValue.length OR i > in1.stringValue.length DO
String.AppendChar[textString, in1.stringValue[i]];
i ← i+1;
ENDLOOP;
IF j > in2.stringValue.length THEN
BEGIN
IF String.EquivalentString[textString, in2.stringValue] THEN
BEGIN
Storage.FreeString[in1.stringValue];
Storage.FreeString[in2.stringValue];
RETURN[BasicValue[integer, integer[integerValue: savedIndex + 1]]];
END;
END
ELSE BEGIN
Storage.FreeString[in1.stringValue];
Storage.FreeString[in2.stringValue];
RETURN[BasicValueZero];
END;
textString.length ← 0;
i ← savedIndex;
END;
i ← i+1;
ENDLOOP;
Storage.FreeString[in1.stringValue];
Storage.FreeString[in2.stringValue];
out ← BasicValueZero;
END; -- of PosFunction --


Random: PROCEDURE [in1, in2: BasicValue] RETURNS [out: BasicValue] =
BEGIN
RunTimeError["RANDOM not yet implemented."L];
END; -- of Random --


RadToDegree: PROCEDURE [in1, in2: BasicValue] RETURNS [out: BasicValue] =
BEGIN
radians: REAL;
IF in2.type = string THEN Storage.FreeString[in2.stringValue];
SELECT in1.type FROM
real => radians ← in1.realValue;
integer => radians ← RealOps.Float[in1.integerValue];
ENDCASE =>
BEGIN
Storage.FreeString[in1.stringValue];
RunTimeError["RTD cannot accept a string argument."L];
END;
out ← BasicValue[real, real[realValue: RealOps.FMul[radians, RealOps.FDiv[180.0, 3.141593]]]];
END; -- of RadToDegree --


Remainder: PROCEDURE [in1, in2: BasicValue] RETURNS [out: BasicValue] =
BEGIN
quotient, intPart, x, y: REAL;
int: LONG INTEGER;
SELECT in1.type FROM
real => x ← in1.realValue;
integer => x ← RealOps.Float[in1.integerValue];
ENDCASE =>
BEGIN
Storage.FreeString[in1.stringValue];
IF in2.type = string THEN Storage.FreeString[in2.stringValue];
RunTimeError["RMD cannot accept a string argument."L];
END;
SELECT in2.type FROM
real => y ← in2.realValue;
integer => y ← RealOps.Float[in2.integerValue];
ENDCASE =>
BEGIN
Storage.FreeString[in2.stringValue];
RunTimeError["RMD cannot accept a string argument."L];
END;
IF RealOps.FComp[y, 0] = 0 THEN RunTimeError["Division by zero not permitted."L];
quotient ← RealOps.FDiv[x, y];
int ← RealOps.RoundLI[RealOps.FSub[quotient, 0.5]];
intPart ← RealOps.Float[int];
out ← BasicValue[real, real[realValue: RealOps.FSub[quotient, intPart]]];
END; -- of Remainder --


Secant: PROCEDURE [in1, in2: BasicValue] RETURNS [out: BasicValue] =
BEGIN
RETURN[BasicValue[real, real[realValue: RealOps.FDiv[1.0, Cosine[in1, in2].realValue]]]];
END; -- of Secant --


SignFunction: PROCEDURE [in1, in2: BasicValue] RETURNS [out: BasicValue] =
BEGIN
arg: REAL;
IF in2.type = string THEN Storage.FreeString[in2.stringValue];
SELECT in1.type FROM
real => arg ← in1.realValue;
integer => arg ← RealOps.Float[in1.integerValue];
ENDCASE =>
BEGIN
Storage.FreeString[in1.stringValue];
RunTimeError["SGN cannot accept a string argument."L];
END;
out ← BasicValue[integer, integer[integerValue: RealOps.FComp[arg, 0]]];
END; -- of SignFunction --


Sine: PROCEDURE [in1, in2: BasicValue] RETURNS [out: BasicValue] =
BEGIN
angle: REAL;
IF in2.type = string THEN Storage.FreeString[in2.stringValue];
out ← BasicValueZero;
SELECT in1.type FROM
real => angle ← in1.realValue;
integer => angle ← RealOps.Float[in1.integerValue];
ENDCASE =>
BEGIN
Storage.FreeString[in1.stringValue];
RunTimeError["SIN cannot accept a string argument."L];
END;
SELECT trigMode FROM
radians => out ← BasicValue[real, real[realValue: RealFns.Sin[angle]]];
degrees => out ← BasicValue[real, real[realValue: RealFns.SinDeg[angle]]];
ENDCASE => IODefs.WriteLine["GRAD mode not implemented yet."L];
END; -- of Sine --


SquareRoot: PROCEDURE [in1, in2: BasicValue] RETURNS [out: BasicValue] =
BEGIN
arg: REAL;
IF in2.type = string THEN Storage.FreeString[in2.stringValue];
SELECT in1.type FROM
real => arg ← in1.realValue;
integer => arg ← RealOps.Float[in1.integerValue];
ENDCASE =>
BEGIN
Storage.FreeString[in1.stringValue];
RunTimeError["SQR cannot accept a string argument."L];
END;
out ← BasicValue[real, real[realValue: RealFns.SqRt[arg]]];
END; -- of SquareRoot --


Tangent: PROCEDURE [in1, in2: BasicValue] RETURNS [out: BasicValue] =
BEGIN
angle: REAL;
IF in2.type = string THEN Storage.FreeString[in2.stringValue];
SELECT in1.type FROM
real => angle ← in1.realValue;
integer => angle ← RealOps.Float[in1.integerValue];
ENDCASE =>
BEGIN
Storage.FreeString[in1.stringValue];
RunTimeError["TAN cannot accept a string argument."L];
END;
SELECT trigMode FROM
radians => out ← BasicValue[real, real[realValue: RealFns.Tan[angle]]];
degrees => out ← BasicValue[real, real[realValue: RealFns.TanDeg[angle]]];
ENDCASE => IODefs.WriteLine["GRAD mode not implement yet."L];
END; -- of Tangent --


UpperCase: PROCEDURE [in1, in2: BasicValue] RETURNS [out: BasicValue] =
BEGIN
IF in2.type = string THEN Storage.FreeString[in2.stringValue];
IF in1.type = string THEN
BEGIN
string: STRING ← Storage.String[in1.stringValue.length];
string.length ← in1.stringValue.length;
FOR i: CARDINAL IN [0 .. string.length) DO
string[i] ← String.UpperCase[in1.stringValue[i]];
ENDLOOP;
out ← BasicValue[string, string[stringValue: string]];
Storage.FreeString[in1.stringValue];
END
ELSE RunTimeError["UPC$ cannot accept a numeric argument."L];
END; -- of UpperCase --


ValFunction: PROCEDURE [in1, in2: BasicValue] RETURNS [out: BasicValue] =
BEGIN
IF in2.type = string THEN Storage.FreeString[in2.stringValue];
IF in1.type = string THEN
BEGIN
out ← BasicValue[real, real[realValue: Real.StringToReal[in1.stringValue]]];
Storage.FreeString[in1.stringValue];
END
ELSE RunTimeError["VAL cannot accept a numeric argument."L];
END; -- of ValFunction --


ValStringFunction: PROCEDURE [in1, in2: BasicValue] RETURNS [out: BasicValue] =
BEGIN
value: REAL;
temp: STRING ← [40];
IF in2.type = string THEN Storage.FreeString[in2.stringValue];
SELECT in1.type FROM
real => value ← in1.realValue;
integer => value ← RealOps.Float[in1.integerValue];
ENDCASE =>
BEGIN
Storage.FreeString[in1.stringValue];
RunTimeError["VAL$ cannot accept a string argument."L];
END;
Real.AppendReal[temp, value];
out ← BasicValue[string, string[stringValue: Storage.CopyString[temp]]];
END; -- of ValStringFunction --


END. -- of BasicFunction --