GET "NLIBHDR"
GET "AHDR"

MANIFEST $( T.HUNK      =    1000
            T.END       =    1002
            T.ABSHUNK   =    1003
            T.RELOCB    =    1005
            T.ABSRELOCB =    1006
         $)

STATIC $( CODEVEC=0
          OUTCOUNT=0
          RELVECC=0
          CURADR=0
          MYRELC=0
          DUMPCNT=0
          DUMPWORD=0
          RELADR=0
          ABASE=0
          RELBASE=0
          HTYPE=T.HUNK
          SEGLOC=0
          SEGGED=FALSE
       $)

LET DUMPINIT() BE
$( CODEVEC := GETVEC(4000)
   IF CODEVEC=0 DO STOP(190)
   RELVECC := GETVEC(1000)
   IF RELVECC=0 DO STOP(191)
  HUNKINIT()
$)

AND HUNKINIT() BE
$(
   UNLESS COMMONS=0 & INTERNALS=0 & EXTERNALS=0 DO
     BADLINKS()

   MYRELC, CURADR, DUMPCNT := 0, 0, 0
   DUMPWORD, RELADR := 0, 0
$)

AND BADLINKS() BE
$( SELECTOUTPUT(FINDOUTPUT(LISTFILE))
   WRITES("*NNO EXTERNALS, INTERNALS OR COMMONS ALLOWED*N")
   STOP(18)
$)

AND DUMP(TYP, V0, V1, V2, V3, V4) BE
$( SWITCHON TYP&#XFC00 INTO
   $( CASE T.ABS:
         TXTO(V0, V1)
         ENDCASE

      CASE T.REL:
         TEST DUMPWORD=0 DO
         $( RELADR := V1
            TXTO(V0, V1)
            DUMPWORD := 1
         $)
         OR
         $( TXTO(V0, V1)
            RELVECC!MYRELC := RELADR
            MYRELC := MYRELC + 1
            DUMPWORD := 0
         $)
         ENDCASE

      CASE T.COMMON:
      CASE T.EXT:
         BADLINKS()
         ENDCASE

      CASE T.DIR:
         SWITCHON TYP&#X3FF INTO
         $( CASE D.ORG:
            TEST V0=T.ABS DO $( ABASE := V1; HTYPE := T.ABSHUNK $)
                          OR $( RELBASE := CURADR ; HTYPE := T.HUNK    $)
                        ENDCASE

            CASE D.RES:
               FOR I = 0 TO V0-1 DO TXTO(V1, P.LOC+I)
               ENDCASE

            CASE D.DSEG:
               UNLESS SEGGED DO
               $( IF HTYPE=T.ABSHUNK DO
                  $( FAULT('J')
                     ENDCASE
                  $)
                  SEGGED := TRUE
                  SEGLOC := CURADR
               $)
               ENDCASE

            CASE D.END:
               WRITEHUNK(TRUE)
               FREEVEC(CODEVEC)
               FREEVEC(RELVECC)
         $)
      $)
$)

AND TXTO(X1, X2) BE
$( UNTIL CURADR=X2 DO
   $( PUTBYTE(CODEVEC, CURADR, 0)
      CURADR := CURADR + 1
      CHECK.CURADR()
      DUMPCNT := DUMPCNT + 1
   $)

   PUTBYTE(CODEVEC, CURADR, X1)
   CURADR := CURADR + 1
   CHECK.CURADR()
   DUMPCNT := DUMPCNT + 1
$)

AND WRITEHUNK(ENDQ) BE
$( LET A = OUTPUT()
   LET ABSRELCNT, I = 0, 1
   SELECTOUTPUT(BINOUT)

   UNTIL I>MYRELC DO
   $( LET N = RELVECC!(I-1)     // ADDRESS IN CODE VECTOR
      LET T = GETBYTE(CODEVEC, N)  // MS BYTE OF ITEM
      LET U = GETBYTE(CODEVEC, N+1) // LS BYTE OF ITEM
      LET VAL = (T<<8) | U

      TEST VAL>=RELBASE DO     // REFERRING TO HUNK
      $( VAL := VAL - RELBASE  // MAKE VAL OFFSET IN HUNK
         T := VAL>>8
         U := VAL&255
         IF N<RELBASE DO ABSRELCNT := ABSRELCNT+1  // ABSHUNK REFERS TO HUNK
       $)
       OR                        // REFERS TO ABSHUNK SO NO RELOCATION REQ.
       $( MYRELC := MYRELC-1     // REMOVE ITEM FROM LIST
          FOR J = I TO MYRELC DO
            RELVECC!(J-1) := RELVECC!J  // BY SHIFTING DOWN ITEMS ABOVE
          I := I-1
       $)

       PUTBYTE(CODEVEC, N, U)
       PUTBYTE(CODEVEC, N+1, T)       // BYTES NOW SWAPPED FOR 8086
       I := I+1
   $)

   UNLESS HTYPE=T.ABSHUNK DO          // UNLESS ONLY 1 ABSHUNK
   $( WR16(T.HUNK)

      $( LET RCNT = (CURADR-RELBASE+1)/2      // WORDS IN HUNK
         LET DCNT = RCNT-(SEGLOC-RELBASE)/2  // DATA WORDS
         WR16(RCNT)
         IF SEGGED DO WR16(DCNT)
         FOR I = 1 TO RCNT*2 DO
           WR8(GETBYTE(CODEVEC, RELBASE+I-1))
         UNLESS MYRELC=0 | MYRELC=ABSRELCNT DO   // MAKE T.RELOCB LIST
         $( WR16(T.RELOCB)
            WR16(MYRELC-ABSRELCNT)
            FOR I = 1 TO MYRELC DO
              IF RELVECC!(I-1)>=RELBASE DO WR16(RELVECC!(I-1)-RELBASE)
         $)
       $)
    $)

   IF RELBASE>0 | HTYPE=T.ABSHUNK DO     // IF ABSHUNK EXISTS
   $( WR16(T.ABSHUNK)
      WR16(ABASE/2)            // WORD ADDRESS OF BASE
      $( LET AAB = (ABASE/2)*2
         LET ACNT = HTYPE=T.ABSHUNK -> (CURADR-AAB+1)/2,
                                       (RELBASE-AAB+1)/2
         WR16(ACNT)

         FOR I = 0 TO ACNT*2 - 1 DO
           WR8(GETBYTE(CODEVEC, AAB+I))

         IF ABSRELCNT>0 DO      // MAKE T.ABSRELOCB LIST
         $( WR16(T.ABSRELOCB)
            WR16(ABSRELCNT)
            FOR I = 1 TO MYRELC DO
            IF RELVECC!(I-1)<RELBASE DO
               WR16(RELVECC!(I-1))
         $)
      $)
   $)

   IF ENDQ DO WR16(T.END)
   SELECTOUTPUT(A)
$)

AND WR8(N) BE
$( IF OUTCOUNT >=32 DO
   $( NEWLINE()
      OUTCOUNT := 0
   $)

   WRITEHEX(N, 2)
   OUTCOUNT := OUTCOUNT + 1
$)

AND WR16(N) BE
$( WR8(N&255)
   WR8((N>>8)&255)
$)


AND CHECK.CURADR() BE
$(
  IF CURADR>16000 DO
  $( SELECTOUTPUT(FINDOUTPUT(LISTFILE))
     WRITES("*NCODE PRODUCER HAS RUN OUT OF STORE!*N")
     ENDWRITE()
     STOP(19)
  $)
$)
.