head     56.3;
access   paws bayes jws quist brad dew jwh;
symbols  ;
locks    ; strict;
comment  @# @;


56.3
date     93.01.27.13.37.40;  author jwh;  state Exp;
branches ;
next     56.2;

56.2
date     93.01.27.12.13.07;  author jwh;  state Exp;
branches ;
next     56.1;

56.1
date     91.11.05.09.43.20;  author jwh;  state Exp;
branches ;
next     55.1;

55.1
date     91.08.25.10.21.30;  author jwh;  state Exp;
branches ;
next     54.1;

54.1
date     91.03.18.15.25.40;  author jwh;  state Exp;
branches ;
next     53.1;

53.1
date     91.03.11.19.26.50;  author jwh;  state Exp;
branches ;
next     52.1;

52.1
date     91.02.19.09.10.49;  author jwh;  state Exp;
branches ;
next     51.1;

51.1
date     91.01.30.16.10.23;  author jwh;  state Exp;
branches ;
next     50.1;

50.1
date     90.10.29.16.25.13;  author jwh;  state Exp;
branches ;
next     49.1;

49.1
date     90.08.14.14.09.32;  author jwh;  state Exp;
branches ;
next     48.1;

48.1
date     90.07.26.11.15.35;  author jwh;  state Exp;
branches ;
next     47.1;

47.1
date     90.05.14.10.57.28;  author dew;  state Exp;
branches ;
next     46.1;

46.1
date     90.05.07.08.44.37;  author jwh;  state Exp;
branches ;
next     45.1;

45.1
date     90.04.19.15.52.17;  author jwh;  state Exp;
branches ;
next     44.1;

44.1
date     90.04.01.22.09.40;  author jwh;  state Exp;
branches ;
next     43.1;

43.1
date     90.03.20.14.01.05;  author jwh;  state Exp;
branches ;
next     42.1;

42.1
date     90.01.23.17.45.44;  author jwh;  state Exp;
branches ;
next     41.1;

41.1
date     89.12.22.11.28.29;  author jwh;  state Exp;
branches ;
next     40.1;

40.1
date     89.09.29.11.50.30;  author jwh;  state Exp;
branches ;
next     39.1;

39.1
date     89.09.26.16.34.51;  author dew;  state Exp;
branches ;
next     38.1;

38.1
date     89.08.29.11.26.32;  author jwh;  state Exp;
branches ;
next     37.1;

37.1
date     89.05.12.11.39.03;  author dew;  state Exp;
branches ;
next     36.1;

36.1
date     89.02.06.10.17.34;  author dew;  state Exp;
branches ;
next     35.1;

35.1
date     89.02.02.13.31.38;  author dew;  state Exp;
branches ;
next     34.1;

34.1
date     89.01.23.16.06.50;  author jwh;  state Exp;
branches ;
next     33.1;

33.1
date     89.01.16.11.39.32;  author dew;  state Exp;
branches ;
next     32.1;

32.1
date     89.01.10.11.47.21;  author bayes;  state Exp;
branches ;
next     31.1;

31.1
date     88.12.14.18.08.36;  author bayes;  state Exp;
branches ;
next     30.1;

30.1
date     88.12.09.13.45.52;  author dew;  state Exp;
branches ;
next     29.2;

29.2
date     88.12.06.15.12.14;  author dew;  state Exp;
branches ;
next     29.1;

29.1
date     88.10.31.15.30.32;  author bayes;  state Exp;
branches ;
next     28.1;

28.1
date     88.10.06.10.58.08;  author dew;  state Exp;
branches 28.1.1.1;
next     27.1;

27.1
date     88.09.29.11.29.30;  author bayes;  state Exp;
branches ;
next     26.1;

26.1
date     88.09.28.13.10.41;  author bayes;  state Exp;
branches ;
next     25.1;

25.1
date     88.03.02.09.27.02;  author bayes;  state Exp;
branches ;
next     24.1;

24.1
date     87.08.31.09.46.22;  author jws;  state Exp;
branches ;
next     23.1;

23.1
date     87.08.26.10.23.24;  author bayes;  state Exp;
branches ;
next     22.1;

22.1
date     87.08.17.11.08.47;  author bayes;  state Exp;
branches ;
next     21.1;

21.1
date     87.08.12.13.51.53;  author bayes;  state Exp;
branches ;
next     20.1;

20.1
date     87.07.30.11.05.17;  author bayes;  state Exp;
branches ;
next     19.1;

19.1
date     87.06.01.08.21.01;  author jws;  state Exp;
branches ;
next     18.1;

18.1
date     87.05.20.15.17.21;  author bayes;  state Exp;
branches ;
next     17.1;

17.1
date     87.04.30.10.31.43;  author jws;  state Exp;
branches ;
next     16.1;

16.1
date     87.04.26.15.44.21;  author jws;  state Exp;
branches ;
next     15.1;

15.1
date     87.04.13.09.18.27;  author jws;  state Exp;
branches ;
next     14.1;

14.1
date     87.04.01.15.22.21;  author jws;  state Exp;
branches ;
next     13.1;

13.1
date     87.02.28.18.30.00;  author jws;  state Exp;
branches ;
next     12.1;

12.1
date     87.02.02.13.20.26;  author jws;  state Exp;
branches ;
next     11.1;

11.1
date     87.01.19.09.46.35;  author jws;  state Exp;
branches ;
next     10.1;

10.1
date     86.12.24.10.54.16;  author jws;  state Exp;
branches ;
next     9.1;

9.1
date     86.12.12.14.34.05;  author bayes;  state Exp;
branches ;
next     8.1;

8.1
date     86.11.27.11.52.01;  author jws;  state Exp;
branches ;
next     7.1;

7.1
date     86.11.20.13.41.53;  author hal;  state Exp;
branches ;
next     6.1;

6.1
date     86.11.04.17.53.34;  author paws;  state Exp;
branches ;
next     5.1;

5.1
date     86.10.28.16.42.37;  author hal;  state Exp;
branches ;
next     4.1;

4.1
date     86.09.30.19.43.10;  author hal;  state Exp;
branches ;
next     3.1;

3.1
date     86.09.01.11.54.06;  author hal;  state Exp;
branches ;
next     2.1;

2.1
date     86.07.30.14.40.05;  author hal;  state Exp;
branches ;
next     1.1;

1.1
date     86.06.30.14.52.18;  author danm;  state tmp;
branches ;
next     ;

28.1.1.1
date     88.10.21.14.13.07;  author dew;  state Exp;
branches ;
next     ;


desc
@Base file for PWS 3.2 release.

@


56.3
log
@
pws2rcs automatic delta on Wed Jan 27 13:14:25 MST 1993
@
text
@					       (*

 (c) Copyright Hewlett-Packard Company, 1985.
All rights are reserved.  Copying or other
reproduction of this program except for archival
purposes is prohibited without the prior
written consent of Hewlett-Packard Company.


	    RESTRICTED RIGHTS LEGEND

Use, duplication, or disclosure by the Government
is subject to restrictions as set forth in
paragraph (b) (3) (B) of the Rights in Technical
Data and Computer Software clause in
DAR 7-104.9(a).

HEWLETT-PACKARD COMPANY
Fort Collins, Colorado                         *)

$SYSPROG$
$RANGE OFF, STACKCHECK OFF, OVFLCHECK OFF$
$DEBUG OFF$
$ALLOW_PACKED ON$

program installdebugger;

$COPYRIGHT '(C) 1985 HEWLETT-PACKARD CO. 3.0'$
module sysbug;
{ this module is used by the debugger when it needs
  to call system resident code
}
IMPORT SYSGLOBALS, LOADER, SYSDEVS, ASM;
export
  procedure callsyscode(i : integer);
