Trailing-Edge
-
PDP-10 Archives
-
BB-4172H-BM
-
language-sources/glxint.mac
There are 37 other files named glxint.mac in the archive. Click here to see a list.
TITLE GLXINT - Operating system interface for GALAXY
SUBTTL Irwin L. Goverman/ILG /PJT/MLB/DC/DPM 1-Jan-82
;
;
; COPYRIGHT (c) 1975,1976,1977,1978,1979,1980,1981,1982
; DIGITAL EQUIPMENT CORPORATION
;
; 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.
;This module provides commonly used routines that are dependent
; upon the operating system.
SEARCH GLXMAC ;GET NECESSARY SYMBOLS
PROLOG(GLXINT,INT) ;GENERATE PROLOG CODE
SEARCH ORNMAC ;GET WTO SYMBOLS
INTEDT==105 ;EDIT NUMBER
SUBTTL Table of Contents
; TABLE OF CONTENTS FOR GLXINT
;
;
; SECTION PAGE
; 1. Table of Contents......................................... 3
; 2. Revision History.......................................... 4
; 3. Entry Points Found in GLXINT.............................. 5
; 4. Local Definitions......................................... 6
; 5. Module Storage............................................ 7
; 6. I%INI1 - Continue Library Initialization.................. 8
; 7. CREDAT - Create data pages for OTS........................ 10
; 8. SETTRP - Setup for APR Trapping........................... 11
; 9. IINIT - Initialize the interrupt system data base......... 12
; 10. I%IOFF-I%ION - Turn interrupt system off and on........... 13
; 11. Processor for each interrupt level........................ 14
; 12. I%EXIT - Exit from the program............................ 15
; 13. I%NOW - Get time of day.................................. 15
; 14. I%SLP - Dismiss the program for a while.................. 16
; 15. I%TIMR Timer queue manipulation routines................. 17
; 16. I%HOST -- Get Host Name/Number of Central Site...... 21
; 17. GETLOC -- GET CENTRAL SITE LOCATION................. 21
; 18. I%JINF -- Canonical Job Information................. 22
; 19. I%JINF ROUTINES FOR THE -10............................... 23
; 20. I%JINF SPECIAL ROUTINES FOR THE -20....................... 24
; 21. I%WTO - ACK, WTO, WTOR MSG PROCESSOR.................... 25
; 22. WTPACD, WTOOCD ACTION ROUTINES............................ 27
; 23. MORE WTO ACTION ROUTINES.................................. 27
SUBTTL Revision History
COMMENT \
Edit GCO Reason
---- ------- -------------------------------------------------------
0001 Create GLXINT module
0002 G011 Add I%IWTO routine to SETUP WTO message
Add I%SWTO routine to SEND WTO message
Add I%SOPR routine to SEND TO ORION
Add I%WTO routine to PUT TEXT IN MESSAGE
0003 G016 On the -10 add APRENB trapping for PDL-OV, ILL-MEM-REF,
0004 G023 Fix WTO Routines to use new messages
and NON-EX-MEM.
0005 G029 Zero the Library data pages to make Library restartable
0006 G032 SUPPLEMENT THE WTO PROCESSORS WITH A ROUTINE TO PROCESS
ACK, WTO, AND WTOR MESSAGES.
0007 G036 Have APR trap set pc into AC 0 for now
0010 G049 Fix I%SOPR
0011 Add Defaulting for IB and change Calling of I%INI1
to keep the Pid pure in callers address space
0012 Support Multiple interrupt levels on the 20
0013 Handle send errors for I%SOPR if user doesn't want
send errors returned.
Make I%EXIT do a reset if not debugging
0014 Add I%HOST and correct I%EXIT to be the same in all
cases(i.e debugging and real)
0015 Add I%JINF call to Library with defined functions in GLXMAC
0016 Convert Module to use I%JINF where possible
0017 Fix $ACK message to lite the WT.SJI bit to suppress
Job info on Display
0020 Rework I%%WTI to handle blocks
Rename to I%%WTO, remove old I%%WTO, I%%WTI code.
0021 Remove I%IWTO,I%SWTO,I%WTO, Rename I%%WTO to I%WTO
0022 Rework of IB, PIB.
0023 Add global routine to get program version #
0024 Add action routines for WTO blocks NOD, JOB
Make APT $STOP print out error PC
0025 Restore S1, S2, TF on return from WTO
0026 FIX GJBLOC TO NOT CLOBBER T4. INSTEAD USE TF
0027 CHANGE NAME OF WT.JOB ACTION ROUTINE TO WTPJBN
0030 Change WT.MIN, WT.MAX to WO.MIN, WO.MAX
0031 Load real WT.JOB in WTPJBN routine
0032 ADD IB.PRG INTO IB DEFAULTS
0033 Add Support for -20 Panic Channels if using Interrupt system
and Channels are not enabled.
0034 Change SAVE to $SAVE
0035 Add WTO support code for Application Code Block and Object Type
Block
0036 Make all calls to I%WTO send a packet if its feasible.
0037 Fix WTO routines so args in S1,S2 work
0040 Fix 0037 so it BLTs a whole object block
0041 Remove setting for WT.SJI if ACK code specified
0042 Fix WTO range check stopcode to dump offending addrs
0043 Move PFH into library
0044 Change the %FATAL for the Version SKEW between GLXINI and GLXLIB
0045 Add WTO support for .MSFLG
0046 Change $FATAL for incompatible Library and I%EXIT to just
text to be dumped by the K%SOUT routine. This covers the
case of the library not being initialized.
0047 Change the error message for incompatible library and GLXINI.
0050 Change WTO block handlers to accept (and pass) args in TF
0051 Change I%EXIT to logout job if not logged in
0052 Add I%TIMR routine to handle timer events
0053 Add check to execute a timer event if caller
requests it.
0054 Fix a bug in I%TIMR when called from I%SLP
0055 Add routine to I%JINF to return jobs physical location
0056 Fix JI.LOC in I%JINF to return sixbit node name
0057 Define CNVNOD routine to do sixbit to octal conversions
for TOPS10 node numbers
0060 Fix a bug in CNVNOD so that we work in monitors without network
support
0061 Remove the CREDAT section so the individual modules can zero
their own $DATA space. Instead, we zero out our own $DATA space
just like any other module. Also remove D%END.
0062 On TOPS-10, APR traps trash AC 'TF'. Preserve it.
0063 [QAR 10-04626] Fix I%TIMR so that the PC word is
compared correctly for .TIMBF function
0064 Detach from FRCLIN if IB.DET tells us to.
0065 Change I%SLP to use two TOPS10 hiber bits and to save
all AC's as documented.
0066 I%NOW didn't return the correct local time. Do it right.
0067 Make GLXLIB run execute-only.
1) Add new routine CREDAT to create the library's data
pages (if they don't already exist).
2) Add new entry point I%APRT for APR traps. Note that
this MUST be set up by GLXINI prior to calling I%INI1.
0070 Restructure GLXLIB
1) Define I%INIT in GLXINT. Note that it's also defined in
GLXINI, but since you don't link both, it doesn't matter.
2) Remove definition for I%INI1 since it is no longer needed.
3) Once again, set up the APR trap here. Remove I%APRT since
it is no longer needed.
4) Add routine EXOCHK to check for execute-only operation and
set global flag EXOFLG. Currently, the only place this is
checked is in the memory manager/page fault handler.
5) Move data page creation out of here and into GLXOTS. It's
not needed if the library is linked with the user program.
6) Move the compatibility check out of here and into GLXOTS.
Anyone who links the library in with their program should
never have to worry about version skews.
7) Take call to SETPFH out of here and make it part of the
memory manager initialization code.
0071 Missing PORTAL in I%TIMR when GLXLIB calls the user.
0072 Add new bit IB.NPF to the IB to disable GLXPFH.
0073 Move linked list initialization above IPCF initialization
0074 Remove EXOFLG crock. Force PFHRET always.
0075 Set up temporary 1 word PDL when PDL overflow trap occurs.
0076 Fix up PDL overflow traps on the -20.
0077 Turn off WATCH when we detach from FRCLIN.
0100 Do not do the GETTAB for the WATCH bits, just clear all
0101 Remove stopcode in I%ION/I%IOFF and return CEI error instead
CEI = Can't enable/disable interrupt system
0102 Add routine I%RLIM to reset VRT and PHY core limits. Have
I%EXIT call I%RLIM for free.
0103 Make I%NOW always return the correct time on both
systems. (GMT)
0104 Move the call to GLXINI (.INIT) to before call to GLXMEM
(M%INIT) in case M%INIT wants to stopcode before the
stopcode processor has been inited.
0105 Remove I%RLIM as it won't be needed with the new PFH.
\ ;END OF REVISION HISTORY
SUBTTL Entry Points Found in GLXINT
ENTRY I%INIT ;INITIALIZE THE MODULE
ENTRY I%NOW ;GET TIME OF DAY
ENTRY I%EXIT ;EXIT FROM PROGRAM
ENTRY I%ION ;INTERRUPTS ON
ENTRY I%IOFF ;INTERRUPTS OFF
ENTRY I%SLP ;SLEEP FOR A WHILE
ENTRY I%TIMR ;CREATE OR CHECK FOR TIMER ENTRY
ENTRY I%INT1 ;CREATE ALL ENTRIES
ENTRY I%INT2 ;FOR INTERRUPT LEVELS
ENTRY I%INT3 ;
ENTRY I%SOPR ;SEND TO OPR ROUTINE.
ENTRY I%WTO ;ACK, WTO, WTOR MSG PROCESSOR
ENTRY I%HOST ;GET HOST NAME/NUMBER
ENTRY I%JINF ;CANONICAL JOB INFO BLOCK
SUBTTL Local Definitions
;Since the number of levels of interrupt differs from system to system,
; all code that deals with interrupt levels is under the DOLEV macro.
; To use this macro, define X(LVL) to generate the proper code for one
; level, using LVL as the suffix. Then the invokation of DOLEV will
; create redundant code for each level wanted (INT.LV defined in GLXMAC).
; (INT.LV and INT.MX defined in GLXMAC)
DEFINE DOLEV (LVLS<INT.LV>)<
LSTOF.
ZZ==1 ;;START AT LEVEL 1
REPEAT LVLS,<
X(\ZZ) ;;EXPAND DEFINED CODE FOR EACH LEVEL
ZZ==ZZ+1 ;;STEP TO NEXT LEVEL
>
LSTON.
> ;END OF DOLEV DEFINITION
SUBTTL Module Storage
EXT RSEFLG ;RETURN SEND ERROR FLAG
$DATA INTBEG,0 ;START OF ZEROABLE $DATA SPACE
DEFINE X(LVL)<
$DATA LEVPL'LVL,IPL.SZ ;;PUSHDOWN LIST FOR EACH LEVEL
$DATA SAVAC'LVL,20 ;;AC SAVE AREA FOR EACH LEVEL
$DATA INTPC'LVL,1 ;;INTERRUPT PROCESSOR PC
> ;END OF PER LEVEL DEFINITIONS
DOLEV ;;EXPAND FOR EACH VALID LEVEL
$GDATA TRPPDP,3 ;SAVED PUSH DOWN POINTER AND PDL
$GDATA MYJOB ;MY JOB NUMBER
$GDATA LOGTIM ;Jobs logged in time
$DATA TIMLST ;TIMER LIST
$DATA TIMWAK ;NEXT WAKEUP TIME
$DATA TIMPC ;TIME DISPATCH PC
$DATA AWOKEN ;USED FOR SLEEP/WAKE CODE
$GDATA BASINT ;BASE OF INTERRUPT SYSTEM
$GDATA INTRPC ;INTERRUPT PC ADDRESS
$DATA PRMADR ;WTO PARM ADDRESS
$DATA RETADR ;Holds return PC
$DATA THSPRM ;Address of current WTO parameter
$DATA S1%S2,2 ;WTO SAVE AREA FOR S1, S2.
$DATA WTOBLT ;OBJECT BLK END ADDRESS FOR WTO BLT
$DATA STF ;Save for TF during WTO
$DATA MSGADR ;WTO MESSAGE ADDRESS.
$DATA BYTPTR ;WTO MSG BYTE PTR.
$DATA BYTCNT ;WTO MSG BYTE COUNT.
$DATA WTOSAB,SAB.SZ ;WTO SAB BLOCK.
$DATA INTEND,0 ;END OF ZEROABLE $DATA SPACE
$GDATA IIB,IB.SZ ;FULL SIZED IB
$GDATA D%END,0 ;Last location in the data pages
SUBTTL I%INIT - Continue Library Initialization
;CALL IS: S1/ LENGTH OF THE USER SUPPLIED IB
; S2/ USER SUPPLIED IB ADDRESS
;
;TRUE RETURN: ALWAYS
I%INIT: PUSHJ P,.SAVE2## ;SAVE TWO REGISTERS
DMOVE P1,S1 ;SAVE IB LENGTH AND LOCATION
MOVE S1,[INTBEG,,INTBEG+1] ;BLT PTR TO ZEROABLE $DATA SPACE
SETZM S1,INTBEG ;FIRST LOCATION
BLT S1,INTEND-1 ;BLT THE REST
DEFINE DEFAULTS <
LSTOF.
XX IB.PRG,FWMASK,'NONAME' ;;PROGRAM NAME
XX IB.OUT,FWMASK,T%TTY ;;$TEXT OUTPUT ROUTINE
XX IB.FLG,IP.STP,0 ;;ORION GETS STOP CODES FLAG
XX IB.INT,FWMASK,0 ;;INTERRUPT VECTORS
XX IB.FLG,IT.OCT,0 ;;OPEN TERMINAL FOR S%CMND
XX IB.FLG,IB.DPM,0 ;;USE JOB NUMBER AS PID
XX IB.FLG,IB.NPF,0 ;;DON'T SET UP GLXPFH
XX IB.ERR,FWMASK,0 ;;USER $TEXT ERROR EXIT ROUTINE
XX IB.PIB,FWMASK,0 ;;PID block address
LSTON.
>
DEFINE XX (LOC,MSK,DEF,%L1) <
CAIG P1,LOC ;;SUPPLIED BY USER?
JRST %L1 ;;NO -- SUPPLY OUR DEFAULT
LOAD S1,LOC'(P2),MSK ;;YES -- GET WHAT THE SUPPLIED
SKIPN S1 ;;NULL FIELD?
%L1: MOVX S1,DEF ;;YES -- SUPPLY OUR DEFAULT
STORE S1,IIB+LOC,MSK ;;STORE IN PERSONAL IB
SUPPRESS %L1
> ;END SETDEF
DEFAULTS ;SET INTERNAL DEFAULTS
SETOM S1 ;SET FOR MY JOB
MOVX S2,JI.JNO ;GET THE JOB NUMBER
PUSHJ P,I%JINF ;GET THE DATA IN S2
MOVEM S2,MYJOB ;SAVE MY JOB NUMBER
TOPS10<
MOVX S2,JI.JLT ;GET LOGGED IN TIME
$CALL I%JINF
SKIPF
MOVEM S2,LOGTIM
DMOVE S1,INT.D ;Point to full IB
PUSHJ P,DETACH ;Try to detach from FRCLIN
> ;END TOPS10
DMOVE S1,INT.D ;POINT TO FULL IB
PUSHJ P,.INIT## ;INITIALIZE THE COMMON MODULE
DMOVE S1,INT.D ;POINT TO FULL IB
PUSHJ P,M%INIT## ;INITIALIZE THE MEMORY SYSTEM
DMOVE S1,INT.D ;POINT TO FULL IB
PUSHJ P,T%INIT## ;INITIALIZE THE TEXT MODULE
DMOVE S1,INT.D ;POINT TO FULL IB
PUSHJ P,IINIT ;INITIALIZE THE INTERRUPT SYSTEM
DMOVE S1,INT.D ;POINT TO FULL IB
PUSHJ P,L%INIT## ;INITIALIZE THE LINKED LIST MODULE
DMOVE S1,INT.D ;POINT TO FULL IB
PUSHJ P,C%INIT## ;INITIALIZE THE COMMUNICATIONS MODULE
DMOVE S1,INT.D ;POINT TO FULL IB
PUSHJ P,F%INIT## ;INITIALIZE THE FILE MODULE
DMOVE S1,INT.D ;POINT TO FULL IB
PUSHJ P,K%INIT## ;INITIALIZE THE TERMINAL KEYBOARD MODULE
DMOVE S1,INT.D ;POINT TO FULL IB
PUSHJ P,S%INIT## ;INIT THE COMMAND SCANNER
MOVX S1,<SI.FLG+SP.OPR> ;SEND TO SPECIAL PID ...OPR
MOVEM S1,WTOSAB+SAB.SI ;SAVE IN WTOSAB
SETZM WTOSAB+SAB.PD ;CLEAR PID WORD
$RETT ;RETURN TO CALLER
INT.D: EXP IB.SZ,IIB ;Common args for the initializers
SUBTTL Detach from FRCLIN
; Detach the program if we're running on FRCLIN (no-op for TOPS-20).
; Call: PUSHJ P,DETACH
;
DETACH:
TOPS10< MOVNI S1,1 ;-1 means us
GETLCH S1 ;Get our line characteristics
ANDX S1,UX.UNT ;Keep just the unit number
MOVX S2,%CNFLN ;GETTAB to return FRCLIN TTY number
GETTAB S2, ;Get it
$RETF ;Can't - just return
CAME S1,S2 ;Are we running on FRCLIN ?
$RETT ;No - return
HRLZS S1 ;Setup line#,,0 for detach
ATTACH S1, ;Detach from FRCLIN
$RETF ;Oh well...
MOVSI S1,.STWTC ;GET FUNCTION CODE TO SET WATCH
SETUUO S1, ;SET WATCH NONE
JFCL ;HOPE NOTHING TYPES OUT
> ;End of TOPS-10 conditional
$RETT ;Return
SUBTTL SETTRP - Setup for APR Trapping
SETTRP:
TOPS10 <
MOVEI S1,TRPADR ;GET APR TRAP ADDRESS
MOVEM S1,.JBAPR## ;STORE IT
MOVX S1,AP.POV+AP.ILM+AP.NXM ;GET TRAP TYPES
APRENB S1, ;ENABLE THEM
$RETT ;RETURN
> ;END TOPS10 CONDITIONAL
TOPS20 <
SKIPN S1,BASINT ;INTERRUPT SYSTEM PRESENT
$RETT ;NO..IGNORE SETUP
HRRZ S1,S1 ;GET CHANNEL TABLE ADDRESS
MOVE S2,[1,,TRPPDL] ;TRAP ADDRESS FOR INTERRUPTS
SKIPN .ICPOV(S1) ;PDL OVERFLOW SETUP?
MOVEM S2,.ICPOV(S1) ;SAVE TRAP ADDRESS
MOVE S2,[1,,TRPIIT] ;TRAP ADDRESS FOR INTERRUPTS
SKIPN .ICILI(S1) ;ILLEGAL INSTRUCTION?
MOVEM S2,.ICILI(S1) ;SAVE TRAP ADDRESS
MOVE S2,[1,,TRPIMR] ;TRAP ADDRESS FOR INTERRUPTS
SKIPN .ICIRD(S1) ;ILLEGAL MEMORY READ?
MOVEM S2,.ICIRD(S1) ;SAVE TRAP ADDRESS
MOVE S2,[1,,TRPIMW] ;TRAP ADDRESS FOR INTERRUPTS
SKIPN .ICIWR(S1) ;ILLEGAL MEMORY WRITE?
MOVEM S2,.ICIWR(S1) ;SAVE TRAP ADDRESS
MOVEI S1,.FHSLF ;GET MY PROCESS HANDLE
MOVX S2,<1B<.ICPOV>!1B<.ICILI>!1B<.ICIRD>!1B<.ICIWR>>
AIC ;ACTIVATE THE CHANNELS
ERJMP SETT.E ;ERROR
HLRZ S1,BASINT ;GET LEVEL TABLE
MOVE S1,(S1) ;GET ADDRESS OF LEVEL PC SAVE
MOVEM S1,INTRPC ;SAVE INTRPC
$RETT ;RETURN
SETT.E: $STOP(CSP,Cannot Activate Panic Channels)
>;END TOPS20
; Here on TOPS-10 APR traps
;
TOPS10 <
TRPADR: PORTAL .+1 ;Allow execute-only operation
EXCH TF,.JBCNI ;Get APR CONI at trap, save TF
TXNE TF,AP.POV ;PDL overflow ?
JRST TRPPDL ;Yes
TXNE TF,AP.ILM ;Ill mem ref ?
JRST TRPILM ;Yes
TXNE TF,AP.NXM ;Non-existant memory ?
JRST TRPNXM ;Yes
EXCH TF,.JBCNI ;Restore JOBDAT location and TF
$STOP (APT,<Unknown APR trap^I/TRPPC/ APR CONI = ^O12R0/.JBCNI/>)
TRPPDL: EXCH TF,.JBCNI ;Restore JOBDAT location and TF
MOVEM P,TRPPDP ;STORE PUSH DOWN POINTER
MOVE P,[IOWD 2,TRPPDP+1] ;SET UP TEMPORARY PDL
$STOP (PDL,<Pushdown list overflow^I/TRPPC/>)
MOVE P,TRPPDP ;RELOAD USER'S PDL POINTER
POPJ P, ;THE FOOL IS TRYING TO CONTINUE
TRPILM: EXCH TF,.JBCNI ;Restore JOBDAT location and TF
$STOP (ILM,<Illegal memory reference^I/TRPPC/>)
TRPNXM: EXCH TF,.JBCNI ;Restore JOBDAT location and TF
$STOP (NXM,<Non-existant memory^I/TRPPC/>)
TRPPC: ITEXT (< at PC ^O/.JBTPC,RHMASK/>)
>;END TOPS10 CONDITIONAL
TOPS20 <
TRPPDL: MOVEM P,TRPPDP ;STORE PUSH DOWN POINTER
MOVE P,[IOWD 2,TRPPDP+1] ;SET UP TEMPORARY PDL
$STOP (PDL,<Pushdown list overflow>)
MOVE P,TRPPDP ;RELOAD USER'S PDL POINTER
POPJ P, ;RETURN?
TRPIIT: $BGINT 1 ;SETUP ILLEGAL INSTRUCTION
PUSHJ P,TRPSET ;SETUP TRAP
MOVE P,SAVAC1+17 ;GET ORIGINAL STACK BACK
$STOP(IST,Illegal Instruction Trap^I/TRPPC/)
TRPIMR: $BGINT 1 ;SETUP ILLEGAL MEMORY READ
PUSHJ P,TRPSET ;SETUP TRAP
MOVE P,SAVAC1+17 ;GET ORIGINAL STACK BACK
$STOP(IMR,Illegal Memory Read^I/TRPPC/)
TRPIMW: $BGINT 1 ;SETUP ILLEGAL MEMORY WRITE
PUSHJ P,TRPSET ;SETUP TRAP
MOVE P,SAVAC1+17 ;GET ORIGINAL STACK BACK
$STOP(IMW,Illegal Memory Write^I/TRPPC/)
TRPPC: ITEXT (< at PC ^O/INTRPC,RHMASK/ Stack ^O/SAVAC1+17/>)
TRPSET: PUSH P,S1 ;SAVE S1
MOVE S1,@INTRPC ;GET THE PC
MOVEM S1,INTRPC ;SAVE THE PC
POP P,S1 ;RESTORE S1
POPJ P, ;RETURN
>;END TOPS20
SUBTTL IINIT - Initialize the interrupt system data base
;Information in the IB must be remembered for operation of the interrupt
; system. Also, since the entries to the interrupt level setup routines
; are in impure storage, they must be set up.
; CALL IS: S1/ Size of the IB
; S2/ Address of the IB
;
; TRUE RETURN: Always
IINIT: SETOM AWOKEN ;ALWAYS PRETEND SOMETHING HAPPENED
MOVE S1,IB.INT(S2) ;GET THE BASE OF THE INTERRUPT SYSTEM
MOVEM S1,BASINT ;STORE FOR LATER
JUMPE S1,SETTRP ;IF NO INTERRUPT SYSTEM,FINISH UP
PUSHJ P,SETINT ;SET IT UP FOR USER
JUMPT SETTRP ;SET APR TRAPS AND RETURN IF OK
$STOP(CSI,Cannot set up interrupt system)
SUBTTL I%IOFF-I%ION - Turn interrupt system off and on
;When interrupts can not be accepted, they can be switched on
; and off via these routines.
;CALL IS: NO ARGUMENTS
;TRUE RETURN: ALWAYS
TOPS10 <
I%ION: SKIPA S1,[PS.FON] ;FLAG TO TURN ON SYSTEM
I%IOFF: MOVX S1,PS.FOF ;FLAG TO TURN OFF SYSTEM
SKIPN BASINT ;DID USER ENABLE INTERRUPTS?
$RETT ;NO, JUST RETURN
PISYS. S1, ;ALTER THE STATE
$RETE(CEI) ;Failed,,return
$RETT ;AND RETURN
SETINT: PIINI. S1, ;HERE TO SET UP VECTOR
$RETF ;FALSE IF CANNOT SET IT UP
$RETT ;OTHERWISE, ALL IS OK
> ;END TOPS10 CONDITIONAL
TOPS20 <
I%ION: SKIPN BASINT ;SKIP IF USER ENABLED INTERRUPTS
$RETT ;AND RETURN
MOVX S1,.FHSLF ;FOR MYSELF
EIR ;TURN ON INTERRUPTS
ERJMP [$RETE(CEI)] ;Failed,,return
$RETT
I%IOFF: SKIPN BASINT ;SKIP IF WE ARE DOING INTERRUPTS
$RETT ;AND RETURN
MOVX S1,.FHSLF ;FOR MYSELF
DIR ;DISABLE INTERRUPTS
ERJMP [$RETE(CEI)] ;Failed,,return
$RETT ;RETURN AFTER CHANGE
SETINT: MOVE S2,S1 ;GET LEVTAB,,CHNTAB OF CALLER
MOVX S1,.FHSLF ;AND FOR MYSELF,
SIR ;ESTABLISH THE INTERRUPT SYSTEM
ERJMP .RETF ;IF IT FAILS, SAY SO
$RETT ;OTHERWISE, TAKE GOOD RETURN
> ;END TOPS20 CONDITIONAL
SUBTTL Processor for each interrupt level
;Each level of interrupt starts off with a $BGINT instruction
;which does a JSR to the appropriate I%INTx routine. These in turn
;call the continuation routines which set the DEBRK code as a co-routine.
;When interrupt processing is done for this level, a $DEBRK is done
;which does the proper post interrupt processing.
DEFINE X(LVL)<
I%INT'LVL:
IFGE INT.LV-LVL,<
POP P,INTPC'LVL ;;SAVE INTERRUPT PROCESSOR PC
MOVEM 0,SAVAC'LVL ;;SAVE AC 0 AWAY
MOVE 0,[XWD 1,1+SAVAC'LVL] ;;BLT POINTER TO SAVE THE ACS
BLT 0,17+SAVAC'LVL ;;SAVE ALL ACS
MOVE 17,[IOWD IPL.SZ,LEVPL'LVL] ;;SET UP INTERRUPT LEVEL PDL
PUSH P,[Z DBRK'LVL] ;;SET UP CO-ROUTINE RETURN
JRST @INTPC'LVL ;;AND CONTINUE
DBRK'LVL: ;;HERE WHEN INTERRUPT IS OVER
PORTAL .+1 ;;CLEAR PUBLIC
TOPS20 < ;;WAKE UP CODE FOR TOPS-20
SETOM AWOKEN ;;WE HAVE A WAKE UP COMING
MOVEI T1,SLP1 ;;LABEL FOR FORCED WAKE UP
HLRZ S2,BASINT ;;GET LEVTAB'S ADDRESS
ADDI S2,LVL-1 ;;GET OFFSET TO THIS LEVEL'S POINTER
HRRZ S2,0(S2) ;;GET WHERE PC IS STORED
HRRZ S1,0(S2) ;;GET PC INTERRUPTED FROM
CAIL S1,SLP0 ;;INSIDE SLEEP CODE BLOCK?
CAILE S1,SLP1 ;;
SKIPA ;;NO, NO NEED TO ALTER PC
HRRM T1,0(S2) ;;ELSE STORE NEW PC TO FORCE WAKE-UP
> ;END TOPS20 CONDITIONAL
MOVE 17,[XWD SAVAC'LVL,0] ;;RESTORE THE ACS
BLT 17,17 ;;OF PREVIOUS CONTEXT
TOPS20 <
DEBRK ;;DISMISS THE INTERRUPT
ERCAL S..NIP ;;IF DEBRK FAILS
> ;END TOPS20 CONDITIONAL
TOPS10 <
DEBRK. ;;DISMISS THE INTERRUPT
PUSHJ P,S..DUF ;IF UUO FAILS
PUSHJ P,S..NIP ;IF NONE IN PROGRESS
> ;END TOPS10 CONDITIONAL
> ;END IFGE INT.LV-LVL
IFL INT.LV-LVL,<
$STOP(IN'LVL,Level LVL interrupts not supported)
> ;END IFL INT.LV-LVL
> ;END OF X DEFINITION
DOLEV (INT.MX) ;EXPAND CODE OR STOP CODE FOR ALL LEVELS
$STOP(NIP,No interrupt is in progress) ;COMMON STOP CODES
$STOP(DUF,DEBRK UUO failed)
SUBTTL I%EXIT - Exit from the program
;This routine provides a non-continuable exit from the calling
; program.
;CALL IS: No argument
;
;NO RETURN IS PROVIDED
I%EXIT:
TOPS10 <
PJOB S1, ;Get my job number
MOVN S1,S1
JOBSTS S1,
TDZA S1,S1
TXNE S1,JB.ULI ;Am I logged in?
JRST IEXIT ;Yes..then just exit
MOVEI S1,[ASCIZ/.KJOB
./]
$CALL K%SOUT
LOGOUT
>
IEXIT: RESET
$HALT ;STOP THE PROCESS
MOVEI S1,[ASCIZ/? Can't continue
/]
PUSHJ P,K%SOUT ;DUMP THE MESSAGE
JRST IEXIT ;LOOP BACK
SUBTTL I%NOW - Get time of day
; Return local date/time in Smithsonian Universal date/time format
; CALL IS: No arguments
;
; TRUE RETURN: S1/ Greenwich time and date in UDT format
;
I%NOW:
TOPS10 < ;TOPS-10 ONLY
MOVX S1,%CNDTM ;GET UNIVERSAL DATE/TIME (GMT)
GETTAB S1, ;THE MONITOR
$STOP(DTU,Date/Time unavailable)
> ;END OF TOPS-10 CONDITIONAL
TOPS20 < ;TOPS-20 ONLY
GTAD ;GET DATE AND TIME
> ;END OF TOPS-20 CONDITIONAL
$RETT ;RETURN WITH UDT IN S1
SUBTTL I%SLP - Dismiss the program for a while
;When programs need to suspend operation for a time or want to block
; indefinitely, they should use the I%SLP routine.
; Any interrupts will cause the end of sleeping, as will certain
; spurious conditions. Programs using I%SLP should not depend
; on premature wake-up not happening.
; An additional reason for waking on the 10 may be wakeup codes accepted
; HIBER. Specifically, HIBER will wakeup on terminal character input and
; on PTY input. This is specifically needed on the 10 to permit interrupting
; the user on tty input to allow ipcf messages to be processed.
;CALL IS: S1/ flags ,, Number of seconds to sleep, or 0 for infinite
;
;TRUE RETURN: Always
; S1/ Number of seconds till next timer wakeup time
; All other AC's are preserved
I%SLP: $SAVE S2 ;Save S2
HRRZ S2,S1 ;Get only the time to sleep
TOPS10< ANDX S1,<HB.RPT+HB.RTC> > ;Use only bits allowed
TOPS20< SETZM S1 > ;Currently no flags on TOPS20
IMULI S2,^D1000 ;Set to milliseconds
SKIPN TIMWAK ;Timer event waiting?
JRST SLP0 ;No - go to sleep
$SAVE <T1,T2,T3,T4> ;Save some more AC's
MOVE T1,S1 ;Save the flags
MOVE T2,S2 ;Save the current time to sleep
$CALL I%NOW ;Get the current time
CAML S1,TIMWAK ;Time for a wakeup?
JRST SLPDSP ;Yes .. Go check requests
MOVE T3,TIMWAK ;Get the wakeup time
SUB T3,S1 ;Make it time till wakeup
IMULI T3,^D333 ;Convert to milliseconds
SKIPE S2,T2 ;Fetch old sleep time and skip if 0
CAML S2,T3 ;Sleep wakeup before timer wakeup?
MOVE S2,T3 ;No - get timer wakeup
MOVE S1,T1 ;Restore the flags
SLP0: CAILE S2,^D60*^D1000 ;Don't sleep for more than 60 seconds
MOVEI S2,^D60*^D1000 ;Nice try
HRR S1,S2 ;Set up for monitor call
TOPS10 <
HIBER S1, ;DO HIBERNATE FOR SLEEPING
JFCL
> ;END TOPS10 CONDITIONAL
TOPS20 <
SKIPE AWOKEN ;SEE IF A WAKE UP HAS OCCURRED
JRST SLP1 ;YES, DON'T SLEEP AT ALL
SKIPN S1 ;TIMED SLEEP?
WAIT ;NO, SLEEP INDEFINITELY
DISMS ;ELSE SLEEP FOR SPECIFIED SECONDS
JFCL ;USE A LOCATION
SLP1: SETZM AWOKEN ;CLEAR "NEED WAKE UP" FLAG
> ;END TOPS20 CONDITIONAL
SLPDSP: SKIPG TIMPC ;Want to execute routine?
JRST SLPRET ;No..just return
MOVEI S1,0 ;Yes..get the entry
$CALL I%TIMR ;Is it time?
JUMPF SLPRET ;No..just return
CAILE S1,.TIMPC ;Simple safety check
$CALL @.TIMPC(S2) ;Call the routine
PORTAL SLPDSP ;Ignore skip returns
PORTAL SLPDSP ;Process all expired entries
SLPRET: MOVE S1,TIMWAK ;Return next wakeup time
$RETT
SUBTTL I%TIMR Timer queue manipulation routines
;This routine is called to add an entry to the timer event queue
;and to return expired events from the queue.
;To add an entry to the timer queue:
;ACCEPTS S1/ Length of entry to be added to queue
; S2/ Address of entry to be added to queue
;RETURNS TRUE Entry has been added to the timer queue
; FALSE ERIFN$ Invalid function was requested
; ERARG$ Invalid argument was specified
; ERTME$ Requested time has already expired
;To get and delete an expired entry from the timer queue:
;ACCEPTS S1/ Zero
;RETURNS TRUE S1/ Length of entry which has expired
; S2/ Address of the entry
; FALSE ERTMN$ No timer events have expired
I%TIMR: $SAVE <P1,P2,P3,P4> ;Save some acs
DMOVE P1,S1 ;Save calling arguments
SKIPN S1,TIMLST ;Get the timer list
$CALL L%CLST ;No list..go get one
MOVEM S1,TIMLST ;Remember we have it
MOVE S2,TIMWAK ;Get wakeup time
CAMN P1,[-1] ;Just want the list number?
$RETT ;Yes..return it
$CALL L%FIRST ;Position to first entry
JUMPF TIMR.1 ;No entries..proceed
SKIPGE .TIPSI(S2) ;Marked for deletion?
$CALL L%DENT ;Yes..get rid of it
TIMR.1: JUMPE P1,TIMCHK ;Want to check the queue?
CAIGE P1,1 ;At least one word?
$RETE (ARG) ;No..return the error
LOAD S1,.TIFNC(P2),TI.FNC ;Get the requested function
CAIL S1,.TIMRT ;Within range?
CAILE S1,.TIMAL
$RETE (IFN) ;No..invalid function
PJRST @TIMTBL(S1) ;Yes..do the function
TIMTBL: PJRST TIMRT ;Interrupt after runtime
PJRST TIMEL ;Add entry after n milliseconds
PJRST TIMDT ;Add an entry at specific UDT
PJRST TIMDD ;Delete entries at specific UDT
PJRST TIMBF ;Delete entries before spec UDT
PJRST TIMAL ;Delete all entries
TIMCHK: MOVE S1,TIMLST ;Yes..get the list index
$CALL L%FIRST ;Get the first entry
JUMPF TIMCH3 ;Oops..kill the list and return
MOVE P2,S2 ;Remember the address
SKIPN TIMWAK ;Any wakeup time set?
JRST TIMCH4 ;No..return nothing to do
$CALL I%NOW ;Yes..get the current time
CAMGE S1,TIMWAK ;First entry expired?
JRST TIMCH4 ;Nothing to do..just return
SETOM .TIPSI(P2) ;Mark entry for deletion
MOVE S1,TIMLST ;Get list index
$CALL L%SIZE ;Get the size of this entry
MOVE P1,S2 ;Remember entry size
SETZM TIMWAK ;Clear wakeup time
SETZM TIMPC ;Clear dispatch flag
MOVE S1,TIMLST ;Get the list index
$CALL L%NEXT ;Get the next entry
JUMPF .+5
MOVE S1,.TITIM(S2) ;Set new wake time
MOVEM S1,TIMWAK
SKIPLE S1,.TIMPC(S2) ;Set new PC word
MOVEM S1,TIMPC
MOVE S1,P1 ;Return size of entry
MOVE S2,P2 ; and address of entry
$RETT
TIMCH3: SETZM TIMWAK ;Clear wakeup time
SETZM TIMPC ; and PC word
TIMCH4: $RETE(TMN) ;Nothing to do
;These routines will add an entry to the timer queue
;TIMEL Add an entry to expire after N milliseconds
TIMEL: CAIGE P1,.TITIM+1 ;Argument list large enough?
$RETE(ARG)
MOVE S1,.TITIM(P2) ;Get number of milliseconds
IDIVI S1,^D333 ;Convert to 1/3 seconds
MOVE P3,S1 ;Remember this
$CALL I%NOW ;Get current date and time
ADD P3,S1 ;UDT now in P3
JRST TIMDTE ;Fall into common code
;TIMDT Add an entry to expire at a specific UDT
TIMDT: CAIGE P1,.TITIM+1 ;Argument list large enough?
$RETE(ARG) ;No..return the error
MOVE P3,.TITIM(P2) ;Get requested UDT
TIMDTE: MOVE S1,TIMLST ;Get the list index
$CALL L%FIRST ;Position to first entry
JUMPF TIMD4 ;None there..go create one
TIMD1: CAMLE P3,.TITIM(S2) ;Right position for this entry?
JRST TIMD3 ;No..check the next
CAMN P3,.TITIM(S2) ;Is it identical?
CAIE P1,.TIMPC+1 ;Have a PC word and no data?
JRST TIMD2 ;No..go create entry
MOVE P4,.TIMPC(P2) ;Yes..get PC word
CAME P4,.TIMPC(S2) ;Don't make duplicate entry
JRST TIMD3 ;Put this one at the end
$RETE(TMA) ;Entry already exists
TIMD2: MOVE S2,P1 ;Get size of entry
$CALL L%CBFR ;Create the entry
JRST TIMD5 ;Finish up
TIMD3: $CALL L%NEXT ;No..Get the next entry
JUMPT TIMD1
TIMD4: MOVE S1,TIMLST ;Put entry at end of list
MOVE S2,P1 ;Get required size of entry
$CALL L%CENT ;Create it
TIMD5: ADDI P1,-1(S2) ;Get destination address
HRL P2,S2 ;Make BLT pointer
MOVS P2,P2
BLT P2,0(P1) ;Copy arguments
MOVEM P3,.TITIM(S2) ;Save expiration UDT
TIMD6: $SAVE <S1,S2> ;Save for return
PJRST TIMDTX ;Set wakup time and exit
;TIMRT Request an interrupt after N milliseconds of runtime
TIMRT: $RETE(IFN) ;Runtime is unsupported
;TIMBF Deletes all entries before specific UDT
;TIMDD Deletes all entries for a specific UDT
TIMBF: SKIPA P4,[CAMG P3,.TITIM(S2)] ;Delete before time
TIMDD: MOVE P4,[CAME P3,.TITIM(S2)] ;Delete specific time
CAIGE P1,.TITIM+1 ;Must have time word
$RETE(ARG) ;Return the error
MOVE S1,TIMLST ;Get the list index
MOVE P3,.TITIM(P2) ;Get requested time
$CALL L%FIRST ;Get the first entry
JUMPF TIMALX ;Reset the flags
TIMDD1: XCT P4 ;Want to delete this request?
JRST TIMDD3 ;No..check the next
CAIG P1,.TIMPC ;Have a PC word?
JRST TIMDD2 ;No..delete the entry
MOVE S2,.TIMPC(S2) ;[63] Yes..get the word
CAMN S2,.TIMPC(P2) ;They must match
TIMDD2: $CALL L%DENT ;Yes..zap it
TIMDD3: $CALL L%NEXT ;Check the next
JUMPT TIMDD1 ;Back to check the next
;Set wakeup time and return
;TIMDTX Sets wakup time and returns
TIMDTX: MOVE S1,TIMLST
$CALL L%FIRST ;Position to first entry
JUMPF TIMALX ;None..reset the flags
MOVE S1,.TITIM(S2) ;Set the wakeup time
MOVEM S1,TIMWAK
SETZM TIMPC ;Clear dispatch flag
SKIPLE S1,.TIMPC(S2) ;Want to execute this request
MOVEM S1,TIMPC ;Yes..remember this
$RETT
;TIMAL Kill all entries in the timer queue
TIMAL: MOVE S1,TIMLST ;Get the list address
$CALL L%FIRST
SKIPF
$CALL L%DENT ;Else delete all entries
JUMPT .-1
TIMALX: SETZM TIMWAK ;Clear wakeup time
SETZM TIMPC ;Clear dispatch flag
$RETT
SUBTTL I%HOST -- Get Host Name/Number of Central Site
;THIS ROUTINE WILL RETURN THE NODE NAME AND NUMBER (-10 ONLY)
;FOR THE CENTRAL SITE.
;
;CALL: NO ARGUMENTS
;
;RETURN: S1/ HOST NAME IN SIXBIT
; S2/ HOST NUMBER
;
IFN FTUUOS,<
I%HOST: MOVEI S2,.GTLOC ;GET LOCATION OF JOB 0
GETTAB S2, ;...
JRST NOHOST ;No network if this fails
MOVE S1,S2 ;Copy node numer
$CALL CNVNOD ;Convert S1 to node name
JUMPF NOHOST ;Use local defaults
$RETT
CNVNOD:: $SAVE <T1,T2,T3,T4> ;Convert S1 to its compliment
MOVE T1,[.NDRNN,,T2] ;Function is convert name/num
MOVEI T2,2 ;2 Args specified
MOVE T3,S1 ;Put the node number in T3
NODE. T1, ;Get the sixbit
SKIPA ;Failed,,look into the error
JRST [MOVE S1,T1 ;Win,,get answer in S1
$RETT ] ;Return
CAMN T1,[.NDRNN,,T2] ;Are networks supported ???
SKIPE S1 ;No,,is the node number 0 ??
$RETE(NSN) ;Network support or non zero node number
MOVE S1,['LOCAL '] ;Use local as default
$RETT ;return
>;END FTUUOS
IFN FTJSYS,<
I%HOST: PUSHJ P,.SAVET ;SAVE THE T REGS
MOVX S1,.NDGLN ;GET LOCAL NODE NAME JSYS CODE
MOVEI S2,TF ;GET ARGUMENT BLOCK ADDRESS
HRROI TF,T1 ;MAKE BYTE POINTER TO T1
NODE ;GET THE LOCAL NODE NAME
ERJMP NOHOST ;NO NETWORKS
MOVE T3,[POINT 7,T1] ;GET POINTER TO NODE NAME
MOVE T4,[POINT 6,S1] ;GET OUTPUT POINTER
SETZ S1, ;SET OUTPUT BUFFER TO NULLS
HOST.1: ILDB S2,T3 ;GET AN INPUT BYTE
JUMPE S2,HOST.2 ;NULL,,GO FINISH UP
SUBI S2,40 ;MAKE IT SIXBIT
IDPB S2,T4 ;SAVE IT
JRST HOST.1 ;AND GO PROCESS ANOTHER
HOST.2: SETZ S2, ;0 FOR NODE NUMBER
$RETT ;AND RETURN
>;END FTJSYS
NOHOST: MOVE S1,['LOCAL '] ;Use local as default
SETZ S2,
$RETT
SUBTTL I%JINF -- Canonical Job Information
;This Call is designed to provide a system independent way of getting Job
;information.
;
; CALL : S1/ JOB NUMBER OR -1 FOR CURRENT JOB
; S2/ FUNCTION CODE
;
;
; RETURN TRUE: S1/ JOB NUMBER PRESERVED FROM CALL
; S2/ RETURNED VALUE FOR FUNCTION
; RETURN FALSE: S1/ ERROR CODE
;
; DEFINED ERROR CODES
;
; ERUJI$ - UNDEFINED JOB INFO FUNCTION
; ERIJN$ - INVALID JOB NUMBER
I%JINF: CAIL S2,JI.MIN ;CHECK FUNCTION RANGE
CAILE S2,JI.MAX ;WITHIN BOUNDS
$RETE(UJI) ;UNDEFINED JOB INFO FUNCTION
MOVE S2,JINFTB-1(S2) ;GET THE DATA
SKIPL S2 ;FUNCTION CODE OR ROUTINE
JRST GJBGTB ;FUNCTION CODE DO THE WORK
HRRZS S2 ;GET ROUTINE ADDRESS
PJRST (S2) ;PROCESS THE FUNCTION
TOPS10<
GJBGTB: HRL S2,S1 ;PLACE JOB NUMBER IN LEFT HALF
GETTAB S2, ;GET THE INFO
$RETE(IJN) ;INVALID JOB NUMBER
$RETT ;RETURN TRUE
>;END TOPS10
TOPS20<
GJBGTB: $SAVE T1 ;SAVE T1
MOVE T1,S2 ;GET THE FUNCTION CODE
MOVSI S2,-1 ;1 WORD TO RETURN
HRRI S2,T1 ;RESULT IN T1
GETJI ;GET THE INFO
$RETE(IJN) ;INVALID JOB NUMBER
MOVE S2,T1 ;GET RETURNED DATA
$RETT ;RETURN TRUE
>;END TOPS20
;JOB INFO FUNCTION DISPATCH TABLE
DEFINE X(A,B,C),<
JI.'A==JI.'A ;GET SYMBOLS
TOPS10<C>
TOPS20<B>
>;END X
JINFTB: JBTAB ;EXPAND THE TABLE
SUBTTL I%JINF ROUTINES FOR THE -10
TOPS10<
;GET THE PATH DIRECTORY
GJBPTH: PUSHJ P,.SAVET ;SAVE THE T REGS
MOVS T1,S1 ;PUT JOB NUMBER IN T1
HRRI T1,.PTFRD ;READ DIRECTORY PATH
MOVSI S2,3 ;LENGTH OF BLOCK
HRRI S2,T1 ;ADDRESS OF BLOCK
PATH. S2, ;DO THE FUNCTION
$RETE(IJN) ;INVALID JOB NUMBER
MOVE S2,T3 ;GET THE PPN
$RETT ;RETURN TRUE
;GET THE CONTROLLING JOB NUMBER
GJBCJB: MOVE S2,S1 ;GET JOB NUMBER
CTLJOB S2, ;GET CONTROLLING JOB
$RETE(IJN) ;INVALID JOB NUMBER
$RETT ;CONTROLLING JOB OR -1 IF NOT CONTROLLED
;GET THE JOB NUMBER OF MY JOB
GJBJNO: SKIPL S2,S1 ;CHECK IF FOR ME
$RETE(IJN) ;INVALID JOB NUMBER
PJOB S2, ;GET THE JOB NUMBER
$RETT ;RETURN TRUE
GJBTLC: $SAVE <T1> ;SAVE AN AC
MOVE T1,S1 ;SAVE THE JOB NUMBER
SETZM S2 ;RETURN A ZERO FOR EARLY FAILURE
TRMNO. S1, ;GET THIS JOB'S TERMINAL #
$RETE(TLU) ;ERROR IF NO TERMINAL
GTNTN. S1, ;FIND OUT WHERE THAT TTY LIVES
$RETE(TLU) ;ERROR IF NO NODE,,TERMINAL
HLRZS S1 ;GET JUST THE TERM #
$CALL CNVNOD ;Convert S1 to sixbit
$RETIF ;Return any failures
MOVE S2,S1 ;Return node name in S2
MOVE S1,T1 ;Return Job number in S1
$RETT
;GET THE JOBS TERMINAL NUMBER
GJBTTY: MOVE S2,S1 ;SAVE THE JOB NUMBER
TRMNO. S2, ;GET THE TERMINAL NUMBER
JRST GJBT.1 ;ERROR..CHECK FOR DETACHED
TRZ S2,.UXTRM ;MAKE TERMINAL NUMBER
$RETT ;RETURN TRUE
GJBT.1: MOVN S2,S1 ;GET NEGATIEV JOB NUMBER IN S1
JOBSTS S2, ;DO JOBSTS UUO
$RETE(IJN) ;INVALID JOB NUMBER
TXNN S2,JB.UJA ;JOB NUMBER ASSIGNED
$RETE(IJN) ;INVALID JOB NUMBER
SETOM S2 ;-1 IF DETACHED
$RETT ;RETURN
GJBVER::MOVE S1,.JBVER ;Yes, get our version
$RETT ;Done
GJBRTM: SKIPGE S1 ;Want our job (-1)?
SETZ S1, ;Yes, adjust to RUNTIm UUO convetion
MOVE S2,S1 ;SAVE THE NUMBER AND GET VALUE IN S2
RUNTIM S2, ;Ask the monitor
$RETT ;Give it to user
GJBLOC: MOVEI S2,.GTLOC ;Function is get my location
$CALL GJBGTB ;Do the GETTAB
$RETIF ;Return any failure
EXCH S1,S2 ;Put number in S1
$CALL CNVNOD ;Convert to sixbit
$RETIF ;Return any failure
EXCH S1,S2 ;Else return sixbit in S2
$RETT ;With job number in S1
> ;End TOPS10
SUBTTL I%JINF SPECIAL ROUTINES FOR THE -20
TOPS20<
GJBLOC:
PUSHJ P,.SAVET ;SAVE THE ACS
HRRI T1,.JILLO ;GET THE FUNCTION CODE
MOVSI S2,-1 ;1 WORD TO RETURN
HRRI S2,T2 ;RESULT IN T2
HRROI T2,T3 ;POINTER TO T3
GETJI ;GET THE INFO
$RETE(IJN) ;INVALID JOB NUMBER
MOVE T1,[POINT 7,T3] ;SETUP INPUT POINTER
MOVE TF,[POINT 6,S2] ;GET OUTPUT POINTER
SETZ S2, ;SET OUTPUT BUFFER TO NULLS
GJBL.1: ILDB T2,T1 ;GET AN INPUT BYTE
JUMPE T2,.RETT ;NULL,,GO FINISH UP
SUBI T2,40 ;MAKE IT SIXBIT
IDPB T2,TF ;SAVE IT
JRST GJBL.1 ;AND GO PROCESS ANOTHER
GJBTLC: $SAVE <S1>
$CALL I%HOST
MOVE S2,S1 ;ONLY KNOW ABOUT OUR HOST FOR NOW
$RETT
GJBVER:: MOVX S1,.FHSLF ;Yes, aim at my process
GEVEC ;Get my entry info
HLRZ S1,S2 ;Get length
CAIN S1,(JRST) ;Is it an old entry vector (JRST start)
JRST [MOVE S1,137 ;Yes, get version ala TOPS-10
$RETT] ;Give that to user
CAIGE S1,2 ;Does it contain a version?
TDZA S1,S1 ;No, return 0
MOVE S1,2(S2) ;Yes, get it
$RETT ;Done
>;END TOPS20
SUBTTL I%WTO - ACK, WTO, WTOR MSG PROCESSOR
;THIS ROUTINE WILL GET A PAGE FROM THE MEMORY MANAGER, SET IT UP
;AS AN ACK, WTO OR WTOR MESSAGE AND THEN CALL $TEXT TO CREATE
;THE MESSAGE BODY.
I%WTO: PUSH P,(P) ;Copy return PC
POP P,RETADR ;And save for final POPJ
POP P,PRMADR ;GET THE PARM ADDRESS.
DMOVEM S1,S1%S2 ;SAVE THE TRASH AC'S.
MOVEM TF,STF ;SAVE TF ACROSS WTO
PUSHJ P,M%GPAG ;GET A PAGE FOR IPCF.
MOVEM S1,WTOSAB+SAB.MS ;SAVE THE PAGE ADDRESS.
MOVEI S2,.OHDRS ;GET OFFSET TO MSG BLOCKS.
STORE S2,.MSTYP(S1),MS.CNT ;SAVE IT IN THE MSG.
ADDI S2,ARG.HD(S1) ;Get addr of first free in msg
MOVEM S2,MSGADR ;Save for building
DEFINE NXTWTO(HERE),<
IFNB <HERE>,<NXTWT:> ;;If this is a definition, just define return loc
IFB <HERE>,<JRST NXTWT>;;Else just return
>;END DEFINE NXTWTO
NXTWTO(HERE) ;Define the loop location for the action routines
AOS S1,PRMADR ;BUMP OVER THE 'JRST'
;Get addr of this entry
SKIPN S1,(S1) ;End of list?
JRST IWTOFN ;Yes, all done
MOVEM S1,THSPRM ;Save arg for computing effective addr
DMOVE S1,S1%S2 ;Get back to user context
MOVE TF,STF ;And get caller's TF
MOVEI S1,@THSPRM ;Get addr from block
EXCH S1,THSPRM ;Save for action routine
LDB S1,[POINT 9,S1,8] ;Get op-code field
CAIL S1,WO.MIN ;Is it ..
CAILE S1,WO.MAX ; .. in range?
$STOP (WFO,<WTO Function ^O/S1/ Out of range at address ^O/PRMADR,RHMASK/>)
JRST @WTDSP-WO.MIN(S1) ;In range, do the work, and return via
;NXTWTO We'd like to do a PUSHJ here,
;but that would destroy the user's
;stack context
WTDSP: DEFINE .EAWTO(SUF,CODE),<$SET(WO.'SUF'-WO.MIN,,WTP'SUF')>
$BUILD WO.MAX-WO.MIN+1
ALLWTO
$EOB
;Here when all thru processing the user blocks
IWTOFN: PUSHJ P,I%WT.3 ;Send the message to OPR
PUSH P,RETADR ;Fix up stack for user again
DMOVE S1,S1%S2 ;Get back the users scratch regs
MOVE TF,STF ;Get back caller's TF
POPJ P, ;Go back to call + 1
;Action routines for each of the op-code types in the WTO macro
;Action routine for setting the message type
WTPMTY: MOVE S1,WTOSAB+SAB.MS ;Get address of message
MOVE S2,THSPRM ;Get addr of parameter (immediate argument)
STORE S2,.MSTYP(S1),MS.TYP ;Fill in message type
NXTWTO ;Try for next parameter
;Action routine for building the message type line
WTPTYP: MOVEI S1,.WTTYP ;Get code for type block
JRST IWTX.1 ;And do the $TEXT
;Action routine for building the text block
WTPTXT: MOVEI S1,.WTTXT ;Get code for text block
IWTX.1: MOVE S2,MSGADR ;Get addr of message
STORE S1,ARG.HD(S2),AR.TYP ;Save the block type
ADD S2,[POINT 7,ARG.DA] ;CREATE A BYTE PTR TO THE DATA AREA.
MOVEM S2,BYTPTR ;AND SAVE IT.
SETZM BYTCNT ;Clear the # bytes put into message
DMOVE S1,S1%S2 ;Get back to caller's context
MOVE TF,STF ;And get caller's TF
$TEXT (IWTODP,<^I/@THSPRM/^0>) ;Fill in the text
MOVE S1,BYTCNT ;Get # chars moved
IDIVI S1,5 ;Convert to words
SKIPE S2 ;Any remainder?
AOS S1 ;Yes, take another word
ADDI S1,ARG.DA ;Account for arg header block
;Fall thru to add variable block
;Here to add a block whose length is in S1 to the message
IWTO.A: MOVE S2,MSGADR ;Get back start of arg block
STORE S1,ARG.HD(S2),AR.LEN ;Set length of block
ADDM S1,MSGADR ;Next block goes farther down
MOVE S2,WTOSAB+SAB.MS ;Get addr of entire message
AOS .OARGC(S2) ;Indicate another arg block is here
PUSH P,T1 ;Save a reg for a second
LOAD T1,.MSTYP(S2),MS.CNT ;Get old length of message
ADDI T1,(S1) ;Account for this block
STORE T1,.MSTYP(S2),MS.CNT ;Update message length
POP P,T1 ;Restore scratch reg
NXTWTO ;Continue scanning the WTO blocks
;Action routine for setting the header flags .MSFLG
WTPMFL: DMOVE S1,S1%S2 ;Get back to caller's context
MOVE TF,STF ;And get caller's TF
MOVE S1,@THSPRM ;Get arg word passed
WTPMF1: MOVE S2,WTOSAB+SAB.MS ;And aim at message again
IORM S1,.MSFLG(S2) ;Store the flags
NXTWTO ;Continue
;Action routine for setting the message flags
WTPFLG: DMOVE S1,S1%S2 ;Get back to caller's context
MOVE TF,STF ;And get caller's TF
MOVE S1,@THSPRM ;Get arg word passed
WTPFL1: MOVE S2,WTOSAB+SAB.MS ;And aim at message again
IORM S1,.OFLAG(S2) ;Store the flags
NXTWTO ;Continue
;Action routine for filling in the ack code
WTPACK: DMOVE S1,S1%S2 ;Get back to caller's context
MOVE TF,STF ;And get caller's TF
MOVE S1,@THSPRM ;Get the users ack code
MOVE S2,WTOSAB+SAB.MS ;Aim at message again
STORE S1,.MSCOD(S2) ;Stuff it in
NXTWTO ;Continue
;Action routine for adding the Object block
WTPOBJ: DMOVE S1,S1%S2 ;Get back to caller's context
MOVE TF,STF ;And get caller's TF
HRLI TF,@THSPRM ;Get start adrs of users obj block
MOVE S1,MSGADR ;Get start of next block
MOVX S2,.WTOBJ ;Get block type
STORE S2,ARG.HD(S1),AR.TYP ;Save in block header
MOVEI S1,ARG.DA(S1) ;Point to the block data
HRR TF,S1 ;Set dest. for BLT to data area
ADDI S1,OBJ.SZ-1 ;Compute terminating adrs for BLT
HRRZM S1,WTOBLT ;Save in memory (not in an AC)
DMOVE S1,S1%S2 ;Get back to caller's context
BLT TF,@WTOBLT ;Move in the Obj block
MOVEI S1,OBJ.SZ+ARG.DA ;Get size of space added
PJRST IWTO.A ;Update the message
; IWTODP - $TEXT ACTION ROUTINE TO BUILD THE ACK, WTO, & WTOR.
;THIS ROUTINE IS THE ACTION ROUTINE FOR $TEXT. IT BUILDS THE
;MESSAGE BLOCKS.
IWTODP: IDPB S1,BYTPTR ;SAVE THE BYTE IN THE MSG.
AOS BYTCNT ;BUMP BYTE COUNT
$RETT ;RETURN QUICK !!
SUBTTL WTPACD, WTOOCD ACTION ROUTINES
WTPOCD: SKIPA S2,[EXP .WTOCD] ;OBJECT TYPE BLOCK
WTPACD: MOVEI S2,.WTACD ;APPLICATION CODE BLOCK
JRST WTPN.1 ;USE THE COMMON ROUTINE
SUBTTL MORE WTO ACTION ROUTINES
WTPJBN: SKIPA S2,[EXP .WTJOB] ;Get block type - JOB
WTPNOD: MOVX S2,.WTDES ;Get block type - DEST NODE
WTPN.1: MOVE S1,MSGADR ;Get first free in message
STORE S2,ARG.HD(S1),AR.TYP ;Save either block type
DMOVE S1,S1%S2 ;Get back to caller's context
MOVE TF,STF ;Get back reg 0, too.
MOVE S2,@THSPRM ;Get job # or SIXBIT node name
MOVE S1,MSGADR ;Get first free in message
STORE S2,ARG.DA(S1) ;Save in block
MOVEI S1,ARG.DA+1 ;Get length of block (Hdr + 1 data)
PJRST IWTO.A ;Update message length, arg counts
I%SOPR: MOVEM S1,WTOSAB+SAB.MS ;SAVE THE PAGE ADDRESS IN THE SAB.
I%WT.3: STKVAR <<PAGEF>> ;PAGE/PACKET WTO FLAG
MOVEI S1,PAGSIZ ;GET SIZE OF MESSAGE
MOVEM S1,WTOSAB+SAB.LN ;SAVE IN LENGTH WORD OF WTOSAB
SETZM PAGEF ;CLEAR PACKET MODE FLAG WORD
MOVE S1,WTOSAB+SAB.MS ;GET THE MESSAGE ADDRESS
LOAD S1,.MSTYP(S1),MS.CNT ;GET THE MESSAGE LENGTH
CAMLE S1,MAXPAK## ;CAN WE SEND IT AS A PACKET ???
JRST I%WT.4 ;NO,,SEND IT AS A PAGE
MOVEM S1,WTOSAB+SAB.LN ;YES,,SAVE THE MSG LENGTH IN THE SAB
SETOM PAGEF ;SET THE PACKET MODE IPCF FLAG
I%WT.4: MOVEI S1,SAB.SZ ;PICK UP THE SAB SIZE.
MOVEI S2,WTOSAB ;PICK UP THE SAB ADDRESS.
PUSHJ P,C%SEND ;SEND THE WTO.
JUMPT [SKIPN PAGEF ;MSG WAS SENT OK,,WAS IT A PACKET ??
$RETT ;NO,,THEN JUST RETURN
MOVE S1,WTOSAB+SAB.MS ;YES,,GET THE MESSAGE ADDRESS
PJRST M%RPAG ] ;RETURN THE PAGE AND EXIT
SKIPE RSEFLG ;SEND FAILED,,DO WE RETURN ??
JRST [MOVE S1,WTOSAB+SAB.MS ;YES,,GET THE MESSAGE ADDRESS
PUSHJ P,M%RPAG ;RETURN THE PAGE
$RETF ] ;AND RETURN
CAIE S1,ERRQF$ ;NO -- IS IT RECIEVE OR
CAIN S1,ERSQF$ ; SEND QUOTA ERROR ???
JRST I%WT.4 ;YES -- RETRY
CAIE S1,ERNSP$ ;IS IT NO SUCH PID
CAIN S1,ERSLE$ ;OR SYSTEM LIMITS EXCEEDED?
JRST I%WT.4 ;YES -- RETRY
$FATAL (Send to ORION failed) ;DIE !!
INT%L: ;LABEL THE LITERAL POOL.
LSTOF.
LIT
LSTON.
CEND=:.-1 ;LABEL LAST OTS LOCATION
END