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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

23.1
date     87.08.26.09.35.50;  author bayes;  state Exp;
branches ;
next     22.2;

22.2
date     87.08.20.15.49.12;  author larry;  state Exp;
branches ;
next     22.1;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

5.1
date     86.10.28.14.04.16;  author hal;  state Exp;
branches ;
next     4.3;

4.3
date     86.10.28.11.14.12;  author hal;  state Exp;
branches ;
next     4.2;

4.2
date     86.10.08.10.24.31;  author hal;  state Exp;
branches ;
next     4.1;

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

3.1
date     86.09.01.11.16.04;  author hal;  state Exp;
branches ;
next     2.1;

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

1.1
date     86.06.30.13.02.14;  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
@
IMPLEMENT

  CONST
    BADIO=102;

  TYPE
    BLOCKPTR = ^FILEBLOCK;
    FILEBLOCK=RECORD
		CHARPTR, BYTESLEFT : SHORTINT;
		filepos : integer;
		ATEOF: BOOLEAN;
		PREVFILE: BLOCKPTR;
		FNAME: STRING[120];     {CHANGED FROM STRING[25] 10-FEB-83}
	      END;
  VAR
    SOURCEBUF: pagebuftype;
    CURRFILE: FILEBLOCK;
    I: SHORTINT;
    OLDBLOCK: BLOCKPTR;


PROCEDURE FILLBUF;   {FWD}
{ GET NEXT PAGE FROM INPUT FILE }

BEGIN
WITH CURRFILE DO
  begin
  ateof := false;
  REPEAT
    with fibp(addr(filevar))^ do
      begin
      filepos := fpos;
      if fkind in [textfile,codefile] then
	if fpos < fleof then
	  begin
	  freadbytes(filevar,sourcebuf,pagesize);
	  if ioresult <> 0 then escape(-10);
	  end
	else ateof := true
      else
	if not eof(filevar) then
	  begin
	  any_to_UCSD(filevar,sourcebuf);
	  if ioresult <> 0 then escape(-10);
	  end
	else ateof := true
      end;

    CHARPTR:=0;
    if ateof then bytesleft := 0
    else
      BYTESLEFT:=SCAN(pagesize,=CHR(0),SOURCEBUF);
  UNTIL ATEOF OR (BYTESLEFT>0);
  end;
END;


PROCEDURE INCLUDEINSTR;  { HANDLES THE INCLUDE PSEUDO OP }
BEGIN
IF ININCLUDE THEN ERROR(ERRBADINCLUDE)
ELSE BEGIN
  INCNAME:='';
  I:=0;
  WHILE (LINE[CURCOL]<>BLANK) AND (CURCOL<=80) DO BEGIN
    I:=I+1;
    INCNAME[0]:=SUCC(INCNAME[0]);
    INCNAME[I]:=PRINTLINE[CURCOL];
    CURCOL:=CURCOL+1;
  END;
  fixname(incname,textfile);
  IF LENGTH(INCNAME)=0 THEN ERROR(ERRBADSYNTAX)
  ELSE BEGIN
    TRY
      NEW(OLDBLOCK)
    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;
    OLDBLOCK^:=CURRFILE;  {COPY CURRENT FILE INFO INTO OLDBLOCK }
    CLOSE(FILEVAR, 'LOCK');
    RESET(FILEVAR, INCNAME,'SHARED');
    IF IORESULT<>0 THEN BEGIN
      ERROR(ERRINCOPEN);
      DISPOSE(OLDBLOCK);
      RESET(FILEVAR, CURRFILE.FNAME,'SHARED');
      if ioresult<>0 then begin
	error(erropen);
	escape(-1);
      end;
      with fibp(addr(filevar))^ do
	begin
	if fkind = textfile then
	  begin
	  fpos := currfile.filepos;
	  am := amtable^[untypedfile];
	  fleof := fleof + (-fleof) mod pagesize;
	  if fpos < fleof then
	    begin
	    freadbytes(filevar,sourcebuf,pagesize);
	    if ioresult <> 0 then escape(-10);
	    end
	  else ERROR(readerror); { FAILED TO REOPEN OLD FILE }
	  end
	else
	  begin
	  if not eof(filevar) then
	    begin
	    any_to_UCSD(filevar,sourcebuf);
	    if ioresult <> 0 then escape(-10);
	    end
	  else ERROR(readerror);  { FAILED TO REOPEN OLD FILE }
	  end;
	end;
    END
    ELSE BEGIN
      ININCLUDE:=TRUE;
      CURRFILE.PREVFILE:=OLDBLOCK;
      with fibp(addr(filevar))^ do begin
	if fkind = textfile then
	  begin
	  am := amtable^[untypedfile];
	  fleof := fleof + (-fleof) mod pagesize;
	  fpos := pagesize;
	  end;
      end;
      FILLBUF;
      INCLUDELINENO:=0;
    END;
  END;
