1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
| unit IO;
interface
uses SysUtils;
const
STAT = 1;
DISA_LOCK = 1; {LOCK - шлюз, замок, запирать}
DAVR_LOCK = 2;
TIMEOUT = 1000000; //1000000;
procedure outp_as(addr_:integer;bdata:byte);
function inp_as(addr_:integer):byte;
procedure outp(addr_:integer;bdata:byte);
function inp(addr_:integer):byte;
procedure outp_b(addr_:integer;bdata:byte);
function inp_b(addr_:integer):byte;
procedure outp_w(addr_:integer;wdata:word);
function inp_w(addr_:integer):word;
procedure outp_l(addr_:integer;ldata:longint);
function inp_l(addr_:integer):longint;
type
ETimeOut = class(Exception); //SysUtils
implementation
uses MSTypes; //,Dialogs;
procedure outp_as(addr_:integer;bdata:byte);
asm
xchg eax,edx //обмен 32-х разрядными регистрами
out dx,al
end;
function inp_as(addr_:integer):byte;
asm
mov edx,eax
in al,dx
end;
procedure outp(addr_:integer;bdata:byte);
begin
if Is_W9x then outp_as(addr_,bdata)
else;
end;
function inp(addr_:integer):byte;
begin
if Is_W9x then Result := inp_as(addr_)
else Result := 0;
end;
procedure outp_b(addr_:integer; bdata : byte); //отослать bdata (byte) по адресу addr
var t:integer;
begin
//MessageDlg('outp_b-0', mtInformation,[mbOk], 0);
//DISA_LOCK = 1 - константа
t := 0;
while inp(addr_+STAT) AND DISA_LOCK > 0 do
begin
Inc(t);
if t > TIMEOUT then raise ETimeOut.Create('IO timeout - Output');
end;
//MessageDlg('outp_b-1', mtInformation,[mbOk], 0);
outp(addr_,bdata);
end;
function inp_b(addr_:integer):byte; //считать (получить) byte с адреса addr
var t:integer;
begin
//DAVR_LOCK = 2 - константа
//STAT = 1 - константа
// result := 0;
t := 0;
while inp(addr_+STAT) AND DAVR_LOCK = 0 do
begin Inc(t);
if t > TIMEOUT then
{begin RaiseErr := 'IO TimeOut!'; inc(RaiseNum); end;}
// try Break;
// finally result := 0;
// end;
raise ETimeOut.Create('IO timeout');
end;
result := inp(addr_);
end;
procedure outp_w(addr_:integer; wdata : word);
begin
//MessageDlg('outp_w-0', mtInformation,[mbOk], 0);
outp_b(addr_,wdata);
//MessageDlg('outp_w-1', mtInformation,[mbOk], 0);
outp_b(addr_,wdata SHR 8);
end;
function inp_w(addr_:integer):word;
begin
result := inp_b(addr_) OR inp_b(addr_) SHL 8;
end;
procedure outp_l(addr_:integer;ldata:longint);
begin
outp_b(addr_,ldata);
outp_b(addr_,ldata SHR 8);
outp_b(addr_,ldata SHR 16);
outp_b(addr_,ldata SHR 24);
end;
function inp_l(addr_:integer):longint;
begin
result := inp_b(addr_) OR inp_b(addr_) SHL 8 OR inp_b(addr_) SHL 16 OR inp_b(addr_) SHL 24;
end;
end. |
(
