head     56.3;
access   paws bayes jws quist brad dew jwh;
symbols  ;
locks    ; strict;
comment  @# @;


56.3
date     93.01.27.13.34.45;  author jwh;  state Exp;
branches ;
next     56.2;

56.2
date     93.01.27.12.11.04;  author jwh;  state Exp;
branches ;
next     56.1;

56.1
date     91.11.05.09.24.52;  author jwh;  state Exp;
branches ;
next     55.1;

55.1
date     91.08.25.10.02.06;  author jwh;  state Exp;
branches ;
next     54.1;

54.1
date     91.03.18.15.12.26;  author jwh;  state Exp;
branches ;
next     53.1;

53.1
date     91.03.11.19.13.25;  author jwh;  state Exp;
branches ;
next     52.1;

52.1
date     91.02.19.08.58.35;  author jwh;  state Exp;
branches ;
next     51.1;

51.1
date     91.01.30.15.57.31;  author jwh;  state Exp;
branches ;
next     50.1;

50.1
date     90.10.29.16.10.22;  author jwh;  state Exp;
branches ;
next     49.1;

49.1
date     90.08.14.13.59.35;  author jwh;  state Exp;
branches ;
next     48.1;

48.1
date     90.07.26.11.04.59;  author jwh;  state Exp;
branches ;
next     47.1;

47.1
date     90.05.14.10.38.38;  author dew;  state Exp;
branches ;
next     46.1;

46.1
date     90.05.07.08.28.43;  author jwh;  state Exp;
branches ;
next     45.1;

45.1
date     90.04.19.15.35.49;  author jwh;  state Exp;
branches ;
next     44.1;

44.1
date     90.04.01.21.53.26;  author jwh;  state Exp;
branches ;
next     43.1;

43.1
date     90.03.20.13.43.16;  author jwh;  state Exp;
branches ;
next     42.1;

42.1
date     90.01.23.17.28.36;  author jwh;  state Exp;
branches ;
next     41.1;

41.1
date     89.12.22.11.11.18;  author jwh;  state Exp;
branches ;
next     40.1;

40.1
date     89.09.29.11.34.26;  author jwh;  state Exp;
branches ;
next     39.1;

39.1
date     89.09.26.16.19.50;  author dew;  state Exp;
branches ;
next     38.1;

38.1
date     89.08.29.11.09.45;  author jwh;  state Exp;
branches ;
next     37.1;

37.1
date     89.05.12.11.22.36;  author dew;  state Exp;
branches ;
next     36.1;

36.1
date     89.02.06.10.01.44;  author dew;  state Exp;
branches ;
next     35.1;

35.1
date     89.02.02.13.11.13;  author dew;  state Exp;
branches ;
next     34.1;

34.1
date     89.01.23.15.47.21;  author jwh;  state Exp;
branches ;
next     33.1;

33.1
date     89.01.16.11.23.49;  author dew;  state Exp;
branches ;
next     32.1;

32.1
date     89.01.10.11.28.25;  author bayes;  state Exp;
branches ;
next     31.1;

31.1
date     88.12.14.17.49.21;  author bayes;  state Exp;
branches ;
next     30.1;

30.1
date     88.12.09.13.27.48;  author dew;  state Exp;
branches ;
next     29.1;

29.1
date     88.10.31.15.12.08;  author bayes;  state Exp;
branches ;
next     28.1;

28.1
date     88.10.06.10.42.47;  author dew;  state Exp;
branches ;
next     27.1;

27.1
date     88.09.29.11.04.12;  author bayes;  state Exp;
branches ;
next     26.1;

26.1
date     88.09.28.12.16.06;  author bayes;  state Exp;
branches ;
next     25.1;

25.1
date     88.03.02.08.57.28;  author bayes;  state Exp;
branches ;
next     24.1;

24.1
date     87.08.31.08.55.10;  author jws;  state Exp;
branches ;
next     23.1;

23.1
date     87.08.26.09.31.44;  author bayes;  state Exp;
branches ;
next     22.1;

22.1
date     87.08.17.10.08.29;  author bayes;  state Exp;
branches ;
next     21.1;

21.1
date     87.08.12.12.57.38;  author bayes;  state Exp;
branches ;
next     20.1;

20.1
date     87.07.30.10.08.27;  author bayes;  state Exp;
branches ;
next     19.1;

19.1
date     87.06.01.07.30.04;  author jws;  state Exp;
branches ;
next     18.1;

18.1
date     87.05.20.14.20.34;  author bayes;  state Exp;
branches ;
next     17.1;

17.1
date     87.04.30.09.38.26;  author jws;  state Exp;
branches ;
next     16.1;

16.1
date     87.04.26.14.55.32;  author jws;  state Exp;
branches ;
next     15.1;

15.1
date     87.04.13.08.17.44;  author jws;  state Exp;
branches ;
next     14.1;

14.1
date     87.04.01.14.01.38;  author jws;  state Exp;
branches ;
next     13.1;

13.1
date     87.02.28.17.47.58;  author jws;  state Exp;
branches ;
next     12.1;

12.1
date     87.02.02.12.32.22;  author jws;  state Exp;
branches ;
next     11.1;

11.1
date     87.01.19.08.58.51;  author jws;  state Exp;
branches ;
next     10.1;

10.1
date     86.12.24.10.02.06;  author jws;  state Exp;
branches ;
next     9.1;

9.1
date     86.12.12.13.18.31;  author bayes;  state Exp;
branches ;
next     8.1;

8.1
date     86.11.27.11.00.13;  author jws;  state Exp;
branches ;
next     7.1;

7.1
date     86.11.20.12.45.34;  author hal;  state Exp;
branches ;
next     6.1;

6.1
date     86.11.04.16.40.58;  author paws;  state Exp;
branches ;
next     5.1;

5.1
date     86.10.28.14.00.50;  author hal;  state Exp;
branches ;
next     4.1;

4.1
date     86.09.30.18.25.57;  author hal;  state Exp;
branches ;
next     3.1;

3.1
date     86.09.01.11.12.59;  author hal;  state Exp;
branches ;
next     2.2;

2.2
date     86.08.26.11.15.23;  author geli;  state Exp;
branches ;
next     2.1;

