Код:
PROGRAM SYSTEM_GENERATION;
CONST
BUFF_LAST = 377B;
(* NEXT CONSTANT - FROM FILE RTS.MAC,
( ALSO, MODULE PDP11 CONTAIN IT ) *)
INITIAL_START_ENTRY = 452B;
INITIAL_START_STACK_BOTTOM = 454B;
INITIAL_START_STACK_LIMIT = 456B;
LOADER_INFO = 460B;
TYPE
CARDINAL =0..65535;
FLAG_TYPE =(ENTRY_POINT_FLAG,
CODE_FLAG,
LINKER_TABLE_FLAG,
DEBUGGER_TABLE_FLAG,
OLD_LOAD_KEY_FLAG,
NEW_LOAD_KEY_FLAG,
FIRST_FREE_LOC_FLAG,
OLD_FIRST_FREE_LOC_FLAG,
MAX_FLAG);
FLAG_SET =SET OF FLAG_TYPE;
FILE_NAME =PACKED ARRAY [1..35] OF CHAR;
BLOCK =0..BUFF_LAST;
BIG_BUFFER=ARRAY [BLOCK] OF CARDINAL;
WORK =FILE OF BIG_BUFFER;
DOUBLE =ARRAY [0..1] OF CARDINAL;
VAR
FOUND : FLAG_SET;
FLAG : FLAG_TYPE;
WHERE,
WORD,
NBYTES,
I,
X : CARDINAL;
LOD_NAME,
RTS_NAME,
TSK_NAME : FILE_NAME;
LOD_FILE,
RTS_FILE,
TSK_FILE : WORK;
EOF_LOD_FILE : BOOLEAN;
CH : CHAR;
CHECK_SUM : CARDINAL;
BUFFER_R : BIG_BUFFER;
INDEX_R,
LIMIT_R : BLOCK;
SYSTEM_ENTRY_POINT_VALUE: CARDINAL;
SYSTEM_LOAD_KEY_VALUE : CARDINAL;
OLD_FREE_LOC : CARDINAL;
FIRST_FREE_LOC : CARDINAL;
BUFFER_W : BIG_BUFFER;
INDEX_W,
CURRENT_BLOCK,
LIMIT_W : CARDINAL;
LIMIT_RTS : CARDINAL;
RTS_BLOCK : CARDINAL;
EOF_RTS_FILE : BOOLEAN;
PROCEDURE EXITST(I: INTEGER ); EXTERNAL;
FUNCTION FLGTYP(WORD: CARDINAL): FLAG_TYPE; EXTERNAL;
PROCEDURE INIT_TTIO;
BEGIN
IF INPUT^ <> ' ' THEN
REPEAT
READ(CH)
UNTIL CH = ' ';
END (* INIT_TTIO *);
PROCEDURE HALT(I: CARDINAL);
BEGIN
CASE I OF
1: WRITELN('LOD INPUT FILE HAS WRONG FORMAT');
2: WRITELN('NO ENTRY POINT BLOCK FOUND ON LOD INPUT FILE');
3: WRITELN('NO NEW KEY BLOCK FOUND ON LOD INPUT FILE');
4: WRITELN('NO FIRST FREE LOC BLOCK FOUND ON LOD INPUT FILE');
5: WRITELN('SINTAX ERROR IN FILE NAME');
6: WRITELN('EOF REACHED ON LOD INPUT FILE');
7: WRITELN('CHECK. SUMM ERROR ON LOD INPUT FILE');
8: WRITELN('BOTH PARTS OF SYSTEM TRY TO OCCUPY SAME LOCATION');
9: WRITELN('EOF REACHED ON RTS INPUT FILE');
10: WRITELN('NO OLD FIRST FREE LOC BLOCK FOUND ON LOD INPUT FILE');
ELSE WRITELN('UNKNOWN ERROR')
END;
EXITST(4)
END (* HALT *);
PROCEDURE READ_FILE_NAME(VAR F_N: FILE_NAME;
VAR S : BOOLEAN;
VAR D : BOOLEAN );
VAR
I: INTEGER;
BEGIN
FOR I:=1 TO 35 DO F_N[I]:=CHR(0);
I:=0;
S:=FALSE;
D:=FALSE;
REPEAT
I:=I+1;
READ(F_N[I]);
IF F_N[I] = ' ' THEN BEGIN
IF EOLN AND (I=1) THEN D:=TRUE;
I:=I-1
END;
UNTIL EOLN OR EOF OR D OR (I>=34);
IF EOF THEN EXITST(0);
IF EOLN AND (I<=34) THEN S:=TRUE;
IF EOLN OR (I>=34) THEN READLN;
END (* READ_FILE_NAME *);
(*-------------------rabota s LOD-fajlom--------------------*)
PROCEDURE READ_SECTOR;
BEGIN
BUFFER_R:=LOD_FILE^;
GET(LOD_FILE);
INDEX_R:=0;
LIMIT_R:=BUFFER_R[BUFF_LAST];
IF LIMIT_R=0 THEN EOF_LOD_FILE:=TRUE;
END;
PROCEDURE READ_AND_CHECK;
VAR
X : CARDINAL;
BEGIN
IF EOF_LOD_FILE THEN
HALT(6)
ELSE BEGIN
X:=BUFFER_R[INDEX_R];
INDEX_R:=INDEX_R+1;
IF INDEX_R = LIMIT_R THEN
IF LIMIT_R = BUFF_LAST THEN
READ_SECTOR
ELSE
EOF_LOD_FILE := TRUE;
IF CHECK_SUM <> X THEN HALT(7)
END;
END (* READ_AND_CHECK *);
PROCEDURE READ_WORD(VAR X:CARDINAL);
BEGIN
IF EOF_LOD_FILE
THEN HALT(6)
ELSE
BEGIN
X := BUFFER_R[INDEX_R];
INDEX_R := INDEX_R + 1;
IF INDEX_R = LIMIT_R
THEN
IF LIMIT_R = BUFF_LAST
THEN READ_SECTOR
ELSE EOF_LOD_FILE :=TRUE;
CHECK_SUM := CHECK_SUM + X
END;
END;
PROCEDURE SKIP_RECORD( COUNT : CARDINAL );
VAR
X : CARDINAL;
BEGIN
WHILE COUNT > 0 DO BEGIN
READ_WORD(X);
COUNT := COUNT - 1
END
END;
PROCEDURE START_READ;
BEGIN
CHECK_SUM := 0;
EOF_LOD_FILE := FALSE;
READ_SECTOR
END;
PROCEDURE OPEN_READ;
VAR
SUCCESS,
DEFAULT : BOOLEAN;
BEGIN
WRITE('MODULA-2 PROGRAM LOAD FILE >');
READ_FILE_NAME(LOD_NAME,SUCCESS,DEFAULT);
IF SUCCESS
THEN
IF DEFAULT
THEN RESET(LOD_FILE,'SY:MOD.LOD/SE/RO')
ELSE RESET(LOD_FILE,LOD_NAME,'SY:MOD.LOD/SE/RO')
ELSE
HALT(5);
START_READ
END;
PROCEDURE RE_OPEN_READ;
BEGIN
RESET(LOD_FILE);
START_READ
END;
PROCEDURE CLOSE_READ;
BEGIN
CLOSE(LOD_FILE)
END;
(*---------------------rabota s TSK-fajlom---------------*)
PROCEDURE WRITE_SECTOR;
VAR
I : BLOCK;
BEGIN
SEEK(TSK_FILE,CURRENT_BLOCK);
TSK_FILE^ := BUFFER_W;
PUT(TSK_FILE);
INDEX_W := 0;
CURRENT_BLOCK := CURRENT_BLOCK + 1
END;
PROCEDURE WRITE_WORD( W : CARDINAL );
VAR
I : BLOCK;
BEGIN
IF W <> 0
THEN
IF BUFFER_W [INDEX_W] <> 0
THEN
HALT(8)
ELSE
BUFFER_W[INDEX_W] := W;
IF INDEX_W < BUFF_LAST
THEN
INDEX_W := INDEX_W + 1
ELSE
BEGIN
WRITE_SECTOR;
IF LIMIT_W < CURRENT_BLOCK
THEN
BEGIN
FOR I := 0 TO BUFF_LAST DO BUFFER_W [I] := 0;
LIMIT_W := CURRENT_BLOCK
END
ELSE
BEGIN
BUFFER_W := TSK_FILE^;
GET(TSK_FILE)
END
END
END;
PROCEDURE WRITE_ZERO_LABEL_BLOCK;
VAR
I : BLOCK;
BEGIN
FOR I := 0 TO BUFF_LAST DO BUFFER_W[I] := 0;
WRITE_SECTOR;
WRITE_SECTOR
END;
PROCEDURE START_WRITE( WHERE : CARDINAL );
VAR
I : CARDINAL;
BEGIN
CURRENT_BLOCK := ( WHERE DIV (( BUFF_LAST+1)*2)) + 3;
INDEX_W := ( WHERE DIV 2 ) MOD ( BUFF_LAST+1 );
IF LIMIT_W < CURRENT_BLOCK
THEN
BEGIN
FOR I := 0 TO BUFF_LAST DO BUFFER_W [I] := 0;
REPEAT
LIMIT_W := LIMIT_W + 1;
IF LIMIT_W < CURRENT_BLOCK
THEN
BEGIN
SEEK(TSK_FILE,LIMIT_W);
TSK_FILE^ := BUFFER_W;
PUT(TSK_FILE)
END;
UNTIL LIMIT_W = CURRENT_BLOCK
END
ELSE
BEGIN
SEEK(TSK_FILE,CURRENT_BLOCK);
BUFFER_W := TSK_FILE^
END
END;
PROCEDURE END_WRITE;
BEGIN
WRITE_SECTOR
END;
PROCEDURE OPEN_WRITE;
VAR
I : INTEGER;
POINT : BOOLEAN;
BEGIN
FOR I := 1 TO 35 DO TSK_NAME[I] := CHR(0);
I := 1;
WHILE ( LOD_NAME[I] <> CHR(0) ) AND
( LOD_NAME[I] <> '.' ) AND
( LOD_NAME[I] <> ';' ) AND
( I <= 34 ) DO BEGIN
TSK_NAME[I] := LOD_NAME[I];
I := I + 1
END;
IF I = 1
THEN
REWRITE(TSK_FILE,'SY:MOD.TSK/SE/NOBL/RW')
ELSE
BEGIN
LOD_NAME[I] := '.';
LOD_NAME[I+1] := 'T';
LOD_NAME[I+2] := 'S';
LOD_NAME[I+3] := 'K';
REWRITE(TSK_FILE,TSK_NAME,'SY:MOD.TSK/SE/NOBL/RW')
END;
INDEX_W := 0;
LIMIT_W := 1;
CURRENT_BLOCK := 1
END;
PROCEDURE CLOSE_WRITE;
BEGIN
CLOSE(TSK_FILE)
END;
PROCEDURE TRANSFER_RECORD( C,A : CARDINAL );
VAR
X : CARDINAL;
BEGIN
START_WRITE(A);
WHILE C > 0 DO BEGIN
READ_WORD (X);
WRITE_WORD(X);
C := C - 1
END;
END_WRITE
END;
(*--------------------rabota s RTS--------------------*)
PROCEDURE READ_RTS_SECTOR;
BEGIN
RTS_BLOCK := RTS_BLOCK + 1;
SEEK(RTS_FILE,RTS_BLOCK);
BUFFER_R := RTS_FILE^;
GET(RTS_FILE);
INDEX_R := 0
END;
PROCEDURE READ_RTS_WORD( VAR X : CARDINAL);
BEGIN
IF EOF_RTS_FILE
THEN
HALT(9)
ELSE
BEGIN
X := BUFFER_R[INDEX_R];
IF RTS_BLOCK < LIMIT_RTS DIV ((BUFF_LAST+1)*2) + 3
THEN
IF INDEX_R < BUFF_LAST
THEN
INDEX_R := INDEX_R + 1
ELSE
READ_RTS_SECTOR
ELSE
IF INDEX_R < ( LIMIT_RTS DIV 2 ) MOD ( BUFF_LAST+1 )
THEN
INDEX_R := INDEX_R + 1
ELSE
EOF_RTS_FILE :=TRUE
END
END;
PROCEDURE MERGE_RTS;
VAR
I : BLOCK;
X : CARDINAL;
F1 : CARDINAL;
F2 : CARDINAL;
BEGIN
FOR I := 0 TO BUFF_LAST DO BUFFER_W[I] := BUFFER_R[I];
LIMIT_RTS := BUFFER_R [5];
CURRENT_BLOCK := 1;
WRITE_SECTOR;
START_WRITE(0);
READ_RTS_SECTOR; (* 2 BLOCK *)
READ_RTS_SECTOR; (* 3 BLOCK *)
REPEAT
READ_RTS_WORD(X);
WRITE_WORD(X);
UNTIL EOF_RTS_FILE;
END_WRITE;
CURRENT_BLOCK := 1;
SEEK(TSK_FILE,CURRENT_BLOCK);
BUFFER_W := TSK_FILE^;
IF (FIRST_FREE_LOC MOD 100B) = 0 THEN FIRST_FREE_LOC := FIRST_FREE_LOC+1;
F1 := ( FIRST_FREE_LOC DIV 100B )*100B + 77B;
F2 := ( FIRST_FREE_LOC + 77B ) DIV 100B;
(* HIGHEST VIRT. ADR., MAPPED BY ADR. WINDOW 0 *)
BUFFER_W [5] := F1;
(* HIGHEST TASK VIRTUAL ADDRESS (=BUFFER_W[5]) *)
BUFFER_W [6] := F1;
(* TASK LOAD SIZE IN 64(10)-WORDS BLOCKS (SIZE OF THE ROOT SEGMENT) *)
BUFFER_W [7] := F2;
(* TASK MAXIMUM SIZE IN 64(10)-WORDS BLOCKS. = THE SIZE OF THE
ROOT SEGMENT + ANY ADDITIONAL PHYSICAL MEMORY, NEEDED TO CONTAIN
TASK OVERLAYS *)
BUFFER_W [8] := F2;
(* TASK EXTENSION - UP TO 64 KB *)
BUFFER_W [352B DIV 2] := 2000B-F2;
(* RELATIVE BLOCK NUMBER OF R/O IMAGE *)
BUFFER_W [364B DIV 2] := FIRST_FREE_LOC DIV (( BUFF_LAST+1)*2) + 4;
TSK_FILE^ := BUFFER_W;
PUT(TSK_FILE);
CURRENT_BLOCK := 3;
SEEK(TSK_FILE,CURRENT_BLOCK);
BUFFER_W := TSK_FILE^;
(* INITIAL STACK POINTER *)
BUFFER_W [8] := 0; (* WE ARE USED ALL 64 KB MEMORY *)
TSK_FILE^ := BUFFER_W;
PUT(TSK_FILE)
END;
PROCEDURE OPEN_RTS_READ;
VAR
S,
D : BOOLEAN;
BEGIN
WRITE(CHR(15B));
WRITELN(' FILE OF RUN TIME SYSTEM OR');
WRITE ('<CR> FOR DEFAULT MS:[1,54]RTS.TSK:');
READ_FILE_NAME(RTS_NAME,S,D);
IF S
THEN
IF D
THEN
RESET(RTS_FILE,'MS:[1,54]RTS.TSK/RO/SE')
ELSE
RESET(RTS_FILE,RTS_NAME,'SY:[1,54]RTS.TSK/RO/SE')
ELSE
HALT(5);
RTS_BLOCK := 0;
READ_RTS_SECTOR;
LIMIT_RTS := 177777B
END;
PROCEDURE CLOSE_RTS_READ;
BEGIN
CLOSE(RTS_FILE)
END;
PROCEDURE WRITE_LUN_BLOCK;
VAR
I : CARDINAL;
BEGIN
CURRENT_BLOCK := 2;
SEEK(TSK_FILE,CURRENT_BLOCK);
FOR I := 1 TO BUFF_LAST DO BUFFER_W [I] := 0;
FOR I := 1 TO 16 DO BUFFER_W [2*I-2] := 54523B;
FOR I := 19 TO 20 DO BUFFER_W [2*I-2] := 54523B;
BUFFER_W [2*17-2] := 44524B;
BUFFER_W [2*18-2] := 44524B;
WRITE_SECTOR
END;
PROCEDURE WRITE_COMMUNICATION_AREA;
BEGIN
START_WRITE(INITIAL_START_ENTRY);
WRITE_WORD(SYSTEM_ENTRY_POINT_VALUE);
END_WRITE;
START_WRITE(INITIAL_START_STACK_BOTTOM);
WRITE_WORD(0); (* USE ALL MEMORY *)
END_WRITE;
START_WRITE(INITIAL_START_STACK_LIMIT);
WRITE_WORD (FIRST_FREE_LOC);
END_WRITE;
START_WRITE(LOADER_INFO);
WRITE_WORD (SYSTEM_LOAD_KEY_VALUE);
END_WRITE;
END;
(*---------------------M A I N---------------------*)
BEGIN
INIT_TTIO;
OPEN_READ;
OPEN_WRITE;
WRITE_ZERO_LABEL_BLOCK;
FOUND := [];
WHILE NOT EOF_LOD_FILE DO BEGIN
READ_WORD(X);
FLAG := FLGTYP(X);
READ_WORD(NBYTES);
READ_WORD(WHERE);
IF FLAG >= MAX_FLAG THEN HALT(1);
FOUND := FOUND+[FLAG];
CASE FLAG OF
ENTRY_POINT_FLAG : SYSTEM_ENTRY_POINT_VALUE := WHERE;
NEW_LOAD_KEY_FLAG : SYSTEM_LOAD_KEY_VALUE := WHERE;
OLD_FIRST_FREE_LOC_FLAG : OLD_FREE_LOC := WHERE;
FIRST_FREE_LOC_FLAG : FIRST_FREE_LOC := WHERE;
ELSE
END;
IF FLAG = CODE_FLAG
THEN TRANSFER_RECORD((NBYTES-6) DIV 2, WHERE)
ELSE SKIP_RECORD ((NBYTES-6) DIV 2 );
READ_AND_CHECK
END;
IF NOT (ENTRY_POINT_FLAG IN FOUND) THEN HALT(2);
IF NOT (NEW_LOAD_KEY_FLAG IN FOUND) THEN HALT(3);
IF NOT (OLD_FIRST_FREE_LOC_FLAG IN FOUND) THEN HALT(10);
IF NOT (FIRST_FREE_LOC_FLAG IN FOUND) THEN HALT(4);
TRANSFER_RECORD(0,FIRST_FREE_LOC-1);
CLOSE_READ;
OPEN_RTS_READ;
MERGE_RTS;
CLOSE_RTS_READ;
WRITE_COMMUNICATION_AREA;
WRITE_LUN_BLOCK;
CLOSE_WRITE;
WRITELN('END SYSTEM GENERATION ');
END.
Сообщение от Oleg N. Cher
Ответить с цитированием