PROGRAM ASSEM8086 (TTY);  (*** ASSMML.PAS -- MAIN LINE AND UTILITIES  ***)
 
(*  THIS IS 8086 CROSS ASSEMBLER THAT RUNS ON PDP-11 AND GENERATES
    CODE FOR THE INTEL 8086 MICROPROCESSOR.
 
	AUTHOR:	T.J. MATHIEU.
		BATTELLE NORTHWEST, RICHLAND, WASH.
		509-946-3711
 
	prepared for the US Dept of Energy under contract
		EY-76-C-06-1830
 
	VERSION	DATE	DESCRIPTION
	------- -----	-----------
	V1.0	11/78	BASIC ASSEMBLER, NO RELOCATION, FULL EXPRESSIONS, NO MACROS.
			WITH TKB EXTTSK=4000, ROOM FOR 667. SYMBOLS.
 
	V2.0	2/79	PRIMITIVE MACROS, SEPARATE ASSEMBLY (LINKER)
	V2.1	4/79	MACRO PARAMETERS, NO NESTING.
 
*)
 
(*$R-*)
 
(*$I+ASSMHD.PAS*)
 
(***************************************************************
	  UTILILTY PROCEDURES
 ***************************************************************)
 
PROCEDURE ENTERSYMB(S,L : SYMPTR);
 
   (* ENTER SYMBOL POINTED AT BY S INTO SYMBOL TABLE AFTER SYMBOL
      POINTED AT BY L.		*)
 
   BEGIN
   NSYMBS := SUCC(NSYMBS);
   IF L = NIL
   THEN
      BEGIN
      S^.SNXT := SYMTOP;  SYMTOP := S
      END
   ELSE
      BEGIN
      S^.SNXT := L^.SNXT;  L^.SNXT := S
      END;
   END;  (*  OF ENTERSYMB  *)
 
 
PROCEDURE NEWSYMB(N:NAME; V:INTEGER; T:SYMTYP; VAR S:SYMPTR);
   BEGIN  (***   CREATE NEW SYMBOL ENTRY   ***)
   NEW(S);
   WITH S^ DO
      BEGIN
      SNAME := N;
      SVAL  := V;
      STYP  := T;
      SNXT := NIL;
      END;
   END;
 
 
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
   B := FALSE; L := NIL;		(* ASSUME NOT THERE *)
   S1 := SYMTOP;
   IF SYMTOP <> 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 ADDSYMB (N:NAME; T:SYMTYP; V:INTEGER);
   (*  ADD A NEW SYMBOL TO SYMBOL TABLE  *)
   VAR S,L:SYMPTR;  B:BOOLEAN;
   BEGIN
   NEWSYMB(N,V,T,S);
   FINDSYMB(N,L,B);
   ENTERSYMB(S,L);
   END;
 
PROCEDURE SKIPBLANKS(VAR N : INTEGER);
   BEGIN
   WITH STATEMENTS^ DO
     WHILE (STMNT[N]=' ') AND (N<STMLEN) DO N := SUCC(N)
   END;
 
PROCEDURE SETERR(CH:CHAR);
   BEGIN
   EC:=EC+1
   WITH STATEMENTS^ DO
      IF ERRCNT < 2 THEN
	 BEGIN
	 ERRCNT := SUCC(ERRCNT);
	 ERRS[ERRCNT] := CH;
	 STPRNT := TRUE;
	 END
      ELSE ERRS[2] := '*';	(***  TOO MANY ERRS IN LINE  ***)
   ERRINPROG := TRUE;
   END;
 
PROCEDURE HEXLY(N:INTEGER;   VAR W:WORD);	(**  OUTPUT HEX VALUE  **)
      VAR I,J:INTEGER;  S:BOOLEAN;
      BEGIN
      S := N<0;
      IF S THEN N := -N-1;
      FOR I:=4 DOWNTO 1 DO
	 BEGIN
	 J := N MOD 16;  N := N DIV 16;
	 IF S THEN J := 15-J;
	 IF J>=10 THEN J := J + ORD('A') - 10
		  ELSE J := J + ORD('0');
	 W[I] := CHR(J)
	 END
      END;
 
