Google
 

Trailing-Edge - PDP-10 Archives - dec-10-omona-u-mc9 - metcon.mac
There are 7 other files named metcon.mac in the archive. Click here to see a list.
TITLE	METCON --PERFORMANCE METERING--  V027
SUBTTL	RLK  25 MAY 76
	SEARCH	F,S
	$RELOC
	$LOW			;PUT DATA IN THE LOW SEGMENT
;***COPYRIGHT 1973,1974,1975,1976,1977 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.***
XP VMETCO,027

	ENTRY	METCON
METCON:
;--SOME HANDY MACROS FROM C.MAC

DEFINE	POINTR(LOC,MASK),<POINT	WID(MASK),LOC,POS(MASK)>


;MACRO TO GENERATE MOVEI, MOVSI, OR MOVE [] AS APPROPRIATE

DEFINE	MOVX	(AC,FLAG),<
	.XCREF
IFE	<777777B17&<FLAG>>,<
	.CREF
	MOVEI	AC,FLAG
	.XCREF
>
IFN	FLAG,<
IFE	<777777&<FLAG>>,<
	.CREF
	MOVSI	AC,(FLAG)
	.XCREF
>
IFN	<777777&<FLAG>>,<
IFN	<777777B17&<FLAG>>,<
	.CREF
	MOVE	AC,[FLAG]
>>>
	.CREF>
;MACRO TO GENERATE MACROS OF THE FORM TXYY.  THESE MACRO REPLACE
; A TLYY OR A TRYY DEPENDING UPON THIER ARGUMENT. SEE EXAMPLES:
;
;		CALL				RESULT
;	TXNE	F,1B20			TRNE	F,1B20
;	TXON	F,1B0			TLON	F,(1B0)
;	TXZ	F,1B1!1B31		TDZ	F,[1B1!1B31]

DEFINE	TX0	(M,S),<
	IRP	M,<
	IRP	S,<
DEFINE	TX'M'S	(AC,FLAG),<
	OP%%	AC,FLAG,TL'M'S,TR'M'S,TD'M'S
>>>>

	TX0	<N,Z,O,C>,<,E,N,A>


DEFINE	OP%%	(AC,FLAG,L,R,D)<
	.XCREF

IFE	FLAG	<
	JFCL			;;ZERO MASK IS A NOP
>
IFN	FLAG	<
IFE	777777&<FLAG>,<
	.CREF
	L	AC,(FLAG)
	.XCREF
>
IFE	777777B17&<FLAG>,<
	.CREF
	R	AC,FLAG
	.XCREF
>
IFN	<777777B17&<FLAG>>,<
IFN	<777777&<FLAG>>,<
	.CREF
	D	AC,[FLAG]
>>>
	.CREF>

	PURGE	TX0
;	TEMPORARY DEF. FOR CAX.., ANDX, IORX, ETC

DEFINE	CAX(T)<IRP T,<DEFINE CAX'T (A,V)<CAM'T A,[V]>>>

CAX <E,N,L,LE,G,GE>
PURGE CAX

DEFINE BOOLX(T)<IRP T,<DEFINE T'X (A,V)<T A,[V]>>>

BOOLX <AND,IOR,XOR>
PURGE BOOLX
;--MORE MACROS

;	GET NEXT USER ARGUMENT AND (OPTIONALLY) CHECK ITS RANGE OR DEFAULT IT

DEFINE	GETARG (DEF,MIN,MAX,ERR)
	<
	IFNB <DEF>,<MOVX	T1,DEF>
	SOSL	LSARGS
	  PUSHJ	P,GETWD1##
	IFNB <MIN>,<IFNB <MAX>,<
		CAXL	T1,MIN
		  CAXLE	T1,MAX
		  PJRST	ERR
		>>
	IFNB <MIN>,<IFB <MAX>,<
		CAXGE	T1,MIN
		  PJRST	ERR
		>>
	IFB <MIN>,<IFNB <MAX>,<
		CAXLE	T1,MAX
		  PJRST	ERR
		>>
	>


;	STORE A USER ARGUMENT

DEFINE	PUTARG
	<
	SOSL	LSARGS
	PUSHJ	P,PUTWD1##
	>
;--SYMBOL DEFINITIONS AND DATA STRUCTURES
;SYMBOLS ARE 'DDTUUU'
;
;	DD=	DATA STRUCTURE:
;		MT	MPTAB
;		MP	MPDB
;		MC	MCDB
;	T=	TYPE:
;		Y	BYTE POINTER
;		M	36 BIT MASK (OR BIT)
;		D	DISPLACEMENT
;		0	DEFAULT VALUE
;		1	MINIMUM VALUE
;		2	MAXIMUM VALUE
;	UUU=	USE

DEFINE	SYMBOL (PREFIX,TYPE,SUFFIX,BEGBIT,ENDBIT,INDEX)
	<
	RADIX 10
	IFNB <ENDBIT>,<
		IFG BEGBIT-ENDBIT,<PRINTX ?SYMBOL MACRO: ERROR 1 ' PREFIX?SUFFIX '>
		$POS==ENDBIT
		>
	IFB  <ENDBIT>,<$POS==BEGBIT>
	$SIZ==ENDBIT-BEGBIT+1
	$MSK==1B<^D35-$SIZ>-1
	$IDX==$INDEX
	IFNB<INDEX>,<$IDX==INDEX>
	IRP TYPE,<$FLAG==0
		IFIDN <TYPE><Y>,<$FLAG==1
			PREFIX'Y'SUFFIX: POINT <$SIZ>,$DISP($IDX),<$POS>
			>
		IFIDN <TYPE><M>,<$FLAG==1
			PREFIX'M'SUFFIX==<$MSK>B<$POS>
			>
		IFIDN <TYPE><D>,<$FLAG==1
			PREFIX'D'SUFFIX==$DISP
			>
		IFE $FLAG,<PRINTX ?SYMBOL MACRO: ERROR 2 ' TYPE '>
		>
	RADIX 8
	>


DEFINE	RANGE (PREFIX,SUFFIX,DEF,MIN,MAX)
	<
	IFNB <DEF>,<PREFIX'0'SUFFIX==DEF>
	IFNB <MIN>,<PREFIX'1'SUFFIX==MIN>
	IFNB <MAX>,<PREFIX'2'SUFFIX==MAX>
	>
;--UUO ARG LIST

;--CHANNEL FUNCTIONS (.MEFCI,.MEFCS,.MEFCR)


;--POINT FUNCTIONS (.MEFPI,.MEFPS,.MEFPR)

RANGE (MP,NUM,1,1)	

RANGE (MP,APP,8,1,8)
;--(MPTAB) METER POINT TABLE

	$INDEX==P1
	$DISP==MPTAB

SYMBOL (MT,<M>,ENB,0)		;=1 IF POINT IS ENABLED
				;  (MUST BE SIGN BIT FOR SKIPL)