2.1
date     86.07.30.14.01.21;  author hal;  state Exp;
branches ;
next     1.1;

1.1
date     86.06.30.12.50.40;  author danm;  state tmp;
branches ;
next     ;


desc
@Base file for PWS 3.2 release.

@


56.3
log
@
pws2rcs automatic delta on Wed Jan 27 13:14:25 MST 1993
@
text
@$ovflcheck on$
PROCEDURE GETCONST{VAR VAL: EXPRVALUE, VAR COLL: SHORTINT}; {FORWARD DECLARED}
     { GET A NUMERIC CONSTANT IN HEX OR DECIMAL }
     { ASSUMES LINE[COLL] IS FIRST CHAR OF CONSTANT }

    const opsok=100;

    VAR RADIX, I: SHORTINT;
	LASTCH,CH : CHAR;
	MYVAL: PACKED RECORD CASE INTEGER OF
		 0: (W32: WORD32);
		 1: (HEXES: PACKED ARRAY[0..7] OF 0..15)
	       END;
	CVAL: WORD32;
	CONS: STRING80;

    BEGIN
    RADIX:=10;  { SET DEFAULT RADIX }
    CONS:=''; CH:=LINE[COLL];
    IF CH='$' THEN BEGIN RADIX:=16; COLL:=COLL+1; CH:=LINE[COLL];
       IF NOT(CH IN ['0'..'9','A'..'F']) THEN ERROR(ERRBADCONST);
    END;
    WHILE CH IN ['0'..'9', 'A'..'F'] DO
      BEGIN
	LASTCH:=CH;
	IF CH>='A' THEN
	  CH:=CHR(ORD(CH)-ORD('A')+10)
	ELSE
	  CH:=CHR(ORD(CH)-ORD('0'));
	IF (CH>CHR(0)) OR (LENGTH(CONS)>0) THEN { IGNORE LEADING ZEROES }
	  BEGIN
	    CONS[0]:=SUCC(CONS[0]); CONS[LENGTH(CONS)]:=CH;
	  END;
	COLL:=COLL+1;
	CH:=LINE[COLL];
      END;
    MYVAL.W32.LOHALF:=0;
    MYVAL.W32.HIHALF:=0; CVAL.HIHALF:=0;
    try
    if radix = 16 then
      IF LENGTH(CONS)>8 THEN ERROR(ERRBADCONST)
      ELSE FOR I:=1 TO LENGTH(CONS) DO
	MYVAL.HEXES[7-LENGTH(CONS)+I]:=ORD(CONS[I])
    else if radix = 10 then
      FOR I:=1 TO LENGTH(CONS) DO
	  BEGIN
	    CVAL.LOHALF:=ORD(CONS[I]);
	    IF CVAL.LOHALF>=RADIX THEN ERROR(ERRBADCONST)
	    ELSE
	    MYVAL.W32.LONGINT:=MYVAL.W32.LONGINT*RADIX+CVAL.LONGINT;
	  END;
    escape(opsok);
    recover
      if escapecode<>opsok then begin
	  myval.w32.longint:=0;
	  error(errbadconst);
	end;
      VAL.BASE:=ABSOLUT;
      VAL.OFFSET:=MYVAL.W32;
      VAL.EMODE:=NOMODE;
      VAL.EXPREFS:=NIL;
  END;  { GETCONST}
$ovflcheck off$

PROCEDURE ALPHACONS(VAR CVALUE:EXPRVALUE; VAR CURCOL: SHORTINT);

CONST ALPHAOK=100; BADALPHA=101;
VAR I: SHORTINT;
    CONS: STRING80;
    MYVAL: WORD32;

BEGIN
TRY
IF (CURROP.NAME<>'DC       ') OR (PASS=1) THEN BEGIN
  LINECOPY:=PRINTLINE;
  LINECOPY[0]:=SUCC(LINECOPY[0]);
  LINECOPY[LENGTH(LINECOPY)]:=BLANK;
END;
CONS:='';
I:=0;
MYVAL:=ZERO32;
WHILE CURCOL<LENGTH(LINE) DO BEGIN
  CURCOL:=CURCOL+1;
  IF LINECOPY[CURCOL]=CHR(39) THEN
    IF LINECOPY[CURCOL+1]=CHR(39) THEN BEGIN
      CURCOL:=CURCOL+1;
      I:=I+1;
      IF I>4 THEN ESCAPE(BADALPHA);
      CONS[0]:=SUCC(CONS[0]);
      CONS[I]:=LINECOPY[CURCOL];
    END
    ELSE BEGIN CURCOL:=CURCOL+1;
      ESCAPE(ALPHAOK);
    END
  ELSE BEGIN
    I:=I+1;
    IF I>4 THEN ESCAPE(BADALPHA);
    CONS[0]:=SUCC(CONS[0]);
    CONS[I]:=LINECOPY[CURCOL];
  END
END;
ESCAPE(BADALPHA);
RECOVER
IF ESCAPECODE=BADALPHA THEN ERROR(ERRBADCONST)
ELSE IF ESCAPECODE=ALPHAOK THEN BEGIN
  CASE LENGTH(CONS) OF
    1: MYVAL.BYTE4:=ORD(CONS[1]);
    2: BEGIN
	 MYVAL.BYTE3:=ORD(CONS[1]);
	 MYVAL.BYTE4:=ORD(CONS[2]);
       END;
    3: BEGIN
	 MYVAL.BYTE2:=ORD(CONS[1]);
	 MYVAL.BYTE3:=ORD(CONS[2]);
	 MYVAL.BYTE4:=ORD(CONS[3]);
       END;
    4: BEGIN
	 MYVAL.BYTE1:=ORD(CONS[1]);
	 MYVAL.BYTE2:=ORD(CONS[2]);
	 MYVAL.BYTE3:=ORD(CONS[3]);
	 MYVAL.BYTE4:=ORD(CONS[4]);
       END;
  END; {CASE}
END ELSE ESCAPE(ESCAPECODE); {IF}
CVALUE.OFFSET:=MYVAL;
CVALUE.EMODE:=NOMODE;
CVALUE.BASE:=ABSOLUT;
CVALUE.EXPREFS:=NIL;
END;