FUNCTION NEOLINE(K:INTEGER) : BOOLEAN;	(**  TRUE IF NOT END OF STATEMENT  **)
  BEGIN
  WITH STATEMENTS^ DO
   NEOLINE := (K<>STMLEN) AND (STMNT[K] <> ';')
  END;
 
PROCEDURE LOADSYMB (VAR N:INTEGER);
   (***  LOAD SYMBOL POINTED AT BY N INTO GLOBAL GSYM  ***)
   VAR J:INTEGER;
   BEGIN
   J := N;
   WITH STATEMENTS^ DO
      IF STMNT[N] = '$' THEN
	 BEGIN
	 N := SUCC(N);   GSYM[1] := '$';
         END
      ELSE
         WHILE (STMNT[N] IN LABCH) AND (N-J+1<=NAMELEN) DO
	    BEGIN
	    GSYM[N-J+1] := STMNT[N];  N := SUCC(N);
	    END;
   FOR J := N-J+1 TO NAMELEN DO GSYM[J] := ' ';
   WITH STATEMENTS^ DO
     WHILE (STMNT[N] IN LABCH) AND (N<STMLEN) DO N:=SUCC(N);
   END;
  
PROCEDURE CLOSEF (VAR F : TEXT); EXTERN;
 
FUNCTION ENDOPNDS(K:INTEGER) : BOOLEAN;
   (**  RETURNS TRUE IF KTH CHAR IN STMNT IS END OF OPERANDS  **)
   BEGIN
   WITH STATEMENTS^ DO
      ENDOPNDS := (K=STMLEN) OR (STMNT[K]<>',')
   END;
 
(*$Y+*)
PROCEDURE INITIALIZE;
 
   VAR  OP : INSTR;  FN : ARRAY[1..13] OF CHAR;
	J  : INTEGER;
 
   PROCEDURE SETOPN(OP:TWOCHAR; PREC:INTEGER);
      BEGIN
      WITH EXOPS[J] DO BEGIN OPTR:=OP; OPREC:=PREC END;
      J := SUCC(J)
      END;
 
   PROCEDURE INITTAB;  EXTERN;
 
   BEGIN
   INITTAB;		(**  SET UP OP CODE TABLE  **)
   NSYMBS := 0;		(**  ENTER DEFAULT SYMBOLS INTO SYMBOL TABLE  **)
   ADDSYMB('AX    ',REGNM,0);
   ADDSYMB('CX    ',REGNM,1);
   ADDSYMB('DX    ',REGNM,2);
   ADDSYMB('BX    ',REGNM,3);
   ADDSYMB('SP    ',REGNM,4);
   ADDSYMB('BP    ',REGNM,5);
   ADDSYMB('SI    ',REGNM,6);
   ADDSYMB('DI    ',REGNM,7);
   ADDSYMB('AL    ',REGNM,8);
   ADDSYMB('CL    ',REGNM,9);
   ADDSYMB('DL    ',REGNM,10);
   ADDSYMB('BL    ',REGNM,11);
   ADDSYMB('AH    ',REGNM,12);
   ADDSYMB('CH    ',REGNM,13);
   ADDSYMB('DH    ',REGNM,14);
   ADDSYMB('BH    ',REGNM,15);
   ADDSYMB('ES    ',REGNM,16);
   ADDSYMB('CS    ',REGNM,17);
   ADDSYMB('SS    ',REGNM,18);
   ADDSYMB('DS    ',REGNM,19);
   ADDSYMB('$     ',MEMR,0);
 
   (***  SET THE EXPR OPS AND PRECEDENCE  ***)
   J := 1;
   SETOPN('( ',0);   SETOPN(') ',0);   SETOPN('* ',7);   SETOPN('/ ',7);
   SETOPN('% ',7);   SETOPN('<-',7);   SETOPN('->',7);   SETOPN('+ ',6);
   SETOPN('- ',6);   SETOPN('= ',5);   SETOPN('< ',5);   SETOPN('<=',5);
   SETOPN('> ',5);   SETOPN('>=',5);   SETOPN('<>',5);   SETOPN('--',4);
   SETOPN('& ',3);   SETOPN('! ',2);   SETOPN('# ',2);   SETOPN('HI',1);
   SETOPN('LO',1);
 
  (***   INIT CHAR SCAN CONTROL SETS   ***)
   OP1 := ['(',')','*','/','%','<','>','-','+','=','&','!','#'];
   OP2 := ['-','>','='];
   LABCH := ['A'..'Z','0'..'9','@'];		(*  VALID SYMBOL CHARS  *)
   EXPTERM := [ ';', ',', '.', ':', '[' ];	(**  EXPRESSION TERMINATORS  **)
 
   HASSBTL := FALSE;		(**  NO SUBTITLES, YET  *)
   IFLEV := 0;
   TTL := '                              ';
   STTL := TTL;
   FIRSTSEG := TRUE;
 
   END;  (*  OF INITIALIZATION  *)
 
 
