DragomanOpDebugImpl.mesa
Last Edited by: Sweet, December 7, 1984 2:38:58 pm PST
Bertrand Serlet July 27, 1985 9:45:30 pm PDT
DIRECTORY
DragomanOpDebug,
Basics,
Convert,
ConvertUnsafe,
ListerUtils,
PrincOps,
Rope,
RuntimeError;
DragomanOpDebugImpl: PROGRAM
IMPORTS Convert, ConvertUnsafe, ListerUtils, RuntimeError
EXPORTS DragomanOpDebug = {
OPEN PrincOps; -- mainly for opcode names
Byte: TYPE = Basics.Byte;
ROPE: TYPE = Rope.ROPE;
JumpOp: TYPE = [PrincOps.zJ2..PrincOps.zJIW];
RopeForOperation: PUBLIC PROC [operation: ARRAY [0..3) OF Byte, pc: CARDINAL] RETURNS [ROPE] = {
op: Byte = operation[0];
il: CARDINAL;
param: RECORD [SELECT OVERLAID * FROM
word => [w: CARDINAL],
bytes => [alpha, beta: Byte],
nibbles => [n1, n2, n3, n4: [0..16)],
ENDCASE] ← [bytes[operation[1], operation[2]]];
opLine: STRING ← [30];
AddRope: PROC [r: ROPE] = {IF r # NIL THEN ConvertUnsafe.AppendRope[opLine, r]};
AddChar: PROC [c: CHAR] = {opLine[opLine.length] ← c; opLine.length ← opLine.length+1};
AddNum: PROC [i: INT] = {ConvertUnsafe.AppendRope[opLine, Convert.RopeFromInt[i, 8]]};
IF opData = NIL THEN RETURN [Convert.RopeFromInt[op, 8]];
BEGIN ENABLE RuntimeError.BoundsFault => GO TO enough;
AddRope[opData[op].name];
il ← MAX[opData[op].length, 1];
SELECT il FROM
1 => IF op IN JumpOp THEN {
AddChar[' ]; AppendJumpAddress[opLine: opLine, jop: op, pc: pc, arg: 0]};
2 => {
AddChar[' ];
SELECT op FROM
zRILP, zWILP, zRXLP, zWXLP, zRIGP,
zRXLPL, zWXLPL, zRXGPL, zWXGPL,
zRILPL, zWILPL, zRIGPL, zWIGPL => {
AddChar['[]; AddNum[param.n1];
AddRope[", "]; AddNum[param.n2];
AddChar[']]};
ENDCASE => AddNum[param.alpha];
IF op IN JumpOp THEN
AppendJumpAddress[opLine: opLine, jop: op, pc: pc, arg: param.alpha];
SELECT op FROM
zMISC => {AddChar[' ]; AddRope[miscName[param.alpha]]};
zKFCB => {AddChar[' ]; AddRope[sdName[param.alpha]]};
ENDCASE;
};
3 => {
AddChar[' ];
SELECT op FROM
zRF, zWF, zWSF, zRFC, zRFL, zWFL => {
AddNum[param.alpha];
AddRope[", ["];AddNum[param.n3];
AddRope[", "]; AddNum[param.n4];
AddChar[']]};
ENDCASE => AddNum[param.w];
SELECT op FROM
zJIB, zJIW => NULL;
IN JumpOp => AppendJumpAddress[opLine: opLine, jop: op, pc: pc, arg: param.w];
ENDCASE};
ENDCASE;
EXITS
enough => NULL;
END;
RETURN [ConvertUnsafe.ToRope[opLine]]};
AppendJumpAddress: PROC [opLine: STRING, jop: Byte, pc: CARDINAL, arg: INT] = {
OPEN PrincOps;
AddChar: PROC [c: CHAR] = {opLine[opLine.length] ← c; opLine.length ← opLine.length+1};
SELECT opData[jop].length FROM
1 =>
SELECT jop FROM
IN [zJ2..zJ9] => arg ← jop - zJ2 + 2;
IN [zJEQ2..zJEQ9] => arg ← jop - zJEQ2 + 2;
IN [zJNE2..zJNE9] => arg ← jop - zJNE2 + 2;
ENDCASE => ERROR;
2 =>
BEGIN
IF arg > 177B THEN arg ← -(400B - arg);
END;
ENDCASE;
ConvertUnsafe.AppendRope[opLine, " ("];
ConvertUnsafe.AppendRope[opLine, Convert.RopeFromInt[pc+arg, 8]];
AddChar[')]};
after much thought, decided to allocate these once and for all
NameTable: TYPE = ARRAY Byte OF ROPE;
miscName, sdName: REF NameTable ← NIL;
opData: ListerUtils.OpCodeArray ← NIL;
OpData: PUBLIC PROC RETURNS [ListerUtils.OpCodeArray] = {RETURN [opData]};
InitializeTables: PROC = { --for speed and ease of use, waste storage for these names that will never be reclaimed until rollback
opData ← ListerUtils.GetOpCodeArray[];
miscName ← NEW[NameTable ← ALL[NIL]];
sdName ← NEW[NameTable ← ALL[NIL]];
Misc alpha bytes (edited from PrincOps)
miscName[0B] ← "ASSOC";
miscName[1B] ← "SETF";
miscName[2B] ← "READRAM";
miscName[3B] ← "LOADRAMJ";
miscName[5B] ← "INPUT";
miscName[6B] ← "OUTPUT";
miscName[7B] ← "CHKSUM";
miscName[10B] ← "SETMP";
miscName[11B] ← "RCLK";
miscName[12B] ← "RPRINTER";
miscName[13B] ← "WPRINTER";
miscName[14B] ← "BANDBLT";
miscName[15B] ← "TEXTBLT";
miscName[16B] ← "GETF";
miscName[20B] ← "FADD";
miscName[21B] ← "FSUB";
miscName[22B] ← "FMUL";
miscName[23B] ← "FDIV";
miscName[24B] ← "FCOMP";
miscName[25B] ← "FIX";
miscName[26B] ← "FLOAT";
miscName[27B] ← "FIXI";
miscName[30B] ← "FIXC";
miscName[31B] ← "FSTICKY";
miscName[32B] ← "FREM";
miscName[33B] ← "ROUND";
miscName[34B] ← "ROUNDI";
miscName[35B] ← "ROUNDC";
miscName[36B] ← "FSQRT";
miscName[37B] ← "FSC";
miscName[102B] ← "ZERO";
miscName[104B] ← "VERSION";
System dispatch offsets, edited from PrincOps
sdName[0] ← "Break";
sdName[2] ← "StackError";
sdName[3] ← "WakeupError";
sdName[4] ← "XferTrap";
sdName[5] ← "Unimplemented";
sdName[6] ← "AllocTrap";
sdName[7] ← "ControlFault";
sdName[10B] ← "SwapTrap";
sdName[11B] ← "PageFault";
sdName[12B] ← "WriteProtect";
sdName[13B] ← "Unbound";
sdName[14B] ← "ZeroDivisor";
sdName[15B] ← "DivideCheck";
sdName[16B] ← "HardwareError";
sdName[17B] ← "ProcessTrap";
sdName[20B] ← "BoundsFault";
sdName[21B] ← "PointerFault";
sdName[40B] ← "SignalList";
sdName[41B] ← "Signal";
sdName[42B] ← "ErrorList";
sdName[43B] ← "Error";
sdName[44B] ← "ReturnErrorList";
sdName[45B] ← "ReturnError";
sdName[46B] ← "UnnamedError";
sdName[47B] ← "UncaughtSignal";
sdName[52B] ← "BLTE";
sdName[53B] ← "BYTBLTE";
sdName[54B] ← "BLTEC";
sdName[55B] ← "BYTBLTEC";
sdName[56B] ← "BLTEL";
sdName[57B] ← "BYTBLTEL";
sdName[60B] ← "BLTECL";
sdName[61B] ← "BYTBLTECL";
sdName[62B] ← "StringInit";
sdName[63B] ← "SignedDiv";
sdName[64B] ← "LongMul";
sdName[65B] ← "LongDivMod";
sdName[66B] ← "LongDiv";
sdName[67B] ← "LongMod";
sdName[70B] ← "ULongDivMod";
sdName[71B] ← "ULongDiv";
sdName[72B] ← "ULongMod";
sdName[73B] ← "LongStringCheck";
sdName[75B] ← "Copy"; -- implements NEW <PROGRAM>
sdName[77B] ← "Start"; -- implements START <PROGRAM>
sdName[100B] ← "Restart"; -- implements RESTART <PROGRAM>
sdName[101B] ← "GFTLength";
sdName[103B] ← "AlternateBreak";
sdName[113B] ← "IOResetBits";
sdName[114B] ← "BreakBlock";
sdName[115B] ← "BreakBlockSize";
sdName[116B] ← "PerfMonitor";
sdName[117B] ← "Logging";
sdName[120B] ← "XferTrapMonitor";
sdName[121B] ← "CrossMDSLow";
sdName[122B] ← "CrossMDSHigh";
sdName[124B] ← "Fork"; -- implements FORK <proc>
sdName[125B] ← "Join"; -- implements JOIN <PROCESS>
sdName[130B] ← "FADD";
sdName[131B] ← "FSUB";
sdName[132B] ← "FMUL";
sdName[133B] ← "FDIV";
sdName[134B] ← "FCOMP";
sdName[135B] ← "FIX";
sdName[136B] ← "FLOAT";
sdName[142B] ← "BootSwitches";
};
InitializeTables[];
}.