END;
END; { OF INCLUDEINSTR }


PROCEDURE READLINE{ VAR S: STRING};
{ FETCH NEXT SOURCE LINE. WILL HANDLE MACROS AND INCLUDE FILES LATER }
VAR LEN, I: SHORTINT;
    DONE: BOOLEAN;

procedure breakoutline;
begin
with currfile do begin
  LEN:=0;
  S[0]:=CHR(255);
  REPEAT
    {ASSERT BYTESLEFT>0}
    IF SOURCEBUF[CHARPTR]=CHR(16) THEN  { HANDLE DLE }
      BEGIN
      I:=ORD(SOURCEBUF[CHARPTR+1])-32;
      FILLCHAR(S[LEN+1],I,BLANK);
      LEN:=LEN+I;
      CHARPTR:=CHARPTR+2;
      BYTESLEFT:=BYTESLEFT-2;
      END;  { ASSUMES DLE NEVER AT PAGE END }
    I:=SCAN(BYTESLEFT,=CHR(13), SOURCEBUF[CHARPTR]);
    DONE:=I<BYTESLEFT; { DONE IF CR FOUND };
    MOVELEFT(SOURCEBUF[CHARPTR], S[LEN+1],I);
    LEN:=LEN+I;
    CHARPTR:=CHARPTR+I+1;   { SKIP OVER TEXT AND CR }
    BYTESLEFT:=BYTESLEFT-I-1;
    IF BYTESLEFT<=0 THEN FILLBUF;
  UNTIL DONE OR ATEOF;
  S[0]:=CHR(LEN);
end;
end;

BEGIN
WITH CURRFILE DO
  IF ATEOF THEN
    IF ININCLUDE THEN BEGIN
      CLOSE(FILEVAR, 'LOCK');
      CURRFILE:=PREVFILE^;
      RESET(FILEVAR, FNAME,'SHARED');
      if ioresult<>0 then begin
	error(erropen);
	escape(-1);
      end;
      with fibp(addr(filevar))^ do
	begin
	fpos := filepos;
	if fkind = textfile then
	  if fpos < fleof then
	    begin
	    am := amtable^[untypedfile];
	    fleof := fleof + (-fleof) mod pagesize;
	    freadbytes(filevar,sourcebuf,pagesize);
	    if ioresult <> 0 then escape(-10);
	    end
	  else ERROR(readerror)  { FAILED TO REOPEN OLD FILE }
	else
	  if not eof(filevar) then
	    begin
	    any_to_UCSD(filevar,sourcebuf);
	    if ioresult <> 0 then escape(-10);
	    end
	  else ERROR(readerror)  { FAILED TO REOPEN OLD FILE }
	end;
      ININCLUDE:=FALSE;
      DISPOSE(OLDBLOCK);
      PREVFILE:=NIL;
      if bytesleft>0 then breakoutline
      else s:=' END';
    END
    ELSE S:=' END'
  ELSE breakoutline
  END; {READLINE}



  PROCEDURE LOOKUPOPCODE(N: OPNAME);
  {FIND OPCODE IN TABLE, TRANSFER TO CURROP }
  LABEL 1;
  VAR I, LO, HI: SHORTINT;

  BEGIN
  LO:=1;
  HI:=NOPCODES;
  REPEAT
    I:= (LO + HI) DIV 2;
    IF N=OPTABLE[I].NAME THEN GOTO 1;  { FOUND }
    IF N<OPTABLE[I].NAME THEN HI:= I-1
      ELSE LO:=I+1;
  UNTIL LO > HI;
  I:=0;             { NOT FOUND }
  1: CURROP:=OPTABLE[I];
  END; {LOOKUPOPCODE}


