!!!                ******   ******   ******   ******   **   **  *     *  ******    *****
!!!                **   **  **   **  **   **  **   **  **   **  **   **  **   **  **   **
!!!                **   **  **   **  **   **  **   **  **   **  *** ***  **   **  **
!!!                ******   **   **  ******   **   **  **   **  ** * **  ******    *****
!!!                **       **   **  **       **   **  **   **  **   **  **            **
!!!                **       **   **  **       **   **  **   **  **   **  **       **   **
!!!                **       ******   **       ******    *****   **   **  **        *****

%CONTROL 0

%OWNSTRING (15) OUTPUT = '.TT'
%OWNSTRING (15) SOURCE = 'SS#ARTH'
%CONSTSTRING (6) %ARRAY OPCODES(0 : 15) =     %C
'NOP   ', 'EVOKE ', 'BUS   ', 'COND  ',
'MERGE ', 'RTCALL', 'RETURN', 'JUMP  ',
'STOP  ', 'BRANCH', 'T-LINE', 'BREAK', ' CONT',' CMRGE','+FLAG ',
'UNDEF '
%CONSTINTEGER NMAX = 100
%RECORDFORMAT EXTERNFM(%BYTEINTEGER FROM, FBITS, TO, TOBITS)
%CONSTINTEGER EXTLNG = 100
%RECORDFORMAT CODEFM(%BYTEINTEGER CODE, NAME, OPRN, MODULE,  %C
          %SHORTINTEGER DEST, STAT)
%RECORDFORMAT HEADFM( %C
          %INTEGER IDEN, USEAGE, NNAMES, NAMES, TEXT, CODE,  %C
          CONSTANTS, OLD FILE, TXTLNG, STARTAD, EXTERNS, TABS)
%RECORDFORMAT TAGFM(%INTEGER MASTER, %SHORTINTEGER TYPE,  %C
          %BYTEINTEGER USED, BITS, %INTEGER USE, DEFN, SIZE, WHERE)
%RECORDFORMAT NAMEFM(%INTEGER NAME,%RECORD TAGS(TAGFM))
%EXTERNALROUTINESPEC DEFINE(%STRING(63) S)
%ROUTINE CONNEKT(%STRING(17) FILE, %INTEGERNAME AD,FLAG)
%SYSTEMROUTINESPEC CONNECT(%STRING(15) S,%INTEGER ACCESS,MAXBYTES,%C
                   PROTECTION,%RECORDNAME R,%INTEGERNAME FLAG)
%RECORDFORMAT FINFO(%INTEGER CONAD,FILESIZE,%BYTEINTEGER DUM1,DUM2,%C
              MODE,DUM3,DUM4,%STRING(6) DUM5,%SHORTINTEGER %C
              FILETYPE,DUM6,%INTEGER DATASTART,DATAEND,DUM7)
%RECORD R(FINFO)
%CONSTINTEGER READ UNSHARED=2
CONNECT(FILE,READ UNSHARED,0,4,R,FLAG)
AD=R_CONAD
%END

%ROUTINE HSYM(%INTEGER N)
%CONSTBYTEINTEGERARRAY SS(0 : 15) =       %C
'0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'
       PRINTSYMBOL(SS(N))
%END

%ROUTINE HB(%INTEGER N)
       HSYM(N>>4);  HSYM(N&15)
%END

%ROUTINE HS(%INTEGER N)
       HB(N>>8&255);  HB(N&255)
%END
%ROUTINE HEX(%INTEGER N)
       HS(N>>16&X'FFFF');  HS(N)
%END

%EXTERNALROUTINE PDPDUMP(%STRING (63) S)
%RECORDFORMAT AR(%INTEGERARRAY A(1:12))
%RECORDNAME HEAD(AR)
%INTEGER I,LAST
%RECORDARRAYFORMAT EXTARFM(1 : EXTLNG)(EXTERNFM)
%RECORDARRAYNAME EXTERNALS(EXTERNFM)
%RECORDFORMAT TABFM(%SHORTINTEGERARRAY W(0 : 7))
%RECORDARRAYFORMAT TBAFM(1 : 50)(TABFM)
%RECORDARRAYNAME TABLES(TABFM)
%RECORDARRAYFORMAT OBJFM(0 : 2000)(CODEFM)
%RECORDARRAYFORMAT TEXTFM(1 : NMAX)(NAMEFM)
%SHORTINTEGERARRAYFORMAT USEFM(0 : 20)
%SHORTINTEGERARRAYFORMAT CONFM(0 : 60)
%RECORDARRAYNAME OBJECT(CODEFM)
%RECORDARRAYNAME NAME(NAMEFM)
%RECORDNAME NP(NAMEFM)
%RECORDNAME CP(CODEFM)
%SHORTINTEGERARRAYNAME USE
%SHORTINTEGERARRAYNAME CONSTANTS
%RECORDNAME HEADER(HEADFM)
%RECORDNAME TAGS(TAGFM)
%INTEGER OP, AD, FLAG, J, K, L, LIMIT, DISP
       SOURCE = S %UNLESS S = ''
       %IF SOURCE -> SOURCE.('/').OUTPUT %START
          SOURCE = 'SS#ARTH' %IF SOURCE = ''
       %FINISH
       DEFINE('ST11,'.OUTPUT)
       CONNEKT(SOURCE, AD, FLAG)
       %IF FLAG # 0 %START
          PRINTSTRING('CANNOT CONNECT '.SOURCE.', FLAG =')
          WRITE(FLAG, 1)
          NEWLINE
          %RETURN
       %FINISH

