(*$M-*)  (***  ASSMP2.PAS -- PASS TWO  ***)
 
(*$R-,X+*)
 
(**  FUNCTION:
	1.  GENERATE CODE
	2.  PRODUCE LISTING
	3.  PRODUCE OBJECT FILE (FORMAT BELOW)
	  COLS  1 3....8 10...14 16	COMMENTS
		S LEN    NAME		SEGMENT NAME AND LEN
		G VAL	 NAME		GLOBAL SYMB AND OFFSET IN SEGMENT
		T ADDR	 CODE TEXT	UP TO 124 HEX CODE DIGITS TERM BY 'ZZ'
		X ADDR	 NAME   OP/TP	EXTERNAL REFS -- 
					  OP = '+' OR '-' FOR ADD/SUB TO ADDR CONST
					  TP = 'B','W','S' FOR BYTE,WORD,SEGNAME
		E			END OF SEGMENT
		B 	 SNAME  NAME	ENTRY AT SEGNAME:NAME (LAST REC ONLY)
*)
 
(*$L-*)
(*$I+ASSMHD.PAS*)
(*$L+*)
(***************************************************************
	  UTILILTY PROCEDURES
 ***************************************************************)
 
PROCEDURE FINDSYMB  (S:NAME; VAR L:SYMPTR; VAR B:BOOLEAN);  EXTERN;
 
FUNCTION  NEOLINE   (K:INTEGER) : BOOLEAN;  EXTERN;
 
FUNCTION  ENDOPNDS  (K:INTEGER) : BOOLEAN;  EXTERN;
 
PROCEDURE SETERR    (CH:CHAR); EXTERN;
 
PROCEDURE SKIPBLANKS( VAR N : INTEGER);  EXTERN;
 
PROCEDURE LOADSYMB  (VAR N:INTEGER);  EXTERN;
 
(******************************************************************
	EVALUATE EXPRESSION
 ******************************************************************)
 
PROCEDURE EVALEXP (VAR N,V:INTEGER; VAR T:OPNDTP; VAR T1:INTEGER);
   EXTERN;
 
(*****************************************************
	EVALUATE OPERAND
 *****************************************************)
 
PROCEDURE EVALOPND (VAR N : INTEGER;  VAR O : OPERAND);
   EXTERN;

(**********************************************************
	PASS TWO -- CODE GENERATION
 **********************************************************)
  