SYMBOL (MT,<Y>,PID,1,5)		;USER'S POINT ID.
 RANGE (MT,PID,0)
SYMBOL (MT,<Y,M>,NAM,8,17)	;POINT'S NAME
;		18-35		;MPDB ADDRESS
;--(MPDB)  METER POINT DATA BLOCK

	$INDEX==P2
	$DISP==0

SYMBOL (MP,<D,M>,STS,0,12)	;POINT STATUS
 SYMBOL (MP,<Y,M>,USA,1)	;=1 IF USER SEGMENT ADDRESSED
 SYMBOL (MP,<M>,ENB,0)		;RESERVED FOR INDICATION MTMENB IN .MPSTS ARGUMENTS
 RANGE (MP,STS,0)
 MPMUST==MPMENB			;BITS USER ALLOWED TO SET
	INTERN MPDPRA
SYMBOL (MP,<D,Y>,PRA,13,35)	;@ ADDRESS OF POINT ROUTINE

	$DISP==1

SYMBOL (MP,<Y>,JOB,0,12)	;JOB NUM. POINT IS ASSIGNED TO
SYMBOL (MP,<Y>,PRT,13,17)	;POINT ROUTINE TYPE
 RANGE (MP,PRT,0,0,4)		;POINT ROUTINE TYPE RANGE
SYMBOL (MP,<D>,MCD,18,35)	;MCDB ADDRESS
RANGE (MP,CID,0,0,777)

	$DISP==2

	INTERNAL MPDPAR
SYMBOL (MP,<D>,PAR,0,35)	;POINT PARAMETER
 RANGE (MP,PAR,0)

	$DISP==3
SYMBOL (MP,<D>,PRP,0,35)	;POINT ROUTINE PARAMETER
 RANGE (MP,PRP,0)

	MPDBL==$DISP+1		;LENGTH OF MPDB
;--(MCDB)  METER CHANNEL DATA BLOCK

	$INDEX==P3
	$DISP==0

SYMBOL (MC,<M,D>,STS,0,12)	;STATUS
 SYMBOL (MC,<M>,USA,1)		;=1 IF USER SEGMENT ADDRESSED
 RANGE (MC,STS,0)
 MCMUST==0			;MASK OF STATUS USER MAY SET
SYMBOL (MC,<Y,D>,CHN,13,35)	;@ ADDRESS OF CHANNEL ROUTINE

	$DISP==1

SYMBOL (MC,<Y>,JOB,0,12)	;JOB NUMBER
SYMBOL (XC,<Y>,JOB,0,12,T2)	;JOB # WHEN MCDB INDEX=T2
				;13-17 UNUSED
SYMBOL (MC,<Y>,CID,18,26)	;USER CHANNEL  ID.
 RANGE (MC,CID,0,0,777)
SYMBOL (MC,<Y>,TYP,27,35)	;CHANNEL TYPE
 RANGE (MC,TYP,0,0,2)

	$DISP==2

SYMBOL (MC,<D>,MCD,18,35)	;ADDR. OF NEXT MCDB
				;  CHAIN BEGINS WITH METMCD

	$DISP==3

MCDDEP==$DISP		;1ST CHANNEL(TYPE) DEPENDENT WORD
;--NULL CHANNEL (TYPE 0)

MCDBL0==MCDDEP			;LENGTH OF TYPE 0 MCDB
MCDBL==MCDBL0			;MCDBL WILL BE LENGTH OF STANDARD (LONGEST) MCDB

;--DISPLAY CHANNEL (TYPE 1)

	$DISP==MCDDEP

SYMBOL (MC,<Y,D>,TCN,13,35)	;TIME CONSTANT (SHIFT COUNT)
 RANGE (MC,TCN,0,-^D36,0)

	$DISP==$DISP+1

SYMBOL (MC,<D>,PTR,0,35)	;DPB BYTE POINTER
 RANGE (MC,PTR,0)

	$DISP==$DISP+1

SYMBOL (MC,<D>,SUM,0,35)	;RUNNING SUM

	$DISP==$DISP+1

SYMBOL (MC,<D>,VAL,0,35)	;LAST VALUE

MCDBL1==$DISP+1			;LENGTH OF TYPE 1 MCDB
IFG MCDBL1-MCDBL,<MCDBL==MCDBL1>

;--TRACE CHANNEL (TYPE 2)

	$DISP==MCDDEP

			;0-12 UNUSED
SYMBOL (MC,<D>,FLG,13,35)	;@ ADDRESS OF FLAGS

	$DISP==$DISP+1

			;0-12 UNUSED
SYMBOL (MC,<D>,BUF,13,35)	;@ ADDRESS OF BUFFER
				;  INDEX (13-17) = T3

	$DISP==$DISP+1

			;0-12 UNUSED
SYMBOL (MC,<D>,IDX,13,35)	;@ ADDRESS OF BUFFER INDEX

	$DISP==$DISP+1

			;0-12 UNUSED
SYMBOL (MC,<D>,CNT,13,35)	;@ ADDRESS OF BUFFER COUNT

	$DISP==$DISP+1

SYMBOL (MC,<D>,MSK,0,35)	;MASK FOR TRUNCATING INDEX
 RANGE (MC,BFL,1000,1)		;BUFFER LENGTH DEFAULT=1 PAGE

MCDBL2==$DISP+1			;LENGTH OF TYPE 2 MCDB
IFG MCDBL2-MCDBL,<MCDBL==MCDBL2>
;--IMPURE STORAGE

;	MCDB CHAIN

METMCD:	0		;MCDB'S CHAINED FROM HERE THROUGH
			;  RH(MCDMCD).  LAST LINK=0

;	DUMMY MCDB (BUILD IT HERE THEN BLT IT THERE)

DUMMCD:	BLOCK	MCDBL

;	DUMMY MPDB

DUMMPD:	BLOCK	MPDBL


;	THE METER POINTS (MPTAB)

DEFINE METERP (N)<MP'N::<N>B17>

RADIX 10
MPTAB:
METERP (1)
METERP (2)
METERP (3)
METERP (4)
METERP (5)
RADIX 8

MPTABX==.-MPTAB-1	;MAX. INDEX IN MPTAB
;--TABLES INDEXED BY CHANNEL TYPE

CHNINI==.-MC1TYP	;INITILIZATION ROUTINES (FOR .MEFCI)
	CPOPJ1##	;(0)
	CH1INI		;(1)
	CH2INI		;(2)

CHNACK==.-MC1TYP	;ADDRESS CHECKING ROUTINES
	CPOPJ1##
	CH1ACK
	CH2ACK

CHNROT==.-MC1TYP	;CHANNEL ROUTINES
	CPOPJ##
	CHAN1
	CHAN2

CHNARG==.-MC1TYP	;ADDRESS OF XCT TABLE (FOR .MEFCS)
	CH0XCT
	CH1XCT
	CH2XCT

