Skip to main content

Full text of "xerox :: mesa :: 4.0 1978 :: listing :: Mesa 4 Debug :: DIActionsHot.mesa Sep78"

See other formats


DIActionsHot.mesa 2-Sop-78 15:32:14 Page 



-- file DIActionsHot .Mesa 
-- Edited by: 

Sandman, April 17, 1978 4:13 PM 

Barbara, July 31, 1978 5:15 PM 

Johnsson, August 29, 1978 9:52 AM 

DIRECTORY 

AUoDefs: FROM "altodefs" USING [wordlength] , 
ControlDefs: FROM "control defs" USING [ 

FieldDescriptor, FrameHandle, Global FrameHandle] , 
DebugContextDef s : FROM "debugcon textdef s" USING [IncorrectVersion] , 
DebugData: FROM "debugdata" USING [gContext], 
DebuggerDefs: FROM "debuggerdef s" USING [ 

fullbitaddress, fullsymaddress , InitSOP, LA, Lookup, LookupLocals, 

Qua! ifyRecord, SA, SearchForBasicSym, SearchForModuleSym, 

SearchFrameForSym, SearchGFrameForSym, SOPointer, SymbolObject] , 
DebugMiscDefs: FROM "debugmiscdef s M USING [ 

DFreeString, DGetString, LookupFail], 
DebugSymbolDefs: FROM "debugsymboldef s" USING [ 

DAcquireSymbolTabl e , DReleaseSymbolTable, Symbol sForGFrame] , 
DebugUtilityDefs: FROM "debugutil itydef s" USING [ 

CheckFrame, LongREAD, MREAD, Val idGlobal Frame], 
DIActionDefs: FROM "diactiondef s" USING [ 

IncorrectType, Inval idExpression , litType, Notlmplemented, 

ResetTypeStack] , 
DIDefs: FROM "didefs" USING [ 

ESPointer, EvalStackltem, hereESPointer, Operator, thereESPointer] , 
DILitDefs: FROM "dilitdefs" USING [ 

LiteralValue, LongLiteralValue, LTIndex, STIndex, StringLiteralValue], 
DITypeDefs: FROM "ditypedef s M USING [ 

SeiLonglnteger , SeiPType, Typelnteger, TypelU, TypelUP, TypeLong, 

TypePointer, TypeProcedure, TypeRecord, TypeUnspec], 
Mopcodes: FROM "mopcodes" USING [zRFS], 
StringOefs: FROM "stringdef s" USING [AppendSubString] , 
SymbolTableDefs: FROM "symbol tabledefs" USING [ 

NoSymbolTable, SymbolTableBase] , 
SymDefs: FROM "symdefs" USING [BitAddress, CSEIndex, ISENull, SENull], 
SystemDefs: FROM "systemdefs" USING [Al locateHeapNode, FreeHeapNode]; 

DIActionsHot: PROGRAM 

IMPORTS DebugContextDefs, DDptr: DebugData, DebuggerDefs, DebugMiscDefs, 

DebugSymbolDefs, DebugUtilityDefs, DIActionDefs, DILitDefs, DITypeDefs, 

StringDefs, SymbolTableDefs, SystemDefs 
EXPORTS DIActionDefs = 
BEGIN 

--stack items 

ESPointer: TYPE = DIDefs . ESPointer ; 

hereESPointer: TYPE = DIDefs .hereESPointer ; 

thereESPointer: TYPE = DIDefs . thereESPointer ; 

Operator: TYPE = DIDefs .Operator ; 

SOPointer: TYPE = DebuggerDefs .SOPointer ; 

currentST: SymbolTableDefs .SymbolTableBase *- NIL; 

--stacks 

MaxStackSize: CARDINAL * 10; 

evalstack: ARRAY [1 . .MaxStackSize] OF ESPointer; 

etop: CARDINAL <- 0; 

EvalStackOverflow: PUBLIC SIGNAL = CODE; 
EvalStackEmpty: PUBLIC SIGNAL - CODE; 
NotOnEvalStack: PUBLIC SIGNAL - CODE; 
NILesp: PUBLIC SIGNAL = CODE; 

--eval stack manipulation 

pushevalstack: PUBLIC PROCEDURE [esp: ESPointer] ■ 

BEGIN 

IF etop » MaxStackSize THEN SIGNAL EvalStackOverflow; 

etop *- etop + 1; 

evalstack[etop] <- esp; 

RETURN 

END; 

popevalstack: PUBLIC PROCEDURE RETURNS [esp: ESPointer] ■ 
BEGIN 
IF etop ■ THEN SIGNAL EvalStackEmpty; 



DIActionsHot.mesa 2-Sep-78 15:32:14 Page 



esp «- evalstack[etop]; 

etop «- etop - 1; 

