Trailing-Edge
-
PDP-10 Archives
-
AP-D471B-SB_1978
-
kernel.mac
Click kernel.mac to
see without markup as text/plain
There are no other files named kernel.mac in the archive.
UNIVERSAL KERNEL - MESSAGE CONTROL PROGRAM UNIVERSAL PARAMETER FILE
SUBTTL D.TODD/DRT/CEW/AAG/CDO/ILG 1 JUNE 1977
SALL
;***COPYRIGHT (C) 1974,1975,1976,1977 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.***
SEARCH MACTEN,UUOSYM ; LOAD THE UNIVERSALS WE NEED
; SET UP VERSION NUMBER FOR KERNEL AND MCS SYSTEM
MCSVER==2 ;MAJOR VERSION
MCSEDT==234 ;EDIT NUMBER
MCSMIN==0 ;MINOR VERSION NUMBER
MCSWHO==0 ;LAST CHANGED BY
LOC 137 ; LOCATE TO .JBVER
VRSN. (MCS) ; FORMAT THE VERSION NUMBER
RELOC ; BACK TO RELOCATABLE CODE
LSTFLG==0
DEFINE LSTOFF<
IFE LSTFLG,<XLIST>
LSTFLG==LSTFLG+1 > ; END OF LSTOFF
DEFINE LSTON<
LSTFLG==LSTFLG-1
IFE LSTFLG,<LIST>> ; END OF LSTON
;** REVISION HISTORY
;
;EDIT SPR/QAR EXPLANATION
;---- ------- -----------
;100 SET UP VERSION NUMBER [KERNEL,ALL]
;101 Q00225 MAKE KILL JSN /ALL DO THE RIGHT THING. [KRNOPR]
;102 Q00199 DISPLAY CURRENT ALT <NONE> INSTEAD OF BLANK [DISPAK]
;103 Q00122 CHANGE FROM FATAL ERROR IF FAILSOFT FILE IS NOT THERE
;104 WORD COUNTS NOT CORRECT IN BLDCNK. [KRNMSG]
; LOTS OF INSTANCES WHEN CORE IS NOT RETURNED. [KRNOPR]
;105 Q00237 TSCORE NOT CORRECT ON RESTART. [MCSONC]
;106 MULTIPLE PAT BLOCKS DON'T WORK. [KRNQUE,KRNONC]
;107 LOTS OF FAILSOFT/ROLLOUT/DEFER MESSAGE FIXES. [DEVSER]
;110 MORE ONCE ONLY CHANGES. [MCSONC]
; TSCORE THROWN OFF BY ROLLING. [MSGIN,UTIL]
;111 Q????? NO TEXT FROM MPP CONFUSED US BADLY. [SENDM]
;112 ADD ASSEMBLY PARAMETER FOR MAX RDX DEVICES CONNECTED.
; RANGE OF MAXRDX = 1 TO 4096 WITH DEFAULT = 20
;113 WITH A LITTLE BIT OF SMARTS, RIP OUT MOST OF THE SCHEDULER. [KRNSCH]
;114 MAKE DEFERRED MULT-DESTINATION SENDS WORK
;115 CLEAN UP TRANSACTIONS AFTER AN MPP IS KILLED
;116 CLEAN UP TYPEOUT FOR WHAT TERM
;117 Q00418 RE-QUEUE MESSAGES CORRECTLY FOR KILLED MPP
;120 Q00421 FIX ADDRESS CHECK IF JOURNAL FILE SWITCHED TO ALT.
;121 ADD FACILITY FOR MPP TO SEND MESSAGE TO OPR WITH QUOTE IN OUTPUT
;122 CLOSE INPUT SIDE OF OPR TERMINAL ON EOF (^Z)
;123 PUT OPRFLG FLAGS IN UNV FILE. REDO MONITOR JSN LOGIC
;124 ADD MORE COMPREHENSIVE FILE IO ERROR MESSAGES
;125 EDIT 115 BROKE KMCS-KILL LOGIC
;126 SENDS TO LEAF W/EMI CONFUSED SENDM
;127 ALLOW LEAF QUOTAS TO BE 0. [KRNOPR,MCSOPR,UTIL]
;130 FIX LOOP IN STORENEXTMH [DEVSER]
;131 IMPLEMENT WARNINGS FOR CORE FULL
;132 IMPLEMENT WARNINGS FOR F/R FILE FULL
;133 ADD WHAT QFILE,WHAT CORE, WHAT RESOURCES
;134 ADD REMEDIAL CODE FOR CORE,QUEUE FILE FULL
;135 CATCH ATTEMPTS TO RESTART MCS FROM MONITOR MODE
;136 PREVENT ERROR CODE 13 (NO ROOM) ON IPCF RECEIVE
;137 FIX BUG IN SWITCH MPP TO ALTERNATE COMMAND
;140 CHANGE SCHEDULING ALGORITHM TO BE ROUND-ROBIN
;141 MORE OF EDIT 135
;142 CLEAN UP OPR COMMAND SCANNER A LITTLE
;143 BAD CORE ALLOCATION WITH MULTIPLE/MULTI-SEGMENT MESSAGES
;144 COMPUTE FREE SPACE DYNAMICALLY, USING SPACE BETWEEN SEGMENTS
;145 TURN ON JBOPR$ WHEN MPP STARTED VIA "RUN"
;146 PUT THE STACK BACK IN THE MAIN PROGRAM
;147 REMOVE SPECIAL IPCF PAGE ALLOCATION LOGIC
;150 ADD WHAT IPCF TO WHAT COMMANDS
;151 REMOVE SOME SUPERFLOUS CODE, FIX KMPP RECURSION
;152 ADD ROUTINE TO EXTEND F/R FILE WHEN IT FILLS UP
;153 ADD QUERY ABILITY TO OPR COMMANDS USING $DISPATCH
;154 REMOVE EXTRA CODE, ADD "HELP" COMMAND, GENERAL CLEANUP
;155 REDO MOST OF MSGOUT MODULE
;156 RE-WORK MPP LOG FILE FORMAT
;157 UTILIZE THE SPACE BEYOND THE HIGHSEG FOR FREE CORE
;160 IMMORTAL MPP'S GOT BROKEN SOMEWHERE ALONG THE LINE
;161 MCSGEN OUTPUTS MPP CORE IN "P", KERNEL USES "WORDS", FIX THE KERNEL
;162 INVENT A NEW PROCESS TO RUN, THE ROLLER, TO EMPTY CORE AS IT CAN
;163 FINAL PASS ON COMMAND SCANNER, ADD $SAYRET MACRO
;164 FIX PAUSEN DEFINITION, ADD VERSION CHECK ON CONFIG FILE
;165 USE "RECOVR" TO CLEAN UP REGULAR MPPS AS WELL AS DEBUGGING ONES
;166 ATTEMPT RECOVERY ON IPCF ERRORS
;167 MOVE FLAGS TO JB$MLF, REMOVE JB$STS TABLE
;170 CHANGE THE KERNEL'S ENTRY AND EXIT SEQUENCES FOR BLISS
;171 REMOVE LOGIC FOR JOURNAL/LOG FILES 0 WHEN JOURN/LOG ON
;172 ADD SET CHECKPOINT/NOCHECKPOINT COMMAND
;173 RE-WORK ENTIRE LOGIC FOR NEW FREE PORTS, REMOVE MBM/CONV/TID STUFF
;174 ADD EXTENDED ERROR MESSAGES TO THE LCM, TO THE TERMINAL USER
;175 REMOVE MAXCHAR/MAXSEG/MAXMSG THINGS, RE-WORK MSGIN,SENDM
;176 ADD MONITOR SON,SOFF COMMANDS
;177 ADD RESETTERMINAL ROUTINE TO UTIL.BLI
;200 ADD FIXTERM SO SIGNOFF CAN RESET TERMINAL FLAGS
;201 FIRST PART OF PHONE AND NODE RECOVERY CODE
;202 ADD INTERRUPTS FOR DEVICE OFF-LINE,ATTACHED OR CARRIER LOST
;203 HIBERNATE ON HB.RTL AND WAKE OCCASIONALLY FOR OPSER & MONITOR
;204 ADD $GW MACRO, BETTER ILLEGAL NODE MESSAGES.... ETC.
;205 RESERVE AN EXTRA IPCF PAGE FOR JUNK COMING IN
;206 CATCH TOO MANY JSNS FOR HIGH SEGMENT SIZE
;207 REMOVE THE HALTS, ADD $STPCD MACRO
;210 SET EOL ON ALL BREAK CHARACTERS,NOT JUST LF
;211 DO NOT FOUL UP FLAGS IF LOG/JRN FILES ALTERED
;212 ADD DMPP COMMAND TO MAKE MCS MORE SECURE
;213 GIVE ERROR MSG TO MPP TRYING TO ATTATCH IF DMPP OFF
;214 SYSTEM NAME TO PERMANENT PORTS ON CONNECT
;215 DO UNCONDITIONAL DISCONNECT ON PORTS,TO RECOVER BUFFERS
;216 ADD GREET COMMAND
;217 ADD NEW $SCHED MACRO
;220 RE-FORMAT THE CONNECT COMMAND
;221 USE NETWORK TOPOLOGY CHANGE INTERRUPT
;222 MORE OF 220 & 221
;223 RE-WORK KRNMSG, OPERATOR SEND COMMAND
;224 ADD SOME MORE STOP CODE INFORMATION
;225 UPDATE GREET STUFF FOR NEW NODE. FUNCTION
;226 ENSURE A BUFFER IS AROUND BEFORE INITIATING OUTPUT
;227 MORE OF 226
;230 INCLUDE CODE FOR MINIMUM NUMBER OF COPIES OF AN MPP
;231 HANDLE EOF ON MPX INPUT ( REQUIRED MCO TO 6.03 )
;232 RE-INVENT OUTPUT CHAIN THAT WAS REMOVED DURING EDIT 155
;233 MAXRDX (EDIT 112) REALLY OUGHT TO BE BIGGER, DEFAULT=100
;234 MCS-10 VERSION 2 RELEASED JUNE 1, 1977
;** END OF REVISION HISTORY
;MEMORY ALLOCATION CONSTANTS
PAGSIZ==^D512 ;NUMBER OF WORDS IN A KI-10 PAGE
PAGMAX==^D512 ;NUMBER OF PAGES ADDRESSABLE BY THE KI-10
MEMSIZ==<PAGMAX*PAGSIZ>-1;NUMBER OF WORDS ADDRESSABLE BY THE KI-10
P2WLSH==11 ;CONVERT PAGES TO WORDS
W2PLSH==-11 ;CONVERT WORDS TO PAGES
;SYSTEM PARAMETERS THAT MAY BE CHANGED
ND MAXRDX,^D100 ;DEFAULT NUMBER OF RDX DEVICES SUPPORTED
IFLE MAXRDX,<MAXRDX==1> ;CANNOT BE ZERO
IFG MAXRDX-^D4096,<MAXRDX==^D4096> ;NOR .GT. 4096.
ND PAGFRE,^D2 ;NUMBER OF PAGES LEFT AT TOP OF CORE FOR PFH
ND STKSIZ,^D512 ;NUMBER OF WORDS FOR THE STACK
ND FRECHK,4 ;NUMBER OF WORDS REPRESENTED BY EACH MAP BIT
;SMALLEST ABOUNT THAT CAN BE ALLOCATED
;MUST BE A POWER OF 2
IFN 1B<^L<FRECHK>>^!FRECHK,<
PRINTX ?MCPASM - FREE CORE CHUNK SIZE NOT A POWER OF 2
>
FRELSH==<^D36-^L<FRECHK>-1> ;GENERATE THE SHIFT CONSTANT
FRERND==FRECHK-1 ;AND THE ROUNDING FACTOR
; THE CORE FULL ALGORITHM USES FOUR VALUES TO SET UP ITS
; WARNING AND REMEDIAL ACTION CODE.
; FREHI1 - THIS IS A PERCENTAGE OF TOTAL CORE, WHICH WHEN USED UP
; INDICATES THAT A "FULL" CONDITION HAS OCCURED.
; FREAB1 - THIS IS AN ABSOLUTE AMOUNT OF CORE, WHICH IS THE SIZE OF
; THE RESERVED AMOUNT AT WHICH A "FULL" CONDITION OCCURS. THE
; SMALLER OF THE TWO RESERVES SPECIFIED BY FREHI1 AND FREAB1
; IS USED TO INDICATE THE "FULL" CONDITION.
; FREHI2 - THIS IS A PERCENTAGE OF TOTAL FREE CORE. HAVING GIVEN A
; WARNING ON A "FULL" CONDITION, IF THE AMOUNT OF FREE CORE
; IN USE DROPS BELOW FREHI2 % AND THEN BACK ABOVE EITHER
; FREHI1 OR FREAB1 ANOTHER WARNING IS ISSUED. THIS PREVENTS
; TOO MANY ERROR MESSAGES BEING GIVEN THE OPERATOR AS THE
; FREE CORE LEVEL HOVERS AROUND THE "FULL" LEVEL.
; FREAB2 - THIS IS AN ABSOLUTE AMOUNT OF CORE, WHICH SPECIFIES A
; RESERVE LEVEL. THE SMALLER OF THE TWO AMOUNTS SPECIFIED
; BY FREHI2 AND FREAB2 IS USED TO SET UP THE ACTUAL AMOUNT.
ND FREHI1,^D90 ;PERCENTAGE WHICH INDICATES FULL
IFG FREHI1-^D100,<FREHI1==^D100> ;CANT BE MORE THAN 100%
ND FREAB1,^D1000 ;ABSOLUTE AMOUNT WHICH SAYS "FULL"
ND FREHI2,^D70 ;LOWER LIMIT AT WHICH WE CLEAR
;WARNING MESSAGE GIVEN FLAG SO THAT
;IF WE GO ABOVE FREHI1 OR FREAB1, MSG
;ISSUED AGAIN
IFGE FREHI2-FREHI1,< FREHI2==FREHI1-^D10>
ND FREAB2,^D1500 ;ABSOLUTE AMOUNT
ND SLPTIM,^D20 ;NUMBER OF SECONDS TO SLEEP
WAKCOD=<HB.RTL+SLPTIM*^D1000> ;CODE TO USE FOR HIBER
; "HB.RTL" IS FOR OPSER
SUBTTL MEMORY ALLOCATION PICTURE
COMMENT %
The following is the layout of virtual memory once the MCP
has gone through the once only code. All 256 K of virtual
memory are used. The first step is to examine all pages of
addressable memory and see which pages are free and which are
already in use at load time. A bit map of all pages is created,
from which we allocate the different areas.
TNEMMOC %
; MCS ADDRESS SPACE ALLOCATION
; === ======= ===== ==========
; !=======================================================!
;LOC 20: ! JOBDAT !
; !-------------------------------------------------------!
;LOC 140: ! KERNEL ABSOLUTE DATA BASE !
; ! PSI VECTORS,STACK,BUFFERS ETC.. !
; !-------------------------------------------------------!
; ! KERNEL LOW SEGMENT (IMPURE) CODE !
; ! AND RELOCATABLE DATA AREA !
; !-------------------------------------------------------!
;C(.JBFF): ! BIT MAP REPRESENTING MCS FREE CORE REGION "B" !
;RH(C$BPTR): \ ONE BIT PER "FRECHK" WORDS \
; !-------------------------------------------------------!
;C(C$BASE): ! MCS FREE CORE REGION "B" !
; \ ALLOCATED IN "ONCE" VIA PAGE. UUO \
; \ \
; !-------------------------------------------------------!
;C(.JBHGA): ! !
; ! MCS KERNEL AND BLISS !
; ! HIGH SEGMENT (PURE) CODE !
; ! !
; !-------------------------------------------------------!
;C(.JBHRL)+1: ! BIT MAP REPRESENTING MCS FREE CORE REGION "A" !
;RH(C$APTR): \ ONE BIT PER "FRECHK" WORDS \
; !-------------------------------------------------------!
;C(C$ABASE): ! MCS FREE CORE REGION "A" !
; \ ALLOCATED IN "ONCE" VIA PAGE. UUO \
; \ \
; !-------------------------------------------------------!
;777777 -( ! IPCF FREE PAGE POOL !
; PAGFRE+MAXJSN \ ONE PAGE PER JOB SLOT NUMBER \
; +1 PAGES) \ PLUS ONE FOR MISC. PAGE RECEPTION \
; !-------------------------------------------------------!
;777777 - ! RESERVED AREA FOR PFH AND DDT !
; PAGFRE PAGES: ! !
; !=======================================================!
SUBTTL FLAGS USED BY THE KERNEL FOR JOB TABLE
;JB$MLF FLAGS ( *** NOTE: THESE MUST AGREE WITH DEFINITIONS IS DATA.BLI *** )
JBNOD$==:0,,-1 ;FIELD FOR NODE THAT STARTED THE MPP
JBEPI$==:1B17 ;EPI SEEN
JBIDL$==:1B16 ;MPP IS IDLE
JBKIL$==:1B15 ;KILL THIS MPP WHEN EPI SEEN
JBOPR$==:1B1 ;OPERATOR STARTED THIS MPP
JBIMM$==:1B0 ;IMMORTAL MPP FLAG
;MP$HPQ BITS FROM MCSGEN
MPTMP$==:1B18 ;TEMPORARY MPP ( USED TO BE "LOCK" IN CORE)
MPLOC$==:1B19 ;LOCAL MPP (MPR)
MPIMM$==:1B20 ;AN IMMORTAL MPP
;PSTATUS BITS RETURNED IN VREG TO THE BLISS ROUTINE QPSTS
LOSTCARRIER==1 ;LOST CARRIER ON THE LINE
LOSTDEVICE==2 ;LOST DEVICE ON THIS LINE
SUBTTL QUE FILE PARAMETERS
; FOLLOWING LETTER DEFINATIONS WILL APPLY
; P PARTICAL
; D BSK BLOCK
; W WORDS
; A ALLOCATION BLOCK (PAT)
; B BITS
QU$WD==^D128 ;WORDS PER DISK BLOCK
QU$WP==^D32 ;WORDS PER PARTICAL
QU$PD==QU$WD/QU$WP ;PARTICALS PER DISK BLOCK
QU$BA==QU$WD*^D36 ;PARTICALS PER ALLOCATION
QU$DA==QU$BA/QU$PD ;DISK BLOCKS PER ALLOCATION
QU$WA==QU$DA*QU$WD ;WORDS PER ALLOCATION
QU$FUL==^D100 ;NR OF PARTICLES IN RESERVE TO TAKE REMEDIAL ACTION AT
QU$FLL==^D150 ;NR OF PARTICLES IN RESERVE AT WHICH TO CLEAR
;"MESSAGE GIVEN" FLAG SO THAT IF WE GO ABOVE
;THE QU$FUL LIMIT ANOTHER WARNING IS GIVEN
SUBTTL I/O SYSTEM MACROS
DEFINE $CBUFF(LABEL,SIZE,NUMBER,FLAG)<
LSTOFF
LABEL=:.+1 ;DEFINE THE LABEL ADDRESS
REPEAT NUMBER-1,<
Z ;;I/O FLAGS
<<SIZE+1>B17>_-^D18,,.+SIZE+3
XWD 0,SIZE
BLOCK SIZE>
Z ;;IO FLAGS
IFE FLAG,< <<SIZE+1>B17>_-^D18,,LABEL>
IFN FLAG,< <<SIZE+1>B17>_-^D18,,0>
XWD 0,SIZE
BLOCK SIZE
LSTON
>;END OF $CBUFF
;MCP KERNEL- ACCUMULATOR DEFINITIONS
T0=0 ;USED BY MCPKRN AS OPERATOR FLAG REGISTER
;BUT CALLED OPRFLG INSTEAD OF T0.
OPRFLG=T0
; ;T1,T2,T3,T4 ARE NEVER SAVED ON A CALL FROM BLISS-10
;THESE AC'S ARE SAVED BY BLISS IF NEEDED.
T1=T0+1 ;TEMP AC 1
T2=T1+1 ;TEMP AC 2
T3=T2+1 ;TEMP AC 3
T4=T3+1 ;TEMP AC 4
; REGISTERS AVAILABLE ONLY TO THE SCHEDULER
SCH1=5 ;SCHEDULER AC 1
SCH2=6 ;SCHEDULER AC 2
SCH3=7 ;SCHEDULER AC 3
SCH4=10 ;SCHEDULER AC 4
;ACS P1,P2,P3,P4 ARE NEVER USED BY THE BLISS=10
;COMPILER (THEY ARE GLOBAL AC'S USED BY MCP AS
;ARGUMENTS TO SUBROUTINES ETC.
P1=11 ;RESERVED AC 11
P2=P1+1 ;RESERVED AC 12
P3=P2+1 ;RESERVED AC 13
P4=P3+1 ;RESERVED AC 14
J==15 ;CONTAINS THE PSEUDO JOB SLOT NUMBER
;TIMESHARED WITH THE VALUE RETURN REGISTER ($V)
P=17 ;SYSTEM WIDE STACK POINTER
;MCP BLISS-10 ACCUMULATOR DEFINITIONS
;AC 1,2,3,4 ;NON-SAVABLE REGISTERS
;AC 5,6,7,10 ;DREG SAVABLE REGISTERS USED BY BLISS-10
;WHENEVER "REGISTER" DECLARATION IS USED
;CORRESPOND TO SCH1 THRU SCH4
$V==15 ;VALUE RETURN REGISTER
$F==16 ;STACK FRAME POINTER
$S==P ;STACK FRAME POINTER
;END OF MCS AC DEFINITIONS
SUBTTL AC OPRFLG (FLAG REGISTER) BIT DEFINITIONS
DEFINE $BIT($A)<
..Z==..Z*2
$A==..Z/2>
..Z==1 ;BIT ALLOCATION MACRO
$BIT(CMDSTR) ;MCS ALREADY STARTED
$BIT(CMDMCS) ;PAUSE MCS IN PROGRESS
$BIT(CMDNET) ;PAUSE NET IN PROGRESS
CMDBOT==CMDNET+CMDMCS ;PAUSE ALL IN PROGRESS
$BIT(CMDKIL) ;KMCS IN PROGRESS
$BIT(CMDDEB) ;IF ON, DEBUGGING MPPS CAN SIGN ON
$BIT(CMDNOI) ;NO INITIAL MPPS ON START/RESTART
$BIT(CMDRES) ;RESTART WAS NOT ISSUED (1=RESTART,0=START)
$BIT(CMDJOR) ;A JOURNAL FILE IS OPEN
$BIT(CMDLOG) ;AN MPP LOG FILE IS OPEN
$BIT(CMDRUN) ;OPR "RUN" COMMAND IN PROGRESS
$BIT(CMDOTO) ;OPERATOR TERMINAL HAS BEEN OPENED
$BIT(EOFLAG) ;END OF LINE ENCOUNTERED
$BIT(CORWRN) ;IF 0, GIVE A CORE WARNING
$BIT(QUEWRN) ;IF 0, GIVE A QUEUE FILE WARNING
$BIT(RCVALL) ;IF 1, HAVE "RECOVR" CHECK ALL PIDS
$BIT(RFRAD) ;IF 1, REFRESHER HAS BEEN CALLED
$BIT(KNORFR) ; "KMCS NOREFRESH" ISSUED
..Z==..Z/2 ;SHOW HIGHEST BIT IN USE
; LEFT HALF OF OPRFLG IS USED FOR THE JSN MONITORING.
; 1B0 INDICATES THAT WE ARE MONITORING SOME JSN OR ALL
; THE REST OF THE LEFT HALF OF OPRFLG IS THE JSN TO MONITOR.
; IF THE ENTIRE JSN FIELD IS 1, I.E. THE LEFT HALF OF OPRFLG
; IS ALL ONES, THEN WE ARE MONITORING "ALL" JSNS.
CMDMON==1B0 ;IF ON, MONITORING A JSN
CMDJSN==377777B17 ;JSN TO MONITOR, -1 FOR ALL
CMDALL==377777 ;PSEUDO-JSN, INDICATES MONITORING "ALL"
IFN CMDJSN&..Z,<PRINTX ?TOO MANY OPRFLG BITS IN USE >
SUBTTL FILE ERROR CODES AND MESSAGES
; THERE ARE TWO WORDS USED FOR REPORTING FILE IO ERRORS.
; THE FIRST IS "ERRCOD" WHICH IS SET VIA THE ERRSET MACRO
; TO BE THE INDEX INTO THE ERROR TABLE FOR THIS PARTICULAR ERROR.
; THE SECOND IS ERRAUX, WHICH CAN BE SET VIA ERRSET OR DIRECTLY.
; THIS SECOND WORD, WHICH IS ERROR-CONDITION DEPENDENT , IS USED
; TO PASS ADDITIONAL INFORMATION TO THE FILE ERROR PROCESSOR.
; TO SET UP THE ERROR MESSAGES, THE FOLLOWING MACRO IS USED.
; ARG 1: UP TO 3 LETTERS TO MAKE ERROR CODE (F%XXX) NAME
; ARG 2: ASCII MESSAGE, WHICH IS FIRST PART ( OR ALL) OF MESSAGE
; ARG 3: THE ADDRESS OF A ROUTINE, (IF ANY) TO CONTINUE THE ERROR MSG.
;
DEFINE FILERR($A,$B,$C)<
LSTOFF
X OPN,<OPEN failed for device >,ERROPN
X ENT,<ENTER failed >,ERRENT
X OUT,<OUTPUT failed >,ERROUT
X IN,<INPUT failed >,ERRIN
X EOF,<END-OF-FILE reached>
X LKP,<LOOKUP failed >,ERRLKP
X CDO,<DEVICE cannot do output: >,ERRCDO
X CDI,<DEVICE cannot do input: >,ERRCDI
X MDD,<Not a DIRECTORY device: >,ERRMDD
X COR,<Insufficient core available>
X MPX,<Multiplex channel could not be opened - MPX>,ERRMPX
LSTON
> ;END OF FILERR DEFINITION
; DEFINE THE VALUES FOR THE F%??? ERROR CODES.
..Z==0 ;START WITH ERROR #0
DEFINE X($A,$B,$C)<
F%'$A==..Z
..Z==..Z+1
> ; END OF X DEFINITION
FILERR
; LEAVE A SIMPLE WAY TO GENERATE THE TABLE IN KRNOPR
;
DEFINE ERRTB<
DEFINE X($A,$B,$C)<
..T==0
IFNB <$C>, <..T==$C>
XWD ..T,[ASCIZ \$B\] >
FILERR >
; THE ERRSET MACRO IS USED TO SET UP FOR THE ERROR CALL
; THE FIRST ARGUMENT IS THE REASON, THAT IS ONE OF THE
; ABOVE F%??? VALUES.
; THE SECOND ARGUMENT IS THE AC CONTAINING THE SPECIFIC CODE, ETC THAT YOU
; WANT TYPED OUT.
; BOTH ARGUMENTS MAY BE OMMITTED.
DEFINE ERRSET($A,$B)<
IFNB <$A>,<
PUSH P,[$A] ;;DONT USE ANY ACS
POP P,ERRCOD## ;;STORE THE REASON
>
IFNB <$B>,<
PUSH P,$B
POP P,ERRAUX##
>
> ;END OF ERRSET DEFINITION
SUBTTL LOOKUP/ENTER ERROR EXPANSIONS FOR FILE IO ERROR MODULE
; FOR EACH ERROR MESSAGE IN THE LOOKUP/ENTER CATEGORY, INCLUDE
; A MESSAGE HERE
; NOTE:: FOR NON-APPLICABLE CODES, INCLUDE A BLANK CALL
; TO PRESERVE THE ORDER OF THE TABLE
DEFINE LE<
LSTOFF
X (<File not found>) ;;0-FNF
X (<Non-existent UFD>) ;;1-IPP
X (<Protection failure>) ;;2-PRT
X (<File being modified>) ;;3-FBM
X (<FILENAME already exists>) ;;4-AEF
X (<Illegal sequence of UUOs>) ;;5-ISU
X (<Transmission error>) ;;6-TRM
X (<>) ;;7-NSF
X (<Not enough core>) ;;10-NEC
X (<Device not available>) ;;11-DNA
X (<No such device>) ;;12-NSD
X (<Illegal UUO>) ;;13-ILU
X (<No room or quota exceeded>) ;;14-NRM
X (<Device write-locked>) ;;15-WLK
X (<Not enough table space>) ;;16-NET
X (<Partial allocation only>) ;;17-POA
X (<Block not free>) ;;20-BNF
X (<>) ;;21-CSD
X (<>) ;;22-DNE
X (<SFD not found>) ;;23-SNF
X (<Search list empty>) ;;24-SLE
X (<SFD level too deep>) ;;25-LVL
X (<NOCREATE for all S/L>) ;;26-NCE
X (<>) ;;27-SNS
X (<Can't update file>) ;;30-FCU
X (<>) ;;31-LOH
X (<>) ;;32-NLI
LSTON
> ; END OF LE DEFINITION
; LEAVE AN EASY WAY TO GENERATE TABLE IN KRNOPR
;
DEFINE LEETB<
DEFINE X($A)<
IFB <$A>,<EXP [0]>
IFNB <$A>, < EXP [ASCIZ \ '$A\]>
> ; END OF X DEFINITION
LE
> ;END OF LEETB DEFINITION
SUBTTL MACROS USED FOR THE COMMON FUNCTIONS OF THE COMMAND SCANNER
; SEND TEXT TO OPERATOR TERMINAL AND RETURN TO NEXT INSTRUCTION.
; NOTE 1: "@" IN MESSAGE STRING MEANS <CR>-<LF>
; NOTE 2: THIS MACRO IS SKIPPABLE
DEFINE $SAY($A),<
IF2,<IFNDEF OSROPA,<EXTERNAL OSROPA>>
JSP T1,OSROPA
LSTOFF
JUMP [ASCIZ _$A_]
LSTON
> ; END OF $SAY DEFINITION
; $SAYRET - SEND TEXT TO OPR TERMINAL AND LEAVE CURRENT ROUTINE VIA POPJ
; NOTE 1: THIS ROUTINE ALWAYS APPENDS <CR>-<LF> TO MSG
; NOTE 2: THE CALL TO $SAYRET IS SKIPPABLE
DEFINE $SAYRET($A)<
IF2,<IFNDEF OSROPB,<EXTERNAL OSROPB>>
JSP T1,OSROPB
LSTOFF
JUMP [ASCIZ _$A'@_]
LSTON
> ;END OF $SAYRET DEFINITION
; UTILITY MACROS FOR $DISPATCH
DEFINE $LEN($A)<
..L==0
IRP $A,<..L==..L+1>
>
DEFINE $TAB($A)<
..T=[
IRP $A, <SIXBIT /$A/>]
>
; THE INVOKATION OF THIS MACRO IS AS FOLLOWS:
; $DISPATCH <T1,T2,T3,...>,<A1,A2,A3,...>
; THE EFFECT IS TO MAKE A TABLE OF SIXBIT T
; AND CALL SCNTBL TO FIND THE INDEX.
; ON NOT FOUND OR AMBIGUOUS, A JUMP IS MADE TO BADARG FOR
; FURTHER ANALYSIS.
; IF T1/0 THEN A JUMP IS MADE TO LSTARG TO LIST THE POSSIBLE
; ARGUMENTS
; IF THE SIXBIT TOKEN IN T1 MATCHES ANY OF THE T'N THEN
; A DISPATCH IS MADE INTO THE A'N TABLE VIA JRST @.
DEFINE $DISPATCH($A,$B)<
.XCREF
$LEN(<$A>)
$TAB(<$A>)
MOVE T2,[XWD -..L,..T]
JUMPE T1,LSTARG
PUSHJ P,SCNTBL##
LSTOFF
JRST BADARG
JRST @.+1(T1)
EXP $B
..T==..L
$LEN(<$B>)
LSTON
IFN ..L-..T, <PRINTX ?BAD DISPATCH TABLE GENERATED $B>
.CREF
> ;END OF $DISPATCH
;DEFINE MACRO FOR HANDLING GUIDE OR "NOISE" WORDS
DEFINE $GW($A)<
PUSHJ P,GW##
LSTOFF
SIXBIT \$A\
LSTON
> ;END OF $GW DEFINITION
SUBTTL PISYS DEFINE THE SOFTWARE INTERRUPT MACRO'S
; *** WARNING ***
; DO NOT CHANGE THESE VALUES
V$BASE=140 ;ABSLOUTE ORGIN OF THE INTERRUPT VECTOR(S)
V$MAX==^D10 ;MAX NUMBER OF INTERRUPT VECTORS
V$SIZE==4 ;FOUR WORDS/VECTOR
;MCP KERNEL SOFTWARE CHANNEL DEFINITIONS
;NAME CHANNEL # USE
ZRO==<.PCZRO==<.PCC00==00>> ;VERY VERY VERY VERY VERY TEMP CHANNEL
;USED FOR GETSEG'S
MX0==<.PCMX0==<.PCC01==01>> ; MULTIPLEXED TTY: AND NON-DROPPED RDX:
MX1==<.PCMX1==<.PCC02==02>> ; MULTIPLEXED MULTI-DROP RDX:
MX2==<.PCMX2==<.PCC03==03>> ; AVAILABLE MPX:
MX3==<.PCMX3==<.PCC04==04>> ; AVAILABLE MPX:
MPP==<.PCMPP==<.PCC05==05>> ; ALL MULTIPLEXED PTY: FOR MPP
OPR==<.PCOPR==<.PCC06==06>> ;TTY CHANNEL TO THE MCS OPERATOR
LOG==<.PCLOG==<.PCC07==07>> ;LOGGING FILE FOR PTY OUTPUT FROM THE MPP'S
JRN==<.PCJRN==<.PCC10==10>> ;LOGGING FILE FOR MESSAGE TRAFFIC THROUGH MCS
;JOURNAL TRAIL OF MESSAGE TRAFFIC
QUE==<.PCQUE==<.PCC11==11>> ;QUEUEING FILE FOR MESSAGE ROOL DOWN/UP (DSK ONLY)
ATO==<.PCATO==<.PCC12==12>> ;AUTO COMMAND FILE PROCESSING
XX0==<.PCXX0==<.PCC13==13>> ;RESERVED FOR DIGITAL
XX1==<.PCXX1==<.PCC14==14>> ;RESERVED FOR DIGITAL
DC0==<.PCDC0==<.PCC15==15>> ;RESERVED FOR DIGITAL
DC1==<.PCDC1==<.PCC16==16>> ;RESERVED FOR DIGITAL
DC2==<.PCDC2==<.PCC17==17>> ;RESERVED FOR DIGITAL
DEFINE $PISY6(DEV,ENB,INT,PRI)<
IFGE PRI,<
JSP T1,P$$'DEV ;;LOAD ARGUMENTS
EXP .PC'DEV
IF2,<IFNDEF VT$'DEV,<EXTERNAL VT$'DEV>>
XWD VT$'DEV-V$BASE,ENB
XWD PRI,0
P$$'DEV:HRLI T1,(PS.FCS!PS.FAC)
PISYS. T1,
$STPCD(DEV,COULD NOT ADD DEV TO PSI SYSTEM)
>;;END OF IFG
>;;END OF $PISY6
SYN $PISY6,$PION
DEFINE $PISY5(DEV,ENB,INT,PRI),<$PISY6 (DEV,ENB,INT,PRI)>
DEFINE $PISY4(ARG),<IRP ARG,<$PISY5 (ARG)>>
DEFINE $PISY3(DEV,ENB,INT,PRI)<
VT$'DEV::XWD 0,IP$'DEV## ;;NEW PC FOR INTERRUPT PROCESSING ADDRESS
XWD 0,0 ;;OLD PC WORD
EXP INT ;;CONTROL FLAGS,,REASON
XWD 0,0 ;;STATUS WORD
..NPI==..NPI+1 ;;INCREMENT ASSEMBLY COUNT
>
DEFINE $PISY2(DEV,ENB,INT,PRI),<$PISY3 (DEV,ENB,INT,PRI)>
DEFINE $PISY1(ARG),<IRP ARG,<$PISY2(ARG)>>
;;CALLED BY THE MACRO:
;;$PISYS (<<DEV1,ENB1,INT1,PRI1>,<DEV2,ENB2,INT2,PRI2>,.........,<DEVN,ENBN,INTN,PRIN>>)
DEFINE $PISYS(ARG)<
LSTOFF
..NPI==0 ;;ZERO COUNT
MOVEI T1,V$BASE ;;GET THE INTERRUPT VECTOR BASE ADDRESS
PIINI. T1,
$STPCD(SII,SOFTWARE INTERRUPT SYSTEM COULD NOT BE INITIALIZED)
IRP ARG,<$PISY4 (<ARG>)>
MOVX T1,PS.FON ;;FLAG TO TURN THE PI SYSTEM ON
PISYS. T1,
$STPCD(SIO,SOFTWARE INTERRUPT SYSTEM COULD NOT BE TURNED ON)
LOC V$BASE ;;PUT THE INTERRUPT VECTORS (ABSOULTE)
IRP ARG,<$PISY1 (<ARG>)>
RELOC ;;BACK TO NORMAL
LSTON
IFG ..NPI-V$MAX,<PRINTX ?V$MAX TOO SMALL FOR ALL CONDITIONS ENABLED>
>
SUBTTL SEGMENT CONTOL MACRO(S)
DEFINE $RELOC(A)<
SALL
TWOSEG
RELOC 400000
LOCFLG==-1 ;0=LOW SEG
;-1=HIGH SEG
HILOC==400000
LOLOC==0
>;END OF $RELOC
DEFINE $LOW(A)<
IFN LOCFLG,<HILOC==.
LOCFLG==0
RELOC LOLOC>
>;END OF $LOW
DEFINE $HIGH(A)<
IFE LOCFLG,<LOLOC==.
LOCFLG==-1
RELOC HILOC>
>;END OF $HIGH
DEFINE $LIT<
LSTOFF
$HIGH
LIT
LSTON
>;END OF $LIT
SUBTTL RANDOM MACRO'S TO MAKE LIFE EASY
;$GETTB ;USED TO SET UP THE GETTAB UUO
DEFINE $GETTB(AC,TABLE)<
SKIPA AC,.+1 ;LOAD THE ARGUEMENT
TABLE
LSTOFF
GETTAB AC, ;GET THE INFORMATION
SETZ AC, ;ERROR RETURN (CLEAR THE INFORMATION)
LSTON
>;END OF $GETTB
DEFINE $LASCI (AC,STRING,%FOOBA)<
LSTOFF
JSP AC,%FOOBA
ASCIZ _STRING_
%FOOBA:
LSTON
>;END OF $LASCI
; $STPCD - MACRO USED TO TERMINATE RUN WITH INFORMATIVE MESSAGE
; FIRST ARGUMENT IS 3 LETTER CODE USED TO GENERATE S$$XXX LABEL
; AND THE SECOND IS THE EXPANDED MESSAGE
DEFINE $STPCD($A,$B)<
IF2,< IFNDEF S$$PC,< EXTERN S$$PC>>
S$$'$A::JSR S$$PC
LSTOFF
CAI [<SIXBIT / $A/>,,[ASCIZ \$B\]]
LSTON
> ;END OF $STPCD DEFINITION
;MACROS TO DEFINE THE ENTRY AND ARGUMENT FETCH FOR BLISS-10 CALLABLE ROUTINES
DEFINE $DEFINE(ARG,OFFSET)<DEFINE ARG<OFFSET($F)>>
DEFINE $ENTRY(N,A)<
N:: ;;ENTRY POINT TO A BLISS-10 CALL
IF2,<IFNDEF .ENT.X,<EXTERNAL .ENT.X>>
JSP 4,.ENT.X ;;SAVE OLD FRAME, SET UP NEW ONE
X.==0 ;;SET COUNTER TO ZERO
IRP A,<X.=X.+1> ;;COUNT THE ARGUMENTS
X..==0 ;;SET ANOTHER COUNTER
IRP A,<X...==<-X.+X..-1>&<777777> ;;DEFINE THE ARGUMENT ADDRESS OFF THE FRAME
$DEFINE(A,\X...) ;;MAKE A MACRO OUT OF IT
X..==X..+1 ;;AND GO TO THE NEXT ARGUMENT
>;;END OF IRP A
>;;END OF $ENTRY
DEFINE $CALL(NAME,ARG)<
LSTOFF
IF2,<IFNDEF NAME,<EXTERNAL NAME>>
N.==0
IRP ARG,<
N.==N.+1
PUSH $S,ARG>
LSTON
PUSHJ $S,NAME
LSTOFF
IFN N.,<
SUB $S,[XWD N.,N.]
>
LSTON
>;END OF $CALL
IF2 <ASUPPRESS>
PRGEND
TITLE KRNABS - MESSAGE CONTROL PROGRAM DATA BASE
SUBTTL D.TODD/DRT/AAG/CDO/ILG 1 JUNE 1977
SEARCH KERNEL,MACTEN,UUOSYM ;LOAD ALL THE UNIVERSALS
$RELOC
LOC 124 ;.JBREN ENTRY ADDRESS
EXP SAVIT## ;IS LOCATION TO SAVE ACS,STOP
LOC 135 ;.JBOPS ENTRY POINTS TO S$$?? BLOCK
EXP S$$PC ;IN CASE WE DON'T HAVE SYMBOLS
$LOW ;RELOC TO .JBDA FOR PSI VECTOR
;INTERUPPT VECTOR(S)
;V$BASE:: ;START OF INTERRUPT VECTORS
BLOCK V$MAX*V$SIZE ;SIZE OF THE INTERRUPT BLOCK
; PLACE TO BUILD THE STACK POINTER AND STACK
STKPTR:: IOWD STKSIZ,.+1
STACK:: BLOCK STKSIZ
;FREE CORE TABLES AND POINTERS
C$BPTR:: 0 ;GETS -LENGTH OF BIT MAP,ADDR OF BIT MAP
C$BASE:: 0 ;ADDRESS REPRESENTED BY THE BIT TABLE
C$APTR:: 0 ;GETS -LENGTH OF ALTERNATE MAP,, ADDR OF MAP
C$ABAS:: 0 ;ADDRESS REPRESENTED BY THE ALTERNATE BIT TABLE
C$SIZE:: 0 ;GETS SIZE OF FREE CORE IN CHUNKS
C$USED:: 0 ;NUMBER OF CHUNKS IN USE
C$FULL:: 0 ;-1 WHEN CORE IS ABOVE ACCEPTABLE LEVEL
FREFUL:: 0 ;FREHI1% OF FREE CORE CHUNKS (C$SIZE)
FREFLL:: 0 ;FREHI2% OF FREE CORE CHUNKS
;FREE PAGE TABLES
P$BPTR::XWD -<<PAGMAX/^D36>+1>,P$BITS
P$BITS::BLOCK <PAGMAX/^D36>+1;MAP OF THE FREE/USED PAGES
I$USED:: 0 ;NUMBER OF IPCF PAGES IN USE
I$SIZE:: 0 ;MAXIMUM NUMBER OF IPCF PAGES AVAILABLE
;MISC WORDS NEEDED THROUGH OUT
FIXCR::JFCL ;WHAT TO DO IF CR=E?I
FIXLF::JFCL ;WHAT TO DO IF LF=E?I
NMPPS::MPPS## ;NO.OF REAL MPPS IN SYSTEM
NSLOT::FMPPS## ;NO.OF FREE MPP SLOTS IN SYSTEM
MONSON:: 0 ;IF TRUE, MONITORING SIGN ONS
MONSOF:: 0 ;IF TRUE, MONITOR SIGN OFFS
MONCPS:: 0 ;IF TRUE, MONITOR CHANGES IN PORT STATUS
LASTOK:: 0 ;LAST ARGUMENT FED TO SCNTBL
ILGCDO:: 0 ;GLOBAL DEBUGGING FLAG
IPCFLG:: 0 ;IPCF ASSOCIATED VARIABLE FLAGS
CNDLST:: 0 ;POINTER TO HEAD OF COMM.NODES TO BE GREETED
;THE DATE AND TIME ARE ORDERED FOR A DMOVEM
$$TIME::BLOCK 1 ;(1) STORE THE TIME FROM THE MSTIME UUO
$$DATE::BLOCK 1 ;(2) STORE THE DATE FROM THE DATE UUO
JOBMCS::BLOCK 1 ;JOB NUMBER OF MCS
PPNMCS::XWD 136,1374 ;SYSTEM WIDE MCS PPN (USED AS A DEFAULT)
PIDMCS::BLOCK 1 ;STORE THE PID FOR MCS
PIDIPC::BLOCK 1 ;STORE THE PID FOR [SYSTEM]IPCF
PIDINF::BLOCK 1 ;STORE THE PID FOR [SYSTEM]INFO
PIDDEB::BLOCK 1 ;STORE THE PID FOR MPP DEBUG RUNS
PAKSND::EXP IP.CFP ;PACKET TO SEND TO [SYSTEM]IPCF
BLOCK 1 ;STORE THE SENDER'S PID
BLOCK 1 ;STORE THE RECEIVER'S PID
XWD ^D8,MSGSND ;POINTER TO THE MESSAGE PACKET
PAKREC::Z ;PACKET TO RECEIVE FROM [SYSTEM]IPCF
Z ;SENDER'S PID
Z ;RECEIVER'S PID
XWD ^D8,MSGREC ;POINTER TO THE MESSAGE PACKET
MSGSND::BLOCK ^D8 ;MESSAGE SEND
MSGREC::BLOCK ^D8 ;MESSAGE RECEIVE
;QUE STORAGE AREAS
QUEIN:: BLOCK 3 ;QUE INPUT RING HEADER
QUEOUT::BLOCK 3 ;QUE OUTPUT RING HEADER
;PARTICAL DATA BUFFER
QD$BLK::BLOCK 1 ;(LT) 0 IF COPY ON DISK CORRENT
;(LT) -1 IF CORE COPY MODIFIES
;(RT) DISK ADDRESS -1 OF THE PARTICAL
$CBUFF (QUEDAT,200,1) ;DEFINE THE DATA AREA
;PAT BLOCK CONTROL WORDS FOR ALLOCATE AND DEALLOCATE
QP$MAX::BLOCK 1 ;MAXIUM NUMBER OF PARTICALS IN THE SYSTEM
;COMPUTED FROM THE FILE SIZE
QP$BLK::BLOCK 1 ;(LT) 0 IF COPY ON DISK CORRECT
;(LT) -1 IF IN CORE COPY MODIFIED
;(RT) IS THE DISK ADDRESS -1 OF THE PAT
Q$BPTR::XWD -200,QUEPAT+2 ;BASE POINTER TO THE PAT TABLE
Q$BASE:: 0 ;DISK ADDRESS REPRESENTER BY PAT
Q$FULL:: 0 ;-1 WHEN FILE IS FULL
Q$USED:: 0 ;RUNNING TOTAL OF USED PARTICLES
$CBUFF (QUEPAT,200,1) ;DEFINE THE PAT BUFFER
SUBTTL MSGSER DATA BUFFERS AND HEADERS
MXNLST::BLOCK 1 ;LAST MXN TO BE SEARCHED
MXNSTS::BLOCK 4 ;CHANNEL STATUS REGISTERS (RESIDUAL COUNTS)
MXNHED::BLOCK 4 ;LEN,,ADDR OF EACH CHANNEL'S ERRLST LIST
MX0CON::BLOCK 1 ;NUMBER OF DEVICES CONNECTED
MX1CON::BLOCK 1 ;ETC
MX2CON::BLOCK 1 ;ETC
MX3CON::BLOCK 1 ;ETC
MX0IN:: BLOCK 4 ;INPUT RING HEADER
MX0OUT::BLOCK 4 ;OUTPUT RING HEADER
$CBUFF (MX0IBF,103,3) ;INPUT BUFFERS FOR THE MX0'S
$CBUFF (MX0OBF,23,30,-1);OUTPUT BUFFERS FOR THE MX0'S
MX1IN:: BLOCK 4 ;INPUT RING HEADER
MX1OUT::BLOCK 4 ;OUTPUT RING HEADER
$CBUFF (MX1IBF,103,3) ;INPUT BUFFERS FOR THE MX1'S
$CBUFF (MX1OBF,23,30,-1);OUTPUT BUFFERS FOR THE MX1'S
MX2IN:: BLOCK 4 ;INPUT RING HEADER
MX2OUT::BLOCK 4 ;OUTPUT RING HEADER
$CBUFF (MX2IBF,1,1) ;INPUT BUFFERS FOR THE MX2'S
$CBUFF (MX2OBF,1,1,-1);OUTPUT BUFFERS FOR THE MX2'S
MX3IN:: BLOCK 4 ;INPUT RING HEADER
MX3OUT::BLOCK 4 ;OUTPUT RING HEADER
$CBUFF (MX3IBF,1,1) ;INPUT BUFFERS FOR THE MX3'S
$CBUFF (MX3OBF,1,1,-1);OUTPUT BUFFERS FOR THE MX3'S
SUBTTL OTHER DATA BUFFERS AND HEADERS
ATOOPR::BLOCK 1 ;ATO FILE MODE FOR OPERATOR COMMANDS
;XWD #WORDS FOR BUFFERS,ADDRESS
ATOIN:: BLOCK 3 ;INPUT RING HEADER
OPRIN:: BLOCK 3 ;INPUT RING HEADER
OPROUT::BLOCK 3 ;OUTPUT RING HEADER
;DATA BUFFERS
$CBUFF (OPRIBF,23,1) ;INPUT BUFFERS FOR THE OPR'S
$CBUFF (OPROBF,23,3) ;OUTPUT BUFFERS FOR THE OPR'S
MPPIN:: BLOCK 4 ;INPUT RING HEADER
MPPOUT::BLOCK 4 ;OUTPUT RING HEADER
;DATA BUFFERS
$CBUFF (MPPIBF,23,1) ;INPUT BUFFERS FOR THE MPP'S
$CBUFF (MPPOBF,23,1,-1);OUTPUT BUFFERS FOR THE MPP'S
LOGINA::
LOGIN:: BLOCK 3 ;INPUT RING HEADER
LOGOTA::
LOGOUT::BLOCK 3 ;OUTPUT RING HEADER
;DATA BUFFERS
$CBUFF (LOGOBF,200,4) ;BUFFER RINGS
JRNIN:: BLOCK 3 ;INPUT RING HEADER
JRNOUT::BLOCK 3 ;OUTPUT RING HEADER
;DATA BUFFERS
$CBUFF (JRNOBF,200,4) ;BUFFER RINGS
SUBTTL OTHER STUFF
;CONSTANT NEEDED THROUGHOUT
JSNCO1::XWD 0,MAXJSN##
JSNCO0::XWD MAXJSN##,0 ;ANOTHER CONSTANT
; UNIVERSAL FILE ERROR CODE AND AUXIALLIARY WORD
ERRCOD:: 0 ;REASON FOR ERROR
ERRAUX:: 0 ;ADDITIONAL INFORMATION
; DATA AREA FOR STOP CODE PROCESSOR
S$$PC:: 0 ;PC STOPCODE OCCURED AT
JRST STOPME## ;CONTINUE TO PURE CODE
S$$CD:: 0 ;CODE FOR STOP CODE
S$$ACS:: BLOCK 20 ;ACS AT TIME OF STOP CODE
; ADDRESS VECTOR OF VARIABLES OF INTEREST AFTER A STOP
S$$PT:: EXP V$BASE ;PSI VECTOR
EXP STACK ;RUN-TIME STACK
EXP C$BPTR ;FREE CORE DATA BASE
EXP P$BPTR ;FREE PAGE DATA BASE
EXP QUEIN ;QUEUE FILE DATA DATA BASE
EXP QP$MAX ;QUEUE FILE POINTER DATA BASE
EXP MXNLST ;MPX DATA BASE
; WHEN IPCF REFUSES TO GIVE US A PAGE BECAUSE OUR PHYSICAL
; SIZE TOO LARGE (ERROR CODE 13), WE WANT TO CHOOSE SOME PAGE TO
; PAGE OUT SO THAT THE NEW ONE COMES IN. THIS PAGE MUST BE IN
; THE LOW SEGMENT SO THAT WHEN WE ARE SHAREABLE IT CAN GO AWAY.
; THIS IS THAT PAGE. WHEN IPCF RECEIVE TELLS US THAT THERE IS
; NO ROOM, WE TOUCH THIS PAGE TO INSURE THAT PFH BRINGS IT IN, AND
; THEN IT GOES AWAY.
PANOUT:: ;PANIC PAGE OUTPUT
PUSHJ P,POUT## ;CO-ROUTINE CAUSES THIS PAGE
;TO DISSAPEAR ON A POPJ
POPJ P, ;DO IT.
$LIT
PRGEND
TITLE KRNSCH -MESSAGE CONTROL PROGRAM KERNEL ROUTINES
SUBTTL D.TODD/DRT/CDO/ILG 1 JUNE 1977
SEARCH KERNEL,MACTEN,UUOSYM ;LOAD ALL THE UNIVERSALS
$RELOC
$INIT=-1 ;FLAG TO RUN PROCESS WHEN MCS STARTS
$NOINIT=0
DEFINE $SCHED <
LSTOFF
X EMO,EATMPP,$NOINIT ;PROCESS MPP OUTPUT
X OPR,MCSOPR,$INIT ;PROCESS OPR COMMAND
X CPS,POLLSS,$NOINIT ;PROCESS TO POLL CHANGES IN STATUS
X ROL,ROLCORE,$NOINIT ;PROCESS CHANGES IN ROLLOUT STATUS
X MSW,MSGOUT,$INIT ;PROCESS MESSAGE OUTPUT
X MSR,MSREAD,$INIT ;PROCESS MESSAGE INPUT
X IPC,MCSIPC,$NOINIT ;PROCESS IPCF TRAFFIC
X CNS,QCNS,$NOINIT ;PROCESS CHANGES IN COMM.NODE STATUS
LSTON
> ; END OF $SCHED DEFINITION
; GENERATE RUN'XXX FLAGS FOR ALL PROCESSES
DEFINE X($A,$B,$C)<
RUN'$A:: EXP $C > ; END OF X
$LOW
RUNTAB:: $SCHED
SCH.N==.-RUNTAB
$HIGH
; GENERATE THE PROCESS TABLE FOR ALL PROCESS
DEFINE X($A,$B,$C)<
EXP $B'##> ;END OF X
PROTAB:: $SCHED
SUBTTL SCHEDULER FOR ALL PROCESSES OF MCS-10
SCHED.:: ;ENTRY POINT FOR THE SCHEDULER
SETZ SCH2, ;ZERO THE FLAG REGISTER
SCHED1: MOVSI SCH1,-SCH.N ;GET NUMBER OF PROCESSES
SCHED2: SETZ T1, ;INSURE A ZERO REGISTER
EXCH T1,RUNTAB(SCH1) ;GET POSTING FLAG AND ZERO IT
JUMPE T1,SCHED3 ;IF ALREADY ZERO,DONT RUN PROCESS
PUSHJ P,@PROTAB(SCH1) ;ELSE PUSH TO IT
MOVEI SCH2,1 ;REMEMBER THAT SOMEONE RAN
SCHED3: AOBJN SCH1,SCHED2 ;IF NOT DONE, GET NEXT PROCESS
SOJE SCH2,SCHED1 ;IF SOMEONE RAN, DON'T SLEEP
MOVX T1,WAKCOD ;GET PROPER BITS AND TIME
HIBER T1, ;HIBERNATE
$STPCD(HUR,HIBER UUO IS REQUIRED) ;SHOULD NEVER HAPPEN
JRST SCHED. ;GO TO TOP OF LOOP
SUBTTL IP$XXX - INTERRUPT PROCESSING ROUTINES
IP$OPR:: ;ENTRY FOR INTERRUPTS FROM THE CONTROLLING
SETOM RUNOPR ;POST THE INTERRUPT
JRST DBRK ;AND DEBREAK IT
IP$MPP:: ;ENTRY FOR PTY INTERRUPTS
SETOM RUNEMO ;SCHEDULE EAT MPP OUTPUT
JRST DBRK ;AND DISMISS THE INTERRUPT
IP$IPC:: ;IPCF INTERRUPTS
PUSH P,T1 ;SAVE T1
SKIPE T1,VT$IPC##+.PSVIS ;GET THE TOP PACK INFORMATION
MOVEM T1,IPCFLG## ;STORE IT IF NON ZERO.
SETOM RUNIPC ;RUN IPCF PROCESS
JRST T1DBRK ;RESTORE T1,DISMISS THE INTERRUPT
IP$DAT:: ;HERE FOR DETACH OR ATTACH OF A TTY
IP$DSC:: ;OR FOR CARRIER LOST INTERRUPT
IP$NET:: ;OR FOR CHANGE IN NETWORK TOPOLOGY
SETOM RUNCPS ;MARK CHANGE IN PORT STATUS
SETOM RUNCNS ;ALSO CHANGE IN COMMUNICATION NODE STATUS
JRST DBRK ;AND FINISH UP
SUBTTL IP$MXN MSGSER INTERFACES TO PSISER
IP$MX0:: ;CHANNEL MX0
PUSH P,T1 ;SAVE T1
MOVEI T1,VT$MX0## ;GET INTERRUPT BLOCK ADDRESS
PJRST SETMXN ;MAKE THE PROCESS RUNNABLE
IP$MX1:: ;CHANNEL MX1
PUSH P,T1 ;SAVE T1
MOVEI T1,VT$MX1## ;GET THE INTERRUPT BLOCK ADDRESS
PJRST SETMXN ;MAKE THE PROCESS RUNNABLE
IP$MX2:: ;CHANNEL MX2
PUSH P,T1 ;SAVE T1
MOVEI T1,VT$MX2## ;GET BLOCK ADDRESS
PJRST SETMXN ;MAKE THE PROCESS RUNNABLE
IP$MX3:: ;CHANNEL MX3
PUSH P,T1 ;SAVE T1
MOVEI T1,VT$MX3## ;GET APPROPRIATE BLOCK ADDRESS
; JRST SETMXN ;FALL INTO SETMXN
;SET THE INPUT/OUTPUT PROCESS RUNNABLE
SETMXN: ;ENTRY
PUSH P,T2 ;SAVE T2
HRRZ T2,.PSVFL(T1) ;CHECK THE REASON WORD
ANDCAM T2,.PSVFL(T1) ;TURN OFF DISCOVERED FLAGS
TRNE T2,PS.RDO ;DEVICE OFF-LINE?
SETOM RUNCPS ;YES,RUN POLLING PROCESS
TRNE T2,PS.ROD ;OUTPUT DONE?
SETOM RUNMSW ;YES,RUN MSGOUT
TRNE T2,PS.RID ;INPUT READY?
SETOM RUNMSR ;YES,RUN MSREAD
; PJRST T2DBRK ;RESTORE TEMP ACS,DISMISS INTERRUPT
;DISMISS INTERRUPTS
T2DBRK: POP P,T2 ;RESTORE T2
T1DBRK: POP P,T1 ;RESTORE T1
DBRK: DEBRK. ;DONE WITH THE CURRENT INTERRUPT
$STPCD(DUR,DEBRK. UUO REQUIRED);
$STPCD(DNI,DEBRK. DONE WITH NO INTERRUPT IN PROGRESS)
$LIT
PRGEND
TITLE KRNCOM - COMMON ROUTINES TO THE KERNEL CODE
SUBTTL D.TODD/DRT/AAG/CDO/ILG 1 JUNE 1977
SEARCH KERNEL,MACTEN,UUOSYM ;LOAD ALL THE UNIVERSALS
$RELOC
;COMMON SUBROUTINE RETURNS
CPOPJ1::AOS (P) ;SKIP SUBROUTINE RETURN
C::
CPOPJ:: POPJ P,
TPOPJ1::AOS -1(P) ;RESTORE T1 THEN SKIP RETURN
TPOPJ::
T1POPJ::POP P,T1 ;RESTORE T1
POPJ P, ;AND RETURN
T2POPJ::POP P,T2 ;RESTORE T2
POPJ P,
T3POPJ::POP P,T3
POPJ P,
T4POPJ::POP P,T4
POPJ P,
;SUBROUTINES TO SAVE AND RESTORE PRESERVED ACS
;SAVEN IS CALLED AT THE BEGINNING OF A SUBROUTINE
;FOR CONVENIENCE NO MATCHING SUB IS NEEDED TO BE CALLED
;TO RESTORE THIS ACS.
;INSTEAD AN EXTRA RETURN IS PUT ON STACK
;5 CHAR NAME INDICATES IT VIOLATES
;SUBROUTINE CALLING CONVENTIONS
;CALL: PUSHJ P,SAVEN
; RETURN HERE IMMEDIATELY WITH EXTRA RETURN ON STACK
; RESPECTS ALL ACS
INTERN SAVE1,SAVE2,SAVE3,SAVE4
SAVE1: EXCH P1,(P) ;SAVE P1, GET CALLER PC
PUSH P,.+3 ;PUT THE RETURN ADDRESS ON THE STACK
HRLI P1,-1(P) ;GET THE ADDRESS OF P1
JRA P1,(P1) ;GO BACK TO THE CALLER, P1 RESTORED
CAIA . ;NON-SKIP RETURN ,, RETURN ADDRESS
AOS -1(P)
JRST RES1
SAVE2: EXCH P1,(P) ;SAVE P1, GET CALLER PC
PUSH P,P2 ;SAVE P2
PUSH P,.+3 ;PUT THE RETURN ADDRESS ON THE STACK
HRLI P1,-2(P) ;GET THE ADDRESS OF P1
JRA P1,(P1) ;GO BACK TO THE CALLER, P1 RESTORED
CAIA . ;NON-SKIP RETURN ,, RETURN ADDRESS
AOS -2(P)
JRST RES2
SAVE3: EXCH P1,(P) ;SAVE P1, GET CALLER PC
PUSH P,P2 ;SAVE P2
PUSH P,P3 ;SAVE P3
PUSH P,.+3 ;PUT THE RETURN ADDRESS ON THE STACK
HRLI P1,-3(P) ;GET THE ADDRESS OF P1
JRA P1,(P1) ;GO BACK TO THE CALLER, P1 RESTORED
CAIA . ;NON-SKIP RETURN ,, RETURN ADDRESS
AOS -3(P)
JRST RES3
SAVE4: EXCH P1,(P) ;SAVE P1, GET CALLER PC
PUSH P,P2
PUSH P,P3
PUSH P,P4
PUSH P,.+3 ;PUT THE RETURN ADDRESS ON THE STACK
HRLI P1,-4(P) ;GET THE ADDRESS OF P1
JRA P1,(P1) ;GO BACK TO THE CALLER, P1 RESTORED
CAIA .
AOS -4(P)
RES4: POP P,P4
RES3: POP P,P3
RES2: POP P,P2
RES1: POP P,P1
POPJ P,
;SUBROUTINE TO SAVE AND RESTORE TEMP ACS(T1-T4)
;CALLED BY PUSHJ P,SAVT RETURN EITHER CPOPJ OR CPOPJ1 WHEN THROUGH
SAVT:: EXCH T1,(P) ;SAVE T1, GET RETURN ADR.
PUSH P,T2
PUSH P,T3 ;SAVE T3
PUSH P,T4
PUSH P,.+3 ;GET THE RETURN ADDRESS
HRLI T1,-4(P) ;GET THE ADDRESS OF P1
JRA T1,(T1) ;GO BACK TO CALL, RESTORE T1
CAIA . ;POPJ RETURN
AOS -4(P) ;CPOPJ1 - SET SKIP RETURN
POP P,T4
REST3: POP P,T3
POP P,T2 ;RESTORE T3 ACS
POP P,T1
POPJ P, ;AND RETURN
;SUBROUTINE TO PAGE OUT THE PAGE(S) CONTAINING THE CALLING ROUTINE
;UPON EXIT.
;
;CALL PUSHJ P,POUT
;RETURN (ALWAYS HERE WITH AN EXTRA RETURN ON THE STACK
INTERNAL POUT
POUT: PUSHJ P,@(P) ;RETURN IMEDIATELY WITH AN EXTRA RETURN
CAIA . ;NON-SKIP RETURN
AOS -1(P) ;SKIP RETURN PASS IT ALONG
EXCH T1,(P) ;SAVE T1 AND GET THE PAGE TO PAGE OUT
PUSH P,T2 ;SAVE T2
PUSH P,T3 ;SAVE T3
MOVEI T3,(T1) ;GET THE ADDRESS
LSH T3,W2PLSH ;CONVERT TO PAGES
TLO T3,(1B0) ;SET PAGE OUT BIT
MOVEI T2,1 ;ARGUMENT COUNT OF 1
SKIPA T1,.+1 ;SET UP THE PAGE ARGUMENT
XWD .PAGIO,T2 ;ARGUMENT
PAGE. T1, ;OUT IT GOES
JFCL ;NICE TRY THOUGH
PJRST REST3 ;RESTORE THE AC AND EXIT
SUBTTL STOP CODE AND RUN TERMINATION ROUTINES
; STOPME - CALLED VIA THE $STPCD MACRO
; SAVES ACS AND TERMINATES RUN
STOPME:: ;ENTRY POINT
MOVEM 0,S$$ACS## ;GET A REGISTER TO USE
MOVE 0,[1,,S$$ACS##+1] ;AND LOAD BLT AC
BLT 0,S$$ACS##+17 ;SAVE ALL REGISTERS AWAY
MOVE 0,S$$ACS## ;RESTORE ORIGINAL CONTENTS
MOVE P,[IOWD 25,STPPDL] ;GET OWN STACK, OLD MIGHT BE USEFUL
$SAY(<?MCSMSC MCS STOP CODE - >) ;START MESSAGE
HRRZS S$$PC## ;CLEAR LH OF PC
HRRZ P1,@S$$PC## ;GET ARGUMENTS
MOVE P1,0(P1) ;GET XWD CODE,,STRING POINTER
HLLZ T1,P1 ;GET SIXBIT CODE
HLRZM T1,S$$CD## ;STORE CODE HERE
PUSHJ P,PUTSIX## ;OUTPUT IT
$SAY(< - at PC >)
SOS T1,S$$PC## ;CORRECT THE PC,FETCH IT TOO
PUSHJ P,PUTOCT## ;OUTPUT IT
$SAY(<@ >) ;CRLF-TAB
MOVEI T1,0(P1) ;GET ADDR OF STRING
PUSHJ P,OSROPR## ;OUTPUT IT
PUSHJ P,PUTEOL## ;OUTPUT END OF LINE
SKIPA ;FALL INTO ABORT ....
; ABORT - CALLED TO TERMINATE THE RUN
ABORT:: ;ENTRY POINT
$SAY(<?MCSCCR CANNOT CONTINUE RUN@>)
EXIT 1, ;EXIT, RETAINING DEVICES
JRST .-1 ;BEAT ANY ATTEMPT TO CONTINUE
; SAVIT - POINTED AT BY RH(.JBREN) TO SAVE ACS AND TERMINATE RUN
SAVIT:: SKIPE S$$PC## ;IF ALREADY TOOK STOP CODE,
JRST ABORT ;DONT ALLOW ANY MORE
$STPCD(SAV,ACS STORED. "SAVE" THIS CORE IMAGE NOW.)
;ROUTINE PROLOGS AND EPILOGS
.ENT.0::
PUSH $S,16
HRRZ $F,17
JRST 00,0(04)
.ENT.1::
PUSH $S,16
HRRZ $F,17
PUSH $S,10
JRST 00,0(04)
.ENT.2::
PUSH $S,16
HRRZ $F,17
PUSH $S,10
PUSH $S,7
JRST 00,0(04)
.ENT.3::
PUSH $S,16
HRRZ $F,17
PUSH $S,10
PUSH $S,7
PUSH $S,6
JRST 00,0(04)
.ENT.4::
PUSH $S,16
HRRZ $F,17
PUSH $S,10
PUSH $S,7
PUSH $S,6
PUSH $S,5
JRST 00,0(04)
.EXT.4::
POP $S,5
.EXT.3::
POP $S,6
.EXT.2::
POP $S,7
.EXT.1::
POP $S,10
.EXT.0::
POP $S,16
POPJ $S,0
.ENT.X:: ;ENTRY ROUTINE FOR THE KERNEL FROM BLISS
PUSH $S,$F ;SAVE THE OLD STACK FRAME
MOVEI $F,($S) ;BUILD A NEW STACK FRAME
PUSHJ $S,(4) ;RETURN TO CALLER
POP $S,$F ;RESTORE THE FRAME
POPJ $S, ;RETURN
SUBTTL SCAN TABLE AND BUZZ WORD ROUTINES
;SUBROUTINE SCNTBL - SCAN A TABLE AND RETURN THE INDEX
;CALL MOVE T1,[SIXBIT /NAME/]
; MOVE T2,[XWD -LENGTH,ADDRESS]
; PUSHJ P,SCNTBL
;RETURN CPOPJ ;ENTRY NOT FOUND OR NOT UNIQUE
;T1=1B0 FOR UNKNOWN
;T1=0 FOR AMBIGUOUS
; CPOPJ1 ;T1=INDEX TO THE TABLE
SCNTBL:: ;ENTRY POINT
PUSH P,T2 ;SAVE THE LENGTH WORD
MOVEM T1,LASTOK## ;SAVE INPUT TOKEN FOR ERROR MESSAGES
SCNTB0:
CAMN T1,0(T2) ;DO WE HAVE AN EXACT MATCH
JRST [ HRRZS T2 ;GET ADDRESS ONLY
PUSH P,T2 ;SAVE IT ON THE STACK
JRST SCNTB4]
AOBJN T2,SCNTB0
MOVE T2,0(P) ;NO EXACT MATCH,TRY PARTIALS
MOVSI T4,770000 ;SET UP A MASK
PUSH P,T4 ;SAVE AS A FLAG WORD
SKIPA T3,T1 ;COPY THE NAME
SCNTB1: ASH T4,-6 ;SHIFT THE MASK
TDZ T3,T4 ;CLEAR OUT THE KNOWN CHARACTERS
JUMPN T3,SCNTB1 ;CONTINUE IF ANY CHARACTERS LEFT
SCNTB2: MOVE T3,(T2) ;GET THE NEXT TABLE ENTRY
AND T3,T4 ;REDUCE TO THE WANTED SIZE
CAME T3,T1 ;IS THIS IT
SCNTB3: AOBJN T2,SCNTB2 ;NO, TRY ANOTHER ONE
JUMPGE T2,SCNTB4 ;END OF THE TABLE LIST
SKIPG T3,(P) ;FOUND A MATCHING ENTRY HERE BEFORE
HRRZM T2,(P) ;NO, SAVE THE TABLE ADDRESS
JUMPL T3,SCNTB3 ;CONTINUE FOR ANOTHER MATCH
SETZM (P) ;NOT UNIQUE SET ZERO FLAG
SCNTB4: POP P,T1 ;GET THE FLAG WORDS BACK
JUMPLE T1,T2POPJ ;OR UNIQUE ... NO ERROR
POP P,T2 ;GET THE LENGTH WORD
SUBI T1,(T2) ;COMPUTE THE INDEX
PJRST CPOPJ1 ;GOOD EXIT T1=THE INDEX
; ROUTINE TO SCAN NOISE WORDS IN COMMAND SCANNER
;
; THIS ROUTINE IS CALLED BY THE $GW MACRO WHENEVER A NOISE
; WORD IS EXPECTED IN THE OPERATOR INPUT STRING.
; IF THE NEXT INPUT (VIA GETSIX) MATCHES THE GUIDE WORD AT LEAST
; PARITALLY, WE JUST RETURN, OTHERWISE:
; 1) ON BLANK INPUT, WE GIVE A MCSGWE GUIDE WORD XXXX EXPECTED MSG
; 2) ON WRONG INPUT, WE GIVE AN ERROR MSG.
GW:: ;ENTRY POINT
PUSHJ P,GETSIX## ;LOAD INPUT ARGUMENT
JUMPE T1,GW.1 ;IF NO INPUT JUST PROMPT
HRRO T2,0(P) ;GET -1,,ADDR OF SIXBIT WORD
PUSHJ P,SCNTBL ;AND TRY FOR MATCH
JRST GW.2 ;INCORRECT GUIDE WORD
PJRST CPOPJ1 ;ALL OK, JUST SKIP NOISE WORD
GW.1: $SAY(<[MCSGWE Guide word '>) ;START ON WORD
MOVE T1,@0(P) ;GET INPUT ARGUMENT
PUSHJ P,PUTSIX## ;OUTPUT IT
$SAY(<' expected]@>) ;SAY IT AND RETURN
PJRST T1POPJ ;
GW.2: $SAY(<?MCSIGW Incorrect guide word '>)
MOVE T1,LASTOK## ;GET THE INPUT GUIDE WORD
PUSHJ P,PUTSIX## ;OUTPUT IT
$SAY(<' given where '>) ;
MOVE T1,@0(P) ;GET ACTUAL GW
PUSHJ P,PUTSIX## ;OUTPUT IT
$SAY(<' was expected@>)
PJRST T1POPJ ;RETURN , SKIPPING ONE LEVEL
SUBTTL TIME AND DATE STAMP ROUTINE
;SUBROUTINE TO GET THE SYSTEM TIME AND DATE
;ENTRY
; $CALL (STAMP,<DATE,TIME>)
;RETURN NO ERROR RETURN
$ENTRY (STAMP,<..DATE,..TIME>)
MSTIME T1, ;GET THE DAY TIME IN MS
MOVEM T1,@..TIME ;STORE THE TIME
CAMLE T1,$$TIME## ;GONE PAST MID-NIGHT
SKIPN T2,$$DATE## ;OR DATE NOT READ YET
DATE T2, ;YES, GET THE DATE
MOVEM T2,@..DATE ;STORE THE DATE
DMOVEM T1,$$TIME## ;STORE THE NEW DATE AND TIME
POPJ P, ;AND RETURN
SUBTTL PAGE ALLOCATION ROUTINES
;SUBROUTINE TO GET "FREE" PAGES
;ENTER GETPAG: T2=# PAGES TO GET
;RETURN CPOPJ IF NOT AVAILABLE
;RETURN CPOPJ1 IF GOTTEN, WITH T1=PAGE NUMBER
GETPAG::MOVE T1,T2 ;NUMBER OF PAGES TO GET
MOVEI T2,P$BPTR## ;L(AOBJN WORD)
PUSH P,T1 ;SAVE NUMBER OF PAGES BEING REQUESTED
PUSHJ P,GETBIT ;GET, SET THE BITS
PJRST T1POPJ ;ERROR RETURN(CAN NOT ALLOCATE THE PAGES
PUSH P,T1 ;SAVE THE FIRST PAGE NUMBER
MOVEI T4,(T1) ;BUILD THE ARGUMENT LIST FOR PAGE.
TLO T4,(PA.GCD) ;VIRTUAL PAGE
MOVEI T3,1 ;ALLOCATE ONE PAGE AT A TIME
MOVE T1,-1(P) ;RELOAD THE NUMBER OF PAGES
SKIPA T2,.+1 ;LOAD THE FUNCTION
XWD .PAGCD,T3 ;ARGUMENT
GETPA1:
PAGE. T2, ;CREATE THE VIRTUAL PAGE
$STPCD(CCP,COULD NOT CREATE A PAGE) ;INSTEAD OF ILL MEM REF LATER
SOSLE T1 ;MORE PAGES
AOJA T4,GETPA1 ;YES, KEEP IT UP
POP P,T1 ;RETURN THE FIRST PAGE NUMBER
LSH T1,P2WLSH ;CONVERT PAGES TO WORDS
POP P,T2 ;RESTORE THE NUMBER OF PAGES
ADDM T2,I$USED## ;UPDATE PAGES IN USE
PJRST CPOPJ1 ;SKIP RETURN (OK)
;SUBROUTIN GIPCPG - ALLOCATE A PAGE TO RECEIVE AN IPCFR
;CALL PUSHJ P,GIPCPG
;RETURN CPOPJ ;NO PAGES AVAILABLE
; CPOPJ1 ;GOT A PAGE T1=PAGE NUMBER
GIPCPG:: ;ENTRY POINT
MOVEI T1,1 ;ONLY ONE PAGE
MOVEI T2,P$BPTR## ;GET THE BASE POINTER
PUSHJ P,GETBIT ;GET A BIT
POPJ P, ;NONE AVAILABLE
AOS I$USED## ;UPDATE PAGES IN USE
JRST CPOPJ1 ;EXIT WITH THE PAGE
;SUBROUTINE TO RETURN "FREE" PAGES
;ENTER GIVPAG: T1=#PAGES TO RETURN, T2=FIRST PAGE
;RETURN CPOPJ
$ENTRY (DPAGE,<..PAGE>)
MOVEI T1,1 ;ALWAYS DELETE ONLY ONE PAGE
MOVE T2,..PAGE ;GET THE PAGE NUMBER AND FALL INTO GIVPAG
GIVPAG::PUSH P,T1 ;SAVE THE #PAGES TO RETURN
LSH T2,W2PLSH ;CONVERT WORDS TO PAGES
PUSH P,T2 ;SAVE THE FIRST PAGE #
MOVEI T4,(T2) ;COPY THE FIRST PAGE #
MOVEI T3,1 ;ONE PAGE ONLY
HRLI T4,(1B0) ;SET THE DISTROY FLAG FOR PAGE.
SKIPA T2,.+1 ;LOAD THE ARGUMENT
XWD .PAGCD,T3 ;ARGUMENT
GIVPA1:
PAGE. T2, ;DESTROY IT
JFCL ;NICE TRY
SOSLE T1 ;ANY MORE PAGES
AOJA T4,GIVPA1 ;YES, CONTINUE
POP P,T2 ;RESTORE THE STARTING PAGE
POP P,T1 ;RESTORE THE NUMBER OF PAGES
;ENTERED FROM KRNIPC TO REMMOVE A PAGE FROM THE BIT TABLE
PIPCPG::IDIVI T2,^D36 ;COMPUTE THE WORD AND STARTING BIT
HRLS T2 ;WORD POSITION IN BOTH HALFS
ADD T2,P$BPTR## ;ADD THE TABLE ORGIN
MOVNS T1 ;NEGATE PAGES RETURNED
ADDM T1,I$USED## ;DECREMENT PAGES IN USE
MOVNS T1 ;RESTORE POSITIVE NUMBER
PJRST SETZRS ;ZERO THE BITS
SUBTTL MEMORY ALLOCATION AND DEALLOCATION ROUTINES
INTERN GETNWD,GIVNWD,GETWDS,GIVWDS,SETZRS
;SUBROUTINE TO GET "FREE" CORE
;ENTER GETNWD: T2=# N WORD BLOCKS TO GET
;ENTER GETWDS: T2=# WORDS TO GET
;RETURN CPOPJ IF NOT AVAILABLE, WITH T2=LARGEST HOLE AVAILABLE
;RETURN CPOPJ1 IF GOTTEN, WITH T1=LOC OF CORE
$ENTRY (GMEM,<..NWDS>)
MOVE T2,..NWDS ;FETCH THE ARGUMENT
PUSHJ P,GETWDS ;GET THE MEMORY
$STPCD(FSE,FREE SPACE EXHAUSTED) ; IF CAN'T GET WORDS
MOVEI $V,(T1) ;STORE THE ADDRESS
POPJ P, ;AND RETURN
GETWDS: ADDI T2,FRERND ;CONVERT TO N WORD BLOCKS
ASH T2,-FRELSH
GETNWD: MOVE T1,T2 ;NUMBER OF BLOCKSTO GET
MOVEI T2,C$BPTR## ;L(AOBJN WORD)
PUSH P,T1 ;SAVE NUMBER BEING REQUESTED
PUSHJ P,GETBIT ;GET, SET THE BITS
JRST GETNW2 ;NOT ENOUGH AVAILABLE
LSH T1,FRELSH ;*N TO CONVERT TO AN ADDRESS
ADD T1,C$BASE## ;+START OF TABLE = ACTUAL ADDRESS
GETNW1: MOVE T2,0(P) ;GET NUMBER OF CHUNKS GOTTEN
ADDB T2,C$USED## ;UPDATE RUNNING TOTAL
CAMLE T2,C$SIZE## ;CONSISTENCY CHECK
$STPCD(FCM,FREE CORE IN USE GREATER THAN MAXIMUM)
CAML T2,FREFUL## ;ARE WE ABOVE LIMIT ACCEPTABLE?
PUSHJ P,SETFUL ;YES, ISSUE MESSAGE, TURN ON FLAG, ETC.
POP P,T2 ;RESTORE T2
PJRST CPOPJ1 ;TAKE GOOD RETURN
;HERE IS REQUESTED AMOUNT ISN'T AVAILABLE IN THE FIRST BIT MAP
GETNW2: MOVEM T1,GHOLE ;REMEMBER LARGEST HOLE IN FIRST BLOCK
MOVE T1,0(P) ;FETCH REQUEST AGAIN
MOVEI T2,C$APTR## ;TRY THE ALTERNATE BIT MAP
SKIPE C$ABAS## ;ANY ALTERNALTE BIT MAP AT ALL
PUSHJ P,GETBIT ;YES, TRY FOR CORE THERE
JRST [MOVE T2,T1 ;NOT AVB, GET LARGEST HOLE IN THIS MAP
SKIPE C$ABAS## ;WAS THERE A SECOND BIT MAP
CAMGE T2,GHOLE ;YES, WHO'S GOT MORE SPACE
MOVE T2,GHOLE ;THE FIRST ONE, GET IT'S LARGEST HOLE
LSH T2,FRELSH ;CONVERT FROM CHUNKS TO WORDS
PJRST T1POPJ] ;AND GIVE FAIL RETURN
LSH T1,FRELSH ;*N TO CONVERT TO AN ADDRESS
ADD T1,C$ABAS## ;+START OF TABLE = ACTUAL ADDRESS
JRST GETNW1 ;ADJUST COUNTERS AND RETURN
; CORE FULL CONDITION SET AND CLEAR ROUTINES
SETFUL:
SETOM C$FULL## ;TURN ON CORE FULL FLAG
SETOM RUNROL## ;TURN ON CORRECTIVE PROCESS
SETOM RUNMSW## ;GIVE OUTPUT ANOTHER SHOT TOO
TXOE OPRFLG,CORWRN ;TIME FOR A CORE FULL WARNING?
POPJ P, ;NO, JUST RETURN
PUSH P,T1 ;SAVE THE TEMP
$SAY (<@%MCSFCF Free core above safe threshold@>)
PJRST T1POPJ ;RETURN
CLRFUL:
SETZM C$FULL## ;CLEAR FULL FLAG
SETOM RUNMSR## ;FORCE MSREAD TO RUN
POPJ P, ;RETURN
;SUBROUTINE TO RETURN "FREE" CORE
;ENTER GIVWDS: T1=# WDS. TO RETURN, T2=START ADR. OF CORE
;ENTER GIVNWD: T1=# N WRD. BLOCKS TO RETURN, T2=START ADR. OF CORE
$ENTRY (PMEM,<..LOC,..NWDS>)
HRRZ T1,..NWDS ;GET THE NUMBER OF WORDS
HRRZ T2,..LOC ;AND THE LOCATION, FALL INTO GIVWDS
GIVWDS: ADDI T1,FRERND ;CONVERT TO # N WD. BLOCKS
ASH T1,-FRELSH
GIVNWD: PUSH P,T1 ;SAVE INPUT ARG.
MOVNS T1 ;MAKE IT NEGATIVE
ADDB T1,C$USED## ;UPDATE RUNNING TOTAL
SKIPGE T1 ;MAKE CONSISTENCY CHECK
$STPCD(FCN,FREE CORE IN USE COUNT IS NEGATIVE)
SKIPN C$FULL## ;SEE IF FLAG UP
JRST GIVNW1 ;NO, SO DONT CHECK FOR CLEAR CONDITION
CAMGE T1,FREFUL## ;LOWER THAN DANGER LIMIT?
PUSHJ P,CLRFUL ;YES, CLEAR FLAG, DIDDLE SCHEDULE BITS
GIVNW1: CAMGE T1,FREFLL## ;LOWER THAN CLEAR LIMIT?
TXZ OPRFLG,CORWRN ;YES,CLEAR WARNING ALREADY GIVEN FLAG
POP P,T1 ;RESTORE T1
SKIPE T3,C$ABAS## ;IS THERE AN ALTERNATE BIT MAP
CAIGE T2,(T3) ;YES, ARE THESE IN THAT MAP
SKIPA T4,[C$BPTR##,,C$BASE##] ;NO, USE PRIMARY MAP
MOVE T4,[C$APTR##,,C$ABAS##] ;YES, USE THAT ONE
SUB T2,(T4) ;GET ADR. RELATIVE TO START OF TABLE
LSH T2,-FRELSH ;/N TO CONVERT TO BITS
IDIVI T2,^D36 ;COMPUTE WORD LOC, STARTING BIT
HRLS T2 ;WORD POSITION IN BOTH HALVES
HLRS T4 ;GET BYTE POINTER ADDRESS IN RH
ADD T2,(T4) ;SET AOBJN WORD FOR TABLE AND FALL INTO SETZRS
;SUBROUTINE TO SET ZEROS IN A TABLE
;ARG T1=HOW MANY BITS TO CLEAR
; T2=AOBJN POINTER FOR TABLE
; T3=POSITION IN WORD OF FIRST BIT TO CLEAR
; (0=BIT 0, 1=BIT 1, ETC.)
SETZRS:: EXCH T1,T3 ;SET ACS FOR CLRBTS
MOVEI T4,^D36 ;ADJUST FOR 1ST WORD
SUBM T4,T1
HRRZ T4,T2 ;SET T4 FOR CLRBTS
PUSH P,T2 ;SAVE AOBJN WORD
PUSHJ P,CLRBTS ;CLEAR SOME BITS
$STPCD(BAC,BIT ALREADY CLEAR)
POP P,T2 ;RESTORE AOBJN WORD
HLRE T3,T2 ;LENGTH OF POINTER
SUB T2,T3 ;COMPUTE TOP OF TABLE
CAILE T4,(T2) ;FINAL ADR PAST TOP?
$STPCD(PTT,PAST TOP OF TABLE)
POPJ P, ;NO, GOOD RETURN
INTERN GETZ,GETZR,SETOS
;SUBROUTINE TO FIND N CONSECUTIVE 0'S IN A TABLE
;ENTER WITH P1 = AOBJN WORD TO THE TABLE
;P2 = PREVIOUS BEST SO FAR
;RH(P3)= HOW MANY,
;EXIT CPOPJ1 IF FOUND, WITH P4 = WHERE THE HOLE IS, P1=UPDATED POINTER
;EXIT CPOPJ IF UNSUCCESSFUL, P2 = LARGEST HOLE FOUND
;P2,P4 CHANGED
GETZ: MOVEI T4,^D36 ;NO. SET UP COUNT
SETCM T1,(P1) ;WORD TO INVESTIGATE
JUMPE T1,GETZ4 ;FULL IF 0
JUMPG T1,GETZ3 ;1ST BIT UNAVAILABLE IF POSITIVE
GETZ1: SETCA T1, ;SET TO REAL CONTENTS
JFFO T1,.+2 ;COUNT THE NUMBER OF 0'S
MOVEI T2,^D36 ;36 OF THEM
GETZR: MOVE T3,T2 ;SHIFT COUNT (T3 CAN BE .GT. 36 AT GETZ2)
MOVEM P1,P4 ;SAVE POSITION IN P4
HRLM T4,P4 ;LOC OF HOLE
GETZ2: CAIL T3,(P3) ;FOUND ENOUGH?
JRST CPOPJ1 ;YES. GOOD RETURN
CAILE T3,(P2) ;NO. BEST SO FAR?
HRRI P2,(T3) ;YES. SAVE IT
SUBI T4,(T2) ;DECREASE POSITION COUNTER
JUMPLE T4,GETZ5 ;0'S ON END
SETCA T1, ;NOW WE WANT TO COUNT 1'S
LSH T1,1(T2) ;REMOVE BITS WE ALREADY LOOKED AT
JUMPE T1,GETZ4 ;GO IF THE REST OF THE WORD IS ALL ONES
GETZ3: JFFO T1,.+1 ;NUMBER OF (REAL) 1'S
LSH T1,(T2) ;GET RID OF THEM
CAIN T4,^D36 ;1ST POSITION IN WORD?
ADDI T4,1 ;YES, SUBTRACT REAL JFFO COUNT
SUBI T4,1(T2) ;DECREASE POSITION COUNT
JUMPG T4,GETZ1 ;TRY NEXT 0 - HOLE
GETZ4: AOBJN P1,GETZ ;1'S ON END - START FRESH AT NEXT WORD
;HERE IF THE DESIRED SIZE NOT YET FOUND, BUT THE WORD HAD 0'S ON THE END
GETZ5: AOBJP P1,CPOPJ ;THROUGH IF END OF SAT
SKIPGE T1,(P1) ;NEXT WORD POSITIVE?
JRST GETZ ;NO. THIS HOLE NOT GOOD ENOUGH
JFFO T1,.+2 ;YES. COUNT THE 0'S
MOVEI T2,^D36 ;36 0'S
ADDI T3,(T2) ;ADD TO PREVIOUS ZERO-COUNT
MOVEI T4,^D36 ;RESET T4
JRST GETZ2 ;AND TEST THIS HOLE
;SUBROUTINE TO SET UP A BIT MASK FOR IORM OR ANDCAM INTO A TABLE
;ENTER WITH T1=POSITION (36=BIT0, 1=BIT35)
; AND T3=HOW MANY
;AFTER THE FIRST CALL USE BITMS2, T3=COUNT RETURNS T1=MASK,
;T3=REMAINING COUNT ROUTINE HAS RETURNED FINAL MASK IF
;T3 .LE. 0 ASSUMES T4=ADR IN TABLE, BITMS2 INCREMENTS T4
INTERN BITMSK,BITMS2
BITMSK: PUSH P,T1 ;SAVE POSITION
MOVN T1,T3 ;- COUNT
CAILE T3,^D36 ;MORE THAN 1 WORD?
MOVNI T1,^D36 ;YES, SETTLE FOR A WORD (OR LESS)
MOVSI T2,400000 ;SET TO PROPOGATE A MASK
ASH T2,1(T1) ;GET THE RIGHT NUMBER OF BITS
SETZ T1,
LSHC T1,@0(P) ;POSITION THE BITS IN T1 (=MASK)
SUB T3,0(P) ;REDUCE THE COUNT TO THE NEW VALUE
PJRST T2POPJ ;AND RETURN
;HERE AFTER FIRST CALL, MASK STARTS AT BIT 0
BITMS2: SETO T1, ;MASK STARTS AT BIT 0
MOVNI T2,-^D36(T3) ;SET UP SHIFT
CAIGE T3,^D36 ;DONT SHIFT IS .GE. 36
LSH T1,(T2) ;POSTION THE MASK
SUBI T3,^D36 ;REDUCE THE COUNT
AOJA T4,CPOPJ ;UPDATE THE POSITION AND RETURN
;SUBROUTINE TO MARK BITS AS TAKEN IN A TABLE
;USES ACS AS RETURNED BY GETZ - P3=HOW MANY
; LH(P4)=POSITION, RH(P4)=WHERE (POSITION=36 IF BIT0, 1 IF BIT35)
;RETURNS CPOPJ IF BIT IS ALREADY SET, CPOPJ1 NORMALLY RESPECTS T1
SETOS: PUSH P,T1 ;SAVE T1
MOVE T4,P4 ;WHERE
HRRZ T3,P3 ;COUNT
HLRZ T1,P4 ;POSITION IN WORD
PUSHJ P,BITMSK ;SET UP A MASK
SETOS1: TDNE T1,(T4) ;BIT ALREADY ON?
JRST SETOS2 ;YES
IORM T1,(T4) ;NO, NOW IT IS
JUMPLE T3,TPOPJ1 ;DONE IF COUNT .LE. 0
PUSHJ P,BITMS2 ;NOT DONE, GET MASK FOR NEXT WORD
JRST SETOS1 ;AND GO SET THE BITS IN THAT WORD
;HERE IF BIT ALREADY ON
SETOS2: PUSH P,T3 ;SAVE CURRENT COUNT
HLRZ T1,P4 ;RESTORE ORIGINAL VALUES
HRRZ T3,P3
MOVE T4,P4
PUSHJ P,BITMSK ;AND GENERATE A MASK
SETOS3: CAMN T3,(P) ;IS THE COUNT FOR MASK=COUNT WHEN SET?
JRST SETOS4 ;YES, DONE
ANDCAM T1,(T4) ;NO, CLEAR THOSE BITS
PUSHJ P,BITMS2 ;GENERATE NEXT MASK
JRST SETOS3 ;AND CONTINUE
SETOS4: POP P,(P) ;CLEARED ALL THE RIGHT BITS - FIX PD LIST
PJRST T1POPJ ;AND NON-SKIP RETURN
;SUBROUTINE TO OBTAIN FREE BITS, MARK THEM AS TAKEN IN THE TABLE
;ENTER WITH T1=HOW MANY,
;T2=XWD ADR OF 1ST WORD OF TABLE, ADR OF TABLE AOBJN WORD (OR 0, LOC OF AOBJN)
;RETURNS CPOPJ IF NOT ENOUGH AVAILABLE, T1=SIZE OF LARGEST HOLE
;RETURNS CPOPJ1 IF GOTTEN, T1= RELATIVE ADDRESS OF BLOCK OBTAINED
;T3 IS UPDATED AOBJN POINTER
INTERN GETBIT
GETBIT: PUSHJ P,SAVE4 ;SAVE P1-P4
TLNN T2,-1 ;STARTING AT AN OFFSET?
HRL T2,(T2) ;NO, START AT FIRST WORD
PUSH P,T2 ;SAVE ADR OF AOBJN WORD FOR TABLE
GETBI1: MOVE P1,0(P) ;GET AOBJN WORD
MOVE P1,(P1)
SETZ P2, ;NO BEST SO FAR
MOVE P3,T1 ;NUMBER OF BITS TO GET
PUSHJ P,GETZ ;GET THE BITS
JRST GETBI2 ;NOT ENOUGH AVAILABLE
HRRZ T1,P4 ;GOT THEM - FIRST WORD WITH ZEROES
HLRZ T2,(P) ;LOC OF FIRST WORD OF TABLE
SUBI T1,(T2) ;COMPUTE RELATIVE ADDRESS OF START
IMULI T1,^D36 ;36 BITS PER WORD
HLRZ T2,P4 ;BIT POSITION OF 1ST 0 IN THE WORD
MOVNS T2
ADDI T1,^D36(T2) ;T1= RELATIVE LOC WITHIN THE TABLE
PUSHJ P,SETOS ;MARK THE BITS AS TAKEN
SKIPA T1,P3 ;SOME FINK SNUCK IN ON US!
AOSA -1(P) ;GOT THEM - WIN RETURN
JRST GETBI1 ;TRY AGAIN TO GET SOME BITS
MOVE T3,P1 ;UPDATED POINTER
JRST T2POPJ ;RETURN
;HERE IF NOT ENOUGH ARE AVAILABLE
GETBI2: MOVE T1,P2 ;T1=LARGEST HOLE FOUND
PJRST T2POPJ ;NON-SKIP RETURN
;ROUTINE TO CLEAR BITS FROM A TABLE
;ENTER T1=POSITION, T3=COUNT, T4=TABLE ADR
; POSITION=36 IF BIT0, 1 IF BIT35
;RETURNS POPJ IF BIT ALREADY 0, POPJ1 OTHERWISE
INTERN CLRBTS
CLRBTS: PUSHJ P,BITMSK ;GENERATE A MASK
CLRBT1: MOVE T2,(T4) ;WORD TO CLEAR BITS FROM
TDC T2,T1 ;ARE THE BITS ALREADY OFF?
TDNE T2,T1
POPJ P, ;RETURN
MOVEM T2,(T4) ;NO, NOW THEY ARE
JUMPLE T3,CPOPJ1 ;DONE IF COUNT .LE. 0
PUSHJ P,BITMS2 ;GENERATE MASK FOR NEXT WORD
JRST CLRBT1 ;AND GO CLEAR THOSE BITS
$LOW
GHOLE: BLOCK 1 ;LARGEST HOLE IN PRIMARY FREE CORE MAP
STPPDL: BLOCK 25 ;STACK USED DURING STOP CODES
$LIT
PRGEND ;END OF COMMON SUBROUTINES
TITLE KRNIPC - MCS-10 INTERFACE TO THE INTER PROCESS COMM SYSTEM
SUBTTL D.TODD/DRT/CDO/ILG 1 JUNE 1977
SEARCH KERNEL,MACTEN,UUOSYM ;LOAD ALL THE UNIVERSALS
$RELOC
;PROCESS ROUTINE CALLED FROM THE SCHEDULER TO LOOK AN SYSTEM MESSAGES
MCSIPC:: ;ENTRY POINT
MOVEI T1,0 ;NO RACES
EXCH T1,IPCFLG## ;GET THE FLAGS
JUMPE T1,CPOPJ## ;FALSE CALL (EXIT)
SETOM RUNIPC## ;SCHEDULE AGAIN
TLNE T1,PAGSIZ ;PAGE TRANSFER
PJRST CMDPRO## ;YES, GO TO THE COMMAND PROCESSOR
SKIPA T1,.+1 ;LOAD PACKET POINTER
XWD ^D8,MSGREC ;..
MOVEM T1,PAKREC##+.IPCFP
MOVX T1,IP.CFT ;SET FLAG TO TRUNCATE IF TOO LONG
PUSHJ P,RECIPC ;GET THE PACKET
;DISPATCH DEPENDING ON WHO SENT THE MESSAGE
MOVE T1,PAKREC##+.IPCFL ;GET THE FLAGS
ANDI T1,IP.CFC ;SYSTEM SENDER CODE
LSH T1,-3 ;POSITION
JRST @IPCTBL(T1) ;DISPATCH
;IPCTBL DISPATCH ADDRESS
IPCTBL: JRST CPOPJ ;EXIT NOT A SYSTEM FUNCTION
JRST IPCIPC ;[SYSTEM]IPCC
JRST IPCINF ;[SYSTEM]INFO (SYSTEM WIDE)
JRST IPCINF ;[SYSTEM]INFO (PRIVATE VERSION)
;HERE FOR SYSTEM FUNCTION (IE. IPCC)
IPCIPC: HRRZ T1,MSGREC##+.IPCS0 ;GET THE FUNCTION CODE
CAIE T1,.IPCSC ;CREATE PID FOR MPP
POPJ P, ;NO, MUST BE JUNK MAIL
HRRZ T1,MSGREC##+.IPCS1 ;GET THE JOB NUMBER OF THE MPP
CAMN T1,JOBMCS## ;A PID FOR US
JRST IPCIP1 ;YES
MOVE J,JSNCO1## ;SEARCH THE JOB SLOTS FOR THE MPP
SRCJB: AOBJP J,CPOPJ## ;JUNK NUMBER
HLRZ T2,JB$UDX##(J) ;GET THE JOB NUMBER
CAIE T1,(T2) ;IS THIS IT
JRST SRCJB ;NO TRY AGAIN
MOVE T1,MSGREC##+.IPCS2 ;GET THE ASSIGNED PID
MOVEM T1,JB$PID##(J) ;STORE THE PID
POPJ P, ;RETURN
;STORE OUR PID
IPCIP1: MOVE T1,MSGREC##+.IPCS2 ;GET THE PID
MOVEM T1,PIDMCS## ;STORE THE PID
POPJ P, ;EXIT
;HERE FOR MESSAGES FROM [SYSTEM]INFO
;
IPCINF: SKIPA T1,.+1 ;LOAD THE MASK
XWD 377776,.IPCII
CAMN T1,MSGREC##+.IPCI0 ;CREATE A PID FOR US
JRST IPCIF1 ;YES
HRRZ T1,MSGREC##+.IPCI0 ;NO GET THE FUNCTION CODE
CAIE T1,.IPCII ;ANY CREATE FUNCTION
POPJ P, ;NO, JUNK MAIL
;
;HERE FOR SIGN ON A DEBUGGING MPP
;
TXC OPRFLG,CMDSTR!CMDDEB ;MUST BE STARTED AND DEBUG MPPS
TXCN OPRFLG,CMDSTR!CMDDEB ;ALLOWED TO DO THIS
PUSHJ P,GETJSN## ;GET AN AVAILABLE JOB SLOT
POPJ P, ;NONE AVAILABLE (IGNORE THE REQUEST)
MOVE T1,MSGREC##+.IPCI1 ;GET THE PID FOR THE MPP
MOVEM T1,JB$PID##(J) ;STORE THE PID
MOVX T1,JBEPI$ ;SET WAITING FLAG
MOVEM T1,JB$MLF##(J) ;SET THE FLAGS
SETZM JB$MPP##(J) ;CLEAR THE PROTOTYPE MPP POINTER
SETOM JB$UDX##(J) ;DUMMY JOB NUMBER/UDX
POPJ P, ;EXIT
IPCIF1: MOVE T1,MSGREC##+.IPCI1 ;GET THE PID
MOVEM T1,PIDDEB## ;STORE THE DEBUGGING PID
POPJ P, ;EXIT FROM IPCF HANDLER
;SUBROUTINE RECIPC RECEIVE A MESSAGE FROM IPCF
;CALL MOVE T1,FLAGS
; PUSHJ P,RECIPC
;ALWAYS RETURN CPOPJ
RECIPC: ;ENTRY POINT
MOVEM T1,PAKREC##+.IPCFL ;STORE THE FLAGS
RECIP1: SKIPA T1,.+1 ;LOAD THE ARGUEMNT
XWD ^D4,PAKREC##
IPCFR. T1, ;GET THE MESSAGE
JRST RECIP2 ;ERROR, DO SOME ANALYSIS
EXCH T1,IPCFLG## ;STORE NEW, GET IF CHANGED AT INT LEVEL
SKIPE T1 ;DID INTERRUPT OCCUR
MOVEM T1,IPCFLG## ;YES, PUT INTERRUPT STATUS BACK
POPJ P, ;AND RETURN
RECIP2:
CAIE T1,IPCUP% ;NO ROOM?
$STPCD(IRF,IPCF RECEIVE FAILED)
PUSHJ P,PANOUT## ;FORCE PANIC PAGE OUT
JRST RECIP1 ;AND TRY AGAIN
;SUBROUTINE RECPAG - RECEIVE A PAGE FROM AN MPP
;CALL PUSHJ P,RECPAG
; RETURN CPOPJ WITH J = JSN,,ADDR OR 0
$ENTRY (INIPC) ;GET A MESSAGE FROM A MPP
RECPAG: PUSHJ P,GIPCPG## ;GET A FREE PAGE (IPC POOL)
$STPCD(NFP,NO FREE PAGES)
HRLI T1,PAGSIZ ;INSERT THE PAGE SIZE
MOVEM T1,PAKREC##+.IPCFP ;STORE THE MESSAGE POINTER
PUSH P,T1 ;SAVE THE PAGE NUMBER
MOVX T1,IP.CFV ;PAGE MODE FLAG
PUSHJ P,RECIPC ;GET THE PAGE
MOVX T1,IP.CFM ;RETURNED MESSAGE STATUS
TDNE T1,PAKREC##+.IPCFL ;WAS THIS ONE I SENT BEFORE
JRST RJUNKP ;YES, ATTEMPT CLEAN UP
MOVE T1,PAKREC##+.IPCFS ;GET THE SENDERS PID
MOVE J,JSNCO1## ;SEARCH FOR THE MPP
RECPA1: AOBJP J,UNKPID ;NOT A PID KNOWN TO US
CAME T1,JB$PID(J) ;IS THIS THE USERS
JRST RECPA1 ;NO, TRY AGAIN
POP P,T1 ;GET THE PAGE NUMBER BACK
LSH T1,P2WLSH ;GET AN ADDRESS
HRLI T1,(J) ;INSERT THE JSN
MOVE $V,T1 ;COPY JSN,,PAGE NUMBER ADDRESS
POPJ P, ;RETURN
;BAD PAGE
RJUNKP: SETZ $V, ;NO PAGES
TXO OPRFLG,RCVALL ;TRY ALL KNOWN MPPS NEXT PASS
SETOM RUNROL## ;MAY HAVE RECOVERED A JOB SLOT
POP P,T2 ;GET THE PAGE NUMBER
LSH T2,P2WLSH ;GET AN ADDRESS
MOVEI T1,1 ;ONE PAGE
PJRST GIVPAG## ;RETURN THE PAGE AND EXIT
; HERE IF RECEIVED PAGE FROM SOMEONE NOT KNOWN TO MCP
UNKPID: MOVEM T1,PAKSND##+.IPCFR ;STORE RECEIVER = SENDER
MOVE T1,0(P) ;GET 1000,,PAGE NUMBER
MOVEM T1,PAKSND##+.IPCFP ;STORE DATA POINTERS
LSH T1,P2WLSH ;CONVERT TO ADDRESS
HRROI T2,-6 ;THATS "WHO R U" STS IN PAGE
MOVEM T2,1(T1) ;STORE AS ERROR INDICATION
;(.PAGEADDR)[P0STATUS] _ STSWHORU
MOVX T1,IP.CFV ;PAGE MODE SEND
PUSHJ P,SNDIPC ;SEND THE PAGE AWAY
PJRST RJUNKP ;WELL, WE TRIED ANYHOW...
SETZ $V, ;RETURN ERROR TO BLISS CODE
POP P,T2 ;RESTORE PAGE NUMBER
HRRZS T2 ;ONLY WANT THE PAGE NUMBER
MOVEI T1,1 ;RETURN PAGE
PJRST PIPCPG## ;AND EXIT
$ENTRY (OUTIPC,<.PAGE,.JSN>) ;SEND A MESSAGE TO A MPP
HRRZ T1,.PAGE ;GET THE PAGE NUMBER
LSH T1,W2PLSH ;CONVERT TO A PAGE NUMBER
HRRZ J,.JSN ;GET THE JOB SLOT NUMBER
;FALL INTO SNDPAG
;SUBROUTINE SNDPAG - SEND A PAGE TO THE MPP
;CALL MOVEI J,JSN ;MPP TO SEND TO
; MOVEI T1,PAGE NUMBER ;PAGE TO SEND
; PUSHJ P,SNDPAG ;CALL
; CPOPJ ;PAGE HAS BEEN SENT TO THE MPP
SNDPAG: ;ENTRY POINT
PUSH P,T1 ;SAVE THE AGE NUMBER
HRLI T1,PAGSIZ ;ADD THE PAGE SIZE
MOVEM T1,PAKSND##+.IPCFP ;STORE THE POINTER
SKIPN T1,JB$PID##(J) ;GET THE PID
HLRZ T1,JB$UDX##(J) ;NONE GET THE JOB NUMBER
MOVEM T1,PAKSND##+.IPCFR ;STORE THE RECEIVER
MOVX T1,IP.CFV ;PAGE MODE
PUSHJ P,SNDIPC ;SEND TO IPCF
JRST RJUNKP ;ERROR, SET CONDITIONS AND PITCH THE PAGE
POP P,T2 ;RESTORE THE PAGE NUMBER
MOVEI T1,1 ;ONE PAGE
PJRST PIPCPG## ;REMOVE THE PAGE FROM THE BIT TABLES
SUBTTL SEND TO IPCF
;SUBROUTINE IPCQTA - SET A QUOTA FOR A JOB
;CALL MOVE T1,[XWD JOB NUMBER,QUOTAS]
; PUSHJ P,IPCQTA
;RETURN CPOPJ ;ERROR T1=CODE
; CPOPJ1 ;OK
IPCQTA:: ;ENTRY POINT
HLRZM T1,MSGSND##+.IPCS1 ;STORE THE JOB NUMBER(PID)
HRRZM T1,MSGSND##+.IPCS2 ;STORE THE QUOTAS
MOVEI T1,.IPCSQ ;QUOTA FUNCTION
PJRST IPCCST ;SET THE FUNCTION
;SUBROUTINE MAKPID MAKE A PID FOR A SUBJOB (MPP)
;CALL MOVEI J,JSN
; PUSHJ P,MAKPID
;RETURN CPOPJ ;ERROR
; CPOPJ1 ;OK T1=PID
MAKPID:: ;ENTRY POINT
HLRZ T1,JB$UDX(J) ;GET THE MPP JOB NUMBER
MOVEM T1,MSGSND##+.IPCS1 ;STORE THE JOB NUMBER
MOVEI T1,.IPCSC ;CREAT PID FUNCTION
;
;SUB LEVEL ENTRY TO SEND MESSAGE TO IPCC
;T1=IPCC FUNCTION CODE
;
IPCCST::MOVEM T1,MSGSND##+.IPCS0 ;STORE THE FUNCTION
MOVE T1,PIDIPC## ;GET THE PID OF IPC
MOVEM T1,PAKSND##+.IPCFR ;RECEIVER
SETZM PAKSND##+.IPCFS ;CLEAR THE SENDER
SKIPA T1,.+1 ;LOAD THE MESSAGE POINTER
XWD ^D8,MSGSND## ;....
MOVEM T1,PAKSND##+.IPCFP ;STORE
MOVX T1,IP.CFP ;INVOKING PRIVS
PJRST SNDIPC ;SEND THE MESSAGE
;SUBROUTINE SNDINF SEND A PACKET TO [SYSTEM]INFO
;CALL PUSHJ P,SNDINF ;MESSAGE ALREADY SET UP IN MSGSND
;RETURN CPOPJ ;ERROR IN SEND
; CPOPJ1 ;SEND OK
SNDINF:: ;ENTRY POINT
SETZM PAKSND##+.IPCFS ;CLEAR THE SENDER
SETZB T1,PAKSND##+.IPCFR ;CLEAR THE RECEIVER (ASSUMES INFO)
;SUBROUTINE SNDIPC SEND A PACKET OR PAGE
;CALL MOVE T1,FLAGS
; PUSHJ P,SNDIPC
;RETURN CPOPJ ;ERROR T1=ERROR CODE
; CPOPJ1 ;MESSAGE SENT
SNDIPC: ;ENTRY POINT
MOVEM T1,PAKSND##+.IPCFL ;STORE THE FLAGS
SKIPA T1,.+1 ;LOAD THE CONTROL WORD POINTER
XWD ^D4,PAKSND## ;ARGUMENT TO THE IPCFS UUO
IPCFS. T1, ;SEND THE MESSAGE
POPJ P, ;ERROR
JRST CPOPJ1## ;OK
$LIT
PRGEND
TITLE KRNQUE- MESSAGE CONTROL PROGRAM INPUT/OUTPUT CONTROL SYSTEM
SUBTTL D.TODD/DRT/CDO/ILG 1 JUNE 1977
SEARCH KERNEL,MACTEN,UUOSYM ;LOAD ALL THE UNIVERSALS
$RELOC
SUBTTL QUE FILE I/O ROUTINES
$ENTRY (DSKALL,<.NUM>)
HRRZ T2,.NUM ;GET THE AMOUNT REQUESTED
JUMPN T2,.+2 ;MUST BE NON ZERO AMOUNT
$STPCD(RZP,REQUEST FOR ZERO PARTICLES)
PUSHJ P,GETPTL ;ALLOCATE THE PARTICALS
JUMPN T2,.-1 ;GET THE MAX ALLOWED
JUMPN T2,DSKAL2
$SAY (<@?MCSQFF Failsoft/Rollout File is Full@>)
TXO OPRFLG,KNORFR ;DONT REFRESH THE FAILSOFT FILE
JRST KCLOSE## ;AND SHUT MCS DOWN
DSKAL2: HRLI $V,(T2) ;RETURN $V=XWD AMT,,ADDRESS
HRRI $V,(T1) ;LOCATION
POPJ P, ;END RETURN
;SUBROUTINE TO GET "FREE" PARTICALS
;ENTER GETPTL T2=# N PARTICALS BLOCKS TO GET
;RETURN CPOPJ IF NOT AVAILABLE, WITH T2=LARGEST HOLE AVAILABLE
;RETURN CPOPJ1 IF GOTTEN, WITH T1=THE PARTICAL ADDRESS
GETPTL:: TXZ OPRFLG,RFRAD ;FILE HAS CHANGED SINCE REFRESH TIME
MOVE T1,Q$BASE## ;REMEMBER BASE FOR SWAPPING PATS
MOVEM T1,OLDBAS ;SAVE FOR LATER COMPARES
MOVEI T1,(T2) ;NUMBER OF BLOCKS TO GET
PUSH P,T1 ;SAVE NUMBER BEING REQUESTED
GETPT1: MOVEI T2,Q$BPTR## ;L(AOBJN WORD)
PUSHJ P,GETBIT## ;GET, SET THE BITS
JRST GETPT2 ;NOT ENOUGH AVAILABLE
ADD T1,Q$BASE## ;+START OF TABLE = ACTUAL ADDRESS
HRROS QP$BLK## ;SET QUEPAT MODIFIED
MOVE T2,0(P) ;GET AMOUNT GOTTEN
ADDB T2,Q$USED## ;UPDATE RUNNING TOTAL
CAMLE T2,QP$MAX## ;CHECK FOR INCONSISTENCY
$STPCD(PCM,PARTICLE IN USE COUNT GREATER THAN MAXIMUM)
ADDX T2,QU$FUL ;GET RESERVE QUOATA+USED
CAML T2,QP$MAX## ;HAVE WE GOT THAT MUCH LEFT?
PUSHJ P,SETPTF ;NO
POP P,T2 ;RESTORE T2
PJRST CPOPJ1## ;TAKE GOOD RETURN
;HERE IF REQUESTED AMOUNT ISNT AVAILABLE
GETPT2: SKIPE T2,T1 ;COPY SIZE OF BEST HOLE
PJRST T1POPJ## ;SOME LEFT IN THIS PAT, RETURN TO GET THEM
;HERE IF THE CURRENT PAT BLOCK IS COMPLETELY FULL
GETPT3: MOVE T2,Q$BASE## ;GET THE BASE FOR THIS PAT
ADDI T2,QU$BA ;STEP TO NEXT PAT BLOCK
CAML T2,QP$MAX## ;EXCEEDING THE MAX
SETZ T2, ;YES, GO BACK TO THE FIRST PAT
PUSHJ P,SWPPAT ;SWAP THE PATS
CAMN T2,OLDBAS ;BACK TO ORIGINAL PAT BLOCK
JRST [SETZ T2, ;YES, NO SPACE LEFT IN THE FILE
PJRST T1POPJ##] ;GIVE FAIL RETURN
MOVE T1,(P) ;NOT YET, GET REQUEST AMOUNT AGAIN
JRST GETPT1 ;AND TRY THE NEW PAT
; QUEUE (F/R) FILE FULL CONDITION SET AND CLEAR ROUTINES
; THE SETPTF FULL ROUTINE FIRST CHECKS TO SEE IF THE FILE IS GREATER THAN 2**18 PARTICLES
; OR EXTENDABILITY IS TURNED OFF (FSSIZE .LT. 0). IF EITHER CONDITION IS TRUE,
; THEN WE GIVE A WARNING AND SET Q$FULL FOR FURTHER REMEDIAL ACTION.
; IF NEITHER CONDITION IS TRUE, WE ALLOCATE ANOTHER PAT AND EXTEND THE F/R FILE.
SETPTF: PUSHJ P,SAVT## ;SAVE SOME REGISTERS
MOVE T1,QP$MAX## ;GET LARGEST PARTICAL IN FILE
ADDI T1,QU$BA ;ADD PARTICLES PER ALLOCATION
SKIPL FSSIZE## ;EXTENDABILITY TURNED OFF?
CAILE T1,-1 ;OR WOULD THIS PUT US OVER 1/2WORD?
JRST SETP90 ;ONE OR THE OTHER
MOVEM T1,QP$MAX## ;STORE NEW MAXIMUM
$SAY (<[MCSXQF Extending QUEUE file to >)
MOVE T1,QP$MAX## ;OUTPUT WHAT WE ARE EXTENDING IT
PUSHJ P,PUTDEC## ;TO
$SAY (< particles]@>)
HRROS QD$BLK## ;JUST IN CASE, WRITE IT OUT FIRST
PUSHJ P,PTLWRT ;WRITE OUT LAST PARTICLE
PUSH P,QD$BLK## ;REMEMBER BLOCK CURRENTLY IN CORE
MOVE T2,[QUEDAT##+2,,QUEDAT##+3] ;SET UP FOR BLT
SETZM QUEDAT##+2 ;SET FIRST TO ZERO
BLT T2,QUEDAT##+201 ;ZERO THE ENTIRE BLOCK
MOVSI T2,740000 ;MARK THE PAT BLOCK PARTICLES IN USE
MOVEM T2,QUEDAT##+2 ;IN THE PAT BLOCK
MOVE T2,QP$MAX## ;GET FIRST FREE PARTICLE
SUBI T2,QU$BA ;RESTORE TO OLD MAX FOR EXTENSION
IDIVI T2,QU$PD ;AND CONVERT TO BLOCKS FROM PARTICLES
HRROM T2,QD$BLK## ;STORE AS MODIFIED,,PARTICLE NUMBER
PUSHJ P,PTLWRT ;WRITE OUT THE PARTICLE
SETZM QUEDAT##+2 ;MAKE PARTICLE ALL ZERO
MOVE T1,QP$MAX## ;GET NEW MAXIMUM PARTICLE NUMBER
IDIVI T1,QU$PD ;CONVERT FROM PARTICLES TO BLOCKS
SOJ T1, ;BACK OFF ONE
HRROM T1,QD$BLK## ;STORE AS MAXIMUM PARTICLE TO WRITE OUT
MOVEI T1,4 ;ADD PAT BLOCK USED TO USED COUNT
ADDM T1,Q$USED## ;SO WHAT QFILE WORKS RIGHT
POP P,T1 ;RESTORE BLOCK THAT USED TO BE IN CORE
HRRZS T1 ;REMOVE JUNK FROM LEFT HALF
IMULI T1,QU$PD ;TO A PARTICLE NUMBER
PJRST LOCPTL ;BRING THAT BACK IN, WRITE OUT NEW ALLOCATION
SETP90: SETOM Q$FULL## ;TURN FILE FULL FLAG ON
TXOE OPRFLG,QUEWRN ;TIME FOR THE WARNING?
POPJ P, ;NO,JUST RETURN
$SAY (<@%MCSFRF Fewer than >)
MOVEI T1,QU$FUL ;GET RESERVED LIMIT
PUSHJ P,PUTDEC## ;OUTPUT IN DECIMAL
$SAYRET (< particles left in QUEUE file>)
CLRPTF: SETZM Q$FULL## ;CLEAR THE FULL CONDTION FLAG
SETOM RUNMSR## ;FORCE MSREAD TO RUN
SETOM RUNROL## ;MAYBE SOME ROOM FOR THE ROLLER NOW
POPJ P, ;RETURN
;SUBROUTINE TO RETURN "FREE" PARTICALS
$ENTRY (DSKDEA,<.NUM,.PART>)
HRRZ T1,.NUM ;GET THE NUMBER OF PARTICALS
HRRZ T2,.PART ;FIRST PARTICAL NUMBER
;FALL INTO GIVPTL
;ENTER GIVPT : T1=# PARTICALS TO RETURN, T2=STARTING PARTICAL ADDRESS
GIVPTL::SKIPE T3,Q$BASE## ;GET THE CURRENT BASE
CAIL T2,(T3) ;CHECK THE RANGE
CAILE T2,QU$BA(T3) ;AND THE HIGH END
PUSHJ P,SWPPAT ;NOT IN RANGE, SWAP THE PATS
PUSH P,T1 ;SAVE NUMBER RETURNING
MOVNS T1 ;NEGATE
ADDB T1,Q$USED## ;UPDATE THE RUNNING TOTAL
SKIPGE T1 ;ARE WE LEGAL?
$STPCD(PCN,PARTICLE IN USE COUNT IS NEGATIVE)
ADDX T1,QU$FUL ;GET WARNING RESERVE+USED
SKIPN Q$FULL## ;IS FULL FLAG ON NOW?
JRST GIVPT1 ;NO, SAVE A FEW CYCLES
CAMG T1,QP$MAX## ;IN RANGE OF UPPER LIMIT TO MAX?
PUSHJ P,CLRPTF ;NO,SO CLEAR THE FULL FLAG
GIVPT1: ADDX T1,QU$FLL-QU$FUL;UPDATE TO LOWER RESERVE+USED
CAMG T1,QP$MAX## ;ARE WE BELOW IT NOW?
TXZ OPRFLG,QUEWRN ;YES, CLEAR IT
POP P,T1 ;RESTORE T1
SUB T2,Q$BASE## ;GET ADR. RELATIVE TO START OF TABLE
CAIG T2,3 ;DON' ALLOW PAT BLOCK REFERENCES
$STPCD(ARP,ATTEMPT TO RELEASE PAT BLOCK)
IDIVI T2,^D36 ;COMPUTE WORD LOC, STARTING BIT
HRLS T2 ;WORD POSITION IN BOTH HALVES
ADD T2,Q$BPTR## ;SET AOBJN WORD FOR TABLE
HRROS QP$BLK## ;SET QUEPAT MODIFIED
PJRST SETZRS## ;CLEAR THE BITS
SUBTTL SWPPAT - SUBROUTIE TO READ AND WRITE PAT BLOCKS
;SUBROUTINE SWPPAT SWAP THE PAT BLOCK THAT IS IN CORE WITH A NEW ONE
;CALL MOVEI T2,PARTICAL NUMBER OR 0
; PUSHJ P,SWPPAT
; CPOPJ ;PATS ARE SWAPPED
SWPPAT:: ;ENTRY POINT
PUSHJ P,SAVT## ;SAVE THE TEMPS
PUSHJ P,PATWRT ;WRITE OUT CURRENT PAT BLOCK(MAYBE)
IDIVI T2,QU$BA ;GET THE RELATIVE PAT BLOCK NO. IN T2
IMULI T2,QU$DA ;GET THE PHYSICAL PAT NUMBER IN T3
HRRZM T2,QP$BLK## ;STORE THE BLOCK NUMBER
USETI QUE,1(T2) ;SET THE INPUT TO THE BLOCK
IMULI T2,QU$PD ;COMPUTE THE BASE OF THE PAT
MOVEM T2,Q$BASE## ;STORE THE NEW BASE
IN QUE,QUEPAT## ;READ IN THE PAT BLOCK
POPJ P, ;RETURN (PATS ARE SWAPPED)
ERRSET F%IN ;INPUT FAILED,SO
JRST QIOERR ;REPORT QUEUE FILE IO ERROR
;SUBROUTINE PATWRT - WRITE THE PAT BLOCK OUT
;CALL PUSHJ P,PATWTR ;WRITE IT OUT
; CPOPJ ;ALWAYS RETURN HERE
PATWRT::SKIPL T1,QP$BLK ;GET CURRENT BLOCK NUMBER
POPJ P, ;NOT MODIFIED-EXIT
USETO QUE,1(T1) ;SET UP OUTPUT BLOCK NUMBER
OUT QUE,QUEPAT## ;WRITE PAT BLOCK OUT
POPJ P, ;SUCCEEDED--EXIT
ERRSET F%OUT ;OUTPUT FAILED
QIOERR:
GETSTS QUE,T1 ;RETREIVE IO STATUS
ERRSET (,T1) ;
MOVSI T1,'QUE' ;ID FOR THIS FILE
PUSHJ P,ERRFIL## ;TELL ABOUT THE ERROR
PJRST ABORT## ;STOP RUNNING
;SUBROUTINES TO READ AND WRITE THE QUE FILE
DGET::
$ENTRY (DREAD,<.PART>)
HRRZ T1,.PART ;GET THE PARTICAL NUMBER
HRLI $V,(T1) ;STORE THE PARTICAL NUMBER
IDIVI T1,QU$BA ;DO A LITTLE RANGE CHECKING HERE
HLRZ T1,$V ;RESTORE T1
CAMGE T1,QP$MAX## ;OFF THE END OF THE FILE
CAIG T2,3 ;OR REFERRENCING A PAT BLOCK
$STPCD(QRF,QUEUE FILE RANGE CHECK FAILED)
PUSHJ P,LOCPTL ;LOCATE THE PARTICAL
HRRI $V,(T1) ;LOAD PARTICAL ADDR IN $V
POPJ P, ;AND RETURN
$ENTRY (DPAT)
PUSHJ P,PTLWRT ;WRITE THE PARTICLE OUT FIRST
HRRZS QD$BLK## ;SET THAT IT HAS BEEN WRITTEN OUT
PUSHJ P,PATWRT ;WRITE PAT OUT
HRRZS QP$BLK## ;INDICATE THAT IT HAS BEEN WRITTEN
POPJ P, ;RETURN
$ENTRY (DWRITE,<.ADR,.PART>)
HRRZ T1,.PART ;IS THERE A PARTICAL
HRLZ $V,T1 ;STORE THE PARTICAL NUMER
HRR $V,.ADR ;GET THE PARTICAL ADDRESS
HRROS QD$BLK## ;MARK BLOCK MODIFIED
IDIVI T1,QU$PD ;CONVERT TO A BLOCK NUMBER
HRRZ T2,QD$BLK## ;CHECK AGAINST BLOCK JUST MARKED
CAME T1,T2 ;BETTER BE TRUE
$STPCD(IBN,INCORRECT BLOCK NUMBER)
POPJ P, ;RETURN
SUBTTL PHYSICAL I/O ROUTINES FOR THE ROLL FILE
;SUBROUTINE TO LOCATE A PARTICAL ON THE DISK AND DUMP THE MODIFIED ONE
;CALL MOVEI T1,PARTICAL NUMBER
; PUSHJ P,LOCPTL
; CPOPJ ;PATICAL IN CORE T1=FIRST WORD OF PARTICAL
LOCPTL: ;ENTRY POINT
IDIVI T1,QU$PD ;CONVERT PARTICALS TO DISK BLOCKS
;T1=DISK ADDRESS -1
;T2=OFFSET 0,1,2,3
MOVE T3,QD$BLK## ;GET THE CURRENT BLOCK NUMBER
CAIN T1,(T3) ;IS THE BLOCK IN CORE
JRST LOCPT4 ;YES, COMPUTE OFFSET
PUSHJ P,PTLWRT ;WRITE THE OLD PARTICLE OUT
HRRZM T1,QD$BLK## ;STORE THE NEW BLOCK NUMBER
USETI QUE,1(T1) ;SET THE INPUT BLOCK
IN QUE,QUEDAT## ;READ THE BLOCK
JRST LOCPT4 ;CONTINUE
ERRSET F%IN ;INPUT FAILED
JRST QIOERR ;REPORT QUEUE FILE IO ERROR
;COMPUTE THE OFFSET TO THE BUFFER
LOCPT4: IMULI T2,QU$WP ;COMPUTE THE OFFSET IN WORDS
ADDI T2,QUEDAT## ;ADD IN THE BUFFER ADDRESS
MOVEI T1,2(T2) ;PUT BACK IN T1 (RELOCATE TO THE DATA)
POPJ P, ;RETURN T1=THE PARTICAL ADDRESS
;SUBROUTINE TO WRITE A PARTICLE OUT
;CALL PUSHJ P,PTLWRT
;RETURN CPOPJ
PTLWRT::
SKIPL T3,QD$BLK## ;GET CURRENT BLOCK NO.
POPJ P, ;NOT MODIFIED-EXIT
USETO QUE,1(T3) ;MODIFIED-SO WRITE IT OUT
OUT QUE,QUEDAT##
POPJ P, ;SUCCEEDED!
ERRSET F%OUT ;OUTPUT FAILED
JRST QIOERR ;REPORT QUEUE FILE IO ERROR
;ROUTINE TO COUNT FREE SPACE IN THE QUE FILE. CALLED BY ONCE
; ONLY WITH THE FIRST PAT BLOCK IN CORE.
;RETURNS CPOPJ WITH THE COUNTS ACCUMULATED IN Q$USE AND Q$FULL SET IF NEEDED.
;WIPES T1-T4
USECNT::PUSHJ P,SAVE1## ;SAVE P1
PUSHJ P,CLRPTF ;CLEAR ANY FULL CONDITION FLAGS
MOVE P1,QP$MAX## ;ASSUME TOTALLY FULL
USEC.1: PUSHJ P,BTSPAT ;COUNT FREE SPACE IN THIS PAT BLOCK
SUB P1,T1 ;ADJUST COUNTS ACCORDINGLY
MOVE T2,Q$BASE## ;BASE PARTICLE
ADDI T2,QU$BA ;STEP TO NEXT PAT BLOCK
CAML T2,QP$MAX## ;DOES IT EXIST
JRST USEC.2 ;NO, DONE COUNTING
PUSHJ P,SWPPAT ;BRING IT INTO CORE
JRST USEC.1 ;COUNT SPACE IN IT TOO
USEC.2: SETZ T2, ;BACK TO PAT # 1
SKIPE Q$BASE## ;ALREADY IN CORE ( ONLY 1 IN FILE)
PUSHJ P,SWPPAT ;NO, BRING IT BACK IN
MOVEM P1,Q$USED## ;STORE AMOUNT ALREADY USED
SKIPGE P1 ;COUNT OK?
$STPCD(IUI,INITIAL PARTICAL USE COUNT INCORRECT)
ADDX P1,QU$FUL ;CHECK IF ALREADY FULL
CAML P1,QP$MAX## ;LESS THAN RESERVE LEFT IN THE FILE
PUSHJ P,SETPTF ;YES, TELL OPERATOR, SET Q$FULL
POPJ P, ;AND RETURN
;ROUTINE USED BY USECNT TO COUNT FREE SPACE IN CURRENT PAT BLOCK
;CALLED WITH PAT BLOCK IN CORE, RETURNS T1 = AMT OF FREE SPACE
BTSPAT: SETZB T1,T2 ;CLEAR COUNTERS
MOVSI T3,-200 ;WORDS IN A PAT BLOCK
BTSP.1: SKIPN T4,QUEPAT##+2(T3) ;GET A WORD
AOJA T2,BTSP.3 ;ALL ZERO, COUNT THE WORD
SETCA T4, ;EASIER TO COUNT 1 BITS
JUMPE T4,BTSP.3 ;ALL TAKEN, DON'T BOTHER
BTSP.2: TRNE T4,1 ;BIT AVAILABLE
AOS T1 ;YES, COUNT IT
LSH T4,-1 ;POSITION NEXT
JUMPN T4,BTSP.2 ;JUMP IF MORE FREE IN THE WORD
BTSP.3: AOBJN T3,BTSP.1 ;TRY ANOTHER WORD
IMULI T2,^D36 ;NUMBER OF FULL WORDS FREE
ADD T1,T2 ;PLUS PARTIAL WORDS
POPJ P, ;RETURN WITH FREE COUNT IN T1
$LOW
OLDBAS: BLOCK 1 ; Q$BASE AT ENTRY TO GETPTL
$LIT
PRGEND ;END OF KRNQUE
TITLE KRNMSG - MCS-10 INTERFACE TO MSGSER
SUBTTL D.TODD/DRT/AAG/CDO 1 JUNE 1977
SEARCH KERNEL,MACTEN,UUOSYM ;LOAD ALL THE UNIVERSALS
$RELOC
$LOW
RDXUDX: BLOCK MAXRDX ; LH = DROP NUMBER, RH = REAL UDX
;FAKE UDX = 070000 + INDEX INTO RDXUDX
FAKUDX==70B26 ;SYMBOLIZE THE OFFSET
FAKNDX==^D4095 ;AND THE INDEX PART
; TABLES USED IN KRNMSG INDEXED BY THE CORRECT CHANNEL NUMBER
;MPX OUTPUT FAILURE TABLE
MXNFAI: EXP 0,0,0,0
$HIGH ;OTHERS ARE IN THE HIGHSEG
;WHERE THE RING HEADERS ARE
MXNRNG: XWD MX0OUT##,MX0IN##
XWD MX1OUT##,MX1IN##
XWD MX2OUT##,MX2IN##
XWD MX3OUT##,MX3IN##
;HOW TO READ INPUT
MXNIN: IN MX0,
PUSHJ P,INRDX
IN MX2,
IN MX3,
;HOW TO DO OUTPUT
MXNOUT: OUT MX0,
OUT MX1,
OUT MX2,
OUT MX3,
;SPECIAL ACTIONS FOR BRAND NEW BUFFERS
MXNPRM: JFCL
PUSHJ P,PRMRDX
JFCL
JFCL
;GETSTS FOR I/O ERRORS
MXNGTS: GETSTS MX0,T1
GETSTS MX1,T1
GETSTS MX2,T1
GETSTS MX3,T1
;CLOSE FOR EOF ON MPX INPUT
MXNCLO: CLOSE MX0,CL.OUT
CLOSE MX1,CL.OUT
CLOSE MX2,CL.OUT
CLOSE MX3,CL.OUT
SUBTTL INMSG - INPUT A MESSAGE FROM MSGSER
MXNMAX==-4 ;AOBJN FOR NUMBER OF CHANNELS
$ENTRY (INMSG)
SKIPN C$FULL## ;IS CORE FULL?
SKIPE Q$FULL## ;OR THE QUEUE FILE?
JRST INMEMP ;YES,FAKE "NO MESSAGES"
TXNN OPRFLG,CMDNET ;ACCEPTING INPUT FROM THE NETWORK
PUSHJ P,IBKMXN ;READ A BUFFER
JRST INMEMP ;NO BUFFERS (EXIT WITH $V=0)
PUSHJ P,SAVE1## ;SAVE P1
MOVEI P1,(T1) ;PUT THE RING HEADER IN A SAFE PLACE
PUSHJ P,BLDCNK ;BUILD THE MESSAGE CHUNK
MOVE T4,MXNLST## ;GET MPX CHANNLE INDEX
MOVE T1,.BFCTR(P1) ;GET REMAINING CHAR COUNT
MOVEM T1,MXNSTS##(T4) ;SAVE IN MPX STATUS AREA FOR CHANNEL
SETOM RUNMSR## ;RUN MSREAD AGAIN
CAIA ;SKIP OVER OTHER STUFF
INMEMP: SETZ $V, ;NO MESSAGES TO PASS TO MCP
POPJ P, ;RETURN
;SUBROUTINE IBKMXN - INPUT A MESSAGE FROM THE FRONT END DEVICES
;CALL PUSHJ P,IBKMXN
;RETURN CPOPJ ;NO MESSAGES AVAILABLE
; CPOPJ1 ;MESSAGE AVAILABLE T1=RING HEADER OF MESSAGE
IBKMXN: ;ENTRY POINT
MOVSI T4,MXNMAX ;TO SEARCH TABLES
IBKMX2: SKIPN MX0CON##(T4) ;ANY DEVICES ON THIS CHANNEL
JRST IBKMX4 ;NO DO NOT DO A UUO
SKIPG MXNSTS(T4) ;DOES OLD BUFFER STILL HAVE DATA
IBKMX1: XCT MXNIN(T4) ;NO, TRY TO GET SOME FROM OUR DEVICES
JRST IBKMX3 ;HAVE SOME TO LOOK AT
XCT MXNGTS(T4) ;INPUT FAILED, GET ERROR BITS
TRNE T1,IO.EOF ;EOF ON INPUT
JRST [XCT MXNCLO(T4) ;YES, CLOSE INPUT SIDE OF MPX
JRST IBKMX1] ;AND TRY ANOTHER INPUT
TRNN T1,740000 ;ANY OTHER INTERESTING ERROR BITS
JRST IBKMX4 ;NO, MUST BE NO DATA AVAILABLE
MOVEM T1,ERRAUX## ;STORE BITS FOR TYPEOUT
ERRSET F%IN ;INPUT FAILED
MOVE T1,[SIXBIT/MX0 MX1 MX2 MX3 /](T4)
PUSHJ P,ERRFIL## ;OUTPUT MESSAGE
JRST ABORT## ;AND GIVE UP NOW
IBKMX4: AOBJN T4,IBKMX2 ;NO, TRY AGAIN
POPJ P, ;RETURN NO DATA AVAILABLE
IBKMX3: HRRZ T1,MXNRNG(T4) ;GET THE INPUT RING HEADER ADDRESS
MOVEM T4,MXNLST## ;STORE THE LIST POINTER
PJRST CPOPJ1## ;EXIT WITH THE RING POINTER
;SUBROUTINE BLDCNK - TAKE INPUT FROM ANY BUFFER AND FORM A CHUNK
;CALL MOVEI P1,ADDRESS OF BUFFER RING HEADER
; PUSHJ P,BLDCNK
;RETURN CPOPJ ADDRESS OF CHUNK IN $V
BLDCNK: MOVEI T2,QU$WP ;CHUNK SIZE
PUSHJ P,GETWDS## ;ALLOCATE
PJRST INMEMP ;DATA STILL IN BUFFERS, COME BACK LATER
MOVEI $V,0(T1) ;SET THE CHUNK'S ADDRESS
HRL $V,.BFUDX(P1) ;INSERT THE UDX
MOVSI T1,(POINT 7) ;ASCII TEXT
MOVEM T1,($V) ;STORE POINTER
MOVSI T3,-<<QU$WP-2>*5> ;SIZE THE DATA FIELD
MOVSI T4,(POINT 7,0,35) ;POINTER TO STORE THE TEXT
HRRI T4,1($V) ;INSERT THE CHUNK ADDRESS
INMCPY: SOSGE .BFCTR(P1) ;REDUCE CHARACTER COUNT
JRST INMEND ;END OF INPUT
ILDB T1,.BFPTR(P1) ;GET INPUT CHAR
CAIN T1,015 ;CR CHAR?
XCT FIXCR## ;YES- MAYBE DO SPECIAL STUFF
CAIN T1,012 ;LF CHAR?
XCT FIXLF## ;MAYBE DO SPECIAL STUFF
JUMPE T1,INMCPY ;IF NULLS IGNORE THE CHAR
CAIN T1,EGI## ;CHECK FOR SPECIAL TERMINATORS
HRLI T1,3 ;SET FLAG
CAIN T1,EMI## ;END OF MESSAGE FLAG
HRLI T1,2 ;YES, SET FLAG
CAIN T1,ESI## ;END OF SEGMENT FLAG
HRLI T1,1 ;SET VALUE
IDPB T1,T4 ;STORE THE CHARACTER
TLNN T1,-1 ;ANY SPACIAL CHARACTER
AOBJN T3,INMCPY ;NO, CONTINUE COPY
INMEND: ANDCMI T1,-1 ;YES, CLEAR THE RIGHT HALF
IORM T1,($V) ;STORE THE END INDICATOR
JUMPN T1,INMCON ;FINISH CHUNK IF END INDICATOR SEEN
MOVEI T1,0(T3) ;GET CHAR COUNT
JUMPN T1,INMCON ;FINISH CHUNK IF SO DATA IN IT
HRRZI T2,0($V) ;GET ADDR OF CHUNK
SETZ $V, ;TELL MCP NOTHING HERE
JRST INMXIT ;AND EXIT
INMCON: MOVEI T1,0(T3) ;GET THE CHARACTER COUNT
IDIVI T1,5 ;CONVERT TO WORDS
SKIPE T2 ;ANY REMAINDER
AOS T1 ;ADD TO THE WORDS COUNT
HRLI T3,(T1) ;XWD WORDS,,CHARS
MOVEM T3,1($V) ;SAVE IN CHUNK
ADDI T1,FRERND+2 ;ADD OVERHEAD AND ROUND
LSH T1,-FRELSH ;GET ROUNDED AMOUNT
LSH T1,FRELSH ;...
MOVEI T2,($V) ;PUT THE START OF THE CHUNK IN T2
ADDI T2,(T1) ; THEN MAKE T2 THE ADDRESS OF THE BLOCK TO RETURN
MOVNS T1 ;NOW COMPUTE SIZE TO RETURN
INMXIT: ADDI T1,QU$WP
JUMPLE T1,CPOPJ## ;QUIT IF ENDED UP A FULL CHUNK
PJRST GIVWDS## ;GIVE AREA BACK TO MCS,AND RETURN
SUBTTL OUTMSG WRITE A MESSAGE TO THE FRONT END
$ENTRY (OUTMSG,<.CNK,.UDX,.SAV,.HIST>)
PUSHJ P,SAVE4## ;SAVE P1-P4
SETOM RUNMSW## ;SINCE WE GOT THIS FAR, KICK OUTPUT
HRRZ T1,.UDX ;GET UDX FOR THIS REQ.
PUSH P,T1 ;KEEP UDX HANDY
PUSHJ P,GETMXN ;GET A BUFFER
MOVEI P1,(T1) ;PUT IN SAVE PLACE
HRRZ P2,.CNK ;GET ADDRESS OF MSG CHUNK
;
; NOW MOVE MESSAGE,FROM CHUNK(S) TO OUTPUT BUFFER(S)
;
MOVCNK: HRL P2,(P) ;INSERT UDX
PUSHJ P,BLTCNK ;MOVE DATA FROM CHUNK TO BUFFER
SKIPE .SAV ;SAVE THE CHUNKS?
JRST NXTCNK ;YES-
OUTFRE: HLRZ T1,1(P2) ;GET CHUNK LENGTH
ADDI T1,02 ;ADD IN OVERHEAD
MOVEI T2,(P2)
PUSHJ P,GIVWDS##
NXTCNK: HRRZ P2,(P2) ;POINT TO NEW NEXT CHUNK
JUMPN P2,MOVCNK ;MORE-THEN CONTINUE
POP P,T1 ;RESTORE UDX
PJRST OBKMXN ;OUTPUT THE DATA AND RETURN
;SUBROUTINE BLTCNK - MOVE CHUNK TO IO BUFFER
;CALL MOVE P1,BUFFER RING HEADER
; MOVE P2,[XWD UDX,CHUNK POINTER]
; PUSHJ P,BLTCNK
; CPOPJ
BLTCNK: HRRZI P3,2(P2) ;CREATE INTERNAL BYTE POINTER
HLL P3,0(P2) ;GET BYTE POINTER INFO
TLZ P3,000077 ;TURN OFF INDIRECT,AND X BITS
HRRZ P4,1(P2) ;GET BYTE COUNT FROM CHUNK
JUMPE P4,EOCYES ;IF NO BYTES TO MOVE LEAVE NOW
BLTAG: ILDB T1,P3 ;GET A CHAR
IDPB T1,.BFPTR(P1) ;STORE IN OUT BUFFER
SOSLE .BFCTR(P1) ;END OF MPX BUFFER?
JRST EOCTST ;END OF CHUNK TEST NOW
HLRZ T1,P2 ;GET SAVED UDX
PUSHJ P,OBKMXN ;WRITE IT OUT
HLRZ T1,P2 ;GET SAVED UDX
PUSHJ P,GETMXN ;GET ANOTHER BUFFER
HRRZI P1,(T1) ;SAVE ADDR IN GOOD LOCATION
EOCTST: SOJN P4,BLTAG ;END OF CHUNK? NO-CONTINUE
EOCYES: HLRZ T2,0(P2) ;YES-GET E?I CODE
ANDI T2,77 ;ONLY NEED E?I CODE
CAIE T2,77 ;IS THIS SPECIAL OPERATOR EIC?
POPJ P, ;NO, DONE NOW
PUSH P,P2 ;SAVE CALLERS CHUNK POINTER
HRRI P2,EOLCNK ;POINT TO SPECIAL CHUNK FOR CRLF (UDX STILL IN LH)
PUSHJ P,BLTCNK ;RECURSE A LITTLE
POP P,P2 ;RESTORE CALLERS
POPJ P, ;AND RETURN
EOLCNK: 440700,,0 ;POS,SIZE, NO ENDI, NO LINK
1,,2 ;1 WORD, 2 BYTES
BYTE (7)15,12 ;<CR>-<LF>
SUBTTL MSGSER OUTPUT ROUTINES
;SUBROUTINE OBKMXN - OUTPUT A BLOCK TO THE MPX CHANNEL
;CALL MOVEI T1,UDX
; PUSHJ P,OBKMXN
OBKMXN: ANDI T1,UX.TYP ;GET THE DEVICE TYPE
CAIGE T1,FAKUDX ;FAKE DEVICE = RDX
TDZA T1,T1 ;NO, USE MX0
MOVEI T1,1 ;YES, USE MX1
OBKMX2: SETZM MXNFAI(T1) ;CLEAR OUTPUT FAILED FLAG
XCT MXNOUT(T1) ;DO AN OUTPUT UUO
POPJ P, ;SUCCESS, RETURN
SETOM MXNFAI(T1) ;FAILED, MARK THE FACT
XCT MXNGTS(T1) ;OUTPUT FAILED, GET ERROR BITS
MOVEI T3,760000 ;THE INTERESTING ONES
TDNN T3,ERRAUX## ;ANY LIT
POPJ P, ;NO, MUST BE NO BUFFERS TO ADVANCE TO
ERRSET F%OUT ;OUTPUT FAILED
MOVE T1,[SIXBIT/MX0 MX1 MX2 MX3 /](T1)
PUSHJ P,ERRFIL## ;OUTPUT MESSAGE
JRST ABORT## ;AND GIVE UP NOW
;SUBROUTINE GETMXN - LOCATE A BUFFER FOR OUTPUT ON THE CORRECT MPX
;CALL MOVEI T1,UDX
; PUSHJ P,GETMXN
;RETURN CPOPJ ;T1=THE RING HEADER POINTER
GETMXN: PUSH P,T1 ;SAVE THE UDX
GETMX1: PUSHJ P,..GAVAIL ;SEE IF BUFFER AROUND (NOTE STACK USAGE)
JUMPN $V,GETMX2 ;OK TO DO OUTPUT
MOVEI $V,1 ;NO, WAIT A SECOND
SLEEP $V, ;...
JRST GETMX1 ;AND TRY AGAIN
GETMX2: MOVE T2,T1 ;COPY CORRECT CHANNEL NUMBER (FROM BUFAVAIL)
HLRZ T1,MXNRNG(T2) ;GET THE RING HEADER
POP P,.BFUDX(T1) ;INSERT THE UDX
XCT MXNPRM(T2) ;DO ANY OTHER PRIMING REQUIRED
POPJ P, ;RETURN T1=RING HEADER ADDRESS
;ENTRY CALLED BY MSGOUT ( MSWRITE ) TO SEE IF OUTPUT CAN BE STARTED.
; RETURNS $V = TRUE IF CAN PROCEED, FALSE OTHERWISE
; T1 = THE CORRECT CHANNEL INDEX (FOR GETMXN)
$ENTRY(BUFAVAIL,<.UDX>)
SETO $V, ;SET RETURN = .TRUE.
SKIPE RUNCPS## ;PORT STATUS CHANGE SCHEDULED
JRST [SETOM RUNMSW## ;YES, SET TO RETURN LATER
AOJA $V,CPOPJ##] ;AND LIE TO THE BLISS CODE (RETURN FALSE)
BUFA.0: HRRZ T1,.UDX ;GET DEVICE ABOUT TO BE STARTED
HRRZ T2,T1 ;SAVE A COPY
ANDI T1,UX.TYP ;DOWN TO DEVICE TYPE
CAIGE T1,FAKUDX ;FAKE UDX = RDX DEVICE
TDZA T1,T1 ;NO, USE MX0
MOVEI T1,1 ;YES, USE MX1 FOR THOSE
SKIPN MXNFAI(T1) ;PREVIOUS OUTPUT FAIL
POPJ P, ;NO, RETURN .TRUE.
JUMPE T1,BUFA.1 ;IF CHANNEL = MX0, UDX IS OK AS IS
ANDX T2,FAKNDX ;ISOLATE RDX DEVICE INDEX
HRRZ T2,RDXUDX(T2) ;GET REAL UDX FOR THIS DEVICE
BUFA.1: HLRZ T3,MXNRNG(T1) ;GET ADDR OF OUTPUT RING HEADER
HRRZM T2,.BFUDX(T3) ;STORE VALID UDX FOR ADVANCING OUTPUT
PUSHJ P,OBKMX2 ;TRY TO ADVANCE TO FRESH BUFFER
SKIPE MXNFAI(T1) ;DID THAT ONE WORK
SETZ $V, ;OH WELL!, RETURN FALSE, TRY LATER
POPJ P, ;RETURN CORRECT VALUE
; ENTRY CALLED BY GETMXN ( DONE THIS WAS FOR STACK USAGE ( .ENT.X) )
$ENTRY(..GAVAIL,<.UDX>)
SETO $V, ;DUPLICATE FIRST INSTRUCTION OF BUFAVAIL
JRST BUFA.0 ;BUT DON'T LET IT LIE TO ME
SUBTTL KRNMSG SUBROUTINES TO CONNECT/DISCONNECT MPX CHANNEL
;SUBROUTINE CONMXN TO COMMECT A TTY OR DROPLESS RDX TO MX0
;CALL MOVE T1,[DEVICE NAME]
; PUSHJ P,CONMXN ;CONNECT THE DEVICE
;RETURN CPOPJ ;DEVICE CAN NOT BE CONNECTED
; CPOPJ1 ;DEVICE CONNECTED T1=UDX
CONMXN:: ;ENTRY POINT
SKIPE T3,T1 ;COPY THE DEVICE TO T3
DEVTYP T1, ;ASK THE MONITOR WHAT IT IS
JFCL ;TAKE NOT IMPLEMENTED AS NON-EXISTENT
JUMPE T1,CERR01 ;AC 0 ON RETURN IS "DEVICE NOT EXISTENT"
ANDI T1,TY.DEV ;ONLY THE DEVICE TYPE
CAIE T1,.TYTTY ;IS IT A TTY
CAIN T1,.TYRDA ; OR RDX DEVICE
SKIPA ;YES, OK SO FAR
JRST CERR02 ;NOT TTY OR RDX
SKIPA T2,.+1 ;LOAD THE CONNECT FUNCTION
XWD .CNCCN,MX0 ;TO MX0
MOVEI T1,T2 ;UUO ARGUMENT
CNECT. T1,
JRST CERR03 ;CANNOT CONNECT IF CNECT. FAILS
AOS MX0CON## ;COUNT THE CONNECT
PUSH P,T1 ;SAVE THE UDX
MOVEI T3,(T1) ;COPY THE UDX
ANDI T1,UX.TYP ;BACK DOWN TO DEVICE TYPE
CAIN T1,<.TYRDA>B26 ;RDX DEVICE
JRST CONM.1 ;YES, BETTER BE NON-MULTI-DROP TYPE
MOVEI T2,.TOSLV+.TOSET;SET SLAVE MODE
MOVEI T4,1 ;SET FUNCTION BIT 35
SKIPA T1,.+1 ;LOAD THE UUO ARGUMENT
XWD 3,T2 ;THREE ARGS AT T2
TRMOP. T1,
JFCL
CONMXX: SKIPL MX0OUT## ;DUMMY OUTPUT REQUIRED
PJRST TPOPJ1## ;NO, EXIT T1=UDX
POP P,T1 ;RESTORE THE UDX
MOVEM T1,MX0OUT##+.BFUDX ;STORE
OUTPUT MX0, ;DUMMY OUTPUT
JRST CPOPJ1 ;RETURN, T1 = UDX
CONM.1: DEVSTS T3, ;GET DEVICE DEPENDENT BITS
$STPCD(DDB,DEVICE DEPENDENT BITS UNAVAILABLE)
TXNN T3,1B35 ;ON IF MULTI-DROP LINE
JRST CONMXX ;JUST FINE, EXIT THROUGH COMMON CODE
POP P,T1 ;RESTORE UDX
PUSHJ P,DISMXN ;DISCONNECT THE DEVICE
JFCL ;DONT CARE
JRST CERR04 ;DROP NUMBER NOT GIVEN FOR MULTI-DROP LINE
;SUBROUTINE DISMXN TO REMOVE A DEVICE FROM THE CORRECT MPX
;CALL MOVE T1,[UDX]
; PUSHJ P,DISMXN
;RETURN CPOPJ IF CANNOT DISCONNECT
; CPOPJ1 IF DEVICE IS GONE
DISMXN:: ;ENTRY POINT
SKIPN T3,T1 ;COPY THE UDX
POPJ P, ;MUST HAVE ONE
ANDI T1,UX.TYP ;DEVICE TYPE FIELD
CAIL T1,FAKUDX ;DEVICE TYPE = THE FAKE FOR RDX
JRST DISRDX ;YES, DISCONNECT ONE OF THOSE
MOVEI T4,0 ;UNSET FUNCTION BIT 35
MOVEI T2,.TOSLV+.TOSET;UN SLAVE THE TTY
SKIPA T1,.+1 ;LOAD THE UUO ARG
XWD 3,T2 ;THREE ARGS AT T2
TRMOP. T1, ;UN-SLAVE THE TERMINAL
JFCL ;OH WELL!!
SKIPA T2,.+1 ;LOAD THE FUCTION
XWD .CNCDR,MX0 ;UNCONDITIONALLY FROM MX0
MOVEI T1,T2 ;UUO ARG
CNECT. T1, ;RELEASE IT
JFCL ;OH WELL!!
SOS MX0CON## ;COUNT THE DISCONNECT
JRST CPOPJ1##
;GET HERE FOR DISCONNECTING RDX DEVICES
DISRDX: HRRZ T1,T3 ;COPY FAKE UDX
ANDX T1,FAKNDX ;ISOLATE TABLE INDEX
SETZ T3, ;GET A ZERO
EXCH T3,RDXUDX(T1) ;CLEAR ENTRY, GET OLD CONTENTS
MOVSI T1,-MAXRDX ;TABLE LENGTH
DISR.1: HRRZ T2,RDXUDX(T1) ;FIND ANY OTHER DROPS OPEN ON THE SAVE DEVICE
CAIN T2,(T3) ;SAVE LINE NUMBER
JRST CPOPJ1## ;YES, KEEP THE DEVICE CONNECTED
AOBJN T1,DISR.1 ;TRY THE NEXT ENTRY
MOVEI T1,T2 ;NO MORE DROPS FOR THIS LINE, RELEASE IT TOO
SKIPA T2,.+1 ;LOAD ARGS
XWD .CNCDR,MX1 ;DISCONNECT FROM MX1
HRRZS T3 ;ISOLATE DEVICE UDX
CNECT. T1, ;DISCONNECT THE LINE
JFCL ;OH WELL
SOS MX1CON## ;ONE LESS TERMINAL
JRST CPOPJ1## ;AND RETURN
$ENTRY(PDISCONNECT,<..UDX>) ;BLISS ENTRY TO DISMXN
MOVE T1,..UDX ;GET THE UDX
PUSHJ P,DISMXN ;PROCESS DISCONNECT
JFCL ;EAT THE NON-SKIP RETURN
POPJ P, ;RETURN TO CALLER
SUBTTL KRNMSG RDX MULTI-DROP SERVICE ROUTINES
;HERE TO DO INPUT FROM THE RDX NETWORK
INRDX: IN MX1, ;GET A BUFFER LOAD
SKIPA ;SOMETHING THERE
JRST CPOPJ1## ;NOTHING, RETURN NOW
PUSHJ P,SAVE4## ;SAVE THE P REGS
HRRZ T1,MXNRNG(T4) ;GET THE RING ADDRESS
PUSHJ P,GET5 ;GET THE DROP NUMBER INTO P1
HRLS P1 ;DROP INTO THE OTHER HALF
HRR P1,.BFUDX(T1) ;GET THE DEVICE CODE
MOVSI P2,-MAXRDX ;MAX NUMBER OF RDX PORTS
CAME P1,RDXUDX(P2) ;SEARCH FOR IT IN THE KNOWN PORTS TABLE
AOBJN P2,.-1 ;KEEP LOOKING
JUMPGE P2,CPOPJ1## ;NOT FOUND, THROW IT AWAY
ADDI P2,FAKUDX ;BUILD FAKE UDX
HRRZM P2,.BFUDX(T1) ;KEEP THE BLISS CODE HAPPY
POPJ P, ;AND GIVE GOT THE DATA RETURN
GET5: MOVEI P2,5 ;FOR DROP NUMBER
SETZ P1, ;FOR DIGIT ASSEMBLY
GET5A: ILDB P3,.BFPTR(T1) ;GET A CHARACTER (KEEP COUNTS STRAIGHT)
SOS .BFCTR(T1) ;FOR IBKMXN
IMULI P1,^D10 ;NUMBERS ARE DECIMAL
ADDI P1,-"0"(P3) ;INCLUDE NEW DIGIT
SOJG P2,GET5A ;GET ENOUGH
POPJ P, ;YES, RETURN WITH ANSWER IN P1
;HERE TO PRIME THE RDX BUFFERS FOR OUTPUT
PRMRDX: PUSHJ P,SAVE4## ;SAVE A FEW REGS FIRST
MOVE P1,.BFUDX(T1) ;GET UDX STORED FOR OUTPUT
ANDX P1,FAKNDX ;ISOLATE TABLE INDEX
HRRZ P2,RDXUDX(P1) ;CONVERT FAKE TO UDX AND DROP
HRRZM P2,.BFUDX(T1) ;STORE DEVICE UDX FOR THE RDX
HLRZ P1,RDXUDX(P1) ;GET DROP NUMBER
MOVEI P3,5 ;OUTPUT 5 CHARACTERS
PUT5A: IDIVI P1,^D10 ;NUMBERS ARE DECIMAL
HRLM P2,(P) ;SAVE DIGITS
SOSLE P3 ;GET THEM ALL
PUSHJ P,PUT5A ;NO, RECURSE A LITTLE
HLRZ P1,(P) ;RETRIEVE A DIGIT
ADDI P1,"0" ;TO ASCII
IDPB P1,.BFPTR(T1) ;STUFF IT AWAY
SOS .BFCTR(T1) ;AND ADJUST THE COUNT
POPJ P, ;RETURN OR GET MORE
;SUBROUTINE TO CONNECT THE RDX DEVICE TO MX1
;CALLED WITH T1 = THE DROP NUMBER (BINARY)
; T2 = THE DEVICE NAME (SIXBIT)
;RETURNS CPOPJ IF BAD
; CPOPJ1 WITH T1 = THE UDX FOR REFERENCE TO THIS DEVICE/DROP PAIR
CONRDX:: PUSHJ P,SAVE3## ;SAVE A FEW REGS
SKIPE T3,T2 ;COPY DEVICE NAME
DEVTYP T3, ;ASK THE MONITOR WHAT IT IS
JFCL ;MAY NOT BE IMPLEMENTED
JUMPE T3,CERR01 ;COMPLAIN THAT DEVICE DOES NOT EXIST
ANDI T3,TY.DEV ;ONLY THE DEVICE TYPE
CAIE T3,.TYRDA ;MUST BE RDX DEVICE
JRST CERR05 ;NOT AN RDX DEVICE
MOVE T3,T2 ;COPY IT AGAIN
IONDX. T3, ;GET UNIVERSAL INDEX
$STPCD(IUF,IONDX. UUO FAILED) ;SINCE DEVTYP WORKED....
HRLI T3,(T1) ;T3 = LONG FORM OF DROP,,UDX
SETOB P1,P2 ;FLAGS FOR TABLE SEARCH
MOVEI T4,MAXRDX-1 ;MAXIMUM ENTRIES
CONR.1: SKIPN T1,RDXUDX(T4) ;GET TABLE ENTRY
MOVEI P1,(T4) ;REMEMBER HOLE IN THE TABLE
CAMN T1,T3 ;DUPLICATE ENTRY
JRST CERR06 ;YES, CAN'T CONNECT DROP TWICE
HRRZS T1 ;ISOLATE DEVICE UDX
CAIN T1,(T3) ;ALREADY CONNECTED
SETZ P2, ;YES, REMEMBER THAT TOO
SOJGE T4,CONR.1 ;SEARCH THE ENTIRE TABLE
JUMPL P1,CERR08 ;QUIT IF NO ROOM IN THE TABLE
JUMPE P2,CONR.2 ;JUMP IF JUST ADDING A DROP
MOVEI T1,P2 ;ARGUMENT BLOCK
SKIPA P2,.+1 ;LOAD ARGS
XWD .CNCCN,MX1 ;CONNECT TO CHANNEL MX1
MOVE P3,T2 ;THE DEVICE REQUESTED
CNECT. T1, ;DO THE CONNECT
JRST CERR03 ;CAN'T HAVE IT, RETURN WITH FAILURE
AOS MX1CON## ;UPDATE NUMBER OF DEVICES CONNECTED
DEVSTS T1, ;GET DEVICE DEPENDENT INFO
PUSHJ P,S$$DDB ;COME ON, MUST HAVE THIS AROUND
TXNE T1,1B35 ;ON IF MULTI-DROP LINE
JRST CONR.2 ;IS, GREAT SO FAR
MOVEM T3,RDXUDX(P1) ;INSERT LONG FORM INTO TABLE
MOVEI T1,FAKUDX(P1) ;BUILD FAKE UDX FOR DISCONNECT
PUSHJ P,DISMXN ;GET RID OF BAD ENTRY AND
JFCL ; GIVE ERROR RETURN
JRST CERR07 ;
CONR.2: MOVEM T3,RDXUDX(P1) ;INSERT LONG FORM INTO TABLE
MOVEI T1,FAKUDX(P1) ;BUILD FAKE UDX FOR REST OF MCS
SKIPL MX1OUT## ;DUMMY OUTPUT NEEDED
JRST CPOPJ1## ;NO, GIVE GOOD RETURN
HRRZM T3,MX1OUT##+.BFUDX ;STORE SOME UDX
OUTPUT MX1, ;PRIME THE BUFFERS
JRST CPOPJ1## ;AND GIVE GOOD RETURN
; ERROR RETURNS FOR CONMXN AND CONRDX, RETURN WITH T1 POINTING TO STRING
CERR01: MOVEI T1,[ASCIZ / (NON-EXISTENT DEVICE)@/]
POPJ P,
CERR02: MOVEI T1,[ASCIZ / (DEVICE NOT RDX OR TTY)@/]
POPJ P,
CERR03: MOVEI T1,[ASCIZ / (DEVICE NOT AVAILABLE)@/]
POPJ P,
CERR04: MOVEI T1,[ASCIZ / (MULT-DROP TYPE RDX)@/]
POPJ P,
CERR05: MOVEI T1,[ASCIZ / (NOT AN RDX DEVICE)@/]
POPJ P,
CERR06: MOVEI T1,[ASCIZ / (DROP ALREADY CONNECTED)@/]
POPJ P,
CERR07: MOVEI T1,[ASCIZ / (NOT A MULT-DROP TYPE RDX)@/]
POPJ P,
CERR08: MOVEI T1,[ASCIZ / (NO ROOM IN RDX DROP TABLE)@/]
POPJ P,
SUBTTL SCHEDULED ROUTINE TO POLL SOURCE STATUSES
POLLSS::MOVSI P1,MXNMAX ;SET UP AOBJN PTR FOR ALL CHANNELS
POLL.1: SETZM MXNHED##(P1) ;CLEAR HEADER FOR LIST
SKIPN P2,MX0CON##(P1) ;ANY DEVICES ON THIS CHANNEL?
JRST POLL.3 ;NO, SO SKIP REST OF STUFF
ADDI P2,2 ;NEED 2 OVERHEAD WORDS FOR ERLST.
MOVE T2,P2 ;ARGUMENT TO GETWDS IN T2
POLL.2: PUSHJ P,GETWDS## ;GET THAT MANY WORDS FROM FREE CORE
JRST [ SETOM RUNCPS## ;NOT ENOUGH CORE, RE-SCHEDULE
SKIPE P2,T2 ;DID WE GET ANY CORE?
JRST POLL.2 ;YES- USE WHAT WE GOT
JRST POLL.3 ] ;NO - SETTLE FOR RE-SCHEDULE LATER
MOVSI T2,0(P2) ;ERLST. TAKES WORDS,,CHANNEL
HRRI T2,MX0(P1) ;SO SET UP FOR THAT
MOVEM T2,0(T1) ;IN ADDR+0
ERLST. T1, ;DO THE ACTUAL UUO
$STPCD(EUF,ERLST. UUO FAILED) ;NOT EVER EXPECTED TO HAPPEN
SKIPN T2,1(T1) ;ON RET, EXAMINE NO. OF DEVICES W/ERRORS
JRST [ MOVEI T2,0(T1) ;NONE- SO GIVE BACK CORE WE USED
MOVEI T1,0(P2) ;SET UP WITH SIZE AND ADDRESS
PUSHJ P,GIVWDS## ;RETURN TO FREE CORE
JRST POLL.3 ] ;AND GO TO NEXT CHANNEL
MOVEM T1,MXNHED##(P1) ;STORE ADDRESS OF LIST INTO HEADER
HRLM P2,MXNHED##(P1) ;ALSO STORE SIZE FOR LATER RETURN
MOVNS T2 ;SET UP AOBJN POINTER TO NON-
HRLI T2,0(T2) ;OVERHEAD WORDS FOR LATER USE.
HRRI T2,2(T1) ;THIS SPEEDS UP PSTATUS CALLS
MOVEM T2,1(T1) ;A LITTLE
POLL.3: AOBJN P1,POLL.1 ;INCREMENT COUNTER, IF DONE
$CALL (QPSTS) ;THEN TIME TO CALL QUERY FOR ALL UDXS
MOVSI P1,MXNMAX ;SET UP AOBJN POINTER AGAIN
POLL.4: SKIPE P2,MXNHED##(P1) ;GET SIZE,,ADDR OF CHANNEL'S LIST
PUSHJ P,[ HLRZ T1,P2 ;T1/ NUMBER OF WORDS TO RETURN
HRRZ T2,P2 ;T2/ ADDRESS OF RETURNED BLOCK
PJRST GIVWDS## ] ;GIVE BACK THE WORDS
AOBJN P1,POLL.4 ;LOOP FOR EACH CHANNEL
POPJ P, ;RETURN
SUBTTL BLISS RECOVERY CODE SERVICE ROUTINES FOR DATASETS AND NODES
; ROUTINE PSTATUS
; INPUTS: UDX
; OUTPUTS: $V CONTAINS 0 IF UDX NOT LOST CARRIER OR DEVICE
; $V CONTAINS "LOSTCARRIER" IF THIS IS THE CASE
; $V CONTAINS "LOSTDEVICE" IF THIS IS THE CASE
$ENTRY(PSTATUS,<.UDX>) ;ENTRY POINT W/UDX ON STACK
MOVEI $V,0 ;INITIAL RETURNED VALUE
MOVE T1,.UDX ;GET THE UDX
MOVE T2,T1 ;COPY TO T2
ANDI T2,UX.TYP ;GET DOWN TO DEVICE TYPE
CAIL T2,FAKUDX ;IS THIS AN RDX (MULTI-DROP) DEVICE?
JRST PSTS.2 ;YES, ASSUME NOT CARRIER LOST
MOVE T2,.UDX ;GET UDX INTO T2
MOVEI T1,30 ;FUNCTION 30 OF TRMOP.
MOVE T3,[XWD 2,T1] ;POINT TO IT
TRMOP. T3, ;DO THE UUO
SETO T3, ;ASSUME CARRIER THERE IF FAILS
JUMPL T3,PSTS.1 ;IF SIGN BIT ON, THERE IS CARRIER
MOVEI $V,LOSTCARRIER ;YES, SO RETURN THAT
PSTS.1: HRRZ T1,.UDX ;USE UDX FOR LOST DEVICE TEST
MOVE T3,MXNHED##+0 ;USE ERRLST LIST FOR MX0
JRST PSTS.3
PSTS.2: ANDX T1,FAKNDX ;ISOLATE TABLE INDEX
HRRZ T1,RDXUDX(T1) ;GET THE REAL UDX
MOVE T3,MXNHED##+1 ;USE ERRLST LIST FOR MX1
PSTS.3:
JUMPE T3,CPOPJ## ;IF NO ERRLST LIST , JUST RETURN
MOVE T3,1(T3) ;GET AOBJN POINTER TO DEVICES
PSTS.4: HLRZ T2,(T3) ;GET UDX OF DEVICE IN ERROR
CAIN T1,(T2) ;MATCH ONE ASKED ABOUT
JRST [ MOVEI $V,LOSTDEVICE ;YES, FLAG AS LOST DEVICE
POPJ P, ] ;TERMINATE SEARCH AND RETURN
AOBJN T3,PSTS.4 ;IF NO MATCH, SEE IF MORE
POPJ P, ;EXHAUSTED, SO RETURN WITH $V SET UP
SUBTTL COMMUNICATION NODE STATUS ROUTINE
; QCNS - ROUTINE TO CHECK THE STATUS OF ALL NODES IN THE LIST
; HEADED BY CNDLST. HERE WE SEE IF NODES COME UP AND
; "GREET" THEM WITH THE SPECIFIED AUTO FILE.
QCNS:: SKIPA T1,CNDLST## ;PRIME THE PUMP
QCNS.1: MOVE T1,0(T1) ;GET NEXT LINK
JUMPE T1,CPOPJ## ;IF NO BLOCK , RETURN
MOVE T2,2(T1) ;GET NODE NAME SUPPLIED
MOVEM T2,NODNOD ;STORE FOR UUO
MOVE T2,[.NDRCI,,NODBLK] ;FUNCTION 5 = GET CONFIG INFO
NODE. T2, ;DO IT
JRST QCNS.2 ;IF UUO FAILS, ASSUME NOT THERE
HLL T2,NODCNF+2 ;GET COMMAND INTERPRETER COUNT
TLNN T2,-1 ;CAN ALWAYS GREET A HOST COMPUTER
HLL T2,NODCNF ;GET NUMBER OF TTY'S ON NODE
HLR T2,NODCNF+1 ;AND NUMBER OF RDX DEVICES
JUMPE T2,QCNS.2 ;CAN'T GREET THINGS WITHOUT SOME
SKIPE 3(T1) ;DO WE THINK NODE IS DOWN?
JRST QCNS.1 ;NO, WE ALREADY KNOW ITS THERE
SETOM 3(T1) ;MARK AS ON-LINE AND UP
MOVEI P1,4(T1) ;GET POINTER TO FILE SPEC
SETOM RUNOPR## ;SCHEDULE OPERATOR TO RUN
SETOM RUNCNS## ;RE-SCHEDULE MYSELF
PUSHJ P,ATOOPN## ;OPEN UP THE AUTO FILE
PJRST [MOVSI T1,'ATO' ;IF OPEN FAILED
JRST ERRFIL##] ;GIVE ERROR AND RETURN
POPJ P, ;RETURN, SINCE WE ARE IN AUTO FILE
QCNS.2: SETZM 3(T1) ;THIS INDICATES LOST NODE
JRST QCNS.1 ;TRY NEXT NODE
$LIT
$LOW
NODBLK: NODEND-NODBLK ;SIZE OF THE BLOCK
NODNOD: BLOCK 1 ;NODE NAME GOES HERE
0 ;RESERVED WORD
NODCNF: XWD 0,.TYTTY ;NUMBER OF TTY'S ON NODE
XWD 0,.TYRDA ;NUMBER OF RDA'S THERE TOO
XWD 0,.TYMCR ;IS THIS A HOST COMPUTER
NODEND:
PRGEND
TITLE KRNJRN - MESSAGE CONTROL PROGRAM JOURNAL FUNCTIONS
SUBTTL D.TODD/DRT/AAG/CDO/ILG 1 JUNE 1977
SEARCH KERNEL,MACTEN,UUOSYM ;LOAD ALL THE UNIVERSALS
$RELOC
SUBTTL ROUTINES TO OUTPUT EITHER A VECTOR OR A WORD TO THE JOURNAL FILE
$ENTRY (INAUDV,<.VECT,.SIZE>)
JRST JOURNAL ;CONTINUE
$ENTRY (OTAUDV,<.VECT,.SIZE>)
JOURNA: TXNE OPRFLG,CMDJOR ;IF JOURNAL FILE IS CLOSED
SKIPG T2,.SIZE ;OR VECTOR IS EMPTY
POPJ P, ;THEN RETURN
VCTAU1: SOSG JRNOUT##+.BFCTR ;ROOM IN THE BUFFER?
PUSHJ P,OBKJRN ;NO , OUTPUT THE BUFFER
TXNN OPRFLG,CMDJOR ;FILE STILL OPEN?
POPJ P, ;NO,TIME TO RETURN
MOVE T1,@.VECT ;GET A WORD OF VECTOR
IDPB T1,JRNOUT##+.BFPTR ;DEPOSIT IT
SOSG .SIZE ;REDUCE THE SIZE
POPJ P, ;AND RETURN IF DONE
AOS .VECT ;UPDATE ADDRESS
JRST VCTAU1 ;CONTINUE
$ENTRY (INAUDW,<.WORD>)
JRST WJOURNAL
$ENTRY (OTAUDW,<.WORD>)
WJOURN: SOSG JRNOUT##+.BFCTR ;SKIP IF BUFFER NOT FULL
PUSHJ P,OBKJRN ;WRITE THE BUFFER
TXNN OPRFLG,CMDJOR ;COULD BE NO FILE OUT THERE
POPJ P, ;IN THAT CASE, QUIT NOW
MOVE T1,.WORD ;GET THE DATA WORD
IDPB T1,JRNOUT##+.BFPTR ;STORE IN THE BUFFER
POPJ P, ;RETURN
;SUBROUTINE OBKJRN WRITE A BLOCK TO THE JOURNAL FILE
OBKJRN: TXNE OPRFLG,CMDJOR ;JOURNAL FILE OPEN?
OUT JRN, ;WRITE THE BLOCK
POPJ P, ;RETURN
GETSTS JRN,T1 ;LOAD IO STATUS
ERRSET F%OUT,T1 ;STORE REASON,STATUS
MOVSI T1,'JRN' ;IDENTIFY FILE
PUSHJ P,ERRFIL## ;CALL REPORT ROUTINE
$SAY (<@[MCSSAJ Switching to alternate JOURNAL file]@>)
PUSHJ P,CLOJRN## ;CLOSE THE FILE OUT
MOVEI T1,JORSPC## ;GET ADDR OF PRIMARY POINTER
SUB T1,JORCUR## ;POSSIBLY CHANGE TO SECONDARY
SETCMM JORCUR## ;CHANGE SENSE OF PRIM/SECONDARY FLAG WORD
HRRZ T1,0(T1) ;GET ADDR OF FILE SPEC
SKIPE T1 ;NONE-THEN ERROR
SKIPN 0(T1) ;A FILE SPEC?
$SAYRET(<?MCSNFN NO ALTERNATE FILE NAME EXISTS>)
PUSHJ P,SAVE1## ;SAVE P1
HRRZI P1,0(T1)
PUSHJ P,JRNOPN## ;OPEN FILE
JRST JORERR ;NOPE-ERROR
JRST OBKJRN ;TRY AGAIN
JORERR: MOVSI T1,'JRN' ;FILE COULD NOT BE OPENED
PJRST ERRFIL##
$LIT
PRGEND
TITLE KRNLOG - MESSAGE CONTROL PROGRAM LOGGING FUNCTIONS
SUBTTL D.TODD/DRT/CDO/ILG 1 JUNE 1977
SEARCH KERNEL,MACTEN,UUOSYM ;LOAD ALL THE UNIVERSALS
$RELOC
SUBTTL MPPOLG - LOG THE PTY TRAFFIC
;SUBROUTINE MPPOLG WRITE THE MPP TRAFFIC TO THE LOG FILE
;CALL MOVEI T1,NEXT CHARACTER TO LOG
; MOVEI J,JSN
; PUSHJ P,MPPOLG!MPPILG
;RETURN CPOPJ
MPPOLG:: ;OUTPUT CALL
MPPILG:: ;INPUT CALL
TXNE OPRFLG,CMDLOG ;IS LOG FILE OPEN?
SKIPN MLOGGI## ;MPP LOGGING ON?
POPJ P, ;NO-JUST EXIT
PUSH P,T1 ;SAVE THE CHARACTER
HRRZ T1,LSTLOG ;CHECK FOR
MOVEM J,LSTLOG ;STORE THE CURRENT JSN
CAIE T1,0(J) ;SAME AS LAST MPP
PUSHJ P,HDRLOG ;NO, WRITE THE HEADER LINE
SKIPE LINLOG ;AT END OF LINE
JRST MPPLO1 ;NO, CONTINUE LINE
PUSHJ P,TIMLOG ;YES, WRITE A TIME STAMP
PUSHJ P,TABLOG ;AND A TAB
MPPLO1: POP P,T1 ;RESTORE THE CHARACTER
PJRST CHRLOG ;WRITE THE CHARACTER
SUBTTL XXXLOG - MPP LOGING FUNCTIONS
;SUBROUTINE HRDLOG - GENERATE THE HEADER COLS 1-16 APROX.
;CALL MOVEI J,JSN
; PUSHJ P,HDRLOG
;RETURN CPOPJ
HDRLOG:: ;ENTRY POINT
SKIPE LINLOG ;BEGINNING OF LINE
PUSHJ P,EOLLOG ;GO TO BEGINNING OF LINE
PUSHJ P,EOLLOG ;ADD A BLANK LINE
PUSHJ P,TIMLOG ;TIME STAMP
PUSHJ P,SPCLOG ;SPACE
SKIPN T1,JB$MPP##(J) ;GET THE POINTER TO THE PROTOTYPE MPP
JRST HDRLO1 ;NOT DEFINED
MOVEI T1,MP$MPP##(T1) ;GET THE ADDRESS OF THE MPP NAME
PUSHJ P,STRLOG ;WRITE THE MPP NAME
HDRLO1: PUSHJ P,TABLOG ;TAB
$LASCI (T1,<JOB=>) ;STRING;SUBROUTINE TIMLOG
PUSHJ P,STRLOG ;WRITE
HLRZ T1,JB$UDX##(J) ;GET THE MONITOR JOB NUMBER
PUSHJ P,C10LOG ;WRITE IN DECIMAL
$LASCI (T1,< JSN=>) ;STRING
PUSHJ P,STRLOG ;WRITE
MOVEI T1,(J) ;GET THE JOB SEQUENCE NUMBER
PUSHJ P,C10LOG ;WRITE IN DECIMAL
$LASCI (T1,< UDX=>) ;STRING
PUSHJ P,STRLOG ;WRITE
HRRZ T1,JB$UDX##(J) ;LOAD THE UDX
PUSHJ P,C8LOG ;WRITE IN OCTAL
PUSHJ P,EOLLOG ;ADD A BLANK LINE
PJRST EOLLOG ;WRITE END OF LINE
;SUBROUTINE TIMLOG WRITE THE TIME STAMP IN THE LOG FILE
;CALL PUSHJ P,TIMLOG
;RETURN CPOPJ
TIMLOG: ;ENTRY POINT
MSTIME T1, ;GET THE TIME OF DAY
MOVEI T3,3 ;WILL TYPE NN:NN:NN
TIMLO1: IDIV T1,TIMTAB-1(T3) ;SPLIT THE DIGITS DOWN
PUSH P,T2 ;SAVE THE REMAINDER
IDIVI T1,^D10 ;SPLIT INTO TWO DIGITS
MOVEI T1,"0"(T1) ;CONVERT TO ASCII
PUSHJ P,CHRLOG ;WRITE THE CHARACTER
MOVEI T1,"0"(T2) ;GET THE LOW ORDER DIGIT IN ASCII
PUSHJ P,CHRLOG ;WRITE IT
SOJLE T3,T1POPJ## ;EXIT IF NO MORE DIGITS
MOVEI T1,":" ;GET A SEPERATOR
PUSHJ P,CHRLOG ;WRITE IT
POP P,T1 ;RESTORE THE REMAINDER
JRST TIMLO1 ;CONTINUE
TIMTAB: DEC 1000,60*1000,60*60*1000 ;CONVERSION TABLE
;SUBROUTINE SPCLOG,TABLOG WRITE A SPACE OR TAB IN THE LOG FILE
;CALL PUSHJ P,SPCLOG TABLOG
;RETURN CPOPJ
TABLOG: MOVEI T1,.CHTAB ;GET A TAB
PJRST CHRLOG ;WRITE IT
SPCLOG: ;ENTRY POINT
MOVEI T1," " ;GET A BLANK
PJRST CHRLOG ;WRITE
;SUBROUTINE EOLLOG WRITE AN END OF LINE IN THE LOG FILE
;CALL PUSHJ P,EOLLOG
;RETURN CPOPJ
EOLLOG:: ;ENTRY POINT
PJSP T1,STRLOG ;LOAD THE POINTER AND JUMP
ASCIZ /
/
;SUBROUTINE C??LOG ;CONVERT A NUMBER IN THE RADIX AND OUTPUT
;CALL MOVEI T1,NUMBER
; PUSHJ P,C8LOG ;OCTAL
; C10LOG ;DECIMAL
; CXXLOG ;SPECIFY THE RADIX IN T3
;RETURN CPOPJ
C8LOG: SKIPA T3,[^D8] ;LOAD OCTAL BASE
C10LOG: MOVEI T3,^D10 ;LOAD DECIMAL BASE
CXXLOG: ;BASE LOADED IN T3
IDIVI T1,(T3) ;CONVERT THE NUMBER
HRLM T2,(P) ;SAVE THE REMAINDERS
SKIPE T1 ;ANY LEFT
PUSHJ P,CXXLOG ;YES, CONTINUE
HLRZ T1,(P) ;GET THE REMAINDERS BACK
MOVEI T1,"0"(T1) ;CONVERT TO ASCII
PJRST CHRLOG ;WRITE THE CHARACTER
;SUBROUTINE STRLOG WRITE A LINE TO THE LOG FILE
;CALL MOVEI T1,[ASCIZ /STRING/]
; PUSHJ P,STRLOG
;RETURN CPOPJ
STRLOG:: ;ENTRY POINT
HRLI T1,(POINT 7,0) ;ASCIZ BYTE POINTER
PUSH P,T1 ;SAVE ON THE STACK
STRLO1: ILDB T1,(P) ;LOAD A CHARACTER
JUMPE T1,T1POPJ## ;EXIT ON A NULL
PUSHJ P,CHRLOG ;WRITE THE CHARACTER TO THE LOG FILE
JRST STRLO1 ;CONTINUE
;SUBROUTINE CHRLOG WRITE A SINGLE CHARACTER TO THE LOG FILE
;CALL MOVEI T1,CHARACTER
; PUSHJ P,CHRLOG
;RETURN CPOPJ
CHRLOG:: ;ENTRY POINT
SOSG LOGOUT##+.BFCTR ;REDUCE THE CHARACTER COUNT
PUSHJ P,OBKLOG ;WRITE THE BLOCK
IDPB T1,LOGOUT##+.BFPTR ;DEPOSITE THE CHARACTR
CAIE T1,.CHLFD ;END OF LINE
AOSA LINLOG ;NO, UPDATE THE LINE COUNT
SETZM LINLOG ;CLEAR THE LINE COUNTER
POPJ P, ;RETURN
;SUBROUTINE OBKLOG OUTPUT THE BUFFER TO THE LOG FILE
;CALL PUSHJ P,OBKLOG
;RETURN CPOPJ ;I/O COMPLETE
OBKLOG:: ;ENTRY POINT
TXNE OPRFLG,CMDLOG ;IS LOG FILE OPEN?
OUT LOG, ;YES - OUTPUT THE BLOCK
POPJ P, ;RETURN
GETSTS LOG,T1 ;GET IO STATUS
ERRSET F%OUT,T1 ;STORE REASON,STATUS
MOVSI T1,'LOG' ;IDENTIFY FILE
PUSHJ P,ERRFIL## ;TELL ABOUT THE ERROR
$SAY (<@[MCSSAL Switching to alternate LOG file]@>)
PUSHJ P,CLOLOG## ;CLOSE THE LOG FILE OUT
MOVEI T1,LOGSPC## ;GET PRIMARY POINTER'S ADDRESS
SUB T1,LOGCUR## ;CHANGE (POSSIBLY) TO ALTERNATE
SETCMM LOGCUR## ;CHANGE SENSE OF FLAG WORD
HRRZ T1,0(T1) ;GET ADDR OF FILE SPEC
SKIPE T1 ;NONE-THEN ERROR
SKIPN 0(T1) ;FILE SPEC PRESENT?
$SAYRET(<?MCSNFN NO ALTERNATE FILE NAME EXISTS>)
PUSHJ P,SAVE1##
HRRZI P1,0(T1)
PUSHJ P,LOGOPN## ;OPEN FILE
JRST LOGER1 ;NOPE-ERROR
JRST OBKLOG ;TRY AGAIN
LOGER1: MOVSI T1,'LOG' ;LOG FILE ERROR
PJRST ERRFIL## ;TELL ABOUT THE ERROR
$LOW
LINLOG: 1 ;CURRENT LINE POSITION
LSTLOG::-1 ;JSN OF LAST MPP LOGGED
$LIT
PRGEND ;END OF KRNLOG
TITLE KRNMPP - MESSAGE CONTROL PROGRAM MPP CONTROL ROUTINES
SUBTTL D.TODD/DRT/AAG/CDO/ILG 1 JUNE 1977
SEARCH KERNEL,MACTEN,UUOSYM ;LOAD ALL THE UNIVERSALS
$RELOC
;SUBROUTINE "SETMPPSTATUS"
;CALL $CALL (SETMPPSTATUS,<JSN,STATUS>)
;RETURN NO RETURN STATUS
$ENTRY (SETMPPSTATUS,<..JSN,..STS>)
MOVE J,..JSN ;GET THE JOB SLOT NUMBER
PUSHJ P,JSNRC ;CHECK RANGE
HLLZ T2,..STS ;GET THE STATUS BITS
IORB T2,JB$MLF##(J) ;SET THE STATUS IN THE TABLE
TXNN T2,JBIDL$ ;JOB JUST GO IDLE
JRST SETMPE ;NO, JUST EXIT
TXNE T2,JBKIL$ ;MARKED TO BE KILLED
PUSHJ P,KILMPP ;YES, KILL IT OFF
JFCL ;IGNORE FAILURE HERE
SETMPE: POPJ P, ;RETURN
;SUBROUTINE "CLRMPPSTATUS"S
;CALL $CALL (CLRMPPSTATUS,<JSN,STATUS>)
;RETURN NO RETURN STATUS
$ENTRY (CLRMPPSTATUS,<..JSN,..STS>)
MOVE J,..JSN ;GET THE JOB SLOT NUMBER
PUSHJ P,JSNRC ;CHECK RANGE
HLLZ T2,..STS ;GET THE STATUS BITS
ANDCAB T2,JB$MLF##(J) ;CLEAR THE BITS
POPJ P, ;RETURN
;SUBROUTINE "GETMPPSTATUS"
;CALL $CALL (GETMPPSTATUS,<JSN>)
;RETURN $V=THE VALUES OF THE STATUS BITS (XWD FLAGS,NODE POINTER)
$ENTRY (GETMPPSTATUS,<..JSN>)
MOVE J,..JSN ;GET THE JOB SLOT NUMBER
PUSHJ P,JSNRC ;CHECK RANGE
MOVE $V,JB$MLF##(J) ;GET THE STATUS BITS, NODE POINTER
POPJ P, ;RETURN
;LOCAL SUBROUTINE JSNRC
; CALLED WITH JSN IN AC J WHICH IS CHECKED AGAINST MAXJSN
; RETURN IS EITHER CPOPJ OR STOP CODE
JSNRC: CAIG J,MAXJSN##-1 ;LESS THAN MAXIMUM?
POPJ P, ;YES,RETURN OK
$STPCD(JRF,JSN RANGE CHECK FAILED)
SUBTTL MPPRUN - ROUTINE TO RUN AN MPP
$ENTRY (MPPRUN,<.MPPTR,.NODPT,.COPY>)
PUSHJ P,SAVE4## ;SAVE 4 PERM ACS
MOVE P1,.MPPTR ;GET THE POINT TO THE MPP TABLE
HRRZ P1,MPPTAB##(P1) ;LOAD THE ADDRESS OF THE MPP PROTO
MOVE P2,.COPY ;GET AMOUNT TO START
MOVE P3,.NODPT ;GET ADDRESS OF NODE THAT DID THIS
MOVX T1,MPLOC$ ;LOCAL MPP????
TDNE T1,MP$HPQ##(P1)
PJRST NEWJOB ;START LOCAL ONES NOW
; NOW COMPUTE NUMBER OF MPP'S TO RUN.THIS NUMBER IS
; COMPUTED FROM THE FOLLOWING INFORMATION:
; (1) MAX NO. THAT CAN BE RUN TOTAL(#MAX)
; (2) CURRENT NO. RUNNING(#CURRENT)
; (3) NO. OF COPIES TO BE STARTED(#COPIES)
; (4) MIN NO. SET DURING MCSGEN (#MIN)
;
; METHOD USED:
;
; #NEEDED = #COPIES
; IF #NEEDED .GT. #MAX THEN #NEEDED = #MAX
; IF #NEEDED .LT. #MIN THEN #NEEDED = #MIN
; IF ( #NEEDED = #NEEDED - #CURRENT ) .GT. 0 THEN START #NEEDED
TXNE OPRFLG,RCVALL ;LOSE ANY JOBS VIA IPCF FAILURES
PUSHJ P,RECOVR ;YES, TRY TO CLEAN UP BEFORE COUNTING
PUSHJ P,ACTJOB ;FIND ALL ACTIVE JOBS OF THIS MPP
HRRZ T2,MP$COP##(P1) ;GET MAX COUNT
CAILE P2,0(T2) ;REQUESTING MORE THAN THE MAX ALLOWED
MOVEI P2,0(T2) ;YES, USE ONLY THE MAX
HLRZ T2,MP$COP##(P1) ;GET MIN COUNT
TXNE OPRFLG,CMDRUN ;HERE BY RUN COMMAND
MOVEI T2,0(P2) ;YES, IGNORE MIN ON STARTUP
CAIGE P2,0(T2) ;WANT LESS THAN MIN
MOVEI P2,0(T2) ;YES, START MIN THEN
CAILE P2,MAXJSN## ;MORE THAN JOB SLOT DEFINED
MOVEI P2,MAXJSN## ;YUP, BRING IT INTO RANGE
SUBI P2,0(P4) ;REDUCE BY NUMBER ALREADY RUNNING
SKIPLE P2 ;WATCH OUT FOR NEGATIVE ARITHMETIC
TXNE OPRFLG,CMDMCS ;PAUSE MCS?
SETO P2, ;YES-SET START COUNT TO -1
PUSHJ P,NEWJOB ;START AS MANY NEW ONES AS NEEDED
MOVE $V,P2 ;GET RESIDUAL COUNT
AOJA $V,CPOPJ## ;RETURN
;SUBROUTINE GETJOB - LOG A JOB IN AS A MPP
;CALL MOVEI P1,POINT TO THE MPP PROTOTYPE
; PUSHJ P,GETJOB
;RETURN CPOPJ ;NO, JOB SLOTS AVAILABLE
; CPOPJ1 ;JOB LOGGED IN J=JSN
GETJOB: PUSHJ P,GETJSN ;GET A JOB SLOT
POPJ P, ;NO JOB SLOTS
SETZB T1,JB$MPP##(J) ;DEFAULT PTY
PUSHJ P,CONPTY ;CONNECT A PTY
POPJ P, ;NO PTY'S
HRRZM T1,JB$UDX##(J) ;STORE THE UDX
SETOM LSTLOG## ;GIVE A NEW HEADER IN THE LOG FILE
$LASCI (T1,<LOG >) ;GET THE LOGIN COMMAND
PUSHJ P,STRMPP ;WRITE THE COMMAND
HLRZ T1,PPNMCS## ;GET THE PROJECT NUMBER
PUSHJ P,C8MPP ;TYPE THE OCTAL NUMBER
MOVEI T1,"/" ;SEPERATOR
PUSHJ P,CHRMPP ;WRITE THE SEPERATOR
HRRZ T1,PPNMCS## ;PROJECT NUMBER
PUSHJ P,C8MPP ;WRITE IT
$LASCI (T1,< /OPT:MCS>) ;FOR SPECIAL THINGS IN SWITCH.INI
PUSHJ P,STRMPP ;ADD TO LOGIN LINE
PUSHJ P,EOLMPP ;WRITE AN END OF LINE
GETJO1: MOVEI T4,1 ;GET A SECOND
SLEEP T4, ;WAIT FOR LOGIN TO HAPPEN
PUSHJ P,STSJSN ;GET THE JOB STATUS
TXNE T1,JB.UOA ;HAVE OUTPUT AVAILABLE
PUSHJ P,EATMPP ;YES, EAT IT UP
TXC T1,JB.UML!JB.UDI!JB.ULI ;COMPLEMENT THE BITS
TXCE T1,JB.UML!JB.UDI;MONITOR LEVEL DEMANDING INPUT
JRST GETJO1 ;WAIT SOME MORE
TXCE T1,JB.ULI ;JOB LOGGED IN
POPJ P, ;NO, CANNOT LOG IN
HRLM T1,JB$UDX##(J) ;STORE THE SYSTEM JOB NUMBER
ANDI T1,-1 ;SAVE ONLY THE JOB NUMBER
SETZM JB$PID##(J) ;CLEAR THE PID (FILLED BY KRNIPC)
PUSHJ P,MAKPID## ;MAK A PID FOR THE JOB
POPJ P, ; CAN NOT MAKE PID FOR USER
; WRITE OUT SET HPQ XXX TO MONITOR THROUGH PTY FOR
; JOB JUST LOGGED IN
HLRZ T1,MP$HPQ##(P1) ;NONZERO HPQ?
JUMPE T1,CPOPJ1## ;NO-RETURN
$LASCI (T1,<SET HPQ >)
PUSHJ P,STRMPP ;WRITE OUT TO PTY BUFFER
HLRZ T1,MP$HPQ##(P1) ;GET HPQ NO.
PUSHJ P,C10MPP ;WRITE OUT VALUE
PUSHJ P,EOLMPP ;WRITE OUT END OF LINE
PJRST CPOPJ1## ;RETURN
;SUBROUTINE RUNMPP START AN MPP
;ARGS: J = JSN, P1 = PTR TO MPP BLOCK, P3 = ADDR OF NODE PTR(OR 0)
;RETS: CPOPJ = FAILURE, CPOPJ1 = MPP STARTED
RUNMPP: PUSHJ P,STSJSN ;GET THE JOB STATUS
TXNE T1,JB.UOA ;HAVE OUTPUT AVAILABLE
PUSHJ P,EATMPP ;YES, EAT IT UP
TXC T1,JB.UJA!JB.ULI!JB.UML!JB.UDI
TXCE T1,JB.UJA!JB.ULI!JB.UML!JB.UDI
PUSHJ P,STPJOB ;STOP THE MPP FROM RUNNING
JFCL ;MPP STOPPED
HRRM P1,JB$MPP(J) ;STORE THE PROTOTYPE POINTER
SETOM LSTLOG## ;NOW, GIVE NEW LOG HEADER SINCE MPP IS DEFINED
$LASCI (T1,<RUN >) ;RUN COMMAND
PUSHJ P,STRMPP ;OUTPUT
MOVEI T1,MP$DEV##(P1) ;GET THE DEVICE NAME POINTER
SKIPN (T1) ;ANY DEVICE
JRST RUNMP1 ;NO, SKIP DEVICE
PUSHJ P,STRMPP ;YES, OUTPUT THE DEVICE
MOVEI T1,":" ;SEPERATOR
PUSHJ P,CHRMPP ;OUTPUT
RUNMP1: MOVEI T1,MP$MPP##(P1) ;GET THE PROGRAM POINTER
PUSHJ P,STRMPP ;OUTPUT THE PROGRAM NAME
MOVEI T1,"[" ;BRACKET
PUSHJ P,CHRMPP ;OUTPUT
HLRZ T1,MP$PPN##(P1) ;PROJECT NUMBER
PUSHJ P,C8MPP ;OUTPUT
MOVEI T1,"," ;SEPERATOR
PUSHJ P,CHRMPP
HRRZ T1,MP$PPN##(P1) ;PROGRAMMER NUMBER
PUSHJ P,C8MPP ;OUTPUT
MOVEI T1,"]" ;BRACKET
PUSHJ P,CHRMPP ;OUTPUT
RUNMP2: MOVEI T1," " ;SEPERATOR
PUSHJ P,CHRMPP ;WRITE
MOVE T1,MP$COR##(P1) ;CORE ARGUMENT
JUMPE T1,RUNMP3 ;"AS REQUIRED"
PUSHJ P,C10MPP ;OUTPUT
MOVEI T1,"P" ;THAT NUMBER IS IN PAGES
PUSHJ P,CHRMPP ;SO ADD CORRECT SUFFIX
RUNMP3: PUSHJ P,EOLMPP ;END OF LINE
TXO P3,JBEPI$ ;SET EPI FLAG ON ALSO
MOVX T1,MPIMM$ ;GET THE IMMORTAL BIT
TDNE T1,MP$HPQ##(P1) ;IS IT
TXO P3,JBIMM$ ;YES, SET STATUS BIT
TXNE OPRFLG,CMDRUN ;IS MPP BEING STARTED VIA RUN COMMAND?
TXO P3,JBOPR$ ;YES,MARK IT THAT WAY
MOVEM P3,JB$MLF##(J) ;STORE NODE VALUE(OR 0) AND FLAG SETTINGS
PJRST CPOPJ1## ;RETURN MPP RUNNING
;SUBROUTINE KILJOB REMOVE THE JOBLOT(LOGOUT)
;CALL MOVEI J,JSN
; PUSHJ P,KILJOB
; CPOPJ ;JOB CAN NOT BE LOGGED OUT
; CPOPJ1 ;JOB LOGGED OUT
KILJOB: SKIPG JB$UDX##(J) ;UDX ASSIGNED?
JRST KILJO4 ;NO-DO STUFF JUST IN CASE
PUSHJ P,STSJSN ;GET JOBS STATUS NOW
TXNN T1,JB.UJA!JB.ULI ;IS THE JOB STILL ATTACHED
JRST KILJO3 ;NO, THAT WAS EASY
$LASCI (T1,<KJOB/F
>) ;LOGOUT COMMAND
PUSHJ P,STRMPP ;WRITE
KILJO1: MOVEI T1,1 ;1 SECOND
SLEEP T1, ;WAIT FOR LOGOUT TO HAPPEN
PUSHJ P,STSJSN ;GET THE JOB STATUS
TXNE T1,JB.UOA ;HAVE OUTPUT AVAILABLE
PUSHJ P,EATMPP ;YES, EAT IT UP
TXNN T1,JB.UJA!JB.ULI; LOGGED IN
JRST KILJO3 ;NO, JOB IS LOGGED OFF
TXNE T1,JB.UDI ;DOES JOB WANT INPUT
POPJ P, ;YES, JOB DIDN'T MAKE IT OUT
JRST KILJO1 ;NO, TRY AGAIN
KILJO3: HRRZ T1,JB$UDX(J) ;GET THE UDX
PUSHJ P,DISPTY ;DISCONECT THE PTY
POPJ P, ;CAN'T DO IT
KILJO4: SETZM JB$UDX##(J) ;CLEAR THE JOB INFO
SETZM JB$PID##(J) ;ZERO OUT PID INFO ALSO
SETZM JB$MPP##(J) ;CLEAR PROTOTYPE INFORMATION
SETZM JB$MLF##(J) ;AND FLAG SETTINGS
PUSH P,J ;SAVE J
HRRZS J ;CONVERT AOBJN PTR TO JSN
$CALL(KMPP##,<J>) ;AND CLEAN UP TRANSACTIONS AND/OR
;CHECK TO SEE IF NEW MPP NEEDED.
SETOM RUNROL## ;START THE ROLLER SINCE A SLOT IS AVAILABLE
POP P,J ;RESTORE CALLERS J
PJRST CPOPJ1## ;GOOD RETURN
;SUBROUTINE STPJOB PUT THE JOB IN MONITOR MODE
;CALL MOVEI J,JSN
; PUSHJ P,STPJOB
;RETURN CPOPJ ;CAN'T GET TO MONITOR MODE
; CPOPJ1 ;JOB AT MONITOR MODE
STPJOB: ;ENTRY POINT
SKIPG JB$UDX##(J) ;UN ASSIGNED UDX?
PJRST CPOPJ1## ;YES-TELL HIM STOPPPED IT!!
STPJO1: PUSHJ P,STSJSN ;GET THE JOB STATUS
TXNE T1,JB.UOA ;HAVE OUTPUT AVAILABLE
PUSHJ P,EATMPP ;YES, EAT IT UP
TXC T1,JB.UML!JB.UDI;COMPLEMENT THE MODE BITS
TXCN T1,JB.UML!JB.UDI;RESTORE AND CHECK FOR MONITOR MODE
PJRST CPOPJ1## ;JOB AT MONITOR MODE
MOVEI T1,[BYTE (7) .CHCNC,.CHCNC] ;LOAD 2 ^C ^C
PUSHJ P,STRMPP ;WRITE
PUSHJ P,FRCMPP ;AND FORCE THE OPUTPUT TO THE MPP
MOVEI T1,1 ;GET A SECOND
SLEEP T1, ;GIVE ^C'S A CHANCE TO WORK
JRST STPJO1 ;TRY AGAIN
SUBTTL UTILITY ROUTINES FOR KRNMPP
;SUBROUTINE C??MPP ;CONVERT A NUMBER IN THE RADIX AND OUTPUT
;CALL MOVEI T1,NUMBER
; PUSHJ P,C8MPP ;OCTAL
; C10MPP ;DECIMAL
; CXXMPP ;SPECIFY THE RADIX IN T3
;RETURN CPOPJ
C8MPP: SKIPA T3,[^D8] ;LOAD OCTAL BASE
C10MPP: MOVEI T3,^D10 ;LOAD DECIMAL BASE
CXXMPP: ;BASE LOADED IN T3
IDIVI T1,(T3) ;CONVERT THE NUMBER
HRLM T2,(P) ;SAVE THE REMAINDERS
SKIPE T1 ;ANY LEFT
PUSHJ P,CXXMPP ;YES, CONTINUE
HLRZ T1,(P) ;GET THE REMAINDERS BACK
MOVEI T1,"0"(T1) ;CONVERT TO ASCII
PJRST CHRMPP ;WRITE THE CHARACTER
;SUBROUTINE EOLMPP ;WRITE AN END OF LINE SEQUENCE
;CALL PUSHJ P,EOLMPP
;RETURN CPOPJ
EOLMPP:: ;ENTRY POINT
PJSP T1,STRMPP ;LOAD T1 WITHE THE ADDRESS OF THE STRING
ASCIZ /
/ ; AND JUMP TO THE STRING WRITER
SUBTTL ROUTINES TO ACCESS THE JOB SLOT TABLE
;SUBROUTINE FNDJSN FIND A JOB SLOT FOR A PARTICULAR MPP
;CALL MOVEI P1,ADDRESS OF MPP PROTOTYPE
; HRLOI J,-<MAXJSN+1> NO.OF JOB SLOTS TO SEARCH
; PUSHJ P,FNDJSN
;RETURN CPOPJ ;NO JOB SLOTS IN SYSTEM
; CPOPJ1 ;JOB SLOT FOUND J=JSN
;
FNDJSN: AOBJP J,CPOPJ ;ANYMORE? NO-RETURN
SKIPLE JB$UDX(J) ;ACTIVE JOB?
CAME P1,JB$MPP(J) ;YES, SAME PROTOTYPES?
JRST FNDJSN ;NO-TRY AGAIN
JRST CPOPJ1## ;YES-THEN GOOD
;SUBROUTINE ACTJOB COUNT ALL ACTIVE JOBS IN THE SSYSTEM
;CALL MOVEI P1,ADDRESS OF MPP PROTOTYPE TO COUNT
; PUSHJ P,ACTJOB
;RETURN CPOPJ1 ;COUNT=P4
ACTJOB::
SETZ P4,
MOVE J,JSNCO1## ;NO.OF ETRIES IN TABLE
ACT001: PUSHJ P,FNDJSN ;FIND A SPECIAL JOB SLOT
POPJ P, ;NO MORE TO CHECK
AOJA P4,ACT001 ;COUNT IT AND LOOK FOR MORE
;SUBROUTINE NEWJOB START A NUMBER OF NEW JOBS IN SYSTEM
;CALL MOVEI P2,NUMBER TO START
; PUSHJ P,NEWJOB
;RETURN CPOPJ
NEWJOB: JUMPLE P2,CPOPJ## ;START ANY? IF NOT RETURN
NEWJB1: MOVX T1,MPLOC$ ;LOCAL MPP?
TDNE T1,MP$HPQ##(P1) ;??
JRST NEWLOC ;YES-SO JUST PUSHJ TO IT
PUSHJ P,GETJOB ;GET A JSN,AND LOG IT IN
POPJ P, ;NONE AVAILABLE-SO RETURN
PUSHJ P,RUNMPP ;NO START A PROGRAM
POPJ P, ;ERROR FROM RUNMPP
NEWCNT: SOJG P2,NEWJB1 ;START SOMEMORE MAYBE
POPJ P, ;NO-JUST RETURN
NEWLOC: PUSHJ P,@MP$MPP##(P1) ;JUMP TO LOCAL MPP
JRST NEWCNT ;COUNT DOWN TILL DONE
;ROUTINE GETJSN FIND AN AVAILABLE JOB SLOT ENTRY
;CALL PUSHJ P,GETJSN
;RETURN CPOPJ ;NO SLOTS AVAILABLE
; CPOPJ1 ;OK RETURN J=JSN
GETJSN:: ;ENTRY POINT
PUSHJ P,RECOVR ;RECOVER ANY DEBUGGING MPPS
MOVE J,JSNCO0## ;SET UP CONSTANT NEEDED
GET002: SKIPN JB$UDX##(J) ;IS SLOT AVAILABLE?
JRST GETONE ;YES, RECLAIM IT
GETCNT: AOBJN J,GET002 ;TRY ANOTHER
MOVE J,JSNCO0##
GET003: MOVE T1,JB$MLF##(J) ;GET MCP STATUS
TXNN T1,JBIDL$ ;IN IDLE STATE???
JRST GET004 ;NOPE-
SKIPL JB$UDX##(J) ;TREAT DEBUGGING MPPS AS IMMORTAL
TXNE T1,JBIMM$ ;IMMORTAL MPP???
JRST GET004 ;YES-LEAVE IT ALONE
PUSH P,J ;SAVE A FEW BEFORE COUNTING MPPS
PUSH P,P4 ;...
PUSH P,P1 ;...
MOVE P1,JB$MPP##(J) ;GET MPP USED BY THIS JOB
PUSHJ P,ACTJOB ;COUNT ALL USES OF IT
HLRZ T1,MP$COP##(P1) ;AND FIND IT'S MIN
SUBI T1,(P4) ;COMPUTE IF OVER MIN
POP P,P1 ;RESTORE ACS
POP P,P4 ;...
POP P,J ;...
JUMPGE T1,GET004 ;NOT OVER MIN, TRY A DIFFERENT MPP
PUSHJ P,KILMPP ;NO-KILL IT
JRST GET004 ;NOT KILLED-IGNORE IT
GETONE: SETZM JB$MLF##(J) ;AND OTHER WORD
ANDI J,-1 ;ONLY NEED INDEX
PJRST CPOPJ1## ;AND EXIT -GOOD
GET004: AOBJN J,GET003 ;MORE-SO DO IT
POPJ P, ;OH-OH,NO SLOTS---ERROR
;SUBROUTINE STSJSN - RETURN THE STATUS OF A MPP
;CALL ;(J)=THE JSN
; PUSHJ P,STSJSN
; CPOPJ ;T1=RESULTS OF THE "JOBSTS" LUUO
STSJSN:: ;ENTRY POINT
HRRZ T1,JB$UDX##(J) ;GET THE UDX FOR THE CHANNEL
JUMPE T1,CPOPJ## ;UDX NOT ASSIGNED (JSN NOT ASSIGNED)
JOBSTS T1, ;GET THE SUB-JOB STATUS
$STPCD(JUF,JOBSTS UUO FAILED)
POPJ P, ;RETURN
;SUBROUTINE FNDMPP - FIND AN MPP IN THE PROTOTYPE TABLE
;CALL MOVEI T1,ADDR OF FILESPEC
; PUSHJ P,FNDMPP
; CPOPJ ;COULD NOT FIND ONE
; CPOPJ1 ;FOUND ONE T1=PTR TO PROTOTYPE
FNDMPP::
PUSHJ P,SAVE4## ;SAVE ALL PERM ACS
MOVN T2,NMPPS## ;COMPUTE AOBJN POINTER
HRLZS T2 ; INTO MPPTABLE
FNDNXT: HLRZ T3,MPPTAB##(T2) ;GET ADDRESS OF PROTOTYPE CHAIN
JUMPE T3,FNDNX1 ;NONE HERE, TRY THE NEXT
PUSHJ P,MPPCHN ;SCAN DOWN CHAIN TO SEE IF THERE
JRST FNDNX1 ;TRY THE NEXT ONE
HRRZI T1,0(T2) ;FOUND-RETURN ADDR IN RIGHT PLACE
PJRST CPOPJ1## ;GOOD RETURN
FNDNX1: AOBJN T2,FNDNXT ;NONE FOUND, TRY THE NEXT
POPJ P, ;NONE, GIVE ERROR RETURN
;SUBROUTINE MPPCHN - SCAN MPP PROTOTYPE CHAIN TO FIND AN MPP
;CALL MOVEI T1,ADDR OF FILESPEC
; MOVEI T3,ADDR OF FIRST MPP PROTOTYPE IN CHAIN
; PUSHJ P,MPPCHN
;RETURN CPOPJ ;COULD NOT FIND IT;
; CPOPJ1 ;FOUND ONE T4 HAS ADDRESS OF PROTOTYPE
MPPCHN::
HRRZI T4,0(T3) ;SAVE ADDR OF THIS PROTOTYPE
PUSHJ P,MPPCOM ;COMPARE FILESPEC AND PROTOTYPE
PJRST CPOPJ1## ; EQUAL,SO RETURN
HRRZ T4,MP$ALT##(T4) ;POINT TO NEXT PROTOTYPE ENTRY
JUMPN T4,MPPCHN+1 ;MORE-THEN CONTINUE
POPJ P, ;NO MORE THEN ERROR
;SUBROUTINE MPPCOM - COMPARE A FILESPEC AND A SPECIFIC PROTOTYPE
;CALL MOVEI T1,FILESPEC
; MOVEI T4,PROTOTYPE ADDRESS
; CPOPJ ; EQUAL
; CPOPJ1 ;NOT EQUAL
MPPCOM::
PUSHJ P,SAVE1## ;SAVE P1 FIRST
MOVE P1,0(T1) ;GET DEVICE SPEC
CAME P1,MP$DEV##(T4) ;COMPARE DEVICE SPECS
PJRST CPOPJ1## ;GIVE NOT EQUAL RETURN
MOVE P1,1(T1)
CAME P1,MP$DEV+1(T4)
PJRST CPOPJ1## ;GIVE NOT EQUAL RETURN
MOVE P1,2(T1) ;GET FILE NAME
CAME P1,MP$MPP##(T4) ;EQUAL FILE NAMES?
PJRST CPOPJ1## ;GIVE NOT EQUAL RETURN
MOVE P1,3(T1)
CAME P1,MP$MPP+1(T4)
PJRST CPOPJ1## ;GIVE NOT EQUAL RETURN
MOVE P1,4(T1) ;SEE IF SAME PPNS
CAME P1,MP$PPN##(T4) ;SAME PPNS?
PJRST CPOPJ1## ;GIVE NOT EQUAL RETURN
POPJ P, ;GOOD RETURN - SPECS MATCH
;SUBROUTINE BLDMPP - BUILD MPP IF SLOT AVAILABLE
;CALL MOVEI T1,ADDR OF MPP FILE SPEC
; PUSHJ P,BLDMPP
;RETURN CPOPJ NO ROOM OR FREE SLOTS
; CPOPJ1 T1 = DISPLACEMENT INTO MPPTAB
BLDMPP:: PUSHJ P,SAVE1## ;SAVE P1
SOSGE NSLOT## ;A SLOT AVAILABLE?
JRST BLDERX ;NO-ERROR
HRRZI P1,0(T1) ;SVE PTR TO FILE SPEC
MOVX T2,12 ;GET PROTOTYPE AREA
PUSHJ P,GETWDS##
JRST BLDERX ;NO SPACE,THEN ERROR
SETZM MP$ALT##(T1) ;CLEAR TYPE+ALTERNATE FLAG
DMOVE T2,0(P1) ;GET DEVICE INFO
DMOVEM T2,MP$DEV##(T1)
DMOVE T2,2(P1) ;GET NAME INFO
DMOVEM T2,MP$MPP##(T1)
MOVE T2,4(P1) ;GET PPN
MOVEM T2,MP$PPN##(T1)
MOVE P1,T1
SETZM MP$COR##(P1) ;SET AS REQUIRED
MOVEI T1,1 ;SET MIN = 0, MAX = 1
MOVEM T1,MP$COP##(P1)
SETZM MP$RUN##(P1) ;SET INIT = 0
MOVX T1,MPTMP$ ;MARK IT TEMPORARY
MOVEM T1,MP$HPQ##(P1) ;AN HPQ = 0
AOS T1,NMPPS## ;INCR DISPL.INTO MPP TABLE
HRLS P1 ;PUT IT IN BOTH HALVES
MOVEM P1,MPPTAB-1(T1) ;STORE PROTOTYPE ADDR
SOJA T1,CPOPJ1## ;GIVE GOOD RETURN
BLDERX: AOS NSLOT## ;BACK UP COUNT
POPJ P,
SUBTTL MPP INTERFACE ROUTINES
;SUBROUTINE TO CONNECT A PTY TO THE MPX CHANNEL
;CALL MOVEI T1,UDX,DEVICE NAME OR 0=PTY
; PUSHJ P,CONPTY
;RETURN CPOPJ ;ERROR
; CPOPJ1 ;PTY IS CONNECTED T1=UDX
CONPTY:: ;ENTRY POINT
SKIPA T2,.+1 ;LOAD THE CONNECT ARGUMENT BLOCK
XWD .CNCCN,MPP ;CONNECT ON THE MPP CHANNEL
SKIPN T3,T1 ;DEFICE SPECIFIED
MOVSI T3,(SIXBIT /PTY/);DEFAULT THE PTY
MOVEI T1,T2 ;ARGUMENT BLOCK POINTER
CNECT. T1, ;CONNECT THE PTY
POPJ P, ;DIDN'T MAKE IT
PJRST CPOPJ1## ;OK RETURN
;SUBROUTINE TO DISCONNECT A PTY FROM THE MPX CHANNEL
;CALL MOVEI T1,UDX
;PUSHJ P,DISPTY
;RETURN CPOPJ ;ERROR
; CPOPJ1 ;OK RETURN
DISPTY:: ;ENTRY
SKIPA T2,.+1 ;LOAD THE DISCONNECT ARGUEMENT
XWD .CNCDC,MPP ;ARGUEMENT
MOVE T3,T1 ;MOVE THE ARGUEMNT
MOVEI T1,T2 ;ARGUMENT BLOCK POINTER
CNECT. T1, ;RELEASE THE PTY
JFCL ;OH WELL
PJRST CPOPJ1## ;RETURN
SUBTTL MPP CHARACTER I/O ROUTINES
;SUBROUTINE TO WRITE AN ASCII CHARACTER TO THE MPP'S
;CALL MOVEI T1,[ASCIZ /STRING/]
; PUSHJ P,STRMPP
;RETURN CPOPJ
STRMPP:: ;ENTRY POINT
HRLI T1,(POINT 7,0) ;MAKE AN ASCII BYTE POINTER
PUSH P,T1 ;SAVE THE POINTER
STRMP1: ILDB T1,(P) ;GET THE NEXT CHARACTER
JUMPE T1,T1POPJ## ;EXIT, END OF STRING
PUSHJ P,CHRMPP ;WRITE THE CHARACTER
JRST STRMP1 ;CONTINUE
;SUBROUTINE CHRMPP OUTPUT A SINGLE CHARACTER TO TH(J)
;CALL MOVEI T1,CHARACTR
; PUSHJ P,CHRMPP
;RETURN CPOPJ
CHRMPP:: CAMN J,MPPJ ;SAME MPP
JRST CHRMP1 ;YES, GO ON
PUSHJ P,OBKMPP ;NO WRITE THE CURRENT USER
MOVEM J,MPPJ ;STORE CURRENT MPP NUMBER
CHRMP1: SOSG MPPOUT##+.BFCTR ;REDUCE THE BYTE COUNT
PUSHJ P,OBKMPP ;WRITE THE BUFFER
IDPB T1,MPPOUT##+.BFPTR ;DEPOSITE THE CHARACTER
CAILE T1,.CHCUN ;CONTROL CHARATER
PJRST MPPOLG## ;NO, LOG THE CHARACTER
CAILE T1,.CHCNH ;ALLOW SOME CONTROL CHARACTER
CAIL T1,.CHCNN ;ETC
POPJ P, ;SKIP THE LOGGING
PUSHJ P,MPPOLG## ;LOG (11-15)
CAIN T1,.CHLFD ;LINE FEED
PJRST OBKMPP ;YES, WRITE THE BUFFER
POPJ P, ;RETURN
;SUBROUTNE FRCMPP FORCE OUTPUT TO AN MPP IE ^C^C
;CALL PUSHJ P,FRCMPP
;RETURN CPOPJ
FRCMPP: ;ENTRY POINT
PUSH P,T1 ;SAVE T1
PUSHJ P,OBKMPP ;TRY NORMAL OUTPUT INCASE ANOTHER MPP
PJRST OBKMP2 ;WRITE THE BUFER
;SUBROUTINE OBKMPP - ROUTINE TO WRITE THE CURRENT BLOCK OUT
;CALL PUSHJ P,OBKMPP
;RETURN CPOPJ ;THE BLOCK HAS BEEN WRITTEN
OBKMPP:: ;ENTRY POINT
PUSH P,T1 ;SAVE T1
OBKMP0: PUSHJ P,STSJSN ;GET THE JOB STATUS
OBKMP1: TXNE T1,JB.UDI ;DEMANDING INPUT
JRST OBKMP2 ;SEND THE OUTPUT
JFCL ;CAN NOT ACCEPT OUTPUT FROM MCP
OBKMP2: MOVE T1,MPPOUT## ;GET THE CURRENT BUFFER ADDRESS
SKIPN 2(T1) ;ANY DATA TO OUTPUT
JUMPGE T1,T1POPJ## ;EXIT NO DATA (UNLESS VIGIN)
MOVE T1,JB$UDX##(J) ;YES, GET THE UDX
HRRZM T1,MPPOUT##+.BFUDX ;STORE THE UDX
OUTPUT MPP, ;OUTPUT THE BUFFER
PJRST T1POPJ## ;RETURN
;SUBROUTINE KILMPP - KILL AN MPP(AND ISSUE ERROR MSGS TO OPERATOR)
;CALL MONEI J,JSN TO BE KILLED
; PUSHJ P,KILMPP
; CPOPJ ;BAD RETURN
; CPOPJ1 ;GOOD RETURN
KILMPP::
PUSHJ P,STPJOB ;STOP THE JOB
JRST KILXX1 ;NOPE-
PUSHJ P,KILJOB ;KJOB IT
JRST KILXX2 ;NOPE AGAIN
PJRST CPOPJ1## ;AND ALL DONE
KILXX1: HRRZ T1,J ;GET JSN
$CALL (INFORM##,<KILMS0,T1,0,0,0,0>)
POPJ P, ;ERROR RETURN
KILXX2: HRRZ T1,J ;GET JSN
$CALL (INFORM##,<KILMS1,T1,0,0,0,0>)
POPJ P, ;ERROR RETURN
KILMS0: [ASCII "
?MCSCSJ CAN NOT ENTER MONITOR MODE FOR JSN : %0D%@"]
KILMS1: [ASCII "
?MCSCKJ CAN NOT KJOB JSN : %0D%@"]
;SUBROUTINE EATMPP COPY THE MPP(PTY) TRAFFIC TO THE LOG FILE
;CALL PUSHJ P,EATMPP
;RETURN CPOPJ ;PTY IS EMPTY
;
;ALSO CALLED BY THE SCHEDULER ON INTERRUPTS
;
EATMPP:: ;ENTRY POINT
PUSHJ P,SAVT## ;SAVE T1
PUSH P,P1 ;SAVE PERM AC
SETZ P1, ;AND CLEAR IT
PUSH P,J ;SAVER THE CURRENT J
EATMP0: PUSHJ P,CHKZER ;ANY MPPS ACTIVE????
JRST EATMP2 ;NO-IGNORE THIS INTERRUPT!!
PUSHJ P,IBKMPP ;READ A BLOCK IF AVAILABLE
JRST EATMP2 ;EMPTY BUFFER
HRRZ T1,MPPIN##+.BFUDX;GET THE UDX
PUSHJ P,SRCUDX ;FIND J
JRST EATMP2 ;ILLEGAL UDX-IGNORE IT!!
PUSHJ P,MPPERR ;SEE IF ERROR/ MESSAGE FROM PTY
EATMP1: SOSGE MPPIN##+.BFCTR ;REDUCE THE CHARACTER COUNT
JRST EATMP0 ;TRY ANOTHER BUFFER
ILDB T1,MPPIN##+.BFPTR ;GET A CHARACTER
JUMPE T1,EATMP1 ;IGNORE NULLS
PUSHJ P,MPPILG## ;LOG IT
TXNN OPRFLG,CMDMON ;MONITOR JSN FLAG SET?
JRST EATMP1 ;NO-THEN NORMAL
LDB T2,[POINTR(OPRFLG,CMDJSN)] ;GET JSN # TO BE TRACED
CAIE T2,CMDALL ;IS IT "ALL"?
CAIN T2,0(J) ;OR SAME JSN AS THIS?
PUSHJ P,OCHOPX## ;YES-LOG IT OUT
AOJA P1,EATMP1 ;FOR ALL MPP S
EATMP2: POP P,J ;RETORE JSN
SKIPE P1 ;IF NON-ZERO
PUSHJ P,OBKOPR## ;OUTPUT BLOCK TO OPR
POP P,P1 ;RESTORE PERM AC
POPJ P, ;RETURN
;SUBROUTINE MPPERR - SEE IF ERROR MESSAGE IN PTY BUFFER
;CALL MOVEI J,JSN ;SETUP JSN
; PUSHJ P,MPPERR
;RETURN CPOPJ
MPPERR:
PUSH P,MPPIN##+.BFCTR ;SAVE CHAR COUNT
PUSH P,MPPIN##+.BFPTR ;SAVE CHAR POINTER
MPPMRE: SOSGE -1(P) ;MORE CHARS?
JRST MPPXIT ;NO-LEAVE
ILDB T1,0(P) ;GET A CHAR
CAIN T1,12 ;CR OR LF-THEN IGNORE
JRST MPPMRE
CAIN T1,15
JRST MPPMRE
CAIE T1,42 ;SEE IF LEADING " FOR MESSAGE TO OPR
JRST MPPER1 ;NO,TRY TO SEE IF ERROR "?"
$CALL (INFORM,<MPPIMS,J,0,0,0,0>) ;TELL OPR ITS COMING
MOVEI T1,42 ;REPLACE THE QUOTE
JRST MPPER2 ;REJOIN COMMON CODE
MPPER1: CAIE T1,"?" ;ERROR MESSAGE?
JRST MPPXIT ;NO-EXIT
$CALL (INFORM,<MPPMSG,J,0,0,0,0>) ;YES-TELL OPERATOR
MOVX T1,"?"
MPPER2:
PUSHJ P,OCHOPX## ;PRINT ERROR MESSAGE
AOS P1 ;INCREMENT
MPPMOR: SOSGE -1(P) ;GET ANOTHER CHAR(?)
JRST MPPXIT ;NO-EXIT
ILDB T1,0(P) ;THEN GET THE CHAR
PUSHJ P,OCHOPX## ;YES-OUTPUT IT
CAIE T1,.CHLFD ;STOP IF END OF LINE HIT
AOJA P1,MPPMOR ;KEEP GOING
MPPXIT: POP P,(P)
POP P,(P) ;POP JUNK OFF
POPJ P, ;EXIT
MPPMSG: [ASCIZ "
?MCSERR ERROR WITH JSN: %0D%. ERROR MESSAGE FOLLOWS...@"]
MPPIMS: [ASCIZ "
[MCSMSG Message for MCS OPERATOR from JSN: %0D% follows]@"]
;SUBROUTINE CHKZER - SEE IF ANY MPPS ACTIVE AT ALL
;CALL PUSHJ P,CHKZER
;RETURN CPOPJ ;NO
; CPOPJ1 ;YES-
CHKZER: MOVE J,JSNCO1## ;GET CONSTANT NEEDED
AOBJP J,CPOPJ## ;NONE ACTIVE-ERROR RETURN
SKIPG JB$UDX##(J) ;ACTIVE JSN??
JRST .-2 ;NO-KEEP TRYING
PJRST CPOPJ1## ;YES-GOOD!!
;SUBROUTINE SRCUDX SEARCH FOR THE UDX AND RETURN J=JSN
;CALL MOVEI T1,UDX
; PUSHJ P,SRCUDX
;RETURN CPOPJ ;NOT FOUND
; CPOPJ1 ;FOUND J=JSN
SRCUDX: ;ENTRY POINT
MOVE J,JSNCO1## ;SET SEARCH RANGE
PUSH P,T1 ;SAVE THE UDX
SRCUD1: AOBJP J,T1POPJ## ;NOT IN THE TABLE
HRRZ T1,JB$UDX(J) ;SEARCH THE TABLE
CAME T1,(P) ;IS THIS THE ENTRY
JRST SRCUD1 ;NO, CONTINUE
ANDI J,-1 ;FIX UP J
PJRST TPOPJ1## ;RETURN
;SUBROUTINE IBKMPP - ROUTINE TO INPUT A BLOCK FROM THE PTY
;CALL PUSHJ P,IBKMPP
;RETURN COPJ ;BLOCK HAS BEEN READ
IBKMPP:: ;ENTRY POINT
INPUT MPP, ;INPUT THE BLOCK
;PTY