Google
 

Trailing-Edge - PDP-10 Archives - QT020_T20_4.1_6.1_SWSKIT_851021 - swskit-tools/environment.bli
There are 3 other files named environment.bli in the archive. Click here to see a list.
! Notice DTEs also in channel map
! Do RH20 map and notice NI20, CI20
! Rework MF20 code to handle MG20 having 64K chips in same box
! Give it a version number, even if entry vectors seem to be
!  more than BLISS can do
! Separate out and add code to really do something on 2020s
! Add recognition of MCA25 for a "2065" processor
! Note exotic microcode versions
!-----------------------------------------------------------------
!
! ENVIROMENT -- report the TOPS-20 processor and memory enviroment
!
! Original program by Scott Hemphill with edits by Greg Zima
!
!-----------------------------------------------------------------
!
MODULE ENVIRO (MAIN = MAINLOOP, ENVIRONMENT(TOPS20), VERSION = '2(5)') =
BEGIN
LIBRARY 'BLI:MONSYM';
MACRO
! Enable WHEEL so that things work
    SET_PRIVS =
	BEGIN
	BUILTIN JSYS;
	REGISTER T1=1, T2=2, T3=3;
	T1 = $FHSLF;
	JSYS (0, RPCAP, T1, T2, T3);
	T3 = .T3 OR SC_WHL OR SC_OPR;
	JSYS (0, EPCAP, T1, T2, T3);
	END
    %,

! Enable user-io so i/o instructions work
    SET_USER_IO =
	BEGIN
	BUILTIN JSYS;
	JSYS (1, USRIO);
	END
    %,

! Return the APR identification word
    GET_APR_ID =
	BEGIN
	BUILTIN MACHOP;
	MACHOP (%O'700', 0, APR_ID);
	END
    %,

! Return the processor serial number from the monitor (who knows the mask)
    GET_APR_SERIAL_NO =
	BEGIN
	BUILTIN JSYS;
	REGISTER T1=1;
	T1 = $APRID;
	JSYS (1, GETAB, T1);
	APR_SERIAL_NO = .T1;
	END
    %,

! Define SBUS DIAG functions
    GET_PAG_STAT =
	BEGIN
	BUILTIN MACHOP;
	MACHOP (%O'701', 5, PAG_STAT);
	END
    %,

! Return word with interleave bits
    FUNCT0 (CONT) =
	BEGIN
	BUILTIN MACHOP;
	OWN T1: BLOCK[2];
	T1[0, 31, 5, 0] = (CONT);
	T1[0, 0, 31, 0] = 0;
	MACHOP (%O'700', %O'12', T1);
	.T1[1, 0, 36, 0]
	END
    %,

! Return word with controller type, upper/lower for MA/MB, RQ0-3
    FUNCT1 (CONT) =
	BEGIN
	BUILTIN MACHOP;
	OWN T1: BLOCK[2];
	T1[0, 31, 5, 0] = (CONT);
	T1[0, 0, 31, 0] = 1;
	MACHOP (%O'700', %O'12', T1);
	.T1[1, 0, 36, 0]
	END
    %,

! Return word with RAM size bits to distinguish MF20/MG20
    FUNCT2 (CONT) =
	BEGIN
	BUILTIN MACHOP;
	OWN T1: BLOCK[2];
	T1[0, 31, 5, 0] = (CONT);
	T1[0, 21, 10, 0] = 3;
	T1[0, 0, 21, 0] = 2;
	MACHOP (%O'700', %O'12', T1);
	.T1[1, 0, 36, 0]
	END
    %,


! Return word with deselect bit
    FUNC12 (CONT,ADDR) =
	BEGIN
	BUILTIN MACHOP;
	OWN T1: BLOCK[2];
	T1[0, 31, 5, 0] = (CONT);
	T1[0, 8, 23, 0] = (ADDR) / %O'40000';
	T1[0, 0, 8, 0] = %O'12';
	MACHOP (%O'700', %O'12', T1);
	.T1[1, 0, 36, 0]
	END
    %,

