/* Modified August 1980 to put code in separate segment */
    /* Improved June 1981 so that size of memory and start
       of code segment may be specified by CODE and CODESIZE */
    /* Modified August 1981 for big code area system, code
       area now limited to 64k words though this could be increased
       with more changes. Code block list size fields are now
       two words wide. When words in data part are being relocated and
       they point to the code part now assume that following word is
       segment part of descriptor and fill this in as well.
    */

SECTION "SYSLINK"
NEEDS "USINGCMS"     // UUUUUUUUUUUUUUUUUUUUUUUUUU
NEEDS "DECODER"

GET "NLIBHDR"
GET "CODEHDR"
GET "SYSLHDR"

LET START() BE
 $( LET V = VEC 63
    LET s = VEC 20
//    LET W = VEC 5000                         //!!!
    USINGCMS(0)                // UUUUUUUUUUUUUUUUUUU
    OWRITED := WRITED
    WRITED := NWRITED
  //  VERSTREAM := OUTPUT()
      VERSTREAM := FINDOUTPUT("SYSTERM")   // UUUUUUUUUUUUUUUUU
    MAPSTREAM := 0
    INSTREAM := 0
    OUTSTREAM := 0
    outstream.code := 0
    writewcount := 0; writewcount.code := 0
    WORKV := 0
    $(
       LET i = 0
       LET ch = ?
      selectinput(findparm())
      ch := rdch()
      WHILE ch=' ' DO ch := rdch()
      s%1:='('; FOR j=2 TO 8 DO s%j := ' '
      i := 8

      UNTIL ch=endstreamch | i=80 | ch='*N' DO
      $( i := i+1
         s%i := ch
         ch := rdch()
      $)
      s%0 := i
      writes(s);newline()
    $)
    WRITES("TRIPOS system linker - 8086 gigantic version*N")
     IF rdargs(v, 63, s, "FROM/A,DATA/A,MAP/K,OPT/K,CODE/A")=0 DO
        ERROR("Bad args")
//    INITINPUT(0)                             //!!!
//    INITOUTPUT(".MAP")                       //!!!
    usingcms("SYSLINK")
    INSTREAM := FINDINPUT(V!0)
    IF INSTREAM=0 DO
       ERROR("Can*'t open FROM %S", V!0)
    UNLESS V!2=0 DO
    $( usingcms("MAP")
       MAPSTREAM := FINDOUTPUT(V!2)
       IF MAPSTREAM=0 DO
          ERROR("Can*'t open MAP %S", V!2)
    $)
//    INITINPUT(".BIN/DD:BF")                  //!!!
//    INITOUTPUT(".ABS/DD:B")                  //!!!
    USINGCMS("HUNK")         // UUUUUUUUUUUUUUUUUUUUUU
    OUTSTREAM := FINDOUTPUT(V!1)
    IF OUTSTREAM=0 DO
       ERROR("Can*'t open DATA %S", V!1)
    FULLMAP := FALSE
    outstream.code := findoutput(V!4)
    if outstream.code=0 do error("Can*'t open CODE %S", V!4)
    WORKSIZE := 5000
    UNLESS V!3=0 DO
    $( LET OPTS = V!3
       LET OPTN = OPTS%0
       LET I = 1
       WHILE I<=OPTN DO
       $( LET C = OPTS%I
          I := I+1
          SWITCHON CAPITALCH(C) INTO
          $( CASE 'F':
                FULLMAP := TRUE
                LOOP

             CASE 'W':
                WORKSIZE := 0
                WHILE I<=OPTN & '0'<=OPTS%I<='9' DO
                $( WORKSIZE := WORKSIZE*10+OPTS%I-'0'
                   I := I+1 $)
                LOOP
          $)
       $)
    $)
    WORKV := GETVEC(WORKSIZE)
//    WORKV := W                               //!!!
//    WORKSIZE := 5000                         //!!!
    IF WORKV=0 DO
       ERROR("Can*'t get workspace")
    WORKP := WORKV+WORKSIZE
    WRITETOMAP("TRIPOS system link map of file %S*N",V!1)
    ERRCOUNT := 0
    CHBUF := V
    memorylimit := 32         // defaults for 128Kb system
    memorylimit.code := 32
    storemax := memorylimit << 10
    storemax.code := memorylimit.code << 10
    codeseg := #X1000
    READDECLS()
    IF ERRCOUNT>0 DO ERROR("Syntax error(s)")
    SCANDECLS()
    IF ERRCOUNT>0 DO ERROR("Scan error(s)")
    LOADALL()
    WRITEF("Resident code %X4 to %X4 (%I5 words)*N",
            storetop.code, storemax.code-1,
            storemax.code-storetop.code)
    UNLESS MAPSTREAM=0 DO
    $( SELECTOUTPUT(MAPSTREAM)
       ENDWRITE() $)
    FREEVEC(WORKV)
    WRITED := OWRITED
    STOP(0)                      // UUUUUUUUUUUUUUUUUUUUUUUUU
 $)


