UncountedAssignHackImpl.mesa
Copyright © 1986 by Xerox Corporation. All rights reserved.
Russ Atkinson (RRA) May 1, 1986 6:04:36 pm PDT
McCreight, May 7, 1986 6:50:01 pm PDT
DIRECTORY
Allocator USING [BlockSizeIndex, bsiEscape, NHeaderP, NormalHeader],
AllocatorOps USING [bsiToSize, NewObject, REFToNHP],
Basics USING [RawWords],
Commander USING [Register, CommandProc],
PrincOpsUtils USING [LongCopy],
RCMap USING [nullIndex],
RTTypesBasicPrivate USING [MapTiTd],
SafeStorage USING [Type],
UncountedAssignHack;
UncountedAssignHackImpl: CEDAR PROGRAM
IMPORTS AllocatorOps, Commander, PrincOpsUtils, RTTypesBasicPrivate
EXPORTS UncountedAssignHack
= BEGIN OPEN UncountedAssignHack;
UncountedSmallAssignProc: PUBLIC PROC [dst: REF, src: REF] RETURNS [AssignResult] = {
SELECT TRUE FROM
dst = NIL, src = NIL => RETURN [problem];
dst # src => TRUSTED {
dstNhp: Allocator.NHeaderP = AllocatorOps.REFToNHP[dst];
dstType: SafeStorage.Type = dstNhp.type;
dstBsi: Allocator.BlockSizeIndex = dstNhp.blockSizeIndex;
srcNhp: Allocator.NHeaderP = AllocatorOps.REFToNHP[src];
srcType: SafeStorage.Type = srcNhp.type;
srcBsi: Allocator.BlockSizeIndex = srcNhp.blockSizeIndex;
words: CARDINAL = AllocatorOps.bsiToSize[srcBsi];
SELECT TRUE FROM
dstType # srcType => RETURN [typesNE];
dstBsi # srcBsi => RETURN [sizesNE];
RTTypesBasicPrivate.MapTiTd[dstType].rcmx # RCMap.nullIndex =>
RETURN [problem];
dstBsi = Allocator.bsiEscape => RETURN [problem];
words <= SIZE[Allocator.NormalHeader] => RETURN [problem];
ENDCASE;
PrincOpsUtils.LongCopy[
from: LOOPHOLE[src, LONG POINTER],
nwords: words - SIZE[Allocator.NormalHeader],
to: LOOPHOLE[dst, LONG POINTER]];
};
ENDCASE;
RETURN [success];
};
UncountedSmallAssignPlease: PUBLIC PROC [dst: REF, src: REF] = {
IF UncountedSmallAssignProc[dst, src] # success THEN ERROR;
};
UncountedSmallNewProc: PUBLIC PROC [src: REF] RETURNS [dst: REF ← NIL] = {
Returns NIL if there was some problem.
IF src # NIL THEN TRUSTED {
srcNhp: Allocator.NHeaderP = AllocatorOps.REFToNHP[src];
srcType: SafeStorage.Type = srcNhp.type;
srcBsi: Allocator.BlockSizeIndex = srcNhp.blockSizeIndex;
words: CARDINAL ← AllocatorOps.bsiToSize[srcBsi];
IF words > SIZE[Allocator.NormalHeader] AND srcBsi # Allocator.bsiEscape AND RTTypesBasicPrivate.MapTiTd[srcType].rcmx = RCMap.nullIndex THEN {
words ← words - SIZE[Allocator.NormalHeader];
dst ← AllocatorOps.NewObject[srcType, words];
PrincOpsUtils.LongCopy[
from: LOOPHOLE[src, LONG POINTER],
nwords: words,
to: LOOPHOLE[dst, LONG POINTER]];
};
};
};
UncountedSmallEqualProc: PUBLIC PROC [ref1, ref2: REF] RETURNS [EqualResult] = {
SELECT TRUE FROM
ref1 = NIL, ref2 = NIL => RETURN [problem];
ref1 # ref2 => TRUSTED {
nhp1: Allocator.NHeaderP = AllocatorOps.REFToNHP[ref1];
type1: SafeStorage.Type = nhp1.type;
bsi1: Allocator.BlockSizeIndex = nhp1.blockSizeIndex;
nhp2: Allocator.NHeaderP = AllocatorOps.REFToNHP[ref2];
type2: SafeStorage.Type = nhp2.type;
bsi2: Allocator.BlockSizeIndex = nhp2.blockSizeIndex;
words: CARDINAL = AllocatorOps.bsiToSize[bsi1];
SELECT TRUE FROM
type1 # type2 => RETURN [typesNE];
bsi1 # bsi2 => RETURN [sizesNE];
bsi1 = Allocator.bsiEscape, bsi2 = Allocator.bsiEscape => RETURN [problem];
words <= SIZE[Allocator.NormalHeader] => RETURN [problem];
ENDCASE;
FOR i: NAT IN [0..words-SIZE[Allocator.NormalHeader]) DO
IF LOOPHOLE[ref1, LONG POINTER TO Basics.RawWords][i]
# LOOPHOLE[ref2, LONG POINTER TO Basics.RawWords][i] THEN
RETURN [contentsNE];
ENDLOOP;
};
ENDCASE;
RETURN [equal];
};
DiagnoseProblemProc: PUBLIC PROC [ref: REF] RETURNS [ProblemKind] = {
IF ref # NIL THEN TRUSTED {
refNhp: Allocator.NHeaderP = AllocatorOps.REFToNHP[ref];
refType: SafeStorage.Type = refNhp.type;
refBsi: Allocator.BlockSizeIndex = refNhp.blockSizeIndex;
words: CARDINAL = AllocatorOps.bsiToSize[refBsi];
SELECT TRUE FROM
RTTypesBasicPrivate.MapTiTd[refType].rcmx # RCMap.nullIndex =>
RETURN [typeIsRC];
refBsi = Allocator.bsiEscape => RETURN [tooLong];
words <= SIZE[Allocator.NormalHeader] => RETURN [tooShort];
ENDCASE => RETURN [noProblem];
};
RETURN [nilRef];
};
Init: Commander.CommandProc = {NULL};
Commander.Register["UncountedAssignHack", Init];
END.