
    <<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[];
        }.