DIRECTORY PS, Basics, RealFns; PSLanguagePrimitivesImpl: CEDAR PROGRAM IMPORTS PS, Basics, RealFns ~ BEGIN OPEN PS; copy: PROC [self: Root] ~ { SELECT TypeIndex[self, 0] FROM integer => { n: INT ~ PopInt[self]; Copy[self, n]; }; array => { array2: Array ~ PopArray[self, unlimited]; array1: Array ~ PopArray[self, readOnly]; PushArray[self, ArrayCopy[self: self, array: array2, from: array1]]; }; string => { string2: String ~ PopString[self, unlimited]; string1: String ~ PopString[self, readOnly]; PushString[self, StringCopy[self: self, string: string2, from: string1]]; }; dict => { dict2: Dict ~ PopDict[self, unlimited]; dict1: Dict ~ PopDict[self, readOnly]; PushDict[self, DictCopy[self: self, dict: dict2, from: dict1]]; }; ENDCASE => ERROR Error[typecheck]; }; length: PROC [self: Root] ~ { SELECT TypeIndex[self, 0] FROM array => { array: Array ~ PopArray[self, readOnly]; PushInt[self, ArrayLength[array]]; }; string => { string: String ~ PopString[self, readOnly]; PushInt[self, StringLength[string]]; }; dict => { dict: Dict ~ PopDict[self, readOnly]; PushInt[self, DictLength[dict]]; }; name => { name: Name ~ PopName[self]; PushInt[self, NameLength[name]]; }; ENDCASE => ERROR Error[typecheck]; }; get: PROC [self: Root] ~ { SELECT TypeIndex[self, 1] FROM array => { index: INT ~ PopInt[self]; array: Array ~ PopArray[self, readOnly]; PushAny[self, ArrayGet[array, index]]; }; string => { index: INT ~ PopInt[self]; string: String ~ PopString[self, readOnly]; PushInt[self, IntFromChar[StringGet[string, index]]]; }; dict => { key: Any ~ PopAny[self]; dict: Dict ~ PopDict[self, readOnly]; PushAny[self, DictGet[dict, key]]; }; ENDCASE => ERROR Error[typecheck]; }; put: PROC [self: Root] ~ { SELECT TypeIndex[self, 2] FROM array => { any: Any ~ PopAny[self]; index: INT ~ PopInt[self]; array: Array ~ PopArray[self, unlimited]; ArrayPut[self, array, index, any]; }; string => { int: INT ~ PopInt[self]; index: INT ~ PopInt[self]; string: String ~ PopString[self, unlimited]; StringPut[self, string, index, CharFromInt[int]]; }; dict => { any: Any ~ PopAny[self]; key: Any ~ PopAny[self]; dict: Dict ~ PopDict[self, unlimited]; DictPut[self, dict, key, any]; }; ENDCASE => ERROR Error[typecheck]; }; getinterval: PROC [self: Root] ~ { count: INT ~ PopInt[self]; index: INT ~ PopInt[self]; SELECT TypeIndex[self, 0] FROM array => { array: Array ~ PopArray[self, readOnly]; PushArray[self, ArrayGetInterval[array, index, count]]; }; string => { string: String ~ PopString[self, readOnly]; PushString[self, StringGetInterval[string, index, count]]; }; ENDCASE => ERROR Error[typecheck]; }; putinterval: PROC [self: Root] ~ { SELECT TypeIndex[self, 2] FROM array => { array2: Array ~ PopArray[self, readOnly]; index: INT ~ PopInt[self]; array1: Array ~ PopArray[self, unlimited]; ArrayPutInterval[self, array1, index, array2]; }; string => { string2: String ~ PopString[self, readOnly]; index: INT ~ PopInt[self]; string1: String ~ PopString[self, unlimited]; StringPutInterval[self, string1, index, string2]; }; ENDCASE => ERROR Error[typecheck]; }; forall: PROC [self: Root] ~ { proc: Any ~ PopAny[self]; SELECT TypeIndex[self, 0] FROM array => { array: Array ~ PopArray[self, readOnly]; action: PROC [x: Any] ~ { PushAny[self, x]; Execute[self, proc]; }; ArrayForAll[array, action ! Exit => CONTINUE]; }; string => { string: String ~ PopString[self, readOnly]; action: PROC [c: CHAR] ~ { PushInt[self, IntFromChar[c]]; Execute[self, proc]; }; StringForAll[string, action ! Exit => CONTINUE]; }; dict => { dict: Dict ~ PopDict[self, readOnly]; action: PROC [key, val: Any] ~ { PushAny[self, key]; PushAny[self, val]; Execute[self, proc]; }; DictForAll[dict, action ! Exit => CONTINUE]; }; ENDCASE => ERROR Error[typecheck]; }; token: PROC [self: Root] ~ { SELECT TypeIndex[self, 0] FROM string => { string: String ~ PopString[self, readOnly]; found: BOOL; token: Any; post: String; [found, token, post] _ StringToken[self, string]; IF found THEN { PushString[self, post]; PushAny[self, token]; PushBool[self, TRUE]; } ELSE { PushBool[self, FALSE]; }; }; file => { file: File ~ PopFile[self, readOnly]; found: BOOL; token: Any; [found, token] _ FileToken[self, file]; IF found THEN { PushAny[self, token]; PushBool[self, TRUE]; } ELSE { PushBool[self, FALSE]; }; }; ENDCASE => ERROR Error[typecheck]; }; pop: PROC [self: Root] ~ { [] _ PopAny[self]; }; exch: PROC [self: Root] ~ { Roll[self, 2, 1]; }; dup: PROC [self: Root] ~ { Copy[self, 1]; }; index: PROC [self: Root] ~ { n: INT ~ PopInt[self]; PushAny[self, Index[self, n]]; }; roll: PROC [self: Root] ~ { j: INT ~ PopInt[self]; n: INT ~ PopInt[self]; Roll[self, n, j]; }; clear: PROC [self: Root] ~ { Clear[self]; }; count: PROC [self: Root] ~ { PushInt[self, Count[self]]; }; mark: PROC [self: Root] ~ { PushMark[self]; }; cleartomark: PROC [self: Root] ~ { ClearToMark[self]; }; counttomark: PROC [self: Root] ~ { PushInt[self, CountToMark[self]]; }; add: PROC [self: Root] ~ { IF TypeIndex[self, 0]=integer AND TypeIndex[self, 1]=integer THEN { int2: INT ~ PopInt[self]; int1: INT ~ PopInt[self]; int3: INT ~ int1+int2; ok: BOOL ~ (int1<0)#(int2<0) OR (int2<0)=(int3<0); IF ok THEN PushInt[self, int3] ELSE PushReal[self, REAL[int1]+REAL[int2]]; } ELSE { real2: REAL ~ PopReal[self]; real1: REAL ~ PopReal[self]; PushReal[self, real1+real2]; }; }; sub: PROC [self: Root] ~ { IF TypeIndex[self, 0]=integer AND TypeIndex[self, 1]=integer THEN { int2: INT ~ PopInt[self]; int1: INT ~ PopInt[self]; int3: INT ~ int1-int2; ok: BOOL ~ (int1<0)=(int2<0) OR (int2<0)#(int3<0); IF ok THEN PushInt[self, int3] ELSE PushReal[self, REAL[int1]-REAL[int2]]; } ELSE { real2: REAL ~ PopReal[self]; real1: REAL ~ PopReal[self]; PushReal[self, real1-real2]; }; }; minInt: REAL _ INT.FIRST; maxInt: REAL _ INT.LAST; mul: PROC [self: Root] ~ { IF TypeIndex[self, 0]=integer AND TypeIndex[self, 1]=integer THEN { int2: INT ~ PopInt[self]; int1: INT ~ PopInt[self]; real3: REAL ~ REAL[int1]*REAL[int2]; ok: BOOL ~ real3 IN [minInt .. maxInt]; -- ***** fix this? ***** IF ok THEN PushInt[self, int1*int2] ELSE PushReal[self, real3]; } ELSE { real2: REAL ~ PopReal[self]; real1: REAL ~ PopReal[self]; PushReal[self, real1*real2]; }; }; div: PROC [self: Root] ~ { real2: REAL ~ PopReal[self]; real1: REAL ~ PopReal[self]; PushReal[self, real1/real2]; }; idiv: PROC [self: Root] ~ { int2: INT ~ PopInt[self]; int1: INT ~ PopInt[self]; PushInt[self, int1/int2]; }; mod: PROC [self: Root] ~ { int2: INT ~ PopInt[self]; int1: INT ~ PopInt[self]; PushInt[self, int1 MOD int2]; }; abs: PROC [self: Root] ~ { IF TypeIndex[self, 0]=integer THEN { int: INT ~ PopInt[self]; ok: BOOL ~ (int#INT.FIRST); IF ok THEN PushInt[self, ABS[int]] ELSE PushReal[self, ABS[REAL[int]]]; } ELSE { real: REAL ~ PopReal[self]; PushReal[self, ABS[real]]; }; }; neg: PROC [self: Root] ~ { IF TypeIndex[self, 0]=integer THEN { int: INT ~ PopInt[self]; ok: BOOL ~ (int#INT.FIRST); IF ok THEN PushInt[self, -int] ELSE PushReal[self, -REAL[int]]; } ELSE { real: REAL ~ PopReal[self]; PushReal[self, -real]; }; }; ceiling: PROC [self: Root] ~ { IF TypeIndex[self, 0]=integer THEN { } ELSE { real: REAL ~ PopReal[self]; PushReal[self, Ceiling[real]]; }; }; floor: PROC [self: Root] ~ { IF TypeIndex[self, 0]=integer THEN { } ELSE { real: REAL ~ PopReal[self]; PushReal[self, Floor[real]]; }; }; round: PROC [self: Root] ~ { IF TypeIndex[self, 0]=integer THEN { } ELSE { real: REAL ~ PopReal[self]; PushReal[self, Round[real]]; }; }; truncate: PROC [self: Root] ~ { IF TypeIndex[self, 0]=integer THEN { } ELSE { real: REAL ~ PopReal[self]; PushReal[self, Truncate[real]]; }; }; sqrt: PROC [self: Root] ~ { num: REAL ~ PopReal[self]; PushReal[self, RealFns.SqRt[num]]; }; atan: PROC [self: Root] ~ { den: REAL ~ PopReal[self]; num: REAL ~ PopReal[self]; PushReal[self, RealFns.ArcTanDeg[num, den]]; }; cos: PROC [self: Root] ~ { angle: REAL ~ PopReal[self]; PushReal[self, RealFns.CosDeg[angle]]; }; sin: PROC [self: Root] ~ { angle: REAL ~ PopReal[self]; PushReal[self, RealFns.SinDeg[angle]]; }; exp: PROC [self: Root] ~ { exponent: REAL ~ PopReal[self]; base: REAL ~ PopReal[self]; PushReal[self, RealFns.Power[base, exponent]]; }; ln: PROC [self: Root] ~ { num: REAL ~ PopReal[self]; PushReal[self, RealFns.Ln[num]]; }; log: PROC [self: Root] ~ { num: REAL ~ PopReal[self]; PushReal[self, RealFns.Log[10, num]]; }; rand: PROC [self: Root] ~ { int: INT ~ Rand[self]; PushInt[self, int]; }; srand: PROC [self: Root] ~ { int: INT ~ PopInt[self]; SRand[self, int]; }; rrand: PROC [self: Root] ~ { int: INT ~ RRand[self]; PushInt[self, int]; }; array: PROC [self: Root] ~ { size: INT ~ PopInt[self]; PushArray[self, ArrayCreate[self, size]]; }; endarray: PROC [self: Root] ~ { -- ] size: INT ~ CountToMark[self]; array: Array ~ ArrayCreate[self, size]; AStore[self, array]; PopMark[self]; PushArray[self, array]; }; aload: PROC [self: Root] ~ { array: Array ~ PopArray[self, readOnly]; ALoad[self, array]; PushArray[self, array]; }; astore: PROC [self: Root] ~ { array: Array ~ PopArray[self, unlimited]; AStore[self, array]; PushArray[self, array]; }; dict: PROC [self: Root] ~ { size: INT ~ PopInt[self]; PushDict[self, DictCreate[self, size]]; }; maxlength: PROC [self: Root] ~ { dict: Dict ~ PopDict[self, readOnly]; PushInt[self, DictMaxLength[dict]]; }; begin: PROC [self: Root] ~ { dict: Dict ~ PopDict[self, readOnly]; Begin[self, dict]; }; end: PROC [self: Root] ~ { End[self]; }; def: PROC [self: Root] ~ { value: Any ~ PopAny[self]; key: Any ~ PopAny[self]; Def[self, key, value]; }; load: PROC [self: Root] ~ { key: Any ~ PopAny[self]; PushAny[self, Load[self, key]]; }; store: PROC [self: Root] ~ { value: Any ~ PopAny[self]; key: Any ~ PopAny[self]; Store[self, key, value]; }; known: PROC [self: Root] ~ { key: Any ~ PopAny[self]; dict: Dict ~ PopDict[self, readOnly]; PushBool[self, Known[dict, key]]; }; where: PROC [self: Root] ~ { key: Any ~ PopAny[self]; found: BOOL; dict: Dict; [found, dict] _ Where[self, key]; IF found THEN PushDict[self, dict]; PushBool[self, found]; }; currentdict: PROC [self: Root] ~ { PushDict[self, CurrentDict[self]]; }; countdictstack: PROC [self: Root] ~ { PushInt[self, CountDictStack[self]]; }; dictstack: PROC [self: Root] ~ { array: Array ~ PopArray[self, unlimited]; PushArray[self, DictStack[self, array]]; }; string: PROC [self: Root] ~ { size: INT ~ PopInt[self]; PushString[self, StringCreate[self, size]]; }; anchorsearch: PROC [self: Root] ~ { seek: String ~ PopString[self, readOnly]; string: String ~ PopString[self, readOnly]; found: BOOL; index: INT; [found: found, index: index] _ Search[string: string, seek: seek, anchor: TRUE]; IF index#0 THEN ERROR Bug; IF found THEN { matchLength: INT ~ StringLength[seek]; match: String ~ StringGetInterval[string, 0, matchLength]; post: String ~ StringGetInterval[string, matchLength, StringLength[string]-matchLength]; PushString[self, post]; PushString[self, match]; PushBool[self, TRUE]; } ELSE { PushString[self, string]; PushBool[self, FALSE]; }; }; search: PROC [self: Root] ~ { seek: String ~ PopString[self, readOnly]; string: String ~ PopString[self, readOnly]; found: BOOL; matchIndex: INT; [found: found, index: matchIndex] _ Search[string: string, seek: seek, anchor: FALSE]; IF found THEN { matchLength: INT ~ StringLength[seek]; postIndex: INT ~ matchIndex+matchLength; pre: String ~ StringGetInterval[string, 0, matchIndex]; match: String ~ StringGetInterval[string, matchIndex, matchLength]; post: String ~ StringGetInterval[string, postIndex, StringLength[string]-postIndex]; PushString[self, post]; PushString[self, match]; PushString[self, pre]; PushBool[self, TRUE]; } ELSE { PushString[self, string]; PushBool[self, FALSE]; }; }; eq: PROC [self: Root] ~ { x2: Any ~ PopAny[self]; x1: Any ~ PopAny[self]; PushBool[self, Eq[x1, x2]]; }; ne: PROC [self: Root] ~ { x2: Any ~ PopAny[self]; x1: Any ~ PopAny[self]; PushBool[self, NOT Eq[x1, x2]]; }; ge: PROC [self: Root] ~ { x2: Any ~ PopAny[self]; x1: Any ~ PopAny[self]; PushBool[self, Compare[x1, x2]>=equal]; }; gt: PROC [self: Root] ~ { x2: Any ~ PopAny[self]; x1: Any ~ PopAny[self]; PushBool[self, Compare[x1, x2]>equal]; }; le: PROC [self: Root] ~ { x2: Any ~ PopAny[self]; x1: Any ~ PopAny[self]; PushBool[self, Compare[x1, x2]<=equal]; }; lt: PROC [self: Root] ~ { x2: Any ~ PopAny[self]; x1: Any ~ PopAny[self]; PushBool[self, Compare[x1, x2] { bool2: BOOL ~ PopBool[self]; bool1: BOOL ~ PopBool[self]; PushBool[self, bool1 AND bool2]; }; integer => { int2: INT ~ PopInt[self]; int1: INT ~ PopInt[self]; PushInt[self, Basics.DoubleAnd[[li[int1]], [li[int2]]].li]; }; ENDCASE => ERROR Error[typecheck]; }; not: PROC [self: Root] ~ { SELECT TypeIndex[self, 0] FROM boolean => { bool1: BOOL ~ PopBool[self]; PushBool[self, NOT bool1]; }; integer => { int1: INT ~ PopInt[self]; PushInt[self, Basics.DoubleNot[[li[int1]]].li]; }; ENDCASE => ERROR Error[typecheck]; }; or: PROC [self: Root] ~ { SELECT TypeIndex[self, 0] FROM boolean => { bool2: BOOL ~ PopBool[self]; bool1: BOOL ~ PopBool[self]; PushBool[self, bool1 OR bool2]; }; integer => { int2: INT ~ PopInt[self]; int1: INT ~ PopInt[self]; PushInt[self, Basics.DoubleOr[[li[int1]], [li[int2]]].li]; }; ENDCASE => ERROR Error[typecheck]; }; xor: PROC [self: Root] ~ { SELECT TypeIndex[self, 0] FROM boolean => { bool2: BOOL ~ PopBool[self]; bool1: BOOL ~ PopBool[self]; PushBool[self, bool1 # bool2]; }; integer => { int2: INT ~ PopInt[self]; int1: INT ~ PopInt[self]; PushInt[self, Basics.DoubleXor[[li[int1]], [li[int2]]].li]; }; ENDCASE => ERROR Error[typecheck]; }; bitshift: PROC [self: Root] ~ { shift: INT ~ PopInt[self]; int1: INT ~ PopInt[self]; IF shift NOT IN INTEGER THEN PushInt[self, 0] ELSE PushInt[self, Basics.DoubleShift[[li[int1]], shift].li]; }; exec: PROC [self: Root] ~ { x: Any ~ PopAny[self]; Execute[self, x]; }; if: PROC [self: Root] ~ { proc: Any ~ PopProc[self]; bool: BOOL ~ PopBool[self]; IF bool THEN Execute[self, proc]; }; ifelse: PROC [self: Root] ~ { proc2: Any ~ PopProc[self]; proc1: Any ~ PopProc[self]; bool: BOOL ~ PopBool[self]; Execute[self, IF bool THEN proc1 ELSE proc2]; }; for: PROC [self: Root] ~ { proc: Any ~ PopProc[self]; type0: TypeCode ~ TypeIndex[self, 0]; type1: TypeCode ~ TypeIndex[self, 1]; type2: TypeCode ~ TypeIndex[self, 2]; IF type0=integer AND type1=integer AND type2=integer THEN { limit: INT ~ PopInt[self]; increment: INT ~ PopInt[self]; initial: INT ~ PopInt[self]; FOR control: INT _ initial, control+increment UNTIL (IF increment>0 THEN control>limit ELSE control EXIT]; ENDLOOP; } ELSE { limit: REAL ~ PopReal[self]; increment: REAL ~ PopReal[self]; initial: REAL ~ PopReal[self]; FOR control: REAL _ initial, control+increment UNTIL (IF increment>0 THEN control>limit ELSE control EXIT]; ENDLOOP; }; }; repeat: PROC [self: Root] ~ { proc: Any ~ PopProc[self]; int: INT ~ PopInt[self]; IF int<0 THEN ERROR Error[rangecheck]; THROUGH [0..int) DO Execute[self, proc ! Exit => EXIT]; ENDLOOP; }; loop: PROC [self: Root] ~ { proc: Any ~ PopProc[self]; DO Execute[self, proc ! Exit => EXIT]; ENDLOOP; }; exit: PROC [self: Root] ~ { SIGNAL Exit; ERROR Error[invalidexit]; }; stop: PROC [self: Root] ~ { ERROR Stop; }; stopped: PROC [self: Root] ~ { x: Any ~ PopAny[self]; stopped: BOOL _ FALSE; Execute[self, x ! Stop => { stopped _ TRUE; CONTINUE }; Exit => { RESUME }; ]; PushBool[self, stopped]; }; quit: PROC [self: Root] ~ { ERROR Quit; }; type: PROC [self: Root] ~ { x: Any ~ PopAny[self]; PushName[self, NameFromType[self, Type[x]]]; }; cvlit: PROC [self: Root] ~ { x: Any ~ PopAny[self]; PushAny[self, CvLit[x]]; }; cvx: PROC [self: Root] ~ { x: Any ~ PopAny[self]; PushAny[self, CvX[x]]; }; xcheck: PROC [self: Root] ~ { x: Any ~ PopAny[self]; PushBool[self, XCheck[x]]; }; DoCheckAccess: PROC [self: Root, check: Access] ~ { access: Access ~ SELECT TypeIndex[self, 0] FROM array => ArrayAccess[PopArray[self, none]], string => StringAccess[PopString[self, none]], dict => DictAccess[PopDict[self, none]], file => FileAccess[PopFile[self, none]], ENDCASE => ERROR Error[typecheck]; PushBool[self, access>=check]; }; DoSetAccess: PROC [self: Root, access: Access] ~ { SELECT TypeIndex[self, 0] FROM array => PushArray[self, ArraySetAccess[PopArray[self, access], access]]; string => PushString[self, StringSetAccess[PopString[self, access], access]]; dict => PushDict[self, DictSetAccess[self, PopDict[self, access], access]]; file => PushFile[self, FileSetAccess[PopFile[self, access], access]]; ENDCASE => ERROR Error[typecheck]; }; readonly: PROC [self: Root] ~ { DoSetAccess[self, readOnly] }; executeonly: PROC [self: Root] ~ { DoSetAccess[self, executeOnly] }; noaccess: PROC [self: Root] ~ { DoSetAccess[self, none] }; wcheck: PROC [self: Root] ~ { DoCheckAccess[self, unlimited] }; rcheck: PROC [self: Root] ~ { DoCheckAccess[self, readOnly] }; cvi: PROC [self: Root] ~ { SELECT TypeIndex[self, 0] FROM integer => { }; real => { real: REAL ~ PopReal[self]; PushInt[self, IntFromReal[real]]; }; string => { string: String ~ PopString[self, readOnly]; PushInt[self, IntFromString[string]]; }; ENDCASE => ERROR Error[typecheck]; }; cvn: PROC [self: Root] ~ { string: String ~ PopString[self, readOnly]; PushName[self, NameFromString[self, string]]; }; cvr: PROC [self: Root] ~ { SELECT TypeIndex[self, 0] FROM integer => { int: INT ~ PopInt[self]; PushReal[self, RealFromInt[int]]; }; real => { }; string => { string: String ~ PopString[self, readOnly]; PushReal[self, RealFromString[string]]; }; ENDCASE => ERROR Error[typecheck]; }; cvrs: PROC [self: Root] ~ { string: String ~ PopString[self, unlimited]; radix: INT ~ PopInt[self]; SELECT TypeIndex[self, 0] FROM integer => { int: INT ~ PopInt[self]; PushString[self, StringFromInt[self, string, int, radix]]; }; real => { real: REAL ~ PopReal[self]; PushString[self, StringFromInt[self, string, IntFromReal[real], radix]]; }; ENDCASE => ERROR Error[typecheck]; }; cvs: PROC [self: Root] ~ { string: String ~ PopString[self, unlimited]; SELECT TypeIndex[self, 0] FROM integer => { int: INT ~ PopInt[self]; PushString[self, StringFromInt[self, string, int]]; }; real => { real: REAL ~ PopReal[self]; PushString[self, StringFromReal[self, string, real]]; }; boolean => { bool: BOOL ~ PopBool[self]; PushString[self, StringFromText[self, string, (IF bool THEN "true" ELSE "false")]]; }; string => { source: String ~ PopString[self, readOnly]; PushString[self, StringCopy[self: self, string: string, from: source]]; }; name => { name: Name ~ PopName[self]; PushString[self, StringFromName[self, string, name]]; }; operator => { operator: Operator ~ PopOperator[self]; PushString[self, StringFromOperator[self, string, operator]]; }; ENDCASE => { x: Any ~ PopAny[self]; PushString[self, StringFromText[self, string, "--nostringval--"]]; }; }; FileAccessModeFromString: PROC [string: String] RETURNS [FileAccessMode] ~ { IF StringLength[string]=1 THEN SELECT StringGet[string, 0] FROM 'r => RETURN[$read]; 'w => RETURN[$create]; ENDCASE; ERROR Error[invalidfileaccess]; }; file: PROC [self: Root] ~ { string2: String ~ PopString[self, readOnly]; string1: String ~ PopString[self, readOnly]; PushFile[self, FileCreate[self, string1, FileAccessModeFromString[string2]]]; }; closefile: PROC [self: Root] ~ { file: File ~ PopFile[self, readOnly]; CloseFile[file]; }; read: PROC [self: Root] ~ { file: File ~ PopFile[self, readOnly]; found: BOOL _ TRUE; char: CHAR; char _ Read[file ! EndOfFile => { found _ FALSE; CONTINUE }]; IF found THEN PushInt[self, IntFromChar[char]]; PushBool[self, found]; }; write: PROC [self: Root] ~ { int: INT ~ PopInt[self]; file: File ~ PopFile[self, unlimited]; Write[file, VAL[LOOPHOLE[int, Basics.LongNumber].ll]]; }; ReadStringProc: TYPE ~ PROC [self: Root, file: File, string: String] RETURNS [String, BOOL]; DoReadString: PROC [self: Root, readString: ReadStringProc] ~ { string: String ~ PopString[self, unlimited]; file: File ~ PopFile[self, readOnly]; substring: String; bool: BOOL; [substring, bool] _ readString[self, file, string]; PushString[self, substring]; PushBool[self, bool]; }; WriteStringProc: TYPE ~ PROC [file: File, string: String]; DoWriteString: PROC [self: Root, writeString: WriteStringProc] ~ { string: String ~ PopString[self, readOnly]; file: File ~ PopFile[self, unlimited]; writeString[file, string]; }; readhexstring: PROC [self: Root] ~ { DoReadString[self, ReadHexString]; }; writehexstring: PROC [self: Root] ~ { DoWriteString[self, WriteHexString]; }; readstring: PROC [self: Root] ~ { DoReadString[self, ReadString]; }; writestring: PROC [self: Root] ~ { DoWriteString[self, WriteString]; }; readline: PROC [self: Root] ~ { DoReadString[self, ReadLine]; }; bytesavailable: PROC [self: Root] ~ { file: File ~ PopFile[self, readOnly]; PushInt[self, BytesAvailable[file]]; }; flush: PROC [self: Root] ~ { FlushFile[self.stdout]; }; flushfile: PROC [self: Root] ~ { file: File ~ PopFile[self, readOnly]; FlushFile[file]; }; resetfile: PROC [self: Root] ~ { file: File ~ PopFile[self, readOnly]; ResetFile[file]; }; status: PROC [self: Root] ~ { file: File ~ PopFile[self, readOnly]; PushBool[self, Status[file]]; }; run: PROC [self: Root] ~ { string: String ~ PopString[self, readOnly]; file: File ~ FileCreate[self, string, $read]; Execute[self, CvX[AnyFromFile[file]] ! UNWIND => CloseFile[file]; Exit => RESUME; -- invalidexit ]; CloseFile[file]; }; currentfile: PROC [self: Root] ~ { file: File ~ SIGNAL CurrentFile[]; PushFile[self, file]; }; print: PROC [self: Root] ~ { string: String ~ PopString[self, readOnly]; WriteString[self.stdout, string]; }; echo: PROC [self: Root] ~ { bool: BOOL ~ PopBool[self]; Echo[self, bool]; }; save: PROC [self: Root] ~ { IF self.level { level: Level ~ val.level; IF NOT levellevel DO self.level _ self.level-1; UNTIL self.restore[self.level]=NIL DO item: RestoreItem ~ self.restore[self.level]; WITH item SELECT FROM item: REF RestoreItemRep.array => { }; item: REF RestoreItemRep.string => { }; item: REF RestoreItemRep.dict => { }; ENDCASE => ERROR Bug; self.restore[self.level] _ item.next; ENDLOOP; ENDLOOP; }; ENDCASE => ERROR Error[typecheck]; }; bind: PROC [self: Root] ~ { }; InitializeLanguagePrimitives: PROC [self: Root] ~ { RegisterOperator[self, "copy", copy]; RegisterOperator[self, "length", length]; RegisterOperator[self, "get", get]; RegisterOperator[self, "put", put]; RegisterOperator[self, "getinterval", getinterval]; RegisterOperator[self, "putinterval", putinterval]; RegisterOperator[self, "forall", forall]; RegisterOperator[self, "token", token]; RegisterOperator[self, "pop", pop]; RegisterOperator[self, "exch", exch]; RegisterOperator[self, "dup", dup]; RegisterOperator[self, "index", index]; RegisterOperator[self, "roll", roll]; RegisterOperator[self, "clear", clear]; RegisterOperator[self, "count", count]; RegisterOperator[self, "mark", mark]; RegisterOperator[self, "cleartomark", cleartomark]; RegisterOperator[self, "counttomark", counttomark]; RegisterOperator[self, "add", add]; RegisterOperator[self, "div", div]; RegisterOperator[self, "idiv", idiv]; RegisterOperator[self, "mod", mod]; RegisterOperator[self, "mul", mul]; RegisterOperator[self, "sub", sub]; RegisterOperator[self, "abs", abs]; RegisterOperator[self, "neg", neg]; RegisterOperator[self, "ceiling", ceiling]; RegisterOperator[self, "floor", floor]; RegisterOperator[self, "round", round]; RegisterOperator[self, "truncate", truncate]; RegisterOperator[self, "sqrt", sqrt]; RegisterOperator[self, "atan", atan]; RegisterOperator[self, "cos", cos]; RegisterOperator[self, "sin", sin]; RegisterOperator[self, "exp", exp]; RegisterOperator[self, "ln", ln]; RegisterOperator[self, "log", log]; RegisterOperator[self, "rand", rand]; RegisterOperator[self, "srand", srand]; RegisterOperator[self, "rrand", rrand]; RegisterOperator[self, "array", array]; RegisterOperator[self, "[", mark]; RegisterOperator[self, "]", endarray]; RegisterOperator[self, "aload", aload]; RegisterOperator[self, "astore", astore]; RegisterOperator[self, "dict", dict]; RegisterOperator[self, "maxlength", maxlength]; RegisterOperator[self, "begin", begin]; RegisterOperator[self, "end", end]; RegisterOperator[self, "def", def]; RegisterOperator[self, "load", load]; RegisterOperator[self, "store", store]; RegisterOperator[self, "known", known]; RegisterOperator[self, "where", where]; RegisterOperator[self, "currentdict", currentdict]; RegisterOperator[self, "countdictstack", countdictstack]; RegisterOperator[self, "dictstack", dictstack]; RegisterOperator[self, "string", string]; RegisterOperator[self, "anchorsearch", anchorsearch]; RegisterOperator[self, "search", search]; RegisterOperator[self, "eq", eq]; RegisterOperator[self, "ne", ne]; RegisterOperator[self, "ge", ge]; RegisterOperator[self, "gt", gt]; RegisterOperator[self, "le", le]; RegisterOperator[self, "lt", lt]; RegisterOperator[self, "and", and]; RegisterOperator[self, "not", not]; RegisterOperator[self, "or", or]; RegisterOperator[self, "xor", xor]; RegisterOperator[self, "bitshift", bitshift]; RegisterOperator[self, "exec", exec]; RegisterOperator[self, "if", if]; RegisterOperator[self, "ifelse", ifelse]; RegisterOperator[self, "for", for]; RegisterOperator[self, "repeat", repeat]; RegisterOperator[self, "loop", loop]; RegisterOperator[self, "exit", exit]; RegisterOperator[self, "stop", stop]; RegisterOperator[self, "stopped", stopped]; RegisterOperator[self, "quit", quit]; RegisterOperator[self, "type", type]; RegisterOperator[self, "cvlit", cvlit]; RegisterOperator[self, "cvx", cvx]; RegisterOperator[self, "xcheck", xcheck]; RegisterOperator[self, "executeonly", executeonly]; RegisterOperator[self, "noaccess", noaccess]; RegisterOperator[self, "readonly", readonly]; RegisterOperator[self, "rcheck", rcheck]; RegisterOperator[self, "wcheck", wcheck]; RegisterOperator[self, "cvi", cvi]; RegisterOperator[self, "cvn", cvn]; RegisterOperator[self, "cvr", cvr]; RegisterOperator[self, "cvrs", cvrs]; RegisterOperator[self, "cvs", cvs]; RegisterOperator[self, "file", file]; RegisterOperator[self, "closefile", closefile]; RegisterOperator[self, "read", read]; RegisterOperator[self, "write", write]; RegisterOperator[self, "readhexstring", readhexstring]; RegisterOperator[self, "writehexstring", writehexstring]; RegisterOperator[self, "readstring", readstring]; RegisterOperator[self, "writestring", writestring]; RegisterOperator[self, "readline", readline]; RegisterOperator[self, "bytesavailable", bytesavailable]; RegisterOperator[self, "flush", flush]; RegisterOperator[self, "flushfile", flushfile]; RegisterOperator[self, "resetfile", resetfile]; RegisterOperator[self, "status", status]; RegisterOperator[self, "run", run]; RegisterOperator[self, "currentfile", currentfile]; RegisterOperator[self, "print", print]; RegisterOperator[self, "echo", echo]; RegisterOperator[self, "save", save]; RegisterOperator[self, "restore", restore]; RegisterOperator[self, "bind", bind]; }; NoteInitialization[InitializeLanguagePrimitives]; END. fPSLanguagePrimitivesImpl.mesa Copyright Σ 1987 by Xerox Corporation. All rights reserved. Doug Wyatt, August 20, 1987 5:34:30 pm PDT PostScript base language primitives. Polymorphic operators Operand stack manipulation operators copy is polymorphic Arithmetic and math operators int: INT ~ PopInt[self]; PushInt[self, int]; int: INT ~ PopInt[self]; PushInt[self, int]; int: INT ~ PopInt[self]; PushInt[self, int]; int: INT ~ PopInt[self]; PushInt[self, int]; Array operators length is polymorphic get is polymorphic put is polymorphic getinterval is polymorphic putinterval is polymorphic copy is polymorphic forall is polymorphic Dictionary operators length is polymorphic get is polymorphic put is polymorphic copy is polymorphic forall is polymorphic String operators length is polymorphic get is polymorphic put is polymorphic getinterval is polymorphic putinterval is polymorphic copy is polymorphic forall is polymorphic token is polymorphic Relational, boolean, and bitwise operators Control operators Type, attribute, and conversion operators int: INT ~ PopInt[self]; PushInt[self, int]; real: REAL ~ PopReal[self]; PushReal[self, real]; File operators token is polymorphic Virtual memory operators should check the stacks here Miscellaneous operators proc: Array ~ PopArray[self, unlimited]; PushArray[self, Bind[proc]]; usertime: PROC [self: Root] ~ { PushInt[self, UserTime[self]]; }; Registration RegisterOperator[self, "countexecstack", countexecstack]; RegisterOperator[self, "execstack", execstack]; RegisterOperator[self, "vmstatus", vmstatus]; RegisterOperator[self, "usertime", usertime]; Κ#ͺ˜codešœ™Kšœ<™K˜—šž œœ3˜DK˜—šžœœ,˜:K˜—šžœœ3˜?K˜—šžœœ2˜>K˜—šžœœ˜šœ˜šœ ˜ Kšœœ™Kšœ™K˜—˜ Kšœœ˜Kšœ!˜!K˜—˜ Kšœ+˜+Kšœ%˜%K˜—Kšœœ˜"—K˜K˜—šžœœ˜K˜+K˜-K˜K˜—šžœœ˜šœ˜˜ Kšœœ˜Kšœ!˜!K˜—˜ Kšœœ™Kšœ™K˜—˜ Kšœ+˜+Kšœ'˜'K˜—Kšœœ˜"—K˜K˜—šžœœ˜K˜,Kšœœ˜šœ˜˜ Kšœœ˜Kšœ:˜:K˜—˜ Kšœœ˜KšœH˜HK˜—Kšœœ˜"—K˜K˜—šžœœ˜K˜,šœ˜˜ Kšœœ˜Kšœ3˜3K˜—˜ Kšœœ˜Kšœ5˜5K˜—˜ Kšœœ˜Kš œ/œœΟfœœ œ˜SK˜—˜ Kšœ+˜+KšœG˜GK˜—˜ Kšœ˜Kšœ5˜5K˜—˜ Kšœ'˜'Kšœ=˜=K˜—šœ˜ Kšœ˜Kšœ/ œ˜BK˜——K˜K˜——™šžœœœ˜Lšœœœ˜?Kšœœ˜Kšœœ ˜Kšœ˜—Kšœ˜K˜K˜—šžœœ˜Kšœ,˜,Kšœ,˜,KšœM˜MK˜K˜—šž œœ˜ Kšœ%˜%Kšœ˜K˜K˜—šžœœ˜Kšœ%˜%Kšœœœ˜Kšœœ˜ Kšœ*œœ˜=Kšœœ"˜/K˜K˜K˜—šžœœ˜Kšœœ˜Kšœ&˜&Jšœ œœ˜6K˜K˜—š œœœ*œ œ˜\K˜—šž œœ-˜?Kšœ,˜,Kšœ%˜%Kšœœ˜Kšœ3˜3K˜Kšœ˜K˜K˜—šœœœ˜:K˜—šž œœ/˜BKšœ+˜+Kšœ&˜&Kšœ˜K˜K˜—šž œœ˜$Kšœ"˜"K˜K˜—šžœœ˜%J˜$K˜K˜—šž œœ˜!Kšœ˜K˜K˜—šž œœ˜"J˜!K˜K˜—šžœœ˜Kšœ˜K˜K˜—šžœ™K™—šžœœ˜%Kšœ%˜%K˜$K˜K˜—šžœœ˜K˜K˜K˜—šž œœ˜ K˜%K˜K˜K˜—šž œœ˜ K˜%Kšœ˜K˜K˜—šžœœ˜K˜%K˜K˜K˜—šžœœ˜K˜+K˜-šœ&˜&Kšœ˜KšœœŸ˜Kšœ˜—K˜K˜K˜—šž œœ˜"Kšœ œ˜"Kšœ˜K˜K˜—šžœœ˜K˜+Kšœ!˜!K˜K˜—šžœœ˜Kšœœ˜Kšœ˜K˜K˜——™šžœœ˜šœœœ˜K˜K˜Kšœœœ˜+K˜—Kšœœ˜K˜K˜—šžœœ˜K˜šœ œ˜˜ K˜Kšœœœœ˜9Kšœ™šœ˜K˜šœœ˜%Kšœ-˜-šœœ˜šœœ˜#K˜K˜—šœœ˜$K˜—šœœ˜"K˜—Kšœœ˜—Kšœ%˜%Kšœ˜—Kšœ˜—K˜—Kšœœ˜"—K˜K˜——™šžœœ˜K™(K™K˜K˜—šžœœ™Kšœ™K™K™——™ šžœœ˜3Iunitšœ%˜%Kšœ)˜)Kšœ#˜#Kšœ#˜#Kšœ3˜3Kšœ3˜3Kšœ)˜)Kšœ'˜'Mšœ#˜#Kšœ%˜%Kšœ#˜#Kšœ'˜'Kšœ%˜%Kšœ'˜'Kšœ'˜'Kšœ%˜%Kšœ3˜3Kšœ3˜3Mšœ#˜#Kšœ#˜#Kšœ%˜%Kšœ#˜#Kšœ#˜#Kšœ#˜#Kšœ#˜#Kšœ#˜#Kšœ+˜+Kšœ'˜'Kšœ'˜'Kšœ-˜-Kšœ%˜%Kšœ%˜%Kšœ#˜#Kšœ#˜#Kšœ#˜#Kšœ!˜!Kšœ#˜#Kšœ%˜%Kšœ'˜'Kšœ'˜'Mšœ'˜'Kšœ"˜"Kšœ&˜&Kšœ'˜'Kšœ)˜)Mšœ%˜%Kšœ/˜/Kšœ'˜'Kšœ#˜#Kšœ#˜#Kšœ%˜%Kšœ'˜'Kšœ'˜'Kšœ'˜'Kšœ3˜3Kšœ9˜9Kšœ/˜/Mšœ)˜)Kšœ5˜5Kšœ)˜)Mšœ!˜!Kšœ!˜!Kšœ!˜!Kšœ!˜!Kšœ!˜!Kšœ!˜!Kšœ#˜#Kšœ#˜#Kšœ!˜!Kšœ#˜#Kšœ-˜-Mšœ%˜%Kšœ!˜!Kšœ)˜)Kšœ#˜#Kšœ)˜)Kšœ%˜%Kšœ%˜%Kšœ%˜%Kšœ+˜+Kšœ9™9Kšœ/™/Kšœ%˜%Mšœ%˜%Kšœ'˜'Kšœ#˜#Kšœ)˜)Kšœ3˜3Kšœ-˜-Kšœ-˜-Kšœ)˜)Kšœ)˜)Kšœ#˜#Kšœ#˜#Kšœ#˜#Kšœ%˜%Kšœ#˜#Mšœ%˜%Kšœ/˜/Kšœ%˜%Kšœ'˜'Kšœ7˜7Kšœ9˜9Kšœ1˜1Kšœ3˜3Kšœ-˜-Kšœ9˜9Kšœ'˜'Kšœ/˜/Kšœ/˜/Kšœ)˜)Kšœ#˜#Kšœ3˜3Kšœ'˜'Kšœ%˜%Mšœ%˜%Kšœ+˜+Kšœ-™-Mšœ%˜%Kšœ-™-M˜J˜—Jšœ1˜1—J˜Jšœ˜—…—k†•–