T Y P E S & C O N S T A N T S
Mob: TYPE = MobDefs.Mob;
BitAddress: TYPE = Symbols.BitAddress;
BTIndex: TYPE = Symbols.BTIndex;
BTRecord: TYPE = Symbols.BodyRecord;
CSEIndex:
TYPE = Symbols.CSEIndex;
typeTYPE: CSEIndex = Symbols.typeTYPE;
ContextLevel:
TYPE = Symbols.ContextLevel;
lZ: ContextLevel = Symbols.lZ;
lG: ContextLevel = Symbols.lG;
lL: ContextLevel = Symbols.lL;
CTXIndex:
TYPE = Symbols.CTXIndex;
CTXNull: CTXIndex = Symbols.CTXNull;
CTXRecord: TYPE = Symbols.CTXRecord;
FTIndex:
TYPE = MobDefs.FTIndex;
FTSelf: FTIndex = MobDefs.FTSelf;
ISEIndex:
TYPE = Symbols.ISEIndex;
ISENull: ISEIndex = Symbols.ISENull;
ISERecord: TYPE = SERecord.id;
LTIndex:
TYPE = Literals.LTIndex;
LTNull: LTIndex = Literals.LTNull;
LTRecord: TYPE = Literals.LTRecord;
LitDescriptor: TYPE = Literals.LitDescriptor;
MDIndex: TYPE = Symbols.MDIndex;
MSTIndex:
TYPE = Literals.MSTIndex;
MSTNull: MSTIndex = LOOPHOLE[STNull];
MTIndex:
TYPE = MobDefs.MTIndex;
MTNull: MTIndex = MobDefs.MTNull;
MTRecord: TYPE = MobDefs.MTRecord;
Name:
TYPE = Symbols.Name;
nullName: Name = Symbols.nullName;
NodeName: TYPE = Tree.NodeName;
RefMob: TYPE = REF Mob;
RefMTRecord: TYPE = REF MTRecord;
RefSGRecord: TYPE = REF SGRecord;
RootBti: BTIndex = Symbols.RootBti;
ROPE: TYPE = Rope.ROPE;
SEIndex:
TYPE = Symbols.SEIndex;
SENull: SEIndex = Symbols.SENull;
SERecord: TYPE = Symbols.SERecord;
SGIndex:
TYPE = MobDefs.SGIndex;
SGNull: SGIndex = MobDefs.SGNull;
SGRecord: TYPE = MobDefs.SGRecord;
STIndex:
TYPE = Literals.STIndex;
STNull: STIndex = Literals.STNull;
STREAM: TYPE = IO.STREAM;
SubString: TYPE = ConvertUnsafe.SubString;
SymbolTableBase: TYPE = REF SymbolTableBaseRep;
SymbolTableBaseRep: PUBLIC TYPE = SymbolTablePrivate.SymbolTableBaseRep;
TransferMode: TYPE = Symbols.TransferMode;
TypeClass: TYPE = Symbols.TypeClass;
VersionStamp: TYPE = MobDefs.VersionStamp;
Utility procedures
Some of these routines were cloned from various places to allow stream: STREAM and stb: SymbolTableBase as arguments, so we don't have to use global variables.
PrintSE:
PUBLIC
PROC [sei: ISEIndex, nBlanks:
CARDINAL, definitionsOnly:
BOOL, stream:
STREAM, stb: SymbolTableBase] = {
sep: LONG POINTER TO ISERecord = @stb.seb[sei];
typeSei: SEIndex;
Indent[stream, nBlanks];
PrintSei[sei, stream, stb];
stream.PutRope[" ["];
PrintLongIndex[sei, stream];
stream.PutChar[']];
IF sep.public THEN stream.PutRope[" [public]"];
IF sep.mark3
THEN {
val: CARD = SymbolOps.DecodeCard[sep.idValue];
idInfo: CARD = SymbolOps.DecodeCard[sep.idInfo];
stream.PutRope[", type = "];
IF sep.idType = typeTYPE
THEN {
typeSei ¬ SymbolOps.DecodeType[sep.idInfo];
stream.PutRope["TYPE, equated to: "];
PrintType[typeSei, stream, stb];
IF stb.ctxb[sep.idCtx].level = lZ
AND SymbolOps.TypeLink[stb, sei] # SENull
THEN
stream.PutF1[", tag code: %g", [cardinal[val]]];
}
ELSE {
typeSei ¬ sep.idType;
PrintType[typeSei, stream, stb];
SELECT
TRUE
FROM
sep.constant => stream.PutRope[" [const]"];
sep.immutable => stream.PutRope[" [init only]"];
ENDCASE;
SELECT
TRUE
FROM
~sep.mark4 =>
stream.PutF1[", # refs: %g", [cardinal[idInfo]]];
sep.constant =>
IF ~ sep.extended
THEN {
stream.PutRope[", value: "];
SELECT SymbolOps.XferMode[stb, typeSei]
FROM
proc, program, signal, error =>
PrintMobLink[LOOPHOLE[val], stream];
ENDCASE =>
IF val < 1000 THEN stream.Put1[[cardinal[val]]]
ELSE stream.PutF1["%b", [cardinal[val]]];
};
(definitionsOnly
AND stb.ctxb[sep.idCtx].level = lG) =>
stream.PutF1[", index: %g", [cardinal[val]]];
ENDCASE => {
addr: BitAddress = LOOPHOLE[val];
bitsPerByte: INT = 8;
stream.PutF[
", address: %g [%g:%g]",
[cardinal[addr.bd/bitsPerByte]],
[cardinal[addr.bd MOD bitsPerByte]],
[cardinal[idInfo]]];
IF sep.linkSpace THEN stream.PutChar['*];
};
};
PrintTypeInfo[typeSei, nBlanks+2, stream, stb];
IF sep.extended
THEN stream.PutRope["(extended)"];
Crashes for some extensions at the moment -- AHL
PrintTree[SymbolOps.FindExtension[stb, sei].tree, nBlanks+4, stream, stb];
};
IF sep.flags.valid
THEN {
stream.PutRope[" flags:"];
IF sep.flags.used THEN stream.PutRope[" used"];
IF sep.flags.addressed THEN stream.PutRope[" addressed"];
IF sep.flags.assigned THEN stream.PutRope[" assigned"];
IF sep.flags.upLevel THEN stream.PutRope[" upLevel"];
};
IF sep.special # normal
THEN {
stream.PutRope[" special:"];
SELECT sep.special
FROM
globalLink => stream.PutRope[" globalLink"];
staticLink => stream.PutRope[" staticLink"];
frameExtension => stream.PutRope[" frameExtension"];
memoryLink => stream.PutRope[" memoryLink"];
returnLink => stream.PutRope[" returnLink"];
ENDCASE => NULL;
};
};
PrintType:
PUBLIC
PROC [sei: SEIndex, stream:
STREAM, stb: SymbolTableBase] = {
IF sei = SENull
THEN stream.PutChar['?]
ELSE
WITH t~~stb.seb[sei]
SELECT
FROM
cons =>
WITH t
SELECT
FROM
transfer => WriteModeName[mode, stream];
ENDCASE => WriteTypeName[t.typeTag, stream];
id =>
FOR tSei: SEIndex ¬ sei, SymbolOps.TypeLink[stb, tSei]
UNTIL tSei = SENull
DO
WITH stb.seb[tSei]
SELECT
FROM
id => {
IF sei # tSei THEN stream.PutChar[' ];
PrintSei[LOOPHOLE[tSei, ISEIndex], stream, stb];
IF ~mark3 OR stb.ctxb[idCtx].level # lZ THEN EXIT;
};
ENDCASE;
ENDLOOP;
ENDCASE;
stream.PutRope[" ["];
PrintLongIndex[sei, stream];
stream.PutChar[']];
};
PrintTypeInfo:
PUBLIC
PROC [sei: SEIndex, nBlanks:
CARDINAL, stream:
STREAM, stb: SymbolTableBase] = {
IF sei # SENull
THEN {
sp: LONG POINTER TO SERecord = @stb.seb[sei];
WITH s~~sp
SELECT
FROM
cons => {
Indent[stream, nBlanks];
stream.PutChar['[];
PrintLongIndex[LOOPHOLE[sei], stream];
stream.PutRope["] "];
WITH s
SELECT
FROM
transfer => WriteModeName[mode, stream];
ENDCASE => WriteTypeName[s.typeTag, stream];
WITH t~~s
SELECT
FROM
basic => NULL;
enumerated => {
IF t.machineDep THEN stream.PutRope[" (md)"]
ELSE IF t.painted THEN stream.PutRope[" (painted)"];
stream.PutRope[", value ctx: "];
PrintLongIndex[t.valueCtx, stream];
};
record => {
IF t.machineDep THEN stream.PutRope[" (md)"];
IF t.monitored THEN stream.PutRope[" (monitored)"];
IF t.hints.variant THEN stream.PutRope[" (variant)"];
OutCtx[", field", t.fieldCtx, stream];
WITH stb.ctxb[t.fieldCtx]
SELECT
FROM
included => IF ~complete THEN stream.PutRope[" [partial]"];
imported => stream.PutRope[" [partial]"];
ENDCASE;
WITH t
SELECT
FROM
linked => {
stream.PutRope[", link: "]; PrintType[linkType, stream, stb]};
ENDCASE;
};
ref => {
SELECT
TRUE
FROM
t.counted => stream.PutRope[" (counted)"];
t.var => stream.PutRope[" (var)"];
ENDCASE;
IF t.ordered THEN stream.PutRope[" (ordered)"];
IF t.basing THEN stream.PutRope[" (base)"];
stream.PutRope[", to: "];
PrintType[t.refType, stream, stb];
IF t.readOnly THEN stream.PutRope[" (readonly)"];
PrintTypeInfo[t.refType, nBlanks+2, stream, stb];
};
array => {
IF t.packed THEN stream.PutRope[" (packed)"];
stream.PutRope[", index type: "];
PrintType[t.indexType, stream, stb];
stream.PutRope[", component type: "];
PrintType[t.componentType, stream, stb];
PrintTypeInfo[t.indexType, nBlanks+2, stream, stb];
PrintTypeInfo[t.componentType, nBlanks+2, stream, stb];
};
arraydesc => {
stream.PutRope[", described type: "];
PrintType[t.describedType, stream, stb];
IF t.readOnly THEN stream.PutRope[" (readonly)"];
PrintTypeInfo[t.describedType, nBlanks+2, stream, stb];
};
transfer => {
IF t.safe THEN stream.PutRope[" (safe)"];
OutArgType[", input", t.typeIn, stream, stb];
OutArgType[", output", t.typeOut, stream, stb];
};
definition => {
stream.PutRope[", ctx: "];
PrintLongIndex[t.defCtx, stream];
};
union => {
IF t.overlaid THEN stream.PutRope[" (overlaid)"];
IF t.controlled
THEN {
stream.PutRope[", tag: "];
PrintSei[t.tagSei, stream, stb]};
stream.PutRope[", tag type: "];
PrintType[stb.seb[t.tagSei].idType, stream, stb];
stream.PutRope[", case ctx: "];
PrintLongIndex[t.caseCtx, stream];
IF t.controlled THEN PrintSE[t.tagSei, nBlanks+2, FALSE, stream, stb];
};
sequence => {
IF t.packed THEN stream.PutRope[" (packed)"];
IF t.controlled
THEN {
stream.PutRope[", tag: "];
PrintSei[t.tagSei, stream, stb]}
ELSE {
stream.PutRope[", index type: "];
PrintType[stb.seb[t.tagSei].idType, stream, stb]};
stream.PutRope[", component type: "];
PrintType[t.componentType, stream, stb];
IF t.controlled THEN PrintSE[t.tagSei, nBlanks+2, FALSE, stream, stb]
ELSE PrintTypeInfo[stb.seb[t.tagSei].idType, nBlanks+2, stream, stb];
PrintTypeInfo[t.componentType, nBlanks+2, stream, stb];
};
relative => {
stream.PutRope[", base type: "];
PrintType[t.baseType, stream, stb];
stream.PutRope[", offset type: "];
PrintType[t.offsetType, stream, stb];
PrintTypeInfo[t.baseType, nBlanks+2, stream, stb];
PrintTypeInfo[t.offsetType, nBlanks+2, stream, stb];
};
opaque => {
stream.PutRope[", id: "];
PrintSei[t.id, stream, stb];
IF t.lengthKnown THEN stream.PutF1[", size: %g", [cardinal[t.length]]];
};
zone => {
IF t.counted THEN stream.PutRope[" (counted)"];
IF t.mds THEN stream.PutRope[" (mds)"];
};
subrange => {
stream.PutRope[" of: "];
PrintType[t.rangeType, stream, stb];
IF t.filled
THEN {
stream.PutF1[" origin: %g", [integer[t.origin]]];
stream.PutF1[", range: %g", [cardinal[t.range]]]};
PrintTypeInfo[t.rangeType, nBlanks+2, stream, stb];
};
real => {
stream.PutF1[" length: %g", [integer[t.length]]];
};
ENDCASE;
};
ENDCASE
};
};
PrintTree:
PUBLIC
PROC [tree: Tree.Link, nBlanks:
NAT, stream:
STREAM, stb: SymbolTableBase] = {
PrintSubTree:
PROC [tree: Tree.Link]
RETURNS [ok:
BOOL ¬
TRUE] = {
tag: Tree.LinkTag ~ TreeOps.GetTag[tree];
Indent[stream, nBlanks];
WITH s~~tree
SELECT tag
FROM
hash =>
PrintName[s.index, stream, stb];
symbol => {
PrintSei[s.index, stream, stb];
stream.PutChar['[];
PrintLongIndex[s.index, stream];
stream.PutChar[']]};
literal =>
PrintLiteral[s.index, stream, stb];
string =>
Figure out why this crashes for MACHINE CODE = { "..." } -- AHL
PrintStringLiteral[s.index, stream, stb];
stream.PutRope["\"STRING\""];
subtree => {
node: Tree.Index = s.index;
SELECT node
FROM
Tree.nullIndex => stream.PutRope["<empty>"];
Tree.Index.LAST => stream.PutRope["<last>"];
ENDCASE => {
tp: LONG POINTER TO Tree.Node ¬ @stb.tb[node];
stream.PutRope[ConvertUnsafe.ToRope[NodeNameTable[tp.name]]];
stream.PutChar['[];
PrintLongIndex[node, stream];
stream.PutRope["] "];
IF TreeOps.ToCard[tp.info] # 0
THEN {
stream.PutRope[" info="];
PrintLongIndex[LOOPHOLE[tp.info], stream]};
IF tp.attr1
OR tp.attr2
OR tp.attr3
THEN {
IF TreeOps.ToCard[tp.info] = 0 THEN stream.PutChar[' ];
stream.PutChar['(];
IF tp.attr1 THEN stream.PutChar['1];
IF tp.attr2 THEN stream.PutChar['2];
IF tp.attr3 THEN stream.PutChar['3];
stream.PutChar[')]};
nBlanks ¬ nBlanks + 2;
IF tp.name # thread
THEN {
EndIndex: Tree.Index = Tree.Index.LAST;
EndMark: Tree.Link = [subtree[index: EndIndex]];
n: NAT = tp.nSons;
IF tp.name = list
AND n = 0
THEN
Very long lists have end markers, not explcit lengths.
FOR i:
NAT
IN [1..
NAT.
LAST]
DO
son: Tree.Link = tp.son[i];
IF son = EndMark THEN EXIT;
IF NOT PrintSubTree[tp.son[i]] THEN EXIT;
ENDLOOP
ELSE
For all other nodes, believe the given length.
FOR i:
CARDINAL
IN [1 .. n]
DO
[] ¬ PrintSubTree[tp.son[i]];
ENDLOOP;
}
ELSE {
stream.PutRope[" link="];
PrintTreeLink[tp.son[2], stream];
stream.PutRope[" to "];
PrintTreeLink[tp.son[1], stream]};
nBlanks ¬ nBlanks - 2};
};
ENDCASE => {
stream.PutF1["(broken Tree.Link, %08xH)", [cardinal[LOOPHOLE[tree]]] ];
ok ¬ FALSE};
};
[] ¬ PrintSubTree[tree];
};
PrintLiteral:
PUBLIC
PROC [lti: Literals.LTIndex, stream:
STREAM, stb: SymbolTableBase] = {
IF lti=Literals.LTNull
THEN stream.PutRope["(null literal)"]
ELSE {
desc: Literals.LitDescriptor = DescriptorValue[stb, lti];
v: CARD;
IF desc.words # 1 THEN stream.PutChar['[];
FOR i:
CARDINAL
IN [0 .. desc.words)
DO
v ¬ SymbolOps.DecodeCard[stb.ltb[desc.offset][i]];
IF v < 1000 THEN stream.Put1[[cardinal[v]]] ELSE stream.PutF1["%b", [cardinal[v]]]; -- octal
IF i+1 # desc.words THEN stream.PutChar[',];
ENDLOOP;
IF desc.words # 1 THEN stream.PutChar[']]};
PrintStringLiteral:
PUBLIC
PROC [sti: Literals.STIndex, stream:
STREAM,
stb: SymbolTableBase] = {
msti: MSTIndex = MasterString[stb, sti];
s: LONG POINTER TO Literals.STRecord.master = @stb.ltb[msti];
stream.PutChar['"];
FOR i: CARDINAL IN [0..s.length) DO stream.PutChar[s.string[i]] ENDLOOP;
stream.PutChar['"];
IF sti # msti THEN stream.PutChar['L];
};
PrintMobLink:
PUBLIC
PROC [link: MobDefs.Link, stream:
STREAM] = {
SELECT link.tag
FROM
proc =>
stream.PutF["proc[%g,%g]", [cardinal[link.modIndex]], [cardinal[link.offset]]];
type => {
stream.PutRope["type["]; PrintIndex[link.offset, stream]};
ENDCASE =>
stream.PutF["var[%g,%g]", [cardinal[link.modIndex]], [cardinal[link.offset]]];
};
PrintTreeLink:
PUBLIC
PROC [link: Tree.Link, stream:
STREAM] = {
WITH t~~link
SELECT TreeOps.GetTag[link]
FROM
subtree => PrintLongIndex[t.index, stream];
hash => {stream.PutRope["hash#"]; PrintLongIndex[t.index, stream]};
symbol => {stream.PutRope["symbol#"]; PrintLongIndex[t.index, stream]};
literal => {stream.PutRope["literal#"]; PrintLongIndex[t.index, stream]};
ENDCASE => ERROR;
};
PrintSei:
PUBLIC
PROC [sei: ISEIndex, stream:
STREAM, stb: SymbolTableBase] = {
PrintName[SymbolOps.NameForSe[stb, sei], stream, stb];
};
PrintName:
PUBLIC
PROC [name: Name, stream:
STREAM, stb: SymbolTableBase] = {
IF name = nullName
THEN stream.PutRope["(anon)"]
ELSE {
ss: SubString = SymbolOps.SubStringForName[stb, name];
FOR i:
NAT
IN [ss.offset..ss.offset+ss.length)
DO
stream.PutChar[ss.base[i]];
ENDLOOP;
};
};
WriteNodeName:
PUBLIC
PROC [n: NodeName, stream:
STREAM] = {
stream.PutRope[ConvertUnsafe.ToRope[NodeNameTable[n]]];
};
WriteTypeName:
PUBLIC
PROC [n: TypeClass, stream:
STREAM] = {
stream.PutRope[ConvertUnsafe.ToRope[TypeNameTable[n]]];
};
WriteModeName:
PUBLIC
PROC [n: TransferMode, stream:
STREAM] = {
stream.PutRope[ConvertUnsafe.ToRope[ModeNameTable[n]]];
};
OutCtx:
PUBLIC
PROC [message: Rope.
ROPE, ctx: CTXIndex, stream:
STREAM] = {
stream.PutRope[message];
stream.PutRope[" ctx: "];
IF ctx = CTXNull THEN stream.PutRope["NIL"] ELSE PrintLongIndex[ctx, stream];
};
OutArgType:
PUBLIC
PROC [message:
ROPE, sei: CSEIndex, stream:
STREAM, stb: SymbolTableBase] = {
IF sei = SENull
THEN {stream.PutRope[message]; stream.PutRope[": NIL"]}
ELSE
WITH t~~stb.seb[sei]
SELECT
FROM
record => OutCtx[message, t.fieldCtx, stream];
any => {stream.PutRope[message]; stream.PutRope[": ANY"]};
ENDCASE
PrintVersion:
PUBLIC
PROC [stamp: VersionStamp, stream:
STREAM, useTime:
BOOL ¬
FALSE] = {
stream.PutF["%08x%08x", [cardinal[stamp[0]]], [cardinal[stamp[1]]] ];
<<Wrong on D-machine, 'cause MobMapper thinks a VersionStamp is a pair of CARD (MJS June 19, 1990).
DigitArray:
TYPE =
PACKED
ARRAY DigitArrayIndex
OF HexDigit;
HexDigit: TYPE = [0..16);
DigitArrayIndex: TYPE = [0..BITS[VersionStamp]/BITS[HexDigit]);
FOR i: DigitArrayIndex
IN DigitArrayIndex
DO
d: HexDigit = LOOPHOLE[stamp, DigitArray][i];
IF d < 10 THEN stream.PutChar['0+d] ELSE stream.PutChar['a-10+d];
ENDLOOP;>>
<<commented out when I first looked here (MJS June 19, 1990).
IF useTime
THEN {
IF stamp.net # 0
OR stamp.host # 0
THEN
stream.PutF[" (%g, %g, ", [cardinal[stamp.net]], [cardinal[stamp.host]]]
ELSE stream.PutRope[" ("];
This next statement is separate to deal with potential errors in time conversion.
{
ENABLE RuntimeError.
UNCAUGHT =>
GO
TO dreck;
stream.PutF["%g)", [time[BasicTime.FromNSTime[stamp.time]]]];
EXITS
dreck => stream.PutRope["??)"];
};
};>>
};
PrintStringFromTable:
PUBLIC
PROC [index:
CARDINAL, stream:
STREAM, stb: SymbolTableBase] = {
str: LONG STRING = stb.ssb;
len: CARDINAL = str[index]-0C;
FOR i:
NAT
IN [1..
MIN[64, len]]
DO
stream.PutChar[str[i]];
ENDLOOP;
};
PrintString:
PUBLIC
PROC [str:
LONG
STRING, stream:
STREAM] = {
IF str #
NIL
THEN
FOR i:
NAT
IN [0..str.length)
DO
stream.PutChar[str[i]];
ENDLOOP;
};
PrintSubString:
PUBLIC
PROC [ss: SubString, stream:
STREAM] = {
FOR i: NAT IN [ss.offset..ss.offset+ss.length) DO stream.PutChar[ss.base[i]] ENDLOOP;
};
PrintIndex:
PUBLIC
PROC [index:
UNSPECIFIED, stream:
STREAM] = {
stream.Put1[[cardinal[LOOPHOLE[index, CARDINAL]]]];
};
PrintLongIndex:
PUBLIC
PROC
[index: Symbols.Base
RELATIVE
LONG
POINTER, stream:
STREAM] = {
tagged: Table.IndexRep ¬ LOOPHOLE[index];
IO.PutF1[stream, "%g:", [cardinal[tagged.tag]] ];
tagged.tag ¬ 0;
IO.PutF1[stream, "%g", [cardinal[LOOPHOLE[tagged, CARD]]] ];
};
Indent:
PUBLIC
PROC [stream:
STREAM, nBlanks:
NAT] = {
stream.PutChar['\n];
THROUGH [0..nBlanks) DO stream.PutChar[' ]; ENDLOOP;
};
DescriptorValue:
PUBLIC
PROC [stb: SymbolTableBase, lti: LTIndex]
RETURNS [LitDescriptor] = {
bitsPerWord: CARD = 16;
WITH entry~~stb.ltb[lti]
SELECT
FROM
short => {
deltaShort: CARDINAL = LTRecord.short.SIZE - Symbols.UNSPEC.SIZE;
deltaShort: CARDINAL = LOOPHOLE[@(NIL[POINTER TO LTRecord.short]).value];
RETURN [[
bits: bitsPerWord,
class: unsigned,
words: 1,
offset: LOOPHOLE[lti + deltaShort]]]};
long => {
deltaLong: CARDINAL = SIZE[LTRecord.long[0]];
deltaLong: CARDINAL = LOOPHOLE[@(NIL[POINTER TO LTRecord.long]).value];
RETURN [[
bits: entry.bits,
class: unsigned,
words: entry.bits/bitsPerWord,
offset: LOOPHOLE[lti + deltaLong]]]};
ENDCASE => ERROR;
MasterString:
PUBLIC
PROC [stb: SymbolTableBase, sti: STIndex]
RETURNS [MSTIndex ¬ MSTNull] = {
WITH s~~stb.ltb[sti]
SELECT
FROM
master => RETURN [LOOPHOLE[sti]];
copy => RETURN [s.link];
heap => RETURN [s.link];
ENDCASE;
};
ShortName:
PUBLIC
PROC [rope:
ROPE]
RETURNS [
ROPE] = {
pos: INT ¬ rope.Length[];
bang: INT ¬ pos;
WHILE pos > 0
DO
under: INT = pos - 1;
SELECT rope.Fetch[under]
FROM
'! => bang ¬ under;
'>, '/, '<, '] => RETURN [rope.Flatten[pos, bang-pos]];
ENDCASE;
pos ¬ under;
ENDLOOP;
RETURN [rope];
};
T A B L E S
NodeNameTable: ARRAY NodeName OF LONG STRING = [
"list", "item", "decl", "typedecl", "basicTC", "enumeratedTC", "recordTC", "monitoredTC", "variantTC", "refTC", "pointerTC", "listTC", "arrayTC", "arraydescTC", "sequenceTC", "procTC", "processTC", "portTC", "signalTC", "errorTC", "programTC", "anyTC", "definitionTC", "unionTC", "relativeTC", "subrangeTC", "longTC", "opaqueTC", "zoneTC", "linkTC", "varTC", "implicitTC", "frameTC", "discrimTC", "paintTC", "optionTC", "spareTC", "unit", "diritem", "module", "body", "inline", "lambda", "block", "assign", "extract", "if", "case", "casetest", "caseswitch", "bind", "do", "forseq", "upthru", "downthru", "return", "result", "goto", "exit", "loop", "free", "resume", "reject", "continue", "retry", "catchmark", "restart", "stop", "lock", "wait", "notify", "broadcast", "unlock", "null", "label", "open", "enable", "catch", "dst", "lste", "lstf", "syscall", "checked", "lst", "spareS3", "subst", "call", "portcall", "signal", "error", "syserror", "xerror", "start", "join", "apply", "callx", "portcallx", "signalx", "errorx", "syserrorx", "startx", "fork", "joinx", "index", "dindex", "seqindex", "reloc", "construct", "union", "rowcons", "sequence", "listcons", "substx", "ifx", "casex", "bindx", "assignx", "extractx", "or", "and", "relE", "relN", "relL", "relGE", "relG", "relLE", "in", "notin", "plus", "minus", "times", "div", "mod", "power", "dot", "cdot", "dollar", "create", "not", "uminus", "addr", "uparrow", "min", "max", "ord", "val", "abs", "all", "size", "first", "last", "pred", "succ", "arraydesc", "length", "base", "loophole", "nil", "new", "void", "clit", "llit", "cast", "check", "float", "pad", "chop", "safen", "syscallx", "narrow", "istype", "openx", "mwconst", "cons", "atom", "typecode", "stringinit", "textlit", "signalinit", "procinit", "intOO", "intOC", "intCO", "intCC", "thread", "none", "exlist", "initlist", "ditem", "lengthen", "shorten", "self", "gcrt", "proccheck", "entry", "internal", "invalid"];
TypeNameTable: ARRAY TypeClass OF LONG STRING = [
"mode", "basic", "signed", "unsigned", "real", "enumerated", "record", "ref", "array", "arraydesc", "transfer", "definition", "union", "sequence", "relative", "subrange", "opaque", "zone", "any", "nil"];
ModeNameTable: ARRAY TransferMode OF LONG STRING = [
"proc", "port", "signal", "error", "process", "program", "other", "none"];
from ListerSysOps:
MobErr: PUBLIC ERROR [err: ROPE] = CODE;
MobFile: TYPE = REF MobFileRecord;
MobFileRecord:
TYPE =
RECORD [
name: Rope.ROPE,
h: CountedVM.Handle,
mob: MobDefs.MobBase,
bytes: CARD
];
bytesPerWord: CARD = BYTES[WORD];
bytesPerVMWord: CARD = BYTES[WORD];
bytesPerWord32: CARD = BYTES[CARD32];
ReadMob:
PUBLIC
PROC [name:
ROPE]
RETURNS [mob: MobDefs.MobBase] = {
mobFile: MobFile ¬ NIL;
err: ROPE ¬ NIL;
stream: STREAM;
time: BasicTime.GMT;
mobFile ¬ FindMobFile[name];
IF mobFile # NIL THEN RETURN[mobFile.mob];
[stream, err, time] ¬ ListerSysOps.Open[name, read];
IF err # NIL THEN ERROR MobErr[err: err];
IF stream #
NIL
THEN {
bytes: INT ¬ IO.GetLength[stream];
allocatedBytes: CARD ¬ VM.WordsForPages[VM.PagesForBytes[bytes]] * bytesPerVMWord;
allocatedWord32s: CARD ¬ allocatedBytes / bytesPerWord32;
h: CountedVM.Handle;
mob: MobDefs.MobBase;
limit: CARD;
IF bytes = 0 THEN ERROR MobErr[err: Rope.Concat["0 length stream for file: ", name]];
h ¬ CountedVM.SimpleAllocate[allocatedBytes/bytesPerWord];
TRUSTED {
Basics.FillWords[dst: h.pointer, count: allocatedWord32s, value: CARD.LAST];
IO.SetIndex[stream, 0];
[] ¬ IO.UnsafeGetBlock[
self: stream,
block: [base: h.pointer, startIndex: 0, count: bytes]];
[] ¬ ListerSysOps.Close[stream, TRUE];
mob ¬ LOOPHOLE[h.pointer];
};
limit ¬ bytes / BYTES[UNIT];
IF MobMapper.AlterMob[mob,
LOOPHOLE[mob], limit ! MobMapper.BadMobContents => GO TO Oops] = badVersion
THEN
ERROR MobErr[err: Rope.Concat["MobMapper.AlterMob failed for ", name]];
mobFile ¬
NEW[MobFileRecord ¬ [
name: name,
h: h,
mob: mob,
bytes: bytes
]];
AddMobFile[mobFile];
EXITS
Oops => ERROR MobErr[err: Rope.Concat["MobMapper.BadMobContents raised for ", name]];
};
RETURN[mobFile.mob];
FreeMob:
PUBLIC
PROC [mob: MobDefs.MobBase] = {
mobFile: MobFile ¬ NIL;
val: CardTab.Val;
[, val] ¬ CardTab.Fetch[x: table.cardTabTable, key: LOOPHOLE[mob]];
IF val = NIL THEN RETURN;
mobFile ¬ NARROW[val];
[] ¬ CardTab.Delete[x: table.cardTabTable, key: LOOPHOLE[mob]];
[] ¬ SymTab.Delete[x: table.symTabTable, key: mobFile.name];
mobFile.name ¬ NIL;
mobFile.mob ¬ NIL;
CountedVM.Free[mobFile.h];
mobFile.h ¬ NIL;
};
TablePair: TYPE = REF TablePairRep;
TablePairRep:
TYPE =
RECORD [
cardTabTable: CardTab.Ref,
symTabTable: SymTab.Ref
];
table: TablePair = NEW[TablePairRep
¬ [cardTabTable: CardTab.Create[], symTabTable: SymTab.Create[]]];
FindMobFile:
PROC [name:
ROPE]
RETURNS [MobFile] = {
WITH SymTab.Fetch[x: table.symTabTable, key: name].val
SELECT
FROM
mobFile: MobFile => RETURN [mobFile];
ENDCASE => RETURN [NIL];
};
AddMobFile:
PROC [mobFile: MobFile] = {
[] ¬ CardTab.Insert[x: table.cardTabTable, key: LOOPHOLE[mobFile.mob], val: mobFile];
[] ¬ SymTab.Insert[x: table.symTabTable, key: mobFile.name, val: mobFile];
};
InitMobTab:
PUBLIC
PROC = {
CardTab.Erase[table.cardTabTable];
SymTab.Erase[table.symTabTable];
};