PROCEDURE OPENFILES;
 
   (*  GET AND OPEN SOURCE, OBJECT, AND LISTING FILES  *)
 
   VAR F:NAME;
 
   PROCEDURE SETFILE (VAR FN : FILENAME);
      VAR I,J : INTEGER;  FL:BOOLEAN;
      BEGIN
      I := 1;
      LOOP
	 FL := I>NAMELEN;
	 IF NOT FL THEN FL := FN.FNAME[I] = ' ';
	 EXIT IF FL;
	 TFN[I] := FN.FNAME[I];  I := SUCC(I);
	 END;
      FOR J := 1 TO NAMELEN DO  TFN[I+J-1] := FN.SUFFX[J];
      FOR J := I+NAMELEN+1 TO 2*NAMELEN DO TFN[J] := ' ';
      END;
 
   BEGIN  (* OPENFILES *)
   WRITELN(TTY,ASSMID); 
   WRITE(TTY,'FILE? '); BREAK; READLN;
   READ(F);
   WITH LFN DO BEGIN FNAME := F; SUFFX := '.LIS  '; DEV := 'SY:   ' END;
   WITH OFN DO BEGIN FNAME := F; SUFFX := '.OBJ  '; DEV := 'SY:   ' END;
   WITH SFN DO BEGIN FNAME := F; SUFFX := '.ASM  '; DEV := 'SY:   ' END;
 
   SETFILE(OFN);  REWRITE(OBJ ,TFN,,OFN.DEV);
   SETFILE(SFN);  RESET(SOURCE,TFN,,SFN.DEV);
   IF IORESULT(SOURCE) <> 1 THEN BEGIN WRITELN(TTY,'FILE NOT FOUND'); ERRINPROG:= TRUE END
      ELSE ERRINPROG := FALSE;
   SETFILE(LFN);	(**  OPEN IT AFTER PASS 1  **)
   END;
 
 
(* **)
PROCEDURE WRITEMESS;		(**  DEBUG AID  **)
   VAR I : INTEGER;
   BEGIN
   WITH STATEMENTS^ DO
     FOR I := 1 TO 20 DO WRITE(TTY,STMNT[I]);
   WRITELN(TTY,' ');
   END;		(*  *)
 
(******************************************************
	PASS ONE -- SYMBOL DEFINITION
 ******************************************************)
 
PROCEDURE PASSONE;  EXTERN;
   
(**********************************************************
	PASS TWO -- CODE GENERATION
 **********************************************************)
  
PROCEDURE PASSTWO;  EXTERN;
 
PROCEDURE EVALOPND(VAR N:INTEGER; VAR O:OPERAND); EXTERN;
 
PROCEDURE DELETF;  EXTERN;
 