implement
  type
    menu1 = array[boolean] of menutype;
    menu2 = array[m_none..m_sysshift] of menu1;
  const
    mstates = menu2[
		{ no menu } menu1[m_sysnorm,m_sysshift],
		{ normal  } menu1[m_none,m_sysshift],
		{ shifted } menu1[m_sysnorm,m_none]];
    inmaxsize = 80;
    imsize    = 88;
  type
    realp = ^real;
    str80p= ^string80;
    dword = 0..65535;
    jvector = packed array[1..6] of char;       { jump vector }
    KRECORD = PACKED RECORD
		VTYPE : BYTE;
		SIZE  : BYTE;
		VALUE : INTEGER;
	      END;
    LLREC   = PACKED ARRAY[0..1] OF DWORD;
{****************************************************************************}
{** DO NOT CHANGE THIS RECORD WITHOUT CHANGEING THE DEBUGGER ASSEMBLY CODE **}
{** SEE ALSO MODULE POWERUP                                                **}
{****************************************************************************}
{ ERROR RECORDS }
  TYPE20       = PACKED RECORD
		   CASE INTEGER OF
		   0010:(ERR_PC : INTEGER);
		   1001:(ERR_PC1: INTEGER;
			 ERR_WRDS:INTEGER;
			 ERR_EA : INTEGER);
		   1010:(BE_SSW_10 : INTEGER;   {SHORT BUS ERROR}
			 BE_IPSC_10: DWORD;
			 BE_IPSB_10: DWORD;
			 BE_PAD_10 : INTEGER;
			 BE_FAULT_10:INTEGER;   {FAULT ADDRESS}
			 BE_DATA_10: INTEGER;   { DATA IN/OUT }
			 BE_PAD2_10: INTEGER);
		   1011:(BE_SSW_11 : INTEGER;{LONG BUS ERROR}
			 BE_IPSC_11: DWORD;
			 BE_IPSB_11: DWORD;
			 BE_PAD_11 : INTEGER;
			 BE_FAULT_11:INTEGER;   {FAULT ADDRESS}
			 BE_DATAOUT: INTEGER;
			 BE_PAD6   : PACKED ARRAY[1..16] OF CHAR;
			 BE_DATAI_11 : INTEGER;
			 BE_MISC20   : PACKED ARRAY[1..44] OF CHAR)
		 END;
  ERRORINFOREC = PACKED RECORD
		   CASE INTEGER OF
		   68000:(BE_SSW_00     : DWORD;
			  BE_FAULT_ADDR : INTEGER;
			  BE_INSTR      : DWORD);
		   68010:(BE_SSW_10     : DWORD;
			  BE_FAULT_ADDR10:INTEGER;
			  BE_PAD1_10    : DWORD;
			  BE_DATAO_10   : DWORD;
			  BE_PAD2_10    : DWORD;
			  BE_DATAI_10   : DWORD;
			  BE_PAD3_10    : DWORD;
			  BE_INSTR_10   : DWORD;
			  BE_MISC_10    : PACKED ARRAY[1..32] OF CHAR);
		   68020:(M68020:TYPE20)
		 END;
  DEBUGCOMTYPE = PACKED RECORD
		 ERRINFO  : ERRORINFOREC;
		 EXCP_STATUS  : DWORD;
		 EXCP_PC      : INTEGER;
		 EXCP_VOFFSET : DWORD;
		 EXCP_LINE    : INTEGER;
		 LASTLINE     : ^LLREC;

		 ESCAPEV      : JVECTOR;
		 PCTEMP       : INTEGER;
		 SRTEMP       : DWORD;
		 INITSTACK    : INTEGER;
		 INITPC       : INTEGER;
		 INITRECOVER  : INTEGER;
		 G_DOLLAR     : INTEGER;
		 CTL_RESETV   : JVECTOR;
		 DEBUGESCAPE  : JVECTOR;
		 BESPTEMP     : INTEGER;
		 AONOFF       : BYTE;
		 GONOFF       : BYTE;
		 GRAPHICSBASE : INTEGER;
		 INITSR       : DWORD;
		 M68KTYPE     : BYTE;
		 MSYSFLAGS    : BYTE;
		 FLTPTHDW     : BYTE;
		 FILLER       : BYTE;

		 SAVEBUS      : JVECTOR;
		 SAVEESC      : JVECTOR;

		 CTRL_FLAGS   : PACKED ARRAY[1..4] OF CHAR;

		 QSTART       : INTEGER;
		 QEND         : INTEGER;
		 QLAST        : INTEGER;

		 TCOUNT       : INTEGER;
		 OLDA6        : INTEGER;
		 SFA6         : INTEGER;

		 IMFIRST      : INTEGER;
		 IMLAST       : INTEGER;

		 KDATAP       : INTEGER;  { K0..K9 DATA AREA POINTER }
		 KVECTOR      : ARRAY[0..9] OF KRECORD;

		 REGPC        : INTEGER;
		 REGSR        : DWORD;
		 REGUS        : INTEGER;  { USER STACK POINTER }
		 DREGS        : ARRAY[0..7] OF INTEGER;
		 AREGS        : ARRAY[0..7] OF INTEGER;
		 { CRT STUFF }
		 CRTOPCODE    : BYTE;
		 CRTCHAR      : CHAR;
		 CRTPADDING1  : BYTE;
		 CRTPROMPTSIZE: BYTE;
		 CRTPROMPT    : PACKED ARRAY[1..4] OF CHAR;
		 CRTPADDING2  : INTEGER;
		 LASTLINEOP   : BYTE;
		 STAT0CHAR    : CHAR;
		 CRTPADDING3  : DWORD;
		 { KEYBOARD STUFF }
		 KBDSTATREG   : BYTE;
		 KBDCHAR      : CHAR;
		 KBDDUMMY     : CHAR;   { NOT USED }
		 KBDTRANSCODE : BYTE;   { 0 = ALPHA, 1= SPECIAL,3= NON_ADV }
		 { OTHER STUFF }
		 UEXCPI       : INTEGER; { ERROR TRAP IMPLANT ADDR }
		 SYMBOLHOOK   : JVECTOR; { HOOK INTO SYMBOL LOOKUP }
		 ACCUMV       : KRECORD;
		 DATAV        : KRECORD;
		 BASE         : DWORD;
		 SSIZE        : INTEGER;
		 RCOUNT       : INTEGER;
		 ETCODES      : ARRAY[0..1] OF INTEGER;
		 NUMET        : BYTE;
		 SCODE        : BYTE;
		 DSCODE       : BYTE;
		 TEMPD        : CHAR;   { DEBUG CI RUNLIGHT }
		 TEMPR        : CHAR;   { TEMP RUNLIGHT }
		 OUTFLAGS     : BYTE;
		 LINECOUNT    : DWORD;
		 RECALLV      : STR80P;
		 TEMPS        : ARRAY[1..4] OF INTEGER;
		 SAVEHOOK     : JVECTOR;
		 INSTACK      : ARRAY[1..4] OF INTEGER;
		 OPSTACK      : ARRAY[1..12] OF INTEGER;
		 INBUF        : STRING80;
	       END;
  VAR
    OUTS     : STR80P;
    DEBUGCRT : ^DBCINFO;
    DERR_INFO['ERR_INFO'] : INTEGER;
    DEBUGCOM : ^DEBUGCOMTYPE;

  function value(symbol: string255): integer;
  var
    modp: moddescptr;
    ptr, valueptr: addrec;
    found: boolean;
  begin {value}
    value := 0;
    found := false;
    modp := sysdefs;
    while (modp<>nil) and not found do
      with modp^ do
	begin
	  ptr := defaddr;
	  while (ptr.a<defaddr.a+defsize) and not found do
	    begin
	      found := ptr.syp^=symbol;
	      ptr.a := ptr.a+strlen(ptr.syp^)+1;
	      ptr.a := ptr.a+ord(odd(ptr.a));
	      valueptr.a := ptr.a+2;
	      if found then value := valueptr.vep^.value;
	      ptr.a := ptr.a+ptr.gvp^.short;
	    end; {while}
	  modp := link;
	end; {with modp^}
  end; {value}

  PROCEDURE UNITTOMSUS;
  {
	UNITTOMSUS DETERMINES THE MSUS THAT APPLIES TO THE
	GIVEN FILE SYSTEM UNIT NUMBER.  ON INPUT, THE UNIT NUMBER
	IS REQUIRED AND ON OUTPUT THE MSUS AND RESULT CODE
	ARE RETURNED.

	INPUT:  UNIT NUMBER IS IN TEMPL.
	OUTPUT: MSUS IS IN TEMPL2.
		RESULT CODE IS IN TEMPL3.

	RESULT CODE CONTENTS ARE:

		0 = OK RETURN
		1 = COULDN'T MAKE A DEFINITE CONVERSION.
		    MSUS IS INVALID.
  }
      TYPE
	msus_type = packed record
		      case integer of
		      1:(df       : 0..7;         { directory format }
			 dt       : 0..31;        { device type }
			 unum     : byte;         { unit number }
			 scode    : byte;         { select code }
			 baddr    : byte);        { bus address }
		      2:(pad1     : byte;
			 vol      : 0..15;    { volume number }
			 un       : 0..15);   { unit number }
		      3:(bytes    : packed array [1..4] of char);
		    end;

      PROCEDURE FSUNIT_MSUS(FSUNIT : unitnum; ANYVAR MSUS : msus_type);
	VAR
	  f : fib;
	BEGIN
	  if (fsunit<0) or (fsunit>maxunit) then escape(2);
	  with unitable^[fsunit] do
	  begin
	    msus.df    := 0;
	    msus.scode := sc;
	    msus.baddr := ba;
	    msus.unum  := du;
	    case letter of
	      'B':begin { BUBBLE }
		    msus.dt := 22;
		  end;
	      'E':begin { EPROM }
		    msus.dt := 20;
		    msus.unum := dv;
		  { bootrom uses unit, table uses volume }
		  end;
	      'F':begin { 9885 }
		    msus.dt := 6;
		  end;
	      'G':begin { SRM }
		    msus.df := 7; msus.dt := 1;
		  end;
	      'H':begin { 9895 }
		    msus.dt := 4;
		  end;
	      'J',{ PRINTER }
	      'R':{ RAM }
		  escape(2);
	      'M':begin { internal mini }
		    msus.dt := 0;
		  end;
	      'N':begin { 8290X }
		    msus.dt := 5;
		  end;
	      'Q':begin { C280 }
		    msus.vol := dv; msus.un := du;
		    if intlevel > 2 then escape(2);
		    call(dam, uvid, fsunit, getvolumename);
		    if (ioresult <> ord(inoerror)) or (strlen(uvid) = 0)
		       or (dvrtemp2 < 8)
		      then escape(2)
		    else
		    if dvrtemp2=8 then msus.dt := 16
				  else msus.dt := 17;
		  end;
	      'S':begin { SCSI }
		    msus.dt := 14;
		  end;
	      'U':begin { 913X_A }
		    msus.dt := 7;
		  end;
	      'V':begin { 913X_B }
		    msus.dt := 8;
		  end;
	      'W':begin { 913X_C }
		    msus.dt := 9;
		  end;
	      otherwise
		escape(2);
	    end; { case }
	  end;
	END; { FSUNIT_MSUS }

  BEGIN
    WITH DEBUGCOM^ DO
    BEGIN
      TRY
	TEMPS[3] := 0;
	FSUNIT_MSUS(TEMPS[1],TEMPS[2]);
      RECOVER
	TEMPS[3] := 1;
    END;
  END;

  { DUMMY REVASM }
  PROCEDURE DUMREVASM(ANYVAR INSP: INTEGER; ANYVAR SP:STR80P;
		      ANYVAR FTYPE:INTEGER);
  TYPE
    REVPROC = PROCEDURE (ANYVAR INSP: INTEGER; VAR S:STRING;
			 ANYVAR NXTP,FTYPE:INTEGER);
    PREC = RECORD
	     CASE BOOLEAN OF
	     TRUE :(RPROC : REVPROC);
	     FALSE:(I2 : PACKED ARRAY[1..2] OF INTEGER);
	   END;
  VAR
    TPROC:PREC;
    NXTP : INTEGER;
  BEGIN
    SP:= OUTS;
    TPROC.I2[1]:=VALUE('REVASM_MOD_REVASM');    { TRY TO FIND THE REAL REVASM }
    IF TPROC.I2[1]=0 THEN
    BEGIN SETSTRLEN(SP^,0); NXTP:=INSP; END     { SIGNAL NO DECODE }
    ELSE
    BEGIN
      TPROC.I2[2]:=0;   { CLEAR STATIC LINK }
      CALL(TPROC.RPROC,INSP,SP^,NXTP,FTYPE);    { CALL THE REVERSE ASSEMBLER }
      INSP:=NXTP;                               { OLD POINTER BECOMES NEW }
    END;
  END;

  PROCEDURE REALTOSTRING(ANYVAR RP:REALP; ANYVAR SP:STR80P);
  TYPE
    RSPROC = PROCEDURE(VAR R:STRING; VAR P2:INTEGER;X :REAL; W,D:SHORTINT);
    PREC = RECORD
	     CASE BOOLEAN OF
	     TRUE :(REALPR : RSPROC);
	     FALSE:(I2 : PACKED ARRAY[1..2] OF INTEGER);
	   END;
  VAR
    I : INTEGER;
    RPROC : PREC;
  BEGIN
    SP:= OUTS;
    RPROC.I2[1]:=VALUE('MFS_FWRITESTRREAL');    { FIND THE ROUTINE }
    IF RPROC.I2[1]=0 THEN SP^ :='no R formatter'
    ELSE
    BEGIN
      TRY
	RPROC.I2[2]:=0;         { CLEAR STATIC LINK }
	SETSTRLEN(SP^,0);       { CLEAR THE STRING }
	I:=1;           { SET START POSITION }
	CALL(RPROC.REALPR,SP^,I,RP^,-1,-1); { CALL THE ROUTINE }
      RECOVER
	SP^ := 'not real';
    END;
  END;

  procedure readkey;
  var
    oldkbdisr : kbdhooktype;
    oldrpgisr : kbdhooktype;
    alldone   : boolean;
    oldcaps   : boolean;
    oldnonchar: char;

    procedure debugrpg(var kbdstatus, kbddata: byte;
			 var dokey: boolean);
    var key: char;
    begin
      if dokey then
      with debugcom^ do
      begin
	kbdstatreg:= kbdstatus;
	kbdtranscode:= 1;       { special }
	alldone:= true;
	case  not odd(kbdstatus div 16) of
	  true: {shifted} { down arrow, up arrow }
	      if kbddata >= 128 then kbdchar:= #34 else kbdchar:= #35;
	  false: {unshifted}{ right arrow, left arrow }
	      if kbddata >= 128 then kbdchar:= #39 else kbdchar:= #38;
	end;
      end;
    end; { rpghandler }

    procedure debugkeys(var kbdstatus, kbddata: byte;
			var dokey: boolean);
    var
      i : integer;
      c : char;
    begin   { debugkeys }
      if dokey then
      with langcom do
	begin
	status  := kbdstatus;
	data    := kbddata;
	extension:= not odd(kbdstatus div 8);
	shift   := not odd(kbdstatus div 16);
	control := not odd(kbdstatus div 32);
	call(langtable[langindex]^.semantics);
	debugcom^.kbdstatreg:= status;
	debugcom^.kbdtranscode:= 0;     { 3.0 BUG FIX }
	alldone := true;
	CASE result OF
	nonadv_key, { have non advancing key }
	alpha_key,
	NONA_ALPHA_KEY  {3.1 BUGFIX SFB--5/30/85} :
	  begin
	    debugcom^.kbdchar:= key;
	    if (result=nonadv_key) OR   {3.1 BUGFIX SFB--5/30/85}
	      ((RESULT = NONA_ALPHA_KEY) AND NOT SHIFT) then
	    begin keybuffer^.non_char:= key; alldone:=false; end;
	  end;
	special_key: { have special function key }
	  begin
	    case data of        { fix itf keycodes }
	    5: data:=56;        { break=>pause }
	    6: data:=55;        { stop }
	    7: data:=59;        { select=>execute}
	    8: data:=57;        { np enter=>enter}
	    17: { enter/print }
	       if shift and control then { dump graphics }
	       begin data:=50; debugcom^.kbdstatreg:=175; end
	       else
		 if shift then data:=49 { dump alpha }
			  else data:=57; { enter }
	    20:begin {system/user}
		 if shift then key:='U' else key:='S';
		 kbdsysmode:=not shift;
		 setstatus(6,key);
		 if key='U' then
		   if (menustate=m_sysnorm) or (menustate=m_sysshift) then
		   begin
		     menustate:=m_none;
		     keybuffer^.echo:=true;
		     keybufops(kdisplay,c);
		   end;
		 alldone:=false;
	       end;
	    21:begin {menu}
		 alldone := false;
		 if kbdsysmode and not control then
		 begin
		   call(crtllhook,cllclear,i,c);
		   if menustate<=m_sysshift
		   then menustate:=mstates[menustate,shift]
		   else menustate:=m_none;

		   keybuffer^.echo:=(menustate=m_none);
		   case menustate of
		     m_none    : keybufops(kdisplay,c);
		     m_sysnorm : call(crtllhook,clldisplay,sysmenu^,c);
		     m_sysshift: call(crtllhook,clldisplay,sysmenushift^,c);
		     otherwise
		   end;
		 end;
	       end;

	    22:begin data:=52; debugcom^.kbdstatreg:=191; end;  { clr line }
	    23:begin data:=52; debugcom^.kbdstatreg:=175; end;  { clr screen }
	    otherwise
	    end; { case data }
	    debugcom^.kbdchar:= chr(data);
	    debugcom^.kbdtranscode:= 1; { special }
	  end;
	ignored_key: alldone:=false;
	OTHERWISE {TO MAKE ISR MORE ROBUST- THE "BITBUCKET". SFB--5/30/85}
	end;

      end;  { with langcom }
    end;    { debugkeys }

  begin { readkey }
    alldone:= false;
    with langtable[langindex]^ do
    begin
      oldcaps:= kbdcapslock; kbdcapslock:= true;  { force capslock }
      oldkbdisr:= kbdisrhook; kbdisrhook:= debugkeys;
      oldrpgisr:= rpgisrhook; rpgisrhook:= debugrpg;
      oldnonchar:= keybuffer^.non_char; keybuffer^.non_char:= ' ';

      repeat call(kbdpollhook,true) until alldone;

      kbdcapslock:= oldcaps;
    end;
    kbdisrhook:= oldkbdisr; rpgisrhook:= oldrpgisr;
    keybuffer^.non_char:= oldnonchar;
  end; { readkey }

  procedure dolastlineop;
  var
    tempc : char;
    i     : integer;
  begin
    with debugcom^ do
    case lastlineop of
    0: begin tempc:= runlight; setrunlight(tempr); tempr:= tempc; end;
    1: setrunlight(tempr);
    2: begin tempd:= runlight; setrunlight('d'); end;
    3: begin for i:=1 to 5 do setstatus(i,' '); setrunlight(tempd); end;
    4: for i:=0 to 5 do setstatus(i,' ');       { clear status line }
    5: setstatus(0,stat0char);
    6: begin    { display last line }
	 setstrlen(inbuf,0); strwrite(inbuf,1,i,lastline^[1]:5);
	 setstatus(0,' ');
	 for i:=1 to 5 do setstatus(i,inbuf[i]);
       end;
    otherwise
    end;
  end;{ dolastlineop }

  procedure docrtops;
  var i : integer;
    procedure putcursor;
    begin
      with debugcrt^ do
      begin
	if cursx>xmax then
	begin cursx:=xmin; cursy:=cursy+1; end;
	if cursy>ymax then
	begin
	  cursy:=ymax; call(dbcrthook,dbscrollup,debugcrt^);
	end;
	call(dbcrthook,dbgotoxy,debugcrt^);
      end;
    end; { putcursor }
  begin
    with debugcom^, debugcrt^ do
    if savesize>0 then
    case crtopcode of
    0: call(dbcrthook,dbexcg,debugcrt^);        { exchange display }
    1: begin    { putchr & advance cursor }
	 c:=crtchar; call(dbcrthook,dbput,debugcrt^);
	 cursx:=cursx+1; putcursor;
       end;
    2: begin    { write prompt }
	 for i:=1 to crtpromptsize do
	 begin
	   c:=crtprompt[i]; call(dbcrthook,dbput,debugcrt^);
	   cursx:=cursx+1; putcursor;
	 end;
       end;
    3: begin cursx:=xmin; cursy:=cursy+1; putcursor; end;
    4: call(dbcrthook,dbinit,debugcrt^);
    5: begin    { clear crt & homecursor }
	 call(dbcrthook,dbclear,debugcrt^);
	 cursx:=xmin; cursy:=ymin; putcursor;
       end;
    6: call(dbcrthook,dbcline,debugcrt^);       { clear to end of line }
    7: begin cursx:=xmin; putcursor; end;
    8: begin cursx:=cursx-1; putcursor; end;
    9: begin cursx:=cursx+1; putcursor; end;
    otherwise
    end;
  end;  { docrtops }

  PROCEDURE DOINIT;
  VAR DONE: BOOLEAN;
  BEGIN    { initialize }
    IF OUTS=NIL THEN NEW(OUTS);
    DEBUGCOM := ADDR(DERR_INFO);
    { allocate debugger crt window }
    NEW(DEBUGCRT);
    WITH DEBUGCRT^ DO
    BEGIN
      XMIN:=0; YMIN:=0;
      XMAX:=SYSCOM^.CRTINFO.WIDTH-1;
      YMAX:=SYSCOM^.CRTINFO.HEIGHT-1;
      SAVESIZE:=-1;
      CALL(DBCRTHOOK,DBINFO,DEBUGCRT^);
      DONE:= SAVESIZE<=0;
      WHILE NOT DONE DO { ALLOCATE SPACE TO SWAP WINDOW }
      BEGIN
	IF SAVESIZE<4000 THEN DONE:=TRUE
	ELSE
	IF (XMAX-XMIN)>50 THEN XMIN:=XMAX-49
	ELSE
	IF (YMAX-YMIN)>24 THEN YMIN:=YMAX-22
	ELSE DONE:=TRUE;

	IF DONE THEN
	BEGIN
	  NEWBYTES(SAVEAREA,SAVESIZE);
	  CALL(DBCRTHOOK,DBINIT,DEBUGCRT^);
	END
	ELSE CALL(DBCRTHOOK,DBINFO,DEBUGCRT^);
      END;      { WHILE }
    END;        { WITH }
  END;  { DOINIT }

  procedure callsyscode(i : integer);
  begin
    case i of
    -1: DOINIT;
    0 : DOCRTOPS;
    1 : call(togglegraphicshook);
    2 : call(dumpalphahook);
    3 : call(dumpgraphicshook);
    4 : WITH DEBUGCOM^ DO REALTOSTRING(TEMPS[1],TEMPS[2]);
    5 : WITH DEBUGCOM^ DO DUMREVASM(TEMPS[1],TEMPS[2],TEMPS[3]);
    6 : BEEP;
    7 : READKEY;
    8 : call(togglealphahook);
    9 : dolastlineop;
    10: UNITTOMSUS;
    otherwise
    end; { case }
  end;  { callsyscode }
