DataMuseum.dk

Presents historical artifacts from the history of:

DANOSI

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about DANOSI

Excavated with: AutoArchaeologist - Free & Open Source Software. 

top - download

⟦b39f9a3e6⟧ TextFile

    Length: 4631 (0x1217)
    Types: TextFile
    Names: »TESTIO.RTP«

Derivation

└─⟦289818552⟧ Bits:30010516 DVBS1.SW2114.src.2.7-3 SW2114 3/4 Real Time Pascal 2.7
    └─⟦this⟧ »RTP\TESTIO.RTP« 
└─⟦783187a02⟧ Bits:30010525 DVBS1.SW2114.src.2.6-3 RTP compiler source SW2104+SW2114 Disk#3 30/1-92 HHA
    └─⟦this⟧ »RTP\TESTIO.RTP« 
└─⟦ca921ce75⟧ Bits:30010528 DVBS1.SW2114.src.2.6-6 RTP Compiler Source SW2104+SW2114 Disk 3 92.02.03 HEJ HHA
    └─⟦this⟧ »RTP\TESTIO.RTP« 
└─⟦d5707feda⟧ Bits:30010512 DVBS1.SW2114.src.2.14-3 SW2114 REAL #3/4 TIME PASCAL SOURCE REL 2.14 92.09.01
    └─⟦this⟧ »RTP\TESTIO.RTP«

TextFile

helpenv;\r
type\r
$if (target = i86)\r
$set target86 = 1\r
$else\r
$set target86 = 0\r
$endif\r
$if target86 = 1\r
     inoutzone=record\r
                 iz,oz: op_zone;\r
                 p: ^pool;\r
          end;\r
$else\r
     inoutzone=record\r
                 iz,oz: zone;\r
                 p: ^pool;\r
          end;\r
$endif\r
        \r
procedure open_input_zone(var z: inoutzone); external;\r
procedure open_output_zone(var z: inoutzone); external;\r
$IF target86 = 0 \r
procedure outputEnd(var z: zone;b : boolean); external;\r
$ENDIF\r
.\r
$IF target = rc3502\r
procedure outstring(var z : Zone; s : string);\r
BEGIN\r
  for i := 1 to s!length do outchar(z,s(i));\r
END;\r
$ENDIF\r
\r
$IF target86 = 0\r
procedure outputEnd(var z: zone;b : boolean);\r
begin\r
$IF target = rc3502\r
outend(z);\r
$ENDIF\r
$IF target = TA\r
outend(z,b);\r
delay(0);\r
$ENDIF\r
end;\r
$ENDIF\r
procedure open_input_zone(var z: inoutzone);\r
var mbx_ptr: ^mailbox;\r
begin\r
  if nil(z.p) then\r
  begin\r
    new(z.p);\r
$if target86=1\r
    op_initzone(z.iz);\r
$endif\r
    if allocpool(z.p^,2,100)<>2 then;\r
$if target86=1\r
    mbx_ptr:= search_object(operator_name);\r
    op_openzone(z.iz,mbx_ptr,z.iz.dataready,1,z.p^,1,7,0,0);\r
    op_in(z.iz);\r
    op_in(z.iz);\r
$else\r
    openopzone(z.iz,mbx_ptr,mbx_ptr,1,z.p^,1,7,0,0);\r
    opin(z.iz);\r
$endif\r
  end;\r
end;\r
procedure open_output_zone(var z: inoutzone);\r
var mbx_ptr: ^mailbox;\r
begin\r
  if nil(z.p) then\r
  begin\r
    new(z.p);\r
$if target86=1\r
    op_initzone(z.oz);\r
$endif\r
$code\r
    if allocpool(z.p^,1,100)<>1 then;\r
$nocode\r
$if target86=1\r
    mbx_ptr:= search_object(operator_name);\r
    op_openzone(z.oz,mbx_ptr,z.oz.free,1,z.p^,2,7,0,0);\r
$else\r
    openopzone(z.oz,mbx_ptr,mbx_ptr,1,z.p^,2,7,0,0);\r
$endif\r
  end;\r
end;\r
$code\r
procedure writechar(var z: inoutzone; aa: char);\r
begin\r
  open_output_zone(z);\r
$if target86=1\r
  op_outchar(z.oz,aa);\r
  op_outend(z.oz,true);\r
$else\r
  outchar(z.oz,aa);\r
  Outputend(z.oz,true);\r
