PROGRAM LINK86 (TTY);
 
(****************************************************************************
	LINK TOGETHER SEPARATELY ASSEMBLED 8086 OBJECT MODULES
 
	AUTHOR:	THOMAS J. MATHIEU
		BATTELLE NORTHWEST, RICHLAND, WASH.
		509-946-3711
 
	PREPARED FOR THE UNITED STATES DEPT OF ENERGY UNDER CONTRACT
			EY-76-C-06-1830
 
	VERSION	DATE	DESCRIPTION
	------- ----	-----------------------------------------------------
	V1.0	4/79	LINK OBJECT MODULES, NO LIBRARY, NO RESIDENT CODE.
 
 ******************************************************************************)
 
CONST	NAMELEN=6;  LINKID = 'INTEL 8086 LINKER  V1.0';
	FNMLN=12;   COM=';';
 
 
TYPE	NAME = ARRAY [ 1..NAMELEN ] OF CHAR;
 
	FNM  = ARRAY [ 1..FNMLN   ] OF CHAR;
 
	SYMPTR = ^SYMBOL;
 
	SYMBOL = RECORD		(**  GLOBAL SYMBOLS  **)
		SNAME : NAME;
		SVAL  : INTEGER;
		SNXT  : SYMPTR;
		CASE CSEG:BOOLEAN OF
		  FALSE: (SSEG:SYMPTR); 
		  TRUE : (XFST:INTEGER)
		END;
 
	XTLS   = ARRAY [1..20] OF CHAR;
 
	ADDR   = ARRAY [1.. 4] OF CHAR;
 
 
VAR	SYMBS,SEGS : SYMPTR;
	MAP,CMD,TSK,OBJ : TEXT;
	TEMP : FILE OF XTLS;
	CMDFIL,OBJFIL,MAPFIL,TSKFIL : FNM;
	XTPENDING,FATALERR : BOOLEAN;
	IC,XCT   : INTEGER;
	IDLINK   : ARRAY [1..23] OF CHAR;
	TM,DT    : ARRAY [1..10] OF CHAR;

(***************************************************************
	  SYMBOL TABLE UTILILTY PROCEDURES
 ***************************************************************)
 
PROCEDURE ENTERSYMB(S,L : SYMPTR);
   (* ENTER SYMBOL POINTED AT BY S INTO SYMBOL TABLE AFTER SYMBOL
      POINTED AT BY L.		*)
   BEGIN
   IF L = NIL THEN
      BEGIN
      S^.SNXT := SYMBS;  SYMBS := S
      END
   ELSE BEGIN
      S^.SNXT := L^.SNXT;  L^.SNXT := S
      END;
   END;  (*  OF ENTERSYMB  *)
 
 
PROCEDURE FINDSYMB (S:NAME; VAR L:SYMPTR; VAR B:BOOLEAN);
   (*  SEARCH SYMBOL TABLE FOR SYMBOL NAMED S.
       RETURN 1. (B=TRUE, L POINTS AT SYMBOL) IF SYMBOL IN TABLE.
	      2. (B=FALSE, L POINTS AT SYMBOL S GOES AFTER) IF SYMBOL NOT IN TABLE.  *)
   VAR S1:SYMPTR;
   BEGIN
   S1 := SYMBS;  B := FALSE; L := NIL;	(* ASSUME NOT THERE *)
   IF SYMBS <> NIL THEN
    IF S >= S1^.SNAME THEN
      BEGIN  (*  FIND THE SYMBOL  *)
      REPEAT
	 L := S1;  S1 := S1^.SNXT;
	 B := (L^.SNAME = S) OR (S1 = NIL);
	 IF NOT B THEN B := S < S1^.SNAME;
	 UNTIL B;
      B := S = L^.SNAME;
      END;
   END;   (*  FINDSYMB  *)
 
 
PROCEDURE NEWSYMB(N:NAME; V:INTEGER; T:BOOLEAN; VAR S:SYMPTR);
   VAR  FND : BOOLEAN;  S1:SYMPTR;
   BEGIN  (***   CREATE NEW SYMBOL ENTRY   ***)
   FINDSYMB(N,S1,FND);
   IF FND THEN BEGIN WRITELN(MAP,'      DUPL SYMBOL -- ',N);
		FATALERR := TRUE;
		END
	   ELSE BEGIN
		NEW(S);
		WITH S^ DO
		   BEGIN
		   SNAME := N; SVAL := V;  CSEG := T;  SNXT := NIL
		   END;
		ENTERSYMB(S,S1);
		END
   END;