end;    { module sysbug }

import sysglobals,loader,sysbug;

procedure realdebugger(p1,p2,p3: integer); external;
{****** PROGRAM INSTALLDEBUGGER **************}
begin
  callsyscode(-1);              { initialize sysbug }
  if realdebugger<>debugger then
  begin
    debugger:=realdebugger;
    realdebugger(0,0,0);        { initialize debugger }
    markuser;
  end;
end.


@


56.2
log
@
pws2rcs automatic delta on Wed Jan 27 11:57:27 MST 1993
@
text
@d1 652
@


56.1
log
@Automatic bump of revision number for PWS version 3.25
@
text
@a0 652
					       (*

 (c) Copyright Hewlett-Packard Company, 1985.
All rights are reserved.  Copying or other
reproduction of this program except for archival
purposes is prohibited without the prior
written consent of Hewlett-Packard Company.


	    RESTRICTED RIGHTS LEGEND

Use, duplication, or disclosure by the Government
is subject to restrictions as set forth in
paragraph (b) (3) (B) of the Rights in Technical
Data and Computer Software clause in
DAR 7-104.9(a).

HEWLETT-PACKARD COMPANY
Fort Collins, Colorado                         *)

$SYSPROG$
$RANGE OFF, STACKCHECK OFF, OVFLCHECK OFF$
$DEBUG OFF$
$ALLOW_PACKED ON$