PROCEDURE GETLINE;            {FWD}
{ GET NEXT SOURCE LINE, PARSE LABEL AND OPCODE}
VAR COL, LEN, I: SHORTINT;
    OP: OPNAME;
    CH:CHAR;

BEGIN
READLINE(LINE);
PRINTLINE:=LINE;
SIZE:=2;  {DEFAULT SIZE IS WORD}
SIZESUFFIX:=' ';
FOR I:=1 TO LENGTH(LINE) DO LINE[I]:=XLATE[LINE[I]];
LINE[0]:=SUCC(LINE[0]);  { APPEND A ' ' TO END OF LINE }
LINE[LENGTH(LINE)]:=BLANK;
IF (LINE[1]='*') OR (LENGTH(LINE)=1) THEN
  BEGIN
  LAB:='';        { COMMENT LINE }
  CURROP.CLASS:=99;
  CURROP.CODE:=0;
  CURROP.NAME:='         ';
END
ELSE BEGIN
  LEN:=SCAN(MAXLINELEN, =BLANK, LINE[1]);  { PARSE LABEL }
  LAB:=COPY(LINE, 1, LEN);
  LINE[LENGTH(LINE)]:=',';
  COL:=1+LEN+SCAN(MAXLINELEN, <>BLANK, LINE[1+LEN]); { SKIP BLANKS }
  LINE[LENGTH(LINE)]:=BLANK;
  LEN:=SCAN(MAXLINELEN, =BLANK, LINE[COL]);  {OPCODE ENDS WITH BLANK }
  LINE[LENGTH(LINE)]:=',';
  CURCOL:=COL+LEN+SCAN(MAXLINELEN, <>BLANK, LINE[COL+LEN]); { START OF OPERAND}
  LINE[LENGTH(LINE)]:=BLANK;
  IF (LEN=0) AND (LENGTH(LAB)=0 ) AND (CURCOL=LENGTH(LINE)) THEN BEGIN
    CURROP.CLASS:=99;       { BLANK LINE }
    CURROP.CODE:=0;
    CURROP.NAME:='         ';  { TREAT AS COMMENT }
  END
  ELSE BEGIN
    OP:='         ';
    {LAF 870820 changed constant 9 to MAXNAMELEN}
    IF LEN>MAXNAMELEN THEN LEN:=MAXNAMELEN;
    MOVELEFT(LINE[COL], OP[1], LEN);
    LOOKUPOPCODE(OP);
    IF LEN>=4 THEN IF LINE[COL+LEN-2]=PERIOD THEN
      BEGIN
	SIZESUFFIX:=LINE[COL+LEN-1];
$if mc68881$
	if      sizesuffix = 'B' then size := 1
	else if sizesuffix = 'W' then size := 2
	else if sizesuffix = 'L' then size := 4
	else if sizesuffix = 'S' then
	    if (currop.class >= fpbase) and (currop.class <= fptop) then
	      size := 4                         (* single prec. flt. pt. *)
	    else size := 2                      (* short jump *)
	else if sizesuffix = 'D' then size := 8
	else if sizesuffix = 'X' then size := 12
	else if sizesuffix = 'P' then size := 12
	else error( errbadsuffix );
$end$
$if not mc68881$
	if (sizesuffix = 'S') or
	   (sizesuffix = 'W') then
	  size := 2
	else if sizesuffix = 'B' then
	  size := 1
	else if sizesuffix = 'L' then
	  size := 4
	else
	  ERROR(ERRBADSUFFIX);
$end$
	CURROP.NAME[LEN]:=' ';
	CURROP.NAME[LEN-1]:=' ';
      END;
  END;
END;
LINENO:=LINENO+1;
if lineno < 0 {overflow} then
  begin
  error(errlinecnt);
  escape(-1);
  end;
IF ININCLUDE THEN INCLUDELINENO:=INCLUDELINENO+1
  ELSE MAINLINENO:=MAINLINENO+1;
