(*$M-*)				(*   P11FIL.PAS   *)








  (*$E-,F-,G-*)
  (*$X-,R-,W-*)


TYPE
  TEXT = FILE OF CHAR;
  INTFILE = FILE OF INTEGER;
  OBJECTRECORD = RECORD
		   LEN: INTEGER;
		   VALUE: ARRAY [1..100] OF CHAR
		 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 RTT ( VAR LINE: LINEBUFF; VAR LEN: INTEGER );  EXTERN;


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

  VAR
    I:INTEGER;


   BEGIN     % WRITOFILE \
    I := 0;
    WRITELN( PDPOBJ, REC.VALUE : 2 * REC.LEN ) ;
    REC.LEN := 1
   END;


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


  PROCEDURE READFILEIDENTIFIER( VAR FDL,FPW,FLW: INTEGER;
	       VAR FSWON,FSWOFF: BOOLARR;
	       VAR CML : LINEBUFF;  VAR CMLLEN, CMLIX : 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,BEGIX,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];
      IF CH > '_' THEN CH := CHR( ORD(CH) - 32 );
     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 );
    CH := 'P';   M := 0;   WHILE CH <> ' ' DO NXTCHR;
    WHILE M >= LEN DO  BEGIN  RTT ( LINE, LEN );  M := 0  END;
    CML := LINE;   CMLLEN := LEN;   BEGIX := M;
    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 );
    IF IORESULT(SOURCE) < 0
    THEN ERRMESS( 2 % AND EXIT \ ) ;
    CMLIX := M;
    FOR I:=0 TO 20 DO  IF I>L3 THEN FILENAME[I] := ' '
				ELSE FILENAME[I] := FILNAM[I];
    DIRECTORY := '                     ';  DEVICE := DIRECTORY;
    M := BEGIX;   CH := ' ';   RDFILENAME('.OBJ');
    READSWITCH((.'A','C','E','F','G','X','R','T','M','S','D','Q'.));
    IF N = -1
    THEN FSWOFF(.'K'.) := TRUE
    ELSE   REWRITE( PDPOBJ, FILNAM, DIRECTORY, DEVICE, [9] (* NOT FD.CR *) );
    IF CH # '='
    THEN NXTCHR;
    RDFILENAME('.LST');   READSWITCH((.'U','P','L','W'.));
    IF N = -1
    THEN FSWOFF(.'L'.) := TRUE
    ELSE
     BEGIN
      IOS := [SPL];
      IF FSWOFF(.'U'.)
      THEN IOS := [];
      REWRITE( LIST, FILNAM, DIRECTORY, DEVICE, IOS );
     END;
    (*$Z+*)
    IF CH # '='
    THEN NXTCHR;
    RDFILENAME('.CXP');
    IF N = -1
    THEN FSWOFF(.'C'.) := TRUE
    ELSE   REWRITE( CODE, FILNAM, DIRECTORY, DEVICE );
    (*$Z-*)
   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,BEGIX,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 *);
 
 
  FUNCTION NEXTINPUT ( VAR F: TEXT; VAR CML: LINEBUFF; VAR CMLLEN, CMLIX: INTEGER;
                VAR FILENAME: STR20 ) :   BOOLEAN;
 
  VAR
    BUFFER,DEVICE,DIRECTORY,FILNAM: STR20;
    I,J,K,M,N,LEN,PIX,BEGIX,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;
 
   BEGIN
    IF CMLIX > CMLLEN THEN NEXTINPUT := FALSE
    ELSE BEGIN
      LEN := CMLLEN;   FOR I:=1 TO LEN DO LINE[I] := CML[I];
      DIRECTORY := '                     ';   DEVICE := DIRECTORY;
      CH := ' ';   M := 0;   WHILE CH <> '=' DO   NXTCHR;
      WHILE M <= CMLIX DO   BEGIN  NXTCHR;  RDFILENAME ( '.PAS' )  END;
      CMLIX := M;
      RESET ( F, FILNAM, DIRECTORY, DEVICE );
      NEXTINPUT := NOT EOF(F);
      IF NOT EOF(F) THEN   BEGIN
        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
     END
   END    (* NEXTINPUT *);
 

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

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

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