--FILE:  RandomCodeDragonMemoryImpl.mesa
--Last Edited by: Sturgis, January 21, 1986 12:34:56 pm PST
-- Don Curry May 1, 1987 3:22:18 pm PDT
-- Curry, September 17, 1986 5:00:59 pm PDT



DIRECTORY
    Basics USING[LongNumber],
    DragOpsCross USING[Inst, ProcessorRegister],
    DragOpsCrossUtils USING[WordToInt],
    IO USING[card, int, PutF, rope, STREAM],
    RandomCode USING[],
    RandomCodeRandom USING[Random, RandomState],
    RandomCodeTypes USING[GetArgsResultsOfProcedureType, GetLength, GetLocalOffset, GetSeqTypeOfPointerType, GetTypeSetOfSeq, 
GetWordTypeFromOffset, SeqType, TypeSet, WordType],
    RandomCodeRandomProcedures USING[GenerateRandomProcedure, GenProcedureBytes, PrintProcedureGraph, ProcedureBody, 
TearDownProcedure, TypeCheckProcedure],
    RandomCodeDragonMemory USING[],
    Rope USING[ROPE];

RandomCodeDragonMemoryImpl: CEDAR PROGRAM IMPORTS IO, DragOpsCrossUtils, RandomCodeRandom, RandomCodeTypes, 
RandomCodeRandomProcedures EXPORTS RandomCodeDragonMemory =

BEGIN
OPEN RandomCodeRandom, RandomCodeTypes, RandomCodeRandomProcedures;


MemoryLayout: TYPE = REF MemoryLayoutBody;
MemoryLayoutBody: PUBLIC TYPE = RECORD[SEQUENCE nItems: CARDINAL OF MemoryItem];

MemoryItem: TYPE = REF MemoryItemBody;
MemoryItemBody: TYPE = RECORD[
    kind: MemoryItemKind,
    type: WordType _ NIL,
    bytePadding: CARDINAL _ 0,
    byteAddr: INT _ 0,
    byteSize: CARDINAL _ 0,
    otherData: REF ANY _ NIL];

MemoryItemKind: TYPE = REF MemoryItemKindBody;
MemoryItemKindBody: TYPE = RECORD[
    getByteSize: PROCEDURE[MemoryItem] RETURNS[INT],
    genBytes: PROCEDURE[MemoryItem, PROCEDURE[[0..255]]],
    showItem: PROCEDURE[MemoryItem, CARDINAL, IO.STREAM],
    typeCheckItem: PROCEDURE[MemoryItem],
    tearDownProcedure: PROCEDURE[MemoryItem]];
    
NullTearDownProcedure: PROCEDURE[MemoryItem] = {NULL};

-- basic memory layout
    -- (0) initial code
    -- (1) root record (contains pointers to every item (except the initial code) along with some word types)
    -- (2) root procedure
    -- (3) a record or procedure
    -- (4) a record or procedure
    -- etc

-- memory layout construction

MemIndexTableBody: TYPE = RECORD[SEQUENCE nTypes: CARDINAL OF CARDINAL];

