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

⟦8f4fa41ce⟧ TextFile

    Length: 3072 (0xc00)
    Types: TextFile
    Names: »setproctx«, »setproctx   «

Derivation

└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
    └─⟦75ff9bef3⟧ 
        └─⟦this⟧ »setproctx   « 
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
    └─⟦75ff9bef3⟧ 
        └─⟦592c22808⟧ »proctxpack  « 
            └─⟦c7b1c7cfc⟧ 
                └─⟦this⟧ »setproctx« 

TextFile



;       set_proc               * page 1   19 01 82, 13.07;  


if listing.yes
char 10 12 10

set_proc = set 1 0

set_proc = algol

external integer procedure set_proc(name, tail);  
  ________________________________________________
  long array name;  integer array tail;  
  <*
  setproc  (return, integer)   0 ok
  _                            1  change kind impossible
  _                            2  bs device unknown
  _                            3  change bs device impossible
  _                            4  no resources
  _                            5  in use
  _                            6  name format illegal
  _                            7  catalog inconsistent

  name     (call, long array)  contains the entry name.
  _                            If name(1)=long<::> a wrkname is
  _                            created and name is return parameter.

  tail     (call, long array)  contains the entry tail
  _                            1     size or modekind
  _                            2:5   docname
  _                            6     shortclock, in case shortclock
  _                                  is found in the entry
  _                            7:10  remaining tail
  *>
  begin integer i;  
    long array field laf;  
    zone zhelp(1, 1, stderror);  
    integer array ia(1:20);  
    i:=1;  open(zhelp, 0, string name(increase(i)), 0);  
    laf:=0;  for i:=1 step 1 until 5 do ia.laf(i):=tail.laf(i);  
    i:=monitor(40<*create*>, zhelp, 0, ia);  
    setproc:=i;  
    if name(1)=long<::> then
    begin <*get wrkname*>
      getzone6(zhelp, ia);  
      laf:=2;  
      name(1):=ia.laf(1);  
      name(2):=ia.laf(2);  
    end;  
    if i=3 then
    begin <*entry exists*>
      i:=monitor(42<*lookup*>, zhelp, 0, ia);  
      if i<>0 then
      begin setproc:=7;  goto exit_setproc end;  
      if tail(1)<0 or ia(1)<0 then
      begin
        if tail(1)>=0 or ia(1)>=0 then
        begin setproc:=1;  goto exit_setproc end;  
        goto change
      end;  

\f



comment set_proc               * page 2   19 01 82, 13.07;  

      if tail(2)=0 or tail(2)=1 then goto change;  
      if tail(3) extract 8=0 then tail(4):=tail(5):=0;  
      if tail(2)<>ia(2) or tail(3)<>ia(3) or
      tail(4)<>ia(4) or tail(5)<>ia(5) then
      begin setproc:=3;  goto exit_setproc end;  
      change:
      laf:=0;  for i:=1 step 1 until 5 do ia.laf(i):=tail.laf(i);  
      i:=monitor(44<*change*>, zhelp, 0, ia);  
      if i=6 then i:=4;  
      setproc:=i;  
    end entry exists;  
    exit_setproc:
  end set_proc;  

end

if ok.no
mode warning.yes

if warning.yes
(mode 0.yes
message set_proc not ok
lookup set_proc)
▶EOF◀