Google
 

Trailing-Edge - PDP-10 Archives - FORTRAN-10_Alpha_31-jul-86 - forrtf.mac
There are 7 other files named forrtf.mac in the archive. Click here to see a list.
	SEARCH	MTHPRM,FORPRM
	TV	FORRTF	REAL TIME FORTRAN SUBROUTINES,10(4134)

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1969, 1986
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.


COMMENT \

***** Begin Revision History *****

1507	BAH	4-Jun-81
	Fix up real time routines to work with version 6 memory management.

3255	BCM	13-Jan-83
	Make FORRTF not lock programs in EVM.

***** Begin Version 10 *****

4065	JLC	6-Dec-83
	Search MTHPRM.

4106	JLC	2-Mar-84
	Create a title which is the same as a global, so the TRACE
	symbol searcher can see it.

4134	JLC	3-Jul-84
	Add some IF10s and IF20s, just to be consistent.

***** End V10 Development *****

***** End Revision History *****
\

IF20,<	END>
IF10,<	PRGEND>

	TITLE	RTINIT
	SEARCH	MTHPRM,FORPRM
	FSRCH


	;THE CONTROL BLOCK SET UP IN LOCK AND RTINIT FOR EACH DEVICE ACTUALLY 
	;LOOKS LIKE THIS: A 40 (OCTAL) WORD BLOCK:
	;PITRP:		PI,,MOVE17
	;USRTRP:	APRTRP
	;CONSOT:	CONSO DEV,@MASKADR - OR - BLKI/O DEV,BLKADT FOR FAST MODE
	;BLIOWD:	0 -OR- BLKI/O DEV,BLKADT FOR NORMAL BLOCK MODE
	;DATAOT:	DATAO DEV,@1(16)
	;DATAIT:	DATAI DEV,@1(16)
	;CONOT:		CONO DEV,(TAC)
	;CONIT:		CONI DEV,@1(16)
	;FLAGT:		FLAGS TO SAY WHETHER DEVICE HAS BEEN INITIALIZED OR CONNECTED
	;BLKADT:	IOWD FOR THE BLOCK TO BE READ OR WRITTEN. - THE
	;		NEGATIVE # OF WORDS,,ABSOLUTE BLOCK ADDRESS
	;MOVE17:	MOVE 17,RTSTK
	;PUSHIN:	PUSHJ 17,TRPADR
	;DISMIN:	UJEN
	;RTSTK:		-22,,RTSTK    STACK POINTER
	;REMAINDER OF WORDS USED FOR STACK.

	;DEFINE ROUTINE NAMES

	ENTRY	RTINIT,LOCK,RTSLP,RTWAKE,UNLOCK,GETCOR
	INTERNAL CONECT,RTREAD,RTWRIT,BLKRW,STATI
	INTERNAL RTSTRT,DISCON,DISMIS
	EXTERNAL ALCOR.,DECOR.,FUNCT.,.JBCNI,.JBREL

	;ESTABLISH CORRESPONDENCE WITH DOTTED SYMBOLS

	GETCOR=GTCOR.
	RTINIT=RTNIT.
	LOCK=LOCK.
	RTSLP=RTSLP.
	RTWAKE=RTWKE.
	UNLOCK=UNLCK.
	CONECT=CONCT.
	RTREAD=RTRED.
	RTWRIT=RTWRT.
	BLKRW=BLRW.
	STATO=:STAO.
	STATI=STAI.
	RTSTRT=RTSTR.
	DISCON=DISCN.
	DISMIS=DISMS.
	JOBPRT=140

	OPDEF UJEN[1B2]
	OPDEF UNLOK.[CALLI 120]

	U=1		;UNIT NUMBER
	TAC=2		;TEMPORARY AC
	TAC1=3		;TEMPORARY AC
	AC0=0		;SCRATCH

	RTTRP=57
	LOCKU=60
	SLEEP=31
	EXIT==12
	RTCFLG==1
	RTIFLG==2
	PION=200
	PIOFF=400

	RTDEVN==2	;NUMBER OF REAL TIME DEVICES WHICH CAN BE
			;HANDLED SIMULTANEOUSLY BY THESE ROUTINES

	SHORT==0	;IF SHORT=-1 THE SHORT FORM OF ERROR MESSAGES
			;ARE USED, THIS SAVES RUN TIME CORE

	DEFINE CHUNIT(A)
<	MOVE TAC1,[SIXBIT/A/]	;KEEP TRACK OF CURRENT ROUTINE CALL
	SKIPLE U,@(16)		;CHECK THE VALIDITY OF THE UNIT NUMBER
	CAILE U,RTDEVN
	JRST NOUNIT
	MOVE U,RTBLK(U)		;CONVERT UNIT NUMBER TO CTRL BLK BASE ADDRESS>

	;DEFINE OFFSETS INTO REAL TIME UNIT CONTROL BLOCK

	PITRP=0
	USRTRP=1
	CONSOT=2
	BLIOWD=3
	DATAOT=4
	DATAIT=5
	CONOT=6
	CONIT=7
	FLAGT=10
	BLKADT=11
	MOVE17=12
	PUSHIN=13
	DISMIN=14
	RTSTK=15

	DEFINE	MES (A,B)	<