! Do a CONI for RHn and return the result
    CONI_RH (RH) =
	BEGIN
	BUILTIN MACHOP;
	BUILTIN LSH;
	REGISTER T1=1, T2=2;
	T1=%O'754240000002' + LSH (RH, 26);
	MACHOP(%O'256', 0, T1);
	.T2
	END
   %,

! Do a CONI for DTEn and return the result
    CONI_DTE (DTE) =
	BEGIN
	BUILTIN MACHOP;
	BUILTIN LSH;
	REGISTER T1=1, T2=2;
	T1=%O'720240000002' + LSH (DTE, 26);
	MACHOP(%O'256', 0, T1);
	.T2
	END
   %,

! KS cache setting (in the 8080 communcations region)
    GET_KS_CACHE =
	BEGIN
	BUILTIN JSYS;
	REGISTER T1=1, T2=2, T3=3;
	T1 = %O'1000031';
	T2 = 1;
	JSYS ( 1, PEEK, T1, T2, T3);
	KS_COMM = .T1;
	END
    %,

! KS memory size function
    GET_KS_MEM_SIZE =
	BEGIN
	BUILTIN JSYS;
	REGISTER T1=1, T2=2, T3=3;
	T1 = $SNPSY;
	T2 = %RAD50_10'NHIPG';		! How much memory monitor sees
	T3 = %RAD50_10'PAGEM';		! In STG for v6, but that's for KLs
	JSYS (1, SNOOP, T1, T2, T3);
	T1 = .T2 + %O'1000000';
	T2 = 1;
	JSYS (1, PEEK, T1, T2, T3);
	KS_MEM_SIZE = .T1;
	END
    %,

! Output an ASCIZ string using PSOUT
    TMSG (TEXT) =
	BEGIN
	BUILTIN JSYS;
	REGISTER T1=1;
	T1= CH$PTR(UPLIT(%ASCIZ %STRING(%REMOVE(TEXT))));
	JSYS (0, PSOUT, T1);
	END
    %,

! Output a number in the given radix... to terminal
    NUMBER_OUTPUT (VALUE, RADIX, COLUMNS, FLAGS) =
	BEGIN
	BUILTIN JSYS;
	REGISTER T1=1, T2=2, T3=3;
	T1 = $PRIOU;
	T2 = (VALUE);
	T3 = ((RADIX)
	    %IF NOT %NULL(COLUMNS) %THEN
		OR ((COLUMNS) * %O'1000000') %FI
	    %IF NOT %NULL(FLAGS) %THEN
		OR (FLAGS) %FI);
	JSYS (1, NOUT, T1, T2, T3);
	END
    %,

    CRLF = %CHAR (%O'15', %O'12') %,

! Memory controller status bits

    INTERLEAVE = STATUS0<28, 2, 0> %,
	OFF_LINE = 0 %,
	ONE_WAY = 1 %,
	TWO_WAY = 2 %,
	FOUR_WAY = 3 %,

    CONTROLLER = STATUS1<24, 4, 0> %,	! Memory controller type
	CUSTOMER = 0 %,
	MA20 = 1 %,			! Core memory
	DMA20 = 2 %,			! DMA controller for external memory
	MB20 = 3 %,			! Core memory
	MF20 = 5 %,			! MOS memory (MF20 and MG20 share code)
	MG20 = 16 %,			! Made-up value for MG20 memory
	MS10 = 17 %,			! Made-up value for KS-10 memory

    LOWER_BOUND = STATUS1<14, 4, 0> %,	! MA20/MB20 fields
    UPPER_BOUND = STATUS1<10, 4, 0> %,

    C_16K = %O'40000' %,		! MF20 chip size
    C_64K = %O'200000' %,		! MG20 chip size

    REQUESTS = STATUS1<0, 4, 0> %,
	RQ0 = %O'10' %,
	RQ1 = 4 %,
	RQ2 = 2 %,
	RQ3 = 1 %,

    DESELECT = %O'10000000' %,		! For MF20 SBDIAG function 12

    SIZEBITS = %O'300000000' %,		! Chip size field from controller PROM

    UCODE_VER = APR_ID<18, 9, 0> %,	! Microcode version number
    EXOTIC = APR_ID<33, 1, 0> %,	! Exotic microcode running
    FIFTY_HZ = APR_ID<17, 1, 0> %,	! Power line clock rate
    CACHE = APR_ID<16, 1, 0> %,		! Processor has cache installed
    KS_CACHE = KS_COMM<25, 1, 0> %,	! Cache enabled for KS
    EXTENDED = APR_ID<14, 1, 0> %,	! Processor has extended features (PV)
    MCA25 = APR_ID<12, 1, 0> %,		! Processor has MCA25 cache and pager
    OMCA25 = APR_ID<30, 1, 0> %,	! Processor has MCA25 ("old" ucode)

    CACHE_LOOK = PAG_STAT<17, 1, 0> %,	! Cache look enabled
    CACHE_LOAD = PAG_STAT<16, 1, 0> %,	! Cache load enabled

    PI_FIELD = %O'7' %,			! PI select field in CONI
    KLPORT = %O'400000000000' %,	! KL (NI or CI) port exists (in CONI)
    NIPORT = (.RHMAP[5] AND KLPORT) %,	! NI20 port exists
    CIPORT = (.RHMAP[7] AND KLPORT) %;	! CI20 port exists

