Добавил:
БГУИР ПОИТ Дистанционное Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:

5

.PAS
Скачиваний:
13
Добавлен:
06.10.2021
Размер:
4 Кб
Скачать
program IPR;
uses CRT;

var
  reg,regOut,initial:integer;
  opt:char;

Procedure Reg13;
var
  key:char;
begin
   clrscr;
   {print value of register 13}
   port[$3d4]:=$13;
   reg:=port[$3d5];
   initial:=port[$3d5];
   writeln('Register 13 has value = ',reg);
   {change value of register 13}
   key:='a';  
   repeat
   writeln('To increase value of register 13 enter m');
   writeln('To decrease value of register 13 enter l');
   writeln('To go to main menu enter b');
   readln(key);
    clrscr;
   case key of
     'm': begin
         reg:=reg+1;
         port[$3d4]:=$13;
         port[$3d5]:=reg;
         port[$3d4]:=$13;
         regOut:=port[$3d5];
         writeln;
         writeln('Register 13 has value =',regOut);
       end;
     'l': begin
         reg:=reg-1;
         port[$3d4]:=$13;
         port[$3d5]:=reg;
         port[$3d4]:=$13;
         regOut:=port[$3d5];
         writeln;
         writeln('Register 13 has value =',regOut);
       end;
   end;
   until key='b';
   port[$3d4]:=$13;
   port[$3d5]:=initial; {return initial value of register 13}
end;

Procedure RegC;
var
  key:char;
begin
  clrscr;
   {print value of  register C}
   port[$3d4]:=$c;
   reg:=port[$3d5];
   initial:=port[$3d5];
   writeln('Register C matters = ',reg);
   {change value of register C}
   key:='a'; 
   repeat
   writeln('To increase the value of register C enter m');
   writeln('To decrease the value of register C enter l');
   writeln('To go to the main menu, enter b');
   readln(key);
    clrscr;
   case key of
     'm': begin
         reg:=reg+1;
         port[$3d4]:=$c;
         port[$3d5]:=reg;
         port[$3d4]:=$c;
         regOut:=port[$3d5];
         writeln;
         writeln('Register C matters =',regOut);
       end;
     'l': begin
         reg:=reg-1;
         port[$3d4]:=$c;
         port[$3d5]:=reg;
         port[$3d4]:=$c;
         regOut:=port[$3d5];
         writeln;
         writeln('Register C matters =',regOut);
       end;
   end;
   until key='b';
   port[$3d4]:=$c;
   port[$3d5]:=initial; {return initial value of register C}
end;

Procedure RegD;
var
  key:char;
begin
  clrscr;
   {print value of  register D}
   port[$3d4]:=$d;
   reg:=port[$3d5];
   initial:=port[$3d5];
   writeln('Register D matters = ',reg);
 {change value of register D}
   key:='a'; 
   repeat
   writeln('To increase the value of register D enter m');
   writeln('To decrease the value of register D enter l');
   writeln('To go to the main menu, enter b');
   readln(key);
    clrscr;
   case key of
     'm': begin
         reg:=reg+1;
         port[$3d4]:=$d;
         port[$3d5]:=reg;
         port[$3d4]:=$d;
         regOut:=port[$3d5];
         writeln;
         writeln('Register D matters =',regOut);
       end;
     'l': begin
         reg:=reg-1;
         port[$3d4]:=$d;
         port[$3d5]:=reg;
         port[$3d4]:=$d;
         regOut:=port[$3d5];
         writeln;
         writeln('Register D matters =',regOut);
       end;
   end;
   until key='b';
   port[$3d4]:=$d;
   port[$3d5]:=initial; {return initial value of register D}
end;

begin
  clrscr;
  repeat
  writeln('Select register number, press Enter');
  writeln('1 - 13');
  writeln('2 - C');
  writeln('3 - D');
  writeln('Exit - enter 0');
  readln(opt);
    case opt of
      '1': Reg13;
      '2': RegC;
      '3': RegD;
	  Else 
writeln('Invalid registration number');
    end;
  until opt='0';
end.
Соседние файлы в предмете Аппаратное обеспечение компьютерной техники