;--XCT TABLE FOR STORING CHANNEL STATUS (.MEFCS)

CHNXCT:			;COMMON FOR ALL CHANNEL TYPES
	LDB	T1,MCYTYP
	PUSHJ	P,[MOVE	T1,MCDSTS(P3)
		ANDX	T1,MCMSTS
		POPJ	P,
		]
	LDB	T1,MCYJOB
CH0XCT:	SKIPA		;THE NULL CHANNEL (TYPE 0) HAS NO STATUS

CH1XCT:			;TYPE 1 (DISPLAY) SPECIFIC ITEMS
	HRRE	T1,MCDTCN(P3)
	MOVE	T1,MCDPTR(P3)
	SKIPA

CH2XCT:			;TYPE 2 (TRACE) SPECIFIC ITEMS
	HRRZ	T1,MCDFLG(P3)
	HRRZ	T1,MCDBUF(P3)
	HRRZ	T1,MCDIDX(P3)
	HRRZ	T1,MCDCNT(P3)
	PUSHJ	P,[HRRZ	T1,MCDMSK(P3)
		AOS	T1
		POPJ	P,
		]
	SKIPA
;--TABLES INDEXED BY POINT ROUTINE TYPE

PNTROT==.-MP1PRT	;POINT ROUTINE ADDRESSES
	CPOPJ##		;(0) NULL
	PRTVAL		;(1) INTRINSIC VALUE
	PRTINT		;(2) TIME INTERVAL
	PRTVID		;(3) ID+INTRINSIC VALUE
	PRTTID		;(4) ID+TIME

PNTPRI==.-MP1PRT	;POINT ROUTINE INITILIZATION (.MEFPI)
	CPOPJ1##	;(0) NULL
	PRIVAL		;(1) INTRINSIC VALUE
	PRIINT		;(2) TIME INTERVAL
	CPOPJ1##	;(3) ID+INTRINSIC VALUE
	CPOPJ1##	;(4) ID+TIME
;--XCT TABLE FOR STORING POINT STATUS (.MEFPS)

PNTXCT:
	LDB	T1,MTYPID
	MOVE	T1,MPDPAR(P2)		;.MPPAR
	LDB	T1,MPYJOB		;.MPJOB
	PUSHJ	P,[MOVE	T1,MPDSTS(P2)	;.MPSTS
		ANDX	T1,MPMSTS
		SKIPGE	MPTAB(P1)
		  TXO	T1,MPMENB
		POPJ	P,
		]
	LDB	T1,MPYPRT		;.MPPFT
	MOVE	T1,MPDPRP(P2)		;.MPPFP
	PUSHJ	P,[SKIPE T1,P3		;.MPCID
		  LDB	T1,MCYCID
		POPJ	P,
		]
	SKIPA

PN0XCT:	SETZM	T1	;USE THIS XCT TABLE IF NO MPDB
	SETZM	T1
	SETZM	T1
	SETZM	T1
	SETZM	T1
	SETZM	T1
	SETZM	T1
	SKIPA

;--TABLES INDEXED BY UUO FUNCTION CODE

UUODAL:		;DEFAULT ARG.LIST LENGTHS
	0	;.MEFCI
	0	;.MEFCS
	0	;.MEFCR
	0	;.MEFPI
	0	;.MEFPS
	0	;.MEFPR
;--UUO ERROR CODES

DEFINE ERROR (NAM,NUM)
	<
	RADIX 10
	IFNDEF ERRMAX,<ERRMAX==NUM>
	IFG NUM-ERRMAX,<ERRMAX==NUM>
	ERR'NAM==ERR'NUM
	ME'NAM'%==NUM
	RADIX 8
	>

ERROR ILF,1	;ILLEGAL FCN.CODE	;ALL
ERROR NPV,2	;NOT PRIVILEGED		;ALL
ERROR IMA,3	;ILLEGAL MEMORY ADDRESS	;.MEFCI .MEFPI
ERROR PDL,4	;PDL OVERFLOW		;ALL
ERROR IAL,5	;ILLEGAL ARG.LST LENGTH	;ALL
ERROR IAV,6	;ILLEGAL ARG VALUE
		;	.MEFCI:	CID OUT OF RANGE
		;	.MEFPI: .MPAPP OUT OF RANGE
ERROR NFC,7	;NOT ENOUGH FREE CORE	;.MEFCI .MEFPI
ERROR ICT,8	;ILLEGAL CHAN.TYPE	;.MEFCI
ERROR IPT,9	;ILLEGAL PNT.RTN.TYPE	;.MEFPI
ERROR NXP,10	;NON-EX. POINT NAME	;.MEFPI .MEFPS .MEFPR
ERROR NXC,11	;NON-EX. CID FOR JOB	;.MEFCI .MEFCR
ERROR PNA,12	;POINT NOT AVAILABLE	;.MEFPI .MEFPR


;--LOCAL STORAGE
;
;	THIS COULD BE DYNAMICALLY ALLOCATED (EG ON THE THE
;	STACK IF IT DIDNT GET MOVED ON PDL OVF)

LSL==0		;WILL BE LENGTH OF LOCAL BLOCK

DEFINE	LOCAL (NAME,DISP)
	<
	NAME==METLOC+DISP
	IFG DISP-LSL+1,<LSL==DISP+1>
	>

;	ALL UUO FUNCTIONS

LOCAL	(LSARGS,0)	;NUMBER OF USER ARG'S LEFT (PUTARG,GETARG MACRO)

;ALL POINT FUNCTIONS

LOCAL	(LSPAPP,1)	;NUM. OF ARGS PER POINT
LOCAL	(LSPNUM,2)	;NUM. OF POINTS
LOCAL	(LSPERR,3)	;USER ADDRESS OF .MPERR (ADDR. OF LAST POINT PROCESSSED)
			;  =0 IF .MPERR NOT ADDRESSED
LOCAL	(LSPADR,4)	;USER ADDRESS OF POINT LIST


METLOC:	BLOCK	LSL
;--INITILIZATION (SYSTEM RESTART ETC.)
;
;	JSR	METINI##
;
;	ALL AC'S EXCEPT T'S PRESERVED

METINI::0

;	INIT (DISABLE) ALL METER POINTS

	MOVEI	T1,MPTABX
	MOVX	T2,MTMNAM	;MASK TO LEAVE ONLY POINT NUMBER
METIN1:	ANDM	T2,MPTAB(T1)
	SOJGE	T1,METIN1

;	CLEAR THE MCDB CHAIN
;	(NO MCDBS ARE EXPECTED, IF THERE ARE SOME THEY SOULD BE RETURNED TO FREE STORAGE)

	SETZM	METMCD

	JRST	@METINI

	$HIGH			;BACK TO HIGH SEGMENT
