!
!
!
%RECORDFORMAT RR(%INTEGER CONAD,FTYPE,DSTART,DEND)
%EXTERNALROUTINESPEC DEFINE(%STRING(255)PARM)
%SYSTEMROUTINESPEC PSYSMES(%INTEGER ROOT,FLAG)
%SYSTEMROUTINESPEC SETPAR(%STRING(255)PARM)
%SYSTEMSTRINGFNSPEC SPAR(%INTEGER N)
%SYSTEMROUTINESPEC CONNECT(%STRING(31)FILE,%INTEGER MODE,HOLE,PROT,
         %RECORD(RR)%NAME FINFO,%INTEGERNAME FLAG)
%SYSTEMROUTINESPEC ETOI(%INTEGER ADR,LNTH)
%SYSTEMROUTINESPEC MOVE(%INTEGER LNTH,FROMAD,TOAD)
!
!                                       OUT HEX
!
%ROUTINE OUTHEX(%INTEGER VAL,WIDTH)
 %CONSTBYTEARRAY HX(0:15)='0','1','2','3','4','5','6','7',
                          '8','9','A','B','C','D','E','F'
 %INTEGER I
 %FOR I=WIDTH-4,-4,0 %CYCLE
      PRINTSYMBOL(HX((VAL>>I)&15))
 %REPEAT
%END
!
!
!
%OWNSTRING(8)%ARRAY NAMES(0:4095)
%OWNINTEGERARRAY BASE(0:4095)
%OWNINTEGER INLINE=0,END TXT =200,ICONAD=0
%OWNSTRING(255) LAST="   "
%CONSTSTRING(2)%ARRAY ETYPE(0:10)="SD","LD","ER","**","PC","CM",
                                  "PR","**","**","**","0A"
!
!                                       CHECK
!
%ROUTINE CHECK(%STRING(255) TYPE)
 %RETURNIF TYPE=LAST
 NEWLINE %IF INLINE>0
 INLINE=0
 LAST = TYPE
 SPACES(15)
 PRINT STRING("     ========== ")
 PRINT STRING(TYPE)
 PRINT STRING("==========")
 NEWLINE
%END
!
!                                       BYTE
!
%INTEGERFN BYTE(%INTEGER I)
 %RESULT = BYTE INTEGER(I)
%END
!
!                                       HALF
!
%INTEGERFN HALF(%INTEGER I)
 %RESULT=BYTE(I)<<8 ! BYTE(I+1)
%END
!
!                                       THREE
!
%INTEGERFN THREE(%INTEGER I)
 %RESULT = BYTE(I)<<16 ! BYTE(I+1)<<8 ! BYTE(I+2)
%END
!
!
!                                       DUMP ESD
!
%ROUTINE DUMP ESD(%INTEGER ADR)
 %INTEGER I,A
 %OWNSTRING(8) NAME="        "
 %INTEGER ID
 CHECK("ESD")
 A=ADR-1{TO ENABLE OFFSETS AS IN DOC}
 ID=HALF(A+15)
 %FOR I=A+17,16,A+1+HALF(A+11) %CYCLE
      %IF INLINE>1 %THEN NEWLINE %AND INLINE=0
      %IF BYTE(I+8)=1{LD} %THEN SPACES(4) %ELSESTART
           OUT HEX(ID,16)
           ID = ID + 1
      %FINISH
      SPACE
      MOVE(8,I,ADDR(NAME)+1)
      ETOI(ADDR(NAME)+1,8)
      %IF BYTE(I+8)#1 %THEN NAMES(ID-1)=NAME {ID ALREADY INCREMENTED}
      PRINT STRING(NAME)
      SPACE
      PRINT STRING(ETYPE(BYTE(I+8)))
      SPACE
      OUT HEX(THREE(I+9),24)
      SPACE
      OUT HEX(BYTE(I+12),8)
      SPACE
      OUT HEX(THREE(I+13),24)
      SPACES(3)
      INLINE=INLINE+1
 %REPEAT
%END
!
!                                       LOCN
!
%INTEGERFN LOCN(%INTEGER ID,OFFSET)
 %INTEGER L
 L=OFFSET//56
 %RESULT=BYTEINTEGER(BASE(ID)+L*80+(OFFSET-L*56)+16)
%END
!
!                                       WORDAT
!
%INTEGERFN WORD AT(%INTEGER ID,OFFSET)
 %RESULT =LOCN(ID,OFFSET)<<24 ! LOCN(ID,OFFSET+1)<<16 ! %C
          LOCN(ID,OFFSET+2)<<8 ! LOCN(ID,OFFSET+3)
%END
!
!                                       DUMP TXT
!
%ROUTINE DUMP TXT(%INTEGER ADR)
 %INTEGER A,I,NB
 A=ADR-1
 %IF THREE(A+6)=0 %START
      {START OF SD}
      BASE(HALF(A+15)) = ADR
 %FINISH
 %IF THREE(A+6)<END TXT %START
      CHECK("TXT")
      PRINT STRING(NAMES(HALF(A+15)))
      PRINT STRING("+")
      OUT HEX(THREE(A+6),24)
      PRINT STRING(":")
      NB=HALF(A+11)
      %FOR I=A+17,1,A+16+NB %CYCLE
         OUT HEX(BYTE(I),8)
      %REPEAT
      NEWLINE
 %FINISH
