UncountedAssignHack.mesa
Copyright © 1986 by Xerox Corporation. All rights reserved.
Russ Atkinson (RRA) May 1, 1986 7:11:22 pm PDT
McCreight, May 2, 1986 5:40:40 pm PDT
DIRECTORY
Allocator USING [BlockSizeIndex, bsiEscape, NHeaderP, NormalHeader],
AllocatorOps USING [bsiToSize, NewObject, REFToNHP],
Basics USING [RawWords],
PrincOpsUtils USING [LongCopy],
RCMap USING [nullIndex],
RTTypesBasicPrivate USING [MapTiTd],
SafeStorage USING [Type];
UncountedAssignHack:
CEDAR
DEFINITIONS
IMPORTS AllocatorOps, PrincOpsUtils, RTTypesBasicPrivate
= BEGIN
UncountedSmallAssign:
PROC [dst:
REF, src:
REF]
RETURNS [AssignResult] =
INLINE {
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];
};
AssignResult:
TYPE = {
success, -- assignment was successful
typesNE, -- types were not equal
sizesNE, -- sizes were not equal
problem -- some other problem
};
UncountedSmallNew:
PROC [src:
REF]
RETURNS [dst:
REF ←
NIL] =
INLINE {
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 {
dst ← AllocatorOps.NewObject[srcType, words];
PrincOpsUtils.LongCopy[
from: LOOPHOLE[src, LONG POINTER],
nwords: words - SIZE[Allocator.NormalHeader],
to: LOOPHOLE[dst, LONG POINTER]];
};
};
};
UncountedSmallEqual:
PROC [ref1, ref2:
REF]
RETURNS [EqualResult] =
INLINE {
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];
};
EqualResult:
TYPE = {
equal, -- objects were equal
typesNE, -- types were not equal
sizesNE, -- sizes were not equal
contentsNE, -- contents were not equal
problem -- either not comparable or some other problem
};
DiagnoseProblem:
PROC [ref:
REF]
RETURNS [ProblemKind] =
INLINE {
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];
};
ProblemKind:
TYPE = {
noProblem, -- no problem
nilRef, -- ref = NIL
typeIsRC, -- type is REF containing
tooLong, -- object is too long (> Allocator.maxSmallBlockSize words)
tooShort}; -- object is too small (probably damaged)
UncountedSmallAssignProc:
PUBLIC
PROC [dst:
REF, src:
REF]
RETURNS [AssignResult];
UncountedSmallAssignPlease: PUBLIC PROC [dst: REF, src: REF];
UncountedSmallNewProc:
PUBLIC
PROC [src:
REF]
RETURNS [dst:
REF ←
NIL];
UncountedSmallEqualProc: PUBLIC PROC [ref1, ref2: REF] RETURNS [EqualResult];
DiagnoseProblemProc: PUBLIC PROC [ref: REF] RETURNS [ProblemKind];
END.