$title('icscan - scan interconnect space and print map of system')
$compact
/********************************************************************
 *
 *     MODULE NAME:  icscan	
 *
 *     DESCRIPTION: Scan the iPSB backplane.  Record each board instance and slot
 *                  number in a system map.  Get local host slot number and id and
 *                  record in system map.  Print system map on console.
 *			
 *********************************************************************/

icscan: DO;

$include(:rmx:inc/rmxplm.ext)
$include(:rmx:inc/error.lit)
$include(err.ext)

DECLARE		/* literals */

	MAXSLOTS       LITERALLY  '20',	   /* maximum number of slots */
	VENDORIDREG    LITERALLY  '00',	   /* low byte of vender id reg */
	BOARDIDREG     LITERALLY  '02H',   /* register offset of board id */
	BOARDIDLEN     LITERALLY  '10',    /* number of bytes in board id */
	BUFLEN         LITERALLY  '11',    /* length of board id rmx string */
	LOCALHOST      LITERALLY  '31',    /* selects local host interconnect */ 
	PSBCONTROLREC  LITERALLY  '06H',   /* psb control record value */
	PSBSLOTIDOFF   LITERALLY  '02H',   /* offset of slot id reg in psb control rec */
	NOEXCEPT       LITERALLY  '0',     /* no exception handling by system */
	RECNOTFOUND    LITERALLY  '0FFH',  /* indicates interconnect record not found */

	map_struc      LITERALLY 'STRUCTURE(
                                        id(BUFLEN)  BYTE,
	                                    slot_num    BYTE)';                		       
	                                    
DECLARE
	con_tab(16) byte INITIAL('0','1','2','3','4','5','6','7','8',
									 '9','A','B','C','D','E','F');

$subtitle('find_record')
/*
 *	PROC NAME:	find_record
 *
 *	DESCRIPTION:
 *		Searches through the interconnect space of the specified board
 *		(slot_number) until either the record type passed is found or the
 *		EOT (end of template) record is found.  If the record is found,
 *		then its record type and offset are returned.  If the EOT record
 *		is found, then 0FFH is returned.
 *
 *	CALL:	record_found = find_record(slot_number, record_type, rec_offset_ptr);
 *
 *	INPUTS:  slot_number 	    BYTE containing slot number of board
 *		     record_type        BYTE containing record type to find
 *	RETURNS: record_found       byte indicating whether record was found
 *						        (contains 0FFH (EOT record type) if record not found)
 *	OUTPUTS: record_offset_ptr  POINTER to WORD offset of record found
 *
 ****************************************************************************/

	find_record: PROCEDURE(slot_number, record_type, rec_offset_ptr) BYTE PUBLIC REENTRANT;

		
		DECLARE
			slot_number		BYTE,
			record_type		BYTE,
			rec_offset_ptr	POINTER,
			rec_offset		BASED rec_offset_ptr WORD,
			record_found	BYTE,
			status			WORD;

		DECLARE 

			EOT_REC      LITERALLY '0FFH', /* end of template record */
			HDRRECLENGTH LITERALLY '20H',  /* number of registers in header rec */
			RECLENREG    LITERALLY '1';    /* record length register */
								
	/*
	 *  Get record type for each record past the header
	 *  record until the specified record is found
	 */

	rec_offset = HDRRECLENGTH;
	record_found = rq$get$interconnect(slot_number, rec_offset, @status);
	CALL error$check(100, status);
	DO WHILE (record_found <> record_type) AND (record_found <> EOT_REC);

		/*
		 *  Get offset for next record by adding length of current record
		 *  to previous record offset (add 2 to account for type and length register)
		 */
		rec_offset = rec_offset + 2 + rq$get$interconnect(slot_number,
										rec_offset + RECLENREG,
										@status);
		CALL error$check(110, status);
		record_found = rq$get$interconnect(slot_number, rec_offset, @status);
		CALL error$check(120, status);
		END;

	RETURN(record_found);

	END find_record;



$subtitle('out_byte - print a byte on the console')
/********************************************************************
 *
 *	PROC NAME: out_byte
 *
 *	DESCRIPTION: Write the hex representation of hex_byte to the console.
 *
 *	CALL: CALL out_byte(hex_byte)
 *
 *	INPUT: hex_byte - byte whose hex value is to be printed
 *              
 *	GLOBALS:
 *
 *********************************************************************/

out_byte: procedure(hex_byte) public;

DECLARE
	hex_byte	BYTE,
	hex_buf(3)  BYTE,
	cur_byte	BYTE,
	status      WORD;
	
	cur_byte = shr(hex_byte, 4);
	hex_buf(0) = 2;
	hex_buf(1) = con_tab(cur_byte);
	cur_byte = hex_byte AND 0FH;
	hex_buf(2) = con_tab(cur_byte); 
	call rqc$send$eo$response(NIL,0,@hex_buf,@status);