%ROUTINE PS(%INTEGER AD)
%STRING (8) S
       S <- STRING(AD+DISP)
       PRINTSTRING(S)
       SPACES(10-LENGTH(S))
%END
       AD = AD+32;                      ! EXTRA FOR SYSTEM USE
       HEADER == RECORD(AD)
       %IF HEADER_IDEN # M'ARTH' %START
          PRINTSTRING(SOURCE.' IS NOT AN ARTHUR OBJECT FILE
')
          %RETURN
       %FINISH
       SELECTOUTPUT(11)
       SETMARGINS(11,1,120)
       DISP = AD-HEADER_OLD FILE-32
       NAME == ARRAY(AD+HEADER_NAMES, TEXTFM)
       EXTERNALS == ARRAY(AD+HEADER_EXTERNS, EXTARFM)
       TABLES == ARRAY(AD+HEADER_TABS, TBAFM)
       OBJECT == ARRAY(AD+HEADER_CODE, OBJFM)
       USE == ARRAY(AD+HEADER_USEAGE, USEFM)
       CONSTANTS == ARRAY(AD+HEADER_CONSTANTS, CONFM)
       PRINTSTRING('
     DUMP OF ARTHUR OBJECT FILE: '.SOURCE)
%PRINTTEXT'
IDEN      USEAGE    NNAMES    NAMES     TEXT      CODE      CONSTANTS '
%PRINTTEXT'OLD FILE  TXTLING   STARTAD   EXTERNS   TABS
'
HEAD==HEADER
%CYCLE I=1,1,12
HEX(HEAD_A(I))
SPACES(2)
%REPEAT
       %PRINTTEXT '

CODE

LOCN  STAT   CD NM  OP MD  ADDR

'
       K = HEADER_NNAMES
       J = 0
       LIMIT = HEADER_CONSTANTS+AD
LAST=0

       %UNTIL (L = 8 %AND CP_OPRN = 0) %C
          %OR ADDR(CP) >= LIMIT %CYCLE
          J = J+1;  CP == OBJECT(J)
!
          HS(J);  SPACES(2)
L=CP_STAT&X'7FFF'
%IF L=LAST%THEN SPACES(4)%ELSE WRITE(L,3)
LAST=L
SPACES(4)
L=CP_CODE
HSYM(L&15)
SPACE
          HB(CP_NAME);  SPACES(2)
          HB(CP_OPRN);  SPACE
          HB(CP_MODULE);  SPACES(2)
          HS(CP_DEST)
          SPACES(4)
          %IF CP_MODULE = 5 %C
             %THEN HS(CONSTANTS(CP_NAME)) %AND SPACES(6) %ELSE %START
             %IF 0 < CP_NAME <= K %THEN PS(NAME(CP_NAME)_NAME) %C
                %ELSE SPACES(10)
          %FINISH
          %IF CP_STAT < 0 %THEN %PRINTTEXT '*' %ELSE %START
             SPACE
             L = 15 %IF L > 14
             PRINTSTRING(OPCODES(L))
          %FINISH
          NEWLINE
       %REPEAT

       %PRINTTEXT '

NAMES


  NAME    MAST  TY US BT     USE     DEFN   SIZE    WHERE


'

       %WHILE K > 0 %CYCLE
          NP == NAME(K);  TAGS == NP_TAGS
          PS(NP_NAME);  HS(TAGS_MASTER);  SPACES(2)
          HB(TAGS_TYPE);  SPACE
          HB(TAGS_USED);  SPACE
          HB(TAGS_BITS)
          SPACES(2)
          HEX(TAGS_USE);  SPACE
          HEX(TAGS_DEFN)
          WRITE(TAGS_SIZE, 4);  SPACES(2)
          HEX(TAGS_WHERE)
          NEWLINE
          %IF 6 <= TAGS_TYPE <= 7 %START
             SPACES(6)
             %IF TAGS_WHERE = 0 %C
                %THEN %PRINTTEXT ' STANDARD SETTING
' %ELSE %START
                L = ADDR(TABLES(TAGS_WHERE))

                %CYCLE I = 0, 1, 15
                   SPACE
                   HB(BYTEINTEGER(L))
                   L = L+1
                %REPEAT

                NEWLINE
             %FINISH
          %FINISH
          %IF TAGS_TYPE = 8 %START
             SPACES(5)

             %CYCLE L = 0, 1, 7
                SPACES(2)
                HS(TABLES(TAGS_WHERE)_W(L))
             %REPEAT

             NEWLINE
          %FINISH
          K = K-1
       %REPEAT

       NEWLINES(2)
       %PRINTTEXT '
=========== END OF DUMP ==========
'
%END
%ENDOFFILE