IFE SHORT,<	TTCALL 3,[ASCIZ/A/]>
IFN SHORT,<	TTCALL 3,[ASCIZ/?B
/]>>



	;INITIALIZATION ROUTINE FOR REAL TIME ROUTINES .
	;CALLED FROM FORTRAN WITH THE FOLLOWING SEQUENCE
	;CALL RTINIT(U,DEV,PI,TRPADR,MASK)
	;WHERE:
	;	U	UNIT NUMBER FOR THIS REALTIME DEVICE.
	;		1 AND 2 ARE PERMITTED. THESE ARE NOT
	;		ASSOCIATED IN ANY WAY WITH THE LOGICAL
	;		UNIT NUMBERS USED IN THE FORTRAN PROGRAM
	;	DEV	DEVICE CODE FOR REAL TIME DEVICE
	;	PI	PRIORITY LEVEL AT WHICH THE REALTIME DEVICE IS
	;		TO RUN
	;	TRPADR	ADDRESS OF AN ENTRY POINT OF A FORTRAN ROUTINE
	;		TO WHICH CONTROL WILL BE PASSED UPON REAL TIME
	;		INTERRUPT.
	;	MASK	INTERRUPT MASK. SHOULD BE ZERO FOR UNSTARTED
	;		DEVICE, AND -1 FOR A DEVICE IN FAST BLOCK MODE.

	HELLO (RTNIT,.)

	MOVE TAC1,[SIXBIT/RTINIT/]
	SKIPLE U,@(16)		;A SLIGHTLY MODIFIED CHUNIT
	CAILE U,RTDEVN
	JRST NOUNIT
	MOVEM U,UNITSV(U)	;SAVE UNIT NUMBER
	PUSHJ 17,DISCN.		;DISCONNECT THE UNIT. THIS IS A
				;CHEAT CALL. THE ARGUMENT BLOCK FOR
				;THE CALL TO RTNIT. WILL BE RECYCLED
				;SINCE THE UNIT (PARAMETER TO DISCN.)  
				;IS THE FIRST ARG TO RTNIT.
	MOVE AC0,@1(16)		;GET THE DEVICE CODE
	LSH	AC0,-2		;MAKE IT A 7-BIT BYTE
	DPB AC0,[POINT 7,CONSOT(U),9]	;CONSO INSTRUCTION
	DPB AC0,[POINT 7,DATAOT(U),9]	;DATAO
	DPB AC0,[POINT 7,DATAIT(U),9]	;DATAI
	DPB AC0,[POINT 7,CONOT(U),9]	;CONO
	DPB AC0,[POINT 7,CONIT(U),9]	;CONI TABLE
	HRL 	AC0,@2(16)	;GET PI VALUE
	HLLM	AC0,PITRP(U)	;STORE IN CONTROL BLOCK
	HRR TAC,4(16)		;GET THE MASK ADDRESS
	SKIPGE (TAC)		;FAST BLOCK MODE?
	MOVEI TAC,-1		;YES. SET ADR TO -1 AS A FLAG
	HRRM	TAC,CONSOT(U)	;STORE IN CONSO INST
	HRRI AC0,@3(16)		;TRAPADDRESS
	HRRM AC0,PUSHIN(U)	;PUT IN CTRL BLOCK
	MOVSI AC0,RTIFLG	;MARK THAT AN INIT HAS BEEN DONE
	MOVEM AC0,FLAGT(U)	;STORE FLAGS
	MOVEI MOVE17(U)		;REESTABLISH TRAP ADDRESS
				;THIS IS NECESSARY BECAUSE DISCONNECT
				;WILL HAVE PROPERLY ZEROED THE UNIT.
				;LOCK SET IT UP FOR ALL REAL TIME 
				;DEVICES. 
	HRRM PITRP(U)		;PUT IN REAL TIME BLOCK
	GOODBY (5)
	;ROUTINE TO CONNECT A REAL TIME DEVICE.
	;CALLED FROM FORTRAN WITH THE FOLLOWING SEQUENCE:
	;CALL CONECT(U,MODE)
	;WHERE:
	;	U	REALTIME DEVICE NUMBER
	;	MODE	-2	WRITE A BLOCK, FAST MODE; THEN INTERRUPT
	;		-1	WRITE A BLOCK, NORMAL MODE; THEN INTERRUPT
	;		 0	INTERRUPT EVERY WORD
	;		 1	READ A BLOCK, NORMAL MODE; THEN INTERRUPT
	;		 2	READ A BLOCK, FAST MODE; THEN INTERRUPT


	HELLO (CONCT,.)

	CHUNIT(CONECT)
	MOVE AC0,FLAGT(U)	;GET THE FLAG REGISTER
	TLNN AC0,RTIFLG		;HAS THIS UNIT BEEN INITIALIZED?
	JRST INITER		;NO, GO TELL USER
	SKIPN TAC,@1(16)	;SINGLES MODE?
	JRST CON1		;YES
	MOVSI TAC,(BLKI)	;GET INSTRUCTION ROOT
	SKIPG @1(16)		;INPUT OR OUTPUT?
	TLO TAC,100		;WRITING - SET UP BLKO
	HRRI TAC,BLKADT(U)	;SET UP ADDRESS OF POINTER WORD
	LDB TAC1,[POINT 7,CONSOT(U),9]
	DPB TAC1,[POINT 7,TAC,9]	;SET UP DEV CODE
	MOVE TAC1,[IOWD 1,DUMMY]	;GET DUMMY POINTER WORD
	MOVEM TAC1,BLKADT(U)	;STORE IN BLKI/O POINTER LOCATION
	MOVM TAC1,@1(16)	;FAST MODE?
	SOJE TAC1,CON1		;NO
	MOVEM TAC,CONSOT(U)	;YES. SET UP BLOCK FOR THIS CASE
	SETZ TAC