END out_byte;

$subtitle('print_map - print system map')
/********************************************************************
 *
 *	PROC NAME: print_map	
 *
 *	ABSTRACT: Write system map to console
 *
 *	CALL: CALL printmap(sys_map_ptr);
 *
 *	INPUT: sys_map_ptr - pointer to system map
 *              
 *	GLOBALS:
 *
 *	CALLS:  rqc$send$eo$response, out_byte
 *			
 *
 *********************************************************************/

print_map: PROCEDURE(sys_map_ptr) PUBLIC;

	DECLARE       /* params */

		sys_map_ptr   POINTER; 

	DECLARE       /* locals */

		sys_map  BASED  sys_map_ptr(MAXSLOTS) map_struc,  /* system map */
		i                                     BYTE,       /* local index */
		status                                WORD;

	
	CALL rqc$send$eo$response(NIL,0,@(2,0dh,0ah),@status);
	CALL rqc$send$eo$response(NIL,0,@(17,'     SYSTEM MAP',0dh,0ah),@status);
	CALL rqc$send$eo$response(NIL,0,@(23,'board          slot',0dh,0ah,0dh,0ah),@status);		
	DO i = 0 to MAXSLOTS -1;
		CALL rqc$send$eo$response(NIL,0,@sys_map(i).id,@status);
		CALL rqc$send$eo$response(NIL,0,@(5,'     '),@status);
		CALL out_byte(sys_map(i).slot_num);
		CALL rqc$send$eo$response(NIL,0,@(2,0DH,0Ah),@status);
	END;

END print_map;

DECLARE         /* globals */
		
	iPSB_slot                BYTE,     /* psb slot currently scanned */
	status                   WORD,
	count                    BYTE,     /* index into id string */
	vendor_id_lo             BYTE,     /* low byte of vendor id */
	vendor_id_hi             BYTE,
	id_char                  BYTE,     /* character in board id */
	local_slot               BYTE,     /* slot number of local host */
	psb_reg_off              WORD,     /* offset of psb control record */     
	r_type                   BYTE,     /* record type returned by find_record */	
	sys_map(MAXSLOTS)        map_struc;/* map of boards in system */

               /* begin main */
                
	CALL set$exception(NOEXCEPT);
	DO iPSB_slot = 0 TO MAXSLOTS - 1;

		sys_map(iPSB_slot).slot_num = iPSB_slot; 
		vendor_id_lo = rq$get$interconnect(iPSB_slot, VENDORIDREG, @status);
		CALL error$check(130, status);

		vendor_id_hi = rq$get$interconnect(iPSB_slot, VENDORIDREG+1, @status);
		CALL error$check(140, status);

		/*
		 * If vendor_id is not equal to 0, then there is a
		 * board in this slot, so get the board's id
		 */

		IF ((vendor_id_hi OR vendor_id_lo) <> 0) THEN DO;
			count = 0;
			sys_map(iPSB_slot).id(0) = BOARDIDLEN;
			DO WHILE (count < BOARDIDLEN);
				id_char = rq$get$interconnect(iPSB_slot, BOARDIDREG+count, @status);
				CALL error$check(150, status);
				IF (id_char <= '!') OR (id_char >= '}') THEN
					id_char = ' ';
				sys_map(iPSB_slot).id(count+1) = id_char; 
				count = count + 1;
			END;
		END;
		ELSE
			CALL movb(@(10,'EMPTY     '), @sys_map(iPSB_slot).id, BOARDIDLEN+1);
	END;
	/* 
	 *  Now get slot number and id of local host.  To access local intercon-
	 *  nect, the special slot number, LOCALHOST, must be used
	 */

	r_type = find_record(LOCALHOST,PSBCONTROLREC,@psb_reg_off);
	IF r_type <> RECNOTFOUND THEN DO;
		local_slot = rq$get$interconnect(LOCALHOST, psb_reg_off + PSBSLOTIDOFF , @status);
		CALL error$check(160, status);
		local_slot = shr(local_slot,3);	
		sys_map(local_slot).slot_num = local_slot;
		count = 0;
		DO WHILE (count < BOARDIDLEN);
			id_char = rq$get$interconnect(LOCALHOST, BOARDIDREG+count, @status);
			CALL error$check(170, status);
			IF (id_char <= '!') OR (id_char >= '}') THEN
				id_char = ' ';
			sys_map(local_slot).id(count+1) = id_char;
			count = count + 1;
		END;
	END;
	CALL print_map(@sys_map);
	CALL rq$exit$io$job(0,NIL,@status);
END icscan;