;--RELEASE A USER (RELEASE, UNLOCK, ETC.)
;
;	MOVE	J,JOBNUMBER	;OR HIGH SEGMENT NUMBER
;	PUSHJ	P,METREL##
;	...			;ALWAYS RETURN HERE
;
;	ALL AC'S EXCEPT T'S PRESERVED

METREL::CAIG	J,JOBMAX##
	  PJRST	RELJOB		;J=JOB # -- RELEASE JOB

;	RELEASE ALL CHANNELS ADDRESSING THE SEGMENT

RELSE0:
	PUSH	P,J
	HRRZ	P1,JBTADR##(J)	;P1=LOWEST SEG. ADDRESS
	HLRZ	P2,JBTADR##(J)
	ADD	P2,P1		;P2=HIGHEST ADDRESS

RELSE6:	MOVEI	P3,METMCD-MCDMCD	;LOOK AT ALL CHANS ON MCDB CHAIN
RELSE7:	HRRZ	T1,MCDMCD(P3)
	JUMPE	T1,[POP	P,J	;0 IS END OF CHAIN
		JRST	CPOPJ##
		]
	EXCH	T1,P3		;P3=NEXT MCDB ON CHAIN
	MOVX	T2,MCMUSA	;USA BIT=1 IF USER SEG. IS ADDRESSED
	TLNN	T2,MCDSTS(P3)
	  JRST	RELSE7

	LDB	T2,MCYTYP	;USER SEG. INVOLVED--
	PUSHJ	P,CHNACK(T2)	;  CALL CHANNEL ADDRESS CHECKER
	  PUSHJ	P,[LDB	J,MCYJOB	;THIS SEGMENT SO RELEASE IT
		PJRST	RELCHN
		]
	JRST	RELSE6	;PLAY IT AGAIN SAM
;--ROUTINE TO RELEASE ALL POINTS AND CHANNELS FOR A GIVEN JOB
;
;CALL	J=JOB NUMBER
;RET+1	ALWAYS

RELJOB:
;	SCAN MPTAB FOR ALL POINTS BELONGING TO THIS JOB

	MOVEI	P1,MPTABX
RELJO2:	HRRZ	P2,MPTAB(P1)	;P2=MPDB
	JUMPE	P2,RELJO4	;(IF ANY)
	LDB	T1,MPYJOB	;THIS JOB?
	CAIN	T1,(J)
	  PUSHJ	P,RELPNT	;YES--RELEASE IT
RELJO4:	SOJGE	P1,RELJO2

;	SCAN MCDB CHAIN FOR ALL CHANNELS BELONGING TO THIS JOB

RELJO6:	MOVEI	P3,METMCD-MCDMCD
RELJO7:	HRRZ	T1,MCDMCD(P3)
	JUMPE	T1,CPOPJ##	;0 IS END OF CHAIN--RETURN
	EXCH	T1,P3		;P3=NEXT MCDB
	LDB	T2,MCYJOB	;THIS JOB?
	CAIE	T2,(J)
	  JRST	RELJO7
	PUSHJ	P,RELCHN	;YES--RELEASE IT
	JRST	RELJO6
;--METER. UUO (CALLI 111)