IF esp ■ NIL THEN SIGNAL NILesp; 

RETURN 

END; 

popNevalstack: PUBLIC PROCEDURE [n: CARDINAL] RETURNS [esp: ESPointer] - 
BEGIN -- returns top-n from stack, adjusts stack 
i: CARDINAL; 

IF etop - n THEN SIGNAL NotOnEvalStack; 
esp <- eval stack[etop-n] ; 
IF esp ■ NIL THEN SIGNAL NILesp; 
FOR i DECREASING IN (0. .n] DO 

evalstack[etop-i] <- evalstack[etop-i+l] ; 

ENDLOOP; 
etop <~ etop - 1; 
RETURN 
END; 

TypesDontMatch: PUBLIC SIGNAL [espl, esp2: ESPointer] = CODE; 

performAddOp: PUBLIC PROCEDURE [es2, esl: ESPointer, op: Operator] 
RETURNS [result: hereESPointer]* 
BEGIN OPEN DIActionDefs, DITypeDefs; 
left: hereESPointer +- Transf er[esl] ; 
right: hereESPointer <- Transf er[es2] ; 
leftptr: BOOLEAN <- TypePointer[l ef t] ; 
rightptr: BOOLEAN <- TypePointer[right] ; 
leftLong: BOOLEAN <- TypeLong[lef t] ; 
rightLong: BOOLEAN «- TypeLong[right] ; 
SELECT op FROM 
plus => 
BEGIN 
IF ~(TypeIUP[left] AND TypeIUP[right]) OR (rightptr AND leftptr) 

THEN SIGNAL TypesDontMatchp eft , right] ; 
--subranges win get lost here 
SELECT TRUE FROM 
leftptr => 

BEGIN --preserve pointer type 

IF rightLong AND -leftLong THEN SIGNAL Notlmplemented; 

result <- Al locateHereStackItem[]; 

IF -leftLong 

THEN result. value <- ActualValue[left] + ActualValue[right] 
ELSE BEGIN 

result. ptr <- SystemDef s . Al locateHeapNode[resul t. wordlength «- 2]; 
LOOPHOLE[result.ptr, POINTER TO LONG INTEGER]t 

<- LongVal ue[lef t] + LongValue[right] ; 
END; 
result. tsei «- left.tsei; result . indirection <- left . indirection; 
resul t. stbase <- left.stbase; 
END; 
rightptr => 

BEGIN --preserve pointer type 

IF leftLong AND -rightLong THEN SIGNAL Notlmplemented; 

result «- Al locateHereStackItem[] ; 

IF -r ightLong 

THEN result. value <- ActualValue[lef t] + ActualValue[right] 
ELSE BEGIN 

result. ptr *~ SystemDef s .Al locateHeapNode[result .wordlength «- 2]; 
LOOPHOLE[result.ptr, POINTER TO LONG INTEGER]t 

+■ LongValue[lef t] + LongVal ue[right] ; 
END; 
result. tsei <- right. tsei; resul t. indirection <- right . indirection ; 
resul t. stbase <- right . stbase; 
END; 
ENDCASE «> 
BEGIN 

result +• Al locateHereStackItem[]; 
IF leTtLong OR rightLong THEN 
BEGIN 

result. ptr <- SystemDef s .Al 1 ocateHeapNode[resul t . wordlength <- 2]; 
LOOPHOLE[result.ptr, POINTER TO LONG INTEGF.R]t 

*- LongValue[lef t] + LongValue[right] ; 
result. tsei *- Se iPType[longinteger , resul t. s tbase <- NIL]; 
END 
ELSE 



DIActionsHot.mesa 2-Sep-78 15:32:14 Page 



BEGIN 

result. value <- ActualVal ue[lef t] + ActualValue[right] ; 

result. tsei <- IF Typelnteger[lef t] OR Typelnteger[right] 

THEN SeiPType[integer .currentST] 
ELSE SeiP Type [unspecified .currentST] ; 
END; 
END; 
END; 
minus K > 
BEGIN 
IF ~(TypeIUP[left] AND TypeIUP[right]) OR (rightptr AND -leftptr) 

THEN SIGNAL TypesDontMatchp eTt , right] ; 
SELECT TRUE FROM 

(leftptr AND rightptr) »> 
BEGIN 

IF rightLong AND -leftLong THEN SIGNAL Notlmplemented; 
result <- AllocateHereStackItem[] ; 
IF -leftLong THEN 
BEGIN 

result. value «- ActualValue[lef t] - ActualValue[right] ; 
result. tsei «- SeiPType[integer , currentST] ; 
END 
ELSE BEGIN 

result. ptr <- SystemDefs .Al locateHeapNode[resul t.wordlength «- 2]; 
LOOPHOLE[result.ptr, POINTER TO LONG INTEGER]^ 