(*****************************************************************
			HEX I/O UTILITIES
 *****************************************************************)
 
FUNCTION INT (C:CHAR) : INTEGER;
 
   BEGIN
   IF C = ' ' THEN INT := 0  (** LEADING BLANKS ARE ZERO  **)
   ELSE IF C >= 'A' THEN INT := ORD(C) - ORD('A') + 10
   		    ELSE INT := ORD(C) - ORD('0')
   END;
 
 
FUNCTION HEX (V:INTEGER) : CHAR;
 
   BEGIN
   IF V >  9 THEN HEX := CHR( V + ORD('A') - 10)
	     ELSE HEX := CHR( V + ORD('0'))
   END;
 
 
PROCEDURE INHEX (VAR V : INTEGER;  W : ADDR);
 
   VAR I:INTEGER;  NEG:BOOLEAN;
 
   BEGIN
   NEG := W[1] IN ['8','9','A'..'F'];
   IF NEG THEN V := INT(W[1]) - 8
	  ELSE V := INT(W[1]);
   FOR I := 2 TO 4 DO V := V*16 + INT(W[I]);
   IF NEG THEN V := -(MAXINT-V) - 1;
   END;
 
 
PROCEDURE OUTHEX (V : INTEGER; VAR W : ADDR);
 
   VAR I,J:INTEGER;  NEG:BOOLEAN;
 
   BEGIN
   NEG := V < 0;
   IF NEG THEN V := -V - 1;
   FOR I := 4 DOWNTO 1 DO
      BEGIN
      J := V MOD 16;  V := V DIV 16;
      IF NEG THEN J := 15-J;
      W[I] := HEX(J);
      END
   END;

(**********************************************************
		INITIALIZATION
 **********************************************************)
 
PROCEDURE INIT;
   TYPE	EXTENSION = ARRAY[0..3] OF CHAR;
   VAR	I,J:INTEGER;   
 
   PROCEDURE SETFILE(VAR F:FNM; E:EXTENSION);
      VAR I : INTEGER;
      BEGIN
      FOR I := 1 TO FNMLN DO F[I] := CMDFIL[I];
      FOR I := J TO J+3   DO F[I] := E[I-J];
      END;
 
   BEGIN
   WRITELN(LINKID);
   WRITE('ENTER COMMAND FILE NAME > ');  BREAK; READLN;
   READ (CMDFIL);
   J := 1;
   WHILE (J<FNMLN) AND (CMDFIL[J] <> '.') DO J := SUCC(J);
   IF CMDFIL[J] <> '.' THEN
      BEGIN
      I := 12;
      WHILE (I>1) AND (CMDFIL[I-1]=' ') DO I := PRED(I);
      J := I;
      IF I < FNMLN-2 THEN SETFILE(CMDFIL,'.CMD');
      END;
   IF J > FNMLN-3 THEN J := FNMLN-3;
   SETFILE(MAPFIL,'.MAP');
   SETFILE(TSKFIL,'.TSK');
   IC := 0;
   FATALERR := FALSE;
   SYMBS := NIL;
   IDLINK := LINKID;
   END;

PROCEDURE SETIC;	(***   SET NEW INSTRUCTION COUNTER VALUE   ***)
   VAR TIC : INTEGER;  W,WW:ADDR;  C:CHAR;
   BEGIN
   READLN (CMD,C,W);  INHEX(TIC,W);
   WRITELN(MAP);
   WRITELN(MAP,'    IC CHANGE TO ',W);
   OUTHEX(IC,WW);
   IF W > WW THEN IC := TIC
   ELSE
     BEGIN
     WRITELN(MAP,'      IC VALUE ERROR -- LESS THAN ',WW);
     FATALERR := TRUE;
     END;
   END;
 
 
 