METER::	PUSHJ	P,SAVE4##
	HRRI	M,-1(T1)	;M ADDRESSES ARG. LIST
	HLRES	T1		;SETUP LSARGS (# OF ARGS)
	SKIPG	T1
	  MOVX	T1,1		;DEFAULT =1 TO GET FUNCTION CODE
	MOVEM	T1,LSARGS

;	CHECK FOR PRIVILEGES

IFN FTPRV,<HRLZI T1,JP.MET	;IF THIS MONITOR HAS PRIVILEGE CODE
	PUSHJ	P,PRVBIT##	;THEN BIT IS SUFFICIENT
	>
IFE FTPRV,<PUSHJ  P,PRVJ##>	;ELSE MUST BE [1,2] OR JACCT
	  SKIPA
	PJRST	[MOVX	T1,MENPV%
		PJRST	STOTAC##
		]

;	DISPATCH ON FUNCTION CODE TO UUO FUNCTION ROUTINE

	GETARG	(,0,MEFMAX,MEFERR)
	MOVE	T2,UUODAL(T1)
	SKIPN	LSARGS		;IF ARG.LENGTH WAS ZERO, USE DEFAULT
	  MOVEM	T2,LSARGS
	PUSHJ	P,@MEFTAB(T1)	;CALL FUNCTION ROUTINE
	  PJRST	STOTAC##	;ERROR RET TO USER WITH ERROR CODE
	PJRST	CPOPJ1##	;GOOD RETURN TO USER

MEFTAB:	MEFCI	;(0) INIT CHANNEL
	MEFCS	;(1) RETURN CHANNEL STATUS
	MEFCR	;(2) RELEASE CHANNEL
	MEFPI	;(3) INIT POINTS
	MEFPS	;(4) RETURN POINT STATUS
	MEFPR	;(5) RELEASE POINTS

MEFMAX==.-MEFTAB-1	;MAX FUNCTION CODE


MEFERR:	MOVX	T1,MEILF%	;ILLEGAL FUNCTION CODE
	PJRST	STOTAC##
;--UUO FUNCTION ROUTINE CONVENTIONS
;
;ENTERED WITH:
;	J=JOB NUMBER
;	LSARGS=ARGUMENT COUNT (FOR GETARG,PUTARG)
;	R,M SETUP FOR GETWD1 & PUTWD1
;
;IF ERROR: JRST TO APPROPRIATE ERROR ROUTINE
;IF SUCCESSFUL: JRST CPOPJ1## (SKIP RETURN TO USER)
;--ERROR RETURNS

DEFINE ERRX (N)<ERR'N: JSP T1,ERR>

$N==0
RADIX 10
REPEAT ERRMAX+1,
	<XLIST
	ERRX (\$N)
	$N==$N+1
	LIST>
RADIX 8

ERR:	HRRZS	T1		;SET T1= ERROR CODE
	SUBI	T1,ERR0+1
	POPJ	P,
;--FUNCTION .MEFCI -- INITILIZE CHANNEL

MEFCI:
;	USE USER'S ARGS TO BUILD DUMMY MCDB

	SETZM	DUMMCD	;CLEAR DUMMY
	MOVE	T1,[DUMMCD,,DUMMCD+1]
	BLT	T1,DUMMCD+MCDBL-1
	MOVEI	P3,DUMMCD

	GETARG	(MC0CID,MC1CID,MC2CID,ERRIAL) ;GET USER CHAN. ID
	DPB	T1,MCYCID

	GETARG	(MC0TYP,MC1TYP,MC2TYP,ERRICT)	;GET CHANNEL TYPE
	DPB	T1,MCYTYP
	MOVE	T1,CHNROT(T1)	;STORE CHAN.ROUTINE ADDRESS
	DPB	T1,MCYCHN

	GETARG	(MC0STS)	;GET STATUS
	ANDX	T1,MCMUST	;  ONLY THOSE BITS USER ALLOWED TO SET
	IORM	T1,MCDSTS(P3)

	GETARG	()		;SET JOB NUMBER
	DPB	J,MCYJOB	;  (USER ARG IGNORED FOR NOW)

;	DISPATCH TO CHAN. TYPE ROUTINE TO LOOK AT REST OF USER ARGS.

	LDB	T1,MCYTYP
	PUSHJ	P,@CHNINI(T1)
	  POPJ	P,

;	LOOK FOR EXISTING MCDB, IF NONE, CREATE ONE

	LDB	T1,MCYCID
	PUSHJ	P,FNDMCD		;SET P3=MCDB ADDR.
	  JRST	MEFCI4
	PUSHJ	P,BLTMCD
	JRST	CPOPJ1##		;SUCCESSFUL RETURN TO USER

MEFCI4:	PUSHJ	P,GETMCD
	  POPJ	P,
	PUSHJ	P,BLTMCD

	MOVE	T1,METMCD		;ADD TO THE MCDB CHAIN
	HRRM	T1,MCDMCD(P3)
	MOVEM	P3,METMCD

	JRST	CPOPJ1##		;SUCCESSFUL RETURN


BLTMCD:	MOVE	T2,MCDMCD(P3)	;PRESERVE LINK ACROSS BLT
	HRLI	T1,DUMMCD
	HRR	T1,P3
	BLT	T1,MCDBL-1(P3)
	HRRM	T2,MCDMCD(P3)
	POPJ	P,
;--FUNCTION .MEFCS -- RETURN CHANNEL STATUS

MEFCS:	PUSHJ	P,FNDMC0	;FIND MCDB
	  PJRST	ERRNXC
	MOVEI	P4,CHNXCT	;MOVE COMMON ITEMS
	PUSHJ	P,MOVARG
	LDB	T1,MCYTYP	;MOVE CHAN.TYPE-SPECIFIC ITEMS
	HRRZ	P4,CHNARG(T1)
	PUSHJ	P,MOVARG
	JRST	CPOPJ1##	;SUCCESSFUL RETURN TO USER


;--FUNCTION .MEFCR -- RELEASE A CHANNEL

MEFCR:	PUSHJ	P,FNDMC0	;FING MCDB
	  PJRST	ERRNXC
	PUSHJ	P,RELCHN
	JRST	CPOPJ1##	;SUCCESSFUL RETURN TO USER
;--SUBROUTINES FOR CHANNEL FUNCTIONS

;FIND MCDB IF IT EXISTS
;
;CALL	FNDMC0:	TO GET CHAN.ID. FROM USER (M,R,LSARGS SET FOR GETARG)
;	FNDMCD:	IF T1=CHAN.ID.
;	J=JOB #
;RET+1	NO SUCH MCDB FOR THIS JOB & CHAN.ID.
;RET+2	P3=MCDB ADDRESS

FNDMC0:	GETARG	(MC0CID)		;GET CHAN.ID.

FNDMCD:	SKIPA	P3,METMCD	;SCAN MCDB CHAIN
FNDMC2:	HRRZ	P3,MCDMCD(P3)
	JUMPE	P3,CPOPJ##		;CANT FIND IT
	LDB	T2,MCYJOB	;JOB# AND CHAN.ID. MUST MATCH
	CAIE	T2,(J)
	  JRST	FNDMC2
	LDB	T2,MCYCID
	CAIE	T2,(T1)
	  JRST	FNDMC2
	JRST	CPOPJ1##		;FOUND IT


;--GET CORE FOR NEW MCDB
;
;RET+1	IF CANT GET CORE
;RET+2	P3=ADDRESS OF MCDB

GETMCD:	MOVEI	T2,MCDBL
	PUSHJ	P,GETWDS##
	  PJRST	ERRNFC		;CANT GET CORE
	HRRZ	P3,T1
	JRST	CPOPJ1##

;--GIVE BACK CORE FOR MCDB
;
;CALL	P3=MCDB ADDRESS
;RET+1	ALWAYS

GIVMCD:	MOVEI	T1,MCDBL
	MOVE	T2,P3
	PJRST	GIVWDS##
;--RELEASE A CHANNEL
;
;CALL	J=JOB NUM
;	P3=MCDB
;RET+1	ALWAYS--ALL ASSOCIATED POINTS STOPPED
;

RELCHN:	MOVEI	P1,MPTABX	;SCALL MPTAB
RELCH2:	HRRZ	P2,MPTAB(P1)	;FOR ALL POINTS ATTACHED
	JUMPE	P2,RELCH4	;TO THIS MCDB
	HRRZ	T1,MPDMCD(P2)
	CAIN	T1,(P3)
	  PUSHJ	P,STPPNT
RELCH4:	SOJGE	P1,RELCH2

;	REMOVE THIS MCDB FROM THE CHAIN

	MOVEI	T1,METMCD-MCDMCD	;FIND PREDECESSOR MCDB
RELCH6:	HRRZ	T2,MCDMCD(T1)
	EXCH	T1,T2
	SKIPN	T1
	STOPCD	CPOPJ##,DEBUG,MCM, ;++MCDB MISSING
	CAIE	T1,(P3)
	JRST	RELCH6
	HRR	T1,MCDMCD(P3)
	HRRM	T1,MCDMCD(T2)
	PJRST	GIVMCD		;GIVE BACK THE MCDB STORAGE
;--DISPLAY CHANNEL STUFF

;--INITILIZATION

CH1INI:	GETARG	(MC0TCN,MC1TCN,MC2TCN,ERRIAV) ;GET TIME CONSTANT
	HRRZS	T1		;MAKE 13-17=0 SO @ WORKS
	DPB	T1,MCYTCN

	GETARG	(MC0PTR)	;GET DPB POINTER
	TRNN	T1,-1		;IF ADDR.=0 USE DEFAULT
	  HRRI	T1,LIGHTS##
	TLNN	T1,-1		;IF P&S = 0, USE 36 BITS
	  HRLI	T1,004400

;	POINTER MUST ADDRESS 'LIGHTS' OR USER SEGMENT

	HRRZ	T2,T1
	CAIN	T2,LIGHTS##
	  JRST	CH1IN3
	PUSH	P,T1		;SAVE LH OF POINTER
	PUSHJ	P,LOKWRD
	  PJRST	ERRIMA
	POP	P,T1		;T2=ABS. ADDRESS
	HRR	T1,T2
	MOVX	T2,MCMUSA	;SET 'USER SEG. ADDRESSED' BIT
	IORM	T2,MCDSTS(P3)

CH1IN3:	MOVEM	T1,MCDPTR(P3)	;STORE COMPLETED BYTE PTR
	SETZM	MCDSUM(P2)	;AND INIT TEMPS
	SETZM	MCDVAL(P2)
	JRST	CPOPJ1##

;--ADDRESS CHECKER

CH1ACK:	MOVEI	T1,[HRRZ T2,MCDPTR(P3)
 		JRST CPOPJ1##
		]
;	JRST	CHNACX

CHNACX:	XCT	(T1)
	CAIL	T2,(P1)
	  CAILE	T2,(P2)
	  AOJA	T1,CHNACX
	POPJ	P,

;--THE CHANNEL ROUTINE

CHAN1:	SUB	T1,MCDVAL(T2)
	ADDB	T1,MCDSUM(T2)
	ASH	T1,@MCDTCN(T2)
	MOVEM	T1,MCDVAL(T2)
	DPB	T1,MCDPTR(T2)
	POPJ	P, 
;--TRACE CHANNEL STUFF

;--INITILIZATION

CH2INI:	PUSHJ	P,GETADR	;GET FLAGS ADDRESS
	  POPJ	P,
	MOVEM	T1,MCDFLG(P3)
	GETARG	()		;BUFFER ADDRESS
	MOVEM	T1,MCDBUF(P3)	;SAVE FOR LATER
	PUSHJ	P,GETADR	;BUFFER IDX. ADDRESS
	  POPJ	P,
	MOVEM	T1,MCDIDX(P3)
	PUSHJ	P,GETADR	;BUFFER COUNTER ADDRESS
	  POPJ	P,
	MOVEM	T1,MCDCNT(P3)
	GETARG	(MC0BFL,1,,ERRIAV)	;BUFFER LENGTH
	JFFO	T1,.+1		;MAKE A MASK FROM IT
	MOVNI	T2,1(T2)
	SETOM	T1
	LSH	T1,(T2)
	MOVEM	T1,MCDMSK(P3)
	MOVEI	T2,1(T1)	;CHECK WHOLE BUFFER FOR ADDRESSABILITY
	MOVE	T1,MCDBUF(P3)
	PUSHJ	P,LOKBLK
	  PJRST	ERRIMA
	HRLI	T2,T3		;IDX BY T3 FOR @ USE BY CHAN2:
	MOVEM	T2,MCDBUF(P3)
	MOVX	T2,MCMUSA	;SET 'USER SEG. ADDRESSED' BIT
	IORM	T2,MCDSTS(P3)
	JRST	CPOPJ1##

;--ADDRESS CHECKER

CH2ACK:	MOVEI	T1,[HRRZ T2,MCDFLG(P3)
		HRRZ	T2,MCDBUF(P3)
		HRRZ	T2,MCDIDX(P3)
		HRRZ	T2,MCDCNT(P3)
		JRST	CPOPJ1##
		]
	JRST	CHNACX

;--THE CHANNEL ROUTINE

CHAN2:	AOS	T3,@MCDIDX(T2)
	AND	T3,MCDMSK(T2)
	MOVEM	T1,@MCDBUF(T2)
	SKIPGE	@MCDFLG(T2)
	  SOSE	@MCDCNT(T2)
	  POPJ	P,
	LDB	T1,XCYJOB	;WAKEUP JOB
	PJRST	WAKJOB##
;--FUNCTION .MEFPI -- INIT. POINTS

MEFPI:	PUSHJ	P,FSTPNT	;SETUP FOR METER POINT LIST
	  POPJ	P,

MEFPI2:	PUSHJ	P,NXTPNT
	  POPJ	P,		;ERROR
	  JRST	CPOPJ1##	;SUCCESSFUL-RETURN TO USER

	JUMPE	P2,MEFPI3	;IF POINT HAS MPDB
	CAIE	T1,(J)		;  THEN MUST BE ASSIGNED TO JOB
	  JRST	ERRPNA
MEFPI3:	PUSHJ	P,STPPNT	;STOP THE POINT WHILE CHANGING MPDB

;	FILL OUT DUMMY MPDB WITH USER ARGUMENTS

	MOVEI	P2,DUMMPD

	GETARG	(MT0PID)	;USER'S POINT ID.
	DPB	T1,MTYPID

	GETARG	(MP0PAR)	;POINT PARAMETER
	MOVEM	T1,MPDPAR(P2)

	GETARG	()		;IGNORE JOB NUMBER ARG.
	DPB	J,MPYJOB

	GETARG	(MP0STS)	;STATUS
	ANDX	T1,MPMUST	;   ONLY ALLOW USER TO SET SOME
	IORM	T1,MPDSTS(P2)

	GETARG	(MP0PRT,MP1PRT,MP2PRT,ERRIPT) ;POINT ROUTINE TYPE
	DPB	T1,MPYPRT
	HRRZ	T1,PNTROT(T1)	;CORRES. POINT ROUTINE ADDRESS
	DPB	T1,MPYPRA

	GETARG	(MP0PRP)	;POINT ROUTINE PARAMETER
	MOVEM	T1,MPDPRP(P2)

	GETARG	(MP0CID)	;CHANNEL ID.
	PUSHJ	P,FNDMCD	;GET ITS MCDB
	  JRST	ERRNXC		;  (ERROR IF NONE--CHAN.MUST BE INITED FIRST)
	HRRM	P3,MPDMCD(P2)	;LINK MCDB TO MPDB

	LDB	T1,MPYPRT
	PUSHJ	P,@PNTPRI(T1)	;DISPATCH TO DO FCN.SPECIFIC INIT.
	  POPJ	P,
;	FIND POINTS REAL MPDB OR, IF NONE, MAKE ONE AND BLT DUMMY INTO IT

	HRRZ	P2,MPTAB(P1)
	JUMPE	P2,[PUSHJ	P,GETMPD	;GET SOME CORE FOR NEW MPDB
		  POPJ	P,
		JRST	MEFPI5
		]
MEFPI5:	HRR	T1,P2
	HRLI	T1,DUMMPD	;BLT DUMMY
	BLT	T1,MPDBL-1(P2)
	HRRM	P2,MPTAB(P1)	;STORE MPDB ADDR. IN CASE THIS IS NEW MPDB

;	ENABLE POINT IF REQUESTED

	MOVX	T1,MTMENB
	MOVX	T2,MPMENB
	TDNE	T2,MPDSTS(P2)
	  IORM	T1,MPTAB(P1)

	JRST	MEFPI2			;LOOP FOR ALL POINTS
;--FUNCTION .MEFPS -- RETURN POINT STATUS

MEFPS:	PUSHJ	P,FSTPNT
	  POPJ	P,

;	LOOP FOR ALL POINTS IN LIST

MEFPS2:	PUSHJ	P,NXTPNT
	  POPJ	P,		;ERROR
	  JRST	CPOPJ1##	;SUCCESSFUL RETURN TO USER
	MOVE	P4,PN0XCT	;ASSUME NO MPDB
	JUMPE	P2,MEFPS4
	MOVE	P4,PNTXCT	;THERE IS A MPDB SO USE DIFFERENT XCT LIST
	HRRZ	P3,MPDMCD	;P3=MCDB ADDRESS(IF ANY)
MEFPS4:	PUSHJ	P,MOVARG

	JRST	MEFPS2		;LOOP FOR ALL POINTS


;--FUNCTION .MEFPR -- RELEASE POINTS

MEFPR:	PUSHJ	P,FSTPNT
	  POPJ	P,

;	LOOP FOR ALL POINTS

MEFPR2:	PUSHJ	P,NXTPNT
	  POPJ	P,		;ERROR
	  JRST	CPOPJ1##		;SUCCESSFUL RETURN TO USER
	PUSHJ	P,RELPNT

	JRST	MEFPR2		;LOOP FOR ALL POINTS
;--SUBROUTINES FOR POINT FUNCTIONS

;--ROUTINES TO STEP THRU USERS METER POINT LIST
;
;CALL	FSTPNT: TO INITILIZE NXTPNT
;		M,R,LSARG SETUP TO GET .MPNUM ARG
;RET+1	IF ERROR
;RET+2	M,R,LSARG POIINT TO .MPERR
;
;CALL	NXTPNT: TO SETUP M,R,LSARGS FOR EACH POINT (INCLUDING FIRST)
;RET+1	IF ERROR
;RET+2	NO MORE POINTS
;RET+3	NEXT POINT SETUP:
;	P1=MPTAB INDEX
;	P2=MPDB ADDRESS (=0 IF NO MPDB)

FSTPNT:	GETARG	(MP0APP,MP1APP,MP2APP,ERRIAV)	;ARGS PER POINT
	MOVEM	T1,LSPAPP
	GETARG	(MP0NUM,MP1NUM,,ERRIAV)	;NUMBER OF POINTS
	MOVEM	T1,LSPNUM
	GETARG	(0)			;ADDRESS OF POINT LIST
	SOS	T1		;DECR. SO GETWD1## WORKS
	SUB	T1,LSPAPP	;DECR. SO  1ST NXTPNT WORKS
	MOVEM	T1,LSPADR

	SETZB	T1,LSPERR	;ASSUME NO .MPERR ARG.
	SKIPGE	LSARGS		;IS THERE?
	  MOVEM	M,LSPERR	;YES--REMEMBER ADDRESS
	PUTARG			;STORE 0 TO INDICATE NO POINTS PROCESSED YET

	JRST	CPOPJ1##

NXTPNT:	SOSGE	LSPNUM		;ANY MORE POINTS?
	  JRST	CPOPJ1##	;NO
	MOVE	T1,LSPAPP	;YES-ADDRESS NEXT POINT'S ARGS]
	MOVEM	T1,LSARGS
	ADDB	T1,LSPADR
	HRR	M,LSPERR	;IF WAS .MPERR ARG.--STORE POINT ARG. ADDRESS
	TRNE	M,-1
	  PUSHJ	P,PUTWD1##
	HRR	M,LSPADR
	PUSHJ	P,FNDMP0	;FIND POINT NAME IN MPTAB
	  POPJ	P,
	HRRZ	P2,MPTAB(P1)	;AND GET MPDB (IF ANY)
	AOS	(P)		;RETURN +3
	JRST	CPOPJ1##
;FIND MPTAB INDEX AND MPDB (IF ANY) FOR POINT NAME
;
;CALL	FNDMP0:	M,R,F SET TO GET .MPNAM WITH GETARG
;	FNDMPD:	T1=POINT NAME
;RET+1	IF ERROR
;RET+2	P1=MPTAB INDEX
;	P2=MPDB (=0 IF NO MPDB)
;	T1=JOB POINT ASSIGND TO (IF MPDB EXISTS)

FNDMP0:	GETARG	()		;POINT NAME

FNDMPD:	MOVEI	P1,MPTABX	;SEARCH MPTAB FOR IT
FNDMP2:	LDB	T2,MTYNAM
	CAMN	T2,T1
	  JRST	[HRRZ	P2,MPTAB(P1)	;FOUND IT -- GET MPDB ADDR
		JUMPE	P2,CPOPJ1##
		LDB	T1,MPYJOB	;GET JOB #
		JRST	CPOPJ1##
		]
	SOJGE	P1,FNDMP2
	JRST	ERRNXP		;NO SUCH POINT NAME


;--GET CORE FOR NEW MPDB
;
;RET+1	NO FREE CORE
;RET+2	P2=MPDB ADDRESS

GETMPD:	MOVEI	T2,MPDBL
	PUSHJ	P,GETWDS##
	  PJRST	ERRNFC
	HRRZ	P2,T1
	JRST	CPOPJ1##

;--GIVE BACK CORE FOR MPDB
;
;CALL	P2=MPDB ADDRESS
;RET+1	ALWAYS

GIVMPD:	MOVEI	T1,MPDBL
	MOVE	T2,P2
	PJRST	GIVWDS##

;--STOP A POINT (BUT DONT DEASSIGN IT FROM JOB OR CHANNEL)
;
;CALL	P1=PTAB INDEX
;RET+1	ALWAYS

STPPNT:	MOVX	T1,MTMENB
	ANDCAM	T1,MPTAB(P1)

;((((WAKE UP JOB??)))))

	POPJ	P,


