DataMuseum.dk

top - metrics - download

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

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

TextFile

mode list.yes
fpconnect=algol survey.yes connect.no
begin
  zone            z (128, 1, blpr);
  integer         result, status;
  long    array   ia, ja, la (1:14);
  integer array field iaf;
  long    array field laf;

  procedure blpr (z, s, b);
  zone            z       ;
  integer            s, b ;
  begin 
    integer i;
    integer array ia (1:10);

    system (5, b, ia);

    write (out,
    "nl", 1, <:answer           address : :>, ia (1),
    "nl", 1, <:zone  descriptor address : :>, ia (2),
    "nl", 1, <:share descriptor address : :>, ia (3),
    "nl", 1, <:logical          status  : :>, ia (4));

    status := ia (4);

    system (5, ia (1), ia);

    write (out,
    "nl", 1, <:answer : :>);

    for i := 1 step 1 until 8 do
      write (out, 
      "nl", 1, <:answer (:>, i, <:) : :>, ia (i));

  end blpr;

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

  if la (1) shift (-40) extract 8 = '0' then
    la (1) := 0;

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

  if system (4, 3, ja) <> 8 shift 12 +  4 then
     system (9, 3, <:<10>param:>);

  result := ia (1) shift 2 + ja (1) extract 2;

  fpproc (28, result, z, la);

  write (out,
  "nl", 1, <:fpproc (28,:>, ia (1), <: shift 2 + :>, ja (1) extract 2,
  <:, z, <'<'><':'>:>, la, <:<':'><'>'>) : :>,
  case (result + 1) of (
  <:connected:>,
  <:no resources:>,
  <:malfunction:>,
  <:not user, non exist:>,
  <:convention error:>,
  <:not allowed:>,
  <:name format error:>));

<*if system (4, 4, la) = 4 shift 12 + 4 then
    laf := la (1);

  movestring (la, 1, <:jaja, det er nu godt nok:>);

  fpproc (31, la, z,  0); *><*outtext  (z, la);   *>
  
<*fpproc (33, 0 , z, 10);*><*outend   (z, nl);   *>
<*fpproc (34, 0 , z, 25);*><*close up (z, em);   *>

<*fpproc (95, 0 , z,  0);*><*close up text output*>

<*iaf := 0; 
  la.iaf (1) := 44 shift 12;
  movestring (la.iaf, 2, <:<10>hilsen..:>);
  fpproc (35, 0 , la.laf, z);*><*parent message (la, z);*>
<*fpproc ( 7, 0 , z , 1 shift 18);*><*end program            *>

end;

end
▶EOF◀