PROCEDURE PROC1OBJ;	(***  PHASE ONE OBJ FILE PROCESSING  ***)
   VAR	CH : CHAR;  I,J,LEN : INTEGER;  XT,XTP : XTLS;
	G,S : SYMPTR;  SNM,NM : NAME;
   BEGIN
   READLN(CMD,CH,OBJFIL);
   WRITELN(MAP); WRITELN(MAP,'    OBJECT FILE REQUEST ',OBJFIL);
   RESET (OBJ,OBJFIL);
   IF IORESULT(OBJ) <> 1 THEN 
      BEGIN
      WRITELN(MAP,'      OBJ FILE NOT FOUND');  FATALERR := TRUE;
      END
   ELSE
   LOOP		(***  PROCESS EACH SEGMENT IN OBJ FILE  ***)
   IF NOT EOF(OBJ) THEN READLN(OBJ,CH,LEN,SNM);
   EXIT IF EOF(OBJ) OR (CH <> 'S');
   NEWSYMB(SNM,IC,TRUE,G);
   G^.XFST := XCT;    LEN := (LEN+15) DIV 16;
   IF IC >= 0 THEN
      IF MAXINT - LEN <= IC THEN IC := LEN - (MAXINT-IC) + MININT
			    ELSE IC := LEN + IC
   ELSE
      IF IC + LEN <= 0 THEN IC := IC + LEN
      ELSE
	BEGIN  (**  MEMORY OVERFLOW  **)
	WRITELN(MAP,'     *** MEMORY OVERFLOW ***');  FATALERR := TRUE
	END;
 
   LOOP		(***   ENTER GLOBAL SYMBOLS   ***)
      READ(OBJ,CH);
      EXIT IF CH <> 'G';
      READLN(OBJ,I,NM);  NEWSYMB(NM,I,FALSE,S);  S^.SSEG := G;
      END;
 
   READLN(OBJ);
   IF CH <> 'T' THEN 
      BEGIN
      IF CH='X' THEN BEGIN FATALERR := TRUE; WRITE(MAP,'      *** ERROR ') END
		ELSE WRITE(MAP,'      *** WARNING ');
      WRITELN(MAP,'-- NO CODE TEXT IN SEGMENT *** ',SNM);
      XT := '                    ';  XT[1] := CH;
      WHILE (XT[1]<>'E') AND NOT EOF(OBJ) DO READLN(OBJ,XT);
      END
   ELSE
      REPEAT		(**  SKIP TEXT CARDS FOR NOW  **)
	READLN(OBJ,XT)
	UNTIL (XT[1] <> 'T') OR EOF(OBJ);
   
   XTP := '                    ';
   WHILE NOT EOF(OBJ) AND (XT[1] = 'X') DO	(**  COPY XTERNALS  **)
      BEGIN
      IF XT<XTP THEN BEGIN TEMP^:= XT; PUT(TEMP,XCT-1); XT := XTP END;
      TEMP^:=XT;  PUT(TEMP,XCT);  XCT:=SUCC(XCT);  XTP:=XT;  READLN(OBJ,XT);
      END;
 
   TEMP^ := XT;  PUT(TEMP,XCT);  XCT := SUCC(XCT);  	(**  INDICATE LAST ONE  **)
   END; END;

(********************************************************************
			PHASE TWO UTILITIES
 ********************************************************************)
 
PROCEDURE SUBHEXCHAR (VAR C : CHAR; C1 : CHAR; VAR BORROW:INTEGER);
 
   VAR I : INTEGER;
  
   BEGIN
   I := INT(C) - INT(C1) - BORROW;
   IF I < 0 THEN BEGIN BORROW := 1; I := I + 16 END
	    ELSE BORROW := 0;
   C := HEX(I)
   END;
 
 
PROCEDURE ADDHEXCHAR (VAR C : CHAR;  C1 : CHAR;  VAR CARRY:INTEGER);
 
   VAR I : INTEGER;
 
   BEGIN
   I := INT(C) + INT(C1) + CARRY;
   IF I > 15 THEN BEGIN I := I - 16;  CARRY := 1 END
	     ELSE CARRY := 0;
   C := HEX(I);
   END;
 
 
