(*$M-*)
 
(*$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;
  EXT = PACKED ARRAY [1..4] OF CHAR;
  IOSPEC = (RAN,UPD,APP,TMP,INS,SHR,SPL);
 
 
  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 ) ;
	  REC.LEN := 1
       END;
 
 
(*$Y+*)   (*  NEW MODULE  *)
 
 
  PROCEDURE READFILEIDENTIFIER( VAR FSWL,FSWO,FSWC: BOOLEAN;
              VAR FILENAME: ALFA ;   VAR PDPOBJ: TEXT;   (*$Z+*)  VAR DECOBJ: IN
              VAR SOURCE: TEXT;  VAR LIST: TEXT (*$Z+*) ;  VAR CODE: TEXT (*$Z-*
 
  VAR
    BUFFER,DEVICE,DIRECTORY,FILNAM: PACKED ARRAY[0:19] OF CHAR;
    I,J,K,M,N,LEN,PIX,SEMIX: 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;
 
    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 := '                    ';   DEVICE := BUFFER;
      DIRECTORY := BUFFER;   FILNAM := BUFFER;
      READNAME;   K := N ;
      IF (CH = ':') OR (CH = '[') THEN
       BEGIN   I := -1;
        IF CH = ':' THEN
         BEGIN   DEVICE := BUFFER;   NXTCHR
         END;
        IF CH = '[' THEN
         BEGIN
         LOOP
          I := I + 1 ;  DIRECTORY[I] := CH;
         EXIT IF ( CH = ']' ) OR ( M >= LEN );
          NXTCHR
         END;
         K := 0;
         NXTCHR
         END  % IF '[' \  ;
        READNAME;
       END  % DEV OR DIR \ ;
      FILNAM := BUFFER;
      IF  PIX = -1 THEN
       BEGIN
        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;
     BEGIN   IF CH = '/' THEN
      BEGIN   NXTCHR;   SWITCH := CH # '-';
       IF CH = '-' THEN NXTCHR;
       IF CH = 'N' THEN
        BEGIN   NXTCHR;   IF CH = 'O' THEN
         BEGIN   NXTCHR;   SWITCH := FALSE END;
        END;
       READNAME
      END
     END % READSWITCH \ ;
 
 
   BEGIN  % READFILEIDENTIFIER \
    GCML( LINE, LEN );
    M := 0;
    WHILE ( M < LEN ) AND ( CH # '=' ) DO NXTCHR;
    IF CH # '=' THEN ERRMESS(1 % WITH EXIT FROM COMPILER \ ) ;
     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 \ ) ;
       M := 4;
            RDFILENAME('.OBJ');
            IF N = -1 THEN FSWO := FALSE
            ELSE   REWRITE( PDPOBJ, FILNAM, DIRECTORY, DEVICE );
              IF CH # '=' THEN NXTCHR;
              RDFILENAME('.LST');
              IF N = -1 THEN FSWL := FALSE
              ELSE
              BEGIN   IOS := [SPL];
               IF CH = '/' THEN
                BEGIN   READSWITCH;
                 IF (BUFFER[0]='S') AND (BUFFER[1]='P')
                    AND NOT SWITCH THEN IOS :=[];
                END;
               REWRITE( LIST, FILNAM, DIRECTORY, DEVICE, IOS );
              END;
                  (*$Z+*)
                  IF CH # '=' THEN NXTCHR;
                  RDFILENAME('.CXP');
                  IF N = -1 THEN FSWC := FALSE
                  ELSE   REWRITE( CODE, FILNAM, DIRECTORY, DEVICE );
                  (*$Z-*)
   END   % READFILEIDENTIFIER \.
 
 
