
    <<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.