PROCEDURE NEXTXT (VAR IXT,ADDR:INTEGER; VAR XSW,XPM:CHAR;  VAR N:NAME);
 
   VAR	I:INTEGER;
 
   BEGIN
   ADDR := 0;
   GET(TEMP,IXT);  IXT := SUCC(IXT);
   XTPENDING := TEMP^[1] = 'X';
 
   IF XTPENDING THEN
      BEGIN
      FOR I := 3 TO 8 DO  ADDR := ADDR*10 + INT(TEMP^[I]);
      FOR I := 1 TO NAMELEN DO N[I] := TEMP^[I+9];
      XSW := TEMP^[19];
      XPM := TEMP^[17];
      END
   END;

PROCEDURE PROC2OBJ;	(***  PHASE TWO OBJ FILE PROCESSING  ***)
 
   VAR	I,ICB,LEN,IXL,XADR:INTEGER;  C,C1,XSW,XPM:CHAR;   XNM,NM:NAME;  
	S:SYMPTR;  FND:BOOLEAN;  W:ADDR;
 
   BEGIN
   READLN(CMD,C,OBJFIL);
   RESET (OBJ,OBJFIL);
   
   WRITELN(MAP);  WRITELN(MAP,'    SEGMENTS FROM ',OBJFIL);
   WRITELN(MAP,'SEGMENT':12,'SEGMENT':9,'GLOBAL':8,'SYMBOL':7);
   WRITELN(MAP,  'NAME ':12,'ADDRESS':9,'SYMBOL':8,'OFFSET':7);
   WRITELN(MAP,'-------':12,'-------':9,'------':8,'------':7);
 
   LOOP  (**  PROCESS EACH SEGMENT  **)
      IF NOT EOF(OBJ) THEN READLN(OBJ,C,LEN,NM);
      EXIT IF EOF(OBJ) OR (C <> 'S');
  
      FINDSYMB(NM,S,FND);
      OUTHEX(S^.SVAL,W);
      WRITELN(MAP,NM:NAMELEN+6,W:7,'0');
      IXL := S^.XFST;
      NEXTXT(IXL,XADR,XSW,XPM,XNM);
 
      LOOP  (**  SKIP GLOBALS  **)
	READ(OBJ,C);
	EXIT IF C <> 'G';
	READLN(OBJ,I,NM);  OUTHEX(I,W);
	WRITELN(MAP,NM:NAMELEN+23,W:6);
	END;
 
      WHILE C = 'T' DO
	BEGIN
	READ(OBJ,I);
	WRITE(TSK,'T ',I+IC:6,' ');
	WHILE NOT EOLN(OBJ) DO
	   BEGIN
	   READ(OBJ,C,C1);
	   IF (I=XADR) AND (C<>'Z') AND XTPENDING THEN
	      BEGIN
	      FINDSYMB(XNM,S,FND);
	      IF NOT FND THEN WRITELN(MAP,XNM:NAMELEN+23,'  *** UNDEFINED EXTERNAL REFERENCE *** ')
		ELSE BEGIN
		OUTHEX(S^.SVAL,W);
		IF S^.CSEG AND (XSW<>'S') THEN
			WRITELN(MAP,XNM:NAMELEN+23,'  *** SYMBOL USAGE ERROR *** ',XSW:3);
		ICB := 0;
		CASE XPM OF 
		   '+' : BEGIN
		         ADDHEXCHAR(C1,W[4],ICB);
		   	 ADDHEXCHAR(C ,W[3],ICB);
			 END;
		   '-' : BEGIN
			 SUBHEXCHAR(C1,W[4],ICB);
			 SUBHEXCHAR(C ,W[3],ICB);
			 END
		   END;
		WRITE(TSK,C,C1);  READ(OBJ,C,C1);
		IF (C='Z') THEN   (***  END OF LINE  ***)
		   BEGIN
		   WRITELN(TSK,C,C1);  READLN(OBJ);
		   READ(OBJ,C,I);
		   IF (C<>'T') THEN WRITELN(MAP,'        *** TEXT ERROR ***');
		   WRITE(TSK,'T ',I+IC:6,' ');
		   READ(OBJ,C,C1);
		   I := PRED(I);
		   END;
		CASE XPM OF
		   '+' : BEGIN
			 ADDHEXCHAR(C1,W[2],ICB);
			 ADDHEXCHAR(C ,W[1],ICB);
			 END;
		   '-' : BEGIN
			 SUBHEXCHAR(C1,W[2],ICB);
			 SUBHEXCHAR(C ,W[1],ICB);
			 END
		   END;
		I := SUCC(I);
		END;
	     NEXTXT(IXL,XADR,XSW,XPM,XNM);
	     END;
	   I := SUCC(I);
	   WRITE(TSK,C,C1);
	   END;
	READLN(OBJ);  WRITELN(TSK);
	READ(OBJ,C);
	END;
 
      WHILE C <> 'E' DO
	BEGIN
	READLN(OBJ);   READ(OBJ,C);
	END;
 
      IC := IC + ((LEN+15) DIV 16) * 16;
      READLN(OBJ);
      END;  (**  OF MAIN LOOP  **)
   END;

