
<<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.