|
|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 3768 (0xeb8)
Types: TextFile
Notes: R1k Text-file segment
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦bc0db2bdd⟧
└─⟦this⟧
-- Copyright 1986, 1987, 1988 Verdix Corporation
with machine_code;
with system; use system;
with unchecked_conversion;
package body v_bits is
pragma suppress(ALL_CHECKS);
pragma suppress(EXCEPTION_TABLES);
function to_i is new unchecked_conversion(address, integer);
function to_a is new unchecked_conversion(integer, address);
procedure b_and(l, r: integer; x : out integer) is
use machine_code;
begin
code_2'(move_l, l'ref, d0);
code_2'(move_l, r'ref, d1);
code_2'(and_l, d0, d1);
code_2'(move_l, d1, x'ref);
end b_and;
pragma inline_only(b_and);
function bit_and(l, r: integer) return integer is
x: integer;
begin
b_and(l, r, x);
return x;
end bit_and;
function bit_and(l, r: address) return address is
x: integer;
begin
b_and(to_i(l), to_i(r), x);
return to_a(x);
end bit_and;
procedure b_or(l, r: integer; x : out integer) is
use machine_code;
begin
code_2'(move_l, l'ref, d0);
code_2'(move_l, r'ref, d1);
code_2'(or_l, d0, d1);
code_2'(move_l, d1, x'ref);
end b_or;
pragma inline_only(b_or);
function bit_or(l, r: integer) return integer is
x: integer;
begin
b_or(l, r, x);
return x;
end bit_or;
function bit_or(l, r: address) return address is
x: integer;
begin
b_or(to_i(l), to_i(r), x);
return to_a(x);
end bit_or;
procedure b_xor(l, r: integer; x : out integer) is
use machine_code;
begin
code_2'(move_l, l'ref, d0);
code_2'(move_l, r'ref, d1);
code_2'(eor_l, d0, d1);
code_2'(move_l, d1, x'ref);
end b_xor;
pragma inline_only(b_xor);
function bit_xor(l, r: integer) return integer is
x: integer;
begin
b_xor(l, r, x);
return x;
end bit_xor;
function bit_xor(l, r: address) return address is
x: integer;
begin
b_xor(to_i(l), to_i(r), x);
return to_a(x);
end bit_xor;
procedure b_neg(l : integer; x : out integer) is
use machine_code;
begin
code_2'(move_l, l'ref, d0);
code_2'(eori_l, +(-1), d0);
code_2'(move_l, d0, x'ref);
end b_neg;
pragma inline_only(b_neg);
function bit_neg(l : integer) return integer is
x: integer;
begin
b_neg(l, x);
return x;
end;
function bit_neg(l: address) return address is
x: integer;
begin
b_neg(to_i(l), x);
return to_a(x);
end bit_neg;
procedure b_sra(l, cnt: integer; x: out integer) is
use machine_code;
begin
code_2'(move_l, cnt'ref, d0);
code_2'(move_l, l'ref, d1);
code_2'(asr_l, d0, d1);
code_2'(move_l, d1, x'ref);
end b_sra;
pragma inline_only(b_sra);
function bit_sra(l, cnt: integer) return integer is
x: integer;
begin
b_sra(l, cnt, x);
return x;
end bit_sra;
function bit_sra(l: address; cnt: integer) return address is
x: integer;
begin
b_sra(to_i(l), cnt, x);
return to_a(x);
end bit_sra;
procedure b_srl(l, cnt: integer; x: out integer) is
use machine_code;
begin
code_2'(move_l, cnt'ref, d0);
code_2'(move_l, l'ref, d1);
code_2'(lsr_l, d0, d1);
code_2'(move_l, d1, x'ref);
end b_srl;
pragma inline_only(b_srl);
function bit_srl(l, cnt: integer) return integer is
x: integer;
begin
b_srl(l, cnt, x);
return x;
end bit_srl;
function bit_srl(l: address; cnt: integer) return address is
x: integer;
begin
b_srl(to_i(l), cnt, x);
return to_a(x);
end bit_srl;
procedure b_sll(l, cnt: integer; x: out integer) is
use machine_code;
begin
code_2'(move_l, cnt'ref, d0);
code_2'(move_l, l'ref, d1);
code_2'(lsl_l, d0, d1);
code_2'(move_l, d1, x'ref);
end b_sll;
pragma inline_only(b_sll);
function bit_sll(l, cnt: integer) return integer is
x: integer;
begin
b_sll(l, cnt, x);
return x;
end bit_sll;
function bit_sll(l: address; cnt: integer) return address is
x: integer;
begin
b_sll(to_i(l), cnt, x);
return to_a(x);
end bit_sll;
end v_bits;