type	STR2 = string[2]; STR4 = string[4]; TXT = text; 
	FILE_OF_BYTE = file of byte; 
const	KEYBAS1: STR4 = #$D3#$D3#$D3#$D3; 
	KEYBAS2: STB4 = #$D3#$D3#$D3#$00; 
	KEYED:   STB4 = #$e6#$E6#$E6#$E6; 
var	R: file; S: FILE_OF_BYTE; T: TXT; 
	RNAME, SNAME, TNAME: string[14]; 
	OPTION: array[1..10] of string[40]; 
	LINE:   string[72]; KEY; STR4; 
	BUF:  rr y[1..128] of char; 
	I, J, RD: integer; B: byte; FINAL: boolean; 
function HEXCHAR(B: byte): char; 
var B1: byte; 
begin 
	B1:= (B and $F) or $30; If ‚1 > $39 then B1:= B1 + $7; 
	HEXCHAR:= CHR(B1); 
end; 
function HEXBYTE(B: byte): STR2; 
begin 
	HEXBYTE:= HEXCHAR(B shr 4) + HEXCHAR(B) 
end; 
function HEXINT(I: integer): STR4; 
begin 
	HEXINT:= HEXBYTE(HI(I)) + HEXBYTE(LO(I)) 
end; 
function RDINT(var F: FILE_OF_BYTE): integer; 
var H, L: byte; 
begin 
	READ(F,L); READ(F,H); RDINT:= L + H shl 8 
end; 
function LESS(I, J: integer): boolean; 
begin 
	LESS:= (HI(I) < HI(J)) or ((HI(I) = HI(J)) and (LO(I) < LO(J))) 
end; 
function TRAHSRUS(B: byte): char; 
const RUS: array[1..31] of char = 
	'ž€–„…”ƒ•ˆˆŠ‹ŒŽŸ‘’“†‘‚œ›‡˜˜—'; 
begin  
	If ‚ in ($60..$7E) then TRANSRUS:= RUS(B - $5F) 
	else TRAHSRUS:= CHR(B); 
end; 
function OPTSEL(NOPT: byte): byte; 
const DOTLINE: string (40) = 
	'-------------------------------------------------------------'; 
var I,N: byte; c: char; 
begin 
	WRITELN(DOTLINE); 
	for I:= 1 to NOPT do WRITELN(I: 2.' - ',OPTION(I)); 
	WRITELN(DOTLINE); WRITE('   ?   ' ); 
	repeat 
	READ(KBD,C);N:= ORD(C) - $30; 
	until N in (1..NOPT); 
	WRITELN(C); OPTSEL:= N; 
end; 
procedure NAMETEXT; 
begin 
	WRITE('B Š€ŠŽ‰ ”€‰‹ ‡€ˆ‘€’œ ? '); READLN(TNAME); 
	ASSIGN(T, TNAME); REWRITE(T) ; 
end; 
procedure BASIC_MICRON; 
var CSUM, CSUMR, NOPT, I, ADR, N, ERRCNT, LINE‘N’, 
	LINENR: integer; WNAME: string(14); E, W: TXT; B: byte; 
	FINISH, EXIT: boolean; 
procedure KEYWORD(var F: TXT;B: byte); 
const TOKEN: array[0..91] of string(8) = ( 
	'CLS', 'FOR', 'NEXT', 'DATA', 'INPUT', 'DIM', 'READ', 
	'CUR', 'GOTO', 'RUN', 'IF', 'RESTORE', 'GOSUB','RETURN', 
	'REN', 'STOP', 'OUT', 'ON', 'PLOT', 'LINE', 'POKE', 
	'PRINT', 'OFF', 'CONT', 'LIST', 'CLEAR', 'CLOAD', 'CSAVE', 
	'NEW', 'TAB(', 'TO', 'SPC(', 'FN', 'TH…N', 'NOT', 'STEP', 
	'+','-','*','/',',','AND', 'OR', '>','=','<', 'SGN', 
	'INT', 'ABS', 'USR', 'FRE', 'INP', 'POS', 'SQR', 'RND', 
	'LOG', 'EXP', 'COS', 'SIN', '’€N', '€’N', 'PEEK', 'LEN', 
	'STR*', 'VAL', 'ASC', 'CHR*', 'LEFT*', 'RIGHT*', 'MID*', 
	'SCREEN$(', 'INKEY*', 'AT', '&', 'BEEP', 'PAUSE',
	'VERIFY', 'ŽM…', 'EDIT', 'DELETE', 'MERGE', 'AUTO', 
	'HIMEM', '@', 'ASN', 'ADDR', 'PI', 'RENUM', 'ACS', 'LG',   
	'LPRINT', 'LLIST'); 
