DataMuseum.dk

top - download

    Length: 4979 (0x1373)
    Types: TextFile
    Names: »IO.ENV«

└─⟦5bf9983c6⟧ Bits:30010496 DANOSI SW50070 Disk 2/2 MegaSwitch Development Toolset Rel. 1.1 PN: 798-66-79 DVBS1.SW50070.rel.1.1.2/2
    └─⟦this⟧ »PAXENV\IO.ENV« 

TextFile

ioenv;\r
-----------------------------------------------------------------------\r
--   environment for operator comm. procedures\r
--\r
--    1985.09.26   /bb\r
--\r
-- 860915 bb outdouble introduced *)\r
--           indouble  introduced *)\r
-- 861001 bb outalfa has frozen var alfa param *)\r
-- 880721 bb changes to rtp3502 release 4\r
-- 890703 bb changed name to ioenv and made alfabetic order\r
-- 900201 bb Compiler switch controls first, last, next.\r
--           Outtext removed.\r
-- 910226 HEJ  Common source for RTP3502 and RTP35022\r
-- 920131 bb Switches changed from compiler to language\r
-- 920218 bb Merge of Mega version and this version\r
--           Common environment for RTP3502, RTP2111, RTP\r
-----------------------------------------------------------------------\r
\r
const\r
\r
linelength = 80;\r
\r
$IF target = TA\r
firstindex = 20;\r
$ELSEIF language = rtp3502\r
firstindex = 6 + typesize(alfa);\r
$ELSEIF fln > 0\r
firstindex = 6 + typesize(alfa);\r
$ELSE\r
firstindex = typesize(alfa);\r
$ENDIF\r
\r
lastindex  = firstindex + linelength - 1;\r
\r
type\r
\r
opbuffer =\r
record\r
$IF target = TA\r
dummy1, dummy2 : integer;\r
$ELSEIF language = rtp3502\r
first ,\r
last  ,\r
next  : integer;\r
$ELSEIF fln > 0\r
first ,\r
last  ,\r
next  : integer;\r
$ENDIF\r
name  : alfa;\r
chars : array ( firstindex..lastindex ) of char\r
end;\r
\r
\r
\r
zone =\r
record\r
$IF language = rtp3502\r
driver    : ^ semaphore; (* operator process       *)\r
answer    : ^ semaphore; (* answers returns here   *)\r
dataready : semaphore;   (* buffers with data      *)\r
free      : semaphore;   (* free buffers           *)\r
$ELSE\r
driver    : ^mailbox;    (* operator process       *)\r
answer    : ^mailbox;    (* answers returns here   *)\r
dataready : mailbox;     (* buffers with data      *)\r
free      : mailbox;     (* free buffers           *)\r
$ENDIF\r
cur       : reference;   (* current buffer         *)\r
$IF target = TA\r
u2val     : integer;\r
state     : integer;\r
$ELSE\r
u2val     : byte;        (* u2 to driver           *)\r
state     : byte;        (* resultcode from answer *)\r
$ENDIF\r
readstate : integer;     (* 0: ok, >0: error, -1: cur=nil *)\r
nextp     : integer;     (* pointer into databuf   *)\r
lastpos   : integer;     (* last position in databuf *)\r
end;\r
\r
procedure inchar (var z : zone; var t : char);\r
external;\r
\r
$IF target <> TA\r
procedure indouble (var z : zone; var d : double);\r
external;\r
$ENDIF\r
\r
procedure inhex (var z : zone; var num : integer);\r
external;\r
\r
procedure ininteger (var z : zone; var num : integer);\r
external;\r
\r
$IF target <> TA\r
procedure inname (var z : zone; var name : alfa);\r
external;\r
$ELSE\r
procedure inname (var z : zone; var name : string);\r
external;\r
$ENDIF\r
\r
procedure opanswer (var msg : reference; var z : zone);\r
external;\r
\r
$IF language = rtp3502\r
procedure openzone (var z : zone;  driv, answ : ^ semaphore;\r
bufs : integer; var home : pool 1; v1, v2, v3, v4 : byte);\r
external;\r
\r
procedure openopzone (var z : zone;\r
 driv, answ : ^ semaphore;\r
bufs : integer; var home : pool 1; v1, v2, v3, v4 : byte);\r
external;\r
\r
$ELSE\r
procedure openzone (var z : zone; driv, answ : ^ mailbox;\r
bufs : integer; var home : pool; v1, v2, v3, v4 : byte);\r
external;\r
\r
procedure openopzone (var z : zone; driv, answ : ^ mailbox;\r
bufs : integer; var home : pool; v1, v2, v3, v4 : byte);\r
external;\r
$ENDIF\r
\r
procedure opin (var z : zone);\r
external;\r
\r
function optest (var z : zone) : boolean;\r
external;\r
\r
$IF language = rtp3502\r
procedure opwait (var z : zone; var inputpool : pool 1 );\r
external;\r
$ELSE\r
procedure opwait (var z : zone; var inputpool : pool);\r
external;\r
$ENDIF\r
\r
$IF target <> TA\r
procedure outaddr (var z : zone; a : addr);\r
external;\r
$ENDIF\r
\r
$IF language = rtp3502\r
procedure outalfa (var z : zone;  var text : ! alfa);\r
external;\r
\r
procedure outtext = outalfa (var z : zone;  var text : ! alfa);\r
external;\r
$ELSE\r
procedure outalfa (var z : zone;  inspect text : alfa);\r
external;\r
$ENDIF\r
\r
procedure outchar (var z : zone; t : char);\r
external;\r
\r
$IF target <> TA\r
procedure outdate (var z : zone; date : coded_date);\r
external;\r
$ELSE\r
procedure outdate (var z : zone; inspect date : coded_date);\r
external;\r
$ENDIF\r
\r
$IF target <> TA\r
procedure outdouble (var z : zone; num : double; pos : integer);\r
external;\r
$ENDIF\r
\r
procedure outend (var z : zone);\r
external;\r
\r
procedure outfill (var z : zone; filler : char; rep : integer);\r
external;\r
\r
procedure outhex (var z : zone; num, pos : integer);\r
external;\r
\r
procedure outinteger (var z : zone; num, pos : integer);\r
external;\r
\r
procedure outnl (var z : zone);\r
external;\r
\r
$IF target = TA\r
procedure outstring (var z : zone; textstring : string);\r
external;\r
$ENDIF\r
\r
$IF target <> TA\r
procedure outtime (var z : zone; time : coded_time);\r
external;\r
$ELSE\r
procedure outtime (var z : zone; inspect time : coded_time);\r
external;\r
$ENDIF\r
\r
procedure printmessage (var z : zone; var r : reference;\r
   first, last, words_per_line : integer);\r
external;\r
\r
.\r