-- TeleDebImpl6.mesa
-- Last modified:
--   Stewart,  September 7, 1982  10:41 PM

DIRECTORY
  Inline,
  IntelHex6,
  IODefs,
  PupDefs USING [GetPupPackageUseCount],
  PupRouterDefs USING [numberOfNetworks],
  Storage USING [FreeString, String],
  StreamDefs,
  String,
  TeleLoad6,
  WF;

TeleDebImpl6: PROGRAM
  IMPORTS
    Inline, IntelHex6, IODefs, PupDefs, PupRouterDefs, Storage, StreamDefs,
    String, TeleLoad6, WF =
  {

  TeleDebugData: TYPE = RECORD [
    h: TeleLoad6.Handle _ NIL,
    iS: StreamDefs.StreamHandle _ NIL,
    program: TeleLoad6.CoreBlock _ NIL,
    programName: STRING _ NIL,
    larkState: TeleLoad6.State8086Object,
    altered: BOOLEAN _ FALSE];

  z: MDSZone _ TeleLoad6.GetZone[];
  tdd: POINTER TO TeleDebugData _ NIL;
  MaxLump: CARDINAL = 128;

  Failed: SIGNAL = CODE;

  BitOp: TYPE = PROC [a, b: UNSPECIFIED] RETURNS [UNSPECIFIED];

  And: BitOp = INLINE {RETURN[Inline.BITAND[a, b]]; };
  Shift: BitOp = INLINE {RETURN[Inline.BITSHIFT[a, b]]; };

  myEndOf: IntelHex6.EndOfProc = {RETURN[tdd.iS.endof[tdd.iS]]; };
  myGetByte: IntelHex6.GetByteProc = {RETURN[tdd.iS.get[tdd.iS]]; };
  myGetPosition: IntelHex6.GetPositionProc = {
    RETURN[StreamDefs.GetPosition[tdd.iS]]; };
  mySetPosition: IntelHex6.SetPositionProc = {
    StreamDefs.SetPosition[tdd.iS, p]; };

  myPutC: IntelHex6.PutCharProc = {WF.WFC[c]; };

  MCR: PROC = {WF.WFCR[]; };

  Main: PROC = {
    {
    ENABLE ABORTED => GO TO CleanUp;
    c: CHARACTER;
    tdd _ z.NEW[TeleDebugData];
    tdd^ _ [larkState: [ALL[0]]];
    WF.WF0["TeleDeb*n"];
    tdd.iS _ NIL;
    FOR i: TeleLoad6.Registers8086 IN [AX..DX] DO
      tdd.larkState.Regs[i] _ 0; ENDLOOP;
    tdd.larkState.Regs[SP] _ 100B;
    tdd.altered _ FALSE;

    DO
      ENABLE {
        IODefs.Rubout => {WF.WF0[" !Rubout!*n"]; CONTINUE; };
        String.InvalidNumber => {WF.WF0[" !InvalidNumber!*n"]; CONTINUE; };
        };
      NoEcho[];
      WF.WF0["%% "];
      c _ IODefs.ReadChar[];
      WF.WF0["  "];
      SELECT c FROM
        'b, 'B => Blit[];
        'o, 'O => Open[];
        'c, 'C => Close[];
        'd, 'D => Fetch[];
        'g, 'G => SetState[];
        'l, 'L => Load[];
        'm, 'M => MemoryTest[];
        'p, 'P => Parse[];
        'r, 'R => AlterRegister[];
        's, 'S => Store[];
        'x, 'X => GetState[];
        'q, 'Q => EXIT;
        '? => Help[];
        ENDCASE => WF.WF0[" type '? for Help*n"];
      ENDLOOP;
    EXITS CleanUp => NULL;
    };
    IF tdd.h # NIL THEN Close[];
    WF.WF0["TeleDeb quitting*n"];
    IF tdd.programName # NIL THEN Storage.FreeString[tdd.programName];
    {
    x: TeleLoad6.CoreBlock;
    WHILE tdd.program # NIL DO
      x _ tdd.program; tdd.program _ tdd.program.next; z.FREE[@x]; ENDLOOP;
    };
    z.FREE[@tdd];
    };

  Echo: PROC = {NULL; };

  NoEcho: PROC = {NULL; };

  Help: PROC = {
    WF.WF0["BLT "];
    WF.WF0["Close "];
    WF.WF0["Display "];
    WF.WF0["G(store state and go) "];
    WF.WF0["Load "];
    WF.WF0["MemoryTest "];
    WF.WF0["Open "];
    WF.WF0["Parse "];
    WF.WF0["Register (Change register) "];
    WF.WF0["Store "];
    WF.WF0["Quit "];
    WF.WF0["X(fetch state) "];
    WF.WF0["*n"];
    };

  Open: PROC = {
    host: STRING _ [50];
    IF tdd.h # NIL THEN {WF.WF0["Please close connection first.*n"]; RETURN; };
    Echo[];
    WF.WF0["Open connection with: "];
    String.AppendString[to: host, from: "Skylark"];
    IODefs.ReadID[host];
    MCR[];
    tdd.h _ TeleLoad6.Start[host];
    IF tdd.h = NIL THEN WF.WF0["   . . . returns NIL*n"];
    };

  Close: PROC = {
    IF tdd.h = NIL THEN {WF.WF0["Connection not open*n"]; RETURN; };
    WF.WF0["Close connection.*n"];
    TeleLoad6.Stop[tdd.h];
    tdd.h _ NIL;
    };

  Blit: PROC = {
    cb: TeleLoad6.CoreBlock;
    source, destination, highAddr: TeleLoad6.CoreAddress;
    count: CARDINAL;
    IF tdd.h = NIL THEN {WF.WF0["Connection not open*n"]; RETURN; };
    WF.WF0["BLT from (hex) "];
    source _ GetHex[16];
    WF.WF0[" to (hex) "];
    destination _ GetHex[16];
    WF.WF0[" count (hex) "];
    count _ Inline.LowHalf[GetHex[16]];
    cb _ z.NEW[TeleLoad6 .CoreBlockObject[MaxLump]];
    highAddr _ source + count - 1;
    DO
      IF source + MaxLump > highAddr THEN {
        count _ Inline.LowHalf[highAddr - source];
        z.FREE[@cb];
        cb _ z.NEW[TeleLoad6 .CoreBlockObject[count]];
        }
      ELSE count _ MaxLump;
      --Fetch old contents
      cb.address _ source;
      IF NOT TeleLoad6.Fetch[tdd.h, cb].success THEN {
        MCR[];
        WF.WF2["cannot fetch %u bytes from address %04lx*n", count, @source];
        EXIT;
        };
      -- Store old contents
      cb.address _ destination;
      IF NOT TeleLoad6.Store[tdd.h, cb].success THEN {
        MCR[];
        WF.WF2["cannot restore %u bytes at address %04lx*n", count, @destination];
        EXIT;
        };
      WF.WFC['.];
      destination _ destination + MaxLump;
      source _ source + MaxLump;
      IF source > highAddr THEN EXIT;
      ENDLOOP;
    z.FREE[@cb];
    MCR[];
    };

  Fetch: PROC = {
    cb: TeleLoad6.CoreBlock;
    offset: CARDINAL;
    maddr, addr: TeleLoad6.CoreAddress;
    count: CARDINAL;
    res: TeleLoad6.Result;
    WF.WF0["Display data, "];
    IF tdd.h = NIL THEN {WF.WF0["Connection not open*n"]; RETURN; };
    Echo[];
    WF.WF0[" address (hex): "];
    addr _ GetHex[16];
    WF.WF0[" count (decimal): "];
    count _ Inline.LowHalf[GetHex[10]];
    WF.WF1[" (= %xH)*n", count];
    cb _ z.NEW[TeleLoad6 .CoreBlockObject[count]];
    cb.address _ addr;
    res _ TeleLoad6.Fetch[tdd.h, cb];
    IF NOT res.success THEN {WF.WF0["  ... failed*n"]; RETURN; };
    maddr _ addr - (addr MOD 16);  -- round down to nearest multiple of 16
    count _ count + Inline.LowHalf[addr - maddr];
    offset _ 0;
    FOR i: CARDINAL IN [0..count) DO
      IF (i MOD 16) = 0 THEN
        WF.WF1[IF maddr > LAST[CARDINAL] THEN " %08lx" ELSE " %04lx", @maddr];
      IF maddr < addr THEN {WF.WF0["   "]; offset _ offset + 1; }
      ELSE WF.WF1[" %02x", cb.data[i - offset]];
      maddr _ maddr + 1;
      IF (i MOD 16) = 15 THEN WF.WFCR[];
      REPEAT FINISHED => IF (i MOD 16) # 7 THEN WF.WFCR[];
      ENDLOOP;
    z.FREE[@cb];
    };

  Store: PROC = {
    addr: TeleLoad6.CoreAddress;
    count: CARDINAL;
    val: CARDINAL;
    cb: TeleLoad6.CoreBlock;
    res: TeleLoad6.Result;
    WF.WF0["Store data,"];
    IF tdd.h = NIL THEN {WF.WF0["Connection not open*n"]; RETURN; };
    Echo[];
    WF.WF0[" address (hex): "];
    addr _ GetHex[16];
    WF.WF0["    count (decimal): "];
    count _ Inline.LowHalf[GetHex[16]];
    WF.WF1[" (= %04xH)*n", count];
    cb _ z.NEW[TeleLoad6 .CoreBlockObject[count]];
    cb.address _ addr;
    WF.WF1["enter %u hex bytes, >FF to abort.*n", count];
    FOR i: CARDINAL IN [0..count) DO
      val _ Inline.LowHalf[GetHex[16]];
      IF val > 377B THEN {WF.WF0[" XXX*n"]; z.FREE[@cb]; RETURN; };
      cb.data[i] _ Inline.LowByte[val];
      IF i MOD 8 = 7 THEN WF.WF0["*n"];
      ENDLOOP;
    MCR[];
    res _ TeleLoad6.Store[tdd.h, cb];
    IF NOT res.success THEN WF.WF0["  ... failed*n"];
    MCR[];
    z.FREE[@cb];
    };

  GetHex: PROC [radix: CARDINAL] RETURNS [LONG CARDINAL] = {
    r: STRING _ [100];
    IODefs.ReadID[r];
    RETURN[String.StringToLongNumber[r, radix]];
    };

  Parse: PROC = {
    myIStream: IntelHex6.IStream _ [
      endof: myEndOf, get: myGetByte, GetPosition: myGetPosition,
      SetPosition: mySetPosition];

    myOStream: IntelHex6.OStream _ [
      PutEndRecord: myPutEndRecord, PutStartRecord: myPutStartRecord,
      DataByte: myDataByte];

    -- Write an end record.
    myPutEndRecord: IntelHex6.PutEndRecordProc = {
      DataFlush[]; MCR[]; WF.WF0["...End*n"]; };

    -- Write a start record.
    myPutStartRecord: IntelHex6.PutStartRecordProc = {
      DataFlush[];
      MCR[];
      WF.WF2["Start at %04x:%04x*n", frame, bytepos];
      tdd.larkState[CS] _ frame;
      tdd.larkState[IP] _ bytepos;
      tdd.altered _ TRUE;
      };

    myDataByte: IntelHex6.DataByteProc = {
      IF gnaflag OR adr # gda THEN DataFlush[];
      gdata[gptr] _ d;
      IF gptr = 0 THEN fda _ adr;
      gptr _ gptr + 1;
      gda _ adr + 1;
      IF gptr >= TeleLoad6.MaxByte THEN DataFlush[];
      };

    DataFlush: PROC = {
      cb: TeleLoad6.CoreBlock;
      IF gptr = 0 THEN RETURN;
      gnaflag _ FALSE;
      cb _ z.NEW[TeleLoad6 .CoreBlockObject[gptr]];
      IF cb = NIL THEN SIGNAL Failed;
      cb.address _ fda;
      FOR i: CARDINAL IN [0..gptr) DO cb.data[i] _ gdata[i]; ENDLOOP;
      gptr _ 0;
      cb.next _ tdd.program;
      tdd.program _ cb;
      WF.WFC['!];
      };

    gda: LONG CARDINAL _ LAST[LONG CARDINAL];
    fda: LONG CARDINAL;
    gptr: CARDINAL _ 0;
    gdata: PACKED ARRAY [0..TeleLoad6.MaxByte) OF TeleLoad6.Byte;
    gnaflag: BOOLEAN _ TRUE;
    iName: STRING _ Storage.String[50];
    x: TeleLoad6.CoreBlock;

    -- code for Load starts here
    IF tdd.programName # NIL THEN {
      String.AppendString[to: iName, from: tdd.programName];
      Storage.FreeString[tdd.programName];
      };
    WHILE tdd.program # NIL DO
      x _ tdd.program; tdd.program _ tdd.program.next; z.FREE[@x]; ENDLOOP;
    Echo[];
    WF.WF0["Name of .obj file: "];
    IODefs.ReadID[iName];
    FOR i: CARDINAL IN [0..iName.length) DO
      IF iName[i] = '. THEN EXIT;
      REPEAT
      FINISHED => String.AppendString[to: iName, from: ".obj"];
      ENDLOOP;
    MCR[];
    IF iName = NIL THEN {WF.WF0["Bad file name*n"]; RETURN; };
    tdd.programName _ iName;
    tdd.iS _ StreamDefs.NewByteStream[
      name: iName, access: StreamDefs.Read !
      StreamDefs.FileNameError => {
        tdd.iS _ NIL; WF.WF0[" ... file not found*n"]; CONTINUE; }];
    IF tdd.iS = NIL THEN RETURN;
    FOR i: TeleLoad6.Registers8086 IN [AX..FL] DO
      tdd.larkState.Regs[i] _ 0; ENDLOOP;
    tdd.larkState.Regs[SP] _ 100B;
    tdd.altered _ TRUE;
    IF NOT IntelHex6.ProcessFile[
      in: myIStream, out: myOStream, errs: myPutC !
      Failed => {MCR[]; WF.WF0[" ...TeleLoad Error*n"]; CONTINUE; }] THEN {
      MCR[]; WF.WF0[" ...IntelHex Failure*n"]; };
    tdd.iS.destroy[tdd.iS];
    tdd.iS _ NIL;
    };

  Load: PROC = {
    a: TeleLoad6.CoreBlock;
    res: TeleLoad6.Result;
    IF tdd.h = NIL THEN {WF.WF0["Connection not open*n"]; RETURN; };
    IF tdd.program = NIL THEN Parse[];
    WF.WF1["Loading %s: ", tdd.programName];
    a _ tdd.program;
    WHILE a # NIL DO
      res _ TeleLoad6.Store[tdd.h, a];
      IF res.attempts = 1 THEN WF.WFC['!] ELSE WF.WF1["%1d",res.attempts];
      IF NOT res.success THEN {MCR[]; WF.WF0["Teleload Error*n"]; EXIT; };
      a _ a.next;
      ENDLOOP;
    MCR[];
    };

  MemoryTest: PROC = {
    saved, cb: TeleLoad6.CoreBlock;
    lowAddr, highAddr, addr: TeleLoad6.CoreAddress;
    count: CARDINAL;
    TestLump: PROC [testValue: CARDINAL] RETURNS [BOOLEAN] = {
      cb.address _ addr;
      FOR i: CARDINAL IN [0..count) DO cb.data[i] _ testValue; ENDLOOP;
      IF NOT TeleLoad6.Store[tdd.h, cb].success THEN {
        IF NOT TeleLoad6.Fetch[tdd.h, cb].success THEN WF.WF0["contact lost*n"];
        FOR i: CARDINAL IN [0..count) DO
          IF cb.data[i] # testValue THEN {
            ta: TeleLoad6.CoreAddress _ addr + i;
            WF.WF3[
              "loc %4lx is %02x, should be %02x*n", @ta, cb.data[i], testValue];
            EXIT;
            };
          ENDLOOP;
        WF.WF3[
          "test of %d bytes of %02x at address %04lx failed*n", count, testValue,
          @addr];
        RETURN[FALSE];
        };
      RETURN[TRUE];
      };
    WF.WF0["Memory Test, "];
    IF tdd.h = NIL THEN {WF.WF0["Connection not open*n"]; RETURN; };
    Echo[];
    WF.WF0[" low address (hex): "];
    lowAddr _ GetHex[16];
    WF.WF0[" high address (hex): "];
    highAddr _ GetHex[16];
    saved _ z.NEW[TeleLoad6 .CoreBlockObject[MaxLump]];
    cb _ z.NEW[TeleLoad6 .CoreBlockObject[MaxLump]];
    addr _ lowAddr;
    DO
      IF addr + MaxLump > highAddr THEN {
        count _ Inline.LowHalf[highAddr - addr];
        z.FREE[@saved];
        z.FREE[@cb];
        cb _ z.NEW[TeleLoad6.CoreBlockObject[count]];
        saved _ z.NEW[TeleLoad6.CoreBlockObject[count]];
        }
      ELSE count _ MaxLump;
      --Fetch old contents
      saved.address _ addr;
      IF NOT TeleLoad6.Fetch[tdd.h, saved].success THEN {
        WF.WF2["cannot fetch %d bytes from address %04lx*n", count, @addr];
        EXIT;
        };
      IF NOT TestLump[0377B] THEN EXIT;
      IF NOT TestLump[0B] THEN EXIT;
      IF NOT TestLump[0252B] THEN EXIT;
      IF NOT TestLump[0125B] THEN EXIT;
      -- Store old contents
      IF NOT TeleLoad6.Store[tdd.h, saved].success THEN {
        WF.WF2["cannot restore %d bytes at address %04lx*n", count, @addr];
        EXIT;
        };
      addr _ addr + MaxLump;
      IF addr > highAddr THEN EXIT;
      ENDLOOP;
    z.FREE[@saved];
    z.FREE[@cb];
    MCR[];
    };

  RegNames: ARRAY TeleLoad6.Registers8086 OF STRING = [
    "AX", "BX", "CX", "DX", "SP", "BP", "SI", "DI", "CS", "DS", "SS", "ES", "IP",
    "FL"];

  GetState: PROC = {
    cb: TeleLoad6.CoreBlock;
    ok: BOOLEAN;
    pp: TeleLoad6.State8086;
    size: CARDINAL = SIZE[TeleLoad6.State8086Object]*2;
    WF.WF0["GetState*n"];
    IF NOT tdd.altered THEN {
      IF tdd.h = NIL THEN {WF.WF0["Connection not open*n"]; RETURN; };
      cb _ z.NEW[TeleLoad6 .CoreBlockObject[size]];
      cb.address _ 1;
      ok _ TeleLoad6.FetchState[tdd.h, cb].success;
      IF NOT ok THEN {WF.WF0["  ... failed*n"]; z.FREE[@cb]; RETURN; };
      pp _ LOOPHOLE[@cb.data, TeleLoad6.State8086];
      FOR i: TeleLoad6.Registers8086 IN [AX..FL] DO
        pp.Regs[i] _ Swab[pp.Regs[i]]; ENDLOOP;
      tdd.larkState _ pp^;
      pp _ NIL;
      };
    FOR i: TeleLoad6.Registers8086 IN [AX..SI] DO
      PutReg[i, tdd.larkState.Regs[i]]; ENDLOOP;
    WF.WFCR[];
    FOR i: TeleLoad6.Registers8086 IN [DI..FL] DO
      PutReg[i, tdd.larkState.Regs[i]]; ENDLOOP;
    WF.WFCR[];
    z.FREE[@cb];
    };

  SetState: PROC = {
    cb: TeleLoad6.CoreBlock;
    ok: BOOLEAN;
    pp: TeleLoad6.State8086;
    size: CARDINAL = SIZE[TeleLoad6.State8086Object]*2;
    WF.WF0["GO!*n"];
    IF tdd.h = NIL THEN {WF.WF0["Connection not open*n"]; RETURN; };
    cb _ z.NEW[TeleLoad6 .CoreBlockObject[size]];
    cb.address _ 1;
    pp _ LOOPHOLE[BASE[DESCRIPTOR[cb.data]], TeleLoad6.State8086];
    pp^ _ tdd.larkState;
    FOR i: TeleLoad6.Registers8086 IN [AX..FL] DO
      pp.Regs[i] _ Swab[pp.Regs[i]]; ENDLOOP;
    pp _ NIL;
    ok _ TeleLoad6.StoreState[tdd.h, cb].success;
    IF NOT ok THEN WF.WF0["  ... failed*n"];
    z.FREE[@cb];
    };

  PutReg: PROC [i: TeleLoad6.Registers8086, v: CARDINAL] = {
    WF.WF2[" %2s=%04x", RegNames[i], v]; };

  AlterRegister: PROC = {
    i: TeleLoad6.Registers8086;
    r: STRING _ [50];
    Echo[];
    WF.WF0["Change register: "];
    IODefs.ReadID[r];
    SELECT TRUE FROM
      String.EquivalentString[s1: r, s2: "0"] => {
        FOR i: TeleLoad6.Registers8086 IN [AX..FL] DO
          tdd.larkState.Regs[i] _ 0; ENDLOOP;
        tdd.larkState.Regs[SP] _ 100B;
        tdd.altered _ TRUE;
        RETURN;
        };
      String.EquivalentString[s1: r, s2: "r"] => {tdd.altered _ FALSE; RETURN; };
      ENDCASE;
    FOR i IN TeleLoad6.Registers8086 DO
      IF String.EquivalentString[s1: r, s2: RegNames[i]] THEN EXIT;
      REPEAT
        FINISHED => {
          WF.WF0[
            " ... unknown register*nRegisters are 0 (clear), r (reset), plus 8086 registers.*n"];
          RETURN;
          };
      ENDLOOP;
    WF.WF1[" value for register %s (hex): ", RegNames[i]];
    tdd.larkState[i] _ Inline.LowHalf[GetHex[16]];
    WF.WF2[" new value %s: %04x*n", RegNames[i], tdd.larkState[i]];
    tdd.altered _ TRUE;
    };

  Swab: PROC [a: CARDINAL] RETURNS [b: CARDINAL] = {
    b _ Inline.BITSHIFT[Inline.LowByte[a], 8] + Inline.HighByte[a]; };

  -- Main program

  [] _ PupDefs.GetPupPackageUseCount[];
  PupRouterDefs.numberOfNetworks _ 255;
  Main[];
  }.
July 27, 1982  5:54 PM, L. Stewart, MDSZone
September 7, 1982  10:41 PM, L. Stewart, added attempt counters