ROUTINE MAINLOOP: NOVALUE  = 
    BEGIN
    OWN
	APR_ID,
	PAG_STAT,
	PIECES,
	STATUS0,
	STATUS1,
	MF20_FLAG,
	APR_TYPE,
	APR_SERIAL_NO,
	KS_MEM_SIZE,
	KS_COMM,
	RHMAP: VECTOR[8],
	DTEMAP: VECTOR[4],
	CONTNO: VECTOR[256],
	ADDRESS: VECTOR[256],
	SIZE: VECTOR[256],
	RQS: VECTOR[256],
	CONTYPE: VECTOR[256],
	INT: VECTOR[256],
	NO_RQS: VECTOR[16] INITIAL(0,1,1,2,1,2,2,3,1,2,2,3,2,3,3,4);
    SET_PRIVS;
    SET_USER_IO;
    GET_APR_ID;
    GET_APR_SERIAL_NO;
    GET_PAG_STAT;
    APR_TYPE = 2050;
    IF .EXTENDED THEN APR_TYPE = 2060;	! All model B's are 2060's now
    IF NOT .CACHE THEN APR_TYPE = 2040;
    IF .MCA25 THEN APR_TYPE = 2065;
    IF .OMCA25 THEN APR_TYPE = 2065;
    IF .APR_SERIAL_NO GEQ 4096 THEN APR_TYPE = 2020;
    PIECES = 0;
    IF .APR_TYPE NEQ 2020 THEN
	BEGIN
	INCR C FROM 0 TO 7 DO
	    BEGIN
	    RHMAP[.C] = CONI_RH(.C);
	    END;
	INCR C FROM 0 TO 3 DO
	    BEGIN
	    DTEMAP[.C] = CONI_DTE(.C);
	    END;
	INCR C FROM 0 TO %O'37' DO
	    BEGIN
	    STATUS0 = FUNCT0(.C);
	    STATUS1 = FUNCT1(.C);
	    IF .STATUS1 NEQ 0 THEN
		IF .INTERLEAVE EQL OFF_LINE THEN
		    BEGIN
		    CONTNO[.PIECES] = .C;
		    ADDRESS[.PIECES] = 0;
		    SIZE[.PIECES] = 0;
		    RQS[.PIECES] = RQ0 OR RQ1 OR RQ2 OR RQ3;
		    CONTYPE[.PIECES] = .CONTROLLER;
		    INT[.PIECES] = OFF_LINE;
		    PIECES = .PIECES + 1;
		    END
		ELSE
		    IF .CONTROLLER NEQ MF20 THEN
			BEGIN
			CONTNO[.PIECES] = .C;
			ADDRESS[.PIECES] = .LOWER_BOUND * C_16K;
			SIZE[.PIECES] = (.UPPER_BOUND + 1 - .LOWER_BOUND) * C_16K;
			SIZE[.PIECES] = (.SIZE[.PIECES] * .NO_RQS[.REQUESTS])/4;
			RQS[.PIECES] = .REQUESTS;
			CONTYPE[.PIECES] = .CONTROLLER;
			INT[.PIECES] = .INTERLEAVE;
			PIECES = .PIECES + 1;
			END
		    ELSE		! MF20-type controller
			BEGIN
			LOCAL
			    CHIPSZ,
			    HIGH,
			    LOW;
			IF (FUNCT2(.C) AND SIZEBITS) EQL 0 THEN
			    BEGIN
			    CHIPSZ = C_64K;
			    CONTYPE[.PIECES] = MG20;
			    END
			ELSE
			    BEGIN
			    CHIPSZ = C_16K;
			    CONTYPE[.PIECES] = MF20;
			    END;
			HIGH = -.CHIPSZ;
			LOW = 0;
			INCR ADDR FROM 0 TO %O'17740000' BY .CHIPSZ DO
			    BEGIN
			    IF (FUNC12(.C, .ADDR) AND DESELECT) EQL 0 THEN
				HIGH = .ADDR
			    ELSE
				BEGIN
				IF .LOW LSS .HIGH THEN
				    BEGIN
				    CONTNO[.PIECES] = .C;
				    ADDRESS[.PIECES] = .LOW;
				    SIZE[.PIECES] = .HIGH + .CHIPSZ - .LOW;
				    RQS[.PIECES] = RQ0 OR RQ1 OR RQ2 OR RQ3;
				    INT[.PIECES] = FOUR_WAY;
				    PIECES = .PIECES + 1;
				    END;
				LOW = .ADDR + .CHIPSZ;
				END;
			    END;
			IF .LOW LSS .HIGH THEN
			    BEGIN
			    CONTNO[.PIECES] = .C;
			    ADDRESS[.PIECES] = .LOW;
			    SIZE[.PIECES] = .HIGH + .CHIPSZ - .LOW;
			    RQS[.PIECES] = RQ0 OR RQ1 OR RQ2 OR RQ3;
			    INT[.PIECES] = FOUR_WAY;
			    PIECES = .PIECES +1;
			    END;
			MF20_FLAG = 1;
			END;
	    END;
	END
    ELSE
	BEGIN
	GET_KS_CACHE;
	GET_KS_MEM_SIZE;
	CONTNO[.PIECES] = 0;
	ADDRESS[.PIECES] = 0;
	SIZE[.PIECES] = (.KS_MEM_SIZE + 1 ) * 512;
	RQS[.PIECES] = RQ0 OR RQ1 OR RQ2 OR RQ3;
	CONTYPE[.PIECES] = MS10;
	INT[.PIECES] = ONE_WAY;
	PIECES = .PIECES + 1;
	END;

