SECTION "LDR"
GET "NLIBHDR"  // STANDARD LIB HEADER
// THIS FILE SHOULD BECOME THE INSERT FILE "AHDR"
GET "AHDR"
STATIC $(
   BWORD=4; BSHIFT=32
   BCHSUM=0
   CSECTNUMBER=0
   COMMTOP=0; INTOP=0;EXTTOP=0
   WORDP1=0;WORDF=0
   CURADR=0; OLDADR=0
   RELID=0;RELADR=0
   EXTID=0;EXTADR=0
$)

MANIFEST $(
   S.SD=0
   S.LD=1
   S.ER=2
   S.PC=4
   S.CM=5
   S.PR=6
   S.WX=10
$)

LET DUMPINIT() BE $(
   LET NEXT=0 AND N=1 AND ECNT=0 AND A=OUTPUT()
   AND UNPACKV=VEC 32 AND VN = VEC 32
//**   DEBUG(" START OF DUMPINIT ECNT =%N*N*N",ECNT)
   SELECTOUTPUT(BINOUT)
   UNPACKSTRING(PGM,UNPACKV)
   FOR I=1 TO UNPACKV!0 DO PUTBYTE(VN,I,UNPACKV!I)
   ECNT:=ECNT+1
   ESD(S.SD,ECNT,VN*BYTESPERWORD,UNPACKV!0,0)
   ECNT:=ECNT+1

   UNTIL COMMONS=0 DO $(
      LET A=SNAME!(1!COMMONS)
      AND T=1!COMMONS
      LET L=GETBYTE(0,A)
//**      DEBUG(" IN COMMON LOOP COMMONS = %X8*N",COMMONS)
      ESD(S.CM,(!(NAMEP!T)&#X3FF)+1,A,L,0)
      ECNT:=ECNT+1
      COMMONS:=!COMMONS
   $)
   COMMTOP:=ECNT

   UNTIL INTERNALS=0 DO $(
      LET A=SNAME!(1!INTERNALS)
      AND T=1!INTERNALS
      LET L=GETBYTE(0,A)
//**      DEBUG(" IN INTERNALS , INTERNALS =%X8*N",INTERNALS)
      ESD(S.LD,0,A,L,1!(NAMEP!T))
      INTERNALS:=!INTERNALS
   $)
   INTOP:=ECNT-1

   UNTIL EXTERNALS=0 DO $(
      LET A=SNAME!(1!EXTERNALS)
      AND T=1!EXTERNALS
      LET L=GETBYTE(0,A)
//**      DEBUG(" IN EXTERNALS, EXTERNALS =%X8*N",EXTERNALS)
      ESD(S.ER,INTOP+(!(NAMEP!T)&#X3FF),A,L,0)
      ECNT:=ECNT+1
      EXTERNALS:=!EXTERNALS
  $)
   EXTTOP:=ECNT
   SELECTOUTPUT(A)
   DUMPCNT,DUMPWORD,DUMPSTATE:=0,0,0
$)

AND ESD(X,ESDID,NAMP,NAMN,ADDR) BE $(
   LET Y=0
//**   DEBUG(" ESD CALL X=%N, Y=%N, NAMP=%X8, NAMN=%N, ADDR=%X4*N",
//**           X,ESDID,NAMP,NAMN,ADDR)
   WRBYTE(#X02)
   WRITES("ESD      ")
   WR8(16)
   WRITES("  ")
   TEST X=S.LD THEN WRITES("  ") ELSE WR8(ESDID)
   NAMN:=NAMN>8->8,NAMN
   FOR I=1 TO NAMN DO WRBYTE(GETBYTE(0,NAMP+I))
   FOR I= NAMN+1 TO 8 DO WRBYTE(' ')
   WRBYTE(X)
   WR16(ADDR)
   WRBYTE(' ')
   IF X=S.LD THEN Y:=1
   IF X=S.ER THEN Y:=#X404040
   WR16(Y)
   NEWLINE()
$)
AND WR8(X) BE $(
   WRBYTE((X>>8)&#XFF)
   WRBYTE(X&#XFF)
$)
AND WR16(X) BE $(
   WRBYTE((X>>16)&#XFF)
   WRBYTE((X>>8)&#XFF)
   WRBYTE(X&#XFF)
$)
AND DEBUG(X,X1,X2,X3,X4,X5,X6,X7,X8,X9) BE $(
   LET A=OUTPUT()
   SELECTOUTPUT(ERRSTR)
   WRITEF(X,X1,X2,X3,X4,X5,X6,X7,X8,X9)
   SELECTOUTPUT(A)

$)

AND WRBYTE(X) BE BINWRCH(X)
AND RLD(ID,ADR) BE $(
//**   DEBUG(" IN RLD ID= %N, ADR =%X8*N",ID,ADR)
   WRBYTE(#X02)
   WRITES("RLD      ")
   WR8(8)
   WRITES("    ")
   WR8(ID)
   WR8(1)
   WRBYTE(8)
   WR16(ADR-1)
   NEWLINE()
$)
AND TXT(V,N,A) BE $(
//**   DEBUG(" IN TEXT V=%X8, N=%N , ADDR =%X8*N",V,N,A)
   WRBYTE(#X02)
   WRITES("TXT ")
   WR16(A)
   WRITES("  ")
   WR8(N)
   WRITES("  ")
   WR8(1)
   FOR I=1 TO N DO WRBYTE(V!I)
   NEWLINE()
$)
AND TXTO(V0,V1) BE $(
   IF (DUMPCNT>=54) LOGOR(CURADR~=V1) THEN $(
      IF DUMPCNT>0 THEN TXT(VX,DUMPCNT-1,OLDADR)
      DUMPCNT:=1
     CURADR:=V1
      OLDADR:=V1
      $)
   VX!DUMPCNT:=V0
   CURADR:=CURADR+1
   DUMPCNT:=DUMPCNT+1
$)

AND FORCETXT() BE $(
   IF DUMPCNT>0 THEN TXT(VX,DUMPCNT-1,OLDADR)
   DUMPCNT:=0
       CURADR:=-1
$)

AND DUMP(TYPE,V0,V1,V2,V3,V4) BE $(
   LET A=OUTPUT()
DEBUG(" DUMP ENTRY TYPE =%N, V0 =%X4, V1=%X4*N",TYPE,V0,V1)
   SELECTOUTPUT(BINOUT)
   SWITCHON TYPE&#XFC00 INTO $(
CASE T.ABS:
   IF DUMPCNT=0 THEN $(
      OLDADR:=V1
      CURADR:=V1
      DUMPCNT:=1
   $)
   TXTO(V0,V1)
   ENDCASE
CASE T.REL:
   TEST DUMPWORD=0 THEN $(
      RELADR:=V1
      RELID:=1
      TXTO(V0,V1)
      DUMPWORD:=1
   $) ELSE $(
      TXTO(V0,V1)
      FORCETXT()
      RLD(RELID,RELADR)
      DUMPWORD:=0
   $)
   ENDCASE
CASE T.COMMON:
CASE T.EXT:
   TEST DUMPWORD= 0 THEN $(
      EXTID:=(TYPE&#XFC00)=T.EXT->INTOP,0
      EXTID:=EXTID+(TYPE&#X3FF)
      EXTADR:=V1
      DUMPWORD:=1
      TXTO(V0,V1)
   $) ELSE $(
      TXTO(V0,V1)
      FORCETXT()
      RLD(EXTID,EXTADR)
      DUMPWORD:=0
   $)
   ENDCASE

CASE T.DIR:
   SWITCHON TYPE&#X3FF INTO $(
   CASE D.ORG: ENDCASE
   CASE D.RES:
   FOR I=0 TO V0-1 DO TXTO(V1,P.LOC+I)
   ENDCASE
   CASE D.END:
      IF DUMPCNT >0 THEN TXT(VX,DUMPCNT-1,OLDADR)
      WRBYTE(#X02)
      WRITES("END                        ")
      DUMPCNT:=(CNT=RELC)->TOPRELCNT,TOPABSCNT
      WRBYTE(0)
      WR16(DUMPCNT)
      WRITES("     ")
      NEWLINE()
   $)
$)

   SELECTOUTPUT(A)
$)
.