PROCEDURE PHASEONE;
   VAR	CMD1 : CHAR;
 
   PROCEDURE HUH (C:CHAR; T:BOOLEAN);	(**  UNHANDLABLE COMMAND  **)
      VAR TXT : ARRAY [1..20] OF CHAR;
      BEGIN
      WRITELN(MAP);  READLN(CMD,TXT);
      IF T THEN WRITE(MAP,'    FEATURE NOT IMPLEMENTED YET -- ')
	   ELSE WRITE(MAP,'    UNKNOWN COMMAND -- ');
      WRITELN(MAP,C,TXT);
      FATALERR := TRUE;
      END;
 
   BEGIN
   TIME(TM);  DATE(DT);
   RESET (CMD,CMDFIL);
   IF IORESULT(CMD) <> 1 THEN
      BEGIN
      WRITELN('FILE ',CMDFIL,' NOT FOUND');
      FATALERR := TRUE;
      END
   ELSE
   BEGIN
   REWRITE(MAP,MAPFIL);  REWRITE(TEMP,'LNK.TMP',,,[TEMPORARY,RANDOM]);
   XCT := 1;
   WRITELN(MAP,IDLINK,DT:15,TM:15,TSKFIL:FNMLN+5);
   WRITELN(MAP);  WRITELN(MAP);
   WRITELN(MAP,'PHASE ONE DIAGNOSTICS :');
   WHILE NOT EOF(CMD) DO
      BEGIN
      READ(CMD,CMD1);
      CASE CMD1 OF 
	COM : READLN(CMD);	(**  COMMENT -- IGNORE IT	**)
	'A' : SETIC;		(**  SET INSTRUCTION COUNTER	**)
	'O' : PROC1OBJ;		(**  PROCESS OBJ FILE		**)
	'L' : HUH(CMD1,TRUE);	(**  PROCESS LIBRARY FILE	**)
	'R' : HUH(CMD1,TRUE);	(**  PROCESS RESIDENT FILE	**)
	'S' : HUH(CMD1,TRUE);	(**  START -- IGNORE PHASE ONE  **)
	OTHERS : HUH(CMD1,FALSE)
	END;
     END;
   END;
   END;

PROCEDURE PHASETWO;
  
   VAR	CMD1 : CHAR;  W:ADDR;  I:INTEGER;
 
  BEGIN
  RESET(CMD,CMDFIL);
  REWRITE(TSK,TSKFIL);
  PAGE(MAP); 
  WRITELN(MAP,IDLINK,DT:15,TM:15,TSKFIL:FNMLN+5);
  WRITELN(MAP);  WRITELN(MAP);
  WRITELN(MAP,'PHASE TWO -- LOAD MAP');
  WHILE NOT EOF(CMD) DO
     BEGIN
     READ(CMD,CMD1);
     CASE CMD1 OF
	COM : READLN(CMD);	(**  COMMENT			**)
	'A' : BEGIN		(**  CHANGE OF ADDRESS		**)
	      READLN(CMD,CMD1,W);  INHEX(I,W);
	      IC := 0;  WRITELN(TSK,'A ',I:6);
	      END;
	'O' : PROC2OBJ;		(**  PROCESS OBJECT FILE	**)
	'L' :			(**  PROCESS LIBRARY FILE	**)
	END; 
     END;
   END;

BEGIN 	(**  MAIN LINE  **)
INIT;
PHASEONE;
IF FATALERR THEN WRITELN('PHASE TWO NOT RUN DUE TO ERROR')
ELSE PHASETWO;
END.