%END
!
!                                       DUMP RLD
!
%ROUTINE DUMP RLD(%INTEGER ADR)
 %INTEGER A,I,NB,R,P
 CHECK("RLD")
 A=ADR-1
 NB=HALF(A+11)
 R=-1
 I=A+17
 %WHILE I<=A+16+NB %CYCLE
      %IF R<0 %START
         R=HALF(I)
         P=HALF(I+2)
         I=I+4
      %FINISH
      PRINT STRING(NAMES(P))
      PRINT STRING("+")
      OUT HEX(THREE(I+1),24)
      PRINT STRING(" DC ")
      %IF BYTE(I)&X'0C'#X'0C' %THEN PRINT SYMBOL('?') %ELSE PRINT SYMBOL('V')
      PRINT STRING("(")
      OUT HEX(WORD AT(P,THREE(I+1)),32)
      %IF BYTE(I)&2=0 %THEN PRINT SYMBOL('+') %ELSE PRINT SYMBOL('-')
      PRINT STRING(NAMES(R))
      PRINT STRING(")  ")
      INLINE = INLINE + 1
      %IF INLINE>=2 %START
         NEWLINE
         INLINE=0
      %FINISH
      %IF BYTE(I)&1=0 %THEN R=-1
      I=I+4
 %REPEAT
%END
!
!                                       DUMP END
!
%ROUTINE DUMP END(%INTEGER ADR)
 %INTEGER A
 %OWNSTRING(8) NM="        "
 A=ADR-1
 CHECK("END")
 %IF BYTE(A+17)=X'40' %START
      %IF HALF(A+15)#X'4040' %START
         PRINTSTRING("ENTRY PT=")
         PRINT STRING(NAMES(HALF(A+15)))
      %FINISH
 %FINISHELSESTART
      PRINT STRING("ENTRY PT=")
      MOVE(8,A+17,ADDR(NM)+1)
      ETOI(ADDR(NM)+1,8)
      PRINT STRING(NM)
 %FINISH
 %IF THREE(A+6)#X'404040' %START
      PRINT STRING("+")
      OUT HEX(THREE(A+6),24)
 %FINISH
 %IF BYTE(A+29)=0 %START
      PRINT STRING("  LENGTH=")
      OUT HEX(THREE(A+30),24)
 %FINISH
 NEWLINE
%END
!
!                                       DUMP REC
!
%ROUTINE DUMP REC(%INTEGER ADR)
 %IF BYTE(ADR)#2 %START
      CHECK("INVALID RECORD")
      %RETURN
 %FINISH
 %IF BYTE(ADR+1)=X'C5' %AND BYTE(ADR+2)=X'E2' %THEN DUMP ESD(ADR) %AND %RETURN
 %IF BYTE(ADR+1)=X'E3' %AND BYTE(ADR+2)=X'E7' %THEN DUMP TXT(ADR) %ANDRETURN
 %IF BYTE(ADR+1)=X'D9' %AND BYTE(ADR+2)=X'D3' %THEN DUMP RLD(ADR) %ANDRETURN
 %IF BYTE(ADR+1)=X'C5' %AND BYTE(ADR+2)=X'D5' %THEN DUMP END(ADR) %ANDRETURN
 CHECK("UNRECOGNISED RECORD TYPE")
%END
!
!
!
%EXTERNALROUTINE IBMDUMP(%STRING(255) PARM)
 %STRING(31) INFILE,LIST
 %RECORD(RR) FINFO
 %INTEGER FLAG,LNTH,NEXT
!
!
!
 SETPAR(PARM)
 INFILE=SPAR(1)
 LIST=SPAR(2)
 %IF LIST="" %THEN LIST=".OUT"
 LAST="   ";INLINE=0
 DEFINE("1,".LIST)
 SELECTOUTPUT(1)
 %IF LIST=".OUT" %THEN END TXT=200 %ELSE END TXT=10000000
 NEWLINE
 PRINTSTRING("Analysis of IBM object module")
 NEWLINE
 PRINTSTRING("Parameters passed:".PARM);NEWLINES(2)
 CONNECT(INFILE,0,0,0,FINFO,FLAG)
 %IF FLAG#0 %THENSTART
      SELECTOUTPUT(0)
      PSYSMES(8,FLAG)
      %RETURN
 %FINISH
 ICONAD = FINFO_CONAD
 LNTH=INTEGER(ICONAD)
 NEXT=INTEGER(ICONAD+4)
 %WHILE NEXT+80<=LNTH %CYCLE
      DUMP REC(ICONAD+NEXT)
      NEXT = NEXT + 80
 %REPEAT
 CHECK("EOF")
 SELECT OUTPUT(0)
 CLOSESTREAM(1)
%END
%ENDOFFILE