DataMuseum.dk

top - 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⟧ 

TextFile

-- 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;