!
! Type out the accumulated information
!
    TMSG ((CRLF, 'TOPS-20 Environment:', CRLF, CRLF));
    TMSG (('Processor serial number '));
    NUMBER_OUTPUT(.APR_SERIAL_NO, 10);
    TMSG (CRLF);
    NUMBER_OUTPUT(.APR_TYPE, 10);
    IF .APR_TYPE EQL 2020 THEN TMSG ('  KS-10 Model A  ')
	ELSE IF .EXTENDED THEN TMSG ('  KL-10 Model B  ')
	ELSE TMSG ('  KL-10 Model A  ');
    IF .FIFTY_HZ THEN TMSG (('50 Hz', CRLF)) ELSE TMSG (('60 Hz', CRLF));
    IF .EXOTIC THEN TMSG ('Exotic ');	! Note any non-standard microcode
    TMSG ('Microcode version ');
    NUMBER_OUTPUT(.UCODE_VER, 8);
    TMSG ((' running',CRLF));
    IF .APR_TYPE NEQ 2020 THEN
	BEGIN
	IF .CACHE THEN
	    BEGIN
	    IF .CACHE_LOOK THEN
		IF .CACHE_LOAD THEN TMSG ('All caches are')
		ELSE TMSG ('Cache look is')
	    ELSE TMSG ('No caches are');
	    TMSG ((' enabled', CRLF));
	    END;
	END
    ELSE
	BEGIN
	IF .KS_CACHE THEN TMSG ('All ') ELSE TMSG ('No ');
	TMSG (('caches are enabled', CRLF));
	END;
    IF .APR_TYPE NEQ 2020 THEN
	BEGIN
	TMSG ('Channels: ');
	INCR I FROM 0 TO 3 DO
	    IF (.RHMAP[.I] AND PI_FIELD) NEQ 0 THEN
		BEGIN
		    TMSG ('RH20-');
		    NUMBER_OUTPUT (.I, 8);
		    TMSG (' ');
		END;
	IF (NIPORT OR CIPORT) NEQ 0 THEN
	    BEGIN
	    IF NIPORT NEQ 0 THEN TMSG ('NI20 ');
	    IF CIPORT NEQ 0 THEN TMSG ('CI20 ');
	    END
	ELSE
	    INCR I FROM 4 TO 7 DO
		IF (.RHMAP[.I] AND PI_FIELD) NEQ 0 THEN
		    BEGIN
			TMSG ('RH20-');
			NUMBER_OUTPUT (.I, 8);
			TMSG (' ');
		    END;
	TMSG ((CRLF,'          '));
	INCR I FROM 0 TO 3 DO
	    IF (.DTEMAP[.I] AND PI_FIELD) NEQ 0 THEN
		BEGIN
		    TMSG ('DTE20-');
		    NUMBER_OUTPUT (.I, 8);
		    TMSG (' ');
		END;
	TMSG (CRLF);
	END;
    TMSG (('Logical memory configuration:', CRLF));
    TMSG (('                  Controller', CRLF));
    TMSG (('Address   Size  RQ0 RQ1 RQ2 RQ3  Contype Int', CRLF));
    INCR I FROM 0 to .PIECES - 2 DO
	BEGIN
	LOCAL
	    BEST,
	    TEMP0,
	    TEMP1,
	    TEMP2,
	    TEMP3,
	    TEMP4,
	    TEMP5;
	BEST = .I;
	INCR J FROM .I + 1 TO .PIECES - 1 DO
	    IF .ADDRESS[.BEST] GTR .ADDRESS[.J] THEN BEST = .J;
	IF .I NEQ .BEST THEN
	    BEGIN
	    TEMP0 = .CONTNO[.BEST];
	    TEMP1 = .ADDRESS[.BEST];
	    TEMP2 = .SIZE[.BEST];
	    TEMP3 = .RQS[.BEST];
	    TEMP4 = .CONTYPE[.BEST];
	    TEMP5 = .INT[.BEST];
	    DECR J FROM .BEST TO .I + 1 DO
		BEGIN
		CONTNO[.J] = .CONTNO[.J - 1];
		ADDRESS[.J] = .ADDRESS[.J - 1];
		SIZE[.J] = .SIZE[.J - 1];
		RQS[.J] = .RQS[.J - 1];
		CONTYPE[.J] = .CONTYPE[.J - 1];
		INT[.J] = .INT[.J - 1];
		END;
	    CONTNO[.I] = .TEMP0;
	    ADDRESS[.i] = .TEMP1;
	    SIZE[.i] = .TEMP2;
	    RQS[.i] = .TEMP3;
	    CONTYPE[.i] = .TEMP4;
	    INT[.i] = .TEMP5;
	    END;
	END;
    INCR I FROM 0 TO .PIECES - 2 DO
	BEGIN
	LOCAL
	    TEMP0,
	    TEMP1,
	    TEMP2,
	    TEMP3,
	    TEMP4,
	    TEMP5;
	IF .ADDRESS[.I] NEQ 0 THEN EXITLOOP;
	IF .INT[.I] NEQ OFF_LINE THEN
	    BEGIN
	    INCR J FROM .I+1 TO .PIECES - 1 DO
		BEGIN
		IF .ADDRESS[.J] NEQ 0 THEN EXITLOOP;
		IF .INT[.I] EQL OFF_LINE THEN
		    BEGIN
		    TEMP0 = .CONTNO[.J];
		    TEMP1 = .ADDRESS[.J];
		    TEMP2 = .SIZE[.J];
		    TEMP3 = .RQS[.J];
		    TEMP4 = .CONTYPE[.J];
		    TEMP5 = .INT[.J];
		    DECR K FROM .J TO .I + 1 DO
			BEGIN
			CONTNO[.K] = .CONTNO[.K - 1];
			ADDRESS[.K] = .ADDRESS[.K - 1];
			SIZE[.K] = .ADDRESS[.K - 1];
			RQS[.K] = .RQS[.K - 1];
			CONTYPE[.K] = .CONTYPE[.K - 1];
			INT[.K] = .INT[.K - 1];
			END;
		    CONTNO[.I] = .TEMP0;
		    ADDRESS[.I] = .TEMP1;
		    SIZE[.I] = .TEMP2;
		    RQS[.I] = .TEMP3;
		    CONTYPE[.I] = .TEMP4;
		    INT[.I] = .TEMP5;
		    END;
		END;
	    END;
	END;
    INCR I FROM 0 TO .PIECES - 1 DO
	BEGIN
	IF .INT[.I] EQL OFF_LINE THEN
	    TMSG ('Off-line        ')
	ELSE
	    BEGIN
	    NUMBER_OUTPUT (.ADDRESS[.I], 8, 8, (NO_LFL OR NO_ZRO));