PROCEDURE GETSYMBOL{VAR VAL: EXPRVALUE, VAR COLL: SHORTINT}; {FORWARD DECLARED}
     { GET THE VALUE OF A SYMBOL }

  VAR SYM: STREF;
      STARTCOL: SHORTINT;

  BEGIN
    STARTCOL:=COLL;
    if startcol=length(line) then lab:=''
    else begin
      REPEAT COLL:=COLL+1
$if mc68881$
	UNTIL (CHTYPE[LINE[COLL]]=SPECIAL)
		or ( fpreadmode and (line[ coll ] = ':') );
$end$
$if not mc68881$
	UNTIL CHTYPE[LINE[COLL]]=SPECIAL;
$end$
      LAB:=COPY(LINE,STARTCOL,COLL-STARTCOL);
    end;
    IF LAB='*' THEN
      BEGIN
	VAL.OFFSET:=LOCCTR;
	IF PCMODE=ABS THEN VAL.BASE:=ABSOLUT ELSE VAL.BASE:=RELATIVE;
	VAL.EMODE:=NOMODE;
	VAL.EXPREFS:=NIL;
      END
    ELSE
      BEGIN
	LOOKUPSYMBOL(SYM);
	IF SYM=NIL THEN
	  BEGIN
	    IF PASS=2 THEN ERROR(ERRUNDEFSYM);
	     VAL.EXPREFS:=NIL; VAL.OFFSET:=ZERO32;
	     VAL.BASE:=ABSOLUT;
	     VAL.EMODE:=NOMODE; FWDREF:=TRUE;
	  END
	ELSE
	  BEGIN
	    IF (SYM^.DEFINED=-1) AND (PASS=2) THEN ERROR(ERRUNDEFSYM);
	    IF (SYM^.DEFINED>LINENO) or
	       (sym^.defined=-1)  THEN FWDREF:=TRUE;
	    VAL.OFFSET:=SYM^.SVALUE;
	    VAL.BASE:=SYM^.SKIND;
	    VAL.EXPREFS:=SYM^.SEXTPTR;
	    VAL.EMODE:=SYM^.SMODE;
	    IF SYM^.EXT THEN BEGIN
	      try
		NEW(VAL.EXPREFS)
	      recover begin
		if escapecode=-2 then begin
		  writeln(lp,'MEMORY OVERFLOW!');
		  LPCHECK;      { 3/2/84 }
		  if listname<>'CONSOLE:' then
		    writeln('MEMORY OVERFLOW!');
		  escape(-1);
		end else escape(escapecode);
	      end;
	      VAL.EXPREFS^.MINUS:=FALSE;
	      if (sym^.svalue.longint=1) then
		val.offset:=globalptr^.location
	      else val.offset:=zero32;
	      VAL.EXPREFS^.SYMPT:=SYM;
	    END
	  END;
      END;
    END; { GETSYMBOL }

$ovflcheck on$
PROCEDURE NEGEXPR(* VAR VAL: EXPRVALUE *); { FORWARD DECLARED }
const badexit=101;

 BEGIN
   if val.base=relative then begin
     error(errbadbase);
     escape(badexit)
   end;
   val.offset.longint:=-val.offset.longint;
   IF VAL.EXPREFS<>NIL THEN
     IF VAL.EXPREFS^.MINUS THEN VAL.EXPREFS^.MINUS:=FALSE
       ELSE VAL.EXPREFS^.MINUS:=TRUE
 END;
$ovflcheck off$

 { ******** EXPRESSION EVALUATION ***********}

$include 'M68KFPEXP'$


$ovflcheck on$
PROCEDURE EXPRESS { GIVERRORS: BOOLEAN; VAR EVALOK: EVALWHEN;
		     VAR EVALUE: EXPRVALUE; VAR COL: SHORTINT } ;

  { **********************************************************
       EVALUATE AN ABSOLUTE OR RELATIVE MODE EXPRESSION.

     IF "GIVERRORS" THEN ISSUE ERRORS FOR UNDEFINED SYMBOLS.

     RETURNS EVALOK AS FOLLOWS:

       NOK: EXPRESSION COULD NOT BE EVALUATED-- SOME ERRORS DON'T GIVE THIS!

       OK1: EXPRESSION VALUE CAN BE DETERMINED IN PASS 1;
       OK2: EXPRESSION VALUE CAN BE DETERMINED IN PASS 2;
	(EXCEPT FOR EXTERNALS)

       RETURNS EVALUE AS EXPRESSION VALUE.

       ADVANCES "COL" PAST EXPRESSION IF POSSIBLE.

    ************************************************************}

 CONST PLUS='+'; MINUS='-'; ASTERISK='*'; DIVIDE='/';
       COLON=':'; LBRACE='{'; RBRACE = '}'; LBRACK='['; RBRACK = ']';
       AMPERSAND='&'; BITWISEOR='!'; LSHIFT='<<'; RSHIFT='>>';
       OPENPAREN='('; CLOSEPAREN=')';

       NORMALEXIT=100; BADEXIT=101;  { ESCAPE CODES }


 TYPE SETREC=RECORD
	       CASE INTEGER OF
		 0:(ASET: SET OF 0..31);
		 1:(WORDS: PACKED RECORD
			     LENGTH: SHORTINT;
			     JINT: INTEGER;
			   END);
	     END;

 VAR CH: CHAR; COLL: SHORTINT;
     LVALUE,RVALUE: EXPRVALUE;
     JUNK,JUNK2: SETREC;


 PROCEDURE JOINEXTLISTS;
 BEGIN
 IF RVALUE.EXPREFS<>NIL THEN
   IF LVALUE.EXPREFS=NIL
     THEN LVALUE.EXPREFS:=RVALUE.EXPREFS
     ELSE IF GIVERRORS THEN ERROR(ERREXTREFS);
 {
 IF RVALUE.EMODE<>NOMODE THEN
   IF LVALUE.EMODE=NOMODE
     THEN LVALUE.EMODE:=RVALUE.EMODE
     ELSE IF GIVERRORS THEN ERROR(ERRBADEXPR);
 }
 IF      (LVALUE.EMODE =NOMODE) AND (RVALUE.EMODE<>NOMODE) THEN
   LVALUE.EMODE:=RVALUE.EMODE
 ELSE IF                            (RVALUE.EMODE =NOMODE) THEN
 ELSE IF (LVALUE.EMODE = SMODE) AND (RVALUE.EMODE = SMODE) THEN
 ELSE IF (LVALUE.EMODE = LMODE) AND (RVALUE.EMODE = LMODE) THEN
 ELSE IF GIVERRORS THEN ERROR(ERRBADEXPR);
 END;

 PROCEDURE PRIMARY(VAR VAL:EXPRVALUE);
 BEGIN
   IF LINE[COLL] IN ['A'..'Z','_','@@','*'] THEN BEGIN   {allow '_' and '@@'}
							{jch 08/26/86}
     GETSYMBOL(VAL,COLL);
     IF FWDREF THEN EVALOK:=OK2;
   END
   ELSE IF LINE[COLL] IN ['0'..'9','$'] THEN GETCONST(VAL,COLL)
     ELSE IF LINE[COLL]=CHR(39) THEN ALPHACONS(VAL, COLL)
     ELSE BEGIN
	    IF GIVERRORS THEN ERROR(ERRBADEXPR);
	    ESCAPE(BADEXIT);
	  END;