$endif\r
end;\r
$nocode\r
procedure writestring(var z: inoutzone; inspect aa: string);\r
begin\r
\r
  open_output_zone(z);\r
$if target86=1\r
  op_outstring(z.oz,aa);\r
  op_outchar(z.oz,' ');\r
  op_outend(z.oz,true);\r
$else\r
  for i := 1 to aa!length do\r
   outchar(z.oz,aa(i));\r
  outchar(z.oz,' ');\r
  Outputend(z.oz,true);\r
$endif\r
end;\r
\r
procedure printboolean(var z: inoutzone; aa: boolean);\r
begin\r
  open_output_zone(z);\r
  if aa=true then\r
  begin\r
$if target86 = 1\r
  op_outstring(z.oz,"TRUE ");\r
  op_outend(z.oz,true);\r
$else\r
  outstring(z.oz,"TRUE ");\r
  Outputend(z.oz,true);\r
$endif\r
  end else\r
  begin\r
$if target86 = 1\r
  op_outstring(z.oz,"FALSE ");\r
  op_outend(z.oz,true);\r
$else\r
  outstring(z.oz,"FALSE ");\r
  Outputend(z.oz,true);\r
$endif\r
  end;\r
end;\r
procedure printinteger(var z: inoutzone; aa: integer);\r
begin\r
  open_output_zone(z);\r
$if target86=1\r
  op_outinteger(z.oz,aa,1);\r
  op_outchar(z.oz,' ');\r
  op_outend(z.oz,true);\r
$else\r
  outinteger(z.oz,aa,1);\r
  outchar(z.oz,' ');\r
  Outputend(z.oz,true);\r
$endif\r
end;\r
$code\r
procedure printword(var z: inoutzone; aa: word);\r
begin\r
  open_output_zone(z);\r
\r
  with aa as ii: integer do\r
$if target86=1\r
   op_outhex(z.oz,ii,5);\r
  op_outstring(z.oz,"HW ");\r
  op_outend(z.oz,true);\r
$else\r
   outhex(z.oz,ii,5);\r
$nocode\r
  outstring(z.oz,"HW ");\r
  Outputend(z.oz,true);\r
$endif\r
end;\r
\r
procedure printbyte(var z: inoutzone; aa: byte);\r
begin\r
  open_output_zone(z);\r
  with aa as ii: 0..255 do\r
$if target86=1\r
   op_outhex(z.oz,ii,5);\r
  op_outstring(z.oz,"HB ");\r
  op_outend(z.oz,true);\r
$else\r
   outhex(z.oz,ii,5);\r
  outstring(z.oz,"HB ");\r
  Outputend(z.oz,true);\r
$endif\r
end;\r
\r
function readchar(var z: inoutzone): char;\r
var aa:char;\r
begin\r
  open_input_zone(z);\r
$if target86 = 1\r
  op_inchar(z.iz,aa);\r
$else\r
  inchar(z.iz,aa);\r
$endif\r
  if z.iz.readstate<>0 then\r
  begin\r
$if target86=1\r
    op_in(z.iz);\r
    op_wait(z.iz,z.p^);\r
    op_inchar(z.iz,aa);\r
$else\r
    opin(z.iz);\r
    opwait(z.iz,z.p^);\r
    inchar(z.iz,aa);\r
$endif\r
  end;\r
  readchar:=aa;\r
end;\r
\r
function readinteger(var z: inoutzone): integer;\r
var aa:integer;\r
begin\r
  open_input_zone(z);\r
$if target86 = 1\r
  op_ininteger(z.iz,aa);\r
$else\r
  ininteger(z.iz,aa);\r
$endif\r
  if z.iz.readstate<>0 then\r
  begin\r
$if target86=1\r
    op_in(z.iz);\r
    op_wait(z.iz,z.p^);\r
    op_ininteger(z.iz,aa);\r
$else\r
    opin(z.iz);\r
    opwait(z.iz,z.p^);\r
    ininteger(z.iz,aa);\r
$endif\r
  end;\r
  readinteger:=aa;\r
end;\r
\r
\r
function byt(x : integer) : byte;\r
begin\r
  byt := x mod 256;\r
end;\r
\r
function int(x : INT16) : integer;\r
begin\r
  int := x;\r
end;\r
\r
function wrd(x : integer) : INT16; \r
begin\r
wrd := x;\r
end.\r