github.com/PDP-10.stacken
1
0
Fork 0
mirror of https://github.com/PDP-10/stacken.git synced 2026-03-02 09:37:06 +00:00
Code Issues Projects Releases Wiki Activity
Files
master
PDP-10.stacken/files/stacken-tape-backup/dskb:10_7/unsmon/metcon.mac
Lars Brinkhoff 6e18f5ebef Extract files from tape images. 
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

1280 lines
27 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
TITLE METCON --PERFORMANCE METERING-- V040
SUBTTL RLK/DD 9 DEC 86
SEARCH F,S
$RELOC
$LOW ;PUT DATA IN THE LOW SEGMENT
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION
; 1973,1974,1975,1976,1977,1978,1979,1980,1982,1984,1986,1988.
;ALL RIGHTS RESERVED.
.CPYRT<1973,1988>
XP VMETCO,040
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,LITES
TLNN T1,-1 ;IF P&S = 0, USE 36 BITS
HRLI T1,004400
; POINTER MUST ADDRESS 'LITES' OR USER SEGMENT
HRRZ T2,T1
CAIN T2,LITES
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
Reference in New Issue View Git Blame Copy Permalink