END;


$ovflcheck on$
PROCEDURE OPERFOLD;

 VAR BOTHCONST: BOOLEAN;

 BEGIN
 TRY
   BOTHCONST:=(LVALUE.BASE=ABSOLUT) AND (RVALUE.BASE=ABSOLUT) AND
	      (LVALUE.EXPREFS=NIL) AND (RVALUE.EXPREFS=NIL);
   IF ((LVALUE.BASE<>ABSOLUT) AND (LVALUE.BASE<>RELATIVE)) OR
      ((RVALUE.BASE<>ABSOLUT) AND (RVALUE.BASE<>RELATIVE)) THEN BEGIN
	ERROR(ERRBADEXPR);
	ESCAPE(BADEXIT);
   END;
   CASE CH OF
	     PLUS: IF (LVALUE.BASE=ABSOLUT) OR (RVALUE.BASE=ABSOLUT) THEN
		     BEGIN
		       IF RVALUE.BASE<>ABSOLUT THEN LVALUE.BASE:=RVALUE.BASE;
		       lvalue.offset.longint:=lvalue.offset.longint+
					       rvalue.offset.longint;
		       JOINEXTLISTS;
		     END
		   ELSE IF GIVERRORS THEN ERROR(ERRBADBASE);

	     MINUS: IF (RVALUE.BASE=ABSOLUT) OR (RVALUE.BASE=LVALUE.BASE) THEN
		    BEGIN
		      IF RVALUE.BASE<>ABSOLUT THEN  begin
			LVALUE.BASE:=ABSOLUT;
			rvalue.base:=absolut;
		      end;
		      NEGEXPR(RVALUE);
		      lvalue.offset.longint:=lvalue.offset.longint+
					     rvalue.offset.longint;
		      JOINEXTLISTS;
		    END
		    ELSE IF GIVERRORS THEN ERROR(ERRBADBASE) ;

	     BITWISEOR: IF BOTHCONST THEN
			   BEGIN
			     JUNK.WORDS.LENGTH:=4;
			     JUNK.WORDS.JINT:=LVALUE.OFFSET.LONGINT;
			     JUNK2.WORDS.LENGTH:=4;
			     JUNK2.WORDS.JINT:=RVALUE.OFFSET.LONGINT;
			     JUNK.ASET:=JUNK.ASET+JUNK2.ASET;
			     LVALUE.OFFSET.LONGINT:=JUNK.WORDS.JINT;
			   END
			ELSE IF GIVERRORS THEN ERROR(ERRBADBASE);

	     AMPERSAND: IF BOTHCONST THEN
			    BEGIN
			      JUNK.WORDS.LENGTH:=4;
			      JUNK2.WORDS.LENGTH:=4;
			      JUNK.WORDS.JINT:=LVALUE.OFFSET.LONGINT;
			      JUNK2.WORDS.JINT:=RVALUE.OFFSET.LONGINT;
			      JUNK.ASET:=JUNK.ASET * JUNK2.ASET;
			      LVALUE.OFFSET.LONGINT:=JUNK.WORDS.JINT;
			    END
			ELSE IF GIVERRORS THEN ERROR(ERRBADBASE);

	     END;  { CASE }
    RECOVER
      IF ESCAPECODE<>NORMALEXIT THEN ESCAPE(ESCAPECODE);
  END; { OPERFOLD }
  $ovflcheck off$


  BEGIN { EXPRESSION }
    TRY
      FWDREF:=FALSE;
      EVALUE.EMODE:=NOMODE;
      COLL:=COL;
      EVALOK:=OK1;   { UNTIL PROVE OTHERWISE }
      IF LINE[COLL] IN [PLUS, MINUS] THEN { UNARY OP }
	BEGIN
	  CH:=LINE[COLL];
	  COLL:=COLL+1;
	  PRIMARY(LVALUE);
	  IF (LVALUE.BASE<>ABSOLUT) AND (LVALUE.BASE<>RELATIVE) THEN BEGIN
	    ERROR(ERRBADEXPR);
	    ESCAPE(BADEXIT);
	  END;
	  CASE CH OF
	    PLUS: ;   { NO ACTION FOR UNARY + }
	    MINUS: NEGEXPR(LVALUE);
	  END;
	END
      ELSE BEGIN
	PRIMARY(LVALUE);
	IF (LVALUE.BASE<>ABSOLUT) AND (LVALUE.BASE<>RELATIVE) THEN BEGIN
	  ERROR(ERRBADEXPR);
	  ESCAPE(BADEXIT);
	END
      END;
      REPEAT  { HANDLE BINARY OPS IF ANY }
	IF LINE[COLL] IN [OPENPAREN,CLOSEPAREN,
			  LBRACE,RBRACE,
			  RBRACK,BLANK,COMMA,COLON] THEN
	  ESCAPE(NORMALEXIT);
	IF LINE[COLL] IN [PLUS,MINUS,AMPERSAND,BITWISEOR] THEN
	  BEGIN
	    CH:=LINE[COLL];
	    COLL:=COLL+1;
	    PRIMARY(RVALUE);
	    OPERFOLD;
	  END
	ELSE BEGIN
	  IF GIVERRORS THEN ERROR(ERRBADEXPR);
	  ESCAPE(BADEXIT);
	END
      UNTIL FALSE;
    RECOVER
      IF ESCAPECODE=NORMALEXIT THEN
	BEGIN
	  EVALUE:=LVALUE;
	  COL:=COLL;
	END
      ELSE
	IF (ESCAPECODE=BADEXIT) or (escapecode=-4) THEN
	  BEGIN
	    if giverrors and (escapecode = -4) then
	      error(errarithoflo);
	    EVALOK:=NOK; EVALUE.OFFSET:=ZERO32;
	    EVALUE.BASE:=ABSOLUT;
	    EVALUE.EXPREFS:=NIL; EVALUE.EMODE:=NOMODE;
	    WHILE (LINE[COLL]<>BLANK) AND (LINE[COLL]<>COMMA) DO COLL:=COLL+1;
	    COL:=COLL;
	  END
	ELSE
	  ESCAPE(ESCAPECODE);
  END; { EXPRESSION  }