END;  { GETLINE }

PROCEDURE OPENINPUT;
BEGIN
  ININCLUDE:=FALSE;
  CLOSE(FILEVAR);
  RESET(FILEVAR, SOURCEFILENAME,'SHARED');
  IF IORESULT<>0 THEN BEGIN
    getioerrmsg(iomsg, ioresult);
    WRITELN('Error: ',iomsg);
    ESCAPE(BADIO);
  END;
  WITH CURRFILE DO
    BEGIN
      with fibp(addr(filevar))^ do begin
	if fkind = textfile then
	  begin
	  am := amtable^[untypedfile];
	  fleof := fleof + (-fleof) mod pagesize;
	  fpos := pagesize;
	  end;
      end;
      PREVFILE:=NIL;
      FNAME:=SOURCEFILENAME
    END;
  FILLBUF; LINENO:=0; MAINLINENO:=0;
END; {OPENINPUT}

PROCEDURE DOREAD;
LABEL 1;
BEGIN {  BODY OF MODULE READER }
 IF USERINFO^.GOTSYM THEN
      SOURCEFILENAME:=USERINFO^.SYMFID
   ELSE BEGIN
1:   WRITE('What source file? ');
     READLN(SOURCEFILENAME);
     fixname(sourcefilename, textfile);
     IF SOURCEFILENAME='' THEN ESCAPE(0);
   END;
   TRY
     OPENINPUT
   RECOVER
    IF ESCAPECODE=BADIO THEN
      IF NOT STREAMING THEN GOTO 1
	ELSE ESCAPE(-1)
    ELSE ESCAPE(ESCAPECODE);
END;


@


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


56.1
log
@Automatic bump of revision number for PWS version 3.25
@
text
@a0 364

IMPLEMENT

  CONST
    BADIO=102;

  TYPE
    BLOCKPTR = ^FILEBLOCK;
    FILEBLOCK=RECORD
		CHARPTR, BYTESLEFT : SHORTINT;
		filepos : integer;
		ATEOF: BOOLEAN;
		PREVFILE: BLOCKPTR;
		FNAME: STRING[120];     {CHANGED FROM STRING[25] 10-FEB-83}
	      END;
  VAR
    SOURCEBUF: pagebuftype;
    CURRFILE: FILEBLOCK;
    I: SHORTINT;
    OLDBLOCK: BLOCKPTR;


PROCEDURE FILLBUF;   {FWD}
{ GET NEXT PAGE FROM INPUT FILE }

BEGIN
WITH CURRFILE DO
  begin
  ateof := false;
  REPEAT
    with fibp(addr(filevar))^ do
      begin
      filepos := fpos;
      if fkind in [textfile,codefile] then
	if fpos < fleof then
	  begin
	  freadbytes(filevar,sourcebuf,pagesize);
	  if ioresult <> 0 then escape(-10);
	  end
	else ateof := true
      else
	if not eof(filevar) then
	  begin
	  any_to_UCSD(filevar,sourcebuf);
	  if ioresult <> 0 then escape(-10);
	  end
	else ateof := true
      end;

    CHARPTR:=0;
    if ateof then bytesleft := 0
    else
      BYTESLEFT:=SCAN(pagesize,=CHR(0),SOURCEBUF);
  UNTIL ATEOF OR (BYTESLEFT>0);
  end;
END;