CreateMemory: PUBLIC PROCEDURE[baseByteAddr: INT, rootRecordType: WordType, randomState: RandomState] RETURNS[MemoryLayout] =
    BEGIN    
    rootSeq: SeqType _ GetSeqTypeOfPointerType[rootRecordType];
    nItems: CARDINAL; 
    layout: MemoryLayout;
    memIndexOfComplexObject: REF MemIndexTableBody _ NEW[MemIndexTableBody[GetLength[rootSeq]]];
    rootProcType: WordType;
    rootProcArgType, rootProcResType: SeqType;
    initialCodeMemoryItem: MemoryItem;
    memoryLayoutIndex: CARDINAL;
    
    FOR I: CARDINAL IN [0..memIndexOfComplexObject.nTypes) DO
        memIndexOfComplexObject[I] _ 0;
        ENDLOOP;
        
    nItems _ 1; -- for the initial code
    FOR I: CARDINAL IN [0..GetLength[rootSeq]) DO
        t: WordType _ GetWordTypeFromOffset[rootSeq, I];
        SELECT t.type FROM
            procedure, pointer => nItems _ nItems + 1;
            ordinary => NULL;
            ENDCASE => ERROR;
        ENDLOOP;
    layout _ NEW[MemoryLayoutBody[nItems]];
    
    IF GetWordTypeFromOffset[rootSeq, 0] # rootRecordType THEN ERROR;
    rootProcType _ GetWordTypeFromOffset[rootSeq, 1];
    [rootProcArgType, rootProcResType] _ GetArgsResultsOfProcedureType[rootProcType];
    IF GetLength[rootProcArgType] # 1 THEN ERROR;
    IF GetWordTypeFromOffset[rootProcArgType, 0] # rootRecordType THEN ERROR;
    IF GetLength[rootProcResType] # 0 THEN ERROR;
    
    
    initialCodeMemoryItem _ layout[0] _ NEW[MemoryItemBody _ [
        kind: InitialCodeKind,
        otherData: CreateInitialCodeMemoryItem[]]];
    
    layout[0].bytePadding _ 0;
    layout[0].byteAddr _ baseByteAddr;
    layout[0].byteSize _ GetInitialCodeByteSize[layout[0]];
    
    memoryLayoutIndex _ 1;
    FOR I: CARDINAL IN [0..GetLength[rootSeq]) DO
        type: WordType _ GetWordTypeFromOffset[rootSeq, I];
        SELECT type.type FROM
            pointer =>
                BEGIN
                layout[memoryLayoutIndex] _ NEW[MemoryItemBody _ [
                    kind: RecordKind,
                    type: type,
                    otherData: CreateARecordMemoryItem[type, rootSeq, randomState]]];
                layout[memoryLayoutIndex].bytePadding _ (4-(layout[I].byteAddr+layout[I].byteSize) MOD 4) MOD 4;
                layout[memoryLayoutIndex].byteAddr _ (layout[I].byteAddr+layout[I].byteSize+layout[I+1].bytePadding);
                layout[memoryLayoutIndex].byteSize _ GetRecordItemByteSize[layout[memoryLayoutIndex]];
                memIndexOfComplexObject[I] _ memoryLayoutIndex;
                memoryLayoutIndex _ memoryLayoutIndex+1;
                END;
            procedure =>
                BEGIN
                layout[memoryLayoutIndex] _ NEW[MemoryItemBody _ [
                    kind: ProcedureKind,
                    type: type,
                    otherData: CreateAProcedureMemoryItem[type, randomState]]];
                layout[memoryLayoutIndex].bytePadding _ 0;
                layout[memoryLayoutIndex].byteAddr _ 
(layout[memoryLayoutIndex-1].byteAddr+layout[memoryLayoutIndex-1].byteSize+layout[memoryLayoutIndex].bytePadding);
                layout[memoryLayoutIndex].byteSize _ GetProcedureItemByteSize[layout[memoryLayoutIndex]];
                memIndexOfComplexObject[I] _ memoryLayoutIndex;
                memoryLayoutIndex _ memoryLayoutIndex+1;
                END;
            ordinary => NULL;
            ENDCASE => ERROR;
        ENDLOOP;
    
    SetByteAddressOfRootRecord[initialCodeMemoryItem, layout[1].byteAddr];
    SetByteAddressOfRootProcedure[initialCodeMemoryItem, layout[2].byteAddr];
    
    FOR I: CARDINAL IN [0..GetLength[rootSeq]) DO
        type: WordType _ GetWordTypeFromOffset[rootSeq, I];
        MemItemByteAddr: PROC[typeIndex: CARDINAL] RETURNS[byteAddr: INT] =
            {RETURN[layout[memIndexOfComplexObject[typeIndex]].byteAddr]};
        SELECT type.type FROM
            pointer => 
                {SetRecordItemPointerAddresses[layout[memIndexOfComplexObject[I]], MemItemByteAddr, randomState]};
            procedure => NULL;
            ordinary => NULL;
            ENDCASE => ERROR;
        ENDLOOP;
    
    SetUserModeFlag[initialCodeMemoryItem, (Random[randomState] MOD 100) > 80]; 
        
    RETURN[layout];    
    END;

GenMemoryBytes: PUBLIC PROCEDURE[layout: MemoryLayout, oneByte: PROC[[0..255]]] =
    BEGIN
    FOR I: CARDINAL IN [0..layout.nItems) DO
        FOR J: CARDINAL IN [0..layout[I].bytePadding) DO oneByte[0] ENDLOOP;
        layout[I].kind.genBytes[layout[I], oneByte];
        ENDLOOP;
    END;