;--SUBROUTINE TO RELEASE A METER POINT
;
;CALL	P1=MPTAB INDEX
;	P2=MPDB ADDRESS (=0 IF NONE)
;	J=JOB #
;RET+1	ALWAYS
;

RELPNT:	PUSHJ	P,STPPNT	;STOP (DISABLE) THE POINT
	MOVX	T1,MTMNAM	;RESET MPTAB ENTRY (LEAVE ONLY POINT NAME)
	ANDM	T1,MPTAB(P1)
	JUMPE	P2,CPOPJ##
	PJRST	GIVMPD		;RETURN MPDB (IF ANY)
;--MISC SUBROUTINES

;USE XCT LIST TO MOVE ARGS FROM DATA BASE TO USER ARG LIST
;
;CALL	P4=ADDR. OF XCT LIST
;		(LIST MUST END WITH SKIPA)
;	M,R,F	SETUP FOR PUTARGS
;RET+1	ALWAYS, M,R,F POINTING TO NEXT ARG AFTER XCT LIST
;	P4 MODIFIED

MOVARG:	XCT	(P4)
	  JRST	[PUTARG
		AOJA	P4,MOVARG
		]
	POPJ	P,


;--GET NEXT USER ARG AND CHK. IT FOR A  LOCKED, WRITABLE ADDRESS
;
;CALL	READY FOR GETARG
;RET+1	IF ADDRESS NOT OK
;RET+2	ADDRESS OK, T1=EQUIV. PHYSICAL (ABS.) ADDRESS