program installdebugger;

$COPYRIGHT '(C) 1985 HEWLETT-PACKARD CO. 3.0'$
module sysbug;
{ this module is used by the debugger when it needs
  to call system resident code
}
IMPORT SYSGLOBALS, LOADER, SYSDEVS, ASM;
export
  procedure callsyscode(i : integer);
implement
  type
    menu1 = array[boolean] of menutype;
    menu2 = array[m_none..m_sysshift] of menu1;
  const
    mstates = menu2[
		{ no menu } menu1[m_sysnorm,m_sysshift],
		{ normal  } menu1[m_none,m_sysshift],
		{ shifted } menu1[m_sysnorm,m_none]];
    inmaxsize = 80;
    imsize    = 88;
  type
    realp = ^real;
    str80p= ^string80;
    dword = 0..65535;
    jvector = packed array[1..6] of char;       { jump vector }
    KRECORD = PACKED RECORD
		VTYPE : BYTE;
		SIZE  : BYTE;
		VALUE : INTEGER;
	      END;
    LLREC   = PACKED ARRAY[0..1] OF DWORD;
{****************************************************************************}
{** DO NOT CHANGE THIS RECORD WITHOUT CHANGEING THE DEBUGGER ASSEMBLY CODE **}
{** SEE ALSO MODULE POWERUP                                                **}
{****************************************************************************}
{ ERROR RECORDS }
  TYPE20       = PACKED RECORD
		   CASE INTEGER OF
		   0010:(ERR_PC : INTEGER);
		   1001:(ERR_PC1: INTEGER;
			 ERR_WRDS:INTEGER;
			 ERR_EA : INTEGER);
		   1010:(BE_SSW_10 : INTEGER;   {SHORT BUS ERROR}
			 BE_IPSC_10: DWORD;
			 BE_IPSB_10: DWORD;
			 BE_PAD_10 : INTEGER;
			 BE_FAULT_10:INTEGER;   {FAULT ADDRESS}
			 BE_DATA_10: INTEGER;   { DATA IN/OUT }
			 BE_PAD2_10: INTEGER);
		   1011:(BE_SSW_11 : INTEGER;{LONG BUS ERROR}
			 BE_IPSC_11: DWORD;
			 BE_IPSB_11: DWORD;
			 BE_PAD_11 : INTEGER;
			 BE_FAULT_11:INTEGER;   {FAULT ADDRESS}
			 BE_DATAOUT: INTEGER;
			 BE_PAD6   : PACKED ARRAY[1..16] OF CHAR;
			 BE_DATAI_11 : INTEGER;
			 BE_MISC20   : PACKED ARRAY[1..44] OF CHAR)
		 END;
  ERRORINFOREC = PACKED RECORD
		   CASE INTEGER OF
		   68000:(BE_SSW_00     : DWORD;
			  BE_FAULT_ADDR : INTEGER;
			  BE_INSTR      : DWORD);
		   68010:(BE_SSW_10     : DWORD;
			  BE_FAULT_ADDR10:INTEGER;
			  BE_PAD1_10    : DWORD;
			  BE_DATAO_10   : DWORD;
			  BE_PAD2_10    : DWORD;
			  BE_DATAI_10   : DWORD;
			  BE_PAD3_10    : DWORD;
			  BE_INSTR_10   : DWORD;
			  BE_MISC_10    : PACKED ARRAY[1..32] OF CHAR);
		   68020:(M68020:TYPE20)
		 END;
  DEBUGCOMTYPE = PACKED RECORD
		 ERRINFO  : ERRORINFOREC;
		 EXCP_STATUS  : DWORD;
		 EXCP_PC      : INTEGER;
		 EXCP_VOFFSET : DWORD;
		 EXCP_LINE    : INTEGER;
		 LASTLINE     : ^LLREC;

		 ESCAPEV      : JVECTOR;
		 PCTEMP       : INTEGER;
		 SRTEMP       : DWORD;
		 INITSTACK    : INTEGER;
		 INITPC       : INTEGER;
		 INITRECOVER  : INTEGER;
		 G_DOLLAR     : INTEGER;
		 CTL_RESETV   : JVECTOR;
		 DEBUGESCAPE  : JVECTOR;
		 BESPTEMP     : INTEGER;
		 AONOFF       : BYTE;
		 GONOFF       : BYTE;
		 GRAPHICSBASE : INTEGER;
		 INITSR       : DWORD;
		 M68KTYPE     : BYTE;
		 MSYSFLAGS    : BYTE;
		 FLTPTHDW     : BYTE;
		 FILLER       : BYTE;

		 SAVEBUS      : JVECTOR;
		 SAVEESC      : JVECTOR;

		 CTRL_FLAGS   : PACKED ARRAY[1..4] OF CHAR;

		 QSTART       : INTEGER;
		 QEND         : INTEGER;
		 QLAST        : INTEGER;

		 TCOUNT       : INTEGER;
		 OLDA6        : INTEGER;
		 SFA6         : INTEGER;

		 IMFIRST      : INTEGER;
		 IMLAST       : INTEGER;

		 KDATAP       : INTEGER;  { K0..K9 DATA AREA POINTER }
		 KVECTOR      : ARRAY[0..9] OF KRECORD;

		 REGPC        : INTEGER;
		 REGSR        : DWORD;
		 REGUS        : INTEGER;  { USER STACK POINTER }
		 DREGS        : ARRAY[0..7] OF INTEGER;
		 AREGS        : ARRAY[0..7] OF INTEGER;
		 { CRT STUFF }
		 CRTOPCODE    : BYTE;
		 CRTCHAR      : CHAR;
		 CRTPADDING1  : BYTE;
		 CRTPROMPTSIZE: BYTE;
		 CRTPROMPT    : PACKED ARRAY[1..4] OF CHAR;
		 CRTPADDING2  : INTEGER;
		 LASTLINEOP   : BYTE;
		 STAT0CHAR    : CHAR;
		 CRTPADDING3  : DWORD;
		 { KEYBOARD STUFF }
		 KBDSTATREG   : BYTE;
		 KBDCHAR      : CHAR;
		 KBDDUMMY     : CHAR;   { NOT USED }
		 KBDTRANSCODE : BYTE;   { 0 = ALPHA, 1= SPECIAL,3= NON_ADV }
		 { OTHER STUFF }
		 UEXCPI       : INTEGER; { ERROR TRAP IMPLANT ADDR }
		 SYMBOLHOOK   : JVECTOR; { HOOK INTO SYMBOL LOOKUP }
		 ACCUMV       : KRECORD;
		 DATAV        : KRECORD;
		 BASE         : DWORD;
		 SSIZE        : INTEGER;
		 RCOUNT       : INTEGER;
		 ETCODES      : ARRAY[0..1] OF INTEGER;
		 NUMET        : BYTE;
		 SCODE        : BYTE;
		 DSCODE       : BYTE;
		 TEMPD        : CHAR;   { DEBUG CI RUNLIGHT }
		 TEMPR        : CHAR;   { TEMP RUNLIGHT }
		 OUTFLAGS     : BYTE;
		 LINECOUNT    : DWORD;
		 RECALLV      : STR80P;
		 TEMPS        : ARRAY[1..4] OF INTEGER;
		 SAVEHOOK     : JVECTOR;
		 INSTACK      : ARRAY[1..4] OF INTEGER;
		 OPSTACK      : ARRAY[1..12] OF INTEGER;
		 INBUF        : STRING80;
	       END;
  VAR
    OUTS     : STR80P;
    DEBUGCRT : ^DBCINFO;
    DERR_INFO['ERR_INFO'] : INTEGER;
    DEBUGCOM : ^DEBUGCOMTYPE;

  function value(symbol: string255): integer;
  var
    modp: moddescptr;
    ptr, valueptr: addrec;
    found: boolean;
  begin {value}
    value := 0;
    found := false;
    modp := sysdefs;
    while (modp<>nil) and not found do
      with modp^ do
	begin
	  ptr := defaddr;
	  while (ptr.a<defaddr.a+defsize) and not found do
	    begin
	      found := ptr.syp^=symbol;
	      ptr.a := ptr.a+strlen(ptr.syp^)+1;
	      ptr.a := ptr.a+ord(odd(ptr.a));
	      valueptr.a := ptr.a+2;
	      if found then value := valueptr.vep^.value;
	      ptr.a := ptr.a+ptr.gvp^.short;
	    end; {while}
	  modp := link;
	end; {with modp^}
  end; {value}

  PROCEDURE UNITTOMSUS;
  {
	UNITTOMSUS DETERMINES THE MSUS THAT APPLIES TO THE
	GIVEN FILE SYSTEM UNIT NUMBER.  ON INPUT, THE UNIT NUMBER
	IS REQUIRED AND ON OUTPUT THE MSUS AND RESULT CODE
	ARE RETURNED.

	INPUT:  UNIT NUMBER IS IN TEMPL.
	OUTPUT: MSUS IS IN TEMPL2.
		RESULT CODE IS IN TEMPL3.

	RESULT CODE CONTENTS ARE:

		0 = OK RETURN
		1 = COULDN'T MAKE A DEFINITE CONVERSION.
		    MSUS IS INVALID.
  }
      TYPE
	msus_type = packed record
		      case integer of
		      1:(df       : 0..7;         { directory format }
			 dt       : 0..31;        { device type }
			 unum     : byte;         { unit number }
			 scode    : byte;         { select code }
			 baddr    : byte);        { bus address }
		      2:(pad1     : byte;
			 vol      : 0..15;    { volume number }
			 un       : 0..15);   { unit number }
		      3:(bytes    : packed array [1..4] of char);
		    end;

      PROCEDURE FSUNIT_MSUS(FSUNIT : unitnum; ANYVAR MSUS : msus_type);
	VAR
	  f : fib;
	BEGIN
	  if (fsunit<0) or (fsunit>maxunit) then escape(2);
	  with unitable^[fsunit] do
	  begin
	    msus.df    := 0;
	    msus.scode := sc;
	    msus.baddr := ba;
	    msus.unum  := du;
	    case letter of
	      'B':begin { BUBBLE }
		    msus.dt := 22;
		  end;
	      'E':begin { EPROM }
		    msus.dt := 20;
		    msus.unum := dv;
		  { bootrom uses unit, table uses volume }
		  end;
	      'F':begin { 9885 }
		    msus.dt := 6;
		  end;
	      'G':begin { SRM }
		    msus.df := 7; msus.dt := 1;
		  end;
	      'H':begin { 9895 }
		    msus.dt := 4;
		  end;
	      'J',{ PRINTER }
	      'R':{ RAM }
		  escape(2);
	      'M':begin { internal mini }
		    msus.dt := 0;
		  end;
	      'N':begin { 8290X }
		    msus.dt := 5;
		  end;
	      'Q':begin { C280 }
		    msus.vol := dv; msus.un := du;
		    if intlevel > 2 then escape(2);
		    call(dam, uvid, fsunit, getvolumename);
		    if (ioresult <> ord(inoerror)) or (strlen(uvid) = 0)
		       or (dvrtemp2 < 8)
		      then escape(2)
		    else
		    if dvrtemp2=8 then msus.dt := 16
				  else msus.dt := 17;
		  end;
	      'S':begin { SCSI }
		    msus.dt := 14;
		  end;
	      'U':begin { 913X_A }
		    msus.dt := 7;
		  end;
	      'V':begin { 913X_B }
		    msus.dt := 8;
		  end;
	      'W':begin { 913X_C }
		    msus.dt := 9;
		  end;
	      otherwise
		escape(2);
	    end; { case }
	  end;
	END; { FSUNIT_MSUS }

  BEGIN
    WITH DEBUGCOM^ DO
    BEGIN
      TRY
	TEMPS[3] := 0;
	FSUNIT_MSUS(TEMPS[1],TEMPS[2]);
      RECOVER
	TEMPS[3] := 1;
    END;
  END;

  { DUMMY REVASM }
  PROCEDURE DUMREVASM(ANYVAR INSP: INTEGER; ANYVAR SP:STR80P;
		      ANYVAR FTYPE:INTEGER);
  TYPE
    REVPROC = PROCEDURE (ANYVAR INSP: INTEGER; VAR S:STRING;
			 ANYVAR NXTP,FTYPE:INTEGER);
    PREC = RECORD
	     CASE BOOLEAN OF
	     TRUE :(RPROC : REVPROC);
	     FALSE:(I2 : PACKED ARRAY[1..2] OF INTEGER);
	   END;
  VAR
    TPROC:PREC;
    NXTP : INTEGER;
  BEGIN
    SP:= OUTS;
    TPROC.I2[1]:=VALUE('REVASM_MOD_REVASM');    { TRY TO FIND THE REAL REVASM }
    IF TPROC.I2[1]=0 THEN
    BEGIN SETSTRLEN(SP^,0); NXTP:=INSP; END     { SIGNAL NO DECODE }
    ELSE
    BEGIN
      TPROC.I2[2]:=0;   { CLEAR STATIC LINK }
      CALL(TPROC.RPROC,INSP,SP^,NXTP,FTYPE);    { CALL THE REVERSE ASSEMBLER }
      INSP:=NXTP;                               { OLD POINTER BECOMES NEW }
    END;
  END;

  PROCEDURE REALTOSTRING(ANYVAR RP:REALP; ANYVAR SP:STR80P);
  TYPE
    RSPROC = PROCEDURE(VAR R:STRING; VAR P2:INTEGER;X :REAL; W,D:SHORTINT);
    PREC = RECORD
	     CASE BOOLEAN OF
	     TRUE :(REALPR : RSPROC);
	     FALSE:(I2 : PACKED ARRAY[1..2] OF INTEGER);
	   END;
  VAR
    I : INTEGER;
    RPROC : PREC;
  BEGIN
    SP:= OUTS;
    RPROC.I2[1]:=VALUE('MFS_FWRITESTRREAL');    { FIND THE ROUTINE }
    IF RPROC.I2[1]=0 THEN SP^ :='no R formatter'
    ELSE
    BEGIN
      TRY
	RPROC.I2[2]:=0;         { CLEAR STATIC LINK }
	SETSTRLEN(SP^,0);       { CLEAR THE STRING }
	I:=1;           { SET START POSITION }
	CALL(RPROC.REALPR,SP^,I,RP^,-1,-1); { CALL THE ROUTINE }
      RECOVER
	SP^ := 'not real';
    END;
  END;

  procedure readkey;
  var
    oldkbdisr : kbdhooktype;
    oldrpgisr : kbdhooktype;
    alldone   : boolean;
    oldcaps   : boolean;
    oldnonchar: char;

    procedure debugrpg(var kbdstatus, kbddata: byte;
			 var dokey: boolean);
    var key: char;
    begin
      if dokey then
      with debugcom^ do
      begin
	kbdstatreg:= kbdstatus;
	kbdtranscode:= 1;       { special }
	alldone:= true;
	case  not odd(kbdstatus div 16) of
	  true: {shifted} { down arrow, up arrow }
	      if kbddata >= 128 then kbdchar:= #34 else kbdchar:= #35;
	  false: {unshifted}{ right arrow, left arrow }
	      if kbddata >= 128 then kbdchar:= #39 else kbdchar:= #38;
	end;
      end;
    end; { rpghandler }

    procedure debugkeys(var kbdstatus, kbddata: byte;
			var dokey: boolean);
    var
      i : integer;
      c : char;
    begin   { debugkeys }
      if dokey then
      with langcom do
	begin
	status  := kbdstatus;
	data    := kbddata;
	extension:= not odd(kbdstatus div 8);
	shift   := not odd(kbdstatus div 16);
	control := not odd(kbdstatus div 32);
	call(langtable[langindex]^.semantics);
	debugcom^.kbdstatreg:= status;
	debugcom^.kbdtranscode:= 0;     { 3.0 BUG FIX }
	alldone := true;
	CASE result OF
	nonadv_key, { have non advancing key }
	alpha_key,
	NONA_ALPHA_KEY  {3.1 BUGFIX SFB--5/30/85} :
	  begin
	    debugcom^.kbdchar:= key;
	    if (result=nonadv_key) OR   {3.1 BUGFIX SFB--5/30/85}
	      ((RESULT = NONA_ALPHA_KEY) AND NOT SHIFT) then
	    begin keybuffer^.non_char:= key; alldone:=false; end;
	  end;
	special_key: { have special function key }
	  begin
	    case data of        { fix itf keycodes }
	    5: data:=56;        { break=>pause }
	    6: data:=55;        { stop }
	    7: data:=59;        { select=>execute}
	    8: data:=57;        { np enter=>enter}
	    17: { enter/print }
	       if shift and control then { dump graphics }
	       begin data:=50; debugcom^.kbdstatreg:=175; end
	       else
		 if shift then data:=49 { dump alpha }
			  else data:=57; { enter }
	    20:begin {system/user}
		 if shift then key:='U' else key:='S';
		 kbdsysmode:=not shift;
		 setstatus(6,key);
		 if key='U' then
		   if (menustate=m_sysnorm) or (menustate=m_sysshift) then
		   begin
		     menustate:=m_none;
		     keybuffer^.echo:=true;
		     keybufops(kdisplay,c);
		   end;
		 alldone:=false;
	       end;
	    21:begin {menu}
		 alldone := false;
		 if kbdsysmode and not control then
		 begin
		   call(crtllhook,cllclear,i,c);
		   if menustate<=m_sysshift
		   then menustate:=mstates[menustate,shift]
		   else menustate:=m_none;

		   keybuffer^.echo:=(menustate=m_none);
		   case menustate of
		     m_none    : keybufops(kdisplay,c);
		     m_sysnorm : call(crtllhook,clldisplay,sysmenu^,c);
		     m_sysshift: call(crtllhook,clldisplay,sysmenushift^,c);
		     otherwise
		   end;
		 end;
	       end;

	    22:begin data:=52; debugcom^.kbdstatreg:=191; end;  { clr line }
	    23:begin data:=52; debugcom^.kbdstatreg:=175; end;  { clr screen }
	    otherwise
	    end; { case data }
	    debugcom^.kbdchar:= chr(data);
	    debugcom^.kbdtranscode:= 1; { special }
	  end;
	ignored_key: alldone:=false;
	OTHERWISE {TO MAKE ISR MORE ROBUST- THE "BITBUCKET". SFB--5/30/85}
	end;

      end;  { with langcom }
    end;    { debugkeys }

  begin { readkey }
    alldone:= false;
    with langtable[langindex]^ do
    begin
      oldcaps:= kbdcapslock; kbdcapslock:= true;  { force capslock }
      oldkbdisr:= kbdisrhook; kbdisrhook:= debugkeys;
      oldrpgisr:= rpgisrhook; rpgisrhook:= debugrpg;
      oldnonchar:= keybuffer^.non_char; keybuffer^.non_char:= ' ';

      repeat call(kbdpollhook,true) until alldone;

      kbdcapslock:= oldcaps;
    end;
    kbdisrhook:= oldkbdisr; rpgisrhook:= oldrpgisr;
    keybuffer^.non_char:= oldnonchar;
  end; { readkey }

  procedure dolastlineop;
  var
    tempc : char;
    i     : integer;
  begin
    with debugcom^ do
    case lastlineop of
    0: begin tempc:= runlight; setrunlight(tempr); tempr:= tempc; end;
    1: setrunlight(tempr);
    2: begin tempd:= runlight; setrunlight('d'); end;
    3: begin for i:=1 to 5 do setstatus(i,' '); setrunlight(tempd); end;
    4: for i:=0 to 5 do setstatus(i,' ');       { clear status line }
    5: setstatus(0,stat0char);
    6: begin    { display last line }
	 setstrlen(inbuf,0); strwrite(inbuf,1,i,lastline^[1]:5);
	 setstatus(0,' ');
	 for i:=1 to 5 do setstatus(i,inbuf[i]);
       end;
    otherwise
    end;
  end;{ dolastlineop }

  procedure docrtops;
  var i : integer;
    procedure putcursor;
    begin
      with debugcrt^ do
      begin
	if cursx>xmax then
	begin cursx:=xmin; cursy:=cursy+1; end;
	if cursy>ymax then
	begin
	  cursy:=ymax; call(dbcrthook,dbscrollup,debugcrt^);
	end;
	call(dbcrthook,dbgotoxy,debugcrt^);
      end;
    end; { putcursor }
  begin
    with debugcom^, debugcrt^ do
    if savesize>0 then
    case crtopcode of
    0: call(dbcrthook,dbexcg,debugcrt^);        { exchange display }
    1: begin    { putchr & advance cursor }
	 c:=crtchar; call(dbcrthook,dbput,debugcrt^);
	 cursx:=cursx+1; putcursor;
       end;
    2: begin    { write prompt }
	 for i:=1 to crtpromptsize do
	 begin
	   c:=crtprompt[i]; call(dbcrthook,dbput,debugcrt^);
	   cursx:=cursx+1; putcursor;
	 end;
       end;
    3: begin cursx:=xmin; cursy:=cursy+1; putcursor; end;
    4: call(dbcrthook,dbinit,debugcrt^);
    5: begin    { clear crt & homecursor }
	 call(dbcrthook,dbclear,debugcrt^);
	 cursx:=xmin; cursy:=ymin; putcursor;
       end;
    6: call(dbcrthook,dbcline,debugcrt^);       { clear to end of line }
    7: begin cursx:=xmin; putcursor; end;
    8: begin cursx:=cursx-1; putcursor; end;
    9: begin cursx:=cursx+1; putcursor; end;
    otherwise
    end;
  end;  { docrtops }

  PROCEDURE DOINIT;
  VAR DONE: BOOLEAN;
  BEGIN    { initialize }
    IF OUTS=NIL THEN NEW(OUTS);
    DEBUGCOM := ADDR(DERR_INFO);
    { allocate debugger crt window }
    NEW(DEBUGCRT);
    WITH DEBUGCRT^ DO
    BEGIN
      XMIN:=0; YMIN:=0;
      XMAX:=SYSCOM^.CRTINFO.WIDTH-1;
      YMAX:=SYSCOM^.CRTINFO.HEIGHT-1;
      SAVESIZE:=-1;
      CALL(DBCRTHOOK,DBINFO,DEBUGCRT^);
      DONE:= SAVESIZE<=0;
      WHILE NOT DONE DO { ALLOCATE SPACE TO SWAP WINDOW }
      BEGIN
	IF SAVESIZE<4000 THEN DONE:=TRUE
	ELSE
	IF (XMAX-XMIN)>50 THEN XMIN:=XMAX-49
	ELSE
	IF (YMAX-YMIN)>24 THEN YMIN:=YMAX-22
	ELSE DONE:=TRUE;

	IF DONE THEN
	BEGIN
	  NEWBYTES(SAVEAREA,SAVESIZE);
	  CALL(DBCRTHOOK,DBINIT,DEBUGCRT^);
	END
	ELSE CALL(DBCRTHOOK,DBINFO,DEBUGCRT^);
      END;      { WHILE }
    END;        { WITH }
  END;  { DOINIT }

  procedure callsyscode(i : integer);
  begin
    case i of
    -1: DOINIT;
    0 : DOCRTOPS;
    1 : call(togglegraphicshook);
    2 : call(dumpalphahook);
    3 : call(dumpgraphicshook);
    4 : WITH DEBUGCOM^ DO REALTOSTRING(TEMPS[1],TEMPS[2]);
    5 : WITH DEBUGCOM^ DO DUMREVASM(TEMPS[1],TEMPS[2],TEMPS[3]);
    6 : BEEP;
    7 : READKEY;
    8 : call(togglealphahook);
    9 : dolastlineop;
    10: UNITTOMSUS;
    otherwise
    end; { case }
  end;  { callsyscode }