CON1:	MOVEM TAC,BLIOWD(U)	;STORE BLKI/O WORD
				;SINCE THIS ROUTINE CAN BE CALLED
				;AT INTERRUPT LEVEL THIS IS NECESSARY
				; FOR F40
	MOVEM 15,SAVE15		;SAVE DO LOOP AC
	MOVEM 16,SAVE16		;SAVE RETURN ADDRESS
	MOVEM 17,SAVE17		;RTTRP DESTROYS ALL AC'S AT INTERRUPT LEVEL
	MOVE	AC0,U		;PUT ADDRESS INTO AC0
	SETOM WORD		;CODE FOR ERROR ROUTINE
	CALLI AC0,RTTRP		;CONNECT DEVICE TO PI LEVEL
	  JRST RTTERR		;FAILED, GO TYPE OUT ERROR MESSAGE
	MOVE 17,SAVE17		;RESTORE PDP
	MOVE 16,SAVE16		;RESTORE RETURN ADDRESS
	MOVE 15,SAVE15		;RESTORE DO LOOP AC
	MOVSI AC0,RTCFLG	;SET APPROPRIATE FLAG
	IORM AC0,FLAGT(U)	;IN FLAG TABLE
	GOODBY (2)

	;ROUTINE TO START A REAL TIME DEVICE
	;CALLED FROM FORTRAN WITH THE FOLLOWING SEQUENCE:
	;CALL RTSTRT(UNIT, CONOMASK, CONSOMASK)
	;WHERE:
	;	UNIT	REAL TIME UNIT NUMBER
	;	CONOMASK	FLAGS TO START DEVICE
	;	CONSOMASK	INTERRUPTING BITS.
	;
	;THE REAL TIME DEVICE MAY BE STOPPED USING THIS ROUTINE
	;WITH CONOMASK AND CONSOMASK BOTH 0
	;IF THE DEVICE IS IN FAST BLOCK MODE, THE VALUE
	;OF CONSOMASK IS DISREGARDED AND NEVER REFERENCED.
	;AND THE MASK ADDRESS HAS BEEN SET TO -1 AS A FLAG

	HELLO	(RTSTR,.)

	CHUNIT(RTSTRT)
	MOVE AC0,FLAGT(U)	;GET FLAGS
	TLNN AC0,RTCFLG		;RT DEVICE CONNECTED YET?
	JRST CONERR		;NO, ERROR
	MOVE TAC,@1(16)		;GET CONO BIT MASK
	HLRZ TAC1,CONOT(U)	;CHECK FOR PI OR APR
	CAIGE TAC1,(CONO 10,0)	;DONT DO CONO 0 TO EITHER PI OR APR
	JUMPE TAC,RTST1
	HRRZ TAC1,CONSOT(U)	;GET CONSO MASK ADDRESS
	CONO PI,PIOFF
	MOVE AC0,@2(16)		;GET CONSO MASK
	SKIPL TAC1		;DON'T STORE IF FAST BLOCK MODE
	MOVEM AC0,(TAC1)	;STORE CONSO MASK
	XCT CONOT(U)		;TURN DEVICE ON OR OFF
	CONO PI,PION