TearDownProcedures: PUBLIC PROCEDURE[layout: MemoryLayout] =
    BEGIN
    FOR I: CARDINAL IN [0..layout.nItems) DO
        layout[I].kind.tearDownProcedure[layout[I]];
        ENDLOOP;
    END;


ShowMemory: PUBLIC PROCEDURE[layout: MemoryLayout, on: IO.STREAM] =
    BEGIN
    FOR I: CARDINAL IN [0..layout.nItems) DO
        typeName: Rope.ROPE _ IF I = 0 THEN "initialCode" ELSE SELECT layout[I].type.type FROM
            pointer => "Record",
            procedure => "Procedure",
            ENDCASE => ERROR;
        on.PutF["item # %g, type = %g, skipBytes: %g, byteAddr = %g\N", IO.card[I], IO.rope[typeName], 
IO.card[layout[I].bytePadding], IO.int[layout[I].byteAddr]];
        layout[I].kind.showItem[layout[I], 5, on];
        ENDLOOP;
    END;

TypeCheckMemory: PUBLIC PROCEDURE[layout: MemoryLayout] =
    BEGIN -- for the moment, only type checks procedures
    FOR I: CARDINAL IN [0..layout.nItems) DO
        layout[I].kind.typeCheckItem[layout[I]];
        ENDLOOP;
    END;    
    

-- initial code

-- the initial code is:
    -- LIQB a status word to set user mode with 20% probability
    -- SIP ifuStatus
    -- LIQB addressOfRootRecord
    -- LIQB addressOfRootProcedure
    -- SFC
    -- HaltTrap HaltTrap HaltTrap

LIQBcode: [0..255] = DragOpsCross.Inst[dLIQB].ORD;
SIPcode: [0..255] = DragOpsCross.Inst[dSIP].ORD;
SFCcode: [0..255] = DragOpsCross.Inst[dSFC].ORD;
HaltTrapCode: [0..255] = DragOpsCross.Inst[x377b].ORD;
    
InitialCodeKind: MemoryItemKind _ NEW[MemoryItemKindBody _ [
    getByteSize: GetInitialCodeByteSize,
    genBytes: GenInitialCodeBytes,
    showItem: ShowInitialCode,
    typeCheckItem: TypeCheckInitialCode,
    tearDownProcedure: NullTearDownProcedure]];

InitialCodeDataBody: TYPE = RECORD[
    byteAddressOfRootRecord: INT _ 0,
    byteAddressOfRootProcedure: INT _ 0,
    statusRec: INT _ 0
    ];

CreateInitialCodeMemoryItem: PROCEDURE RETURNS[REF ANY] =
    {RETURN[NEW[InitialCodeDataBody]]};

GetInitialCodeByteSize: PROCEDURE[item: MemoryItem] RETURNS[INT] =
    {RETURN[21]};

GenInitialCodeBytes: PROCEDURE[item: MemoryItem, oneByte: PROCEDURE[[0..255]]] =
    BEGIN
    data: REF InitialCodeDataBody _ NARROW[item.otherData];
    oneByte[LIQBcode];
    GenCodeInt[data.statusRec, oneByte];
    oneByte[SIPcode];
    ERROR;
    -- oneByte[ORD[DragOpsCross.ProcessorRegister.ifuStatus]];
    -- intended to be the byte address of ifuStatus
    oneByte[LIQBcode];
    GenCodeInt[data.byteAddressOfRootRecord/4, oneByte];
    oneByte[LIQBcode];
    GenCodeInt[data.byteAddressOfRootProcedure, oneByte];
    oneByte[SFCcode];
    oneByte[HaltTrapCode];
    oneByte[HaltTrapCode];
    oneByte[HaltTrapCode];
    END;

ShowInitialCode: PROCEDURE[item: MemoryItem, nested: CARDINAL, on: IO.STREAM] =
    BEGIN
    showOneCodeByte: PROCEDURE[byte: [0..255]] =
        {on.PutF[" %g", IO.card[byte]]};
    FOR I: CARDINAL IN [0..nested) DO on.PutF[" "]; ENDLOOP;
    GenInitialCodeBytes[item, showOneCodeByte];
    on.PutF["\N"];
    END;

TypeCheckInitialCode: PROCEDURE[item: MemoryItem] =
    BEGIN
    -- ERROR fill this in
    END;