$ovflcheck off$


@


56.2
log
@
pws2rcs automatic delta on Wed Jan 27 11:57:27 MST 1993
@
text
@d1 434
@


56.1
log
@Automatic bump of revision number for PWS version 3.25
@
text
@a0 434
$ovflcheck on$
PROCEDURE GETCONST{VAR VAL: EXPRVALUE, VAR COLL: SHORTINT}; {FORWARD DECLARED}
     { GET A NUMERIC CONSTANT IN HEX OR DECIMAL }
     { ASSUMES LINE[COLL] IS FIRST CHAR OF CONSTANT }

    const opsok=100;

    VAR RADIX, I: SHORTINT;
	LASTCH,CH : CHAR;
	MYVAL: PACKED RECORD CASE INTEGER OF
		 0: (W32: WORD32);
		 1: (HEXES: PACKED ARRAY[0..7] OF 0..15)
	       END;
	CVAL: WORD32;
	CONS: STRING80;

    BEGIN
    RADIX:=10;  { SET DEFAULT RADIX }
    CONS:=''; CH:=LINE[COLL];
    IF CH='$' THEN BEGIN RADIX:=16; COLL:=COLL+1; CH:=LINE[COLL];
       IF NOT(CH IN ['0'..'9','A'..'F']) THEN ERROR(ERRBADCONST);
    END;
    WHILE CH IN ['0'..'9', 'A'..'F'] DO
      BEGIN
	LASTCH:=CH;
	IF CH>='A' THEN
	  CH:=CHR(ORD(CH)-ORD('A')+10)
	ELSE
	  CH:=CHR(ORD(CH)-ORD('0'));
	IF (CH>CHR(0)) OR (LENGTH(CONS)>0) THEN { IGNORE LEADING ZEROES }
	  BEGIN
	    CONS[0]:=SUCC(CONS[0]); CONS[LENGTH(CONS)]:=CH;
	  END;
	COLL:=COLL+1;
	CH:=LINE[COLL];
      END;
    MYVAL.W32.LOHALF:=0;
    MYVAL.W32.HIHALF:=0; CVAL.HIHALF:=0;
    try
    if radix = 16 then
      IF LENGTH(CONS)>8 THEN ERROR(ERRBADCONST)
      ELSE FOR I:=1 TO LENGTH(CONS) DO
	MYVAL.HEXES[7-LENGTH(CONS)+I]:=ORD(CONS[I])
    else if radix = 10 then
      FOR I:=1 TO LENGTH(CONS) DO
	  BEGIN
	    CVAL.LOHALF:=ORD(CONS[I]);
	    IF CVAL.LOHALF>=RADIX THEN ERROR(ERRBADCONST)
	    ELSE
	    MYVAL.W32.LONGINT:=MYVAL.W32.LONGINT*RADIX+CVAL.LONGINT;
	  END;
    escape(opsok);
    recover
      if escapecode<>opsok then begin
	  myval.w32.longint:=0;
	  error(errbadconst);
	end;
      VAL.BASE:=ABSOLUT;
      VAL.OFFSET:=MYVAL.W32;
      VAL.EMODE:=NOMODE;
      VAL.EXPREFS:=NIL;
  END;  { GETCONST}
$ovflcheck off$

PROCEDURE ALPHACONS(VAR CVALUE:EXPRVALUE; VAR CURCOL: SHORTINT);

CONST ALPHAOK=100; BADALPHA=101;
VAR I: SHORTINT;
    CONS: STRING80;
    MYVAL: WORD32;

BEGIN
TRY
IF (CURROP.NAME<>'DC       ') OR (PASS=1) THEN BEGIN
  LINECOPY:=PRINTLINE;
  LINECOPY[0]:=SUCC(LINECOPY[0]);
  LINECOPY[LENGTH(LINECOPY)]:=BLANK;
END;
CONS:='';
I:=0;
MYVAL:=ZERO32;
WHILE CURCOL<LENGTH(LINE) DO BEGIN
  CURCOL:=CURCOL+1;
  IF LINECOPY[CURCOL]=CHR(39) THEN
    IF LINECOPY[CURCOL+1]=CHR(39) THEN BEGIN
      CURCOL:=CURCOL+1;
      I:=I+1;
      IF I>4 THEN ESCAPE(BADALPHA);
      CONS[0]:=SUCC(CONS[0]);
      CONS[I]:=LINECOPY[CURCOL];
    END
    ELSE BEGIN CURCOL:=CURCOL+1;
      ESCAPE(ALPHAOK);
    END
  ELSE BEGIN
    I:=I+1;
    IF I>4 THEN ESCAPE(BADALPHA);
    CONS[0]:=SUCC(CONS[0]);
    CONS[I]:=LINECOPY[CURCOL];
  END