end;    { module sysbug }

import sysglobals,loader,sysbug;

procedure realdebugger(p1,p2,p3: integer); external;
{****** PROGRAM INSTALLDEBUGGER **************}
begin
  callsyscode(-1);              { initialize sysbug }
  if realdebugger<>debugger then
  begin
    debugger:=realdebugger;
    realdebugger(0,0,0);        { initialize debugger }
    markuser;
  end;
end.


@


55.1
log
@Automatic bump of revision number for PWS version 3.25A
@
text
@@


54.1
log
@Automatic bump of revision number for PWS version 3.24
@
text
@@


53.1
log
@Automatic bump of revision number for PWS version 3.24B
@
text
@@


52.1
log
@Automatic bump of revision number for PWS version 3.24A
@
text
@@


51.1
log
@Automatic bump of revision number for PWS version 3.24d
@
text
@@


50.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@@


49.1
log
@Automatic bump of revision number for PWS version 3.24b
@
text
@@


48.1
log
@Automatic bump of revision number for PWS version 3.24a
@
text
@@


47.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@@


46.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@@


45.1
log
@Automatic bump of revision number for PWS version 3.23C
@
text
@@


44.1
log
@Automatic bump of revision number for PWS version 3.23B
@
text
@@


43.1
log
@Automatic bump of revision number for PWS version 3.23aA
@
text
@@


