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

⟦b6721a45b⟧ TextFile

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

Derivation

└─⟦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



;       child_name_tx         * page 1   13 08 79, 12.48;  

;  child_name
;  **********

if listing.yes
char 10 12 10

child_name = set 1

child_name = algol

external integer procedure child_name
_____________________________________
_                (p_name , char, c_name);  
value                      char;  
long array        p_name,        c_name;  
long                       char;  

comment

child_name      (call and return, integer proc)
The character in char is added to the string in p_name
and the result is stored in c_name. The value of the
procedure is the number of characters in c_name.
If p_name has more then 10 characters nothing is
added and the value becomes zero.  

p_name          (call, long array)
but only up to 11 characters.
but only up to 10 characters make sense, p_name is 
not changed by the call, unless p_name(1) has less 
than 6 characters. p_name(2) is then cleared.

char            (call, long)
The add-character is stored in the 8 most significant bits
of char, and following characters in char are neglected.

c_name          (return, long)
The concatenated string of p_name and char (first char), 

Prog. Knud Poder, JUN 1979
;  

\f



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

begin
  integer i, t;  
  char := char shift (-40);  

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

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

  i := (96 - t)//8;  

  if i <= 11 then
  begin
    child_name := i;  

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

    i         := 2 - t//48;  
    t         := t mod 48;  
    c_name(i) := c_name(i) + (char shift t);  
  end i <= 11

  else
  child_name := 0;  

end child_name;  

end;

if ok.no
mode warning.yes

if warning.yes
(mode 0.yes
message child_name not ok
lookup child_name)

end

finis
▶EOF◀