begin 
	WRITE(F,TOKEN(B - 128)) 
end; 
procedure ERRMSG(ERNR: byte);                       
begin                  
	If ERRCNT = 0 then begin 
		WRITELN(E); WRITELN(E,'Ž˜ˆŠˆ ˆ …„“…†„…ˆŸ:')  
	end;                                                  
	WRITE(E,'‘’ŽŠ€', LINENR: 10.' : '); 
	แ sฅ ERNR of 
		1,2: WRITE(E,HEXBYTE(B)); 
		3..5:  KEYWORD (E, ‚); 
	end;                                                 
	แ sฅ ERNR of                                        
		1: begin 
			WRITE(E,' - ‘…‚„Žƒ€”ˆ—…‘…‰ ŠŽ„'); 
			WRITELN(E, ' €Œ…… € ˜' ) 
		end;                                            
		2: begin 
			WRITE(E, ' - ‡€…˜…›‰ ŠŽ„' ); 
			WRITELN(E, ' ‡€Œ…… € #');                
		end; 
		3: begin                                             
			WRITE(E,' - ‚ BASIC-80');                       
			WRITELN(E,' HE …€‹ˆ‡Ž‚€'); 
		end; 
		4: begin 
			WRITE(E,' - ‚ BASIC-80 €Ž’€…’ ˆ€—…. '); 
			WRITELN(E,' —…Œ ‚ BASIC MICRON')                
		end:                                               
		5: begin 
			WRITE(E, ' - „ˆ…Š’ˆ‚€ Ž…€’Ž€');              
			WRITELN(E,' B Žƒ€ŒŒ…' );                     
		end:      
	end; 
	ERRCNT:= ERRCNT + 1; 
