DataMuseum.dk

Presents historical artifacts from the history of:

RC4000/8000/9000

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

See our Wiki for more about RC4000/8000/9000

Excavated with: AutoArchaeologist - Free & Open Source Software. 

top - metrics - download

⟦243aa3ea0⟧ TextFile

    Length: 2304 (0x900)
    Types: TextFile
    Names: »crealinktx  «

Derivation

└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
    └─⟦75ff9bef3⟧ 
        └─⟦this⟧ »crealinktx  «

TextFile

mode list.yes
createlink=algol connect.no rts.algftnrts7 survey.yes
begin
  zone                z (128, 1, stderror);
  integer array       ia (1:20);
  long    array       ldname, devname, netname (1:4);
  integer             devno, devtype, reason, devix, devinc, status, result,
                      i, j;

  if system (4, 1, ldname) <> 4 shift 12 + 10 then
    system (9, 1, <:<10>param:>);

  if system (4, 2, ia) <> 4 shift 12 + 4 then
    system (9, 2, <:<10>param:>);
  devno := ia (2);

  if system (4, 3, ia) =  4 shift 12 + 4 then
    devname (1) := long <::>
  else
  if system (4, 3, devname) <> 4 shift 12 + 10 then
    system (9, 3, <:<10>param:>);
  
  if system (4, 4, ia) <> 4 shift 12 + 4 then
    system (9, 4, <:<10>param:>);
  devtype := ia (2);

  if system (4, 5, netname) <> 4 shift 12 + 10 then
    system (9, 5, <:<10>param:>);

  open (z, 0 shift 12 + 0 <*users = 0*>, ldname, 0);

  if ldlink (z, devno, devname, devtype, netname, reason) then
  begin
    write (out,
    "nl", 1, <:linkup_ld (z, :>, devno, <:, :>, 
    devname, <:, :>, devtype, <:, :>, netname, <:, reason);:>,
    "nl", 1, <:ldlink true, reason =  maxsendsize shift 8 + device index = :>,
    reason shift (-8), <: shift 8 + :>, reason extract 8,
    <: devno = :>, devno);

<*  if ldunlink (z, devno, devname, reason) then
      write (out,
      "nl", 1, <:ldunlink true, reason =  0 < 12 +  1 = :>,
      reason shift (-12), <: shift 12 + :>, reason extract 12)
    else
      write (out,
      "nl", 1, <:ldunlink false, reason = status < 12 + result = :>,
      reason shift (-12) extract 12, <: shift 12 + :>, reason extract 12);
*>
  end
  else
  begin
    write (out,
    "nl", 1, <:ldlink false, :>);
    if reason shift (-12) extract 12 = 4095 then
      write (out,
      <:reason =   4095 shift 12 + result = :>, 
      reason shift (-12) extract 12, <: shift 12 + :>, reason extract 12)
    else
      write (out,
      <:reason = status shift 12 + result = :>, 
      reason shift (-12) extract 12, <: shift 12 + :>, reason extract 12);
  end;

  close (z, true);
end;
▶EOF◀