(*$M-*)  (***  ASSMP1.PAS -- PASS ONE  ***)
 
(*$R-,X+*)
 
(*  FUNCTION :
	1.  DETERMINE OPERATION CODE, OPERANDS, AND LABELS
	2.  DEFINE AND EXPAND MACROS
	3.  CLASSIFY EACH INSTRUCTION AND SYMBOL
	4.  ASSIGN STORAGE AND VALUES FOR SYMBOLS
	5.  OUTPUT LEFT IN TEMPORARY FILE AND SYMBOL TABLE
*)
 
(*$L-*)
(*$I+ASSMHD.PAS*)
(*$L+*)
(***************************************************************
	  UTILILTY PROCEDURES
 ***************************************************************)
 
PROCEDURE ENTERSYMB (S,L : SYMPTR);	EXTERN;
 
PROCEDURE NEWSYMB   (N:NAME; V:INTEGER; T:SYMTYP; VAR S:SYMPTR);  EXTERN;
 
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;
 
FUNCTION GENCODE:BOOLEAN;  (* RETURNS TRUE IF OK TO ASSEMBLE STATEMENT  *)
   VAR F:BOOLEAN;
   BEGIN
   F := IFCUR=0;
   IF NOT F THEN F := IFLEVS[IFCUR].ISGEN;
   GENCODE := F
   END;
 
 
PROCEDURE LOADSYMB (VAR N:INTEGER);  EXTERN;
 
PROCEDURE WRITEMESS; 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;
 
(*$P+*)
(******************************************************
	PASS ONE -- SYMBOL DEFINITION
 ******************************************************)
 