RTST1:
	GOODBY	(3)
	;ROUTINE TO DISCONNECT A REAL TIME DEVICE
	;CALLED FROM FORTRAN WITH THE FOLLOWING SEQUENCE:
	;CALL DISCON(UNIT)
	;WHERE:
	;	UNIT	REAL TIME UNIT NUMBER

	HELLO	(DISCN,.)
	CHUNIT(DISCON)
	MOVE AC0,FLAGT(U)	;GET FLAGS
	TLZN AC0,RTCFLG		;DEVICE CONNECTED
	GOODBY  (1)		;NO. RETURN, NO DISCONNECT NECESSARY
	MOVSI AC0,RTCFLG	;GET FLAG
	SETZM (U)		;PREPARE TO DELETE RT DEVICE
	MOVEM 15,SAVE15		;SAVE NECESSARY AC'S
	MOVEM 16,SAVE16		;RTTRP KILLS ALL ACS
	MOVEM 17,SAVE17
	MOVE	TAC,U		;GET ADDRESS OF BLK
	SETZM WORD		;CODE FOR ERROR ROUTINE
	ANDCAM AC0,FLAGT(U)	;CLEAR CONNECT FLAG
	CALLI TAC,RTTRP		;REMOVE DEVICE
	  JRST RTTERR		;ERROR
	MOVE 17,SAVE17		;RESTORE PDP AC
	MOVE 16,SAVE16		;RESTORE RETURN ADDRESS AC
	MOVE 15,SAVE15		;RESTORE DO LOOP AC
	GOODBY	(1)
	;REAL TIME READ ROUTINE.
	;CALLED FROM FORTRAN WITH THE FOLLOWING SEQUENCE
	;CALL RTREAD(UNIT, ADR)
	;WHERE:
	;	UNIT	REAL TIME UNIT
	;	ADR	ADDRESS TO WHICH DATA TRANSFER SHOULD OCCUR

	HELLO	(RTRED,.)

	CHUNIT(RTREAD)
	XCT DATAIT(U)		;DATAI DEV,@1(16)
	GOODBY	(2)
	;ROUTINE TO PERFORM REAL TIME WRITE
	;CALLED WITH FORTRAN SEQUENCE:
	;CALL RTWRIT(UNIT,ADR)
	;WHERE:
	;	UNIT	REAL TIME UNIT NUMBER
	;	ADR	LOCATION FROM WHICH TO TRANSFER DATA


	HELLO	(RTWRT,.)
	CHUNIT(RTWRIT)
	XCT DATAOT(U)		;DATAO DEV,@1(16)
	GOODBY	(2)
	;ROUTINE TO SEND TO STATUS REGISTER OF REAL TIME DEVICE
	;CALLED FROM FORTRAN WITH THE FOLLOWING SEQUENCE
	;CALL STATO(UNIT, ADR)
	;WHERE
	;	UNIT	REAL TIME UNIT NUMBER
	;	ADR	ADDRESS FROM WHICH TO GET STATUS BITS



	HELLO(STAO,.)
	CHUNIT(STATO)
	MOVE TAC,@1(16)		;GET STATUS BITS TO SEND OUT
	XCT CONOT(U)		;CONO DEV,(TAC)
	GOODBY	(2)

	;ROUTINE TO RETRIEVE STATUS OF THE REAL TIME DEVICE
	;CALLED FROM FORTRAN WITH THE FOLLOWING SEQUENCE
	;CALL STATI(UNIT,ADR)
	;WHERE:
	;	UNIT	REAL TIME UNIT NUMBER
	;	ADR	ADDRESS INTO WHICH TO STORE STATUS BITS
	;

	HELLO	(STAI,.)
	CHUNIT(STATI)
	XCT CONIT(U)		;CONI DEV,@1(16)
	GOODBY	(2)
	;ROUTINE TO CAUSE PROGRAM TO SLEEP UNTIL INTERRUPTED
	;CALLED FROM FORTRAN WITH THE FOLLOWING SEQUENCE
	;CALL RTSLP(TIME)
	;WHERE
	;	TIME 	NUMBER OF SECONDS TO SLEEP
	;		60 IS THE MAX. RETURNS TO SLEEP
	; 		UNTIL RTWAKE HAS BEEN CALLED FROM INTERRRUPT LEVEL


	HELLO	(RTSLP,.)
RTSLP1:	SKIPE DONFLG		;AWAKENED AT INTERRUPT LEVEL?
	JRST WAKE1		;YES, GO RETURN TO CALLING ROUTINE
	MOVE AC0,@(16)		;GET SLEEP TIME
	SETZ	U,		;INFINITE SLEEP
	HIBER	U,		;IF WE CAN HIBERNATE
	  CALLI AC0,SLEEP	;GO TO SLEEP
	JRST RTSLP1		;WAKE UP AND TRY AGAIN
