/* 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