END;
ESCAPE(BADALPHA);
RECOVER
IF ESCAPECODE=BADALPHA THEN ERROR(ERRBADCONST)
ELSE IF ESCAPECODE=ALPHAOK THEN BEGIN
  CASE LENGTH(CONS) OF
    1: MYVAL.BYTE4:=ORD(CONS[1]);
    2: BEGIN
	 MYVAL.BYTE3:=ORD(CONS[1]);
	 MYVAL.BYTE4:=ORD(CONS[2]);
       END;
    3: BEGIN
	 MYVAL.BYTE2:=ORD(CONS[1]);
	 MYVAL.BYTE3:=ORD(CONS[2]);
	 MYVAL.BYTE4:=ORD(CONS[3]);
       END;
    4: BEGIN
	 MYVAL.BYTE1:=ORD(CONS[1]);
	 MYVAL.BYTE2:=ORD(CONS[2]);
	 MYVAL.BYTE3:=ORD(CONS[3]);
	 MYVAL.BYTE4:=ORD(CONS[4]);
       END;
  END; {CASE}
END ELSE ESCAPE(ESCAPECODE); {IF}
CVALUE.OFFSET:=MYVAL;
CVALUE.EMODE:=NOMODE;
CVALUE.BASE:=ABSOLUT;
CVALUE.EXPREFS:=NIL;
END;


PROCEDURE GETSYMBOL{VAR VAL: EXPRVALUE, VAR COLL: SHORTINT}; {FORWARD DECLARED}
     { GET THE VALUE OF A SYMBOL }

  VAR SYM: STREF;
      STARTCOL: SHORTINT;

  BEGIN
    STARTCOL:=COLL;
    if startcol=length(line) then lab:=''
    else begin
      REPEAT COLL:=COLL+1
$if mc68881$
	UNTIL (CHTYPE[LINE[COLL]]=SPECIAL)
		or ( fpreadmode and (line[ coll ] = ':') );
$end$
$if not mc68881$
	UNTIL CHTYPE[LINE[COLL]]=SPECIAL;
$end$
      LAB:=COPY(LINE,STARTCOL,COLL-STARTCOL);
    end;
    IF LAB='*' THEN
      BEGIN
	VAL.OFFSET:=LOCCTR;
	IF PCMODE=ABS THEN VAL.BASE:=ABSOLUT ELSE VAL.BASE:=RELATIVE;
	VAL.EMODE:=NOMODE;
	VAL.EXPREFS:=NIL;
      END
    ELSE
      BEGIN
	LOOKUPSYMBOL(SYM);
	IF SYM=NIL THEN
	  BEGIN
	    IF PASS=2 THEN ERROR(ERRUNDEFSYM);
	     VAL.EXPREFS:=NIL; VAL.OFFSET:=ZERO32;
	     VAL.BASE:=ABSOLUT;
	     VAL.EMODE:=NOMODE; FWDREF:=TRUE;
	  END
	ELSE
	  BEGIN
	    IF (SYM^.DEFINED=-1) AND (PASS=2) THEN ERROR(ERRUNDEFSYM);
	    IF (SYM^.DEFINED>LINENO) or
	       (sym^.defined=-1)  THEN FWDREF:=TRUE;
	    VAL.OFFSET:=SYM^.SVALUE;
	    VAL.BASE:=SYM^.SKIND;
	    VAL.EXPREFS:=SYM^.SEXTPTR;
	    VAL.EMODE:=SYM^.SMODE;
	    IF SYM^.EXT THEN BEGIN
	      try
		NEW(VAL.EXPREFS)
	      recover begin
		if escapecode=-2 then begin
		  writeln(lp,'MEMORY OVERFLOW!');
		  LPCHECK;      { 3/2/84 }
		  if listname<>'CONSOLE:' then
		    writeln('MEMORY OVERFLOW!');
		  escape(-1);
		end else escape(escapecode);
	      end;
	      VAL.EXPREFS^.MINUS:=FALSE;
	      if (sym^.svalue.longint=1) then
		val.offset:=globalptr^.location
	      else val.offset:=zero32;
	      VAL.EXPREFS^.SYMPT:=SYM;
	    END
	  END;
      END;
    END; { GETSYMBOL }

$ovflcheck on$
PROCEDURE NEGEXPR(* VAR VAL: EXPRVALUE *); { FORWARD DECLARED }
const badexit=101;

 BEGIN
   if val.base=relative then begin
     error(errbadbase);
     escape(badexit)
   end;
   val.offset.longint:=-val.offset.longint;
   IF VAL.EXPREFS<>NIL THEN
     IF VAL.EXPREFS^.MINUS THEN VAL.EXPREFS^.MINUS:=FALSE
       ELSE VAL.EXPREFS^.MINUS:=TRUE
 END;
$ovflcheck off$

 { ******** EXPRESSION EVALUATION ***********}

$include 'M68KFPEXP'$