(*$Y+***********************************************************
	PASS 1.5 (MIDDLE) -- SHORTEN CODE FOR FORWARD JMP/CALLS
 ***************************************************************)
PROCEDURE PASSMID;
   VAR  J,NRK,SHORTEN,SH1,K : INTEGER;  O:OPERAND;  CHG,SFND:BOOLEAN;
 
   BEGIN
   K := 0;
   REPEAT			(**  CHECK EACH CODE LINE  **)
    SHORTEN := 0;  SH1:=0;  NRK := 1;  
    WHILE NRK<=NRC DO
      BEGIN
      GET(STATEMENTS,NRK);
      CHG := FALSE;
      WITH STATEMENTS^ DO
	BEGIN
	IF (SHORTEN>0) THEN	(**  CHANGE THIS LINE'S ADDRESS  **)
	 IF (OPERATIONS[ST].OPTYP <> PSEUD) OR (ST=DB) OR (ST=DW)  OR (ST=ENDD)
					    OR (ST=DSB) OR (ST=DSW) THEN
	   BEGIN
	   ADDR := ADDR-SHORTEN;
	   IF HASLBL THEN
	      BEGIN
	      J := LABSTR;  LOADSYMB(J);  FINDSYMB(GSYM,GS,SFND);
	      GS^.SVAL := GS^.SVAL - SHORTEN;
	      END;
	   END
	 ELSE IF (ST = ORG) OR (ST = CSEG) OR (ST = DSEG)
	    THEN BEGIN SH1:=SH1+SHORTEN; SHORTEN:=0 END;
 
	IF (ST=JMP) AND (MRLN=109) AND (OPDSTR<>0) THEN  (**  IT MIGHT SHORTEN  **)
	   BEGIN
	   J := OPDSTR;  EVALOPND(J,O);
	   J := O.OPV - ADDR - 2;
	   IF (J<=128) AND (J>-129) AND (O.OPTP<>FREF) THEN
	      BEGIN
	      SHORTEN := SHORTEN+1;  MRLN := 77;  
	      END;
	   END;   (*** JUMP FIX ***)
 
	IF (MRLN=133) OR (MRLN=143) THEN
	   BEGIN  (**  FORWARD IMMED REF  **)
	   J := OPDSTR;  EVALOPND(J,O);  CHG := TRUE;
	   IF (O.OPTP<>FREF) AND (O.OTP=1) THEN SHORTEN := SHORTEN+1;
	   MRLN := MRLN - 32;
	   END;
	END;      (*** WITH     ***)
 
      IF CHG OR (SHORTEN>0) THEN PUT(STATEMENTS,NRK);
      NRK := SUCC(NRK);
      END;  (*** OF WHILE ***)
    K := SUCC(K);
    UNTIL (SHORTEN=0) AND (SH1=0) OR (K=3);
   WRITELN(TTY,K:3,' CODE OPTIMIZATION PASSES');
   END;

 
(***********************************************************
	SYMBOL TABLE LIST
 ***********************************************************)
 
PROCEDURE STBLIST;
 
   CONST SPPG=280;   (* SYMBOLS PER PAGE *)
 
   VAR	NP,NSL : INTEGER;  W : WORD;
	STPR   : ARRAY [1..5,1..56] OF SYMPTR;
	J      : INTEGER;
 
   PROCEDURE SLPG(NS:INTEGER);		(**  OUPUT ONE PAGE OF SYMBOLS  **)
      VAR  NSPL,I,J,K : INTEGER;
      BEGIN
      NSPL := (NS+4) DIV 5;    (** NUMBER SYMBS PER COLUMN **)
      FOR J := 1 TO 5 DO
	FOR K := 1 TO NSPL DO
	   BEGIN
	   STPR[J,K] := GS;
	   IF GS <> NIL THEN GS := GS^.SNXT;
	   END;
 
	(***  HEADING  ***)
      PAGE(LIST); 
      WRITELN(LIST,'SYMBOL TABLE LIST':63);  WRITELN(LIST);
      FOR I:= 1 TO 5 DO WRITE(LIST,'SYMBOL VALUE TYPE SIZE    ');
      WRITELN(LIST);
      FOR I:= 1 TO 5 DO WRITE(LIST,'------ ----- ---- ----    ');
      WRITELN(LIST);
 
      FOR J := 1 TO NSPL DO  BEGIN (**  OUTPUT EACH ROW  **)
      FOR K := 1 TO 5 DO
      IF STPR[K,J] <> NIL THEN
      WITH STPR[K,J]^ DO
	 BEGIN
	 WRITE(LIST,SNAME);
	 HEXLY(SVAL,W);  WRITE(LIST,W:6);
	 CASE STYP OF
	  REGNM     : WRITE(LIST,' REG ');
	  CHBL,PERM : WRITE(LIST,' CNST');
	  SEGNM     : WRITE(LIST,' SEGN');
	  XTLB,XTLW,XTLS : WRITE(LIST,' XTRN');
	  OTHERS 	 : WRITE(LIST,' ADDR')
	  END;
	 IF (STYP=XTLB) OR (STYP=MBYTE) OR (STYP=REGNM) AND ((SVAL>=8) OR (SVAL<=15)) 
	   THEN WRITE(LIST,' BYTE')
	   ELSE WRITE(LIST,' WORD');
	 WRITE(LIST,' ':4);
	 END;  (** WITH **)
      WRITELN(LIST);
      END;  (**  OF FOR  **)
      END;
 
 
   BEGIN
   NP := NSYMBS DIV SPPG + 1;	(** NUMBER OF PAGES  **)
   NSL := NSYMBS MOD SPPG;
   IF NSL=0 THEN BEGIN NP := NP-1; NSL := SPPG END;
   GS := SYMTOP;
   FOR J := 2 TO NP DO SLPG(SPPG);
   SLPG(NSL);
   END;
(*$P+*)
  
(**********************************************************)
 
BEGIN   (*  MAIN LINE  *)
OPENFILES;
IF NOT ERRINPROG THEN BEGIN
EC:=0;
INITIALIZE;
STIME := RUNTIME;
PASSONE;
WRITELN(TTY,NSYMBS,' SYMBOLS IN PROGRAM');
WRITELN(TTY,'PASS ONE COMPLETE');
PASSMID;
IF HASSBTL THEN	(**  NEED TWO FILES -- ONE FOR CONTENTS, ONE FOR LISTING  **)
   BEGIN
   REWRITE(LIST,'SC2.TMP');
   REWRITE(SOURCE,TFN);
   WRITELN(SOURCE,'TABLE OF CONTENTS FOR PROGRAM ',SFN.FNAME);
   WRITELN(SOURCE);
   WRITELN(SOURCE,'LINE  PAGE':56);
   WRITELN(SOURCE,'----  ----':56);
   END
   ELSE REWRITE(LIST,TFN); (**  ONLY ONE FILE  **)
PASSTWO;
IF ERRINPROG THEN WRITELN(TTY,EC,' ERROR(S) IN PROGRAM');
STBLIST;
WRITELN(LIST); WRITELN(LIST); WRITELN(LIST); WRITELN(LIST);
WRITELN(LIST,EC,' ERROR(S) IN PROGRAM');
WRITELN(LIST,NSYMBS,' SYMBOLS  IN PROGRAM');
 
IF HASSBTL THEN		(**  APPEND LISTING TO TABLE OF CONTENTS  **)
   BEGIN
   PAGE(SOURCE);
   RESET(LIST,'SC2.TMP');
   WHILE NOT EOF(LIST) DO
      BEGIN
      WHILE NOT EOLN(LIST) DO
	BEGIN
	READ(LIST,STRING[1]);  WRITE(SOURCE,STRING[1]);
        END;
      WRITELN(SOURCE); READLN(LIST);
      END;
   CLOSEF(LIST);   DELETF; 
   END;
WRITELN(TTY,RUNTIME-STIME,' SECONDS TO ASSEMBLE')
END
END.