!THIS IS A CROCK TO MAKE BLISS WORK
	    SIZE[.I] = .SIZE[.I] / 1024;
	    NUMBER_OUTPUT (.SIZE[.I], 10, 5, NO_LFL);

	    TMSG ('K  ');
	    END;
	IF (.RQS[.I] AND RQ0) EQL 0 THEN
	    TMSG ('--  ')
	ELSE
	    BEGIN
	    NUMBER_OUTPUT (.CONTNO[.I], 8, 2, (NO_LFL OR NO_ZRO));
	    TMSG ('  ');
	    END;
	IF (.RQS[.I] AND RQ1) EQL 0 THEN
	    TMSG ('--  ')
	ELSE
	    BEGIN
	    NUMBER_OUTPUT (.CONTNO[.I], 8, 2, (NO_LFL OR NO_ZRO));
	    TMSG ('  ');
	    END;
	IF (.RQS[.I] AND RQ2) EQL 0 THEN
	    TMSG ('--  ')
	ELSE
	    BEGIN
	    NUMBER_OUTPUT (.CONTNO[.I], 8, 2, (NO_LFL OR NO_ZRO));
	    TMSG ('  ');
	    END;
	IF (.RQS[.I] AND RQ3) EQL 0 THEN
	    TMSG ('--  ')
	ELSE
	    BEGIN
	    NUMBER_OUTPUT (.CONTNO[.I], 8, 2, (NO_LFL OR NO_ZRO));
	    TMSG ('  ');
	    END;
	SELECTONE .CONTYPE[.I] OF
	    SET
	    [CUSTOMER]: TMSG (' CUSTOMER ');
	    [MA20]: TMSG ('  MA20    ');
	    [DMA20]: TMSG ('  DMA20   ');
	    [MB20]: TMSG ('  MB20    ');
	    [MF20]: TMSG ('  MF20    ');
	    [MG20]: TMSG ('  MG20    ');
	    [MS10]: TMSG ('  MS10    ');
	    [OTHERWISE]: TMSG (' unknown  ');
	    TES;
	SELECTONE .INT[.I] OF
	    SET
	    [OFF_LINE]: TMSG (CRLF);
	    [ONE_WAY]: TMSG (('1', CRLF));
	    [TWO_WAY]: TMSG (('2', CRLF));
	    [FOUR_WAY]: TMSG (('4', CRLF));
	    TES;
	END;
    END;
END
ELUDOM