$ovflcheck on$
PROCEDURE EXPRESS { GIVERRORS: BOOLEAN; VAR EVALOK: EVALWHEN;
		     VAR EVALUE: EXPRVALUE; VAR COL: SHORTINT } ;

  { **********************************************************
       EVALUATE AN ABSOLUTE OR RELATIVE MODE EXPRESSION.

     IF "GIVERRORS" THEN ISSUE ERRORS FOR UNDEFINED SYMBOLS.

     RETURNS EVALOK AS FOLLOWS:

       NOK: EXPRESSION COULD NOT BE EVALUATED-- SOME ERRORS DON'T GIVE THIS!

       OK1: EXPRESSION VALUE CAN BE DETERMINED IN PASS 1;
       OK2: EXPRESSION VALUE CAN BE DETERMINED IN PASS 2;
	(EXCEPT FOR EXTERNALS)

       RETURNS EVALUE AS EXPRESSION VALUE.

       ADVANCES "COL" PAST EXPRESSION IF POSSIBLE.

    ************************************************************}

 CONST PLUS='+'; MINUS='-'; ASTERISK='*'; DIVIDE='/';
       COLON=':'; LBRACE='{'; RBRACE = '}'; LBRACK='['; RBRACK = ']';
       AMPERSAND='&'; BITWISEOR='!'; LSHIFT='<<'; RSHIFT='>>';
       OPENPAREN='('; CLOSEPAREN=')';

       NORMALEXIT=100; BADEXIT=101;  { ESCAPE CODES }


 TYPE SETREC=RECORD
	       CASE INTEGER OF
		 0:(ASET: SET OF 0..31);
		 1:(WORDS: PACKED RECORD
			     LENGTH: SHORTINT;
			     JINT: INTEGER;
			   END);
	     END;

 VAR CH: CHAR; COLL: SHORTINT;
     LVALUE,RVALUE: EXPRVALUE;
     JUNK,JUNK2: SETREC;


 PROCEDURE JOINEXTLISTS;
 BEGIN
 IF RVALUE.EXPREFS<>NIL THEN
   IF LVALUE.EXPREFS=NIL
     THEN LVALUE.EXPREFS:=RVALUE.EXPREFS
     ELSE IF GIVERRORS THEN ERROR(ERREXTREFS);
 {
 IF RVALUE.EMODE<>NOMODE THEN
   IF LVALUE.EMODE=NOMODE
     THEN LVALUE.EMODE:=RVALUE.EMODE
     ELSE IF GIVERRORS THEN ERROR(ERRBADEXPR);
 }
 IF      (LVALUE.EMODE =NOMODE) AND (RVALUE.EMODE<>NOMODE) THEN
   LVALUE.EMODE:=RVALUE.EMODE
 ELSE IF                            (RVALUE.EMODE =NOMODE) THEN
 ELSE IF (LVALUE.EMODE = SMODE) AND (RVALUE.EMODE = SMODE) THEN
 ELSE IF (LVALUE.EMODE = LMODE) AND (RVALUE.EMODE = LMODE) THEN
 ELSE IF GIVERRORS THEN ERROR(ERRBADEXPR);
 END;

 PROCEDURE PRIMARY(VAR VAL:EXPRVALUE);
 BEGIN
   IF LINE[COLL] IN ['A'..'Z','_','@@','*'] THEN BEGIN   {allow '_' and '@@'}
							{jch 08/26/86}
     GETSYMBOL(VAL,COLL);
     IF FWDREF THEN EVALOK:=OK2;
   END
   ELSE IF LINE[COLL] IN ['0'..'9','$'] THEN GETCONST(VAL,COLL)
     ELSE IF LINE[COLL]=CHR(39) THEN ALPHACONS(VAL, COLL)
     ELSE BEGIN
	    IF GIVERRORS THEN ERROR(ERRBADEXPR);
	    ESCAPE(BADEXIT);
	  END;
END;


$ovflcheck on$
PROCEDURE OPERFOLD;

 VAR BOTHCONST: BOOLEAN;

 BEGIN
 TRY
   BOTHCONST:=(LVALUE.BASE=ABSOLUT) AND (RVALUE.BASE=ABSOLUT) AND
	      (LVALUE.EXPREFS=NIL) AND (RVALUE.EXPREFS=NIL);
   IF ((LVALUE.BASE<>ABSOLUT) AND (LVALUE.BASE<>RELATIVE)) OR
      ((RVALUE.BASE<>ABSOLUT) AND (RVALUE.BASE<>RELATIVE)) THEN BEGIN
	ERROR(ERRBADEXPR);
	ESCAPE(BADEXIT);
   END;
   CASE CH OF
	     PLUS: IF (LVALUE.BASE=ABSOLUT) OR (RVALUE.BASE=ABSOLUT) THEN
		     BEGIN
		       IF RVALUE.BASE<>ABSOLUT THEN LVALUE.BASE:=RVALUE.BASE;
		       lvalue.offset.longint:=lvalue.offset.longint+
					       rvalue.offset.longint;
		       JOINEXTLISTS;
		     END
		   ELSE IF GIVERRORS THEN ERROR(ERRBADBASE);

	     MINUS: IF (RVALUE.BASE=ABSOLUT) OR (RVALUE.BASE=LVALUE.BASE) THEN
		    BEGIN
		      IF RVALUE.BASE<>ABSOLUT THEN  begin
			LVALUE.BASE:=ABSOLUT;
			rvalue.base:=absolut;
		      end;
		      NEGEXPR(RVALUE);
		      lvalue.offset.longint:=lvalue.offset.longint+
					     rvalue.offset.longint;
		      JOINEXTLISTS;
		    END
		    ELSE IF GIVERRORS THEN ERROR(ERRBADBASE) ;

	     BITWISEOR: IF BOTHCONST THEN
			   BEGIN
			     JUNK.WORDS.LENGTH:=4;
			     JUNK.WORDS.JINT:=LVALUE.OFFSET.LONGINT;
			     JUNK2.WORDS.LENGTH:=4;
			     JUNK2.WORDS.JINT:=RVALUE.OFFSET.LONGINT;
			     JUNK.ASET:=JUNK.ASET+JUNK2.ASET;
			     LVALUE.OFFSET.LONGINT:=JUNK.WORDS.JINT;
			   END
			ELSE IF GIVERRORS THEN ERROR(ERRBADBASE);

	     AMPERSAND: IF BOTHCONST THEN
			    BEGIN
			      JUNK.WORDS.LENGTH:=4;
			      JUNK2.WORDS.LENGTH:=4;
			      JUNK.WORDS.JINT:=LVALUE.OFFSET.LONGINT;
			      JUNK2.WORDS.JINT:=RVALUE.OFFSET.LONGINT;
			      JUNK.ASET:=JUNK.ASET * JUNK2.ASET;
			      LVALUE.OFFSET.LONGINT:=JUNK.WORDS.JINT;
			    END
			ELSE IF GIVERRORS THEN ERROR(ERRBADBASE);

	     END;  { CASE }
    RECOVER
      IF ESCAPECODE<>NORMALEXIT THEN ESCAPE(ESCAPECODE);
  END; { OPERFOLD }
  $ovflcheck off$


  BEGIN { EXPRESSION }
    TRY
      FWDREF:=FALSE;
      EVALUE.EMODE:=NOMODE;
      COLL:=COL;
      EVALOK:=OK1;   { UNTIL PROVE OTHERWISE }
      IF LINE[COLL] IN [PLUS, MINUS] THEN { UNARY OP }
	BEGIN
	  CH:=LINE[COLL];
	  COLL:=COLL+1;
	  PRIMARY(LVALUE);
	  IF (LVALUE.BASE<>ABSOLUT) AND (LVALUE.BASE<>RELATIVE) THEN BEGIN
	    ERROR(ERRBADEXPR);
	    ESCAPE(BADEXIT);
	  END;
	  CASE CH OF
	    PLUS: ;   { NO ACTION FOR UNARY + }
	    MINUS: NEGEXPR(LVALUE);
	  END;
	END
      ELSE BEGIN
	PRIMARY(LVALUE);
	IF (LVALUE.BASE<>ABSOLUT) AND (LVALUE.BASE<>RELATIVE) THEN BEGIN
	  ERROR(ERRBADEXPR);
	  ESCAPE(BADEXIT);
	END
      END;
      REPEAT  { HANDLE BINARY OPS IF ANY }
	IF LINE[COLL] IN [OPENPAREN,CLOSEPAREN,
			  LBRACE,RBRACE,
			  RBRACK,BLANK,COMMA,COLON] THEN
	  ESCAPE(NORMALEXIT);
	IF LINE[COLL] IN [PLUS,MINUS,AMPERSAND,BITWISEOR] THEN
	  BEGIN
	    CH:=LINE[COLL];
	    COLL:=COLL+1;
	    PRIMARY(RVALUE);
	    OPERFOLD;
	  END
	ELSE BEGIN
	  IF GIVERRORS THEN ERROR(ERRBADEXPR);
	  ESCAPE(BADEXIT);
	END
      UNTIL FALSE;
    RECOVER
      IF ESCAPECODE=NORMALEXIT THEN
	BEGIN
	  EVALUE:=LVALUE;
	  COL:=COLL;
	END
      ELSE
	IF (ESCAPECODE=BADEXIT) or (escapecode=-4) THEN
	  BEGIN
	    if giverrors and (escapecode = -4) then
	      error(errarithoflo);
	    EVALOK:=NOK; EVALUE.OFFSET:=ZERO32;
	    EVALUE.BASE:=ABSOLUT;
	    EVALUE.EXPREFS:=NIL; EVALUE.EMODE:=NOMODE;
	    WHILE (LINE[COLL]<>BLANK) AND (LINE[COLL]<>COMMA) DO COLL:=COLL+1;
	    COL:=COLL;
	  END
	ELSE
	  ESCAPE(ESCAPECODE);
  END; { EXPRESSION  }
