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