42.1
log
@Automatic bump of revision number for PWS version 3.23e
@
text
@@


41.1
log
@Automatic bump of revision number for PWS version 3.23d
@
text
@@


40.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@@


39.1
log
@Automatic bump of revision number for PWS version 3.23b
@
text
@@


38.1
log
@Automatic bump of revision number for PWS version 3.23a
@
text
@@


37.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@@


36.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


35.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


34.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


33.1
log
@Automatic bump of revision number for PWS version 3.22D
@
text
@@


32.1
log
@Automatic bump of revision number for PWS version 3.22C
@
text
@@


31.1
log
@Automatic bump of revision number for PWS version 3.22B
@
text
@@


30.1
log
@Automatic bump of revision number for PWS version 3.22A
@
text
@@


29.2
log
@The previous rcs version 29.2 was deleted using the rcs -o29.2 INITBUG command.
Because I (DEW) did a break during newci, the bottom half of INITBUG
was chopped off.  Fortunately, on PWS a backup copy existed.

The previous comments for INITBUG 29.2 apply here.
DEW 12/6/88.
@
text
@@


29.1
log
@Automatic bump of revision number for PWS version 3.22b
@
text
@d24 1
d223 109
d632 1
d651 1
@


28.1
log
@Automatic bump of revision number for PWS version 3.3b
@
text
@@