AND READDECLS() BE
 $( LET V = VEC 50
    WORDV := V
    SEGLIST := 0
    INITSEGLIST := 0
    DCBLIST := 0
    DRIVERLIST := 0
    TASKTABSIZE := 10
    DEVTABSIZE := 10
    TASKLIST := 0
    INITTASK := 0
    DEVLIST := 0
    SELECTINPUT(INSTREAM)
    EXHAUSTED := FALSE
    FOR I = 0 TO 63 DO CHBUF!I := -1
    CHCOUNT := 0
    RCH()

    $( LET F = FALSE
       REC.P, REC.L := LEVEL(), RECLAB
 L:    RDSYMB()
       IF SYMB=S.STAR DO
       $( F := TRUE
          GOTO L $)
       IF SYMB=S.SEMICOLON GOTO RECLAB
       CHECKFOR(S.WORD)
       VAL := findarg1("SEGMENT=SEG,DCB,DRIVER,TASKTAB,*
                      *TASK,DEVTAB,DEVICE=DEV,CODE,CODESIZE",WORDV)
       SWITCHON VAL INTO
       $( CASE 0:         // SEGMENT
             ADDNAMEDLIST(F -> @INITSEGLIST,@SEGLIST)
             ENDCASE

          CASE 1:         // DCB
             ADDNAMEDLIST(@DCBLIST)
             ENDCASE

          CASE 2:         // DRIVER
             ADDNAMEDLIST(@DRIVERLIST)
             ENDCASE

          CASE 3:        // TASKTAB
             TASKTABSIZE := RDNUMB()
             RDSYMB()
             ENDCASE

          CASE 4:        // TASK
          $( LET A, N, P, S = 0, 0, 1000, 100
             N := RDNUMB()
             $( RDWORD()
                VAL := findarg1("PRIORITY=PRI,STACK,*
                               *SEGMENTS=SEGS",WORDV)
                SWITCHON VAL INTO
                $( CASE 0:        // PRIORITY
                      P := RDNUMB()
                      LOOP

                   CASE 1:        // STACK
                      S := RDNUMB()
                      LOOP

                   CASE 2:        // SEGMENTS
                      A := LIST(4, N, P, S, RDLIST())
                      BREAK


                   DEFAULT:
                      SYNERROR("Invalid task keyword")
                $)
             $) REPEAT
             APPEND(@TASKLIST, A)
             IF F DO INITTASK := A
             ENDCASE $)

          CASE 5:        // DEVTAB
             DEVTABSIZE := RDNUMB()
             RDSYMB()
             ENDCASE

          CASE 6:        // DEVICE
          $( LET A, N, B, D = 0, 0, 0, 0
             N := RDNUMB()
             $( RDSYMB()
                UNLESS SYMB=S.WORD BREAK
                VAL := findarg1("DCB,DRIVER",WORDV)
                SWITCHON VAL INTO
                $( CASE 0:        // DCB
                      B := RDNAME()
                      LOOP

                   CASE 1:        // DRIVER
                      D := RDNAME()
                      RDSYMB()
                      BREAK

                   DEFAULT:
                      SYNERROR("Invalid device keyword")
                $)
             $) REPEAT
             A := LIST(3, N, B, D)
             APPEND(@DEVLIST, A)
             ENDCASE $)

                   CASE 7:  // codeseg base (word)
                      codeseg := rdnumb() >> 3
                      memorylimit := codeseg >> 7
                      storemax := memorylimit << 10
                      rdsymb()
                      ENDCASE

                   CASE 8:
                      memorylimit.code := rdnumb() >> 10
                      storemax.code := memorylimit.code << 10
                      rdsymb()
                      ENDCASE
          DEFAULT:
             SYNERROR("Invalid keyword")
       $)
       CHECKFOR(S.SEMICOLON)
 RECLAB:
    $) REPEATUNTIL EXHAUSTED
    APPEND(@SEGLIST, INITSEGLIST)
    ENDREAD()
    INSTREAM := 0
 $)


AND ADDNAMEDLIST(LVLIST) BE
 $( LET A = LIST(3, RDNAME(), 0, 0)
    A!2 := RDLIST()
    APPEND(LVLIST, A)
 $)


AND RDLIST() = VALOF
 $( LET A = 0
    LET E = @A
    RDSYMB()
    UNLESS SYMB=S.SEMICOLON DO
    $( CHECKFOR(S.WORD)
       !E := LIST(1, NAME(WORDV))
       E := !E
       RDSYMB()
       UNLESS SYMB=S.COMMA BREAK
       RDSYMB()
    $) REPEAT
    RESULTIS A
 $)


AND RDNAME() = NAME(RDWORD())


AND RDWORD() = VALOF
 $( RDSYMB()
    CHECKFOR(S.WORD)
    RESULTIS WORDV $)


AND RDNUMB() = VALOF
 $( RDSYMB()
    CHECKFOR(S.NUMB)
    RESULTIS VAL $)


AND RDSYMB() BE
 $( LET I = 0
    TESTBREAK()
L:  SWITCHON CH INTO
    $( CASE '*S': CASE '*T': CASE '*N':
          RCH()
          GOTO L

       CASE ENDSTREAMCH:
          EXHAUSTED := TRUE
       CASE ';':
          SYMB := S.SEMICOLON
          ENDCASE

       CASE ',':
          SYMB := S.COMMA
          ENDCASE

       CASE '**':
          SYMB := S.STAR
          ENDCASE

       DEFAULT:
          IF '0'<=CH<='9' DO
          $( SYMB, VAL := S.NUMB, 0
             $( VAL := VAL*10+CH-'0'
                RCH() $) REPEATWHILE '0'<=CH<='9'
             RETURN
          $)
          SYMB := S.WORD
          $( I := I+1
             WORDV%I := CH
             RCH()
          $) REPEATUNTIL I=100 \/ CH=ENDSTREAMCH \/
                   CH='*S' \/ CH='*T' \/ CH='*N' \/
                   CH=';' \/ CH=','
          WORDV%0 := I
          RETURN
    $)
    RCH()
 $)


AND RCH() BE
 $( CH := RDCH()
    CHCOUNT := CHCOUNT+1
    CHBUF!(CHCOUNT&63) := CH
 $)


AND NAME(S) = VALOF
 $( LET SIZE = S%0/BYTESPERWORD
    LET V = NEWVEC(SIZE)
    FOR I = 0 TO SIZE DO V!I := S!I
    RESULTIS V $)


AND CHECKFOR(S) BE
    UNLESS S=SYMB DO
       SYNERROR("%S expected",
           S=S.SEMICOLON -> "*';*'",
           S=S.NUMB -> "number",
           S=S.WORD -> "word", "?" )


AND SYNERROR(F, A, B) BE
 $( WRITES("Error - ")
    WRITEF(F, A, B)
    WRITES("*NNear ... ")
    FOR I = -63 TO 0 DO
    $( LET C = CHBUF!(CHCOUNT+I & 63)
       IF C>=0 DO WRCH(C) $)
    NEWLINE()
    TESTBREAK()
    ERRCOUNT := ERRCOUNT+1
    IF ERRCOUNT>=ERRMAX DO ERROR("Too many errors")
    UNTIL SYMB=S.SEMICOLON DO RDSYMB()
    LONGJUMP(REC.P, REC.L)
 $)


AND SCANDECLS() BE
 $( LET A = 0
    CHECKDISTINCT(SEGLIST, "Segment")
    CHECKDISTINCT(DRIVERLIST, "Driver")
    CHECKDISTINCT(DCBLIST, "DCB")
    UNLESS 0<TASKTABSIZE<1000 DO
       SCANERROR("Task table size %N invalid",
                  TASKTABSIZE)
    TASKTAB := NEWVEC(TASKTABSIZE)
    FOR I = 1 TO TASKTABSIZE DO
       TASKTAB!I := 0
    TASKTAB!0 := TASKTABSIZE
    A := TASKLIST
    UNTIL A=0 DO
    $( LET N, P, L = A!1, A!2, A!4
       TEST 0<N<=TASKTABSIZE THEN
       $( UNLESS TASKTAB!N=0 DO
             SCANERROR("Task %N declared twice", N)
          TASKTAB!N := A
          UNLESS P>0 DO
             SCANERROR("Task %N invalid priority %N",
                         N, P)
          UNTIL L=0 DO
          $( LET S = LOOKUP(SEGLIST, L!1)
             IF S=0 DO
                SCANERROR("Segment %S not declared", L!1)
             L!1 := S
             L := !L
          $)
       $)
       ELSE SCANERROR("Task ID %N invalid", N)
       A := !A
    $)
    SORTLIST(@TASKLIST)
    UNLESS 0<DEVTABSIZE<1000 DO
       SCANERROR("Device table size %N invalid",
                   DEVTABSIZE)
    DEVTAB := NEWVEC(DEVTABSIZE)
    FOR I = 1 TO DEVTABSIZE DO
       DEVTAB!I := 0
    DEVTAB!0 := DEVTABSIZE
    A := DEVLIST
    UNTIL A=0 DO
    $( LET N, B, D = A!1, A!2, A!3
       TEST 1<N<=DEVTABSIZE THEN
       $( UNLESS DEVTAB!N=0 DO
             SCANERROR("Device %N declared twice", N)
          DEVTAB!N := A
          TEST B=0 THEN
             SCANERROR("Device %N has no DCB", N)
          ELSE
          $( A!2 := LOOKUP(DCBLIST, B)
             IF A!2=0 DO
                SCANERROR("DCB %S not declared", B)
          $)
          UNLESS D=0 DO
          $( A!3 := LOOKUP(DRIVERLIST, D)
             IF A!3=0 DO
                SCANERROR("Driver %S not declared", D)
          $)
       $)
       ELSE SCANERROR("Device ID %N invalid", N)
       A := !A
    $)
 $)


AND CHECKDISTINCT(LIST, STR) BE
    UNTIL LIST=0 DO
    $( UNLESS LOOKUP(!LIST, LIST!1)=0 DO
          SCANERROR("%S %S declared twice", STR, LIST!1)
       LIST := !LIST
    $)


AND LOOKUP(LIST, NAME) = VALOF
 $( IF LIST=0 RESULTIS 0
    IF COMPSTRING(LIST!1, NAME) = 0 RESULTIS LIST
    LIST := !LIST
 $) REPEAT


AND SORTLIST(LVLIST) BE
    UNTIL !LVLIST=0 DO
    $( LET MAXP, LVMAXT = 0, 0
       LET T = LVLIST
       UNTIL !T=0 DO
       $( IF (!T)!2>MAXP DO
             LVMAXT, MAXP := T, (!T)!2
          T := !T
       $)
       T := !LVMAXT
       !LVMAXT := !T
       !T := !LVLIST
       !LVLIST := T
       LVLIST := T
    $)
.
SECTION "SYSLINK2"

GET "NLIBHDR"
GET "CODEHDR"
GET "SYSLHDR"


LET SCANERROR(F, A, B) BE
 $( WRITES("Error - ")
    WRITEF(F, A, B)
    NEWLINE()
    TESTBREAK()
    ERRCOUNT := ERRCOUNT+1
    IF ERRCOUNT>=ERRMAX DO ERROR("Too many errors")
 $)


AND LOADALL() BE
 $( LET A = 0
    LET PREVIOUSTCB = 0
    ABSVEC := NEWVEC(ABSSIZE)
    ROOTVEC := ABSVEC-ABSMIN+ROOTNODE
    FOR I = 0 TO ABSSIZE DO ABSVEC!I := 0
    STOREP := STOREMAX-2
    storep.code := storemax.code-2
    REWRITE(STOREP, 0)
    rewrite.code(storep.code+1,0)
    rewrite.code(storep.code, 0)
    REFLIST := 0
    WRITETOMAP("Segments*N")
    A := SEGLIST
    UNTIL A = INITSEGLIST DO
    $( A!3 := LOADLIST(A!2)
       A := !A $)
    WRITETOMAP("*NTasks*N")
    TCBVEC := NEWVEC(TCBSIZE)
    FOR I = 0 TO TCBSIZE DO TCBVEC!I := 0
    PREVIOUSTCB := 0
    A := TASKLIST
    UNTIL A=0 DO
    $( LET N, P, S, L = A!1, A!2, A!3, A!4
       LET SL, SS, SV = L, 0, 0
       UNTIL L=0 DO
       $( SS := SS+1
          L := !L $)
       L, SV := SL, NEWVEC(SS)
       SV!0 := SS
       FOR I = 1 TO SS DO
       $( SV!I := (L!1)!3
          L := !L $)
       L := SL
       SL := LOADVEC(SV, SS)
       DISCARDVEC(SV, SS)
       FOR I = 1 TO SS DO
       $( IF (L!1)!3=0 DO GENREF(SL+I, L!1)
          L := !L $)
       TCBVEC!TCB.TASKID := N
       TCBVEC!TCB.PRI := P
       TCBVEC!TCB.STATE := STATE.DEAD
       TCBVEC!TCB.STSIZ := S
       TCBVEC!TCB.SEGLIST := SL
       L := LOADVEC(TCBVEC, TCBSIZE)
       WRITETOMAP("Task %I2 TCB %X4 seglist %X4",N,L,SL)
       TASKTAB!N := L
       TEST PREVIOUSTCB=0
         THEN ROOTVEC!RTN.TCBLIST := L
         ELSE REWRITE(PREVIOUSTCB, L)
       PREVIOUSTCB := L
       IF A=INITTASK DO ROOTVEC!RTN.CRNTASK := L
       A := !A
    $)
    TASKTAB := LOADVEC(TASKTAB, TASKTABSIZE)
    WRITETOMAP("*NTask table %X4*N", TASKTAB)
    WRITETOMAP("Device drivers*N")
    A := DRIVERLIST
    UNTIL A=0 DO
    $( A!3 := LOADLIST(A!2, 0)
       A := !A $)
    WRITETOMAP("*NDevices*N")
    A := DEVLIST
    UNTIL A=0 DO
    $( LET N, B, D = A!1, A!2, A!3
       LET D3 = D=0 -> 0, D!3
       WRITETOMAP("Device %I2", N)
       DEVTAB!N := LOADLIST(B!2)
       TEST LASTSECT=0 THEN
          DEVTAB!N := D3
       ELSE
          REWRITE(LASTSECT, D3)
       A := !A $)
    DEVTAB := LOADVEC(DEVTAB, DEVTABSIZE)
    WRITETOMAP("*NDevice table %X4", DEVTAB)
    STORETOP := STOREP
    storetop.code := storep.code
    UNLESS INITSEGLIST=0 DO
       WRITETOMAP("*NInitialisation segments*N")
    A := INITSEGLIST
    UNTIL A=0 DO
    $( A!3 := LOADLIST(A!2, 0)
       A := !A $)
    SETREFS()
    REWRITE(STOREMIN, STOREP-STOREMIN+1)
    rewrite.code(storemin.code, storep.code-storemin.code+1)
    rewrite.code(storemin.code+1,0) // ms bits of count for big system
    ROOTVEC!RTN.TASKTAB := TASKTAB
    ROOTVEC!RTN.DEVTAB := DEVTAB
    ROOTVEC!RTN.BLKLIST := STOREMIN
    rootvec!rtn.codeseg := codeseg
    rootvec!rtn.memsize := storemax.code
    rootvec!rtn.cblklist := storemin.code<<1
    rootvec!(rtn.cblklist+1) := codeseg
    LOADABSVEC(ABSMIN, ABSVEC, ABSSIZE)
    WRITETOMAP("*NAbs  store %X4 - %X4",
           ABSMIN, ABSMAX)
    WRITETOMAP("Free store %X4 - %X4 (%I5 words)",
           STOREMIN, STORETOP-1, STORETOP-STOREMIN)
    writetomap("Free store in code segment %X4 - %X4 (%I5 words)",
                 storemin.code, storetop.code-1, storetop.code-storemin.code)
    UNLESS INITTASK=0 DO
       WRITETOMAP("Initial task %N", INITTASK!1)
    SELECTOUTPUT(OUTSTREAM)
    WRITEWORD(T.END)
    ENDWRITE()
    OUTSTREAM := 0
    selectoutput(outstream.code)
    writeword(t.end)
    endwrite()
    outstream.code := 0
    SELECTOUTPUT(VERSTREAM)
 $)


AND LOADLIST(LIST) = VALOF
 $( LET FIRST = 0
    LASTSECT := 0
    UNTIL LIST=0 DO
    $( LET SEG = LOADFILE(LIST!1)
       IF FIRST=0 DO FIRST := SEG
       LIST := !LIST
    $)
    RESULTIS FIRST
 $)


AND LOADFILE(FILE) = VALOF
 $( LET FIRST, TAIL = LASTSECT, LASTSECT
    LET RELVEC, RELOC = 0, 0
    LET BASE, SIZE = 0, 0
    let dbase, dsize, drelvec, dreloc = 0, 0, 0, 0
    LET baseseg = 0
    let climit2 = 0
    LET LASTHUNK = T.END
    LET SEGTOP = STOREP-1
    let segtop.code = storep.code - 1
    INSTREAM := FINDINPUT(FILE)
    IF INSTREAM=0 DO
       ERROR("Can*'t open %S", FILE)
    IF FULLMAP DO
       WRITETOMAP("File %S", FILE)
    SELECTINPUT(INSTREAM)
    EXHAUSTED := FALSE

    $( LET TYPE = READWORD()
       IF EXHAUSTED BREAK
       SWITCHON TYPE INTO
       $( case t.relocb:
             UNLESS LASTHUNK=T.HUNK DO formerr("last not hunk",file)
          $( LET N = READWORD()
             let climit = size - dsize
             let its = ?
             climit2 := climit*2
             IF EXHAUSTED \/ dreloc=0 DO formerr("ex or dreloc=0",file)
             FOR I = 1 TO N DO
             $( let a = readword()
                LET crel = FALSE
                if exhausted DO formerr("ex reading relocs",file)
                unless 0<=a<size*2 DO formerr("reloc too big",file)

                test a>=climit2 do       // in data part
                $( a := a - climit2 + 6  // offset in drelvec
                   its := getb(drelvec, a) | (getb(drelvec, a+1) << 8)
                   test its>=climit2 do its := its - climit2 + dreloc
                                     or $( its := its + reloc
                                           crel := TRUE // refers code
                                        $)
                   putb(drelvec, a, its)
                   putb(drelvec, a+1, its>>8)

                   IF crel DO // also fill in segment
                   $( a := a+2
                      UNLESS getb(drelvec,a)=0 & getb(drelvec,a+1)=0 DO
                         formerr("seg field not zero",file)
                      putb(drelvec,a,baseseg)
                      putb(drelvec,a+1,baseseg>>8)
                   $)
                $)
                or
                $( its := getb(relvec, a) | (getb(relvec, a+1) << 8)
                   test its>=climit2 do its := its - climit2 + dreloc
                                     or its := its + reloc
                   putb(relvec, a, its)
                   putb(relvec, a+1, its>>8)
                $)
             $)
             LOOP $)

          case t.absrelocb:
             UNLESS LASTHUNK=T.ABSHUNK DO formerr("not abshunk",file)
          $( LET N = READWORD()
             IF EXHAUSTED \/ dreloc=0 DO
                formerr("ex or dreloc=0 (abs)",file)
             FOR I = 1 TO N DO
             $( LET A = READWORD()-BASE*2
                LET crel = FALSE
                IF EXHAUSTED DO formerr("ex reading abs relocs",file)
                unless 0<=a<=size*2 DO formerr("bad abs reloc",file)
                $( let its = getb(relvec,a) | (getb(relvec,a+1) << 8)
                   test its>=climit2 do its := its-climit2+dreloc
                                     or $( its := its+reloc;crel:=TRUE $)
                   putb(relvec,a,its)
                   putb(relvec,a+1,its>>8)

                   IF crel DO // also fill in segment
                   $( a := a+2
                      UNLESS getb(relvec,a)=0 & getb(relvec,a+1)=0 DO
                         formerr("seg field non zero (abs)",file)
                      putb(relvec,a,baseseg)
                      putb(relvec,a+1,baseseg>>8)
                   $)
                $)
             $)
             LOOP $)

          CASE T.HUNK: CASE T.ABSHUNK: CASE T.END:
             IF LASTHUNK=T.HUNK DO
            $( if fullmap do test (relvec!1 & #xffff)=secword &
                                  (relvec+2)%3=17 do
                 $( let s = vec 4
                    for i = 0 to 17 do s%i := atoe(getb(relvec+2, i))
                    writetomap("Section %S %X4 - %X4",
                               s, dbase+3, dbase+dsize+1)
                    unless drelvec!1=0 & drelvec!2=0 DO
                      writetomap("         code %X4 - %X4",
                                 base, base+size-dsize-1)
                 $)
                 or
                 $( writetomap("Hunk %X4 - %X4", dbase, dbase+dsize+1)
                    unless drelvec!1=0 & drelvec!2=0 DO
                                        writetomap("     code %X4 - %X4",
                                                   base, base+size-dsize-1)
                 $)
                loadvec.code(RELVEC, SIZE-dsize-1)
                DISCARDVEC(RELVEC, SIZE-dsize-1)
                loadvec(drelvec, dsize+2)
                discardvec(drelvec, dsize+2)
             $)
             IF LASTHUNK=T.ABSHUNK DO
             $( LET F = FALSE
                IF FULLMAP DO
                   WRITETOMAP("Abshunk %X4 - %X4",
                         BASE, BASE+SIZE)
                FOR I = 0 TO SIZE DO
                $( LET ABSLOC = BASE+I
                   TEST ABSLOC-ABSMIN>=0 &
                        ABSLOC-ABSMAX<=0
                   THEN
                      UNLESS RELVEC!I=0 DO
                         ABSVEC!(ABSLOC-ABSMIN):=RELVEC!I
                   ELSE
                      F := TRUE
                $)
                IF F DO LOADABSVEC(BASE, RELVEC, SIZE)
                DISCARDVEC(RELVEC, SIZE)
             $)
             LASTHUNK := TYPE
             IF TYPE=T.END DO
             $( RELOC := 0
                dreloc := 0
                LOOP $)
             IF TYPE=T.HUNK DO
             $( SIZE := READWORD()
                dsize := readword()
                IF EXHAUSTED \/ SIZE<0 DO
                    formerr("ex or size<0 reading hunk", file)
                dbase := preallocvec(dsize+2)
                dreloc := (dbase+3)*MCADDRINC
                UNLESS LASTSECT=0 DO
                   REWRITE(LASTSECT, dbase)
                IF FIRST=TAIL DO FIRST := dbase
                LASTSECT := dbase
                drelvec := newvec(dsize+2)
                drelvec!0 := 0

                test size=dsize do          // no code part
                $( drelvec!1 := 0; drelvec!2 := 0 $)
                or
                $( relvec := newvec(size-dsize-1)
                   base := preallocvec.code(size-dsize-1)
                   $( LET badd = (codeseg<<3) + base // abs wd address
                                // will only work on > 16 bit host
                      badd := badd-2 // back off to vec count
                      reloc := ((badd<<1) & #XF)+4 //offset
                      drelvec!1 := reloc
                      baseseg := badd>>3       // mc segment
                   $)
                   drelvec!2 := baseseg
                   unless abs readwords(relvec, size-dsize)=size-dsize DO
                      formerr("while reading code",file)
                $)
              if dsize>0 do
                unless abs readwords(drelvec+3, dsize)=dsize
                   DO formerr("while reading data",file)
                LOOP $)
             IF TYPE=T.ABSHUNK DO
             $( BASE := READWORD()
                IF EXHAUSTED DO formerr("ex reading abs",file)
                SIZE := READWORD()-1
                IF EXHAUSTED \/ SIZE<0 DO formerr("ex or size(abs)",file)
                RELVEC := NEWVEC(SIZE)
                UNLESS ABS READWORDS(RELVEC,SIZE+1)=SIZE+1
                   DO formerr("while reading abs",file)
                LOOP $)

          DEFAULT:
             GOTO ERR
       $)
    $) REPEAT
    UNLESS LASTHUNK=T.END DO formerr("no t.end",file)
    ENDREAD()
    INSTREAM := 0
    UNLESS FULLMAP \/ SEGTOP=STOREP-1 DO
       $( WRITETOMAP("File %S %X4 - %X4",
          FILE, LASTSECT, SEGTOP)
          unless segtop.code=storep.code-1 do
          writetomap("       code %X4 - %X4",
                     storep.code, segtop.code)
       $)
    RESULTIS FIRST

ERR:ERROR("Format error in object file %S", FILE)
 $)


AND formerr(s,f) BE
   error("Object format error - %S - in file %S", s, f)


AND PREALLOCVEC(SIZE) = VALOF
 $( LET BLKSIZE = (SIZE+1 \/ 1)+1
    RESULTIS STOREP-BLKSIZE+1 $)


and preallocvec.code(size) = valof
$( let blksize= (size+2 | 1)+1
   resultis storep.code-blksize+2
$)


and loadvec(v, size) = valof
 $( LET BLKSIZE = (SIZE+1 \/ 1)+1
    TESTBREAK()
    storep := storep-blksize
    selectoutput(outstream)
    WRITEWORD(T.ABSHUNK)
    WRITEWORD(storep)
    WRITEWORD(SIZE+2)
    WRITEWORD(BLKSIZE)
    WRITEWORDS(V, SIZE+1)
    SELECTOUTPUT(VERSTREAM)
    resultis storep+1
 $)


and loadvec.code(v, size) = valof
$( LET blksize = (size+2 | 1)+1
   testbreak()
   storep.code := storep.code-blksize
   selectoutput(outstream.code)
   writeword(t.abshunk)
   writeword(storep.code)
   writeword(size+3)
   writeword(blksize)
   writeword(0)
   writewords(v, size+1)
   selectoutput(verstream)
   resultis storep+2
$)


and loadabsvec.generic(base, v, size, g) be
 $( TESTBREAK()
    test g='C' do selectoutput(outstream.code)
    or selectoutput(outstream)
    WRITEWORD(T.ABSHUNK)
    WRITEWORD(BASE)
    WRITEWORD(SIZE+1)
    WRITEWORDS(V, SIZE+1)
    SELECTOUTPUT(VERSTREAM)
 $)


and loadabsvec(base, v, size) be loadabsvec.generic(base, v, size, 'D')


and loadabsvec.code(base, v, size) be loadabsvec.generic(base, v, size, 'C')


AND REWRITE(LOC, VAL) BE
    LOADABSVEC(LOC, @VAL, 0)


and rewrite.code(loc, val) be
    loadabsvec.code(loc, @val, 0)


AND GENREF(LOC, SEG) BE
    APPEND(@REFLIST, LIST(2, LOC, SEG))


AND SETREFS() BE
 $( LET L = REFLIST
    UNTIL L=0 DO
    $( REWRITE(L!1, (L!2)!3)
       L := !L $)
 $)


AND APPEND(LVLIST, LIST) BE
 $( UNTIL !LVLIST=0 DO LVLIST := !LVLIST
    !LVLIST := LIST $)


AND LIST(N, A,B,C,D,E) = VALOF
 $( LET P = @N
    LET V = NEWVEC(N)
    V!0 := 0
    FOR I = 1 TO N DO V!I := P!I
    RESULTIS V $)


AND NEWVEC(SIZE) = VALOF
 $( WORKP := WORKP-SIZE-1
    IF WORKP-WORKV<0 DO ERROR("Run out of workspace")
    RESULTIS WORKP
 $)


AND DISCARDVEC(V, SIZE) BE
    IF WORKP=V DO WORKP := WORKP+SIZE+1


AND TESTBREAK() BE RETURN               // UUUUUUUUUUUUUUUUUUUUUUUUU
    // IF TESTFLAGS(1) DO ERROR("BREAK")   UUUUUUUUUUU


AND ERROR(F, A, B) BE
 $( SELECTOUTPUT(VERSTREAM)
    WRITEF(F, A, B)
    WRITES(" - linking aborted*N")
    UNLESS INSTREAM=0 DO
    $( SELECTINPUT(INSTREAM)
       ENDREAD() $)
    UNLESS OUTSTREAM=0 DO
    $( SELECTOUTPUT(OUTSTREAM)
       ENDWRITE() $)
    unless outstream.code=0 do
    $( selectoutput(outstream.code)
       endwrite()
    $)
    UNLESS MAPSTREAM=0 DO
    $( SELECTOUTPUT(MAPSTREAM)
        ENDWRITE() $)
    UNLESS WORKV=0 DO FREEVEC(WORKV)
    WRITED := OWRITED
    STOP(20)
 $)


AND WRITETOMAP(F, A, B, C) BE
    UNLESS MAPSTREAM=0 DO
    $( LET O = OUTPUT()
       SELECTOUTPUT(MAPSTREAM)
       WRITEF(F, A, B, C)
       NEWLINE()
       SELECTOUTPUT(O)
    $)


AND READWORD() = VALOF
 $( LET W = 0
    UNLESS ABS READWORDS(@W, 1)=1 DO
       EXHAUSTED := TRUE
    RESULTIS W
 $)

AND READWORDS(V, N) = VALOF
$( FOR I = 0 TO N-1 DO
   $( V!I := RD16()
      IF V!I=-1 DO RESULTIS 0
   $)
   RESULTIS N
$)


AND WRITEWORD(W) BE
    WRITEWORDS(@W, 1)

  /* NEXT FOUR ROUTINES ARE INCLUDED FOR THE CROSS LINKER UUUUUU */
AND RD8() = VALOF
$( LET VAL = READX()
   IF VAL=-1 RESULTIS -1
   $( LET VAL2 = READX()
      IF VAL2=-1 RESULTIS -1
      RESULTIS VAL*16 + VAL2
   $)
$)

AND READX() = VALOF
$( LET C = ?
   C := RDCH() REPEATWHILE C='*S' | C='*N'
   IF C=ENDSTREAMCH RESULTIS -1
   RESULTIS '0'<=C<='9' -> C-'0', C-'A'+10
$)

AND RD16() = VALOF
$( LET VAL1 = RD8()
  IF VAL1=-1 RESULTIS -1
  $( LET VAL2 = RD8()
     IF VAL2=-1 RESULTIS -1
     RESULTIS (VAL2<<8) | VAL1
  $)
$)

AND WRITEWORDS(V, N) BE    /* NOT IN FINAL TRIPOS VERSION */
$( let wt = output()=outstream -> @writewcount,
                                  @writewcount.code
     FOR I = 0 TO N-1 DO
     $( IF !wt >= 16 DO
        $( NEWLINE()
           !wt := 0
        $)

        WRITEHEX(V!I, 2)
        WRITEHEX(V!I>>8, 2)
        !wt := !wt + 1
     $)
$)

AND NWRITED(N, D) BE
 $( LET NN = (N>>1)/5
    TEST NN=0 THEN
       OWRITED(N, D)
    ELSE
    $( OWRITED(NN, D-1)
       OWRITED(N-NN*10, 1)
    $)
 $)
  /* these routines added for cross linker uuuuuuu */

AND capitalch(ch) = 'a' <= ch <= 'z' -> ch + 'A' - 'a', ch


AND compch(ch1, ch2) = capitalch(ch1) - capitalch(ch2)


AND compstring(s1, s2) = VALOF
    $(
    LET lens1, lens2 = s1%0, s2%0
    LET smaller = lens1 < lens2 -> s1, s2

    FOR i = 1 TO smaller%0
    DO
        $(
        LET res = compch(s1%i, s2%i)

        UNLESS res = 0 RESULTIS res
        $)

     IF lens1 = lens2 RESULTIS 0

    RESULTIS smaller = s1 -> -1, 1
    $)


AND findarg1(keys, w) = VALOF  // =argno if found
                              // =-1 otherwise
  $( MANIFEST $( matching = 0; skipping = 1 $)

     LET state, wp, argno = matching, 0, 0

     FOR i = 1 TO keys % 0 DO
       $( LET kch = keys % i
          IF state = matching THEN
            $( IF (kch = '=' | kch= '/' | kch =',') &
                  wp = w % 0 THEN
                 RESULTIS argno
               wp := wp + 1
               UNLESS compch(kch,w % wp) = 0 THEN
                 state := skipping
            $)
          IF kch = ',' | kch = '=' THEN
            state,wp := matching,0
          IF kch=',' THEN
            argno := argno+1
       $)
     IF state = matching & wp = w % 0 THEN
       RESULTIS argno
     RESULTIS -1
  $)


and getb(v, a) = valof   // get byte from pseudo 16-bit vector
$( let aw = a/2
   let f = (a&1)=1 -> 2, 3
   resultis (v+aw)%f
$)


and putb(v, a, n) be      // put byte in pseudo 16-bit vector
$( let aw = a/2
   let f = (a&1)=1 -> 2, 3
   (v+aw)%f := n
$)


and atoe(c) =
c!TABLE  #X00,#X01,#X02,#X03,#X37,#X2D,#X2E,#X2F,
               #X16,#X05,#X25,#X0B,#X0C,#X0D,#X0E,#X0F,
               #X10,#X11,#X12,#X13,#X3C,#X3D,#X32,#X26,
               #X18,#X19,#X3F,#X27,#X1C,#X1D,#X1E,#X1F,
               #X40,#X5A,#X7F,#X7B,#X5B,#X6C,#X50,#X7D,
               #X4D,#X5D,#X5C,#X4E,#X6B,#X60,#X4B,#X61,
               #XF0,#XF1,#XF2,#XF3,#XF4,#XF5,#XF6,#XF7,
               #XF8,#XF9,#X7A,#X5E,#X4C,#X7E,#X6E,#X6F,
               #X7C,#XC1,#XC2,#XC3,#XC4,#XC5,#XC6,#XC7,
               #XC8,#XC9,#XD1,#XD2,#XD3,#XD4,#XD5,#XD6,
               #XD7,#XD8,#XD9,#XE2,#XE3,#XE4,#XE5,#XE6,
               #XE7,#XE8,#XE9,#XAD,#XE0,#XBD,#X71,#X6D,
               #X79,#X81,#X82,#X83,#X84,#X85,#X86,#X87,
               #X88,#X89,#X91,#X92,#X93,#X94,#X95,#X96,
               #X97,#X98,#X99,#XA2,#XA3,#XA4,#XA5,#XA6,
               #XA7,#XA8,#XA9,#X8B,#X4F,#X9B,#X5F,#X07,
               #X00,#X01,#X02,#X03,#X37,#X2D,#X2E,#X2F,
               #X16,#X05,#X25,#X0B,#X0C,#X0D,#X0E,#X0F,
               #X10,#X11,#X12,#X13,#X3C,#X3D,#X32,#X26,
               #X18,#X19,#X3F,#X27,#X1C,#X1D,#X1E,#X1F,
               #X40,#X5A,#X7F,#X7B,#X5B,#X6C,#X50,#X7D,
               #X4D,#X5D,#X5C,#X4E,#X6B,#X60,#X4B,#X61,
               #XF0,#XF1,#XF2,#XF3,#XF4,#XF5,#XF6,#XF7,
               #XF8,#XF9,#X7A,#X5E,#X4C,#X7E,#X6E,#X6F,
               #X7C,#XC1,#XC2,#XC3,#XC4,#XC5,#XC6,#XC7,
               #XC8,#XC9,#XD1,#XD2,#XD3,#XD4,#XD5,#XD6,
               #XD7,#XD8,#XD9,#XE2,#XE3,#XE4,#XE5,#XE6,
               #XE7,#XE8,#XE9,#XAD,#XE0,#XBD,#X71,#X6D,
               #X79,#X81,#X82,#X83,#X84,#X85,#X86,#X87,
               #X88,#X89,#X91,#X92,#X93,#X94,#X95,#X96,
               #X97,#X98,#X99,#XA2,#XA3,#XA4,#XA5,#XA6,
               #XA7,#XA8,#XA9,#X8B,#X4F,#X9B,#X5F,#X07