Trailing-Edge
-
PDP-10 Archives
-
bb-x130a-sb
-
metcon.mac
There are 7 other files named metcon.mac in the archive. Click here to see a list.
TITLE METCON --PERFORMANCE METERING-- V036
SUBTTL RLK/DD 25 oct 82
SEARCH F,S
$RELOC
$LOW ;PUT DATA IN THE LOW SEGMENT
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
.CPYRT<
COPYRIGHT (C) 1973,1974,1975,1976,1977,1978,1979,1980,1982,1984 BY DIGITAL EQUIPMENT CORP., MAYNARD, MASS.
>
;DATE LOAD EDIT
;---- ---- ----
;12-JAN-82 70126 035
;25-oct-83 70170
;11023
;
;
;
;
XP VMETCO,036
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) ;=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
INTERN 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) ;=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
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
TDNN T2,MCDSTS(P3)
JRST RELSE7
LDB T2,MCYTYP ;USER SEG. INVOLVED--
PUSHJ P,@CHNACK(T2) ; CALL CHANNEL ADDRESS CHECKER
JRST [LDB J,MCYJOB ;THERE IS METER CHANNEL INFO IN THIS SEG.
PUSHJ P,RELCHN ;RELEASE THE CHANNEL
JRST RELSE6 ;PLAY IT AGAIN SAM
]
JRST RELSE7 ;NOTHING HERE, CHECK NEXT SEG.
;--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
HRLZI T1,JP.MET ;IF THIS MONITOR HAS PRIVILEGE CODE
PUSHJ P,PRVBIT## ;THEN BIT IS SUFFICIENT
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)
; 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,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
MOVEI P4,PN0XCT ;ASSUME NO MPDB
JUMPE P2,MEFPS4
MOVEI P4,PNTXCT ;THERE IS A MPDB SO USE DIFFERENT XCT LIST
HRRZ P3,MPDMCD(P2) ;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 #
; 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: PUSHJ P,LOKEVC## ;JOB MUST BE IN EVM, NOT MERELY LOCKED
SKIPA ;ERROR - NOT IN EVM
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.
;
; 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
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 ;PUT R IN FOR INDEX
MOVEI T2,@T1 ;PUT ABSOLUTE ADDRESS IN T2
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
;
; 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
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