PROCEDURE PASSTWO;
 
   CONST CLEN=12;  LPPG=55;  (** LINES PER PAGE  **)
 
   VAR	LINE,PAGEN,CC,I,J : INTEGER;   W:WORD;
	CODE : ARRAY [1..CLEN] OF CHAR;
	DT,TM  : ARRAY [1..10] OF CHAR;
	LSTON,MD,MD1,SFND,F:BOOLEAN;  TP:OPNDTP;  O1,O2:OPERAND;
	CLIN,CLEND2,ADR,CCN,NRK,OLINE,CG,LS,NL,K,K1 : INTEGER;
 
   PROCEDURE DISPATCH;  (** SEND CODE TEXT TO OBJECT FILE  **)
      CONST MXCC=119;
      VAR   CCM,I,K : INTEGER;
 
      PROCEDURE NEWREC;
	BEGIN
	WRITE(OBJ,'T ',ADR:6,' '); CCN:=1;
	END;
 
      BEGIN
      IF CC>1 THEN
      WITH STATEMENTS^ DO
	BEGIN
	IF FIRSTSEG THEN  (**  NO SEG CARD AT FRONT  **)
	  BEGIN
	  WRITELN(OBJ,'S ',DUM1STSEG:6,SFN.FNAME:7);  FIRSTSEG := FALSE
	  END;
	CCM := CC-1;
	IF F AND (ADR<>ADDR) OR (CCN>=MXCC) THEN
	   BEGIN
	   IF ADR <> -1 THEN WRITELN(OBJ,'ZZ');
	   IF F THEN ADR := ADDR;
	   NEWREC;
	   END;
	IF (CCN+CCM > MXCC) THEN (** SPLIT CODE **)
	   BEGIN
	   K := MXCC-CCN;
	   FOR I:= 1 TO K DO WRITE(OBJ,CODE[I]);
	   ADR := ADR + K DIV 2;
	   WRITELN(OBJ,'ZZ');  NEWREC;
	   FOR I := K+1 TO CCM DO WRITE(OBJ,CODE[I]);
	   CCN := CCM-K+1;
	   ADR := ADR + CCN DIV 2;
	   END
	ELSE
	   BEGIN	(**  ALL IN THIS LINE  **)
	   FOR I := 1 TO CCM DO WRITE(OBJ,CODE[I]);
	   ADR := ADR + CCM DIV 2;
	   CCN := CCN + CCM;
	   END
	END
      END;
 
   PROCEDURE HEXLY(N:INTEGER; VAR W:WORD);
      EXTERN;
 
   PROCEDURE BYTELY(I:INTEGER);
      BEGIN
      HEXLY(I,W);
      CODE[CC] := W[3];  CODE[CC+1] := W[4];
      CC := CC+2
      END;
 
   PROCEDURE CHARLY(CH:CHAR);
      BEGIN
      BYTELY(ORD(CH));
      END;
 
   PROCEDURE TITLE;
      BEGIN
      IF PAGEN<>1 THEN PAGE(LIST);
      WRITELN(LIST,TTL,ASSMID:35,DT:14,
		   ' AT ',TM,'PROGRAM > ':15,SFN.FNAME,'PAGE':10,PAGEN:4);
      WRITELN(LIST,STTL);  WRITELN(LIST);
      END;
 
   PROCEDURE CHKHEAD;	(**  CHECK FOR END OF PAGE  **)
      VAR K : INTEGER;
      BEGIN
      IF OLINE >= LPPG THEN  (*  NEW PAGE  *)
	 BEGIN
	 K := (CLEND2*3 +4) DIV 2;	(** WIDTH OF CODE **)
	 TITLE;
	 WRITELN(LIST,'ADDR','CODE':K+2,' ':K-2,'ERR LINE  ','STATEMENT':20);
	 WRITELN(LIST);
	 PAGEN := PAGEN+1;  OLINE := 0;
	 END;
      END;
 
   PROCEDURE LISTLINE;	(**  OUTPUT ONE LINE TO LIST AND OBJ FILES  **)
      VAR I:INTEGER;
      BEGIN
      DISPATCH;
      IF LSTON THEN
      BEGIN
      IF NOT F THEN BEGIN CHKHEAD; WRITE(LIST,' ':6) END;
      FOR I:=1 TO CLEND2  DO
	WRITE(LIST,CODE[2*I-1],CODE[2*I],' ');
      WITH STATEMENTS^ DO
       IF F THEN WRITE(LIST,'  ',ERRS,LINE:5,'  ',STMNT:STMLEN);
      WRITELN(LIST);
      OLINE := OLINE+1;
      END;
      CC := 1;
      F := FALSE;
      CLIN := CLIN + 1;
      END;
 
   PROCEDURE ADDRLY(I:INTEGER);		(**  GENERATE ADDRESS  **)
      BEGIN
      IF XD <> NX1 THEN	   (**  INCLUDE ADDRS WITH XTL REFS  **)
	REPEAT
	IF XD = NIL THEN XD := XREFS
	ELSE XD := XD^.XNXT;
	XD^.XA := STATEMENTS^.ADDR + (CC-1) DIV 2 + CLIN*CLEND2
	UNTIL XD = NX1;
      HASXTL := NX1<>NX2;
      NX1 := NX2;
      HEXLY(I,W);
      IF CC>CLEN THEN LISTLINE;
      CODE[CC] := W[3];  CODE[CC+1]:=W[4];  CC:=CC+2;
      IF CC>CLEN THEN LISTLINE;
      CODE[CC] := W[1];  CODE[CC+1]:=W[2];  CC:=CC+2;
      END;
 
   PROCEDURE DATALY(K,I:INTEGER);	(**  GENERATE DATA  **)
      BEGIN
      IF K=0 THEN BYTELY(I)
      	     ELSE ADDRLY(I);
      END;
 
   PROCEDURE SETOPCODE(I:INTEGER);
      BEGIN
      WITH OPERATIONS[STATEMENTS^.ST] DO
	BYTELY(ORD(OPCODE[I]))
      END;
 
   PROCEDURE CHECKSR(VAR O : OPERAND);
      BEGIN
      IF O.OSR <> 0 THEN
	 BYTELY(O.OSR);
      END;
 
   PROCEDURE SETMODEMR(VAR I,W:INTEGER; VAR O :OPERAND);
      VAR MODE,MR:INTEGER;
      BEGIN
      MR := 0;
      IF O.OTP=1 THEN W:=0 ELSE W:=1;
      MODE := O.OPLN-1;
      WITH O DO CASE OPTP OF
	REG	: BEGIN
		  IF OPV>15 THEN SETERR('R')
		  ELSE
		      BEGIN
		      IF OPV>7 THEN OPV := OPV-8;
		      MODE := 3;  MR := OPV
		      END;
		  END;
	CNST,OFFS : BEGIN MR:=6;  MODE:=0  END;
	INDB	: IF RB=5 THEN MR:=6 ELSE MR:=7;
	INDX	: IF RX=6 THEN MR:=4 ELSE IF RX=3 THEN MR:=7 ELSE MR:=5;
	INDBX	: BEGIN
		  IF RX=7 THEN MR:=1;
		  IF RB=5 THEN MR:=MR+2
		  END
	END;
      I := MODE*100B + MR
      END;
 
   PROCEDURE GENADR(VAR O:OPERAND);
      BEGIN
      IF O.OPTP <> REG THEN
	IF O.OPLN=2 THEN BYTELY(O.OPV)
	ELSE IF O.OPLN=3 THEN ADDRLY(O.OPV)
       END;
 
 
   PROCEDURE PCMPLX;	(**  GENERATE CODE FOR COMPLEX INSTRUCTIONS  **)
      VAR M : INTEGER;
      BEGIN
      WITH STATEMENTS^ DO WITH OPERATIONS[ST] DO
	BEGIN
	M := MRLN DIV 32;
	MRLN := MRLN MOD 32;
 
	IF OPDSTR <> 0 THEN 
	   BEGIN
	   IF STMNT[OPDSTR]='^' THEN OPDSTR:=SUCC(OPDSTR);
	   EVALOPND(OPDSTR,O1);
	   IF NOT ENDOPNDS(OPDSTR) THEN 
	      BEGIN OPDSTR:=SUCC(OPDSTR); EVALOPND(OPDSTR,O2) END;
	   IF NEOLINE(OPDSTR) THEN SETERR('Z');
	   END;
 
	IF (O2.OPTP=CNST) AND (MRLN=7) THEN MRLN := 6;  (** SEG NM FORWARD REF  **)
 
	CASE MRLN OF	(**  SEE PASS 1  **)
	 0:  (***  INC,DEC,PUSH,POP -- TO REGISTER  ***)
	     IF (ST=INC) OR (ST=DEC) THEN
		IF O1.OPV < 8 THEN
		   BEGIN
		   IF ST = INC THEN K := 100B  ELSE K := 110B;
		   BYTELY(K+O1.OPV);
		   END
		ELSE IF O1.OPV>15 THEN SETERR('R')
		ELSE  (** BYTE REG  **)
		   BEGIN
		   SETMODEMR(K,K1,O1);
		   BYTELY(K1+ORD(OPCODE[1]));
		   BYTELY(K +ORD(OPCODE[2]))
		   END
	     ELSE (**  PUSH, POP  **)
		IF O1.OPV > 15 THEN  (** SEGMENT REG **)
		   BEGIN
		   IF ST=PUSH THEN K:=6 ELSE K:=7;
		   BYTELY (K + (O1.OPV-16)*8);
		   END
		ELSE IF O1.OPV<8 THEN (** WORD REG **)
		   BEGIN
		   IF ST=PUSH THEN K:=120B ELSE K:=130B;
		   BYTELY(K + O1.OPV);
		   END
		ELSE  (**  BYTE REG  **)
		   SETERR('R');
 
	 1,2: (*** INC,DEC,PUSH,POP -- NOT REG ***)
	      BEGIN
	      O1.OPLN := M;
	      CHECKSR(O1);
	      SETMODEMR(K,K1,O1);
	      IF (ST=PUSH) OR (ST=POP) THEN K1 := 0;
	      BYTELY(K1+ORD(OPCODE[1]));
	      BYTELY(K +ORD(OPCODE[2]));
	      GENADR(O1);
	      END;
 
	 4:  (*** R/M TO REGISTER ***)
	     BEGIN
	     O2.OPLN:=M;
	     CHECKSR(O2);
	     SETMODEMR(K,K1,O2);
	     IF (O1.OPV > 15) THEN (** SEG REG **)
		IF ST = MOV THEN
		   BEGIN
		   BYTELY(216B);
		   BYTELY(K+(O1.OPV-16)*8);
		   END
		ELSE SETERR('R')
	     ELSE 
		BEGIN
		IF O1.OPV < 8 THEN K1 := 1 
			      ELSE BEGIN K1:=0;  O1.OPV:=O1.OPV-8 END;
		IF ST<>XCHG THEN K1:=K1+2;
		BYTELY(K1 + ORD(OPCODE[1]));
		BYTELY(K  + O1.OPV*8);
		END;
	     GENADR(O2);
	     END;
 
	 3:  (*** REG TO R/M ***)
	     BEGIN
	     O1.OPLN := M;
	     CHECKSR(O1);
	     SETMODEMR(K,K1,O1);
	     IF O2.OPV > 15 THEN
		IF ST=MOV THEN
		   BEGIN
		   BYTELY(214B);
		   BYTELY(K + (O2.OPV-16)*8);
		   END
		ELSE SETERR('R')
	     ELSE
		BEGIN
		IF O2.OPV<8 THEN K1 := 1
			    ELSE BEGIN K1 := 0; O2.OPV := O2.OPV-8 END;
		BYTELY(K1 + ORD(OPCODE[1]));
		BYTELY(K  + (O2.OPV)*8);
		END;
	     GENADR(O1)
	     END;
 
	 5,15:  (***  IMMEDIATE TO R/M  ***)
	     BEGIN
	     O1.OPLN:=M;
	     CHECKSR(O1);
	     SETMODEMR(K,K1,O1);
	     IF ST=MOV THEN K1:=K1+306B
	     ELSE IF ST=TEST THEN K1:=K1+366B
		  ELSE K1:=K1+200B;
	     IF MRLN=15 THEN
		BEGIN
		IF ODD(K1) THEN (** WORD OPERATION **)
		   IF O2.OTP=1 THEN J:=2 ELSE J:=0
		ELSE (** BYTE OPERAND **)
		   BEGIN
		   J := 0;  IF O2.OTP=2 THEN SETERR('F');
		   END;
		K1 := K1+J
		END ELSE J:=-1;
	     BYTELY(K1);  BYTELY(K+ORD(OPCODE[2]));
	     GENADR(O1);
	     IF J=-1 THEN K := ORD(ODD(K1))
	     ELSE IF NOT ODD(K1) THEN K:=0
		  ELSE IF J=0 THEN K:=1 ELSE K:=0;
	     DATALY(K,O2.OPV)
	     END;
 
	6:  (***  IMMEDIATE TO REG  ***)
	     BEGIN
	     IF O1.OPV>15 THEN SETERR('R');
	     IF O1.OTP = 1 THEN BEGIN K:=0; O1.OPV:=O1.OPV-8 END
			   ELSE K:=1;
	     BYTELY(260B+K*8+O1.OPV);
	     DATALY(K,O2.OPV)
	     END;
 
	7:  (***  MEM TO ACCUM  ***)
	     BEGIN
	     CHECKSR(O2);
	     IF O1.OTP=1 THEN K := 0 ELSE K := 1;
	     BYTELY(240B+K);
	     ADDRLY(O2.OPV);
	     END;
 
	8:   (***  ACCUM TO MEM  ***)
	     BEGIN
	     CHECKSR(O1);
	     IF O2.OTP=1 THEN K:=0 ELSE K:=1;
	     BYTELY(242B+K);
	     ADDRLY(O1.OPV);
	     END;
 
	 9:  (***  IMMED TO ACCUM  ***)
	     BEGIN
	     IF O1.OTP=1 THEN K:=0 ELSE K:=1;
	     IF ST=TEST  THEN BYTELY(K+250B) ELSE
	     BYTELY(K+ORD(OPCODE[1])+4);
	     DATALY(K,O2.OPV);
	     END;
 
	10: (***  ONE/NONE OPERAND  ***)
	    IF OPDSTR = 0 THEN SETOPCODE(1)
	    ELSE
		BEGIN
		IF ST=INTT THEN BYTELY(315B)
			  ELSE BYTELY(ORD(OPCODE[1])-8);
		BYTELY(O1.OPV);
		IF O1.OPTP<>CNST THEN SETERR('C');
		END;
 
	 11: (*** REG-REG XCHG ***)
	     IF O1.OPV=0 THEN BYTELY(220B+O2.OPV)
			 ELSE BYTELY(220B+O1.OPV);
 
	 12: (***  RETURN  ***)
	     BEGIN
	     K := ORD(OPCODE[1]);
	     IF OPDSTR = 0 THEN BYTELY(K)
	     ELSE
		BEGIN
		BYTELY(K-1);
		ADDRLY(O1.OPV);
		IF O1.OPTP<>CNST THEN SETERR('C');
		END;
	     END;
 
	 13: (***  JMP/CALL DIRECT  ***)
	     IF OPDSTR<>0 THEN
	     IF ISEGJ THEN (** INTERSEGMENT **)
		BEGIN
		IF ST=JMP THEN BYTELY(352B) ELSE BYTELY(232B);
		IF XD <> NX1 THEN
		   BEGIN
		   NX1^.XA := ADDR+3;
		   XD := NX1;  NX1 := NX2;  NX2 := XLAST;
		   END;
		ADDRLY(O1.OPV);
		ADDRLY(ISEGD);
		IF NOT (O1.OPTP IN [CNST,OFFS]) THEN SETERR('C');
		END
	     ELSE
	     BEGIN
	     J:=O1.OPV-ADDR-2;  (** DISPLACEMENT **)
	     IF M=2 THEN (**  SHORT JUMP  **)
		BEGIN
		BYTELY(353B); BYTELY(J)
		END
	     ELSE
		BEGIN
		SETOPCODE(1);  ADDRLY(J-1);
		END
	     END;
 
	 14: (***  JMP/CALL INDIRECT  ***)
	     BEGIN
	     O1.OPLN := M;  CHECKSR(O1);  SETMODEMR(K,K1,O1);
	     BYTELY(377B);
	     BYTELY(ORD(OPCODE[2])+K);
	     GENADR(O1)
	     END
 
	END  (***  CASES  ***)
      END    (***  WITH   ***)
      END;   (***  PROC   ***)
 
   PROCEDURE ENDSEG; FORWARD;
 
 
   PROCEDURE DBDW1MOP(T : INTEGER);	(**  PROCESS PSEUDO, 1MOP INSTR  **)
      BEGIN
      WITH STATEMENTS^ DO
	CASE T OF
	  1:	(**  PSEUDO  **)
	   BEGIN
	   J := OPDSTR - 1;
           IF ST = DB THEN
	   REPEAT
	   J := SUCC(J);
	   EVALEXP(J,I,TP,K);
	   IF TP=CNST THEN
	      IF SL > 0 THEN  (***   STRING CONST   ***)
		IF 2*SL+CC-1 <= CLEN THEN  (** IT'LL FIT HERE  ***)
		   FOR K := 1 TO SL DO CHARLY(STRING[K])
		ELSE
		   BEGIN (** IT'LL TAKE A COUPLE OF LINES **)
		   NL := (2*SL+CC-1) DIV CLEN;
		   LS := ((2*SL+CC-1) MOD CLEN) DIV 2;
		   CG := CLEND2 - (CC-1) DIV 2;
		   FOR K := 1 TO CG DO CHARLY(STRING[K]);
		   LISTLINE;
		   FOR K := 0 TO NL-2 DO
		      BEGIN
		      FOR K1 := 1 TO CLEND2 DO CHARLY(STRING[K*CLEND2+CG+K1]);
		      LISTLINE;
		      END;
		   FOR K := 1 TO LS DO CHARLY(STRING[(NL-1)*(CLEND2)+CG+K]);
		   END
	      ELSE  (***  NOT STRING  ***)
		BEGIN
		HEXLY(I,W);
		IF CC>CLEN THEN LISTLINE;
		CODE[CC] := W[3]; CODE[CC+1] := W[4];
		CC := CC+2
		END
	   UNTIL ENDOPNDS(J)
	  ELSE IF ST = DW THEN
	     REPEAT
	     J := SUCC(J);
	     OPNDS := 1;  NX1 := XD;
	     EVALEXP(J,I,TP,K);
	     NX2 := NX1;
	     ADDRLY(I);
	     IF TP = FREF THEN SETERR('U');
	     UNTIL ENDOPNDS(J)
	   ELSE IF (ST=SETT) AND HASLBL THEN (**  RESET SYMBOL TABLE **)
		  BEGIN
		  LOADSYMB(LABSTR);
		  FINDSYMB(GSYM,GS,SFND);
		  EVALEXP(OPDSTR,I,TP,K);
		  IF GS^.STYP=CHBL THEN GS^.SVAL:=I
		  END
		ELSE IF (ST=ENDD) THEN  
		   BEGIN
		   ENDSEG;
		   IF OPDSTR > 0 THEN  (** GENERATE BEGIN EXEC STM **)
			BEGIN
			LOADSYMB(OPDSTR);
			SKIPBLANKS(OPDSTR);
			IF STMNT[OPDSTR] = ':' THEN
			   BEGIN
			   OPDSTR := SUCC(OPDSTR);  SKIPBLANKS(OPDSTR);
			   WRITE(OBJ,'B ',GSYM:13);
			   LOADSYMB(OPDSTR);  WRITE(OBJ,GSYM:7)
			   END ELSE WRITE(OBJ,'B ',GSYM:20);
			WRITELN(OBJ);
			END
		   END 
		END;
	  3: 	(**  ONEMOP  **)
		BEGIN
		EVALOPND(OPDSTR,O1);
		MD := (ST=MUL) OR (ST=IMUL) OR (ST=DIVV) OR (ST=IDIV);
		MD1 := MD OR (ST=NOTT) OR (ST=ESC) OR (ST=NEG);
		IF NOT MD1 THEN		(**  SEEK 2ND OPERAND  **)
		   IF STMNT[OPDSTR] <> ',' THEN SETERR('Y')
		   ELSE
		      BEGIN
		      OPDSTR:=SUCC(OPDSTR);  EVALOPND(OPDSTR,O2)
		      END;
		IF NEOLINE(OPDSTR) THEN SETERR('Z');
		IF (ST<RCL) AND NOT MD1 THEN
		   BEGIN
		   CHECKSR(O2);  SETMODEMR(I,J,O2);  SFND:=TRUE;
		   O2.OPLN := MRLN+1;
		   END
		ELSE
		   BEGIN
		   CHECKSR(O1);  SETMODEMR(I,J,O1);  SFND:=FALSE;
		   O1.OPLN:=MRLN+1
		   END;
		K := ORD(OPERATIONS[ST].OPCODE[1]);
		IF (ST<LDS) OR (ST>LES) THEN K := K+J;  (**  ADD W IN  **)
		IF (ST>=RCL) THEN
		   IF (O2.OPTP=REG) AND (O2.OPV=9) (** CL **) THEN K:=K+2  (*  SET V  *)
		   ELSE IF (O2.OPTP<>CNST) OR (O2.OPV<>1) THEN SETERR('R');
		BYTELY(K);  (***   SET OPCODE   ***)
		IF (ST>=LDS) AND (ST<=LES) THEN
		   IF O1.OPTP <> REG THEN SETERR('R')
		   ELSE IF O1.OPV IN [0..7] THEN I := I + O1.OPV*8
			ELSE SETERR('R')
		ELSE I := I + ORD(OPERATIONS[ST].OPCODE[2]);
		BYTELY(I);  (**  SET SECOND BYTE  **)
		IF SFND THEN GENADR(O2)
			ELSE GENADR(O1)
		END
	 END
      END;
 
 
   PROCEDURE SETTTL(VAR TTL:TTLTP; K1:INTEGER);
      BEGIN		(**  PROCESS TITLE PSEUDOS  **)
      WITH STATEMENTS^ DO
	BEGIN
	IF OPDSTR <= 0  THEN J := 0 
			ELSE J := STMLEN-OPDSTR + 1;
	IF J>30 THEN J:=30;
	FOR K := 1 TO J DO TTL[K] := STMNT[OPDSTR+K-1];
	FOR K := J+1 TO 30 DO TTL[K] := ' ';
	IF LSTON THEN
	BEGIN
	IF HASSBTL THEN
	   BEGIN
	   WRITE(SOURCE,' ':K1);
	   FOR K := 1 TO TTLEN DO WRITE(SOURCE,TTL[K]);
	   WRITE(SOURCE,LINE:20-K1);
	   IF OLINE < LPPG THEN WRITELN(SOURCE,PAGEN-1:6) ELSE WRITELN(SOURCE,PAGEN:6);
	   END;
        CHKHEAD;   WRITE(LIST,' ':6);
	END;
	END;
      END;
 
   PROCEDURE ENDSEG;	(**  END OF PROGRAM SEGMENT  **)
      BEGIN
      IF ADR <> -1 THEN WRITELN(OBJ,'ZZ');   (* TERMINATE CURRENT LINE *)
      (** PROCESS EXTERNAL REFS  **)
      WHILE XREFS <> NIL DO
	BEGIN
	WITH XREFS^ DO
	   WRITELN(OBJ,'X ',XA:6,XN:7,XOP:2,XTP:2);
	XREFS := XREFS^.XNXT;
	END;
      RELEASE;
      WRITELN(OBJ,'E ');   (*   END SEGMENT	     *)
      END;
 
   PROCEDURE GENGLOBS;
      BEGIN
      IF ADR <> -1 THEN SETERR('K');
      WITH STATEMENTS ^ DO
      BEGIN
      IF OPDSTR <> 0 THEN
	REPEAT
	LOADSYMB(OPDSTR);
	FINDSYMB(GSYM,GS,SFND);
	WRITELN(OBJ,'G ',GS^.SVAL:6,GSYM:7);
	SKIPBLANKS(OPDSTR);
	IF STMNT[OPDSTR]=',' THEN BEGIN OPDSTR:=SUCC(OPDSTR); SKIPBLANKS(OPDSTR) END;
	UNTIL NOT NEOLINE(OPDSTR);
      END
      END;
 
   PROCEDURE NEWSEG;
      BEGIN
      IF NOT FIRSTSEG THEN ENDSEG;
      XREFS := NIL;  XD := NIL;  MARK;
      WITH STATEMENTS^ DO
      BEGIN
      FIRSTSEG := FALSE;  ADR := -1;
      LOADSYMB(LABSTR);
      FINDSYMB(GSYM,GS,SFND);
      WRITELN(OBJ,'S ',GS^.SVAL:6,GSYM:7);
      GENGLOBS;
      END;
      END;
 
 
   BEGIN	(***   PASS TWO -- GENERATE CODE   ***)
   PASS1 := FALSE;  FIRSTSEG := TRUE;
   NRK := 1;  CCN := 1;  ADR:=-1;  CLEND2 := CLEN DIV 2;
   DATE(DT);  TIME(TM);  PAGEN:=1;  LINE:=0;  OLINE:=LPPG+1;
   WHILE NRK <= NRC DO
      BEGIN
      GET(STATEMENTS,NRK);  NRK := SUCC(NRK);
      WITH STATEMENTS^ DO
	 BEGIN
	 LSTON := STPRNT;
	 IF (ST<>TITL) AND (ST<>STITL) AND LSTON THEN CHKHEAD;
	 LINE := LINE + 1;
	 F := TRUE;  CC := 1;  CLIN := 0;  HASXTL := FALSE;
	 W := '    ';   OPNDS := 0;
	 IF COMMNT THEN
	    BEGIN
	    IF HASLBL THEN HEXLY(ADDR,W);
	    IF LSTON THEN WRITE(LIST,W,'  ')
	    END
	 ELSE
	  BEGIN
	  IF (ST<>EJECT) AND (ST<>STITL) AND (ST<>TITL) THEN   
	    BEGIN
	    HEXLY(ADDR,W);  IF LSTON THEN WRITE(LIST,W,'  ')
	    END;
	  WITH OPERATIONS[ST] DO
	  CASE OPTYP OF
	    PSEUD : 
		IF ST=EJECT THEN
		   BEGIN
		   FOR J := OPRSTR TO STMLEN DO STMNT[J]:=' ';
		   IF OLINE <> 0 THEN OLINE := 54;
		   IF LSTON THEN WRITE(LIST,' ':6)
		   END
		ELSE
		IF ST=TITL THEN SETTTL(TTL,10)
		ELSE IF ST = STITL THEN SETTTL(STTL,15)
		ELSE
		IF (ST = CSEG) OR (ST = DSEG) THEN NEWSEG
		ELSE IF (ST=GLBL) THEN GENGLOBS
		ELSE
		IF (OPDSTR>0) OR (ST=ENDD) THEN
		   DBDW1MOP(1);
	   ONEMOP:
		IF OPDSTR <= 0 THEN SETERR('Y') ELSE
		DBDW1MOP(3);
	   NOOPS,TWOB :
		BEGIN
		SETOPCODE(1);
		IF OPTYP=TWOB THEN SETOPCODE(2);
		IF OPDSTR <> 0 THEN SETERR('Z');
		END;
	   DISPL :
		IF OPDSTR <= 0 THEN SETERR('Y') ELSE
		BEGIN
		SETOPCODE(1);
		EVALOPND(OPDSTR,O1);
		IF NEOLINE(OPDSTR) THEN SETERR('Z');
		WITH O1 DO
		  IF OPTP<>OFFS THEN SETERR('J')
		  ELSE
		    BEGIN
		    K := OPV-ADDR-2;
		    IF (K>127) OR (K<-128) THEN SETERR('J')
		    ELSE BYTELY(K)
		    END
		END;
 
	   CMPLX : PCMPLX
 
	   END;  (***  OF CASES  ***)
 
	 END;	 (***  OF NOT COMMENT   ***)
 
        FOR I := CC TO CLEN DO CODE[I] := ' ';
	IF HASXTL THEN SETERR('G');
	IF NOT LSTON AND (ERRS<>'  ') THEN
	  BEGIN
	  LSTON := TRUE;  HEXLY(ADDR,W);
	  WRITE(LIST,W,'  ')
	  END;
	IF F OR (CC>1) THEN LISTLINE;
	END;  (*** OF WITH ***)
 
      END;    (*** OF WHILE ***)
 
   END  (*  PASS TWO  *)  .
  