PROCEDURE INCLUDEINSTR;  { HANDLES THE INCLUDE PSEUDO OP }
BEGIN
IF ININCLUDE THEN ERROR(ERRBADINCLUDE)
ELSE BEGIN
  INCNAME:='';
  I:=0;
  WHILE (LINE[CURCOL]<>BLANK) AND (CURCOL<=80) DO BEGIN
    I:=I+1;
    INCNAME[0]:=SUCC(INCNAME[0]);
    INCNAME[I]:=PRINTLINE[CURCOL];
    CURCOL:=CURCOL+1;
  END;
  fixname(incname,textfile);
  IF LENGTH(INCNAME)=0 THEN ERROR(ERRBADSYNTAX)
  ELSE BEGIN
    TRY
      NEW(OLDBLOCK)
    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;
    OLDBLOCK^:=CURRFILE;  {COPY CURRENT FILE INFO INTO OLDBLOCK }
    CLOSE(FILEVAR, 'LOCK');
    RESET(FILEVAR, INCNAME,'SHARED');
    IF IORESULT<>0 THEN BEGIN
      ERROR(ERRINCOPEN);
      DISPOSE(OLDBLOCK);
      RESET(FILEVAR, CURRFILE.FNAME,'SHARED');
      if ioresult<>0 then begin
	error(erropen);
	escape(-1);
      end;
      with fibp(addr(filevar))^ do
	begin
	if fkind = textfile then
	  begin
	  fpos := currfile.filepos;
	  am := amtable^[untypedfile];
	  fleof := fleof + (-fleof) mod pagesize;
	  if fpos < fleof then
	    begin
	    freadbytes(filevar,sourcebuf,pagesize);
	    if ioresult <> 0 then escape(-10);
	    end
	  else ERROR(readerror); { FAILED TO REOPEN OLD FILE }
	  end
	else
	  begin
	  if not eof(filevar) then
	    begin
	    any_to_UCSD(filevar,sourcebuf);
	    if ioresult <> 0 then escape(-10);
	    end
	  else ERROR(readerror);  { FAILED TO REOPEN OLD FILE }
	  end;
	end;
    END
    ELSE BEGIN
      ININCLUDE:=TRUE;
      CURRFILE.PREVFILE:=OLDBLOCK;
      with fibp(addr(filevar))^ do begin
	if fkind = textfile then
	  begin
	  am := amtable^[untypedfile];
	  fleof := fleof + (-fleof) mod pagesize;
	  fpos := pagesize;
	  end;
      end;
      FILLBUF;
      INCLUDELINENO:=0;
    END;
  END;
END;
END; { OF INCLUDEINSTR }


PROCEDURE READLINE{ VAR S: STRING};
{ FETCH NEXT SOURCE LINE. WILL HANDLE MACROS AND INCLUDE FILES LATER }
VAR LEN, I: SHORTINT;
    DONE: BOOLEAN;

procedure breakoutline;
begin
with currfile do begin
  LEN:=0;
  S[0]:=CHR(255);
  REPEAT
    {ASSERT BYTESLEFT>0}
    IF SOURCEBUF[CHARPTR]=CHR(16) THEN  { HANDLE DLE }
      BEGIN
      I:=ORD(SOURCEBUF[CHARPTR+1])-32;
      FILLCHAR(S[LEN+1],I,BLANK);
      LEN:=LEN+I;
      CHARPTR:=CHARPTR+2;
      BYTESLEFT:=BYTESLEFT-2;
      END;  { ASSUMES DLE NEVER AT PAGE END }
    I:=SCAN(BYTESLEFT,=CHR(13), SOURCEBUF[CHARPTR]);
    DONE:=I<BYTESLEFT; { DONE IF CR FOUND };
    MOVELEFT(SOURCEBUF[CHARPTR], S[LEN+1],I);
    LEN:=LEN+I;
    CHARPTR:=CHARPTR+I+1;   { SKIP OVER TEXT AND CR }
    BYTESLEFT:=BYTESLEFT-I-1;
    IF BYTESLEFT<=0 THEN FILLBUF;
  UNTIL DONE OR ATEOF;
  S[0]:=CHR(LEN);
end;
end;