«- LongValue[lef t] - LongVal ue[right] ; 
result. tsei «- SeiPType[longinteger , resul t . stbase «- NIL]; 
END; 
END; 
leftptr = > 

BEGIN --preserve pointer type 

IF -leftLong AND rightLong THEN SIGNAL Notlmplemented; 

result <- AllocateHereStackItem[] ; 

IF -leftLong 

THEN result. value «- ActualValue[lef t] - ActualValue[right] 
ELSE BEGIN 

result. ptr <- SystemDefs. AllocateHeapNode[resul t.wordlength «- 2]; 
LOOPHOLE[result.ptr, POINTER TO LONG INTEGER]t 

«- LongVal ue[left] - LongVal ue[right] ; 
END; 
result. tsei <- left. tsei; resul t. indirection <- left . indirection; 
resul t. stbase «- left. stbase; 
END; 
ENDCASE = > 
BEGIN 

result <- AllocateHereStackItem[]; 
IF leftLong THEN 
BEGIN 

result. ptr <- SystemDefs .AllocateHeapNode[resul t.wordlength «- 2]; 
LOOPHOLE[result.ptr, POINTER TO LONG INTEGER]t 

«- LongValue[left] - LongVal ue[right] ; 
result. tsei <- SeiPType[longinteger , resul t. stbase <~ NIL]; 
END 
ELSE 
BEGIN 

result. value «- ActualValue[lef t] - ActualValue[right] ; 
result. tsei <- IF Typelnteger[lef t] OR Typelnteger[right] 

THEN SeiPType[ integer , currentST] 
ELSE SeiPType[unspecif ied, currentST] ; 
END; 
END; 
END; 
ENDCASE => ERROR; 
FreeStackItem[lef t] ; FreeStackItem[r ight] ; 
RETURN 
END; 

performMultOp: PUBLIC PROCEDURE [es2, esl: ESPointer, op: Operator] 
RETURNS [result: hereESPointer]* 
BEGIN OPEN DITypeDefs; 
left: hereESPointer «- Transfer[esl]; 
right: hereESPointer <- Transf er[es2] ; 
leftLong: BOOLEAN <- TypeLong[lef t] ; 
rightLong: BOOLEAN «- TypeLong[r ight] ; 

IF ~TypeIU[left] OR ~TypeIU[right] THEN SIGNAL TypesDontMatchp ef t , right]; 
result <~ AllocateHereStackItem[]; 



DIActionsHot.mesa 2-Sep-78 15:32:14 Page 



SELECT op FROM 
times »> 

IF leftLong OR rightLong THEN 
BEGIN 

result. ptr <- SystemDef s ,AllocateHeapNode[resul 1 .wordlength <- 2]; 
LOOPHOLE[result.ptr, POINTER TO LONG INTEGER]* 

+- LongVal ue[lef t] * LongVal ue[right] ; 
END 
ELSE result. value <- ActualValue[lef t] * ActualValue[right] ; 
div ■> 

IF leftLong OR rightLong THEN 
BEGIN 

result. ptr «- SystemDef s .AllocateHeapNode[result. wordlength *- 2]; 
LOOPHOLE[result.ptr, POINTER TO LONG INTEGER]* 

♦■ LongVal ue[left] / LongValue[right] ; 
END 
ELSE result. value <~ ActualValue[lef t] / ActualValue[right]; 
mod »> 

IF leftLong OR rightLong THEN 
BEGIN 

result. ptr «- SystemDef s . AllocateHeapNode[resul t. wordlength «- 2]; 
LOOPHOLE[result.ptr, POINTER TO LONG INTEGER]t ♦- 

LongValuepeft] MOD LongVal ue[right] ; 
END 
ELSE result. value «- ActualVal ue[lef t] MOD Actual Value[right] ; 
ENDCASE => ERROR; 
result. tsei «- SELECT TRUE FROM 

(leftLong OR rightLong) a > SeiPType[longinteger , resul t. stbase <- NIL], 
(Typelnteger[left] OR Typelnteger[right]) = > SeiPType[integer .currentST] , 
ENDCASE => SeiPType[unspecif ied , currentST] ; 
FreeStackItem[lef t] ; FreeStackItem[right] ; 
RETURN 
END; 

ActualValue: PUBLIC PROCEDURE [hesp: hereESPointer] RETURNS 
[value: UNSPECIFIED] - 
BEGIN 

IF hesp. stbase = NIL THEN RETURN[hesp. val ue] ; 
WITH hesp. stbase. seb+hesp. stbase. UnderType[hesp. tsei] SELECT FROM 

subrange => 

IF origin # THEN RETURN[hesp . value+origin] ; 

ENDCASE; 
RETURN[hesp. value]; 
END; 