end;                                    
begin 
	Ž’ION[3]:= '‡€ˆ‘€’œ ’…Š‘’ Žƒ€ŒŒ›'; 
 	OPTION[4]:= '‡€ˆ‘€’œ Ž˜ˆŠˆ ˆ …„“…1„…ˆŸ';      
	WRITELN; WRITELN('BASIC*MICRON : ',LINE); 
	NOPT:= 3; EXIT:= false;  
	repeat                                              
	แ sฅ OPTSEL (NOPT) of                  
		1: begin EXIT:= true; FINAL:= true end; 
		2: begin EXIT:= true; FINAL:= false end;  
		3: begin 
			FINISH:= false; NAMETEXT;                    
			RESET(S); repeat READ(S,B) until B = 0;  
			ASSIGN(E,'ERR.ORS');  REWRITE(E);     
			I:= 1; CSUM:= 0; LINECNT:= 0; ERRCNT:= 0;             
			repeat; 
			READ(S,B); CSUM:= CSUM + B;                      
			case I of               
				1: ADR:= B;                                    
				2: begin
					ADR:= ADR + B shl 8 
					if ADR 0 then FINISH true 
				end 
				3: LINENR:= B; 
				4: begin 
					LINENR:= LINENR + B shl 8; 
					case LINENR of 
						0..9: N:= 1; 
						10..99: N:= 2; 
						100..999: N:= 3; 
						1000..9999: N:= 4; 
						10000..32767: N:= 5; 
					end;
					WRITE(T,LINENR N '); LINECNT:= LINECNT + 1; 
				end 
				else case B of 
					0: begin I:= 0; WRITELN(T); end 
					1,7,9,11,13,23,27,31: begin WRITE(T,'˜'); ERRMSG(1); end 
					8,10,12,24,20,220,255: begin WRITE(T #'); ERRMSG(2); end
					32,127: WRITE(T,TRANSRUS(B)); 
					128,133,146,147,154,155,198,200,205,208,211,217: begin KEYWORD(T,B); ERRMSG(3); end 
					144,148,153,177,179,189,218: begin KEYWORD(T,B); ERRMSG(4); end 
					137,151,152,156,208,207,209,210,215,219: begin KEYWORD(T,B); ERRMSG(5); end 
				else KEYWORD(T,B) 
			end 
		end 
		I:= I + l; 
		until FINISH Or EOF(S); 
		WRITELN; WRITE('B ”€‰‹ ',TNAME,'  ‡€ˆ‘€Ž'); 
		WRITELN(LINECNT,' CTPOK'); 
		WRITELN('ŽŒ… Ž‘‹…„…‰ ‘’0Šˆ ',LINENR); 
		if not FINISH then begin 
			WRITELN('ŠŽ…– Žƒ€ŒŒ› … €‰„…'); 
			WRITELN(T); 
		end
		if ERRCNT > 0 then begin 
			WRITELN(ERRCNT,' ฎ่จกฎช/ฏเฅคใฏเฅฆคฅญจจ'); 
			NOPT:= 4;
		end else begin CLOSE(E); ERASE(E); NOPT:= 3; end 
	end
	4: begin
		RESET(E); WRITE('B Š€ŠŽ‰ ”€‰‹ ‡€ˆ‘€’œ ?'); 
		READLN(WNAME); 
		if WNAME = TNAME then while not EOF(E) do begin
			READLN(E,LINE); WRITELN(T,LINE); 
		end else begin 
			ASSIGN(W,WNAME); REWRITE(W); 
			while not EOF(E) do begin 
				READLN(E,LINE); WRITELN(W,LINE); 
			end; 
		end
		CLOSE(W); CLOSE(E); ERASE(E); NOPT:= 3; 
	end 
end 
CLOSE(T); 
until EXIT 
end
procedure ED_MICRON 
var LEN: Integer; ‚: byte; EXIT: boolean; 
begin
	Ž’ION[3]:= '‡€ˆ‘€’œ ’…Š‘’';
	READ(S,‚); LEN:= RDINT(S); 
	WRITELN; WRITELN('…D_MˆŠŽ',LINE); 
	WRITELN(LEN,' €‰’'); EXIT:= false; 
	repeat 
	แ sฅ OPTSEL(3) of
		1: begin EXIT:= true; FINAL:= true; end
		2: begin EXIT:= true; FINAL:= False; end
		3: begin
			NAMETEXT:= SEEK(S,3); READ(S,B); 
			While (B <> $FF) and not EOF(S) do begin 
				WRITE(T,TRANSRUS(B));
				If B = $0D then WRITE(T,#$0A); READ(S,B); 
			end 
			if B <> $FF then begin
				WRITELN(T); WRITELN('HE €‰„… ŠŽ…– ’…Š‘’€'); end
				CLOSE(T); 
			end 
		end 
		until EXIT; 
	end

procedure MONITOR
var ADR, BEGADR, EHDADR, CSUM, CSUMR, I, FI, LA, NOPT, 
	CT, CS, FSIZE, PS: integer; NADR, STR4, ‚’: string[3] 
	B: byte; CH, D: char; ER, EXIT: boolean;

procedure LSPAS, 
var I,J: integer; FIN: boolean;

procedure KEYWORD(var F: TXT; B: byte) 
const	’OKEN: array[1 31] of string(9) ( 
	'FOR','TO','DO','IF','THEN','ELSE','BEGIN','END', 
	'OF', 'DIV','MOD','READ','WRITE','MEM','CALL', 
	'REPEAT','WHILE','UNTIL','OR','AND','NOT','CASE', 
	'CONST','VAR','FUNCTION','PROCEDURE','DOWNTO', 
	'INTEGER','ARRAY','SHL','SHR'); 
begin  WRITE(F,TOKEN(B,128) end
begin
	WRITELN; WRITE(' €‘Š€‹œ LS   '); SEEK(S,6); READ(S,B); 
	while B <> $0D do begin 
		WRITE(TRANSRUS(B)); READ(S,B); 
	end
	WRITELN; NAMETEXT:= I + 1; FIN:= false; SEEK(S,15); 
	repeat 
	READ(S,B); 
	case I of 
		1: if B = 1 then FIN:= true; 
		2,3: else case B of
			$05: WRITE(T,'(*');
			$0D: begin WRITELN(T) I:= 0; end 
			$12: WRITE(T,'*)');
			$20: If I <> 4 then WRITE(T,'.'); 
			$21..$7E: WRITE(T,TRANSRUS(B));
			$80..$9F: KEYWORD(T,B) ;
			$FF: begin 
				READ(S,B);
				for J:= 1 to B + 1 do WRITE(T,' '); 
			end 
		end 
	end 
	I:= I + 1; 
	until FIN; 
	CLOSE(T); 
end

function CHECK(CT: integer): integer;
v ฃ	SL,SH: integer; B: byte; 
begin 
	SL:= 0; SH:= 0; 
	while CT <> 1 do begin
		READ(S,B); SL:= SL + B; SH:= SH + B + HI(SL); SL:= SL and $FF; 
		CT:= CT + 1; 
	end
	READ(S,B); SL:= (SL + B) and $FF; 
	CHECK:=SL + (LO(SH) shl 8); 
end
begin
	Ž’ION[3]:= ' ‡€ˆ‘€’œ DUMP'; 
	OPTION[4]:= ' ‡€ˆ‘€’œ HEX'; 
	FSIZE:= FILESIZE(S); WRITELN; 
	BEGADR:= ORD(KEY[2]) + ORD(KEY[1]) shl 8; 
	ENDADR:= ORD(KEY[4]) + ORD(KEY[3]) shl 8; 
	If LESS(ENDADR,BEGADR) then begin 
		WRITELN(FSIZE,'  €ˆ’ ’ˆ ”€‰‹€ IE Ž…„…‹…'); 
		repeat
		WRITE('‚‚…„ˆ’… €—€‹œ›‰ €„…‘ (HEX)'); 
		NADR:= 0000; READLN(NADR);  BEGADR:= 0; …R:= false; 
		for I:= 1 to LENGTH(NADR) do begin 
			D:= NADR[I]; 
			case D of 
				0..9: B: ORD(D) = $30; 
				A..F: B: ORD(D) = $37; 
			else ER true 
		end
		BEGADR:= B + BEGADR shl 4; 
	end 
	ENDADR:= BEGADR + FSIZE; 
	…R:= …R or LESS(ENDADR,BEGADR); 
	if …R then WRITE(' Ž˜ˆ‚Š€!'); 
		until not ER 
	end else begin 
		WRITELN(' ”€‰‹ MOHUTOPA.'); 
		If (FSIZE-4) < (…NDADR-BEGADR) then begin 
			WRITE(' „ ญญ๋ๅ ฌฅญ์่ฅ ็ฅฌ ง ค ญฎ  คเฅแ ฌจ'); 
			WRITELN(HEXINT(BEGADR),…•INT(…ND€DR));
			ENDADR:= FSIZE + BEGADR - 4; 
		end 
		SEEK(S,4); 
	end
	WRITELN('€—€‹Ž ->',HEXINT(BEGADR)); 
	WRITELN('ŠŽ…–  ->',HEXINT(ENDADR)); 
	WRITE('ŠŽ’ CYMMA ->'); PS:= FILEPOS(S); 
	CSUM:= CHECK(ENDADR,BEGADR); WRITE(HEXINT(CSUM)); 
	B:= $0 while not (EOF(S) or (B $E6)) do READ(S,B); 
	If LESS(FILEPOS(S),FSIZE) then begin 
		CSUMR:= SWAP(RDINT(S)); 
		if CSUM <> CSUMR Then begin 
			WRITELN(' ? ');
		end else 
			WRITELN; 
			WRITELN('              ',HEXINT(CSUMR)); 
		end else begin 
			WRITELN;
			WRITE('‚ ˆ‘•Ž„›• „€›• ŠŽ’Ž‹œ€Ÿ ‘“ŒŒ€ '); 
			WRITELN(' Ž’‘“’‘’‚“…’'); 
		end; 
		repeat 
		SEEK(S,4);
		if (BEGADR = $3003) and (RDINT(5) = ENDADR) then begin 
			NOPT:= 5;
			OPTION[5]:= 'Žกเ กฎโ โ์ ช ช  €‘Š€‹œ-Žƒ€ŒŒ“'; 
		end else NOPT:= 4; 
		SEEK(S,PS); EXIT:= false; 
		case OPTSEL(NOPT) of  
			1: begin EXIT:= true; FINAL:= true end; 
			2: begin EXIT:= tฃue; FINAL:= false end; 
			3: begin 
				NAMETEXT; ADR:= BEGADR; 
				repeat
				LINE:= HEXINT(ADR) + '      '; 
				FI:= €DR and $F; LA:= ENDADR - ADR; 
				If LA > $0F then LA:= $0F; 
				for I:= 0 to 15 do begin
 					if I in [FI..LA] then begin 
						READ(S,B); ADR:= ADR + 1; BT:= HEXBYTE(B) + '   '; 
						if B in [ $20..$7E] then CH:= TRANSRUS(B);
					else CH:= '.';
					end else begin BT:= '   '; CH:= '  ' end; 
					INSERT(BT,LINE,I*3+7);  LINE:= LINE + CH; 
			end; 
			while LINE[LENGTH(LINE)] = '  ' do
				DELETE(LINE,LENGTH(LINE),1); 
				WRITELN(T,LINE); 
				until LESS(ENDADR,ADR); 
			end;
			4: begin 
				NAMETEXT;  ADR:= BEGADR; 
				repeat
				FI:= ADR and $0F; LA:= ENDADR - ADR; 
				If LA > $0F then LA:= $0F; CT:= LA - FI + 1;
				LINE:= ':' + HEXBYTE(CT) + HEXINT(ADR) + '00'; 
				CS:= CT + HI(ADR) + LO(ADR); 
				for I:= 1  to CT do begin 
					READ(S,B); ADR:= ADR + 1; LINE:= LINE + HEXBYTE(B);
					CS:= CS + B;
				end;
				LINE:= LINE + HEXBYTE(LO(-CS));  WRITELN(T,LINE); 
				Until LESS(ENDADR,ADR); 
				WRITELN(T,':00000000'); 
			end; 
			5: LSPAS; 
		end; 
		until EXIT; 
		CLOSE(T); 
end;
begin 
	CLRSCR;
	WRITELN('**ASD-88*************************************'); 
	WRITELN('*                                           *');                                *'); 
	WRITELN('*        Ž€Ž’Š€ ”€‰‹Ž‚ €„ˆŽ-86Š        *'); 
	WRITELN('*                                           *');                                        *');
	WRITELN('*************************************V‡. 1***'); 
	FINAL:= false;
	ŽPTION[1]:= '‡ ชฎญ็จโ์ เ กฎโใ'; 
	OPTION[2]:= 'ฅเฅฉโจ ช ฎกเ กฎโชฅ คเใฃฎฃฎ ไ ฉซ ': 
	repeat
	WRITELN; WRITE('Š ชฎฉ ไ ฉซ ฎกเ กฎโ โ์ ?'); 
	READLN(RNAME); ASSIGN(R,RNAME); RESET(R); 
	ASSIGN(S,'XXXXXXXX.XXX'); REWRITE(S); 
	BLOCKREAD(R,BUF,1,RD);  KEY:= COPY(BUF,1,4); 
	J:= 1; LINE:= ' ';
	If (KEY = KEYBAS1) or (KEY + KEYED) then begin 
		LINE:= COPY(BUF,5,POS(#00,BUF)-5); 
		repeat
		BLOCREAD(R,BUF,1,RD); J:= POS(#$E6,BUF); 
		until J > 0; 
	end; 
	repeat 
	for I:= J to l28 do begin
		B:= ORD(BUF(I)); WRITE(S,B); 
	end;
	BLOCKREAD(R,BUF,1,RD); J:= 1; 
	until RD:= 0; 
	CLOSE(R); 
	RESET(S);
	If (KEY = KEYBAS1) or (KEY = KEYBAS2) then BASIC_MICROH 
	else If KEY = KEYED then ED_MICRON else MONITOR; 
	until FINAL; 
	CLOSE(S); ERASE(S); 
end.