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; UncountedAssignHackImpl: CEDAR PROGRAM IMPORTS AllocatorOps, 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 = MIN[AllocatorOps.bsiToSize[dstBsi], AllocatorOps.bsiToSize[srcBsi]]; SELECT TRUE FROM dstType # srcType => RETURN [typesNE]; RTTypesBasicPrivate.MapTiTd[dstType].rcmx # RCMap.nullIndex => RETURN [problem]; srcBsi = Allocator.bsiEscape, 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] = { 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]]; }; }; }; 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 = MIN[AllocatorOps.bsiToSize[bsi1], AllocatorOps.bsiToSize[bsi2]]; SELECT TRUE FROM type1 # type2 => RETURN [typesNE]; 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]; }; END. "UncountedAssignHackImpl.mesa Copyright c 1986 by Xerox Corporation. All rights reserved. Russ Atkinson (RRA) May 1, 1986 6:04:36 pm PDT McCreight, May 5, 1986 6:06:19 pm PDT dstBsi # srcBsi => RETURN [sizesNE]; Returns NIL if there was some problem. bsi1 # bsi2 => RETURN [sizesNE]; Κ»˜codešœ™Kšœ Οmœ1™žœ ˜OKšœ žœžœ ˜:Kšžœ˜—Kšœžœžœžœžœžœžœžœ˜ŠK˜—Kšžœ˜—Kšžœ ˜K˜K˜—š Ÿœžœžœžœžœ˜@Kšžœ.žœžœ˜;K˜K˜—š Ÿœž œžœžœžœžœ˜JKšœžœ™&šžœžœžœžœ˜Kšœ8˜8Kšœ(˜(Kšœ9˜9Kšœžœ"˜1š žœ žœžœžœ=žœ˜Kšœ-˜-Kšœžœžœžœžœžœžœžœ˜ŠKšœ˜—K˜—K˜K˜—K˜šŸœž œžœžœ˜Pšžœžœž˜Kšœžœ žœžœ ˜+šœžœ˜Kšœ7˜7Kšœ$˜$Kšœ5˜5Kšœ7˜7Kšœ$˜$Kšœ5˜5Kšœžœžœ=˜Ršžœžœž˜Kšœžœ ˜"Kšœžœ ™ Kšœ:žœ ˜KKšœ žœžœ ˜:Kšžœ˜—š žœžœžœ žœž˜8šžœžœžœžœžœžœžœžœžœž˜oKšžœ˜—Kšžœ˜—K˜—Kšžœ˜—Kšžœ ˜K˜K˜—šŸœž œžœžœ˜Ešžœžœžœžœ˜Kšœ8˜8Kšœ(˜(Kšœ9˜9Kšœžœ"˜1šžœžœž˜Kšœ?žœ ˜QKšœ žœ ˜1Kšœ žœžœ ˜;Kšžœžœ ˜—K˜—Kšžœ ˜K˜K˜—K˜Kšžœ˜K˜J˜—…—βΏ