LongValue: PUBLIC PROCEDURE [hesp: hereESPointer] RETURNS [LONG INTEGER] - 
BEGIN 

IF hesp. wordlength = 1 THEN RETURN[LONG[CARDINAL[hesp . value]]] ; 
RETURN[LOOPHOLE[hesp.ptr, POINTER TO LONG INTEGER]*] 
END; 

--perform an action on an eval stack item 

qualifyltem: PUBLIC PROCEDURE [esp: ESPointer, id: DILitDef s .STIndex, 
locals: BOOLEAN] RETURNS [ESPointer] = 
BEGIN OPEN DebuggerDefs; 
so: SymbolOb ject ; 
sop: SOPointer *- @so; 
bitaddr: SymDef s .BitAddress ; 
val: UNSPECIFIED; 
local : BOOLEAN «- FALSE; 
fd: ControlDef s . FieldDescriptor; 

i, lengthOfFieldlnRecord, sizeOf ItemWithinField: CARDINAL; 
IF DITypeDef s .TypePointer[esp] THEN esp <- dereferenceltem[esp] ; 
espTosop[esp , sop] ; 
SELECT TRUE FROM 

DITypeDef s . TypeRecord[esp] *> 

IF ~QualifyRecord[sop, OIL i tDef s .StringLi tera!Value[id]] 
THEN SIGNAL DIActionDef s . Inval idExpression ; 
(locals AND DITypeDefs.TypeProcedure[esp]) «> 

IF ~LookupLocals[sop, DILitDef s .StringLiteral Value[id]] 

THEN SIGNAL DIActionDef s . Inval idExpression 
ELSE local <- TRUE; 
ENDCASE »> 

SIGNAL DIActionDef s . IncorrectType[esp] ; 
BEGIN OPEN t: esp. stbase, s: sop. stbase; 
bitaddr «- (s.seb+sop.sei) . idvalue; 



DIActionsHot.mesa 2-Sep-78 15:32:14 Page 



lengthOfFieldlnRecord «- (s. seb+sop. sei ) . idinf o; 
sizeOfltemWithinField <- s.BitsForType[sop. tsei] ; 
WITH e: esp SELECT FROM 
there ■> 
BEGIN 
WITH e SELECT FROM 

short => IF local THEN e.addr «- short[shortAddr: [bitaddr.wd]] 

ELSE e.addr *- short[shortAddr : [shortAddr+bitaddr.wd]] ; 
long a > e.addr <- long[longAddr: LA[LI[1 i : longAddr .1 i+bitaddr .wd]]] ; 
ENDCASE; 
e.bitoffset «- e.bitoffset + bitaddr.bd + 

TengthOfFieldlnRecord - sizeOf ItemWi thinFiel d ; 
e.bitsize «- sizeOf ItemWithinField; 
END; 
here «> 

BEGIN OPEN AltoDefs; 
SELECT sizeOfltemWithinField FROM 
< wordlength => 
BEGIN 

fd. offset <- bitaddr.wd; 
fd.size *■ sizeOfltemWithinField; 
fd.posn <- bitaddr.bd + 

TengthOfFieldlnRecord - sizeOfltemWithinField; 
val <- ReadField[IF e. wordlength » 1 THEN ®e. value ELSE e.ptr, fd]; 
IF e. wordlength # 1 THEN 
BEGIN 

SystemDef s. FreeHeapNode [e.ptr]; 
e. wordlength <- 1; 
END; 
e. value <- val 
END; 
= wordlength => 

IF e. wordlength # 1 THEN 
BEGIN 

val <- (e.ptr + bitaddr.wd)t ; 
SystemDef s. FreeHeapNode [e.ptr]; 
e. wordlength <- 1; 
e. value <- val 
END; 
ENDCASE => 
BEGIN 

e. wordlength «- sizeOf ItemWi thinField/wordlength; 
val *- SystemDefs.AllocateHeapNode[e. wordlength]; 
FOR i IN [0. .e. wordlength) DO 

LOOPHOLE[val + i, POINTER]t <- (e.ptr + bitaddr.wd + 1)t; 
ENDLOOP; 
SystemDef s . FreeHeapNode[e . ptr] ; 
e.ptr ♦- val ; 
END; 
END; 
ENDCASE ■> ERROR; 
esp.stbase <- sop.stbase; esp. tsei <- sop. tsei; 
--necessary for correct field extraction on records 
esp. sei <- IF -local THEN SymDef s . ISENul 1 ELSE sop. sei; 
END; 
RETURN[esp] 
END; 

dereferenceltem: PUBLIC PROCEDURE [esp: ESPointer] RETURNS [tesp: thereESPointer] 
BEGIN OPEN s:esp.stbase, DITypeDefs, DebugUti 1 ityDef s ; 
type: SymDef s .CSEIndex; 
long: BOOLEAN <- FALSE; 

