|
|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 2304 (0x900)
Types: TextFile
Names: »childnametx«
└─⟦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⟧
; 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◀