DataMuseum.dk

top - metrics - download

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

└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ.  Detaljer om "HC8000" projekt.
    └─⟦0364f57e3⟧ 
        └─⟦787c125fb⟧ »adjprocfile« 
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
    └─⟦b2ec5d50f⟧ 
        └─⟦787c125fb⟧ »adjprocfile« 
            └─⟦this⟧ 

TextFile

;       parent_nam_tx         * page 1   13 08 79, 12.48;  

;  parent_name
;  ***********

parent_name = set 1

parent_name = algol

external integer procedure parent_name
______________________________________
_                (c_name, char, p_name);  
long array        c_name,       p_name;  
long                      char;  

comment 

parent_name      (call and return, integer proc)
The last character in the text stored in c_name is
extracted and stored in char, and the remaining text is 
stored in p_name. The value of the procedure is the number
of remaining characters in the text. An empty string
is permitted.

c_name           (call, long array)
An array of up to 11 characters. The array is unchanged
after the call, but if c_name(1) has a zero in the least
significant 8 bits c_name(2) is cleared.

char             (return, long)
Contains the last character of the text in c_name
stored in the most significant 8 bits. If c_name is empty, 
char is zero.

p_name           (return, long array)
Contains the remaining text of c_name after extraction of char.

Prog. Knud Poder, JUN 1979

;  

\f



comment parent_nam_tx         * page 2   13 08 79, 12.48
0 1 2 3 4 5 6 7 8 9 ;  

begin
  integer  i, t;  
  long     ch;  

  if c_name(1) extract 8 = 0 then
  c_name(2) := 0;  

  if c_name(1) <> 0 then
  begin
    t := -8;  
    for i := t + 8 while 
    _        (c_name(1 + i//48) shift ((i mod 48) - 40))
    _        extract 8 <> 0 do
    _        t := i;  
  end
  else t := -8;  

  i := t//8;  

  if i >= 0 then
  begin
    parent_name := i;  

    for i := 1 step 1 until 2 do p_name(i) := c_name(i);  

    i         := 1 + t//48;  
    t         := 40 - (t mod 48);  
    ch        := p_name(i) shift (-t);  
    char      := ch shift 40;  
    p_name(i) := (ch shift (-8)) shift (t + 8);  
  end i >= 0
  else 
  begin
    parent_name := 0;  
    char        := 0;  
  end;  
end parent_name;  

end;  

if ok.no
mode warning.yes

if warning.yes
(mode 0.yes
message parent_name not ok
lookup parent name)

end

finis
▶EOF◀