WAKE1:	SETZM DONFLG		;CLEAR FLAG
	SKIPN TAC,ERRFLG	;WERE THERE ANY ERRORS?
	GOODBY	(1)
	JRST (TAC)		;YES, GO TO ERROR ROUTINE
	;ROUTINE CALLED AT INTERRUPT LEVEL TO WAKE UP BACKGROUND
	;PORTION OF FORTRAN JOB
	;CALLED FROM FORTRAN WITH THE FOLLOWING SEQUENCE
	;CALL RTWAKE

	HELLO	(RTWKE,.)
	MOVEM 15,SAVE15		;SAVE NECESSARY AC'S
	MOVEM 16,SAVE16		;RTTRP KILLS ALL ACS
	MOVEM 17,SAVE17
	SETOB DONFLG		;SET WAKE UP FLAG
	WAKE			;WAKE THIS JOB
	  JFCL			;IGNORE ERROR RETURN, IF WAKE NOT IMPLEMENTED
	MOVE 17,SAVE17		;RESTORE PDP AC
	MOVE 16,SAVE16		;RESTORE RETURN ADDRESS AC
	MOVE 15,SAVE15		;RESTORE DO LOOP AC
	GOODBY	(0)
	;ROUTINE TO CONTROL BLOCK READ/WRITING
	;CALLED FROM FORTRAN WITH THE FOLLOWING SEQUENCE
	;CALL BLKRW(UNIT,WORDS,ADR)
	;WHERE:
	;	UNIT	REAL TIME UNIT NUMBER
	;	WORDS	NUMBER OF WORDS TO TRANSFER
	;	ADR	ADDRESS OF TRANSFER




	HELLO	(BLRW,.)

	CHUNIT(BLKRW)
	MOVE AC0,FLAGT(U)	;CHECK FLAGS FOR CONECT
	TLNN AC0,RTCFLG		;THE DEVICE MUST BE CONNECTED
	JRST CONERR		;IT ISN'T, THIS IS AN ERROR
	MOVEI	AC0,@2(16)	;GET STARTING ADDRESS
	CAILE AC0,JOBPRT	;IS IT TOO LOW
	CAMLE AC0,.JBREL	;OR TOO HIGH
	JRST BNDERR		;YES,
	ADD AC0,@1(16)		;CALCULATE END OF BLOCK
	CAMLE AC0,.JBREL	;IS THIS TOO HIGH?
	JRST BNDERR		;YES, ERROR
	MOVN AC0,@1(16)		;GET NEGATIVE NUMBER OF WORDS
	MOVSS AC0		;PUT IT IN LEFT HALF OF AC
	MOVEI TAC1,@2(16)	;GET START ADDRESS OF BLOCK
	ADD TAC1,RELOCA		;MAKE IT ABSOLUTE
	HRR AC0,TAC1		;PUT IT INTO AC0 WITH THE COUNT
	MOVEM AC0,BLKADT(U)	;STORE IT IN THE POINTER TABLE
	GOODBY	(3)

	;ROUTINE TO LOCK JOB IN CORE
	;CALLED FROM FORTRAN PROGRAM WITH THE FOLLOWING SEQUENCE
	;CALL LOCK

	HELLO	(LOCK,.)
	MOVEI TAC,RTDEVN	;LOOP FOR AS MANY DEVICES AS POSSIBLE
LOCK1:
	SETZM STATUS
	SETZM FNAADR
	MOVEI 16,FNACOR
	PUSHJ 17,FUNCT.		;ALLOCATE ONE CTRL BLOCK
	SKIPE STATUS		;DID WE GET THE CORE?
	JRST NOCORE		;NO GO, PROGRAM TOO FAT
	MOVE AC0,FNAADR		;GET ADDRESS OF CTRL BLOCK
	MOVEM AC0,RTBLK(TAC)	;STORE BLOCK ADR IN STATIC DATA AREA
	MOVEM AC0,U		;SET U TO BASE ADR OF BLOCK
	MOVE DATO		;SET UP THE INSTRUCTIONS IN EACH BLOCK
	MOVEM DATAOT(U)		;DATAO
	MOVE DATI
	MOVEM DATAIT(U)		;DATAI
	MOVE CON
	MOVEM CONOT(U)		;CONO
	MOVE CIN
	MOVEM CONIT(U)		;CONI
	MOVE CONS
	MOVEM CONSOT(U)		;CONSO
	HLLZ MOV17
	HRRI RTSTK(U)		;STACK POINTER ADDRESS
	MOVEM MOVE17(U)		;SET UP STACK INSTRUCTION
	HLLZ PSH
	MOVEM PUSHIN(U)		;PUSHJ INSTRUCTION
	MOVSI (UJEN)
	MOVEM DISMIN(U)		;UJEN
	MOVEI RTSTK(U)
	HRLI AC0,-22
	MOVEM RTSTK(U)		;SET UP STACK POINTER
	MOVEI MOVE17(U)		;GET ADR OF MOVE INST
	HRRM PITRP(U)		;PUT IN BLOCK
	MOVEI APRTRP		;TRAP ADR
	MOVEM USRTRP(U)		;PUT IN BLOCK
	SETZM FLAGT(U)		;PRECAUTION FOR APRTRP
	SOJN TAC,LOCK1		;LOOP FOR EVERY DEVICE
	MOVE AC0,[LK.HNE!LK.HLS!LK.LNE!LK.LLS] ;[3255] LOCK ALL NON EVM
	CALLI AC0,LOCKU		;TRY TO LOCK THE JOB IN CORE
	JRST LOKERR		;NO SUCH LUCK
	HRRZS AC0		;ZERO HIGH SEGMENT START ADDRESS
	LSH AC0,^D9		;MAKE ADDRESS CORRECT
	SUBI AC0,1		;OFFSET RELOCATION FOR LATER USE
	HRRZM AC0,RELOCA	;STORE FOR BLKRW CALLS
	GOODBY	(0)
	;ROUTINE TO UNLOCK JOB FROM CORE
	;CALLED FROM FORTRAN WITH THE FOLLOWING SEQUENCE
	;CALL UNLOCK


	HELLO	(UNLCK,.)

	MOVE	AC0,[1,,1]	;NOT NEEDED, BUT SET FOR FUTURE
	UNLOK.	AC0,		;TRY TO UNLOCK JOB
	  JFCL			;NOT IN THIS MONITOR
	MOVE TAC,[IOWD RTDEVN,2]	;SET UP LOOP THROUGH ALL DEVICES