BEGIN
WITH CURRFILE DO
  IF ATEOF THEN
    IF ININCLUDE THEN BEGIN
      CLOSE(FILEVAR, 'LOCK');
      CURRFILE:=PREVFILE^;
      RESET(FILEVAR, FNAME,'SHARED');
      if ioresult<>0 then begin
	error(erropen);
	escape(-1);
      end;
      with fibp(addr(filevar))^ do
	begin
	fpos := filepos;
	if fkind = textfile then
	  if fpos < fleof then
	    begin
	    am := amtable^[untypedfile];
	    fleof := fleof + (-fleof) mod pagesize;
	    freadbytes(filevar,sourcebuf,pagesize);
	    if ioresult <> 0 then escape(-10);
	    end
	  else ERROR(readerror)  { FAILED TO REOPEN OLD FILE }
	else
	  if not eof(filevar) then
	    begin
	    any_to_UCSD(filevar,sourcebuf);
	    if ioresult <> 0 then escape(-10);
	    end
	  else ERROR(readerror)  { FAILED TO REOPEN OLD FILE }
	end;
      ININCLUDE:=FALSE;
      DISPOSE(OLDBLOCK);
      PREVFILE:=NIL;
      if bytesleft>0 then breakoutline
      else s:=' END';
    END
    ELSE S:=' END'
  ELSE breakoutline
  END; {READLINE}



  PROCEDURE LOOKUPOPCODE(N: OPNAME);
  {FIND OPCODE IN TABLE, TRANSFER TO CURROP }
  LABEL 1;
  VAR I, LO, HI: SHORTINT;

  BEGIN
  LO:=1;
  HI:=NOPCODES;
  REPEAT
    I:= (LO + HI) DIV 2;
    IF N=OPTABLE[I].NAME THEN GOTO 1;  { FOUND }
    IF N<OPTABLE[I].NAME THEN HI:= I-1
      ELSE LO:=I+1;
  UNTIL LO > HI;
  I:=0;             { NOT FOUND }
  1: CURROP:=OPTABLE[I];
  END; {LOOKUPOPCODE}


PROCEDURE GETLINE;            {FWD}
{ GET NEXT SOURCE LINE, PARSE LABEL AND OPCODE}
VAR COL, LEN, I: SHORTINT;
    OP: OPNAME;
    CH:CHAR;

BEGIN
READLINE(LINE);
PRINTLINE:=LINE;
SIZE:=2;  {DEFAULT SIZE IS WORD}
SIZESUFFIX:=' ';
FOR I:=1 TO LENGTH(LINE) DO LINE[I]:=XLATE[LINE[I]];
LINE[0]:=SUCC(LINE[0]);  { APPEND A ' ' TO END OF LINE }
LINE[LENGTH(LINE)]:=BLANK;
IF (LINE[1]='*') OR (LENGTH(LINE)=1) THEN
  BEGIN
  LAB:='';        { COMMENT LINE }
  CURROP.CLASS:=99;
  CURROP.CODE:=0;
  CURROP.NAME:='         ';
END
ELSE BEGIN
  LEN:=SCAN(MAXLINELEN, =BLANK, LINE[1]);  { PARSE LABEL }
  LAB:=COPY(LINE, 1, LEN);
  LINE[LENGTH(LINE)]:=',';
  COL:=1+LEN+SCAN(MAXLINELEN, <>BLANK, LINE[1+LEN]); { SKIP BLANKS }
  LINE[LENGTH(LINE)]:=BLANK;
  LEN:=SCAN(MAXLINELEN, =BLANK, LINE[COL]);  {OPCODE ENDS WITH BLANK }
  LINE[LENGTH(LINE)]:=',';
  CURCOL:=COL+LEN+SCAN(MAXLINELEN, <>BLANK, LINE[COL+LEN]); { START OF OPERAND}
  LINE[LENGTH(LINE)]:=BLANK;
  IF (LEN=0) AND (LENGTH(LAB)=0 ) AND (CURCOL=LENGTH(LINE)) THEN BEGIN
    CURROP.CLASS:=99;       { BLANK LINE }
    CURROP.CODE:=0;
    CURROP.NAME:='         ';  { TREAT AS COMMENT }
  END
  ELSE BEGIN
    OP:='         ';
    {LAF 870820 changed constant 9 to MAXNAMELEN}
    IF LEN>MAXNAMELEN THEN LEN:=MAXNAMELEN;
    MOVELEFT(LINE[COL], OP[1], LEN);
    LOOKUPOPCODE(OP);
    IF LEN>=4 THEN IF LINE[COL+LEN-2]=PERIOD THEN
      BEGIN
	SIZESUFFIX:=LINE[COL+LEN-1];
