BugBaneTests.mesa
Russ Atkinson, February 2, 1983 4:55 pm
DIRECTORY
AMBridge,
AMTypes,
BBApply USING [CoerceTV],
BBBreak,
BBBugOut,
BBContext,
BBNub USING [FindWorld, TurnADeafEar],
BBObjectLocation,
Frame USING [GetReturnFrame],
IO,
Mopcodes USING [zBRK],
PriorityQueue USING [Create, Ref, SortPred],
PrincOps,
PrintTV,
Rope USING [Compare, ROPE, Text],
RTBasic USING [nullType, TV, Type],
RTMiniModel USING [AcquireIRInstance, AcquireIRType],
RTTypesBasic USING [refAnyType],
Space,
UserExec,
WorldVM;
BugBaneTests:
CEDAR
PROGRAM
IMPORTS
AMBridge, AMTypes, BBApply, BBBreak, BBBugOut, BBContext, BBNub, BBObjectLocation, Frame, IO, PriorityQueue, Rope, RTMiniModel, Space, UserExec, WorldVM
SHARES BBBreak
= BEGIN OPEN Rope, AMBridge, AMTypes, RTBasic, RTTypesBasic;
CARD: TYPE = LONG CARDINAL ← 0;
procs to get at TVs for global stuff
GVar:
PROC [name:
ROPE]
RETURNS [tv:
TV] =
TRUSTED {
gTV: TV ← TVForGFHReferent[LOOPHOLE[BugBaneTests]];
glob: TV ← Globals[gTV];
globType: Type ← UnderType[TVType[glob]];
index: CARDINAL ← NameToIndex[globType, IF name = NIL THEN "gtv" ELSE name];
tvType: Type;
tyUnder: Type;
tv ← IndexToTV[glob, index];
IF tv #
NIL
THEN {
tvType ← TVType[tv];
tyUnder ← UnderType[tvType]};
};
GType:
PROC [name:
ROPE]
RETURNS [type: Type] =
TRUSTED {
gTV: TV ← TVForGFHReferent[LOOPHOLE[BugBaneTests]];
glob: TV ← Globals[gTV];
globType: Type ← UnderType[TVType[glob]];
index: CARDINAL ← NameToIndex[globType, IF name = NIL THEN "gtv" ELSE name];
under: Type;
tv: TV ← IndexToTV[glob, index];
type ← TVType[tv];
under ← UnderType[type];
};
GStuff:
PROC [name:
ROPE]
RETURNS [tv:
TV, type, under: Type, class: Class] =
TRUSTED {
gTV: TV ← TVForGFHReferent[LOOPHOLE[BugBaneTests]];
glob: TV ← Globals[gTV];
globType: Type ← UnderType[TVType[glob]];
index: CARDINAL ← NameToIndex[globType, IF name = NIL THEN "gtv" ELSE name];
tv ← IndexToTV[glob, index];
type ← TVType[tv];
under ← UnderType[type];
class ← TypeClass[under];
};
enumerated types & subranges of enumerated types
ET1: TYPE = {red, green, yellow, blue};
ET2: TYPE = ET1 [green..yellow];
ET3: TYPE = MACHINE DEPENDENT {red, green, yellow, blue};
et1: ET1 ← yellow;
et2: ET2 ← green;
et3: ET3 ← red;
simple record types
RT1: TYPE = RECORD [a, b: CARDINAL, r1: REF, r2: ATOM];
RT2: TYPE = RECORD [a, b, c: REAL ← 0.0];
rt1: RT1 ← [1, 200B, $foo, $foo];
rt2: RT2 ← [1, 2, 3];
simple variant record types
VT1:
TYPE =
RECORD [
common: BOOLEAN ← TRUE,
varying:
SELECT tag: ET1
FROM
blue => [blue: ROPE],
red => [red: BOOLEAN],
green => [green1, green2: INT],
yellow => [yellow: CARDINAL]
ENDCASE];
vt1: VT1 ← [TRUE, green[101, 202]];
rvt1: REF ← NEW[VT1 ← vt1];
pvt1: POINTER TO VT1 ← NIL;
qvt1: POINTER TO VT1[green] ← NIL;
VT2:
TYPE =
RECORD [
SELECT tag: ET1
FROM
blue => [blue: ROPE],
red => NULL,
green => [green1, green2: INT],
yellow => NULL
ENDCASE];
vt2: VT2 ← [green[101, 202]];
rvt2: REF ← NEW[VT2 ← vt2];
pvt2: POINTER TO VT2 ← NIL;
vt2a: VT2 ← [red[]];
rvt2a: REF ← NEW[VT2 ← vt2a];
VT3:
TYPE =
RECORD [
common: BOOLEAN ← TRUE,
varying:
SELECT tag: ET1
FROM
blue => [blue: CHAR],
green => NULL,
red => [green1, green2: INT],
yellow => [yellow: CARDINAL]
ENDCASE];
vt3: VT3 ← [TRUE, blue['A]];
rvt3: REF ← NEW[VT3 ← vt3];
pvt3: POINTER TO VT3 ← NIL;
VT4:
TYPE =
RECORD [
common: BOOLEAN ← TRUE,
varying:
SELECT tag: ET1
FROM
blue => [blue: CHAR],
green => NULL,
red => [green1, green2: INT],
ENDCASE];
vt4: VT4 ← [FALSE, blue['A]];
rvt4: REF ← NEW[VT4 ← vt4];
pvt4: POINTER TO VT4 ← NIL;
Arrays
AT1: TYPE = ARRAY ET1 OF BoolPair;
at1: AT1 ← ALL[[TRUE, FALSE]];
BoolPair: TYPE = RECORD[first: BOOL, second: BOOL] ← [TRUE, FALSE];
bp1: BoolPair ← [TRUE, FALSE];
bp2: BoolPair ← [FALSE, TRUE];
AT2: TYPE = PACKED ARRAY ET1 OF BoolPair;
at2: AT2 ← ALL[[TRUE, FALSE]];
AT3: TYPE = ARRAY ET2 OF BoolPair;
at3: AT3 ← ALL[[TRUE, FALSE]];
AT4: TYPE = PACKED ARRAY ET2 OF BoolPair;
at4: AT4 ← ALL[[TRUE, FALSE]];
AT5: TYPE = PACKED ARRAY [0..0) OF CHAR;
at5: LONG POINTER TO AT5 ← NIL;
Test sub-word fields
Max: CARDINAL = LAST[CARDINAL] / 4;
Field1: TYPE = INTEGER [0..Max];
Field2: TYPE = RECORD [INTEGER [0..Max]];
Field3: TYPE = Type;
gf1: Field1 ← 101;
gf2: Field2 ← [102];
gf3: Field3 ← [103];
Test out sequences
SeqType1: TYPE = REF SeqRep1;
SeqRep1:
TYPE =
RECORD [
sel1: INT ← 1,
sel2: LONG CARDINAL ← 2,
sel3: INTEGER ← 3,
sel4: CARDINAL ← 4,
sel5: UNSPECIFIED ← LOOPHOLE[5],
sel6: INTEGER [0..100) ← 6,
sel7: CARDINAL [0..100) ← 7,
sel8: BOOLEAN ← TRUE,
seq: SEQUENCE len: NAT OF ROPE];
seq1: SeqType1 ← NEW[SeqRep1[20]];
SeqType2: TYPE = REF SeqRep2;
SeqRep2: TYPE = RECORD[seq: PACKED SEQUENCE len: CARDINAL [0..6) OF BoolPair];
seq2: SeqType2 ← NewSeqType2[];
SeqType3: TYPE = REF SeqRep3;
SeqRep3: TYPE = RECORD[seq: SEQUENCE len: CARDINAL [0..6) OF VT3];
seq3: SeqType3 ← NewSeqType3[];
SeqRep4: TYPE = SeqRep3;
SeqType4: TYPE = LONG POINTER TO SeqRep4;
seq4: SeqType4 ← NIL;
SeqRep5: TYPE = RECORD[len: CARDINAL, seq: SEQUENCE COMPUTED CARDINAL OF VT3];
SeqType5: TYPE = LONG POINTER TO SeqRep5;
seq5: SeqType5 ← NIL;
Make sure that ropes work!
rope: ROPE ← "rope";
text: Rope.Text ← "text";
ropeNIL: ROPE ← NIL;
textNIL: Rope.Text ← NIL;
ropeEmpty: ROPE ← "";
textEmpty: Rope.Text ← "";
Test based and relative pointers
BaseType: TYPE = LONG BASE POINTER TO BaseCommon;
BaseCommon: TYPE = RECORD [first,second,rest: Object];
RelType: TYPE = BaseType RELATIVE POINTER [0..Limit) TO Object;
Limit: CARDINAL = 4000B;
Object: TYPE = RECORD [int: INT, card: LONG CARDINAL];
obj: Object ← [int: 69, card: 105B];
objArray: ARRAY [0..5) OF Object ← [[0,0], [1,1], [2,2], [3,3], [4,4]];
objPtr: POINTER ← NIL;
base: BaseType ← NIL;
rel: RelType ← InitRel[];
EmbeddedRelPtr: TYPE = RECORD [rel: RelType, flag: BOOL];
embed: EmbeddedRelPtr ← [rel, TRUE];
Test out explicit/implicit tags & overlaid records
ExplicitTagType: TYPE = {int, card};
ExplicitTag:
TYPE =
RECORD [
SELECT tag: ExplicitTagType
FROM
int => [int: INT],
card => [card: LONG CARDINAL]
ENDCASE];
exp: ExplicitTag ← [int[17]];
ImplicitTag:
TYPE =
RECORD [
SELECT tag: *
FROM
int => [int: INT],
card => [card: LONG CARDINAL]
ENDCASE];
imp: ImplicitTag ← [card[17B]];
OverlaidTag:
TYPE =
RECORD [
SELECT
OVERLAID ExplicitTagType
FROM
int => [int: INT],
card => [card: LONG CARDINAL]
ENDCASE];
ovr: OverlaidTag ← [int[17]];
OverlaidImplicitTag:
TYPE =
RECORD [
SELECT
OVERLAID *
FROM
int => [int: INT],
card => [card: LONG CARDINAL]
ENDCASE];
ovrimp: OverlaidTag ← [card[17B]];
Test descriptors & long descriptors
Desc: TYPE = DESCRIPTOR FOR ARRAY OF CARD;
LongDesc: TYPE = LONG DESCRIPTOR FOR ARRAY OF CARD;
array: ARRAY [0..8) OF CARD ← [100B, 101B, 102B, 103B, 104B, 105B, 106B, 107B];
desc1: Desc ← MakeDesc[8];
desc2: Desc ← MakeDesc[4];
longDesc1: LongDesc ← MakeLongDesc[8];
longDesc2: LongDesc ← MakeLongDesc[4];
Signals & Errors
CopyFailed: ERROR = CODE;
TestError: ERROR [reason: ROPE] = CODE;
TestSignal: SIGNAL [reason: ROPE] = CODE;
Some helpful goodies
stringBodyType: Type = CODE[StringBody];
Start of procedures
GlobalTest:
PROC =
TRUSTED {
gTV: TV ← TVForGFHReferent[LOOPHOLE[BugBaneTests]];
glob: TV ← Globals[gTV];
globType: Type ← UnderType[TVType[glob]];
n: NAT ← AMTypes.NComponents[globType];
st: IO.STREAM ← UserExec.GetStreams[UserExec.GetExecHandle[]].out;
put: PrintTV.PutClosure;
put1: PrintTV.PutProc = TRUSTED {st.PutChar[c]};
TRUSTED {put ← [put1]}; -- sigh
FOR i:
NAT
IN [1..n]
DO
name: ROPE ← AMTypes.IndexToName[globType, i];
tv: TV ← NIL;
BBBugOut.ShowRopes["\n", name, " => ", NIL, put];
tv ← AMTypes.IndexToTV[glob, i];
ShowTV[tv, 4];
ENDLOOP;
};
NewSeqType2:
PROC
RETURNS [seq2: SeqType2] = {
seq2 ← NEW[SeqRep2[4]];
FOR i:
NAT
IN [0..4)
DO
seq2[i] ← [TRUE, FALSE];
ENDLOOP;
};
NewSeqType3:
PROC
RETURNS [seq3: SeqType3] =
TRUSTED {
seq3 ← NEW[SeqRep3[4]];
seq3[0] ← [TRUE, blue['B]];
seq3[1] ← [FALSE, green[]];
seq3[2] ← [TRUE, red[1001, 1002]];
seq3[3] ← [FALSE, yellow[17B]];
seq4 ← LOOPHOLE[seq3];
};
InitRel:
PROC
RETURNS [RelType] =
TRUSTED {
objPtr ← @objArray;
base ← LOOPHOLE[LONG[objPtr]];
RETURN [LOOPHOLE[3*SIZE[Object]]];
};
MakeDesc:
PROC [len:
NAT ← 4]
RETURNS [Desc] =
TRUSTED {
RETURN [DESCRIPTOR [@array, len]];
};
MakeLongDesc:
PROC [len:
NAT ← 4]
RETURNS [LongDesc] =
TRUSTED {
RETURN [DESCRIPTOR [@array, len]];
};
TestTypeToName:
PROC [type: Type]
RETURNS [name1,name2,mod:
ROPE] = {
modRef: REF ROPE ← NEW[ROPE ← NIL];
name1 ← AMTypes.TypeToName[type];
name2 ← AMTypes.TypeToName[type, modRef];
mod ← modRef^
};
NCases:
PROC [type: Type]
RETURNS [n:
INT] =
TRUSTED {
this procedure returns the number of cases for a variant record
we need this proc because the number of cases is sometimes less than
the number of values for the domain type
ERROR AMTypes.Error[typeFault] is raised when the type is not right
SELECT AMTypes.UnderClass[type]
FROM
record, structure => {
last: INT ← AMTypes.NComponents[type];
lastType: Type ← nullType;
IF last = 0 THEN GO TO noCases;
lastType ← AMTypes.IndexToType[type, last];
IF AMTypes.UnderClass[lastType] # union THEN GO TO noCases;
type ← lastType;
};
union => {};
ENDCASE => GO TO noCases;
n ← AMTypes.NValues[AMTypes.Domain[type]];
WHILE n > 0
DO
[] ← AMTypes.IndexToType
[type, n
! AMTypes.Error =>
IF reason = badIndex THEN {n ← n - 1; LOOP}];
RETURN;
ENDLOOP;
EXITS
noCases => ERROR AMTypes.Error[typeFault, NIL, type];
};
InvokeSignal:
PROC [r:
ROPE ←
NIL] = {
SIGNAL TestSignal[r]
};
InvokeError:
PROC [r:
ROPE ←
NIL] = {
ERROR TestError[r]
};
WhichSpecialError: TYPE = {unnamed, aborted, unwind};
InvokeSpecialError:
PROC [which: WhichSpecialError ← unnamed] =
TRUSTED {
SELECT which
FROM
unnamed => ERROR;
aborted => ERROR ABORTED;
unwind => ERROR UNWIND;
ENDCASE;
};
SimpleCatch:
PROC = {
InvokeError["SimpleCatch" ! TestError => CONTINUE];
};
LessSimpleCatch:
PROC = {
InvokeError["SimpleCatch" ! TestError => {rr: ROPE ← reason; CONTINUE}];
};
SimpleEnable:
PROC = {
rr: ROPE ← NIL;
{
ENABLE {
TestError => {rr ← reason; GO TO oops};
ABORTED => GO TO abort};
InvokeError["LessSimpleCatch"];
EXITS
oops => rr ← rr;
abort => ERROR ABORTED};
};
LessSimpleEnable:
PROC = {
rr: ROPE ← NIL;
{
ENABLE {
TestError => {me: TV ← TVForCaller[]; rr ← reason; GO TO oops};
ABORTED => GO TO abort};
InvokeError["LessSimpleCatch"];
EXITS
oops => rr ← rr;
abort => ERROR ABORTED};
};
TVForCaller:
PROC
RETURNS [
TV] =
TRUSTED {
RETURN [AMBridge.TVForFrame[Frame.GetReturnFrame[]]];
};
TestEnclosingBody:
PROC [arg:
INT ← 1] =
TRUSTED {
outerVar: ROPE ← "outside chance";
inner:
PROC [insideArg:
INT ← 2] =
TRUSTED {
me: TV ← TVForCaller[];
frame: TV ← me;
fptr: PrincOps.FrameHandle ← AMBridge.FHFromTV[frame];
lptr: POINTER TO PrincOps.Frame[local] ← LOOPHOLE[fptr];
insideVar: INT ← 100 + insideArg;
WHILE frame #
NIL
DO
ShowTV[AMTypes.Locals[frame]];
frame ← AMTypes.EnclosingBody[frame];
ENDLOOP;
};
inner[2];
inner[3];
};
gtv: TV ← NIL;
TestGVar:
PROC [name:
ROPE ←
NIL] = {
tv: TV ← NIL;
IF name = NIL THEN name ← "gtv";
tv ← GVar[name];
ShowTV[tv];
};
TestTVTV:
PROC [name:
ROPE ←
NIL] =
TRUSTED {
tv: TV ← GVar[name];
tvRef: REF ← NEW[REF ← tv];
show the original TV
ShowTV[tv];
gtv ← AMBridge.TVForReferent[tvRef];
show the TV for the TV
ShowTV[gtv];
now cross back to get to the original TV
ShowTV[LOOPHOLE[AMBridge.TVToLC[gtv], TV]];
};
TestRelativeFetch:
PROC
RETURNS [
TV] =
TRUSTED {
baseTV: TV ← GVar["base"];
relTV: TV ← GVar["rel"];
RETURN [AMTypes.Referent[relTV, baseTV]];
};
TestCopy:
PROC [tv1:
TV, insistEqual:
BOOL ←
TRUE]
RETURNS [
BOOL] =
TRUSTED {
under: Type ← AMTypes.UnderType[AMTypes.TVType[tv1]];
class: AMTypes.Class ← AMTypes.TypeClass[under];
tv2: TV ← AMTypes.Copy[tv1];
RETURN [TestEqual[tv1, tv2, insistEqual]];
};
TestEqual:
PROC
[tv1,tv2: TV, insistEqual: BOOL ← TRUE, depth: INTEGER ← 100]
RETURNS [BOOL] = TRUSTED {
under: Type ← AMTypes.UnderType[AMTypes.TVType[tv1]];
class: AMTypes.Class ← AMTypes.TypeClass[under];
equal: BOOL ← TRUE;
setEqual:
PROC [ntv1,ntv2:
TV] =
TRUSTED {
equal ← TestEqual[ntv1, ntv2, insistEqual, depth-1];
IF NOT equal AND insistEqual THEN ERROR TestSignal["Equal failed!"];
};
IF UnderClass[tv2] # class THEN ERROR TestSignal["Equal failed!"];
IF depth <= 0 THEN RETURN [equal];
SELECT class
FROM
ref, longPointer, pointer =>
setEqual[AMTypes.Referent[tv1], AMTypes.Referent[tv2]];
record, structure => {
-- test component-wise equality
n: NAT ← AMTypes.NComponents[under];
FOR i:
NAT
IN [1..n]
DO
setEqual[AMTypes.IndexToTV[tv1, i], AMTypes.IndexToTV[tv2, i]];
IF NOT equal THEN EXIT;
ENDLOOP;
};
union =>
setEqual[AMTypes.Variant[tv1], AMTypes.Variant[tv2]];
array, sequence => {
-- test component-wise equality
max: INT ← IF class = array THEN LAST[INT] ELSE AMTypes.Length[tv1];
indexType: Type ← Domain[under];
index: TV ← First[indexType];
IF max # AMTypes.Length[tv2] THEN ERROR TestError["Copy failed!"];
FOR i:
INT
IN [0..max)
WHILE index #
NIL
DO
setEqual[AMTypes.Apply[tv1, index], AMTypes.Apply[tv2, index]];
IF NOT equal THEN EXIT;
index ← AMTypes.Next[index];
IF index =
NIL
THEN
IF class = sequence AND i # max THEN TestError["Next failed!"];
ENDLOOP;
};
ENDCASE => {
equal ← AMTypes.TVEqual[tv1, tv2];
IF NOT equal AND insistEqual THEN ERROR TestError["Equal failed!"]};
RETURN [equal];
};
UnderClass:
PROC [tv:
TV]
RETURNS [AMTypes.Class] =
TRUSTED {
RETURN [AMTypes.TypeClass[AMTypes.UnderType[AMTypes.TVType[tv]]]];
};
Test1:
PROC =
TRUSTED {
rf: REF ← NEW[Field2 ← [402]];
tv: TV ← TVForReferent[rf];
tv1: TV ← IndexToTV[tv, 1];
lc: LONG CARDINAL ← TVToLC[tv];
lc1: LONG CARDINAL ← TVToLC[tv1];
type: Type ← TVType[tv];
ntv: TV ← New[type];
ntv1: TV ← NIL;
nlc, nlc1: LONG CARDINAL ← 0;
Assign[ntv, tv];
IF lc1 # lc THEN ERROR CopyFailed;
nlc ← TVToLC[ntv];
IF nlc # lc THEN ERROR CopyFailed;
ntv1 ← IndexToTV[ntv, 1];
nlc1 ← TVToLC[ntv1];
IF nlc1 # lc THEN ERROR CopyFailed
};
SingleReturn:
PROC [in:
INT ← 0]
RETURNS [
INT] = {
RETURN [in + 1]
};
SingleNamedReturn:
PROC [in:
INT ← 0]
RETURNS [out:
INT] = {
out ← in + 1
};
MultiReturn:
PROC [in:
INT ← 0]
RETURNS [
INT,
INT] = {
RETURN [in + 1, in + 2]
};
MultiNamedReturn:
PROC [in:
INT ← 0]
RETURNS [out1, out2:
INT] = {
out1 ← in + 1;
out2 ← in + 2
};
BigArgRecord:
PROC
[a1, a2, a3, a4, a5, a6, a7, a8, a9: INT ← 0] RETURNS [INT] = {
RETURN [a1 + a2 + a3 + a4 + a5 + a6 + a7 + a8 + a9]
};
RefAnyProc:
PROC [r:
REF]
RETURNS [
TV] =
TRUSTED {
r ← NEW[REF ← r];
RETURN [TVForReferent[r]]
};
UndefArg:
PROC [x:
UNSPECIFIED]
RETURNS [
CARDINAL] =
TRUSTED {
RETURN [LOOPHOLE[x, CARDINAL]]
};
ProcArg:
PROC [x:
PROC [r:
REF]
RETURNS [
TV]]
RETURNS [
CARDINAL] =
TRUSTED {
RETURN [LOOPHOLE[x, CARDINAL]]
};
ProcArgDefaultNil:
PROC
[x: PROC [r: REF] RETURNS [TV] ← NIL] RETURNS [CARDINAL] = TRUSTED {
RETURN [LOOPHOLE[x, CARDINAL]]
};
RefArg:
PROC [x:
REF]
RETURNS [
LONG
CARDINAL] =
TRUSTED {
RETURN [LOOPHOLE[x, LONG CARDINAL]]
};
RefArgDefaultNil:
PROC [x:
REF ←
NIL]
RETURNS [
LONG
CARDINAL] =
TRUSTED {
RETURN [LOOPHOLE[x, LONG CARDINAL]]
};
TestRefAnyCoerce:
PROC [r:
ROPE]
RETURNS [
TV] =
TRUSTED {
rr: REF ROPE ← NEW[ROPE ← r];
tv: TV ← TVForReferent[rr];
tv1: TV ← Coerce[tv, refAnyType];
tv2: TV ← New[refAnyType];
Assign[tv2, tv1];
RETURN [tv2]
};
AtomToTV:
PROC [atom:
ATOM]
RETURNS [
TV] =
TRUSTED {
ref: REF ← atom;
new: REF ← NEW[ATOM ← atom];
tv: TV ← TVForReferent[new];
tv1: TV ← BBApply.CoerceTV[tv, refAnyType];
tv2: TV ← Coerce[tv, refAnyType];
RETURN [tv]
};
MakeRefAny:
PROC [ref:
REF]
RETURNS [
REF] = {
RETURN [NEW[REF ← ref]];
};
IdentityRef:
PROC [ref:
REF]
RETURNS [
REF] = {
RETURN [ref]};
IRType:
PROC [defsName:
ROPE]
RETURNS [type: Type] =
TRUSTED {
RETURN [RTMiniModel.AcquireIRType[defsName]]
};
IRInstance:
PROC [defsName:
ROPE]
RETURNS [
TV] =
TRUSTED {
RETURN [RTMiniModel.AcquireIRInstance[defsName]]
};
IRRef:
PROC [defsName:
ROPE]
RETURNS [
REF] =
TRUSTED {
RETURN [AMBridge.RefFromTV[RTMiniModel.AcquireIRInstance[defsName]]];
};
NestedProcs:
PROC = {
i, j: INT ← 0;
nest1:
PROC = {
i ← 1;
BreakPlace[i];
j ← 1;
};
nest2:
PROC = {
i ← 2;
FOR k:
INT
IN [0..2)
DO
kk: INT ← k;
BreakPlace[i];
ENDLOOP;
j ← 2;
};
nest3:
PROC = {
i ← 3;
FOR k:
INT
IN [0..2)
DO
kk: INT ← k;
BreakPlace[i];
kk ← k + 1;
ENDLOOP;
j ← 3;
};
BreakPlace[0];
nest1[];
nest2[];
nest3[];
BreakPlace[4]
};
BreakPlace:
PROC [x:
INT] = {
x ← x + 1
};
DefaultArgTest:
PROC
[int: INTEGER ← 1, card: CARDINAL ← 2, lint: INT ← 3, c: CHAR ← 'A, r: REF ← NIL,
z: ZONE ← NIL, uz: UNCOUNTED ZONE ← NIL]
RETURNS [INTEGER, CARDINAL, INT, CHAR, REF, ZONE, UNCOUNTED ZONE] = {
RETURN [int, card, lint, c, r, z, uz]
};
PriorityQueueCreate:
PROC
RETURNS [PriorityQueue.Ref] = {
RETURN [PriorityQueue.Create[RopeSortPred]]};
RopeSortPred: PriorityQueue.SortPred = {
RETURN [Rope.Compare[NARROW[x], NARROW[y], FALSE] = less]};
ShowTV:
PROC [tv:
TV, delta:
INTEGER ← 2] = {
type, under: Type;
st: IO.STREAM ← UserExec.GetStreams[UserExec.GetExecHandle[]].out;
put: PrintTV.PutClosure;
put1: PrintTV.PutProc = {st.PutChar[c]};
TRUSTED {put ← [put1]}; -- sigh
BBBugOut.ShowRope["\n tv: ", put];
BBBugOut.ShowTV[tv, delta, put];
BBBugOut.ShowRope["\n type: ", put];
type ← TVType[tv];
BBBugOut.ShowType[type, put];
SELECT
TRUE
FROM
AMTypes.TypeClass[type] = type => {
BBBugOut.ShowRope["\n = ", put];
type ← AMTypes.TVToType[tv];
BBBugOut.ShowType[type, put];
under ← UnderType[type];
IF under # type
THEN
{BBBugOut.ShowRope["\n (", put];
BBBugOut.ShowType[under, put];
BBBugOut.ShowRope[")", put]};
};
(under ← UnderType[type]) # type => {
BBBugOut.ShowRope["\n under: ", put];
BBBugOut.ShowType[under, put];
};
ENDCASE;
BBBugOut.ShowRope["\n", put];
};
ShowBoth:
PROC [ref:
REF] = {
ShowReferent[NEW[REF ← ref]];
};
ShowReferent:
PROC [ref:
REF] =
TRUSTED {
tv: TV ← AMBridge.TVForReferent[ref];
ShowTV[tv];
};
CheckBreaks:
PROC =
TRUSTED {
FOR bx: BBBreak.BreakIndex ← BBBreak.NextBreak[], BBBreak.NextBreak[bx]
UNTIL bx = BBBreak.NullIndex DO
bid: BBBreak.BreakId ← BBBreak.FindBreakId[bx];
IF bid #
NIL
THEN {
loc: BBObjectLocation.Location ← bid.loc;
gf: TV;
pc: PrincOps.BytePC;
byte: PrincOps.BYTE;
[gf, pc] ← BBObjectLocation.GFandPCFromLocation[loc];
byte ← ReadCodeByte[gf, pc];
IF byte # Mopcodes.zBRK
THEN {
a bug, I fear
other: PrincOps.BYTE ← ReadCodeByte[gf, pc];
BBBugOut.ShowRope[" break bug for #"];
BBBugOut.ShowDecimal[bx];
BBBugOut.ShowRope["!\n"];
};
};
ENDLOOP;
};
SwapOutBreaks:
PROC =
TRUSTED {
FOR bx: BBBreak.BreakIndex ← BBBreak.NextBreak[], BBBreak.NextBreak[bx]
UNTIL bx = BBBreak.NullIndex DO
bid: BBBreak.BreakId ← BBBreak.FindBreakId[bx];
IF bid #
NIL
THEN {
loc: BBObjectLocation.Location ← bid.loc;
gf: TV;
pc: PrincOps.BytePC;
cb: PrincOps.FrameCodeBase;
addr: LONG CARDINAL;
page: CARDINAL;
space: Space.Handle;
[gf, pc] ← BBObjectLocation.GFandPCFromLocation[loc];
cb ← AMBridge.GFHFromTV[gf].code;
cb.out ← FALSE;
addr ← LOOPHOLE[cb.longbase, LONG CARDINAL] + pc/2;
page ← Space.PageFromLongPointer[LOOPHOLE[addr, LONG POINTER]];
space ← Space.GetHandle[page];
Space.Deactivate[space];
};
ENDLOOP;
};
ReadCodeByte:
PROC
[gf: TV, pc: PrincOps.BytePC]
RETURNS [PrincOps.BYTE] = TRUSTED {
cb: PrincOps.FrameCodeBase ← AMBridge.GFHFromTV[gf].code;
cb.out ← FALSE;
{
addr: LONG CARDINAL ← LOOPHOLE[cb.longbase, LONG CARDINAL]+pc/2;
iword: PrincOps.InstWord ← LOOPHOLE[WorldVM.Read[WorldVM.LocalWorld[], addr]];
RETURN [IF pc MOD 2 = 0 THEN iword.evenbyte ELSE iword.oddbyte]}};
LookupGF:
PROC [rope:
ROPE]
RETURNS [
TV] =
TRUSTED {
RETURN [BBContext.GlobalFrameSearch[NIL, rope, NIL, FALSE].gf];
};
LocFromSource:
PROC
[gf: TV, index: CARDINAL] RETURNS [loc: BBObjectLocation.Location] = TRUSTED {
loc ← BBObjectLocation.SourceToLocation[gf, index];
};
Enable:
PROC =
TRUSTED {
[] ← BBNub.FindWorld["Local", TRUE];
};
Disable:
PROC =
TRUSTED {
[] ← BBNub.TurnADeafEar[WorldVM.LocalWorld[]];
};
NewStaticParent:
PROC [tv:
TV]
RETURNS [
TV] =
TRUSTED {
SELECT AMTypes.UnderClass[AMTypes.TVType[tv]]
FROM
globalFrame => RETURN [NIL];
localFrame => {
procTV: TV ← NIL;
world: WorldVM.World ← AMBridge.GetWorld[tv];
link: CARDINAL ← 0;
procTV ← AMTypes.Procedure[
tv
! AMTypes.Error => IF reason = typeFault THEN CONTINUE ELSE REJECT];
IF procTV #
NIL
THEN {
nextProc: TV ← AMTypes.StaticParent[procTV];
SELECT AMTypes.UnderClass[AMTypes.TVType[nextProc]]
FROM
procedure => {};
ENDCASE => RETURN [AMTypes.GlobalParent[tv]];
};
link ← AMBridge.OctalRead[tv, PrincOps.localbase];
IF link <= PrincOps.localbase THEN RETURN [NIL];
link ← link - PrincOps.localbase;
IF world = WorldVM.LocalWorld[]
THEN RETURN [AMBridge.TVForFrame[LOOPHOLE[link]]]
ELSE
RETURN [AMBridge.TVForRemoteFrame[[
world: world,
worldIncarnation: WorldVM.CurrentIncarnation[world],
fh: LOOPHOLE[link]]]];
};
ENDCASE => RETURN [AMTypes.StaticParent[tv]];
};
TRUSTED {
pvt1 ← @vt1;
qvt1 ← LOOPHOLE[pvt1];
pvt2 ← @vt2;
pvt3 ← @vt3;
pvt4 ← @vt4;
};
END.