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