DataMuseum.dk

top - download

    Length: 5214 (0x145e)
    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« 
        └─⟦4034421d9⟧ 
            └─⟦this⟧ 

TextFile

with system;				use system;
with v_i_pass;				use v_i_pass;
with unchecked_conversion;

package v_i_libop is

	pragma not_elaborated;
	pragma suppress(EXCEPTION_TABLES);
	pragma suppress(ALL_CHECKS);

---- for image and value attributes ---------------------
  type target_integer is new integer;
  type target_dv_integer is new integer;
  type dv_rec is
		record
      char_size: target_dv_integer;
      low:       target_dv_integer;
      high:      target_dv_integer;
      size:      target_dv_integer;
    end record;
  type dv_ptr is access dv_rec;
  pragma local_access(dv_ptr);

  type image_rec is
		record
      width:  integer;
      count:  integer;
      images:  string(1 .. 1);
    end record;
  type image_ptr is access image_rec;
  pragma local_access(image_ptr);
  type pv_arr is array(target_integer range 0 .. 0) of target_integer;
  type pv_ptr is access pv_arr;
  pragma local_access(pv_ptr);
  type char_ptr is access character;
  pragma local_access(char_ptr);
	function atoc is new unchecked_conversion(address, char_ptr);

	function enum_image ( map: image_ptr; val: target_integer; dv:  dv_ptr)
		return address;
	function enum_value ( str: address; dv: dv_ptr; image: image_ptr)
		return target_integer;
	function enum_width ( map: image_ptr; low, high: target_integer)
		return target_integer;

	function int_image ( val: target_integer; image: address; dv: dv_ptr)
		return address;
	function int_value ( str: address; dv:  dv_ptr; lb, ub:  target_integer)
		return target_integer;
	function int_width ( low:  target_integer; high: target_integer)
		return target_integer;

------ val/pos support --------------------------------------
	function val_to_pos ( val:    target_integer; pv_map: pv_ptr)
		return target_integer;

------ bit support ------------------------------------------
	procedure bitcopy(
		bits: 		integer;
		src_base: 	address;
		src_bit_offset: integer;
		dst_base: 	address;
		dst_bit_offset: integer);
	function biteq(
		bits: 		integer;
		lhs_base: 	address;
		lhs_bit_offset: integer;
		rhs_base: 	address;
		rhs_bit_offset: integer)
		return			boolean;

-- catenation support ---------------------------------------------
	procedure lib_catenate(arg_list_p: address; new_dv: dv_ptr);

-- block memory support -------------------------------------------
	procedure bcopy( src_addr, dst_addr: address; lgth: integer);
	procedure bzero ( addr: address; lgth: integer);
	--  Compare 2 strings of characters given their address and the length.
	--  Condition codes are left for the calling procedure.
	procedure cmpc3 ( addr1: address; addr2: address; lgth:  integer);
	--  Compare 2 strings of chars with possibly different lengths.
	--  Condition codes are left for the calling procedure.
	procedure cmpc4(addr1:address; lgth1:integer; addr2:address; lgth2:integer);
	--  Compare 2 strings of longs with possibly different lengths.
	--  Condition codes are left for the calling procedure.
	procedure cmpl4(addr1:address; lgth1:integer; addr2:address; lgth2:integer);
	--  Compare 2 strings of words with possibly different lengths.
	--  Condition codes are left for the calling procedure.
	procedure cmpw4(addr1:address; lgth1:integer; addr2:address; lgth2:integer);
	--  Copy a block of memory from one address to another.
	--  Handles overlapping segments of memory.
	procedure movc3 ( addr1: address; addr2: address; lgth:  integer);

-- fixed point support --------------------------------------------
	function fixed_mantissa(low: target_integer; high: target_integer)
		return target_integer;

-- string support --------------------------------------------
	procedure strncpy(dest: system.address; src: system.address; len: integer);

private
	pragma interface(Ada, fixed_mantissa);
	pragma interface_name(fixed_mantissa, "FIXED_MANTISSA");
	pragma interface(Ada, movc3);
	pragma interface_name(movc3, "MOVC3");
	pragma interface(Ada, cmpw4);
	pragma interface_name(cmpw4, "CMPW4");
	pragma interface(Ada, cmpl4);
	pragma interface_name(cmpl4, "CMPL4");
	pragma interface(Ada, cmpc4);
	pragma interface_name(cmpc4, "CMPC4");
	pragma interface(Ada, cmpc3);
	pragma interface_name(cmpc3, "CMPC3");
	pragma interface(Ada, bzero);
	pragma interface_name(bzero, "BZERO");
	pragma interface(Ada, bcopy);
	pragma interface_name(bcopy, "BCOPY");
	pragma interface(Ada, biteq);
	pragma interface_name(biteq, "BITEQ");
	pragma interface(Ada, bitcopy);
	pragma interface_name(bitcopy, "BITCOPY");
	pragma interface(Ada,val_to_pos);
	pragma interface_name (val_to_pos, "VAL_TO_POS");
	pragma interface(Ada,int_width);
	pragma interface_name (int_width, "INT_WIDTH");
	pragma interface(Ada,int_value);
	pragma interface_name (int_value, "INT_VALUE");
	pragma interface(Ada,int_image);
	pragma interface_name (int_image, "INT_IMAGE");
	pragma interface(Ada,enum_width);
	pragma interface_name (enum_width, "ENUM_WIDTH");
	pragma interface(Ada,enum_value);
	pragma interface_name (enum_value, "ENUM_VALUE");
	pragma interface(Ada,enum_image);
	pragma interface_name(enum_image, "ENUM_IMAGE");
	pragma interface(Ada, lib_catenate);
	pragma interface_name(lib_catenate, "__LIB_CATENATE");
	pragma interface(Ada, strncpy);
	pragma interface_name(strncpy, "__STRNCPY");
end