28.1.1.1
log
@DEW 10/21/88
Branch created for debugger named reboot modifications.
@
text
@a23 1
$ALLOW_PACKED ON$
a221 115
  PROCEDURE UNITTOMSUS;
  {
	UNITTOMSUS DETERMINES THE MSUS THAT APPLIES TO THE
	GIVEN FILE SYSTEM UNIT NUMBER.  ON INPUT, THE UNIT NUMBER
	IS REQUIRED AND ON OUTPUT THE MSUS AND RESULT CODE
	ARE RETURNED.

	INPUT:  UNIT NUMBER IS IN TEMPL.
	OUTPUT: MSUS IS IN TEMPL2.
		RESULT CODE IS IN TEMPL3.

	RESULT CODE CONTENTS ARE:

		0 = OK RETURN
		1 = COULDN'T MAKE A DEFINITE CONVERSION.
		    MSUS IS INVALID.
  }
      TYPE
	msus_type = packed record
		      case integer of
		      1:(df       : 0..7;         { directory format }
			 dt       : 0..31;        { device type }
			 unum     : byte;         { unit number }
			 scode    : byte;         { select code }
			 baddr    : byte);        { bus address }
		      2:(pad1     : byte;
			 vol      : 0..15;    { volume number }
			 un       : 0..15);   { unit number }
		      3:(bytes    : packed array [1..4] of char);
		    end;

      PROCEDURE FSUNIT_MSUS(FSUNIT : unitnum; ANYVAR MSUS : msus_type);
	VAR
	  f : fib;
	BEGIN
	  if (fsunit<0) or (fsunit>maxunit) then escape(2);
	  with unitable^[fsunit] do
	  begin
	    msus.df    := 0;
	    msus.scode := sc;
	    msus.baddr := ba;
	    msus.unum  := du;
	    case letter of
	      'B':begin { BUBBLE }
		    msus.dt := 22;
		  end;
	      'E':begin { EPROM }
		    msus.dt := 20;
		    msus.unum := dv;
		  { bootrom uses unit, table uses volume }
		  end;
	      'F':begin { 9885 }
		    msus.dt := 6;
		  end;
	      'G':begin { SRM }
		    msus.df := 7; msus.dt := 1;
		  end;
	      'H':begin { 9895 }
		    msus.dt := 4;
		  end;
	      'J',{ PRINTER }
	      'R':{ RAM }
		  escape(2);
	      'M':begin { internal mini }
		    msus.dt := 0;
		  end;
	      'N':begin { 8290X }
		    msus.dt := 5;
		  end;
	      'Q':begin { C280 }
		    msus.vol := dv; msus.un := du;
		    { do unit clear
		    with f do
		    begin
		      dvrtemp2 := -1;
		      funit := fsunit;
		      call(tm, addr(f), clearunit, fsunit, 0, 0);
		    end; }
		    call(dam, uvid, fsunit, getvolumename);
		    if (ioresult <> ord(inoerror)) or (strlen(uvid) = 0)
		       or (dvrtemp2 < 8)
		      then escape(2)
		    else
		    if dvrtemp2=8 then msus.dt := 16
				  else msus.dt := 17;
		  end;
	      'S':begin { SCSI }
		    msus.dt := 14;
		  end;
	      'U':begin { 913X_A }
		    msus.dt := 7;
		  end;
	      'V':begin { 913X_B }
		    msus.dt := 8;
		  end;
	      'W':begin { 913X_C }
		    msus.dt := 9;
		  end;
	      otherwise
		escape(2);
	    end; { case }
	  end;
	END; { FSUNIT_MSUS }

  BEGIN
    WITH DEBUGCOM^ DO
    BEGIN
      TRY
	TEMPS[3] := 0;
	FSUNIT_MSUS(TEMPS[1],TEMPS[2]);
      RECOVER
	TEMPS[3] := 1;
    END;
  END;