PROCEDURE PASSONE;
 
   CONST FORMFEED = 12;
	 MXPV = 16;  (** MAX NUMBER MACRO PARAMS **)
 
   TYPE	 MACPTR = ^MACRO;
 
	 MACRO  = RECORD
		 MACNAME : NAME;	(* NAME OF MACRO *)
		 MACTXT  : INTEGER;	(* POINTER INTO MACRO TEXT FILE *)
		 MACLST  : INTEGER;	(* LAST LINE IN TEXT FILE *)
		 MACPS   : INTEGER;	(* NUMBER OF PARAMETERS   *)
		 MACNXT  : MACPTR	(* NEXT ONE *)
		 END;
   
   VAR   J,FLDSFND : INTEGER;  	EOFLG,SFND,XPANDM : BOOLEAN;
	 S : SYMPTR;		O1,O2 : OPERAND;
	 NCR,MX : INTEGER;	M,MM,FIRSTM,LASTM : MACPTR;
	 IC     : INTEGER;	STMOP : NAME;
	 PARMV  : ARRAY [1..MXPV] OF NAME;
	 LSTON,PRTGEN : BOOLEAN;
	 LOCSYM : NAME;
	 CH	: CHAR;		MAXIC : INTEGER;
 
 
   PROCEDURE READREC(VAR S:STMT);  (* READ NEXT STATEMENT IMAGE INTO S *)
      CONST TAB = 9;
      VAR   I : INTEGER;	N,LNG,J,PL : INTEGER;
	    T : OPNDTP;
      BEGIN
      IF XPANDM THEN	(**  GET IT FROM MACRO FILE  **)
	BEGIN
	S := MACF^;
	I := 1;
	WHILE (I <= STMLN-6) DO
	  BEGIN
	  IF ORD(S[I]) > 128 THEN
	     BEGIN
	     N := ORD(S[I]) - 128;
	     LNG:= N DIV 16;
	     N := N MOD 16;
	     PL:= NAMELEN;
	     WHILE (PL>1) AND (PARMV[N,PL] = ' ') DO PL := PRED(PL);
	     WHILE (PL>LNG) AND (S[I+LNG]=' ') DO LNG := SUCC(LNG);
	     IF PL > LNG THEN  (** MOVE IMAGE OVER TO MAKE ROOM FOR LONGER PARAM **)
		FOR J := STMLN DOWNTO PL+I DO
		   S[J] := S[J-PL+LNG];
	     FOR J := 1 TO PL DO S[J+I-1] := PARMV[N,J];
	     END;
	   I := SUCC(I);
	   END;
	I := STMLN-1;
	WHILE (S[I] = ' ') AND (I > 1) DO I := PRED(I);
	I := SUCC(I);
	STATEMENTS^.STPRNT := PRTGEN AND LSTON;
	MX := MX + 1;
	GET (MACF,MX);
	XPANDM := M^.MACLST <> MX;
	END
      ELSE
      BEGIN
      STATEMENTS^.STPRNT := LSTON;
      FOR I := 1 TO STMLN DO S[I] := ' ';
      I := 1;
      IF EOF(SOURCE) 
       THEN   (*  NO MORE DATA -- ASSUME END  *)
	 BEGIN
	 S[8] := 'E'; S[9] := 'N'; S[10] := 'D';
	 EOFLG := TRUE;
	 I := 10;
	 END
       ELSE  (*  READ NEXT STATEMENT  *)
         BEGIN
	 WHILE (I <= STMLN) AND (NOT EOLN(SOURCE)) DO
	    BEGIN
	    READ(SOURCE,S[I]);  
	    IF ORD(S[I]) = FORMFEED THEN
		BEGIN
		S[I] := ' ';  I := 13;
		FOR J := 1 TO 5 DO S[J+7] := OPERATIONS[EJECT].OPNAME[J];
		END;
	    IF ORD(S[I]) = TAB THEN BEGIN S[I]:=' '; I:=I+7 - (I-1) MOD 8 END;
	    IF S[I] >= ' ' THEN I := SUCC(I) ELSE S[I] := ' ';
	    END;
	 READLN(SOURCE);
	 END;
      END;
      STATEMENTS^.STMLEN := I
      END;   (*  OF READREC  *)
 
   PROCEDURE LOADOP(N:INTEGER);
      VAR  J:INTEGER;
      BEGIN		(* LOAD OP CODE INTO STMOP *)
      J := N;
      WHILE (STATEMENTS^.STMNT[J] IN ['A'..'Z','0'..'9']) AND (J-N+1<=NAMELEN) DO
	 BEGIN
	 STMOP[J-N+1] := STATEMENTS^.STMNT[J];  J := SUCC(J);
	 END;
      FOR J := J-N+1 TO NAMELEN DO STMOP[J] := ' ';
      END;
 
   PROCEDURE NEXTLS(VAR N : NAME);   (** NEXT LOCAL SYMBOL INTO NAME N  **)
      VAR K : INTEGER;
      BEGIN
      K := NAMELEN-1;
      LOCSYM[K] := CHR (SUCC(ORD(LOCSYM[K])));
      WHILE (K>2) AND (ORD(LOCSYM[K]) = SUCC(ORD('9'))) DO
	BEGIN
	LOCSYM[K] := '0';
	K := PRED(K);
	LOCSYM[K] := CHR(SUCC(ORD(LOCSYM[K])));
	END;
      N := LOCSYM;
      END;
 
 
   PROCEDURE PARSE(VAR ST:STATEMENT);	(* FIND FIELDS IN STATEMENT ST *)
      VAR   I,J,K,FND : INTEGER;
      BEGIN   (* PARSE *)
      WITH ST DO
	 BEGIN
	 LABSTR:=0; OPRSTR:=0; OPDSTR:=0; HASLBL:=FALSE;  FND:=0;
	 I := 1;  SKIPBLANKS(I);
	 COMMNT := (I=STMLEN) OR (STMNT[I] = COMDELIM);
	 IF NOT COMMNT THEN
	    BEGIN  (*  SCAN FIRST FIELD  *)
	    J := I;
	    REPEAT J := SUCC(J) UNTIL (STMNT[J]=' ') OR (STMNT[J]=LABDELIM)
				   OR (J = STMLEN);
	    IF J = STMLN THEN SETERR('S')
	     ELSE
	       BEGIN  (*  GOT FIRST FIELD -- WHAT IS IT  *)
	       SKIPBLANKS(J);
	       IF STMNT[J] = LABDELIM THEN
		  BEGIN  (* IT IS LABEL  *)
		  J := SUCC(J);  HASLBL := TRUE;
		  SKIPBLANKS(J);
		  END;
	       FND := 1;   (*  ONE GOOD FIELD FOUND  *)
	       IF (J <> STMLEN) AND (STMNT[J]<>COMDELIM) THEN  (* MORE GOOD FIELDS *)
		  BEGIN
		  IF (NOT HASLBL) THEN (*  CHECK FOR POSSIBLE EQU OR SET  *)
		     BEGIN
		     LOADOP(J);
		     HASLBL := (STMOP=OPERATIONS[EQU].OPNAME) OR
			       (STMOP=OPERATIONS[SETT].OPNAME);
		     END;
		  IF HASLBL THEN  (* 2ND FIELD IS OP CODE -- SKIP OVER IT  *)
		     BEGIN
		     K := J;
		     WHILE (K<STMLEN) AND (STMNT[K] IN ['A'..'Z','0'..'9']) DO K := SUCC(K);
		     SKIPBLANKS(K);  (* FIND THIRD FIELD *)
		     IF (K=STMLEN) OR (STMNT[K]=COMDELIM) THEN FND:=2 ELSE FND:=3;
		     END   (* THIRD FIELD SEARCH *)
		   ELSE FND := 2;
		  END;      (* MORE FIELD SEARCH  *)
	       END;	    (* NOT ERROR          *)
 
	    CASE FND OF
	      0: ;
	      1: IF HASLBL THEN LABSTR:=I ELSE OPRSTR:=I;
	      2: IF HASLBL
		   THEN BEGIN LABSTR:=I; OPRSTR:=J END
		   ELSE BEGIN OPRSTR:=I; OPDSTR:=J END;
	      3: BEGIN LABSTR:=I; OPRSTR:=J; OPDSTR:=K END
	      END;  (* CASES *)
 
	    END;  (* OF NOT COMMENT *)
	 END;     (*  OF WITH  *)
      END;        (*  OF PARSE *)
 
   PROCEDURE PROCPSEUD(OT:INSTR);	(* PROCESS PSEUDO INSTRUCTION *)
      VAR K,CV:INTEGER; TP:OPNDTP;  W:NAME;  STP:SYMTYP;
      PROCEDURE EE;
	BEGIN
	J := SUCC(J);
	IF J=0 THEN BEGIN SETERR('Y'); J:=STATEMENTS^.STMLEN END ELSE BEGIN
	EVALEXP(J,CV,TP,K);
	IF (TP<>CNST) AND ((OT<>DW) AND ((OT<>EQU) AND (OT<>EQW))) THEN
		BEGIN SETERR('C'); CV:=0 END
	END;
	END;
      BEGIN
      W:=GSYM;
      WITH STATEMENTS^ DO BEGIN
      J := OPDSTR-1;
      CASE OT OF
	IFF:  BEGIN
	      EE;
	      IF IFLEV=8 THEN SETERR('I') ELSE IFLEV:=IFLEV+1;
	      IF GENCODE THEN IFCUR := IFLEV ELSE COMMNT:=TRUE;
	      ADDR := CV;
	      IFLEVS[IFLEV].ISGEN := ODD(CV);
	      IFLEVS[IFLEV].HASELSE := FALSE;
	      END;
 
	ELSEE:BEGIN
	      IF IFLEV=0 THEN SETERR('I')
	      ELSE IF IFLEVS[IFLEV].HASELSE THEN SETERR('I')
		   ELSE BEGIN
			IFLEVS[IFLEV].HASELSE := TRUE;
			IFLEVS[IFLEV].ISGEN := NOT IFLEVS[IFLEV].ISGEN
			END;
	      J := STMLEN;
	      COMMNT := TRUE;
	      END;
 
	ENDIF:BEGIN
	      IF IFLEV=0 THEN SETERR('I')
	      ELSE IFLEV := IFLEV-1;
	      IF IFLEV = IFCUR-1 THEN IFCUR := IFLEV;
	      COMMNT := TRUE;
	      J := STMLEN
	      END;
 
	DB:   BEGIN
	      IF HASLBL THEN S^.STYP := MBYTE;
	      REPEAT
		EE;
		IF SL > 0 THEN IC := IC+SL
		ELSE IF (CV>255) OR (CV<-256) THEN SETERR('E')
		     ELSE IC := IC+1;
		UNTIL ENDOPNDS(J);
	      END;
 
	DW:   BEGIN
	      IF HASLBL THEN S^.STYP := MWORD;
	      REPEAT
		EE;
		IF TP=REG THEN SETERR('C');
		IF SL<>0 THEN SETERR('E')
		ELSE IC := IC+2;
		UNTIL ENDOPNDS(J);
	      END;
 
	DSB:  BEGIN
	      IF HASLBL THEN S^.STYP := MBYTE;
	      EE;
	      IC := IC+CV;
	      END;
 
	DSW:  BEGIN
	      IF HASLBL THEN S^.STYP := MWORD;
	      EE;   IC := IC + 2*CV;
	      END;
 
	EQW,
	EQU:  BEGIN
	      EE;
	      ADDR := CV;
	      IF OT = EQW THEN NEWSYMB(W,CV,PERW,S)
	      		  ELSE NEWSYMB(W,CV,PERM,S);
	      ENTERSYMB(S,GS);
	      END;
 
	STITL     : BEGIN HASSBTL := TRUE; J:=STMLEN END;
 
	GLBL,TITL,EJECT: J:=STMLEN;
 
	LON,LOFF  : BEGIN LSTON  := ST=LON;  COMMNT := TRUE;  J := STMLEN END;
 
	GEN,NOG   : BEGIN PRTGEN := ST=GEN;  COMMNT := TRUE;  J := STMLEN END;
 
	ENDD:	BEGIN
		J := STMLEN;
		IF NOT FIRSTSEG THEN CURSEG^.SVAL := MAXIC
				ELSE DUM1STSEG    := MAXIC;
		END;
 
	XTRNL:
	      IF OPDSTR = 0 THEN SETERR('Y')
	      ELSE
		BEGIN
		STP := XTLB;  CH := STMNT[OPDSTR];  J := J+2;
		COMMNT := TRUE;
		IF CH = 'S' THEN STP := XTLS
		ELSE IF CH = 'W' THEN STP := XTLW
		ELSE IF CH <> 'B' THEN SETERR('G');
		SKIPBLANKS(J);  IF STMNT[J] <> ',' THEN SETERR('G') ELSE
		REPEAT
		  J := J+1;  SKIPBLANKS(J);
		  LOADSYMB(J);  FINDSYMB(GSYM,GS,SFND);
		  IF SFND THEN SETERR('M')
		  ELSE
		    BEGIN
		    NEWSYMB(GSYM,0,STP,S);  ENTERSYMB(S,GS);
		    END;
		  SKIPBLANKS(J);
		  UNTIL ENDOPNDS(J);
		END;
 
	CSEG,DSEG:
		IF HASLBL THEN
		BEGIN
		IF NOT FIRSTSEG THEN CURSEG^.SVAL := MAXIC
				ELSE DUM1STSEG    := MAXIC;
		IC := 0;  FIRSTSEG := FALSE; CURSEG := S;
		J  := STMLEN;  S^.STYP := SEGNM;
		ADDR := 0;  MAXIC := 0;
		END ELSE BEGIN SETERR('H'); COMMNT := TRUE END;
 
	SETT: BEGIN
	      EE;
	      ADDR := CV;
	      IF SFND THEN BEGIN IF (GS^.STYP=CHBL) THEN GS^.SVAL:=CV END
	      ELSE 
		BEGIN
		NEWSYMB(W,CV,CHBL,S);  ENTERSYMB(S,GS)
		END;
	      END;
 
	ORG:  BEGIN
	      EE;  ADDR:=CV;
	      IC := CV;
	      END
 	END;  (*** OF CASES ***)
       IF NEOLINE(J) THEN SETERR('Z');
       END
      END;   (*  PROCPSEUD  *)
 
 
   PROCEDURE PROCCMPLX;		(* PROCESS COMPLEX INSTRUCTION *)
   (** SET MRLN IN CURR INSTR AS FOLLOWS:
	0-2: ONE OPERAND INSTR (INC,ETC)
	3: REG TO R/M
	4: R/M TO REG
	5: IMM TO R/M
	6: IMM TO REG
	7: MEM TO ACC
	8: ACC TO MEM
	9: IMM TO ACC  
	10: ONE/NONE OPERAND
	11: REG-REG XCHNG
	12: RETURN
	13: JMP/CALL DIRECT
	14: JMP/CALL INDIRECT 
	15: IMMED TO R/M (S:W OPTION)	**)
      VAR  L,M:INTEGER; IND:BOOLEAN;
      PROCEDURE EE1;
	BEGIN
	J:=STATEMENTS^.OPDSTR;
	IF J<=0 THEN SETERR('Y')
	ELSE EVALOPND(J,O1);
	END;
      PROCEDURE EE2;
	BEGIN
	WITH STATEMENTS^ DO
	  IF ENDOPNDS(J) THEN SETERR('Y')
	  ELSE BEGIN J:=SUCC(J);  EVALOPND(J,O2) END
	END;
      PROCEDURE SETML(VAR O:OPERAND);
	BEGIN
	M:=O.OPLN+1;
	L := O.OPLN
	END;
      PROCEDURE SETM;
	BEGIN
	L := O1.OPLN;
	M := L;
	WITH STATEMENTS^ DO 
	IF (ST=ADD) OR (ST=ADC) OR (ST=SUB) OR (ST=SBB) OR (ST=CMP) THEN
	   BEGIN
	   MRLN:=15;  
	   IF (O1.OTP=2) AND (O2.OPLN=3) THEN M:=M+3 ELSE M:=M+2
	   END
	ELSE
	   BEGIN
	   MRLN := 5;
	   IF (O1.OTP=2) THEN M:=M+3 ELSE M:=M+2;
	   END;
	IF (O1.OPTP=FREF) THEN BEGIN  M := SUCC(M); L := 4 END;
	END;
      BEGIN
      L:=1;
      WITH STATEMENTS^ DO BEGIN
      CASE ST OF
	INW,INN,INTT,OUT,OUTW:
	   BEGIN  MRLN := 10;
	   IF OPDSTR = 0 THEN M := 1 ELSE M := 2;
	   END;
 
	RETI,RET:
	   BEGIN MRLN:=12;
	   IF OPDSTR=0 THEN M := 1 ELSE M:=3;
	   END;
 
	JMP,CALL:
	   BEGIN  MRLN:=13;
	   IF OPDSTR=0 THEN SETERR('A')
	   ELSE
	    BEGIN
	    J := OPDSTR;
	    IND := STMNT[J]='^';
	    IF IND THEN J := SUCC(J);
	    EVALOPND(J,O1);
	    IF ISEGJ THEN M := 5 ELSE
	    IF IND OR (O1.RB<>0) OR (O1.RX<>0) THEN
	      BEGIN SETML(O1);  MRLN:=14; IF O1.OSR<>0 THEN M:=M+1 END
	    ELSE
	      BEGIN
	      J := O1.OPV-ADDR-2;  (** CALCULATE DISPL  **)
	      IF (ST=JMP) AND ((J<128) AND (J>=-128)) AND (O1.OPTP<>FREF) THEN M:=2
	      ELSE M:=3;
	      L := M
	      END
	    END;
	   END;
 
	INC,DEC,PUSH,POP:
	  BEGIN
	  EE1;
	  IF O1.OPTP=REG THEN
	     BEGIN
	     MRLN := 0;
	     IF (ST=INC) OR (ST=DEC) THEN
		IF O1.OPV<8 THEN M := 1
			    ELSE M := 2
	     ELSE M := 1
	     END
	  ELSE BEGIN SETML(O1); IF M=2 THEN MRLN:=1 ELSE MRLN:=M-2 END;
	  IF O1.OSR<>0 THEN M := M+1;
	  END;
 
	XCHG:
	  BEGIN
	  EE1;  EE2;  MRLN:=3;
	  IF (O1.OPTP=REG) AND (O2.OPTP=REG) AND 
	     (((O1.OPV=0) AND (O2.OPV<8)) OR ((O2.OPV=0) AND (O1.OPV<8)))
		THEN BEGIN M := 1;  MRLN := 11 END
	  ELSE
	   IF (O1.OPTP=REG) AND (O2.OPTP<>CNST) THEN BEGIN SETML(O2); MRLN:=4 END
	   ELSE
	    IF (O2.OPTP=REG) AND (O1.OPTP<>CNST) THEN SETML(O1)
	    ELSE  BEGIN M:=3; SETERR('X') END;
	  IF (O1.OSR<>0) OR (O2.OSR<>0) THEN M:=M+1
	  END;
 
	OTHERS:  (***  OTHER OPERATIONS -- MOV,ADD,ETC  ***)
	  BEGIN
	  EE1;  EE2;
	  IF O2.OPTP=CNST THEN  (**  IMMEDIATE  OPERATION  **)
	     IF O1.OPTP=REG THEN  (** IMM TO REG  **)
		IF ST=MOV THEN BEGIN M := O1.OTP+1; MRLN:=6 END
		ELSE
		 IF O1.OPV=8 (** AL **) THEN BEGIN M:=2; MRLN:=9 END
		 ELSE
		  IF O1.OPV=0  (** AX **) THEN BEGIN M:=3; MRLN:=9 END
		  ELSE SETM
	     ELSE  (** NOT REG **)
		SETM
	  ELSE  (** NOT IMMED **)
	   IF (O1.OPTP=REG) AND (O2.OPTP=REG) THEN
	      BEGIN
	      M := 2;  
	      IF O2.OPV>15 THEN MRLN := 3 ELSE MRLN := 4
	      END
	   ELSE
	   IF (ST=MOV) AND (O1.OPTP=REG) AND ((O1.OPV=0) OR (O1.OPV=8))
		       AND (O2.RB=0) AND (O2.RX=0) THEN
		BEGIN M:=3; MRLN:=7 END
	   ELSE
	    IF (ST=MOV) AND (O2.OPTP=REG) AND ((O2.OPV=0) OR (O2.OPV=8)) 
			AND (O1.RB=0) AND (O1.RX=0)  THEN
		BEGIN M:=3; MRLN:=8 END
	     ELSE
		IF (O1.OPTP=REG) THEN BEGIN SETML(O2); MRLN:=4 END
		ELSE
		 IF O2.OPTP=REG THEN BEGIN SETML(O1); MRLN:=3 END
		 ELSE BEGIN IF O2.OPLN=0 THEN O2.OPLN:=2;  SETM;
		      IF O2.OPTP<>OFFS THEN SETERR('R');
		      END;
	  IF (O1.OSR<>0) OR (O2.OSR<>0) THEN M := M+1
	  END
       END;  (*** OF CASES  ***)
      IC := IC+M;
      MRLN := L*32 + MRLN;
      END;   (*  WITH  *)
      END;   (*  PROCCMPLX  *)
  
 
   PROCEDURE PROCMAC;		(**  PROCESS MACRO DEFINITION  **)
      VAR M	: MACPTR;  ENDM : BOOLEAN;
	  PARMS : ARRAY [ 1..MXPV ] OF NAME;
	  J,K,N : INTEGER;
 
      FUNCTION ITISPARM(VAR I : INTEGER) : BOOLEAN;
	VAR F : BOOLEAN;
	BEGIN
	I := 0;  F := FALSE;
	WHILE NOT F AND (N>I) DO
	   BEGIN
	   I := SUCC(I);  F := GSYM=PARMS[I];
	   END;
	ITISPARM := F;
	END;
 
      PROCEDURE INDP(I,J,K : INTEGER); 	(**  MARK PARAMETER  **)
	(** COLS I TO J ARE PARAMETER K
	    CHAR > 128 INDICATES PARAMETER
	    LOW 4 BITS ARE PARAM #, BITS 5-6 ARE PARAM LEN  **)
	BEGIN
	  MACF^[I] := CHR(128 + K + (J-I+1)*16);
	  FOR I := I+1 TO J DO MACF^[I] := ' '
	END;
 
      PROCEDURE CHCKSYMB (VAR I : INTEGER);  (**  CHECK IF SYMBOL IS PARAMETER  **)
	VAR J,K : INTEGER;
	BEGIN
	J := I;  LOADSYMB(J);
	IF ITISPARM(K) THEN INDP(I,J-1,K);
	I := J;
	END;
 
      BEGIN
      NEW(M);
      WITH STATEMENTS^ DO BEGIN
      J := LABSTR;  LOADSYMB(J);
      M^.MACNAME := GSYM;   (** LOOK FOR REDEF SOME DAY **)
      M^.MACTXT  := NCR;
      M^.MACNXT  := NIL;
      IF FIRSTM = NIL THEN FIRSTM := M
		      ELSE LASTM^.MACNXT := M;
      LASTM := M;
      COMMNT := TRUE;  ENDM := FALSE;
      HASLBL := FALSE;
      J := PRED(OPDSTR);	(*  FIND PARAMETERS  *)
      N := 0;
      IF OPDSTR <> 0 THEN
	REPEAT
	J := SUCC(J);  SKIPBLANKS(J);  (**  GET PAST ','  *)
	LOADSYMB(J);
	SKIPBLANKS(J);
	N := SUCC(N);   (**  CHECK FOR ERROR  ???  **)
	PARMS[N] := GSYM;
	UNTIL ENDOPNDS(J);
      END;   (** WITH  **)
      M^.MACPS := N;     (**  SET NUMBER PARAMETERS  **)
      REPEAT
	NRC := SUCC(NRC);  PUT (STATEMENTS);
	WITH STATEMENTS^ DO
	BEGIN
	READREC(STMNT);
	PARSE  (STATEMENTS^);
	MACF^ := STMNT;
	(**  INDICATE PARAMETERS IN TEXT  **)
	IF HASLBL THEN CHCKSYMB(LABSTR);
	IF OPRSTR <> 0 THEN
	   BEGIN
	   CHCKSYMB(OPRSTR);
	   ENDM := GSYM = 'ENDM  ';
	   END;
	IF OPDSTR <> 0 THEN
	   BEGIN
	   OPDSTR := PRED(OPDSTR);
	   REPEAT
	     OPDSTR := SUCC(OPDSTR);
	     SKIPBLANKS(OPDSTR);
	     CHCKSYMB(OPDSTR);
	     SKIPBLANKS(OPDSTR);
	     UNTIL NOT NEOLINE (OPDSTR);
	   END;
	ST := DSB;
	COMMNT := TRUE;
	ERRS   := '  ';
	HASLBL := FALSE;
	M^.MACLST := NCR;
	END;
	PUT (MACF,NCR);  NCR := SUCC(NCR);
	UNTIL ENDM OR EOFLG;
      END;
 
   PROCEDURE READMAC;		(**  EXPAND MACRO CALL  **)
      VAR  N,J:INTEGER;
      BEGIN
      M := MM;
      MX := M^.MACTXT;
      GET (MACF,MX);
      XPANDM := M^.MACLST <> MX;
      WITH STATEMENTS^ DO
      BEGIN
      N := 0;
      IF OPDSTR > 0 THEN
	BEGIN
	OPDSTR := PRED(OPDSTR);
	REPEAT
	  OPDSTR := SUCC(OPDSTR);  SKIPBLANKS(OPDSTR);
	  J := 1;
	  WHILE (J <= NAMELEN) AND NOT (STMNT[J+OPDSTR-1] IN [' ',',']) DO
	    BEGIN
	    GSYM[J] := STMNT[J+OPDSTR-1];
	    J := SUCC(J);
	    END;
	  OPDSTR := OPDSTR + J - 1;  SKIPBLANKS(OPDSTR);
	  FOR J := J TO NAMELEN DO GSYM[J] := ' ';
	  N := SUCC(N);
	  IF N > MXPV THEN BEGIN N := MXPV; SETERR('G'); END;
	  PARMV[N] := GSYM;
	  UNTIL ENDOPNDS(OPDSTR);
	END;
      IF N > M^.MACPS THEN SETERR('G')
      ELSE FOR N := N+1 TO M^.MACPS DO NEXTLS(PARMV[N]);
      COMMNT := TRUE;
      IF HASLBL THEN
	BEGIN
	J := LABSTR;  LOADSYMB(J);
	FINDSYMB(GSYM,GS,SFND);
	IF SFND THEN SETERR('M')
	ELSE
	  BEGIN
	  NEWSYMB(GSYM,ADDR,MEMR,S);  ENTERSYMB(S,GS);
	  END;
	END;
     END;
     END;
 
 
   BEGIN (*  PASS ONE  *)
   PASS1 := TRUE;
   NRC   := 0;
   NCR   := 1;
   FIRSTM:= NIL;  LASTM := NIL;
   PRTGEN := FALSE;  LSTON := TRUE;  LOCSYM := '@@000 ';
   EOFLG := FALSE;		      (* NOT AT EOF YET *)
   REWRITE(STATEMENTS,'SC.TMP',,,[RANDOM,TEMPORARY]); (* OPEN TEMP FILES *)
   REWRITE(MACF,'MAC.TMP',,,[RANDOM,TEMPORARY]);
   XPANDM := FALSE;
   IC := 0;  MAXIC := 0;	      (* INSTRUCTION COUNTER AT ZERO *)
   REPEAT
      WITH STATEMENTS^ DO
      BEGIN
      ERRS := '  ';		(* NO ERRORS AT START *)
      READREC(STMNT);		(* GET NEXT STATEMENT *)
      PARSE(STATEMENTS^);	(* DETERMINE WHERE FIELDS ARE *)
      ADDR := IC;  MRLN := 0;  ERRCNT:= 0;  ST := DSB;
      IF HASLBL AND (OPRSTR=0)  THEN 	(**  LABEL ONLY ON THIS LINE  **)
	 BEGIN
	 IF GENCODE THEN BEGIN
	 J := LABSTR;  LOADSYMB(J);
	 FINDSYMB(GSYM,GS,SFND);
	 IF SFND THEN SETERR('M')
	 ELSE 
	   BEGIN
	   NEWSYMB(GSYM,ADDR,MEMR,S);  ENTERSYMB(S,GS)
	   END;
	 END  ELSE HASLBL:=FALSE;
	 COMMNT := TRUE
	 END;
      IF NOT COMMNT AND (ERRS='  ') THEN
	 BEGIN
	 LOADOP (OPRSTR);
 
	 ST := AAA;		(* FIND THE OP CODE IN THE TABLE *)
	 WHILE (ST < XOR) AND (OPERATIONS[ST].OPNAME <> STMOP) DO ST := SUCC(ST);
 
	 IF GENCODE OR (ST=ELSEE) OR (ST=ENDIF) OR (ST=IFF) THEN
	 IF OPERATIONS[ST].OPNAME <> STMOP THEN 
	    BEGIN
	    MM := FIRSTM;  SFND := FALSE;
	    WHILE (MM <> NIL) AND NOT SFND DO
		BEGIN
		SFND := MM^.MACNAME = STMOP;
		IF NOT SFND THEN MM := MM^.MACNXT;
		END;
	    IF SFND THEN READMAC ELSE SETERR('B')
	    END
	  ELSE
	    IF ST = MCR THEN PROCMAC
	    ELSE
	    BEGIN
	    IF HASLBL THEN
		BEGIN
		J := LABSTR;  LOADSYMB(J);
		FINDSYMB(GSYM,GS,SFND);
		IF SFND AND ((ST<>SETT) OR (GS^.STYP<>CHBL)) THEN SETERR('M')
		ELSE IF (ST<>SETT) AND (ST<>EQU) THEN
		   BEGIN
		   NEWSYMB(GSYM,ADDR,MEMR,S);  ENTERSYMB(S,GS)
		   END;
		END;
	    CASE OPERATIONS[ST].OPTYP OF
	       PSEUD : PROCPSEUD(ST);
	       ONEMOP:  BEGIN
			IF OPDSTR > 0 THEN BEGIN
			J := OPDSTR;
			EVALOPND(J,O1);
			IF STMNT[J] = ',' THEN
			   BEGIN
			   J := SUCC(J);  EVALOPND(J,O2);
			   IF (ST<RCL) THEN O1 := O2
			   END;
			IF O1.OPTP=CNST THEN SETERR('A')
			ELSE IF O1.OPTP=REG THEN MRLN:=0
			     ELSE MRLN:=O1.OPLN-1;
			END;
			IC := IC + MRLN + 2;
			IF O1.OSR <> 0 THEN IC := IC+1
			END;
		NOOPS:  IC := IC+1;
		TWOB,DISPL : IC := IC+2;
	        CMPLX : PROCCMPLX
	      END  (*** CASES ***)
 
 
	    END (* OF ERROR SKIP   *)
	 ELSE   (* IN CONDITIONAL SKIP *)
	    BEGIN COMMNT:=TRUE;  ST:=IFF;  HASLBL:=FALSE END
	 END;   (* OF COMMENT SKIP *)
      END;      (*  OF WITH  *)
 
      NRC := SUCC(NRC);
      PUT (STATEMENTS);		(*  OUTPUT TO SCRATCH FILE  *)
      IF IC > MAXIC THEN MAXIC := IC;
      UNTIL (STMOP = 'END   ') OR EOFLG;
   END.  (*  PASS ONE  *)