UNLCK1:
	MOVE U,RTBLK(TAC)	;PICK UP ADDRESS OF CONTROL BLOCK
	HRRZM U,FNAADR
	SETZM	STATUS
	MOVEI 16,FNRCOR		;SET UP FOR CALL TO GIVE BACK CORE
	PUSHJ 17,FUNCT.		;GIVE IT BACK
	SETZM RTBLK(TAC)	;ZERO WORD IN VECTOR
	AOBJN TAC,UNLCK1	;GO ROUND AGAIN FOR ALL BLOCKS
	GOODBY	(0)

	;ROUTINE TO DISMISS THE INTERRUPT
	;CALLED FROM FORTRAN WITH THE FOLLOWING SEQUENCE
	;CALL DISMIS

	HELLO	(DISMS,.)
	UJEN			;DISMISS THIS INTERRUPT
	



	;ROUTINE TO ALLOCATE CORE TO APPEASE FOROTS
	;CALLED FROM FORTRAN WITH THE FOLLOWING SEQUENCE
	;CALL GETCOR(WDS)
	;WHERE:
	;	WDS	NUMBER OF WORDS TO BE ALLOCATED
	;THIS IS A KLUDGE, IMPLEMENTED TO GET AROUND THE FACT THAT
	;FOROTS MUST HAVE CORE AROUND TO OPERATE, AND THE JOB MUST BE
	;LOCKED IN CORE. THE APPROPRIATE NUMBER OF WORDS OF STORAGE IS THE
	;FIRST NUMBER LARGE ENOUGH TO RUN YOUR JOB. KLUDGY, ISN'T IT?


	HELLO(GTCOR,.)

	MOVEI TAC,@(16)		;GET ADDRESS OF WDS
	MOVEM TAC,ALLCOR	;SET UP ARGBLK FOR ALCOR.
	MOVEI 16,ALLCOR		;SET UP ALCOR. CALL
	SETO TAC		;FLAG FOR NOCORE ROUTINE
	PUSHJ 17,ALCOR.		;CALL
	JUMPLE AC0,NOCORE	;NO GO. PROGRAM TOO FAT
	HRRZM AC0,ARNCOR	;SET UP ARGBLK FOR DECOR.
	SETZ TAC		;CLEAR FLAG
	MOVEI 16,ARDCOR		;SET UP CALL
	PUSHJ 17,DECOR.		;CALL
	GOODBY(1)		;DONE. GO HOME
	;GENERAL ERROR HANDLING AND UTILITIES FOR THE REAL TIME PACKAGE
NOUNIT:	MOVEI TAC,NOUNIT	;GET ERROR ADDRESS
	MOVEM TAC,ERRFLG	;STORE IT IN CASE WE ARE AT INTERRUPT LEVEL
	MES (<?ILLEGAL UNIT NUMBER.
TO HANDLE MORE DEVICES, REASSEMBLE FORRTF WITH A LARGER "RTDEVN".
>,1)
	MOVEI AC0,6		;SET UP LOOP