a521 1
    10: UNITTOMSUS;
@


27.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@@


26.1
log
@Automatic bump of revision number for PWS version 3.3 Synch
@
text
@@


25.1
log
@Automatic bump of revision number for PWS version 3.2Y
@
text
@@


24.1
log
@Automatic bump of revision number for PWS version 3.2
@
text
@@


23.1
log
@Automatic bump of revision number for PWS version 3.2P
@
text
@@


22.1
log
@Automatic bump of revision number for PWS version 3.2N
@
text
@@


21.1
log
@Automatic bump of revision number for PWS version 3.2M
@
text
@@


20.1
log
@Automatic bump of revision number for PWS version 3.2L
@
text
@@


19.1
log
@Automatic bump of revision number for PWS version 3.2K
@
text
@@


18.1
log
@Automatic bump of revision number for PWS version 3.2J
@
text
@@


17.1
log
@Automatic bump of revision number for PWS version 3.2I+
@
text
@@


16.1
log
@Automatic bump of revision number for PWS version 3.2I
@
text
@@


15.1
log
@Automatic bump of revision number for PWS version 3.2H
@
text
@@


14.1
log
@Automatic bump of revision number for PWS version 3.2G
@
text
@@


13.1
log
@Automatic bump of revision number for PWS version 3.2F
@
text
@@


12.1
log
@Automatic bump of revision number for PWS version 3.2E
@
text
@@


11.1
log
@Automatic bump of revision number for PWS version 3.2D
@
text
@@


10.1
log
@Automatic bump of revision number for PWS version 3.2C
@
text
@@


9.1
log
@Automatic bump of revision number for PWS version 3.2B
@
text
@@


8.1
log
@Automatic bump of revision number for PWS version 3.2A
@
text
@@


7.1
log
@Automatic bump of revision number for PWS version 3.2l
@
text
@@


6.1
log
@Automatic bump of revision number for PWS version 3.2k
@
text
@@


5.1
log
@Automatic bump of revision number for PWS version 3.2j
@
text
@@


4.1
log
@Automatic bump of revision number for PWS version 3.2i
@
text
@@


3.1
log
@Automatic bump of revision number for PWS version 3.2h
@
text
@@


2.1
log
@Auto bump rev number to 2.1 for sys 3.2e.
@
text
@@


1.1
log
@Initial revision
@
text
@@
