-- DIHot.mesa last edit:
-- Bruce October 28, 1980 12:14 PM
-- Sandman July 18, 1980 8:05 AM
DIRECTORY
BP USING [Condition],
ComData USING [typeCARDINAL, typeCHAR, typeINT, typeSTRING],
CompilerUtil USING [PrintTree],
DebugFormat USING [Foo, Fob, NullFob],
DebugOps USING [
DisplayFoo, Foo, FooProc, Lengthen, SyntaxError],
DebugUsefulDefs USING [],
DI USING [
AbortWithError, CSEIndex, CTXIndex, DerefProcDesc, Err, Error, FindField, Foo,
GetControlLink, GetValue, HTIndex, ISEIndex, MakeLongType, NotAProcedure, Number,
NumberType, Pad, PutValue, RecordSEIndex, SearchCtxList, SEIndex,
TagIsei, TypeForSe, UnionSEIndex, VariantType, Words],
DIActions USING [
Abs, Assignable, Base, DoApply, DumpArray, DumpMemory,
FoldExpr, GetSize, Interval, Length, LengthenFob, Long,
MakePointerType, MakeXferType, Max, Memory, Min, nullError, nullProc, nullSig,
PushNil, PutLongReps, PutReps, SelectVariantType, Size, TotalWords, TreeType,
VariantUnionType,
exp, memoryInt, arrayInt, conditionalBreak, eol, frameDollar, fileDollar, typeDollar,
card, lcard, int, lint, bang, memory, reps],
DOutput USING [EOL, NewLine],
DSyms USING [GFHandle, GFrameHti, Shared],
Frames USING [Type],
Gf USING [FrameGfi, Handle, NewLink, Validate],
DHeap USING [AllocFob, FreeLong],
Inline USING [HighHalf, LowHalf],
Lf USING [GF],
Literals USING [LitRecord],
Lookup USING [
Complete, CopyLiteral, HTIndex, InCtx, InLF, InMod, Mode, OnStack, Proc, Signal],
MachineDefs USING [GFHandle],
P1 USING [DParse, PrintNodeName],
PrincOps USING [SignalDesc],
State USING [Get, GetGS, GSHandle, Handle, Stack, top],
Storage USING [Free, FreeString, Node, String],
String USING [AppendChar, AppendString],
SymbolOps USING [FirstCtxSe, NextSe, TypeRoot, UnderType, WordsForType],
Symbols USING [
ArraySEIndex, CSEIndex, CTXIndex, HTIndex, HTNull, ISEIndex, ISENull,
SEIndex, seType, typeANY],
SymbolTable USING [Missing],
Table USING [AddNotify, Base, DropNotify, Notifier],
Tree USING [Index, Link, NodeName, Null, Scan, treeType],
TreeOps USING [FreeTree, OpName, PopTree, ScanList];
DIHot: PROGRAM
IMPORTS BP, com: ComData, CompilerUtil, DebugOps, DI, DIActions,
DOutput, DSyms, Frames, Gf, DHeap, Inline, Lf, Lookup, P1, State, Storage,
String, SymbolOps, SymbolTable, Table, TreeOps
EXPORTS DebugOps, DebugUsefulDefs, DI, DIActions =
BEGIN OPEN DI, DIActions;
Underflow: PUBLIC ERROR = CODE;
StackNotEmptyAtStatement: PUBLIC ERROR = CODE;
NotImplemented: PUBLIC SIGNAL [msg: STRING] = CODE;
DIAbort: PUBLIC ERROR = CODE;
BadTree: ERROR = CODE;
WhosBeenScanningMyTree: ERROR = CODE;
CantAssignInDebuggerImage: ERROR = CODE;
data: State.GSHandle ← State.GetGS[];
dereferenced: PUBLIC BOOLEAN;
target: Symbols.CSEIndex;
Interpreter: PUBLIC PROC [exp: STRING] = {Interpret[exp,NIL]};
Interpret: PUBLIC PROC [
exp: STRING, results: DebugOps.FooProc ← DebugOps.DisplayFoo,
targetType: Symbols.CSEIndex ← Symbols.typeANY] =
BEGIN
t: Tree.Link;
copy: BOOLEAN = exp.length = exp.maxlength;
temp: STRING ← IF copy THEN Storage.String[exp.length+1] ELSE NIL;
CleanupString: PROC =
BEGIN
IF copy THEN Storage.FreeString[temp]
ELSE exp.length ← exp.length - 1;
END;
Cleanup: PROC =
BEGIN
Drop[];
[] ← TreeOps.FreeTree[t];
ResetStack[];
CleanupString[];
END;
IF copy THEN {String.AppendString[temp,exp]; exp ← temp};
String.AppendChar[exp,'\];
IF ~P1.DParse[exp !UNWIND => CleanupString[]] THEN
BEGIN CleanupString[]; SIGNAL DebugOps.SyntaxError[0] END;
t ← TreeOps.PopTree[];
IF data.tree THEN CompilerUtil.PrintTree[t];
Add[];
State.Get[].h.proc ← results;
target ← targetType;
ProcessTree[t ! UNWIND => Cleanup[]];
Cleanup[];
END;
ProcessTree: Tree.Scan =
BEGIN OPEN TreeOps;
IF t = Tree.Null THEN RETURN;
t ← CheckNode[t,eol];
t ← CheckNode[t,block];
ScanList[t,Exp];
CheckForStackEmpty[];
END;
CheckNode: PUBLIC PROCEDURE [t: Tree.Link, name: Tree.NodeName]
RETURNS [son1: Tree.Link] =
BEGIN
IF TreeOps.OpName[t] # name THEN ERROR BadTree;
Add[];
WITH t SELECT FROM
subtree => son1 ← tb[index].son[1];
ENDCASE => {Drop[]; ERROR BadTree};
Drop[];
END;
CheckLink: PUBLIC PROC [t: Tree.Link, type: TreeType] RETURNS [UNSPECIFIED] =
BEGIN
WITH t SELECT FROM
subtree => IF type = subtree THEN RETURN[index];
hash => IF type = hash THEN RETURN[index];
symbol => IF type = symbol THEN RETURN[index];
literal => IF type = literal THEN RETURN[info];
ENDCASE => ERROR BadTree;
ERROR WhosBeenScanningMyTree;
END;
seb: Table.Base;
tb: Table.Base;
hot: PUBLIC CARDINAL ← 0;
Notify: Table.Notifier =
BEGIN
tb ← base[Tree.treeType];
seb ← base[Symbols.seType];
END;
Add: PROCEDURE =
BEGIN
IF hot = 0 THEN Table.AddNotify[Notify];
hot ← hot + 1;
END;
Drop: PROCEDURE =
BEGIN
IF (hot ← hot-1) = 0 THEN Table.DropNotify[Notify];
END;
Exp: Tree.Scan =
BEGIN ENABLE {DIAbort => GOTO cleanExit; UNWIND => Drop[]};
son1: Foo;
IF t = Tree.Null THEN RETURN;
Add[];
WITH t SELECT FROM
subtree =>
BEGIN OPEN TreeOps;
SELECT tb[index].name FROM
exp =>
BEGIN
son1 ← FirstSon[index, target];
IF son1↑ # DebugFormat.NullFob THEN State.Get[].h.proc[son1];
END;
memoryInt =>
BEGIN
son1 ← FirstSon[index, MakeLongType[com.typeCARDINAL]];
DumpMemory[son1];
END;
arrayInt =>
BEGIN
son1 ← FirstSon[index, target];
Work[tb[index].son[2], seb[ArraySei[son1]].indexType];
DumpArray[son1];
END;
reps =>
BEGIN
n: Number;
son1 ← FirstSon[index, target];
n ← GetNumber[son1];
SELECT n.type FROM
one => PutReps[n.u];
two => PutLongReps[n.lu];
ENDCASE;
END;
assign =>
BEGIN
rhs: Foo;
son1 ← FirstSon[index, target];
TargetTypeWork[tb[index].son[2], son1.tsei];
rhs ← Pop[];
PutValue[son1,rhs.addr.base]
END;
eol => {
IF ~DOutput.NewLine[] THEN DOutput.EOL[];
Exp[tb[index].son[1]];
DOutput.EOL[]; CheckForStackEmpty[]};
conditionalBreak => {
IF State.Get[].h.howSet # break THEN AbortWithError[relation];
dereferenced ← FALSE;
Work[tb[index].son[1]]};
ENDCASE => ERROR WhosBeenScanningMyTree;
END;
ENDCASE => ERROR BadTree;
Drop[];
EXITS
cleanExit => {ResetStack[]; RETURN};
END;
ArraySei: PROC [f: Foo] RETURNS [asei: Symbols.ArraySEIndex] =
BEGIN
csei: CSEIndex ← TypeForSe[f.tsei];
DO
WITH seb[csei] SELECT FROM
array => {asei ← LOOPHOLE[csei]; EXIT};
arraydesc => {asei ← LOOPHOLE[SymbolOps.UnderType[describedType]]; EXIT};
ref => csei ← TypeForSe[refType];
long => csei ← TypeForSe[rangeType];
ENDCASE => AbortWithError[notArray,f.hti];
ENDLOOP;
END;
FirstSon: PUBLIC PROC [index: Tree.Index, type: SEIndex ← Symbols.typeANY]
RETURNS [f: Foo] =
BEGIN
son: Tree.Link;
Add[];
son ← tb[index].son[1];
Work[son, type ! UNWIND => Drop[]];
Drop[];
f ← IF son # Tree.Null THEN Pop[] ELSE NIL;
END;
Son: PUBLIC PROC [t: Tree.Link, target: Symbols.SEIndex] RETURNS [Foo] =
BEGIN
IF t = Tree.Null THEN ERROR WhosBeenScanningMyTree;
Work[t, target];
RETURN[Tos[]];
END;
NumberWork: PUBLIC PROC [t: Tree.Link, number, target: Symbols.SEIndex] =
BEGIN
csei: Symbols.SEIndex;
target ← TypeForSe[target];
csei ← SELECT TRUE FROM
target = Symbols.typeANY => number,
SymbolOps.WordsForType[target] # 1 => number,
ENDCASE => target;
TargetTypeWork[t, csei];
END;
Work: PUBLIC PROC [t: Tree.Link, type: Symbols.SEIndex ← Symbols.typeANY] =
BEGIN
IF t = Tree.Null THEN RETURN;
WITH t SELECT FROM
subtree => SubtreeWork[index,type];
hash => Push[HashWork[index,type]];
symbol => Push[SymbolWork[index]];
literal => Push[FindLiteral[info]];
ENDCASE => ERROR BadTree;
END;
LoopHoleWork: PUBLIC PROC [t: Tree.Link, type: Symbols.SEIndex] =
BEGIN
f: Foo ← NIL;
literal: BOOLEAN ← FALSE;
IF t = Tree.Null THEN RETURN;
WITH t SELECT FROM
subtree => {
SubtreeWork[index,type];
f ← Pop[];
SELECT tb[index].name FROM
int, card => literal ← TRUE;
ENDCASE};
hash => f ← HashWork[index,type];
literal => {literal ← TRUE; f ← FindLiteral[info]};
ENDCASE => ERROR BadTree;
IF literal AND
(SELECT type FROM nullProc, nullSig, nullError => TRUE, ENDCASE => FALSE)
THEN f.addr.base↑ ← Gf.NewLink[f.addr.base↑];
LoopHole[f,type,TRUE];
Push[f];
END;
TargetTypeWork: PUBLIC PROC [t: Tree.Link, type: Symbols.SEIndex] =
BEGIN
f: Foo ← NIL;
IF t = Tree.Null THEN RETURN;
WITH t SELECT FROM
subtree => {SubtreeWork[index,type]; f ← Pop[]};
hash => f ← HashWork[index,type];
literal => {f ← FindLiteral[info]; FixupLiteral[f,type]};
ENDCASE => ERROR BadTree;
Assignable[f,TypeForSe[type]];
Push[f];
END;
FixupLiteral: PROC [f: Foo, type: Symbols.SEIndex] = {
csei: Symbols.CSEIndex ← TypeForSe[type];
f.tsei ← csei;
SELECT csei FROM
com.typeCARDINAL, Symbols.typeANY, com.typeINT => NULL;
ENDCASE => {
WITH seb[csei] SELECT FROM
long => IF NumberLength[f] = one THEN Long[f, rangeType = com.typeINT];
ENDCASE } };
SymbolWork: PROC [index: Symbols.SEIndex] RETURNS [f: Foo] = INLINE
BEGIN
f ← DHeap.AllocFob[];
f.tsei ← index;
f.typeOnly ← TRUE;
END;
HashWork: PROC [index: Symbols.HTIndex, hint: Symbols.SEIndex]
RETURNS [f: Foo] =
BEGIN
f ← NIL;
IF hint # Symbols.typeANY THEN {
csei: Symbols.CSEIndex ← TypeForSe[hint];
DO
WITH seb[csei] SELECT FROM
enumerated => f ← Lookup.InCtx[index, valueCtx];
subrange => {csei ← TypeForSe[rangeType]; LOOP};
ENDCASE;
IF f # NIL THEN RETURN ELSE EXIT;
ENDLOOP};
f ← Lookup.OnStack[index];
IF f = NIL THEN AbortWithError[notFound, index];
END;
SubtreeWork: PROC [index: Tree.Index, type: Symbols.SEIndex] =
BEGIN OPEN TreeOps;
SELECT tb[index].name FROM
plus, minus, times, div, mod =>
BEGIN
f: Foo ← FirstSon[index, type];
LoopHoleWork[tb[index].son[2], type];
Push[f];
FoldExpr[tb[index].name];
END;
relE, relN, relL, relLE, relG, relGE =>
BEGIN
f: Foo ← FirstSon[index];
TargetTypeWork[tb[index].son[2],TypeForSe[f.tsei]];
BP.Condition[left: f, rel: tb[index].name, right: Pop[]];
END;
uminus =>
BEGIN
Work[tb[index].son[1]];
FoldExpr[uminus];
END;
base => Base[FirstSon[index],type];
length => Length[FirstSon[index], type];
size => Size[FirstSon[index]];
clit =>
BEGIN
f: Foo ← FindLiteral[CheckLink[tb[index].son[1], literal]];
f.tsei ← com.typeCHAR;
f.addr.offset ← 8;
Push[f];
END;
mwconst =>
BEGIN
f: Foo ← FindLiteral[CheckLink[tb[index].son[1], literal]];
f.tsei ← type;
Push[f];
END;
lint => Work[tb[index].son[1], MakeLongType[com.typeINT]];
lcard => Work[tb[index].son[1], MakeLongType[com.typeCARDINAL]];
int => NumberWork[tb[index].son[1], com.typeINT, type];
card => NumberWork[tb[index].son[1], com.typeCARDINAL, type];
typeDollar =>
BEGIN
id: Symbols.HTIndex ← CheckLink[tb[index].son[2], hash];
mod: Symbols.HTIndex ← CheckLink[tb[index].son[1], hash];
f: Foo ← Lookup.InMod[id,mod ! DSyms.Shared => AbortWithError[wrongDollar,mod]];
IF f = NIL THEN AbortWithError[notFound,id];
IF ~f.typeOnly THEN Error[notType, id];
Push[f];
END;
addr => TakeAddress[FirstSon[index,type]];
uparrow =>
BEGIN
f: Foo ← Son[tb[index].son[1],type];
IF ~Deref[f] THEN AbortWithError[invalidPointer, f.hti];
END;
dot => Qualify[FirstSon[index],CheckLink[tb[index].son[2], hash]];
apply => DoApply[tb[index].son[2], FirstSon[index]];
loophole => {
f: Foo;
IF tb[index].son[2] = Tree.Null THEN {
Work[tb[index].son[1], type];
f ← Tos[];
LoopHole[f, type]}
ELSE
BEGIN
Work[tb[index].son[2],type];
f ← Pop[];
IF ~f.typeOnly THEN Error[notType, f.hti];
LoopHoleWork[tb[index].son[1],f.tsei];
END };
fileDollar =>
BEGIN
id: Symbols.HTIndex ← CheckLink[tb[index].son[2], hash];
mod: Symbols.HTIndex ← CheckLink[tb[index].son[1], hash];
f: Foo ← Lookup.InMod[id,mod ! DSyms.Shared => AbortWithError[wrongDollar,mod]];
IF f = NIL THEN AbortWithError[notFound,id];
Push[f];
END;
frameDollar =>
BEGIN
id: Symbols.HTIndex ← CheckLink[tb[index].son[2], hash];
f: Foo ← FindLiteral[CheckLink[tb[index].son[1], literal]];
f ← Lookup.InLF[id,f.addr.base↑];
IF f = NIL THEN AbortWithError[notFound,id];
Push[f];
END;
memory => Memory[tb[index].son[1],type];
nil => PushNil[FirstSon[index,type]];
procTC =>
BEGIN
f: Foo ← DHeap.AllocFob[];
f.tsei ← MakeXferType[proc];
f.typeOnly ← TRUE;
Push[f];
END;
errorTC =>
BEGIN
f: Foo ← DHeap.AllocFob[];
f.tsei ← MakeXferType[error];
f.typeOnly ← TRUE;
Push[f];
END;
signalTC =>
BEGIN
f: Foo ← DHeap.AllocFob[];
f.tsei ← MakeXferType[signal];
f.typeOnly ← TRUE;
Push[f];
END;
longTC =>
BEGIN
f: Foo ← Son[tb[index].son[1],type];
f.tsei ← MakeLongType[f.tsei];
END;
pointerTC =>
BEGIN
f: Foo ← Son[tb[index].son[1],type];
f.tsei ← MakePointerType[f.tsei];
END;
discrimTC =>
BEGIN
f: Foo ← Son[tb[index].son[1],type];
f.tsei ← SelectVariantType[f.tsei, CheckLink[tb[index].son[2],hash]];
END;
lengthen =>
BEGIN
f: Foo ← Son[tb[index].son[1],type];
LengthenFob[f];
END;
abs => Abs[tb[index].son[1],type];
min =>
BEGIN
size: NumberType;
cnt: CARDINAL;
signed: BOOLEAN;
[size,cnt,signed] ← GetSize[index,type];
Min[size,cnt,signed];
END;
max =>
BEGIN
size: NumberType;
cnt: CARDINAL;
signed: BOOLEAN;
[size,cnt,signed] ← GetSize[index,type];
Max[size,cnt,signed];
END;
intOO => Interval[
t: tb[index].son[1], type: type, openLow: TRUE, openHigh: TRUE];
intOC => Interval[t: tb[index].son[1], type: type, openLow: TRUE];
intCO => Interval[t: tb[index].son[1], type: type, openHigh: TRUE];
intCC => Interval[t: tb[index].son[1], type: type];
bang => Interval[t: tb[index].son[1], type: type, cntOnly: TRUE];
ENDCASE => NotImpl[tb[index].name];
END;
NotImpl: PROC [name: Tree.NodeName] = {
P1.PrintNodeName[name]; SIGNAL NotImplemented[NIL]};
Deref: PUBLIC PROC [f: Foo] RETURNS [success: BOOLEAN] =
BEGIN
tsei: Symbols.CSEIndex ← TypeForSe[f.tsei];
ref: SEIndex;
n: Number;
Add[];
DO
WITH seb[tsei] SELECT FROM
ref => {
dereferenced ← TRUE;
IF ~f.typeOnly THEN {ref ← TypeForSe[refType]; EXIT}
ELSE {
f↑ ← DebugFormat.NullFob; f.tsei ← refType; f.typeOnly ← TRUE;
WITH seb[refType] SELECT FROM
id => f.hti ← hash;
ENDCASE;
Drop[]; RETURN[TRUE]}};
long => tsei ← TypeForSe[rangeType];
subrange => tsei ← TypeForSe[rangeType];
ENDCASE => GOTO cant;
ENDLOOP;
Drop[];
n ← GetNumber[f, invalidPointer];
DHeap.FreeLong[f.addr.base];
SELECT n.type FROM
one => f.addr.base ← DebugOps.Lengthen[n.p];
two => f.addr.base ← n.lp;
ENDCASE;
IF f.addr.base = NIL THEN AbortWithError[nilChk,f.hti];
f.tsei ← ref; f.words ← SymbolOps.WordsForType[ref];
f.hti ← Symbols.HTNull;
f.typeOnly ← FALSE;
f.addr.offset ← 0;
f.addr.useStack ← FALSE;
f.bits ← 0;
f.there ← TRUE;
RETURN[TRUE];
EXITS cant => {Drop[]; RETURN[FALSE]};
END;
Qualify: PUBLIC PROC [f: Foo, hti: Symbols.HTIndex] =
BEGIN OPEN Symbols;
original, root: CSEIndex;
Add[];
WHILE Deref[f] DO NULL ENDLOOP;
original ← TypeForSe[f.tsei];
root ← SymbolOps.TypeRoot[original];
SELECT TRUE FROM
QualifyCsei[f,hti,original] => {Drop[]; RETURN};
root # original => IF QualifyCsei[f,hti,root] THEN {Drop[]; RETURN};
ENDCASE;
Drop[];
AbortWithError[notValidField,hti];
END;
QualifyCsei: PUBLIC PROC [f: Foo, hti: Symbols.HTIndex, csei: Symbols.CSEIndex]
RETURNS [found: BOOLEAN] =
BEGIN OPEN Symbols;
pad: CARDINAL;
WITH seb[csei] SELECT FROM
record =>
BEGIN
pad ← DI.Pad[f,LOOPHOLE[csei]];
IF SearchCtx[f, fieldCtx, hti, pad] THEN RETURN[TRUE];
IF hints.variant THEN RETURN[SearchVariants[
f,hti,pad,LOOPHOLE[VariantUnionType[LOOPHOLE[csei]]]]];
END;
definition => {
temp: DebugFormat.Fob ← DebugFormat.NullFob;
p: POINTER ← State.Get[].h.interpretContext;
isei: ISEIndex = SearchCtxList[hti,defCtx];
reallyThere: BOOLEAN;
IF isei = ISENull THEN RETURN [FALSE];
temp.addr.base ← DebugOps.Lengthen[IF Frames.Type[p] = local THEN Lf.GF[p] ELSE p];
temp.tsei ← f.tsei; temp.there ← TRUE; temp.indent ← f.indent;
reallyThere ← SELECT Lookup.Mode[isei] FROM
refVal => TRUE,
refProc => FALSE,
ENDCASE => FALSE;
found ← SearchCtx[@temp,defCtx,hti,0];
IF found THEN Tos[].f.there ← reallyThere;
RETURN};
ENDCASE => {Drop[]; AbortWithError[typeMismatch,f.hti]};
RETURN[FALSE];
END;
SearchCtx: PROC [f: Foo, ctx: CTXIndex, hti: HTIndex, pad: CARDINAL]
RETURNS [BOOLEAN] =
BEGIN OPEN Symbols;
isei: ISEIndex ← SearchCtxList[hti,ctx];
field: Foo;
IF isei = ISENull THEN RETURN [FALSE];
IF f.typeOnly THEN {
field ← DHeap.AllocFob[]; field↑ ← f↑;
field.hti ← seb[isei].hash; field.tsei ← isei}
ELSE field ← FindField[f, pad, isei];
IF field = NIL THEN RETURN [FALSE];
Push[field];
RETURN[TRUE];
END;
SearchRecord: PROC [
f: Foo, rsei: RecordSEIndex, hti: HTIndex, pad: CARDINAL]
RETURNS [BOOLEAN] = INLINE
BEGIN RETURN[SearchCtx[f,seb[rsei].fieldCtx,hti,pad]] END;
SearchVariants: PROC [
f: Foo, hti: HTIndex, pad: CARDINAL, usei: UnionSEIndex]
RETURNS [BOOLEAN] =
BEGIN OPEN Symbols;
isei: ISEIndex;
IF usei = typeANY THEN RETURN [FALSE];
SELECT VariantType[usei] FROM
controlled =>
BEGIN
isei ← seb[usei].tagSei;
IF seb[isei].hash = hti THEN {
field: Foo ← FindField[f, pad, isei];
IF field = NIL THEN RETURN [FALSE];
Push[field]; RETURN[TRUE]};
isei ← TagIsei[f,pad,usei];
IF isei = ISENull THEN RETURN [FALSE];
RETURN[SearchRecord[f,seb[isei].idInfo,hti,pad]];
END;
overlaid =>
BEGIN OPEN SymbolOps, seb[usei];
Lookup.Complete[caseCtx];
FOR isei ← FirstCtxSe[caseCtx], NextSe[isei] UNTIL isei = ISENull DO
IF SearchRecord[f,seb[isei].idInfo,hti,pad] THEN RETURN[TRUE];
ENDLOOP;
RETURN[FALSE];
END;
computed =>
BEGIN OPEN SymbolOps, seb[usei];
cnt: CARDINAL ← 0;
Lookup.Complete[caseCtx];
FOR isei ← FirstCtxSe[caseCtx], NextSe[isei] UNTIL isei = ISENull DO
IF SearchRecord[f,seb[isei].idInfo,hti,pad] THEN cnt ← cnt + 1;
IF cnt > 1 THEN AbortWithError[notUniqueField,hti];
ENDLOOP;
RETURN[cnt = 1];
END;
ENDCASE => ERROR;
END;
TakeAddress: PROC [f: Foo] =
BEGIN
addr: LONG POINTER = f.addr.base;
tsei: Symbols.SEIndex = MakePointerType[f.tsei];
IF f.addr.offset # 0 OR ~f.there THEN AbortWithError[invalidAddress,f.hti];
IF Inline.HighHalf[addr] = data.mds THEN PushVal[Inline.LowHalf[addr], tsei]
ELSE PushLongVal[addr,tsei];
END;
LoopHole: PUBLIC PROC [
f: Foo, type: Symbols.SEIndex, lengthen: BOOLEAN ← FALSE] =
BEGIN
tSize: CARDINAL;
checkSize: BOOLEAN ← TRUE;
csei: Symbols.CSEIndex = TypeForSe[type];
Add[];
WITH seb[csei] SELECT FROM
subrange => checkSize ← range # 0;
ENDCASE;
Drop[];
SELECT TRUE FROM
f = NIL => RETURN;
f.tsei = type => RETURN;
type = nullProc =>
type ← LoopHoleControlLink[f,Lookup.Proc ! NotAProcedure => GO TO notProc];
type = nullSig OR type = nullError =>
type ← LoopHoleControlLink[f,Lookup.Signal ! NotAProcedure => GO TO notProc];
~checkSize => NULL;
TotalWords[f] = (tSize ← SymbolOps.WordsForType[csei]) => NULL;
~lengthen => AbortWithError[sizeMismatch];
tSize # 2 => AbortWithError[sizeMismatch];
~CheckLength[f,1] => AbortWithError[sizeMismatch];
ENDCASE => LengthenFob[f];
f.tsei ← type;
EXITS notProc => AbortWithError[notProcDesc];
END;
LoopHoleControlLink: PROC [
f: Foo, proc: PROC [PrincOps.SignalDesc] RETURNS [Symbols.ISEIndex]]
RETURNS [Symbols.SEIndex] =
BEGIN
desc: PrincOps.SignalDesc = LOOPHOLE[DerefProcDesc[GetControlLink[f]]];
gf: MachineDefs.GFHandle = Gf.FrameGfi[desc.gfi];
isei: Symbols.ISEIndex ← Symbols.ISENull;
IF ~Gf.Validate[gf] THEN AbortWithError[notProcDesc];
isei ← proc[desc ! SymbolTable.Missing => CONTINUE];
IF isei # Symbols.ISENull THEN RETURN[TypeForSe[isei]];
AbortWithError[notFound, DSyms.GFrameHti[gf]];
ERROR;
END;
FindLiteral: PROCEDURE [info: Literals.LitRecord] RETURNS [f: Foo] =
BEGIN
f ← DHeap.AllocFob[];
[f.addr.base, f.words] ← Lookup.CopyLiteral[info];
WITH info SELECT FROM
string => f.tsei ← com.typeSTRING;
ENDCASE => f.tsei ← Symbols.typeANY;
END;
CheckLength: PUBLIC PROC [f: Foo, size: CARDINAL] RETURNS [BOOLEAN] =
BEGIN
IF f.words # size OR f.bits # 0 OR f.addr.offset # 0 THEN
RETURN[FALSE]
ELSE RETURN[TRUE];
END;
NumberLength: PUBLIC PROC [f: Foo] RETURNS [nt: NumberType] =
BEGIN
IF CheckLength[f,1] THEN RETURN[one];
IF CheckLength[f,2] THEN RETURN[two];
RETURN[nogood]
END;
GetNumber: PUBLIC PROC [f: Foo, code: Err ← invalidNumber] RETURNS [n: Number] =
BEGIN
p: LONG POINTER TO Words;
size: CARDINAL = TotalWords[f];
csei: Symbols.CSEIndex;
IF size ~IN[1..2] THEN AbortWithError[code] ELSE n.type ← LOOPHOLE[size];
GetValue[f];
p ← f.addr.base;
FOR i: NumberType IN [nogood..n.type) DO
n.w[i] ← p[i];
ENDLOOP;
IF (csei ← TypeForSe[f.tsei]) = com.typeCARDINAL THEN RETURN;
Add[];
WITH seb[csei] SELECT FROM
subrange =>
IF n.type = one THEN n.i ← n.i + origin ELSE AbortWithError[invalidSubrange];
ENDCASE;
Drop[];
END;
Stack: TYPE = State.Stack;
PushVal: PUBLIC PROC [u: UNSPECIFIED, tsei: Symbols.SEIndex] =
BEGIN
f: Foo ← DHeap.AllocFob[];
p: POINTER TO UNSPECIFIED;
f.addr.base ← p ← Storage.Node[SIZE[UNSPECIFIED]];
p↑ ← u; f.words ← 1;
f.tsei ← tsei;
Push[f];
END;
PushLongVal: PUBLIC PROC [lu: LONG UNSPECIFIED, tsei: Symbols.SEIndex] =
BEGIN
f: Foo ← DHeap.AllocFob[];
p: POINTER TO LONG UNSPECIFIED;
f.addr.base ← p ← Storage.Node[SIZE[LONG UNSPECIFIED]];
p↑ ← lu; f.words ← 2;
f.tsei ← MakeLongType[tsei];
Push[f];
END;
Push: PUBLIC PROCEDURE [f: Foo] =
BEGIN
h: State.Handle ← State.Get[];
new: POINTER TO Stack ← Storage.Node[SIZE[Stack]];
new↑ ← [h.fooStack,f];
h.fooStack ← new;
END;
Pop: PUBLIC PROCEDURE RETURNS [f: Foo] =
BEGIN
h: State.Handle ← State.Get[];
old: POINTER TO Stack ← h.fooStack;
IF old = NIL THEN ERROR Underflow;
f ← old.foo;
h.fooStack ← old.link;
Storage.Free[old];
END;
ResetStack: PROCEDURE =
BEGIN
h: State.Handle ← State.Get[];
top, next: POINTER TO Stack;
FOR top ← h.fooStack, next UNTIL top = NIL DO
next ← top.link;
Storage.Free[top];
ENDLOOP;
h.fooStack ← NIL;
END;
Tos: PUBLIC PROCEDURE RETURNS [f: Foo] =
BEGIN
h: State.Handle ← State.Get[];
old: POINTER TO Stack ← h.fooStack;
IF old = NIL THEN ERROR Underflow;
RETURN[old.foo];
END;
CheckForStackEmpty: PUBLIC PROCEDURE =
BEGIN
IF State.Get[].h.fooStack # NIL THEN ERROR StackNotEmptyAtStatement;
END;
END.