NONIT1:
	ILDB TAC,PTR1		;GET SIXBIT CHARACTER
	ADDI TAC,40		;CONVERT TO ASCII CODE
	IDPB TAC,PTR		;DEPOSIT THE ASCII IN WORD
	SOJN AC0,NONIT1		;HANDLED 6 CHARACTERS YET?
	MES (<?ERROR COMES FROM THE SUBROUTINE >,A)
	TTCALL 3,WORD
	SETZM ERRFLG		;CLEAR ERROR FLAG
	CALLI EXIT

INITER:	MOVEI TAC,INITER	;GET ERROR ADDRESS
	MOVEM TAC,ERRFLG	;STORE IT FOR USER LEVEL USE
	MES (<?RTINIT MUST BE CALLED BEFORE CONECT
>,2)
	SETZM ERRFLG		;CLEAR ERROR FLAG
	CALLI EXIT

RTTERR:	MOVE 17,SAVE17		;RESTORE 17
	MOVEI TAC,RTTER1	;GET USER LEVEL ERROR ADDRESS
	MOVEM TAC,ERRFLG	;STORE ERROR ADDRESS
	HRLM AC0,ERRFLG		;STORE ERROR BITS
RTTER1:	HLRZ TAC,ERRFLG		;PICK UP ERROR BITS
	MES (<?RTTRP ERROR
>,7)
	SKIPN WORD		;ERROR FROM CONECT OR DISCON?
	MES (<?OCCURRED IN THE DISCON ROUTINE
>,0)
	SKIPE WORD	
	MES (<?OCCURRED IN THE CONECT ROUTINE
>,1)
	TRNE TAC,3		;PI CHL NOT AVAILABLE
	MES (<?ILLEGAL PI NUMBER
>,A)
	TRNE TAC,4		;TRAP ADDRESS OUT OF BOUNDS
	MES (<?TRAP ADDRESS OUT OF BOUNDS
>,B)
	TRNE TAC,100		;NO MORE RT DEVICES LEFT
	MES (<?SYSTEM LIMIT FOR REAL TIME DEVICES EXCEEDED
>,C)
	TRNE TAC,200		;JOB NOT LOCKED IN CORE
	MES (<?JOB NOT LOCKED IN CORE OR NOT PRIVILEGED
>,D)
	TRNE TAC,1000		;ILLEGAL DEVICE
	MES(<?DEVICE ALREADY IN USE BY ANOTHER JOB
>,E)
	SETZM ERRFLG		;CLEAR ERROR FLAG
	CALLI EXIT

CONERR:	MOVEI TAC,CONERR	;GET ERROR ADDRESS
	MOVEM TAC,ERRFLG	;SAVE FOR USER LEVEL USE
	MES (<?CONECT MUST BE CALLED BEFORE RTSTRT OR BLKRW
>,3)
	SETZM ERRFLG		;CLEAR ERROR FLAG
	CALLI EXIT

BNDERR:	MOVEI TAC,BNDERR	;GET ERROR ADDRESS
	MOVEM ERRFLG		;SAVE IT IN CASE WE ARE NOT AT USER LEVEL
	MES (<?REAL TIME BLOCK OUT OF BOUNDS
>,4)
	CAMLE AC0,.JBREL	;IS THE PROBLEM: TOO HIGH?
	MES (<?END OF BLOCK TOO HIGH
>,A)
	CAMG AC0,.JBREL		;OR: TOO LOW?
	MES (<?BEGINNING OF BLOCK TOO LOW
>,B)
	SETZM ERRFLG		;CLEAR ERROR FLAG
	CALLI EXIT

LOKERR:	MES (<?JOB CANNOT BE LOCKED IN CORE
>,5)
	CAIN AC0,1
	MES (<?JOB NOT PRIVILEGED.
>,A)
	CAIE AC0,2
	CAIN AC0,3
	MES(<?NOT ENOUGH CORE AVAILABLE FOR LOCKING.
>,B)
	SETZM ERRFLG		;CLEAR ERROR FLAG
	CALLI EXIT

APRTRP:	Z			;APR ERROR AT INTERRUPT LEVEL
	MOVEI TAC,APRERR	;GET ERROR ADDRESS
	MOVEM TAC,ERRFLG	;STORE FOR USER LEVEL USE
	MOVE TAC,[IOWD RTDEVN,2]	;SET UP LOOP
APRTP1:
	PUSH 17,TAC
	MOVE U,RTBLK(TAC)	;GET ADDRESS OF CONTROL BLOCK OF THIS UNIT
	MOVE AC0,FLAGT(U)	;MAKE SURE DEVICE IS CONNECTED
	TLNN AC0,RTCFLG
	JRST APRTP2		;IT ISN'T CONNECTED. GET NEXT ONE
	MOVE TAC1,UNITSV(TAC)
	JUMPE TAC1,APRTP2	;UNIT NUMBER UNUSED
	MOVEM TAC1,ARGBLK	;DO A CONO 0 AND DISCON FOR EACH DEVICE
	MOVEI 16,ARGBLK
	PUSHJ 17,RTSTR.
	PUSHJ 17,DISCN.