GETADR:	GETARG	(0)
	PUSHJ	P,LOKWRD
	  PJRST	ERRIMA
	HRRZ	T1,T2
	JRST	CPOPJ1##
;ROUTINES 'LOKWRD' THRU 'RHIBLK' SHOULD GO INTO DATMAN IF EVER USED
;  BY ANYONE OTHER THAN METER


;--SUBROUTINE TO CHECK THAT BLOCK OF CORE IS WRITABLE, IN BOUNDS, & LOCKED
;
;	J=JOB #
;	R=PROTECTION,,RELOCATION  (LOW SEG.)
;	T1=VIRTUAL ADDR. OF 1ST WORD
;	T2=LENGTH OF BLOCK OR 0   (LOKBLK ONLY)
;	PUSHJ	P,LOKBLK	;OR LOKWRD
;	---		;ALL ADDRS. NOT WRITABLE,IN BOUNDS, AND LOCKED
;	---		;ALL ADDRS. WRITABLE,IN BOUNDS, AND LOCKED
;			;T1=CONTENTS OF 1ST ADDR. ;T2=CORRES. ABS.ADDR.
;
;	ALL AC'S PRESERVED EXCEPT T'S

;	INTERN	LOKBLK,LOKWRD,MPOPJ,MPOPJ1

