Trailing-Edge
-
PDP-10 Archives
-
BB-LW55A-BM_1988
-
galaxy-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 Preliminaries
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1975, 1988.
; 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 THAT 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
EXTERNAL GLXVRS
INTMAN==:0 ;Maintenance edit number
INTDEV==:133 ;Development edit number
VERSIN (INT) ;Generate edit number
Subttl Table of Contents
; Table of Contents for GLXINT
;
; Section Page
;
;
; 1. Revision History . . . . . . . . . . . . . . . . . . . 3
; 2. Entry Points Found in GLXINT . . . . . . . . . . . . . 4
; 3. Local Definitions . . . . . . . . . . . . . . . . . . 5
; 4. Module Storage . . . . . . . . . . . . . . . . . . . . 6
; 5. I%INIT - Continue Library Initialization . . . . . . . 7
; 6. Detach from FRCLIN . . . . . . . . . . . . . . . . . . 9
; 7. SETTRP - Setup for APR Trapping . . . . . . . . . . . 10
; 8. IINIT - Initialize the interrupt system data base . . 12
; 9. I%IOFF-I%ION - Turn interrupt system off and on . . . 13
; 10. Processor for each interrupt level . . . . . . . . . . 14
; 11. I%EXIT - Exit from the program . . . . . . . . . . . . 15
; 12. I%NOW - Get time of day . . . . . . . . . . . . . . . 16
; 13. I%SLP - Dismiss the program for a while . . . . . . . 17
; 14. I%TIMR Timer queue manipulation routines . . . . . . . 18
; 15. I%HOST - Get Host Name/Number of Central Site . . . . 22
; 16. I%JINF - Canonical Job Information . . . . . . . . . . 23
; 17. I%JINF ROUTINES FOR THE -10 . . . . . . . . . . . . . 24
; 18. I%JINF SPECIAL ROUTINES FOR THE -20 . . . . . . . . . 25
; 19. WTPACD, WTOOCD ACTION ROUTINES . . . . . . . . . . . . 28
SUBTTL Revision History
COMMENT \
105 Remove I%RLIM as it won't be needed with the new PFH.
***** Release 4.2 -- begin maintenance edits *****
***** Release 5.0 -- begin development edits *****
110 5.1002 28-Dec-82
Move to new development area. Clean up edit organization.
111 5.1063 30-Nov-83
Rearrange default table for the IB. Add default for new bit IB.SYS.
Based on IB.SYS and DB.SYS in debug word, set/don't set process as
system process in the initialization code.
112 5.1074 31-Jan-84
Return with S1 containing the version of the library.
113 5.1094 13-Feb-84
Correct edit 112 so that S1 contains the version of the library and not
the contents of the memory location whose value equals that of the
version number.
114 5.1133 9-APR-84
Define GLXVRS as external.
115 5.1148 21-Jun-84
Fix bug in testing code which accidently causes private world processes
to hog too much of the system.
116 5.1200 6-Feb-85
Set bit IB.NAC to zero which causes GTJFNs to be called without setting
bit GJ%ACC.
***** Release 5.0 -- begin maintenance edits *****
120 Increment maintenance edit level for version 5 of GALAXY.
***** Release 6.0 -- begin development edits *****
130 6.1021 19-Oct-87
Change routine WTPOBJ to process remote LPT name blocks as part of
its processing of object blocks.
131 6.1096 21-Nov-87
Add routine WTPNHD which processes the remote node name block for
the $QACK and $QWTO macros.
132 6.1108 1-Dec-87
Change WTPNHD to correctly store the message length.
133 6.1225 8-Mar-88
Update copyright notice.
\ ;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
; S1/ VERSION OF THE LIBRARY
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.OUT,FWMASK,T%TTY ;;$TEXT OUTPUT ROUTINE
XX IB.FLG,IT.OCT,0 ;;OPEN TERMINAL FOR S%CMND
XX IB.FLG,IP.STP,0 ;;ORION GETS STOP CODES FLAG
XX IB.FLG,IB.DPM,0 ;;USE JOB NUMBER AS PID
XX IB.FLG,IB.NPF,0 ;;DON'T SET UP GLXPFH
XX IB.FLG,IB.SYS,0 ;;Don't set up as a system process
XX IB.FLG,IB.NAC,0 ;;Don't normally restrict access to JFNs
XX IB.INT,FWMASK,0 ;;INTERRUPT VECTORS
XX IB.PIB,FWMASK,0 ;;PID block address
XX IB.ERR,FWMASK,0 ;;USER $TEXT ERROR EXIT ROUTINE
XX IB.PRG,FWMASK,'NONAME' ;;PROGRAM NAME
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
; Here to decide if to set system process
LOAD S1,IIB+IB.FLG,IB.SYS ;Get the bit to indicate system process
JUMPE S1,INIT.2 ;If not set, nothing else to do
SKIPN DEBUGW ;Are we debugging?
JRST INIT.1 ;No, go set system process
LOAD S1,DEBUGW,DB.SYS ;Get the system process override bit
JUMPE S1,INIT.2 ;If not set, do not set sys. proc.
; Here to set system process
INIT.1: SETZ S2, ;Clear "priority word"
TXO S2,JP%SYS ;Set system process bit
MOVEI S1,.FHSLF ;For ourselves
SPRIW ;And do it
ERCAL [$WARN (<Failed to set as a system process>)
$RET]
INIT.2: 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
MOVE S1,[GLXVRS] ;RETURN WITH LIBRARY VERSION
$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 remote node name block
WTPNHD: MOVE S1,@THSPRM ;[131]Pick up node name
MOVE S2,MSGADR ;[131]Pick up the block address
MOVEM S1,ARG.DA(S2) ;[131]Store the node name
MOVEI S1,2 ;[131]Pick up the block length
ADDM S1,MSGADR ;[131]Point to the next block
MOVSS S1 ;[131]Move block length to LH
PUSH P,S1 ;[131]Save for total message length
HRRI S1,.WTNHD ;[131]Pick up the block type
MOVEM S1,ARG.HD(S2) ;[131]Store in the message
MOVE S2,WTOSAB+SAB.MS ;[131]Pick up the message address
AOS .OARGC(S2) ;[131]Increment the argument count
POP P,S1 ;[131]Pick up the block length
ADDM S1,.MSTYP(S2) ;[132]Add to message length
NXTWTO ;[131]Continue scanning the WTO blocks
;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
HRRZ S2,THSPRM ;[6000]Pick up block address
MOVE TF,OBJ.TY(S2) ;[6000]Pick up object type
TXNN TF,.DQLPT ;[6000]Is this a DQS LPT?
TXNE TF,.LALPT ;[6000]No, is it a LAT LPT?
SKIPA ;[6000]Yes, update the block code
PJRST IWTO.A ;[6000]No, Update the message
WTPO.1: $CALL FINOBB ;[6000]Finish building object block
ADDI S2,OBJ.SZ ;[6000]Point to the name block
MOVE S1,MSGADR ;[6000]Point to current message block
MOVE TF,S1 ;[6000]Save as destination address
HRLI TF,ARG.HD(S2) ;[6000]Pick up the source address
LOAD S2,ARG.HD(S2),AR.LEN ;[6000]Pick up the block length
ADD S1,S2 ;[6000]Add to start of destination adr
BLT TF,-1(S1) ;[6000]Copy over block
$CALL CHNTYP ;[6000]Change to WTO block code
MOVE S1,S2 ;[6000]Pick up block length
PJRST IWTO.A ;[6000]Finish up the message
FINOBB: PUSH P,T1 ;[6000]Save a reg for a second
MOVE T1,MSGADR ;[6000]Get back start of arg block
STORE S1,ARG.HD(T1),AR.LEN ;[6000]Set length of block
ADDM S1,MSGADR ;[6000]Next block goes farther down
MOVE T1,WTOSAB+SAB.MS ;[6000]Get addr of entire message
AOS .OARGC(T1) ;[6000]Indicate another arg block is here
LOAD TF,.MSTYP(T1),MS.CNT ;[6000]Get old length of message
ADDI TF,(S1) ;[6000]Account for this block
STORE TF,.MSTYP(T1),MS.CNT ;[6000]Update message length
POP P,T1 ;[6000]Restore scratch reg
$RET
CHNTYP: $SAVE <P1> ;[6000]Save this AC
HRRZ S1,THSPRM ;[6000]Pick up object block address
MOVE P1,OBJ.TY(S1) ;[6000]Pick up object type
TXNE P1,.DQLPT ;[6000]Is this a DQS LPT?
JRST CHNT.1 ;[6000]Yes, go pick up its code
MOVEI P1,OBJ.SZ(S1) ;[6000]Point to name block
LOAD P1,ARG.HD(P1),AR.TYP ;[6000]Pick up the type of name
MOVEI S1,.WTPOR ;[6000]Assume it is a PORT
CAIE P1,.KYPOR ;[6000]Is it?
MOVEI S1,.WTSER ;[6000]No, it is a SERVICE name
SKIPA ;[6000]Skip over the DQS code
CHNT.1: MOVEI S1,.WTDQS ;[6000]Pick up the DQS code
MOVE P1,MSGADR ;[6000]Pick up address of block to change
STORE S1,ARG.HD(P1),AR.TYP ;[6000]Update its WTO block code
$RET ;[6000]Return
; 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