APRTP2:
	POP 17,TAC
	AOBJN TAC,APRTP1	;LOOP
	UJEN

APRERR:	MES (<?APR ERROR AT INTERRUPT LEVEL
>,6)
	MOVE TAC,.JBCNI		;PICK UP ERROR BITS
	TRNE TAC,200000		;PDL?
	MES (<?PDL OVERFLOW
>,A)
	TRNE TAC,30000		;ILL MEM REF OR NON EX MEM
	MES (<?ILLEGAL MEMORY REFERENCE
>,B)
	SETZM ERRFLG		;CLEAR ERROR FLAG
	CALLI EXIT
NOCORE:	MES (<?NOT ENOUGH CORE AVAILABLE >,8)
	SKIPLE TAC		;ERROR FROM GETCOR OR LOCK?
	MES (<FOR THE CONTROL BLOCKS
>,A)				;LOCK
	SKIPG TAC
	MES (<FOR THE GETCOR ROUTINE
>,B)				;GETCOR
	SETZM ERRFLG
	CALLI EXIT
WORD:	Z			;NEEDED FOR NOUNIT AND RTTERR ERRORS
	BYTE (7)0,15,12,0,0	;CR AND LF

DATI:	DATAI @1(16)		;DATAI INSTRUCTION 
CON:	CONO (TAC)		;CONO INSTRUCTION FOR CTRL BLOCK
CIN:	CONI @1(16)		;CONI INSTRUCTION FOR CTRL BLOCK
CONS:	CONSO @0		;CONSO INSTRUCTION FOR CTRL BLOCK
DATO:	DATAO @1(16)		;DATAO INSTRUCTION
MOV17:	MOVE 17,		;MOVE INSTRUCTION
PSH:	PUSHJ 17,		;PUSHJ INSTRUCTION

PTR:	POINT 7,WORD		;NEEDED FOR NOUNIT CALLS
PTR1:	POINT 6,TAC1
	
ERRFLG:	Z			;ERROR ROUTINE TO BE EXECUTED WHEN ERROR
				;OCCURS AT INTERRUPT LEVEL
RELOCA:	Z			;SAVE ACTUAL LOCATION AFTER LOCKING
DUMMY:	Z			;DUMMY I/O WORD
DONFLG:	Z			;SLEEP COMMUNICATIONS FLAG

RTBLK=.-1			;RTBLK CONTAINS THE ADDRESSES OF THE CONTROL
	BLOCK RTDEVN		;BLOCKS ALLOCATED BY ALCOR. FOR EACH DEVICE

	XWD	-5,0		;ARGBLK FOR FUNCT. TO GET CORE -- FUNCTION 2
FNACOR:	TP%INT,F.COR
	TP%LIT,[ASCIZ/COR/]
	TP%INT,STATUS
	TP%INT,FNAADR
	TP%INT,FNAAMT		;AMOUNT OF CORE TO GET
				;END OF ARGBLK FOR FUNCT. FUNCTION 2

	XWD	-5,0		;ARGBLK FOR FUNCT. TO RETURN CORE -- FUNCTION 3
FNRCOR:	TP%INT,F.RAD
	TP%LIT,[ASCIZ/RAD/]
	TP%INT,STATUS
	TP%INT,FNAADR
	TP%INT,FNAAMT		;AMOUNT OF CORE TO RETURN
				;END OF ARGBLK FOR FUNCT. FUNCTION 3
F.COR:	2			;FUNCTION 2 ARG TO FUNCT.
F.RAD:	3			;FUNCTION 3 ARG TO FUNCT.
STATUS:	Z			;STATUS FOR FUNCT. CALL
FNAADR:	Z			;ADDRESS OF CORE BLOCK FOR FUNCT.
FNAAMT:	XWD 0,40		;AMOUNT OF CORE FOR FUNCT.

	XWD -1,0		;ARGBLK FOR ALCOR. ROUTINE IN FOROTS
ARCOR:	XWD 0,[40]		;ALLOCATES DECIMAL 32 WORDS OF STORAGE

ARNCOR: Z			;ADDRESS OF CORE ALLOCATED
	XWD -1,0		;ARGBLK FOR DECOR. ROUTINE OF FOROTS
ARDCOR:	ARNCOR			;DEALLOCATES A 32-WORD BLOCK

	XWD -1,0		;ARGBLK FOR ALCOR. CALL IN GETCOR
ALLCOR:	Z

UNITSV=.-1
	REPEAT RTDEVN,<Z>	;SAVE UNIT NUMBERS IN CASE OF APR ERROR

ARGBLK:	Z			;NEEDED FOR INTRA-FORRTF CALLS
	Z
	Z
SAVE15:	Z
SAVE16:	Z
SAVE17:	Z
LIT
	END