$ovflcheck off$


@


55.1
log
@Automatic bump of revision number for PWS version 3.25A
@
text
@@


54.1
log
@Automatic bump of revision number for PWS version 3.24
@
text
@@


53.1
log
@Automatic bump of revision number for PWS version 3.24B
@
text
@@


52.1
log
@Automatic bump of revision number for PWS version 3.24A
@
text
@@


51.1
log
@Automatic bump of revision number for PWS version 3.24d
@
text
@@


50.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@@


49.1
log
@Automatic bump of revision number for PWS version 3.24b
@
text
@@


48.1
log
@Automatic bump of revision number for PWS version 3.24a
@
text
@@


47.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@@


46.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@@


45.1
log
@Automatic bump of revision number for PWS version 3.23C
@
text
@@


44.1
log
@Automatic bump of revision number for PWS version 3.23B
@
text
@@


43.1
log
@Automatic bump of revision number for PWS version 3.23aA
@
text
@@


42.1
log
@Automatic bump of revision number for PWS version 3.23e
@
text
@@


41.1
log
@Automatic bump of revision number for PWS version 3.23d
@
text
@@


40.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@@


39.1
log
@Automatic bump of revision number for PWS version 3.23b
@
text
@@


38.1
log
@Automatic bump of revision number for PWS version 3.23a
@
text
@@


37.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@@


36.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


35.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


34.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


33.1
log
@Automatic bump of revision number for PWS version 3.22D
@
text
@@


32.1
log
@Automatic bump of revision number for PWS version 3.22C
@
text
@@


31.1
log
@Automatic bump of revision number for PWS version 3.22B
@
text
@@


30.1
log
@Automatic bump of revision number for PWS version 3.22A
@
text
@@


29.1
log
@Automatic bump of revision number for PWS version 3.22b
@
text
@@


28.1
log
@Automatic bump of revision number for PWS version 3.3b
@
text
@@


27.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@@


26.1
log
@Automatic bump of revision number for PWS version 3.3 Synch
@
text
@@


25.1
log
@Automatic bump of revision number for PWS version 3.2Y
@
text
@@


24.1
log
@Automatic bump of revision number for PWS version 3.2
@
text
@@


23.1
log
@Automatic bump of revision number for PWS version 3.2P
@
text
@@


22.1
log
@Automatic bump of revision number for PWS version 3.2N
@
text
@@


21.1
log
@Automatic bump of revision number for PWS version 3.2M
@
text
@@


20.1
log
@Automatic bump of revision number for PWS version 3.2L
@
text
@@


19.1
log
@Automatic bump of revision number for PWS version 3.2K
@
text
@@


18.1
log
@Automatic bump of revision number for PWS version 3.2J
@
text
@@


17.1
log
@Automatic bump of revision number for PWS version 3.2I+
@
text
@@


16.1
log
@Automatic bump of revision number for PWS version 3.2I
@
text
@@


15.1
log
@Automatic bump of revision number for PWS version 3.2H
@
text
@@


14.1
log
@Automatic bump of revision number for PWS version 3.2G
@
text
@@


13.1
log
@Automatic bump of revision number for PWS version 3.2F
@
text
@@


12.1
log
@Automatic bump of revision number for PWS version 3.2E
@
text
@@


11.1
log
@Automatic bump of revision number for PWS version 3.2D
@
text
@@


10.1
log
@Automatic bump of revision number for PWS version 3.2C
@
text
@@


9.1
log
@Automatic bump of revision number for PWS version 3.2B
@
text
@@


8.1
log
@Automatic bump of revision number for PWS version 3.2A
@
text
@@


7.1
log
@Automatic bump of revision number for PWS version 3.2l
@
text
@@


6.1
log
@Automatic bump of revision number for PWS version 3.2k
@
text
@@


5.1
log
@Automatic bump of revision number for PWS version 3.2j
@
text
@@


4.1
log
@Automatic bump of revision number for PWS version 3.2i
@
text
@@


3.1
log
@Automatic bump of revision number for PWS version 3.2h
@
text
@@


2.2
log
@changes to assemble PAWS C compiler output.
@
text
@@


2.1
log
@Auto bump rev number to 2.1 for sys 3.2e.
@
text
@d288 2
a289 1
   IF LINE[COLL] IN ['A'..'Z','*'] THEN BEGIN
@


1.1
log
@Initial revision
@
text
@@