SetByteAddressOfRootRecord: PROCEDURE[item: MemoryItem, address: INT] =
    BEGIN
    data: REF InitialCodeDataBody _ NARROW[item.otherData];
    data.byteAddressOfRootRecord _ address;
    END;

SetByteAddressOfRootProcedure: PROCEDURE[item: MemoryItem, address: INT] =
    BEGIN
    data: REF InitialCodeDataBody _ NARROW[item.otherData];
    data.byteAddressOfRootProcedure _ address;
    END;

SetUserModeFlag: PROCEDURE[item: MemoryItem, userMode: BOOLEAN] =
    BEGIN
    data: REF InitialCodeDataBody _ NARROW[item.otherData];
    ERROR; -- fix this
    -- data.statusRec _
    -- DragOpsCrossUtils.WordToInt[DragOpsCrossUtils.StatusToWord[DragOpsCross.IFUStatusRec
    -- [userModeKeep: FALSE, userMode: userMode, trapsEnabledKeep: TRUE,
    -- rescheduleKeep: TRUE]]];
    END;

-- procedure memory items

ProcedureKind: MemoryItemKind _ NEW[MemoryItemKindBody _ [
    getByteSize: GetProcedureItemByteSize,
    genBytes: GenProcedureItemBytes,
    showItem: ShowProcedureItem,
    typeCheckItem: TypeCheckProcedureItem,
    tearDownProcedure: TearDownProcedureItem]];

ProcedureItemDataBody: TYPE = RECORD[
    procedureBody: ProcedureBody,
    byteSize: INT];

CreateAProcedureMemoryItem: PROCEDURE[procedureType: WordType, randomState: RandomState] RETURNS[REF ANY] =
    BEGIN
    data: REF ProcedureItemDataBody _ NEW[ProcedureItemDataBody];
    allowedArgs, possibleResults: SeqType;
    typeSet: TypeSet;
    [allowedArgs, possibleResults] _ GetArgsResultsOfProcedureType[procedureType];
    typeSet _ GetTypeSetOfSeq[allowedArgs];
    [data.procedureBody, data.byteSize] _ GenerateRandomProcedure[allowedArgs, possibleResults, typeSet, randomState];
    RETURN[data];
    END;

GetProcedureItemByteSize: PROCEDURE[item: MemoryItem] RETURNS[INT] = BEGIN
    data: REF ProcedureItemDataBody _ NARROW[item.otherData];
    RETURN[data.byteSize];
    END;

GenProcedureItemBytes: PROCEDURE[item: MemoryItem, oneByte: PROCEDURE[[0..255]]] =
    BEGIN
    data: REF ProcedureItemDataBody _ NARROW[item.otherData];
    GenProcedureBytes[data.procedureBody, oneByte];
    END;

ShowProcedureItem: PROCEDURE[item: MemoryItem, nested: CARDINAL, on: IO.STREAM] =
    BEGIN
    data: REF ProcedureItemDataBody _ NARROW[item.otherData];
    PrintProcedureGraph["", data.procedureBody, on];
    END;

TypeCheckProcedureItem: PROCEDURE[item: MemoryItem] =
    BEGIN
    data: REF ProcedureItemDataBody _ NARROW[item.otherData];
    TypeCheckProcedure[data.procedureBody];
    -- ERROR this procedure should also use the know call type of the procedure
    END;

TearDownProcedureItem: PROCEDURE[item: MemoryItem] =
    BEGIN
    data: REF ProcedureItemDataBody _ NARROW[item.otherData];
    TearDownProcedure[data.procedureBody];
    END;


-- record memory items

RecordKind: MemoryItemKind _ NEW[MemoryItemKindBody _ [
    getByteSize: GetRecordItemByteSize,
    genBytes: GenRecordItemBytes,
    showItem: ShowRecordItem,
    typeCheckItem: TypeCheckRecordItem,
    tearDownProcedure: NullTearDownProcedure]];

RecordItemDataBody: TYPE = RECORD[seqType: SeqType, pointers: SEQUENCE nWords: CARDINAL OF RECORD[
    tIndex: CARDINAL, byteAddress: INT, data: INT]];