LOKWRD:	SETZM	T2		;CHECK ONLY ONE WORD
LOKBLK:	PUSH	P,M
	HRR	M,T1		;SETUP ARG. FOR WHIBLK
	HRL	M,T2
	PUSHJ	P,WLOBLK	;IN LOW SEG.?
	  JRST	LOKBL2		;NO--TRY HI SEG.
	SETCM	T3,JBTSTS##(J)	;YES-GET STATUS OF LOW SEG.
	JRST	LOKBL3
LOKBL2:	PUSHJ	P,WHIBLK	;IN HI SEG.?
	  JRST	MPOPJ		;NO--ERORR RETURN
	MOVE	T3,JBTSGN##(J)	;YES-GET STATUS OF HI SEG.
	SETCM	T3,JBTSTS##(T3)
LOKBL3:	TLNN	T3,NSHF!NSWP	;LOCKED?
MPOPJ1:	AOS	-1(P)		;YES
MPOPJ:	POP	P,M
	POPJ	P,
;--SUBROUTINE TO CHECK THAT BLOCK OF CORE IS
;   READABLE (RLOBLK) OR WRITABLE (WLOBLK) AND IN LOW SEG.
;
;	R=XWD PROTECTION,RELOCATION
;	T1=1ST VIRTUAL ADDRESS OF BLOCK
;	T1=LENGTH OF BLOCK OR 0
;	PUSHJ	P,WLOBLK	;OR RLOBLK
;	---		;DOESNT PASS THE TESTS
;	---		;PASSES-T1=CONTENTS OF 1ST ADDR ;T2=ITS ABS.ADDR
;
;	ALL AC'S PRESERVED EXCEPT T'S

	INTERN	WLOBLK,RLOBLK

WLOBLK:
RLOBLK:	SOJLE	T2,RLOBL2	;JUMP IF ONLY 1 WORD
	PUSH	P,T1		;SAVE 1ST ADDR
	ADD	T1,T2		;ADDR CHECK HIGHEST WORD
	PUSHJ	P,IADRCK##
	  JRST	TPOPJ##		;FAILS
	POP	P,T1		;RESTORE 1ST ADDR
RLOBL2:	PUSHJ	P,IADRCK##	;ADDR CHECK LOWEST WORD
	  POPJ	P,		;FAILS
	HRLI	T1,R		;SET T2=ABS ADDRESS
	MOVEI	T2,@T1
	MOVE	T1,@T1		;SET T1=CONTENTS
	JRST	CPOPJ1##
;--SUBROUTINE TO CHECK THAT BLOCK OF CORE IS READABLE (RHIBLK)
;  OR WRITABLE (WHIBLK) AND IN HIGH SEGMENT
;
;	R=XWD PROTECTION,RELOCATION (OF LOW SEG.)
;	J=JOB NUM.
;	M=XWD BLOCK-LENGTH,1ST-VIRT.-ADDR.  (LENGTH MAY= 0)
;	PUSHJ	P,WHIBLK	;OR RHIBLK
;	---		;FAILS THE TESTS
;	---		;T1=CONTENTS 1ST ADDR  ;T2= ITS ABS.ADDR
;
;	ALL AC'S PRESERVED EXCEPT M & T'S

	INTERN	RHIBLK,WHIBLK

WHIBLK:	PUSHJ	P,SAVE3##	;CHKHWC IS RUTHLESS
	PUSH	P,J
	MOVE	J,JBTSGN##(J)
	PUSHJ	P,CHKHWC##	;MAY USER WRITE IN HIGH SEG.?
	  JRST	JPOPJ##		;NO--FAIL
	POP	P,J
RHIBLK:	HLRZ	T3,M		;GET BLOCK LENGTH
	SOJLE	T3,RHIBL2	;JUMP IF ONLY ONE WORD
	PUSH	P,M		;ADDR CHECK HIGHEST WORD
	ADD	M,T3
	PUSHJ	P,HGHWRD##
	  JRST	MPOPJ		;FAILS
	POP	P,M		;OK--ADDR CHECK LOWEST WORD
RHIBL2:	PJRST	HGHWRD##	;  AND RETURN TO CALLER
;--POINT ROUTINES

;METER POINTS HAVE THE FORM:
;
;	MOVE	T1,POINT VALUE (IF ANY)
;	SKIPGE	T2,MP'N'##
;	PUSHJ	P,@MPDPRA##(T2)

;--TYPE 1 (INTRINSIC VALUE)

PRIVAL:			;INITILIZE (.MEFPI)
	MOVX	T1,T1	;FORCE BYTE PTR. TO ADDRESS T1
	DPB	T1,[POINT 23,MPDPRP(P2),35]
	JRST	CPOPJ1##

PRTVAL:	LDB	T1,MPDPRP(T2)
	HRRZ	T2,MPDMCD(T2)
	JRST	@MCDCHN(T2)

;--TYPE 2 (TIME INTERVAL)

PRIINT:		;INITILIZE
	PUSHJ	P,METIME##	;START 1ST INTERVAL FROM NOW
	MOVEM	T1,MPDPRP(P2)
	JRST	CPOPJ1##

PRTINT:
	PUSHJ	P,METIME##
	EXCH	T1,MPDPRP(T2)
	MOVNS	T1
	ADD	T1,MPDPRP(T2)
 	HRRZ	T2,MPDMCD(T2)
	JUMPGE	T1,@MCDCHN(T2)	;NORMAL
	ADD	T1,RTCMAX##	;ASSUME WENT THRU MIDNIGHT
	JRST	@MCDCHN(T2)

;--TYPE 4 (TIME + ID)

PRTTID:
	PUSHJ	P,METIME##
;	FALL INTO PRTVID

;--TYPE 3 (VALUE + ID)

PRTVID:	MOVE	T3,T2
	LSHC	T1,6
	ROT	T1,-6
	HRRZ	T2,MPDMCD(T3)
	JRST	@MCDCHN(T2)
METEND:	END