(*$M-*)				(*   P11FIL.PAS   *)
(*$V+791121*)








  (*$X+,R-,W-*)


TYPE
  TEXT = FILE OF CHAR;
  INTFILE = FILE OF INTEGER;
  OBJECTRECORD = RECORD
		   LEN: INTEGER;
		   VALUE: ARRAY [1..25] OF INTEGER
		 END;
  LINEBUFF = ARRAY [1..80] OF CHAR;
  ALFA = PACKED ARRAY [1..10] OF CHAR;
  STR20 = PACKED ARRAY [0..20] OF CHAR;
  EXT = PACKED ARRAY [1..4] OF CHAR;
  IOSPEC = (RAN,UPD,APP,TMP,INS,SHR,SPL);
  SETOFCHAR = SET OF CHAR;
  INTP = ^ INTEGER;
  BOOLARR = PACKED ARRAY ['A'..'Z'] OF BOOLEAN;


  PROCEDURE GCML( VAR LINE: LINEBUFF; VAR LEN: INTEGER );   EXTERN;

  PROCEDURE ERRMESS( N: INTEGER );     EXTERN;


  PROCEDURE WRITOFILE ( VAR REC: OBJECTRECORD ;
		       VAR PDPOBJ: TEXT (*$Z+*) ;
		       VAR DECOBJ: INTFILE  (*$Z-*) );

  VAR
    I:INTEGER;


    PROCEDURE PUTOBJ ( FCODE: INTEGER ) ;
    VAR
      I,PDPWORD: INTEGER;
     BEGIN
      IF FCODE < 0
      THEN PDPWORD := FCODE + 100000B
      ELSE PDPWORD := FCODE;
      WRITE( PDPOBJ, CHR( PDPWORD MOD 256 ));
      I := PDPWORD DIV 256 ;
      IF FCODE < 0
      THEN I := I + 200B;
      WRITE(PDPOBJ, CHR(I) );
     END ;


   BEGIN     { WRITOFILE }
    FOR I := 1 TO REC.LEN DO PUTOBJ( REC.VALUE[I] ) ;
    WRITELN( PDPOBJ ) ;
    IF IORESULT( PDPOBJ ) < 0 THEN  ERRMESS ( 6 {AND EXIT} );
    REC.LEN := 1
   END;


  (*$Y+*)   (*  NEW MODULE  *)


  PROCEDURE READFILEIDENTIFIER( VAR FDL,FPW,FLW: INTEGER;
	       VAR FSWON,FSWOFF: BOOLARR;
	       VAR CML : LINEBUFF;  VAR CMLLEN : INTEGER;
	       VAR FILENAME: STR20 ;   VAR PDPOBJ: TEXT;
	       (*$Z+*)  VAR DECOBJ: INTFILE;  (*$Z-*)
	       VAR SOURCE: TEXT;  VAR LIST: TEXT
	       (*$Z+*) ;  VAR CODE: TEXT (*$Z-*) );
 

  VAR
    BUFFER,DEVICE,DIRECTORY,FILNAM: STR20;
    I,J,K,M,N,LEN,PIX,SEMIX,L1,L2,L3: INTEGER;      CH,STATUS: CHAR;
    ERROR,NEWSTATUS: BOOLEAN;   LINE: LINEBUFF;   IOS: SET OF IOSPEC;
    SWITCH: BOOLEAN;

    PROCEDURE NXTCHR;
     BEGIN
      M := M+1;
      IF M > LEN
      THEN CH := ' '
      ELSE CH := LINE[M]
     END;
 
   (*$Y-*)     (*   NO MORE MODULE SPLITTING   *)

    PROCEDURE READNUM( VAR N: INTEGER );
    VAR
      I: INTEGER;
     BEGIN
      I:=0;
      IF CH = ':'
      THEN NXTCHR;
       WHILE  CH IN ['0'..'9'] DO
	BEGIN   I := 10*I + ORD(CH) - 48;
	 NXTCHR;
        END;
      N:=I;
     END;


    PROCEDURE READNAME;
     BEGIN
      PIX:=-1;  SEMIX:=-1;  N := -1;  WHILE CH = ' ' DO NXTCHR;
      WHILE CH IN ['A'..'Z','0'..'9','.',';'] DO
       BEGIN
	N := N+1;   BUFFER[N] := CH;
	IF CH = '.'
	THEN PIX := N;
	IF CH=';'
	THEN SEMIX := N;    NXTCHR
       END
     END;

    PROCEDURE RDFILENAME( EXTNAME: EXT );
     BEGIN
      BUFFER := '                     ';   FILNAM := BUFFER;
      READNAME;   K := N ;   L1:=-1;   L2:=-1;
      IF (CH = ':') OR (CH = '[')
      THEN
       BEGIN
	I := -1;
	IF CH = ':'
	THEN
	 BEGIN
	  DEVICE := BUFFER;   NXTCHR;   L1 := N
	 END;
	IF CH = '['
	THEN
	 BEGIN
	   LOOP
	    I := I + 1 ;  DIRECTORY[I] := CH;
	   EXIT IF ( CH = ']' ) OR ( M >= LEN );
	    NXTCHR
	   END;
	  K := 0;   L2 := I;
	  NXTCHR
	 END  { IF '[' }  ;
	READNAME;
       END  { DEV OR DIR } ;
      FILNAM := BUFFER;   L3 := N;
      IF  PIX = -1
      THEN
       BEGIN
	L3 := N + 4;
	IF SEMIX <> -1
	THEN
	FOR I:=SEMIX TO 16 DO FILNAM[I+4]:=FILNAM[I];
	FOR I := 1 TO 4 DO FILNAM[N+I] := EXTNAME[I];
       END;
      IF K <> -1
      THEN N := K;
     END  { RDFILENAME } ;

    PROCEDURE READSWITCH( SWSET: SETOFCHAR);
    VAR
      SWPLUS: BOOLEAN;
     BEGIN
      WHILE CH = '/' DO
       BEGIN
	NXTCHR;   SWPLUS := TRUE;
	IF CH = '-'
	THEN
	 BEGIN
	  SWPLUS := FALSE;   NXTCHR
	 END;
	STATUS := CH;
	IF CH = 'N'
	THEN
	 BEGIN
	  NXTCHR;
	  IF CH = 'O'
	  THEN
	   BEGIN
	    NXTCHR;   SWPLUS := FALSE; STATUS := CH
	   END
	 END;
	WHILE CH IN ['A'..'Z'] DO  NXTCHR;
	IF NOT (STATUS IN SWSET)
	THEN ERRMESS( 3 { AND EXIT } );
	IF STATUS = 'P'
	THEN READNUM(FPW)
	ELSE
	 IF STATUS = 'L'
	 THEN READNUM(FLW)
	 ELSE
	   IF STATUS = 'A'
	   THEN READNUM(FDL)
	   ELSE
	     IF STATUS IN ['A'..'Z']
	     THEN
	       IF SWPLUS
	       THEN FSWON[STATUS]:=TRUE
	       ELSE FSWOFF[STATUS]:=TRUE;
       END;
     END { READSWITCH } ;
 
 
 
 
   BEGIN  { READFILEIDENTIFIER }
    GCML( LINE, LEN );
    CML := LINE;   CMLLEN := LEN;
    M := 0;   NXTCHR;
    WHILE ( M < LEN ) AND ( CH <> '=' ) DO NXTCHR;
    IF CH <> '=' THEN
	ERRMESS (1 { WITH EXIT FROM COMPILER } ) ;
    DIRECTORY := '                     ';  DEVICE := DIRECTORY;
    NXTCHR;   RDFILENAME('.PAS');
    IF N = -1 THEN
	ERRMESS ( 1 { AND EXIT FROM COMPILER } ) ;
    RESET( SOURCE, FILNAM, DIRECTORY, DEVICE, [SHARED] );
    IF IORESULT(SOURCE) < 0 THEN
	ERRMESS ( 2 { AND EXIT } ) ;
    FOR I:=0 TO 20 DO  IF I>L3 THEN FILENAME[I] := ' '
			       ELSE FILENAME[I] := FILNAM[I];
    DIRECTORY := '                     ';  DEVICE := DIRECTORY;
    M := 4;   RDFILENAME('.OBJ');
    READSWITCH(['A','C','E','F','G','X','R','T','M','S','D','Q']);
    IF N = -1 THEN
	FSWOFF['K'] := TRUE
    ELSE
	BEGIN
	REWRITE( PDPOBJ, FILNAM, DIRECTORY, DEVICE );
	IF IORESULT( PDPOBJ ) < 0 THEN ERRMESS ( 5 { AND EXIT } );
	END;
    IF CH = '=' THEN
	FSWOFF['L'] := TRUE
    ELSE
	BEGIN
	NXTCHR;
	RDFILENAME('.LST');   READSWITCH(['U','P','L','W']);
	IF N = -1 THEN
	    FSWOFF['L'] := TRUE
	ELSE
	    BEGIN
	    IOS := [];
	    IF FSWON['U'] THEN IOS := [SPL];
	    REWRITE( LIST, FILNAM, DIRECTORY, DEVICE, IOS );
	    IF IORESULT( LIST ) < 0 THEN ERRMESS ( 5 { AND EXIT } )
	    END;
	(*$Z+*)
	IF CH <> '=' THEN
	    BEGIN
	    NXTCHR;
	    RDFILENAME('.CXP');
	    IF N <> -1  THEN
		BEGIN
		REWRITE( CODE, FILNAM, DIRECTORY, DEVICE );
		IF IORESULT( CODE ) < 0 THEN ERRMESS ( 5 { AND EXIT } )
		END
	    END
	(*$Z-*)
	END
   END   { READFILEIDENTIFIER };
 
 
 
 
  PROCEDURE NEWSOURCE ( VAR F: TEXT; VAR FILENAME: STR20;
		       VAR FLINE: LINEBUFF; FLEN: INTEGER );

  VAR
    BUFFER,DEVICE,DIRECTORY,FILNAM: STR20;
    I,J,K,M,N,LEN,PIX,SEMIX,L1,L2,L3: INTEGER;      CH,STATUS: CHAR;
    ERROR,NEWSTATUS: BOOLEAN;   LINE: LINEBUFF;   IOS: SET OF IOSPEC;
    SWITCH: BOOLEAN;

    PROCEDURE NXTCHR; EXTERN;
    PROCEDURE READNUM ( VAR N: INTEGER ); EXTERN;
    PROCEDURE READNAME; EXTERN;
    PROCEDURE RDFILENAME ( EXTNAME: EXT ); EXTERN;
    PROCEDURE OPEN ( VAR F: TEXT; STRING NAM,DIR,DEV ); EXTERN;

   BEGIN
    LEN := FLEN;   FOR I:=1 TO LEN DO LINE[I] := FLINE[I];
    M := 0;   NXTCHR;
    RDFILENAME ( '.PAS' );
    OPEN ( F, FILNAM[0..L3], DIRECTORY[0..L2], DEVICE[0..L1] );
    FILENAME := '                     ';
    FOR I:=0 TO L1 DO FILENAME[I] := DEVICE[I];
    FOR I:=0 TO L2 DO FILENAME[I+L1+1] := DIRECTORY[I];
    FOR I:=0 TO L3 DO FILENAME[I+L1+L2+2] := FILNAM[I];
   END   (* NEWSOURCE *);

  (*$Y+*)     (*   NEW MODULE   *)

  PROCEDURE HEAPMARK( VAR M: INTP );
   BEGIN
    MARK;
   END;

  (*$Y-*)   (* CONTIGUOUS MODULE *)
  PROCEDURE HEAPRELEASE( M: INTP );
   BEGIN
    RELEASE
   END;

  PROCEDURE COPYSTP ( P: INTEGER );
   BEGIN P:=P
   END;
 
  PROCEDURE COPYCTP ( P: INTEGER );
   BEGIN P:=P
   END.