(*$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 \.