$if mc68881$
	if      sizesuffix = 'B' then size := 1
	else if sizesuffix = 'W' then size := 2
	else if sizesuffix = 'L' then size := 4
	else if sizesuffix = 'S' then
	    if (currop.class >= fpbase) and (currop.class <= fptop) then
	      size := 4                         (* single prec. flt. pt. *)
	    else size := 2                      (* short jump *)
	else if sizesuffix = 'D' then size := 8
	else if sizesuffix = 'X' then size := 12
	else if sizesuffix = 'P' then size := 12
	else error( errbadsuffix );
$end$
$if not mc68881$
	if (sizesuffix = 'S') or
	   (sizesuffix = 'W') then
	  size := 2
	else if sizesuffix = 'B' then
	  size := 1
	else if sizesuffix = 'L' then
	  size := 4
	else
	  ERROR(ERRBADSUFFIX);
$end$
	CURROP.NAME[LEN]:=' ';
	CURROP.NAME[LEN-1]:=' ';
      END;
  END;
END;
LINENO:=LINENO+1;
if lineno < 0 {overflow} then
  begin
  error(errlinecnt);
  escape(-1);
  end;
IF ININCLUDE THEN INCLUDELINENO:=INCLUDELINENO+1
  ELSE MAINLINENO:=MAINLINENO+1;
END;  { GETLINE }

PROCEDURE OPENINPUT;
BEGIN
  ININCLUDE:=FALSE;
  CLOSE(FILEVAR);
  RESET(FILEVAR, SOURCEFILENAME,'SHARED');
  IF IORESULT<>0 THEN BEGIN
    getioerrmsg(iomsg, ioresult);
    WRITELN('Error: ',iomsg);
    ESCAPE(BADIO);
  END;
  WITH CURRFILE DO
    BEGIN
      with fibp(addr(filevar))^ do begin
	if fkind = textfile then
	  begin
	  am := amtable^[untypedfile];
	  fleof := fleof + (-fleof) mod pagesize;
	  fpos := pagesize;
	  end;
      end;
      PREVFILE:=NIL;
      FNAME:=SOURCEFILENAME
    END;
  FILLBUF; LINENO:=0; MAINLINENO:=0;
END; {OPENINPUT}

PROCEDURE DOREAD;
LABEL 1;
BEGIN {  BODY OF MODULE READER }
 IF USERINFO^.GOTSYM THEN
      SOURCEFILENAME:=USERINFO^.SYMFID
   ELSE BEGIN
1:   WRITE('What source file? ');
     READLN(SOURCEFILENAME);
     fixname(sourcefilename, textfile);
     IF SOURCEFILENAME='' THEN ESCAPE(0);
   END;
   TRY
     OPENINPUT
   RECOVER
    IF ESCAPECODE=BADIO THEN
      IF NOT STREAMING THEN GOTO 1
	ELSE ESCAPE(-1)
    ELSE ESCAPE(ESCAPECODE);
END;


@


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.2
log
@users' opcodes are now truncated to MAXNAMELEN characters instead of 9
@
text
@@


22.1
log
@Automatic bump of revision number for PWS version 3.2N
@
text
@d272 2
a273 1
    IF LEN>9 THEN LEN:=9;
@


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.3
log
@Pws2unix automatic delta on Tue Oct 28 10:57:29 MEZ 1986
@
text
@@


4.2
log
@When open uxfile, tell am to expand tabs.
@
text
@a97 4
	if fkind = uxfile then begin
	  { tell am to expand tabs }
	  fb0 := false; fb1 := true;
	end;
a124 4
	if fkind = uxfile then begin
	  { tell am to expand tabs }
	  fb0 := false; fb1 := true;
	end;
a185 4
	if fkind = uxfile then begin
	  { tell am to expand tabs }
	  fb0 := false; fb1 := true;
	end;
a329 4
	if fkind = uxfile then begin
	  { tell am to expand tabs }
	  fb0 := false; fb1 := true;
	end;
@


4.1
log
@Automatic bump of revision number for PWS version 3.2i
@
text
@d98 4
d128 5
a132 1
      with fibp(addr(filevar))^ do
d139 1
d194 4
d341 5
a345 1
      with fibp(addr(filevar))^ do
d352 1
@


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


2.1
log
@Auto bump rev number to 2.1 for sys 3.2e.
@
text
@@


1.1
log
@Initial revision
@
text
@@
