GET "AHDR"

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

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

LET DUMPINIT() BE
$(
  HUNKINIT()
$)

AND HUNKINIT() BE
$(

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

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)
            IF myrelc>rvsize DO
            $( writes("*NNot enough reloc space*N")
               tidy.and.finish(19)
            $)
            RELVECC!MYRELC := RELADR
            MYRELC := MYRELC + 1
            DUMPWORD := 0
         $)
         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)
         $)
      $)
$)

AND TXTO(X1, X2) BE
$( UNTIL CURADR=X2 DO
   $( checkcnt()
      putbyte(codevec, curadr, 0)
      CURADR := CURADR + 1
      DUMPCNT := DUMPCNT + 1
   $)

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


AND checkcnt() BE
   IF cdsize*bytesperword-dumpcnt < 0 DO
   $( writes("*NNot enough code space for pusher*N")
      tidy.and.finish(20)
   $)


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
   TEST outcount=1 DO
    $( outcount := 0
      wr16((n<<8)|savb)
   $)
   OR
   $( outcount := 1
      savb := n
   $)

AND WR16(N) BE writewords(@n, 1)


AND tidy.and.finish(n) BE
$( endwrite()    // list
   selectoutput(binout)
   endwrite()
   selectoutput(errstr)
   endwrite()
   selectinput(assfilestr)
   endread()
   stop(n)
$)


AND writetolog(s) BE
$( LET a = output()
   selectoutput(termstr)
   writes(s); newline()
   selectoutput(a)
$)


AND date() = ""
.