IF TypeUnspec[esp] THEN esp . indirection «- 1; 
IF ~(TypePointer[esp] OR esp . indirection # 0) 

THEN SIGNAL DIActionDef s . IncorrectType[esp] ; 
tesp <- Al locateThereStackl tem[] ; 
IF esp. indirection > THEN 
BEGIN 

WITH e:esp SELECT FROM 
here *> 
BEGIN 
tespt <- [next:, stbase: e.stbase, sei: SymDef s . ISENul 1 , tsei: e.tsei, 



desc 
body 
addr 



e.desc, intN: e.intN, indirection: e . indirection-1 , 
there[bitoff set: 0, bitsize: AltoDefs .wordlength , 
short[shortAddr : e. value]]]; 



IF e.stbase U NIL IHL'N tesp. bitsize <■- e . stbase. BitsForType[e. tsei] 



DIActionsHot.mesa 2-Sep-78 15:32:14 Page 



ELSE IF e.tsei ■ SeiLonglnteger THEN 

tesp.bitsize <- 2 * AltoDef s .wordlength; 
END; 
ENDCASE «> SIGNAL DIActionDef s . Inval idExpression ; 
RETURN 
END; 
type <- s.UnderType[esp. tsei] ; 
DO 

WITH s.seb+type SELECT FROM 

subrange => type «- s .UnderType[rangetype] ; 

long a > BEGIN long *- TRUE; type <- s . UnderType[rangetype] ; END; 
pointer -> BEGIN esp.tsei <- pointedtotype ; EXIT END; 
ENDCASE »> ERROR; 
ENDLOOP; 
tespt «- [next:, stbase: esp.stbase, sei: SymDefs . ISENull , tsei: esp.tsei, 
desc: esp.desc, intN: esp.intN, indirection: 0, body: there[bitoff set : 0, 
addr:, bitsize: esp. stbase. BitsForType[esp. tsei]]] ; 
WITH e:esp SELECT FROM 

here => tesp.addr ♦- short[shortAddr: 

IF e. wordlength = 1 THEN e. value ELSE e.ptrt]; 
there => WITH e SELECT FROM 
short => IF -long THEN 

tesp.addr «- short[shortAddr :MREAD[shortAddr]] 
ELSE BEGIN 

la: LA DebuggerDef s . LA; 
la. low <- MREAD[shortAddr]; 
la. high <- MREAD[shortAddr+l]; 
tesp.addr «- long[longAddr: 1 a]; 
END; 
long *> IF -long THEN 

tesp.addr <- short[shortAddr :LongREAD[longAddr . 1 p]] 
ELSE BEGIN 

la: DebuggerDef s .LA; 
la. low «- LongREAD[longAddr .lp]; 
la. high «- LongREAD[longAddr . lp+1] ; 
tesp.addr <~ long[longAddr : 1 a]; 
END; 
ENDCASE; 
ENDCASE; 
FreeStackItem[esp] ; 
RETURN 
END; 

--handle literals 

getLiteral: PUBLIC PROCEDURE [type: DIActionDef s . 1 itType, value: DILitDef s .LTIndex] 

RETURNS [new: hereESPointer] « 

BEGIN 

new <- AllocateHereStackItem[]; 

new. value <- DILitDef s . LiteralValue[value]; 

new. tsei «- SELECT type FROM 

num => DITypeDef s.SeiPType[integer .currentST] , 
ENDCASE => DITypeDeFs.SeiPType[character, currentST]; 

RETURN 

END; 

getLongLiteral : PUBLIC PROCEDURE [value: DILitDef s .LTIndex] 
RETURNS [new: hereESPointer] ■ 
BEGIN 

new <- AllocateHereStackItem[] ; 

new.ptr <- SystemDefs .Al locateHeapNode[new. wordlength «- 2]; 
LOOPHOLE[new.ptr, POINTER TO LONG INTEGER]^ «- 

DILitDefs . LongLiteralValue[value]; 
new. tsei <- DITypeDef s .SeiPType[longinteger , new. stbase <- NIL]; 
RETURN 
END; 

getStringLiteral: PUBLIC PROCEDURE [value: DILitDef s .STIndex] 
RETURNS [new: hereESPointer] * 
BEGIN 

new «- AllocateHereStackItem[]; 

new. value *- DILitDefs. StringLiteralValue[value] ; 
new. tsei <~ DITypeDef s .SeiPType[string, currentST]; 
RETURN 
END; 



-symboltable manipulation 



DIActionsHot.mesa 2-Sep-78 15:32:14 Page 



Lookupld: PUBLIC PROCEDURE [id: DILI tDef s .STIndex] RETURNS [ESPointer] - 
BEGIN OPEN DebuggerDefs; 
s: STRING «- DebugMiscDef s .DGetString[30] ; 
so: SymbolObject; 
sop: SOPointer <- @so; 
tesp: thereESPointer; 
hesp: hereESPointer; 
found, constant, transfer: BOOLEAN; 
InitSOP[sop]; 

Str ingDefs.AppendSubString[s, DILitDefs.StringLiteralVaUie[id]] ; 
IF (found 4- Lookup[s, FALSE, sop, FALSE, mod]) THEN 
BEGIN 

constant «- (sop. stbase. seb+sop. sei) . constant ; 

transfer «- WITH sop. stbase. seb+sop. stbase. UnderType[sop .tsei] SELECT FROM 
transfer *> TRUE, 
ENDCASE ■> FALSE; 
IF -constant OR (constant AND transfer) THEN 
BEGIN 

tesp «- A1 locateThereStackItem[] ; 
sopToesp[sop , tesp] ; 

IF -constant AND -transfer THEN tesp. sei <- SymDef s . ISENull ; 
DebugMiscDefs.DFreeString[s]; 
RETURN[tesp]; 
END; 
END; 
IF (found AND constant) OR SearchForBasicSym[s , sop] THEN 
BEGIN 

hesp <- AllocateHereStackItem[]; 
hesp. stbase «- sop. stbase; 
hesp. sei <~ sop. sei; 
hesp . tsei <~ sop. tsei ; 
DebugMiscDef s.DFreeString[s ]; 
IF -(sop . stbase. seb+sop. sei ) .extended THEN 
BEGIN 

hesp .wordlength *- 1; 

hesp. value «- (sop. stbase. seb+sop. sei ). idvalue; 
END 
ELSE SIGNAL DIActionDef s . Notlmplemented ; --multiword constants 
RETURN[hesp]; 
END; 
SIGNAL DebugMiscDefs. Lookup Fail[s]; 
END; 

SearchFrameForld: PUBLIC PROCEDURE [num: DILitDef s .LTIndex, id: DILi tDef s .STIndex] 
RETURNS [ESPointer] - 
BEGIN OPEN DebuggerDefs; 
gf rame : Control Defs. Global FrameHandle 

*- LOOPHOLE [DILi tDef s. Liter a !Value[num], Control Defs .Global FrameHandle] ; 
sym: STRING «- DebugMiscDef s . DGetString[30] ; 

frame: ControlDefs . FrameHandle <- LOOPHOLE[DILi tDef s . Li tera!Value[num]] ; 
so: SymbolObject; 
sop: SOPointer <- @so; 
InitSOP[sop]; 

StringDefs.AppendSubString[sym, DILi tDef s .Str ingLiteralVal ue[ id]]; 
IF DebugUtilityDeFs.ValidGlobalFrame[gframe] THEN 

BEGIN 

IF -SearchGFrameForSym[gframe, sym, FALSE, sop, FALSE] THEN 
SIGNAL DebugMiscDefs. Look up Fail [sym] 
. END 
ELSE IF DebugUtilityDefs.CheckFrame[frame] THEN 

BEGIN 

IF -SearchFrameForSym[frame, sym, FALSE, sop, FALSE] THEN 
SIGNAL DebugMiscDef s. Lookup Fail [sym] 

END 
ELSE SIGNAL DIActionDef s . Inval idExpression ; 
DebugMiscDefs . DFreeString[sym] ; 
RETURN[SetUpId[sop]] 
END; 

SetUpId: PROCEDURE [sop: DebuggerDefs .SOPointer] RETURNS [ESPointer] - 
BEGIN 

tesp: thereESPointer; 
hesp: hereESPointer; 
constant, transfer: BOOLEAN <- FALSE; 
constant ♦- (sop . stbase . seb+sop. sei ). constant; 
WITH sop. stbase. seb+sop. stbase. UnderType[sop. tsei] SELECT FROM 



DIActionsHot.mesa 2-Sep~78 15:32:14 Page 8 



transfer »> transfer <- TRUE; 

ENDCASE; 
IF -constant OR (constant AND transfer) THEN 

BEGIN 

tesp <- AT locateThereStackItem[] ; 

sopToesp[sop, tesp] ; 

tesp.sei <- SymDef s. ISENul 1 ; 

RETURN[tesp]; 

END; 
hesp *- AllocateHereStackItem[]; 
hesp.stbase «- sop.stbase; 
hesp . sei «- sop . sei ; 
hesp.tsei <- sop.tsei; 
hesp.wordlength <- 1; 

hesp. value <- (sop. stbase.seb+sop. sei ) . idvalue; 
RETURN[hesp]; 
END; 

SearchFileForld: PUBLIC PROCEDURE [file, id: DILi tDef s .STIndex] 
RETURNS [ESPointer] = 
BEGIN OPEN DebugMiscDefs, DebuggerDefs ; 
mod: STRING «- DGetString[30] ; 
type: STRING «- DGetStr ing[30] ; 
so: SymbolObject ; 
sop: SOPointer <- @so; 
InitSOP[sop]; 

StringDefs.AppendSubString[mod t DILi tDef s ,StringLiteralValue[f i le]] ; 
StringDef s.AppendSubString[type, DILi tDef s . StringLiteral Val ue[ id]] ; 
IF ~SearchForModuleSym[mod, type, FALSE, sop, FALSE] THEN 

BEGIN 

DFreeString[mod]; 

SIGNAL DebugMiscDefs. Lookup Fail [type]; 

END; 
DFreeString[mod]; 
DFreeString[type]; 
RETURN[SetUpId[sop]] 
END; 

--conversion utilities 

espTosop: PUBLIC PROCEDURE [esp: ESPointer, sop: SOPointer] « 
BEGIN OPEN DebuggerDefs; 
sym: f ul 1 bitaddress; 
sa: SA; 
InitSOP[sop]; 
sop.stbase «- esp.stbase; 
sop. sei <- esp. sei ; 
sop.tsei ♦- esp. tsei ; 
sym «- f ullsymaddress[sop]; 
WITH sym SELECT FROM 

short => sa *- shortAddr; 
ENDCASE => ERROR; 
WITH e: esp SELECT FROM 
here -> 
BEGIN 
sop.baddr.wd <- short[shortAddr : [LOOPHOLE[ 

(IF e.wordlength = 1 THEN @e. value ELSE e. value), SA] - sa]]; 
sop. there *- FALSE; 
END; 
there => 
BEGIN 
WITH e SELECT FROM 

short -> sop.baddr.wd <- short[shortAddr : 

[shortAddr-sa]]; 
long ~> sop.baddr.wd <- long[longAddr : LA[LI[1 i : longAddr . 1 i-sa]]]; 
ENDCASE; 
sop.baddr.bd <- e.bitoFfset; 
sop. space <~ e.bitsize MOD 16; 
END; 
ENDCASE *> ERROR; 
RETURN 
END; 

sopToesp: PUBLIC PROCEDURE [sop: SOPointer, tesp: thereESPointer] * 
BEGIN OPEN DebuggerDefs, sop.stbase; 
sa: SA; 
sym: f ull bi taddress <- full symaddress[sop]; 



DIActionsHot.mesa 2-Sep-78 15:32:14 Page 



WITH sym SELECT FROM 

short «> sa ♦- shortAddr; 

ENDCASE => ERROR; 
tesp.stbase <- sop.stbase; 
tesp.sei ♦- sop.sei ; 
tesp.tsei <- sop.tsei; 
tesp.bitsize *- BitsForType[sop . tsei] ; 
tesp . bitoff set «- IF tesp.bitsize < AT toDef s. wordlength 

THEN (AltoDefs.wordlength - tesp.bitsize) ELSE 0; 
WITH sop.baddr SELECT FROM 

short -> tesp.addr <- short[shortAddr: [shortAddr+sa]]; 

long »> tesp.addr <- long[longAddr : LA[LI[1 i : 1 ongAddr . 1 i+sa]]] ; 

ENDCASE; 
RETURN 
END; 

Transfer: PUBLIC PROCEDURE [esp: ESPointer] RETURNS [newesp: hereESPointer] ■ 
BEGIN OPEN DebugUtilityDefs, DIDefs; 
i: CARDINAL; 

fd: ControlDef s . FieldDescriptor ; 
WITH e:esp SELECT FROM 
here -> RETURN[@e]; 
there ■> 
BEGIN 

newesp «- AllocateHereStackItem[] ; 

newespt «- EvalStackItem[next: .stbase: e. stbase, sei: SymDef s. ISENull , 
tsei: e.tsei, desc: e.desc, intN: e.intN, 

indirection: e. indirection , body: here[wordlength: , data:]]; 
IF e.bitsize <= AltoDefs.wordlength THEN 
BEGIN 

newesp .wordlength *- 1; 
WITH e SELECT FROM 

short => i <- MREAD[shortAddr]; 
long => i *- LongREAD[longAddr.lp]; 
ENDCASE; 
fd *- [offset: 0, posn: e.bitoffset, size: e.bitsize]; 
newesp. value ♦■ ReadField[@i , fd]; 
END 
ELSE 
BEGIN 
IF e.bitsize MOD AltoDefs.wordlength # OR e.bitoffset # 

THEN ERROR; 
newesp. wordlength *- e.bitsize/Al toDef s .wordlength; 
newesp. ptr *- SystemDef s. AllocateHeapNode[newesp. wordlength]; 
FOR i IN [0 . .newesp. wordlength) DO -- use val for loop counter 
WITH e SELECT FROM 

short «> (newesp. ptr+i )t <- MREAD[shortAddr+i] ; 
long -> (newesp. ptr+i )t <- LongREAD[longAddr. lp+i]; 
ENDCASE; 
ENDLOOP; 
END; 
END; 
ENDCASE; 
FreeStackItem[esp]; 
RETURN[newesp] 
END; 

ReadField: PROCEDURE [POINTER, ControlDef s . Fiel dDescriptor] RETURNS [UNSPECIFIED] 
MACHINE CODE BEGIN Mopcodes . zRFS END; 

LA: TYPE * DebuggerDef s , LA; 

--initialization and reset 
GetSetUp: PUBLIC PROCEDURE ■ 
BEGIN OPEN DebugSymbolDefs; 
BEGIN --only valid HERE ill 
IF DDptr.gContext # NIL THEN 

currentST <- DAcquireSymbolTable[ Symbol sForGFrame[DDptr .gContext 
1 Symbol Tab! eDef s .NoSymbolTable «> GOTO nosym; 
DebugContextDef s . IncorrectVersion a > RESUME] 
t SymbolTableDefs. NoSymbolTable => GOTO nosym] 
ELSE currentST <- NIL; 
EXITS 
--this is a problem - what if no symboltable - try alittle harder ?? 

nosym ■> currentST <- NIL; 
END; 



DIActionsHot.mesa 2-Sep-78 15:32:14 Page 10 



RETURN 
END; 

GetCurrentST: PUBLIC PROCEDURE RETURNS [SymbolTableDef s .SymbolTableBase] - 
BEGIN 

RETURN[currentST] 
END; 

Cleanup: PUBLIC PROCEDURE - 
BEGIN 
IF currentST # NIL THEN 

BEGIN DebugSymbolDefs.DReleaseSymbolTable[currentST]; currentST *- NIL; END; 
ResetStacks[]; 
RETURN 
END; 

ResetStacks: PUBLIC PROCEDURE « 
BEGIN 

esp: ESPointer *- EvalStackList; 
nesp: ESPointer; 
UNTIL esp ■ NIL DO 
nesp <- esp. next; 
WITH e: esp SELECT FROM 

here => IF e.wordlength > 1 AND e.ptr # NIL 

THEN SystemDef s . F reeHeapNode [e.ptr ]; 
ENDCASE; 
SystemDef s . F reeHeapNode [esp] ; 
esp «- nesp; 
ENDLOOP; 
EvalStackList <- NIL; etop <- 0; 
DIActionDef s . ResetTypeStack[] ; 
RETURN 
END; 

EvalStackList: ESPointer «- NIL; 

AllocateHereStackltem: PUBLIC PROCEDURE RETURNS [hesp: hereESPointer] - 
BEGIN OPEN DIDefs; 

hesp <- SystemDef s . Al locateHeapNode[SIZE[here EvalStackltem]]; 
hespt +• EvalStackl tem[next: EvalStackList, stbase: currentST, 

sei: SymDefs.ISENull , tsei: SymDef s .SENull , desc: FALSE, intN: FALSE, 

indirection: 0, body: here[wordlength: 1 , data:]]; 
EvalStackList <- hesp; 
RETURN 
END; 

AllocateThereStackltem: PUBLIC PROCEDURE RETURNS [tesp: thereESPointer] - 

BEGIN OPEN DIDefs; 

tesp <- SystemDefs. AllocateHeapNode[SIZE[there EvalStackltem]]; 

tespt <- EvalStackItem[next : EvalStackList, stbase: currentST, 

sei: SymDefs.ISENull, tsei: SymDef s . SENul 1 , desc: FALSE, intN: FALSE, 
indirection: 0, body: there[bitof f set :0 , addr: short[shortAddr : [0]], 
bitsize: 0]]; 

EvalStackList <- tesp; 

RETURN 

END; 

FreeStackltem: PUBLIC PROCEDURE [esp: ESPointer] * 
BEGIN 

dl: ESPointer <- EvalStackList; 
pdl : ESPointer <- NIL; 
UNTIL dl « NIL DO 
IF dl « esp THEN 
BEGIN 

IF pdl « NIL THEN EvalStackList ♦- dl.next ELSE pdl. next ♦- dl.next; 
WITH e: esp SELECT FROM 
here ■> 

IF e.wordlength > 1 AND e.ptr # NIL THEN SystemDef s . FreeHeapNode[e.ptr] ; 
ENDCASE; 
SystemDef s. FreeHeapNode[ esp]; 
RETURN 
END; 
pdl «- dl ; dl «- dl .next; 
ENDLOOP; 
RETURN 
END; 



DIActionsHot.mesa 2-Sep-78 15:32:14 Page 11 



END.,