CreateARecordMemoryItem: PROCEDURE[pointerType: WordType, rootSeq: SeqType, randomState: RandomState] RETURNS[REF ANY] =
    BEGIN
    seqType: SeqType _ GetSeqTypeOfPointerType[pointerType];
    nWords: CARDINAL _ GetLength[seqType];
    data: REF RecordItemDataBody _ NEW[RecordItemDataBody[nWords]];
    data.seqType _ seqType;
    FOR I: CARDINAL IN [0..nWords) DO
        tIndex: CARDINAL _ GetLocalOffset[rootSeq, GetWordTypeFromOffset[seqType, I], Random[randomState]]; 
        data.pointers[I].tIndex _ tIndex;
        ENDLOOP;
    RETURN[data];
    END;

GetRecordItemByteSize: PROCEDURE[item: MemoryItem] RETURNS[INT] = 
    BEGIN
    data: REF RecordItemDataBody _ NARROW[item.otherData];
    RETURN[4*data.nWords]
    END;


SetRecordItemPointerAddresses: PROCEDURE[item: MemoryItem, byteAddressOfMemItem: PROC[typeIndex: CARDINAL] RETURNS[INT], 
randomState: RandomState] =
    BEGIN
    data: REF RecordItemDataBody _ NARROW[item.otherData];
    FOR I: CARDINAL IN [0..data.nWords) DO
        t: WordType _ GetWordTypeFromOffset[data.seqType, I];
        data.pointers[I].byteAddress _ byteAddressOfMemItem[data.pointers[I].tIndex];
        SELECT t.type FROM
            pointer =>
                BEGIN
                IF data.pointers[I].byteAddress MOD 4 # 0 THEN ERROR;
                data.pointers[I].data _ data.pointers[I].byteAddress/4;
                END;
            procedure => data.pointers[I].data _ data.pointers[I].byteAddress;
            ordinary =>
                BEGIN
                decodedData: Basics.LongNumber;
                decodedData.lo _ Random[randomState];
                decodedData.hi _ Random[randomState];
                data.pointers[I].data _ LOOPHOLE[decodedData]; 
                END;
            ENDCASE => ERROR;
        ENDLOOP;
    END;

GenRecordItemBytes: PROCEDURE[item: MemoryItem, oneByte: PROCEDURE[[0..255]]] =
    BEGIN
    data: REF RecordItemDataBody _ NARROW[item.otherData];
    FOR I: CARDINAL IN [0..data.nWords) DO
        GenDataInt[data.pointers[I].data, oneByte];
        ENDLOOP;
    END;

ShowRecordItem: PROCEDURE[item: MemoryItem, nested: CARDINAL, on: IO.STREAM] =
    BEGIN
    data: REF RecordItemDataBody _ NARROW[item.otherData];
    FOR I: CARDINAL IN [0..data.nWords) DO
        FOR J: CARDINAL IN [0..nested) DO on.PutF[" "] ENDLOOP;
        on.PutF["%g\N", IO.int[data.pointers[I].data]];
        ENDLOOP;
    on.PutF["\N"];
    END;

TypeCheckRecordItem: PROCEDURE[item: MemoryItem] =
    BEGIN
    -- ERROR fill in
    END;





-- two procedures for generating the bytes of an INT, GenCodeInt is used for the bytes of an integer to appear as the traiing 4 
bytes of a 5 bytes instruction (in inverse order) and GenDataInt delivers the bytes to be placed in a data word.

-- December 16, 1985 2:56:59 pm PST: the byte order of a literal occuring in code has been reversed, to become high byte first.  
Thus, GenCodeInt now generates bytes in same order as GenDataInt 



GenCodeInt: PROCEDURE[int: INT, oneByte: PROCEDURE[[0..255]]] =
    BEGIN
    decodedInt: Basics.LongNumber _ LOOPHOLE[int];
    oneByte[decodedInt.hh];
    oneByte[decodedInt.hl];
    oneByte[decodedInt.lh];
    oneByte[decodedInt.ll];
    END;

GenDataInt: PROCEDURE[int: INT, oneByte: PROCEDURE[[0..255]]] =
    BEGIN
    decodedInt: Basics.LongNumber _ LOOPHOLE[int];
    oneByte[decodedInt.hh];
    oneByte[decodedInt.hl];
    oneByte[decodedInt.lh];
    oneByte[decodedInt.ll];
    END;


END.
MODULE HISTORY

Initial by: Sturgis,   October 10, 1984 4:17:04 pm PDT, copied from RandomCodeTestImpl.  Early comments still in that module.