Trailing-Edge
-
PDP-10 Archives
-
AP-D471B-SB_1978
-
kernel.mac
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 NEVER/NEVER/NEVER BLOCK
SKIPLE MPPIN##+.BFCTR ;GET ANY THING
AOS (P) ;YES, SKIP RETURN
POPJ P, ;NO, NORMAL RETURN
SUBTTL ROUTINE TO RECOVER JOBSLOT
;SUBROUTINE TO RECOVER JOB SLOTS WHEN A DEBUGGING MPP LOGS OUT
; OR WHEN REQUESTED, LOOK AT ALL ACTIVE JOBS
;CALL: PUSHJ P,RECOVR
; CPOPJ
RECOVR:: ;ENTRY POINT
PUSHJ P,SAVE1 ;SAVE P1
PUSH P,J ;SAVE CALLERS
MOVE P1,[EXP %IPCPM] ;GET PID MASK
GETTAB P1, ;FOR NOW
$STPCD(CPM,CANNOT GET PID MASK FROM MONITOR)
MOVE J,JSNCO0## ; J=JOB TABLE COUNTER
RECLI: MOVE T1,JB$PID##(J) ;GET ITS CURRENT PID
JUMPE T1,REC1 ;JUMP IF ALREADY DID THIS
MOVE T2,JB$UDX##(J) ;GET UDX FOR JOB
JUMPL T2,REC2 ;IF DEBUGGING, DO IT NOW
TXNE OPRFLG,RCVALL ;TRY ALL JOBS ?
JUMPN T2,REC2 ;YES, GO IF ATTACHED
REC1: AOBJN J,RECLI ;FOR THE NEXT JOB
TXZ OPRFLG,RCVALL ;CLEAR THE FLAG AFTER TRYING
POP P,J ;RESTORE CALLERS
POPJ P, ;HERE WHEN FINISHED
REC2: MOVE T2,T1 ;MAKE A COPY OF T1
AND T1,P1 ;STRIP OFF INDEX FIELD
ANDCM T2,P1 ;THIS TIME THE INDEX FIELD IS PRESERVED
HRLZ T1,T1 ;SET UP FOR GETTAB CALL
HRRI T1,.GTPID ;FOR MORE INFO ABOUT THE JOB
GETTAB T1, ;GET PIDTAB INFO
$STPCD(CPI,CANNOT GET PID TABLE INFORMATION)
ANDCM T1,P1 ;STRIP OFF JOB #(I THINK??)
CAME T1,T2 ;AND COMPARE WITH OUR COPY
PUSHJ P,KILMPP ;KILL OFF THE JOB SLOT
JFCL ;IGNORE FAILURES HERE
JRST REC1 ;FOR ALL JOBS
$LOW
MPPJ: BLOCK 1 ;CURRENT MPP RECEIVING DATA
$LIT
PRGEND ;END OF KRNMPP
TITLE KRNOPR - MCS-10 INTERFACE TO THE OPERATOR TERMINAL
SUBTTL D.TODD/DRT/CDO/ILG 1 JUNE 1977
SEARCH KERNEL,MACTEN,UUOSYM ;LOAD ALL THE UNIVERSALS
$RELOC
;SUBTTL OPERATOR COMMAND/DISPATCH TABLES
;DEFINE THE OPERATOR COMMANDS
DEFINE OPRCMD<
LSTOFF
X AVAILABLE,AVAIL
X AUTO,AUTO
X CLOSE,CLOSEX
X CONNECT,CONECT
X CONTINUE,CONTIN
X DEBUG,DEBUG
X DISABLE,DISABL
X DISCONNECT,DISCON
X DISKP,DISKP
X DMPP,DMPP
X ENABLE,ENABLE
X FAILSOFT,FAILSF
X GREET,GREET
X HELP,HELP
X HPQ,HPQX
X KILL,KILL
X KMCS,KMCS
X MONITOR,MONIX
X JOURNAL,JOURNL
X MPPLOG,MPPLOG
X OPEN,OPENX
X PAUSE,PAUSE
X RESTART,RESTAR
X REFRESH,REFRES
X ROLL,ROLL
X RUN,RUNX
X SEND,SENDX
X SET,SET
X START,STARTX
X SWITCH,SWTCH
X WHAT,WHAT
X NO,NOKILL
X YES,YESKIL
X H,HELP
LSTON
>;END OF OPERATOR COMMAND LIST
; NUMBER OF COMMANDS AT END OF COMMAND LIST THAT ARE NOT
; TO BE TYPED VIA "HELP" COMMAND
HDNCMD==3
DEFINE X(A,B,C)<
IF2,<IFNDEF B,<B=CPOPJ##>>
IFE ZZ&1,<DEFINE XX(D)<
XWD B,D>>
IFN ZZ&1,<XX B>
ZZ=ZZ+1
>;END OF X FOR ADDRESS GENERATION
;GENERATE THE ADDRESS DISPATCH
ZZ==0
OPRDSP: OPRCMD
IFN ZZ&1,<XX CPOPJ##> ;TIE DOWN THE LAST ENTRY
OPRSIZ: XWD -ZZ,OPRTBL
HLPSIZ: XWD -ZZ+HDNCMD,OPRTBL
;GENERATE THE COMMAND NAME LIST
DEFINE X(A,B,C)<
EXP SIXBIT \A\
>;END OF X FOR THE COMMAND LIST
OPRTBL: OPRCMD
; MCSOPR - SCHEDULED TO RUN TO PROCESS OPERATOR CONSOLE I/O
MCSOPR:: SKIPE ATOOPR ;IN AUTO FILE
JRST MCSO.1 ;YES, TAKE THE COMMAND
SKPINL ;NO, ANYTHING THERE
POPJ P, ;NO, EXIT NOW
MCSO.1: SETZ J, ;SYSTEM FUNCTION (SET JOB NUMBER)
TXZ OPRFLG,EOFLAG ;CLEAR END OF LINE INDICATOR
PUSHJ P,GETSIX ;GET A COMMAND
JUMPE T1,[PUSHJ P,GETEOL ;NO COMMAND, GET TO END OF LINE
PUSHJ P,OSRAST ;OUTPUT *
JRST MCSOPR] ;TRY FOR MORE INPUT
MOVE T2,OPRSIZ ;GET THE -LENGTH,ADR OF THE TABLE
PUSHJ P,SCNTBL## ;SCAN THE TABLE
PJRST BADCMD ;BAD COMMAND
ROT T1,-1 ;INDEX/2
HLRZ T2,OPRDSP(T1) ;EVEN
JUMPGE T1,CMDXE1 ;DISPATCH
HRRZ T2,OPRDSP(T1) ;ODD
CMDXE1: PUSHJ P,(T2) ;DISPATCH
CMDXE2: PUSHJ P,OSRAST ;PUT OUT THE "*" FOR OPR
PUSHJ P,GETEOL ;EAT REST OF LINE
JRST MCSOPR ;TRY FOR NEXT COMMAND OR RETURN
BADCMD: ;HERE IF SCNTBL DID NOT SKIP ON RETURN
JUMPL T1,.+2 ;IT T1/0 ITS AMBIGUOUS,ELSE UNKNOWN
SKIPA T1,[[ASCIZ "?MCSACG Ambiguous command given@"]]
MOVEI T1,[ASCIZ "?MCSUCG Unknown command given@"]
PUSHJ P,OSROPR ;OUTPUT THE STRING
JRST CMDXE2 ;FINISH COMMAND INPUT
BADARG: JUMPL T1,.+2 ;IF T1/0 ITS AMBIGUOUS , ELSE UNKNOWN
SKIPA T1,[[ASCIZ "?MCSAAG Ambiguous argument given - "]]
MOVEI T1,[ASCIZ "?MCSUAG Uknown argument given - "]
PUSHJ P,OSROPR ;OUTPUT STRING
MOVE T1,LASTOK## ;GET THE INPUT ARGUMENT
PUSHJ P,PUTSIX ;OUTPUT IT
PJRST PUTEOL ;END WITH <CR-LF>
LSTARG: MOVE P1,T2 ;GET COPY OF LIT POINTER
SETZ P2, ;CLEAR COUNTER
$SAY (<[MCSPCA Possible choices are:]>)
LSTA.1: JUMPE P2,[PUSHJ P,PUTEOL ;TERMINATE CURRENT LINE
MOVEI P2,7 ;NUMBER OF ARGS PER LINE
JRST .+1] ;RETURN IN LINE
MOVE T1,0(P1) ;GET A NAME
PUSHJ P,PUTSIX ;OUTPUT IT
$SAY (< >) ;OUTPUT A TAB
SOS P2 ;DECREMENT COUNTER
AOBJN P1,LSTA.1 ;
PJRST PUTEOL ;END THE LINE
SUBTTL OPERATOR COMMANDS
HELP: MOVE T2,HLPSIZ
PJRST LSTARG
HPQX: ;ENTRY
PUSHJ P,GETDEC ;GET THE ARGUMENT
SKIPGE NOINPUT ;IF NO INPUT GIVEN
PJRST DVENEX ;PROMPT
HPQ T1, ;SET HPQ
$SAYRET(<?MCSHSF HPQ set failed>)
POPJ P, ;RETURN
DISKP: ;ENTRY
PUSHJ P,GETDEC ;GET THE ARGUMENT
SKIPGE NOINPUT ;IF NO INPUT GIVEN
PJRST DVENEX ;PROMPT
MOVEI T2,(T1) ;COPY THE PRIORITY
HRLI T2,-2 ;FOR THE ENTIRE JOB
SKIPA T1,.+1 ;LOAD THE FINCTION
XWD .DUPRI,T2
DISK. T1, ;SET THE PRIORITY
$SAYRET (<?MCSDSF DISK PRIORITY set failed>)
POPJ P, ;RETURN OK
DEBUG: SKIPN T1,.JBDDT## ;DDT LOADED?
$SAYRET(<?MCSDEB DDT NOT LOADED>)
PJRST 0(T1) ;GO TO DDT
DMPP: PUSHJ P,GETSIX ;GET ARGUMENT
$DISPATCH<ON,OFF>,<DMPON,DMPOFF>
DMPON: TXOA OPRFLG,CMDDEB ;ALLOW DEBUGGING MPPS
DMPOFF: TXZ OPRFLG,CMDDEB ;DONT ALLOW DEBUGGING MPPS
POPJ P, ;RETURN
; CONNECT COMMAND PROCESSOR
; WILL HANDLE COMMANDS OF FORMAT:
; CONNECT <PORT> (TO) (LINE) <OCTAL VALUE> (AT) <SITE-NAME>
; CONNECT <PORT> (TO) (DROP) <DECIMAL-DROP> (ON) <SIXBIT RDX DEVICE>
; CONNECT <PORT> (TO) (DEVICE) <SIXBIT TTY NAME>
; CONNECT <PORT> (TO) (DEVICE) <SIXBIT RDX NAME>
;
; THE RESULT IS TO CONNECT THE DESIRED PORT TO THE SPECIFIED DEVICE
CONECT: PUSHJ P,GETSIX ;GET THE PORT NAME
JUMPE T1,PORNEX ;PORT NAME EXPECTED
MOVEM T1,I$PORT ;STORE PORT NAME AWAY FOR NOW
PUSHJ P,LOCENT ;FIND THE PORT
PJRST ILLPRT ;NOT THE RIGHT NAME
HRRZ T2,2(P1) ;GET UDX FOR THIS PORT
JUMPN T2,CCPT.1 ;ALREADY CONNECT, SO GIVE ERROR MSG
SETOM RUNMSW## ;SCHEDULE MESSAGE WRITER
SETOM RUNMSR## ;AND READER
$GW(<TO>) ;CONNECT <PORT> (TO)
PUSHJ P,GETSIX ;GET TYPE OF THING TO CONNECT TO
$DISPATCH<DROP,LINE,DEVICE>,<CDROP,CLINE,CDEV> ;DISPATCH ON IT
CDROP: PUSHJ P,GETDEC ;GET DECIMAL DROP NUMBER
SKIPGE NOINPUT ;IF NOT THERE
JRST DVENEX ;TELL WHAT COMES HERE
JUMPL T1,CCPT.2 ;IF NEGATIVE, COMPLAIN
MOVEM T1,I$DROP ;BE AN I$DROPPER
$GW(<ON>) ;CONNECT DROP N "ON"
PUSHJ P,GETSIX ;GET NAME
JUMPE T1,DEVNEX ;TELL WHATS EXPECTED
MOVE T2,T1 ;GET DEVICE NAME INTO PLACE
MOVE T1,I$DROP ;GET DROP NUMBER
PUSHJ P,CONRDX## ;CONNECT RDX DEVICE
JRST CCPT.3 ;CAN'T OBTAIN UDX
CONN1: HRRM T1,2(P1) ;ELSE STORE THE UDX
$CALL (CPORT,<P1>) ;TELL SUPPORT CODE ABOUT CONNECTION
POPJ P, ;AND RETURN
CLINE: PUSHJ P,GETOCT ;GET OCTAL LINE NUMBER
SKIPGE NOINPUT ;ANYTHING TYPED?
JRST OVENEX ;OCTAL VALUE EXPECTED
CAIL T1,0 ;IF NEGATIVE OR
CAILE T1,777 ; GREATER THAN LINE NUMBERS GO
JRST CCPT.4 ; INDICATE WITH ERROR MESSAGE
MOVEM T1,I$DROP ;STORE LINE NUMBER AWAY FOR NOW
$GW(<AT>) ;CONN LINE N "AT"
PUSHJ P,GETSIX ;GET SITE NAME
JUMPE T1,COMNEX ;SITE NAME EXPECTED
MOVEM T1,T2 ;DO A NODE. UUO ON THIS NAME
MOVX T1,<XWD 0,2> ;TO INSURE IT EXISTS AND GET NUMBER
MOVE T3,[XWD 2,T1] ;ARG BLOCK PTR FOR NODE.
NODE. T3, ;
JRST CCPT.5 ;NONE EXISTENT COMM SITE
CLINE1: HRLZS T3 ;PLACE NODE NUMBER FOR GTXTN.
HRR T3,I$DROP ;SET NODE,,LINE UP TO GET
GTXTN. T3, ;SIXBIT TTY NAME
JRST CCPT.6 ;NON-EXISTENT LINE NUMBER
SKIPA T1,T3 ;GET TTY NAME INTO PLACE
CDEV: PUSHJ P,GETSIX ;GET DEVICE NAME
JUMPE T1,DEVNEX ;PROMPT ON ZERO INPUT
PUSHJ P,CONMXN## ;CONNECT TTY UP
JRST CCPT.3 ;CAN'T GET UDX
JRST CONN1 ;ELSE STORE UDX, RETURN
PORNEX: $SAYRET(<[MCSPNE PORT name expected]>)
NODNEX: $SAYRET(<[MCSNNE NODE name expected]>)
TERNEX: $SAYRET(<[MCSTNE TERMINAL name expected]>)
DEVNEX: $SAYRET(<[MCSDNE DEVICE name expected]>)
JSNNEX: $SAYRET(<[MCSJSN Job Slot Number expected]>)
DVENEX: $SAYRET(<[MCSDVE Decimal value expected]>)
OVENEX: $SAYRET(<[MCSOVE Octal value expected]>)
COMNEX: $SAYRET(<[MCSCSE Communication site name expected]>)
CCPT.1: MOVEI P2,[ASCIZ / (PORT Already connected)@/]
JRST CCPT.0
CCPT.2: MOVEI P2,[ASCIZ / (Negative drop number)@/]
JRST CCPT.0
CCPT.3: MOVEI P2,0(T1) ;PASSED STRING ADDR IN T1
JRST CCPT.0
CCPT.4: MOVEI P2,[ASCIZ / (Illegal line number)@/]
JRST CCPT.0
CCPT.5: MOVEI P2,[ASCIZ / (Non-existent Communication Site)@/]
JRST CCPT.0
CCPT.6: MOVEI P2,[ASCIZ / (Non-existent line number)@/]
; JRST CCPT.0
CCPT.0: $SAY (<?MCSCCP Can't connect PORT >)
MOVE T1,I$PORT
PUSHJ P,PUTSIX
MOVEI T1,(P2) ;GET REASON MSG ADDRESS
PJRST OSROPR ;OUTPUT IT AND RETURN
DISCON: PUSHJ P,GETSIX ;GET PORT NAME
JUMPE T1,PORNEX ;PORT NAME REQUIRED
PUSHJ P,LOCENT ;LOCATE ENTRY WITHIN PORT TABLE
PJRST ILLPRT ;NO SUCH ENTRY
HRRZ T1,2(P1) ;GET UDX FOR THIS PORT
PUSHJ P,DISMXN## ;DISCONNECT FROM MPX CHANNEL
$SAYRET(<?MCSDCF DISCONNECT FAILED, COMMAND IGNORED>)
HRRZ T1,2(P1) ;GET UDX AGAIN
$CALL (CUDX,<T1>)
HLLZS 2(P1) ;CLEAR UDX
POPJ P,
OPENX:
PUSHJ P,GETSIX ;GET FILE TYPE-JOURNAL,ETC.
$DISPATCH <JOURNA,MPPLOG>,<OPEJRN,OPELOG>
OPEJRN: PUSHJ P,GETSPC ;GET FILE SPEC
POPJ P, ;IF INVALID SPECIFICATION GIVEN
JUMPE T1,FSPNEX ;FILE SPECIFICATION PROMPT
PUSHJ P,CLOJRN ;CLOSE OUT OLD JOURNAL FILE
MOVEI P1,I$SPEC ;USE CURRENT INPUT SPEC
PUSHJ P,JRNOPN## ;OPEN IT UP
JRST [ MOVSI T1,'JRN'
PJRST ERRFIL] ;TELL ABOUT THE ERROR
SETZM JORSPC## ;ONCE WE SPECIFY SPEC, DEFAULTS ARE GONE
SETZM JORSPC##+1 ;FROM SCHEME OF THINGS
POPJ P, ;RETURN
OPELOG: PUSHJ P,GETSPC ;GET THE FILE SPEC
POPJ P, ;IF SYNTAX ERROR
JUMPE T1,FSPNEX ;FILE SPECFICATION PROMPT
PUSHJ P,CLOLOG ;CLOSE OUT OLD LOG FILE
MOVEI P1,I$SPEC ;USE CURRENT INPUT SPEC
PUSHJ P,LOGOPN## ;OPEN IT UP
JRST [ MOVSI T1,'LOG'
PJRST ERRFIL] ;TELL ABOUT THE ERROR
SETZM LOGSPC## ;CLEAR OUT MCSGEN PRIMARY AND
SETZM LOGSPC##+1 ;SECONDARY POINTERS
POPJ P, ;RETURN
; REFRESH FAILSOFT / ROLLOUT FILE
REFRES: TXNE OPRFLG,CMDSTR ;IS MCS STARTED?
$SAYRET(<?MCSISO CANNOT REFRESH FAILSOFT/ROLLOUT WHILE MCS IS STARTED>)
PUSHJ P,QUERFR## ;YES-REFRESH QUEUE
JRST QUEERR ;ERROR
POPJ P,
QUEERR: MOVSI T1,'QUE' ;REPORT THE ERROR TYPE
PUSHJ P,ERRFIL ;
$SAYRET (<?MCSRFR REFRESH OF FAILSOFT/ROLLOUT FILE ABORTED>)
;CLOSE COMMAND
CLOSEX: PUSHJ P,GETSIX ;GET FILE TO BE CLOSED
$DISPATCH <JOURNA,MPPLOG>,<CLOJRN,CLOLOG>
CLOLOG::CLOSE LOG, ;CLOSE LOG FILE
TXZ OPRFLG,CMDLOG ;NO LOG FILE OPEN NOW
POPJ P, ; GO HOME
CLOJRN::CLOSE JRN, ;CLOSE JOURNAL FILE
TXZ OPRFLG,CMDJOR ;NO JOURNAL FILE OPEN NOW
POPJ P,
MONIX: PUSHJ P,GETSIX ;SEE IF PTY?
$DISPATCH <JSN,SON,SOFF,CPS,CLRJSN,CLRSON,CLRSOF,CLRCPS>
,<MONON,MSON,MSOFF,MCPS,MONOFF,NSON,NSOFF,NCPS>
MONON: PUSHJ P,GETDEC ;GET JSN TO BE MONITORED
JUMPL T1,KILER4 ;IF NEGATIVE OR
CAILE T1,MAXJSN##-1 ;OR OUTSIDE OF RANGE
JRST KILER4 ;GIVE ERROR MSG
JUMPN T1,MONSIN ;MONITOR ALL JSNS?
SKIPGE NOINPUT ;ANY INPUT?
PJRST JSNNEX ;NO, PROMPT
PUSHJ P,GETSIX ;SEE IF MON JSN /ALL
JUMPE T1,MONSIN ;NO-USER WANTED JSN 0
HLRZS T1 ;SWAP HALVES
CAIE T1,'ALL' ;MON JSN /ALL ????
IJNERR: $SAYRET(<?MCSIJN Illegal JSN number>)
MOVX T1,CMDALL ;USE PSEUDO-JSN INDICATING "ALL"
MONSIN: DPB T1,[POINTR(OPRFLG,CMDJSN)] ;STORE JSN TO WATCH
TXO OPRFLG,CMDMON ;TURN MONITORING FLAG ON
POPJ P, ;TELL HIM OKAY
MONOFF: TXZ OPRFLG,CMDMON ;TURN MONITOR FLAG OFF
POPJ P, ;TELL ALL OKAY
MSON: SETOM MONSON## ;SET MONITOR SIGN ON FLAG
POPJ P, ;RETURN
MSOFF: SETOM MONSOF## ;SET MONITOR SIGN OFF FLAG
POPJ P, ;RETURN
NSON: SETZM MONSON## ;CLEAR MONITOR SIGN ON FLAG
POPJ P, ;RETURN
NSOFF: SETZM MONSOF## ;CLEAR MONITOR SIGN OFF FLAG
POPJ P, ;RETURN
MCPS: SETOM MONCPS## ;MONITOR CHANGES IN PORTS
POPJ P, ;
NCPS: SETZM MONCPS## ;DONT MONITOR CHANGES IN PORTS
POPJ P, ;AND RETURN
SENDX::
PUSHJ P,GETSIX ;GET SEND TYPE
$DISPATCH <JSN,TERMIN>,<SENJSN,SENTER>
SENJSN: PUSHJ P,GETDEC ;GET JSN NO.
SKIPGE NOINPUT ;ANY INPUT YET?
PJRST JSNNEX ;NO, SO PROMPT
JUMPL T1,KILER4 ;RANGE CHECK
CAILE T1,MAXJSN##-1 ;MORE
JRST KILER4 ;OUT OF RANGE
SKIPGE JB$UDX(T1) ;DEBUGGING MPP
$SAYRET(<?MCSCSD CANNOT SEND TO A DEBUGGING MPP>)
SKIPN JB$UDX(T1) ;ACTIVE JSN?
$SAYRET(<?MCSISN CANNOT SEND TO JSN ENTERED BECAUSE INACTIVE>)
HRRZI J,0(T1) ;PUT IN NEW JSN
HRRZI P2,^D10 ;SNOOZ COUNT
JRST .+4 ;SKIP AROUND SNOOZ
SWAIT: SOJL P2,SNDPER ;ERROR IF SNOOZ COUNT=0
MOVEI T1,1 ;GET A SECOND
SLEEP T1, ;WAIT FOR INPUT REQUEST
PUSHJ P,STSJSN## ;GET STATUS OF JSN
TXC T1,JB.UJA+JB.ULI ;CAN GIVE INPUT?
TXCE T1,JB.UJA+JB.ULI
JRST SWAIT ;NO-WAIT SOMEMORE
SND001: PUSHJ P,ICHOPR ;GET A CHAR
POPJ P, ;
CAIE T1,"^" ;UP ARROW?
JRST SND002 ;NO-SO JUST OUTPUT IT
PUSHJ P,ICHOPR ;GET NEXT CHAR
POPJ P, ;OKAY-DO NOT SEND ^
ANDI T1,077 ;FORCE TO CONTROL SEQ.
SND002: CAIE T1,12 ;A LINE FEED
JRST SND003 ;NO, PRESS ON
MOVEI T1,15 ;YES, ICHOPR THREW AWAY THE CR
PUSHJ P,CHRMPP## ;SO ADD ONCE HERE
MOVEI T1,12 ;GET THE LINE FEED BACK
SND003: PUSHJ P,CHRMPP## ;SEND A CHAR TO AN MPP
CAIN T1,12 ;DO A LINE FEED
POPJ P, ;YES, ALL DONE
JRST SND001 ;GO FOR MORE
SNDPER: $SAYRET (<?MCSPTY JSN IS NOT AVAILABLE FOR SENDING MESSAGE TO>)
SENTER: PUSHJ P,GETNAM ;YES-GET TERMINAL NAME
JUMPE T1,TERNEX ;PROMPT IF NONE GIVEN
MOVE T2,ASCALL ;SEE IF /ALL
CAMN T2,0(T1)
SETZ T1,
MOVE $V,T1 ;COPY FOR CALL TO OPRTSEND
MOVE T3,[POINT 7,SOPBLK+2] ;POINT TO PRE-FORMATTED CHUNK
MOVSI T4,-<<QU$WP-2>*5> ;CHARACTERS THEREIN
SENT.1: PUSHJ P,ICHOPR ;GET A CHARACTER
JRST SENT.2 ;NO MORE COMING
CAIN T1,.CHLFD ;END OF INPUT LINE
JRST SENT.2 ;YES, TIME TO OUTPUT THE MESSAGE
IDPB T1,T3 ;TUCK CHARACTER AWAY
AOBJN T4,SENT.1 ;AND TRY FOR ANOTHER IF MORE ROOM
SENT.2: HRRM T4,SOPBLK+1 ;STORE CHARACTER COUNT FOR OUTPUT
MOVEI T1,SOPBLK ;FOR BLISS PART OF SEND TERMINAL
$CALL (OPRTSE##,<$V,T1>)
JUMPE $V,CPOPJ## ;ALL OKAY??
CAIN $V,1 ;ALL OK??
PJRST ILLTRM ;1 = ILLEGAL TERMINAL
$SAYRET(<?MCSNDC NO DEVICE CONNECTED>)
$LOW
;PRE-FORMATTED (AND ALLOCATED) CHUNK FOR SEND TERMINAL
SOPBLK: 440777,,0 ;POS,SIZE,EIC,NEXT CHUNK
QU$WP-2,,"?" ;WORDS FOLLOWING,,FILLED IN CHARACTER COUNT
BLOCK QU$WP-2 ;ROOM FOR DATA
$HIGH
SUBTTL FILE CONTROL OPERATOR COMMANDS
FAILSF: PUSHJ P,GONOFF ;GET ON/OFF FLAGS
POPJ P, ;BAD ARGUMENT
JUMPL T1,FAILPR ;IF NO ARGUMENT, PRINT STATUS
MOVEM T1,CHECKPOINT## ;TURN FLAG ON/OFF
POPJ P,
FAILPR: SKIPN CHECKPOINT## ;FAILSOFTING ACTIVE?
$SAYRET(<FAILSOFTING IS OFF>)
$SAYRET (<FAILSOFTING IS ON>)
MPPLOG: PUSHJ P,GONOFF ;FIND OUT WHAT TO DO
POPJ P, ;BAD ARGUMENT
JUMPL T1,MPPPRT ;IF NO ARGUMENT, PRINT STATUS
MOVEM T1,MLOGGI## ;STORE FLAG RETURN
JUMPE T1,CPOPJ## ;IF TURNING IT OFF, RETURN
TXNN OPRFLG,CMDLOG ;IS LOG FILE OPEN
$SAYRET(<%MCSNLF No logging will be done until LOG file is opened>)
POPJ P, ;RETURN
MPPPRT: SKIPN MLOGGI## ;ON OR OFF?
$SAYRET(<MPPLOGGING IS OFF>)
TXNE OPRFLG,CMDLOG ;CHECK STATUS OF FILE
$SAYRET(<MPP logging is on>)
$SAYRET(<MPP logging is on, but LOG file is not open>)
JOURNL: PUSHJ P,GONOFF ;FIND OUT IF ON,OFF OR PRINT?
POPJ P, ;BAD ARGUMENT
JUMPL T1,JRNPRT ;IF NO ARGUMENT, PRINT STATUS
MOVE P1,T1 ;COPY INTO SAFER PLACE
PUSHJ P,GETSIX ;GET OPTIONAL ARGUMENT
SETZ P2, ;ASSUME WE WANT ONLY ONE
JUMPE T1,JOURNB ;BOTH WANTED IF NONE
$DISPATCH<INPUT,OUTPUT,BOTH>,<JOURNI,JOURNO,JOURNB>
JOURNB: SETO P2, ;FLAG WE WANT BOTH
JOURNI: MOVEM P1,ILOGGI## ;STORE AS INPUT
JUMPE P2,JEXIT ;COMMON EXIT
JOURNO: MOVEM P1,OLOGGI## ;STORE AS OUTPUT
JEXIT: JUMPE P1,CPOPJ## ;IF TURNING OFF,LEAVE NOW
TXNN OPRFLG,CMDJOR ;IS THERE A FILE TO RECV. THE OUTPUT?
$SAYRET(<%MCSNJF No journalling will be done until JOURNAL file is opened>)
POPJ P,
JRNPRT: MOVE T1,ILOGGI## ;GET ONE SIDE
IOR T1,OLOGGI## ;OR WITH THE OTHER
SKIPN T1 ;IF EITHER IS ON..
$SAYRET(<ALL JOURNALLING IS OFF>)
SKIPE ILOGGI## ;CHECK INPUT LOGGING
$SAY(<INPUT JOURNALLING ON >)
SKIPE OLOGGI## ;CHECK OUTPUT LOGGING
$SAY(<OUTPUT JOURNALLING ON >)
TXNN OPRFLG,CMDJOR ;CHECK FILE STATUS
$SAY(<(But no journal file open)>)
PJRST PUTEOL
ROLL: PUSHJ P,GONOFF ;FIND OUT WHAT TO DO
POPJ P, ;BAD ARGUMENT
JUMPL T1,ROLPRT ;IF NO ARGUMENT, PRINT STATUS
MOVEM T1,ROLLIN## ;STORE STATUS
JUMPE T1,CPOPJ## ;IF TURNED OFF, LEAVE NOW
SETOM RUNROL## ;WORRY ABOUT QUOTAS NOW
POPJ P, ;TELL HIM OKAY
ROLPRT: SKIPN ROLLIN## ;ROLLING ACTIVE?
$SAYRET(<ROLLING IS OFF>)
$SAYRET (<ROLLING IS ON>)
; ROUTINE TO PROCESS OPERATOR AUTO COMMANDS
AUTO: PUSHJ P,GETSPC ;GET THE FILE SPEC
POPJ P, ;IF SYNTAX ERROR
JUMPE T1,FSPNEX ;IF NO SPEC GIVEN
PUSHJ P,GETEOL ;GO TO THE END OF LINE
MOVEI P1,I$SPEC ;ADDRESS OF SPEC BLOCK
SKIPE ATOOPR## ;ALREADY IN PROCESS
$SAYRET(<?MCSAIP Auto file already in progress>)
PUSHJ P,ATOOPN## ;OPEN THE ATO FILE
JRST [ MOVSI T1,'ATO';REPORT THE FILE ERROR TYPE
JRST ERRFIL ] ;VIA STANDARD MECHANISM
POPJ P, ;ELSE JUST GO HOME
; ROUTINE TO PROCESS OPERATOR GREET COMMANDS
GREET: PUSHJ P,GETSIX ;GET THE COMMUNICATION NODE NAME
JUMPE T1,COMNEX ;SAY NAME WAS EXPECTED
MOVE P1,T1 ;SAVE IN SAFE PLACE
$GW(<WITH>) ;GUIDE WORD WITH
PUSHJ P,GETSPC ;GET FILE SPECIFICATION
POPJ P, ;PROPOGATE ERROR RETURN
JUMPE T1,FSPNEX ;IF NULL, PROMPT
PUSHJ P,FGNODE ;SEE IF ALREADY EXISTS
JRST [MOVEI T2,^D8 ;DOESN'T , SO CREATE BLOCK
PUSHJ P,GETWDS## ;FOR NODE AND FILE STOREAGE
$SAYRET(<?MCSICA Insufficient core available>)
MOVE T2,CNDLST## ;GET OLD HEAD OF LIST
MOVEM T2,0(T1) ;STORE THE LINK
MOVEM T1,CNDLST## ;STORE NEW HEAD OF LIST(THIS NODE)
JRST GREET1]
PUSH P,T1 ;SAVE ADDR OF BLOCK ACROSS $SAY
$SAY(<%MCSOEG Overwriting existing greeting@>)
POP P,T1 ;RESTORE ADDRESS
GREET1: MOVEM P1,2(T1) ;STORE NODE NAME AWAY
SETZM 3(T1) ;MARK AS OFF-LINE
MOVSI P1,I$SPEC ;BLT FROM
HRRI P1,4(T1) ; TO
BLT P1,^D7(T1) ; UNTIL
SETOM RUNCNS## ;SCHEDULE THE OTHER HALF TO RUN
POPJ P, ;THEN RETURN
; ROUTINE FGNODE
; CALL IS: MOVE P1,[SIXBIT /NODE/]
; PUSHJ P,FGNODE
; HERE IF NODE NAME NOT IN LIST
; HERE IF IN LIST WITH T1 POINTING TO 8 WORD GREET BLOCK
FGNODE: SKIPA T1,CNDLST## ;GET HEAD OF LIST TO PRIME THE PUMP
FGNOD1: MOVE T1,0(T1) ;UPDATE LINK
JUMPE T1,CPOPJ## ;TAKE BAD RETURN IF NOT IN LIST
CAMN P1,2(T1) ;CHECK FOR MATCH
JRST CPOPJ1## ;WE HAVE A MATCH
JRST FGNOD1 ;TRY NEXT OR EXIT
PAUSE: PUSHJ P,GETSIX ;FIND OUT WHAT TO PAUSE
JUMPE T1,PAUPRT ;NOTHING-PRINT STATUS
TXNN OPRFLG,CMDSTR ;HAVE WE STARTED?
MNSERR: $SAYRET(<?MCSMNS MCS is not started yet>)
$DISPATCH <MCS,NET,ALL>,<PAUMCS,PAUNET,PAUALL>
PAUALL: TXO OPRFLG,CMDNET ;PAUSE BOTH
PAUMCS: TXOA OPRFLG,CMDMCS ;PAUSE MCS
PAUNET: TXO OPRFLG,CMDNET ;PAUSE NET
POPJ P,
PAUPRT: TXNE OPRFLG,CMDMCS ;PAUSED MCS?
$SAY (<MCS IS PAUSED@>)
TXNE OPRFLG,CMDNET ;NETWORK PAUSED?
$SAYRET(<NETWORK IS PAUSED>)
TXNN OPRFLG,CMDMCS!CMDNET ;BOTH PAUSED?
$SAY (<MCS is active@>)
POPJ P, ;AND RETURN
CONTIN: PUSHJ P,GETSIX ;FIND OUT WHAT TO CONTINUE
TXNN OPRFLG,CMDSTR ;IS MCS STARTED?
JRST MNSERR
JUMPE T1,CONTAL ;IF NO OPERAND,THEN ASSUME ALL
$DISPATCH <MCS,NET,ALL>,<CONMCS,CONNET,CONTAL>
CONTAL: TXZ OPRFLG,CMDNET ;CLEAR BOTH PAUSE FLAGS
CONMCS: TXZA OPRFLG,CMDMCS ;CLEAR PAUSE MCS FLAG
CONNET: TXZ OPRFLG,CMDNET ;CLEAR NET FLAG
SETOM RUNMSR## ;SCHEDULE MSREAD
SETOM RUNROL## ;AND ROLLER
POPJ P, ;RETURN
RESTAR: TXO OPRFLG,CMDRES ;INDICATE RESTART IN EFFECT
STARTX: TXNE OPRFLG,CMDSTR ;START ALREADY ISSUED?
$SAYRET(<?MCSSAG START/RESTART COMMAND PREVIOUSLY ENTERED>)
TXZ OPRFLG,CMDMCS!CMDNET!CMDNOI ;TURN MCS MPPS ON-
SETOM RUNMSR## ; AND POKE THE READ PROCESS
XSCAN: PUSHJ P,GETSIX ;GET OPERAND
JUMPE T1,XXSTAR ;NONE-SO INITIAL WANTED
$DISPATCH <NOINIT,NONET>,<SNOINI,SNONET>
SNOINI: TXOA OPRFLG,CMDNOI ;NO INITIAL START
SNONET: TXO OPRFLG,CMDNET ;NO NET START
JRST XSCAN
XXSTAR: TXNE OPRFLG,CMDNOI ;INITIAL MPPS WANTED?
JRST XXINIT ;NO-IGNORE ALL GOOD STUFF
SETZ P3, ;NODE PTR
MOVE P1,NMPPS## ;GET NO.OF MPPS
SUBI P1,1 ;DECR COUNT
INEX: HRRZ P2,MPPTAB##(P1) ;GET ADDR OF MPP PROTOTYPE
JUMPE P2,XXINIT ;ALL DONE? MAYBE
HLRZ P4,MP$RUN##(P2) ;GET INITIAL STARTING VALUE
JUMPE P4,INEX2 ;ANY TO BE STARTED?
PUSH P,MP$COP##(P2) ;SAVE MIN/MAX COUNTS
HRRZS MP$COP##(P2) ;SET MIN = 0
$CALL (MPPRUN,<P1,P3,P4>) ;START MPPS INITIALLY
POP P,MP$COP##(P2) ;RESTORE MIN
INEX2: SOJGE P1,INEX
XXINIT: TXNE OPRFLG,CMDRES ;RESTART MCS????
JRST XXIN.1 ;YES-
PUSHJ P,QUERFR## ;REFRESH THE QUEUE FILE
JRST QUEERR ;QUE FILE ERROR
JRST ONCFIN ;FINISH UP
XXIN.1: $CALL (MCSONC)
ONCFIN: TXO OPRFLG,CMDSTR ;SET START FLAG ON
$SAYRET (<MCS-10 STARTED>)
KMCS:
PUSHJ P,GETSIX ;SEE IF REFRESH WANTED?
JUMPE T1,KMCS.2 ;NO TOKEN, SO NOTHING WANTED
$DISPATCH <NOREFR>,<KMCS.1> ;IF NOREFRESH OR SON OF THAT
KMCS.1: TXO OPRFLG,KNORFR ;NO-SET FLAG TO REMEMBER
KMCS.2: MOVE T1,JSNCO0## ;SEE IF ANY ACTIVE MPPS
SKIPN JB$UDX##(T1) ;ACTIVE MPP SLOT
AOBJN T1,.-1 ;STILL NONE FOUND
JUMPGE T1,KCLOSE ;JUMP IF NO ACTIVE JOBS
TXO OPRFLG,CMDKIL ;SET KILL FLAG
$SAY (<%MCSMSR MPPs still running.@Confirm>)
PJRST OBKOPR ;MAKE SURE OPR SEES IT.
NOKILL: TXZ OPRFLG,KNORFR ;IF NO, CLEAR "NOREFRESH" WANTED
TXZE OPRFLG,CMDKIL ;DO NOT KILL-RESET FLAG
POPJ P, ;RETURN AFTER CLEARING FLAG
FUNKCMD:
POP P,0(P) ;POP OFF RETURN TO CMDXEQ
SETO T1, ;MAKE IT UNKNOWN,NOT AMBIGUOUS
JRST BADCMD ;BAD COMMAND
YESKIL: TXNN OPRFLG,CMDKIL ;KILL MCS ENTERED?
PJRST FUNKCMD ;FAKE UNKNOWN COMMAND
KCLOSE::
TXO OPRFLG,CMDMCS ;DON'T START ANY MPPS
TXZ OPRFLG,CMDMON ;NO MONITORING OF JSN,S
SETZM MLOGGI## ;NO MPP LOGGING
CLOSE MX0, ;CLOSE JUST IN CASE
CLOSE MX1,
CLOSE MX2,
CLOSE MX3,
MOVE J,JSNCO0## ;FIND ALL MPPS STILL ACTIVE
KILSEQ: SKIPLE JB$UDX##(J) ;AND KILL THEM DEAD
PUSHJ P,KILMPP## ;KILL THIS ACTVIE MPP
JFCL ;IGNORE ERROR RETURN
AOBJN J,KILSEQ ;CYCLE THROUGH ENTIRE LIST
CLOSE JRN,
CLOSE LOG,
CLOSE MPP,
PUSHJ P,PTLWRT## ;WRITE LAST PARTICLE OUT
PUSHJ P,PATWRT## ;WRITE LAST PAT OUT
TXNN OPRFLG,KNORFR ;REQUEST "NOREFRESH" OPTION
PUSHJ P,QUERFR## ;NO, GO REFRESH QUEUE
JFCL ;IGNORE ERROR
HRLZI T1,400000 ;TELL MONITOR NOTHING IN
IORM T1,QUEOUT## ;IN QUEUE FILE BUFFERS
CLOSE QUE,
CLOSE OPR,
CALLI 12 ;EXIT TO MONITOR
KILL:
PUSHJ P,GETSIX ;GET TYPE OF KILL
$DISPATCH <MPP,JSN,ALL>,<KILM,KILSLT,KILTHM>
KILM: PUSHJ P,GMPPSP ;GET FILE SPEC
POPJ P, ;SOME SORT OF ERROR
JUMPE T1,MPPNEX ;MPP NAME EXPECTED
PUSHJ P,FNDMPP## ;FIND MPP ASSOC. WITH THIS FILE
PJRST ILLMPP ;ILLEGAL MPP IF NOT FOUND
HRRZ P1,MPPTAB##(T1) ;SAVE ADDR OF MPP PROTOTYPE
PUSHJ P,GETDEC ;GET JSN
JUMPL T1,KILER4 ;JSN NEGATIVE , THEN ERROR
CAILE T1,MAXJSN##-1 ;JSN TOO LARGE
JRST KILER4 ;YES, THEN ERROR
JUMPE T1,KILALL ;NO JSN,SO KILL ALL IMMED
HRRZI J,0(T1) ;STORE NEW JSN
CAME P1,JB$MPP##(J) ;THIS CORRECT MPP?
JRST KILER3 ;NO-ERROR
PUSHJ P,KILMPP## ;KILL THIS MPP RIGHT NOW
JFCL ;IGNORE ERROR
POPJ P, ;ALL DONE, SO RETURN
KILALL: MOVE J,JSNCO0## ;FIND ALL ALIKE MPPS
MOVX P2,JBIDL$ ;SET UP FLAGS NEEDED
MOVX P3,JBKIL$
KILIT: CAME P1,JB$MPP(J) ;THIS IS A MPP TO KILL?
JRST KILCNT ;NO-SO COUNT DOWN
TDNN P2,JB$MLF##(J) ;THIS MPP IN EPI STATE?
JRST KILSET ;NO-SO REMEMBER IT
PUSHJ P,KILMPP ;YES-KILL IT NOW
JFCL ;IGNORE ERROR
KILCNT: AOBJN J,KILIT ;MORE-YES:CONTINUE
POPJ P, ;TELL HIM OK
KILSET: IORM P3,JB$MLF##(J) ;SET DELAYED KILL FLAG
JRST KILCNT
KILSLT: PUSHJ P,GETDEC ;YES-GET JSN TO KILL
SKIPGE NOINPUT ;IF NO INPUT GIVEN
PJRST JSNNEX ;PROMPT
JUMPL T1,KILER4
JUMPN T1,KILSL1 ;NON ZERO JSN NUMBER?
PUSHJ P,GETSIX ;NO, COULD BE /ALL THEN
HLRZS T1 ;JUSTIFY ANY INPUT CORRECTLY
JUMPN T1,KILTHM ;IF WE GOT A TOKEN,IT BETTER BE 'ALL'
KILSL1: CAILE T1,MAXJSN##-1
JRST KILER4
SKIPG JB$UDX(T1) ;IS THERE A JOB IN THIS SLOT
JRST KILER5 ;NO, GIVE AN ERROR
HRRZI J,0(T1) ;PUT NEW J IN PLACE
PUSHJ P,KILMPP## ;NO-KILL THIS SLOT
JFCL ;IGNORE ERROR RETURN
POPJ P, ;TELL HIM OKAY
KILTHM: MOVE J,JSNCO0## ;-KILL ALL MPPS
KILLIN: SKIPE JB$UDX##(J) ;SLOT OCCUPID?
PUSHJ P,KILMPP ;YES-KILL IT THEN
JFCL ;IGNORE ERROR RETURN
AOBJN J,KILLIN ;MORE TO DO? YES-
POPJ P, ;NO-THEN END TELL HIM OK
KILER3: HRRZ T1,J ;ISOLATE JSN
$CALL (INFORM,<KILLMX,T1,0,0,0>)
POPJ P, ;RETURN
KILLMX: [ASCII "
?MCSILJ ILLEGAL MPP FOR JSN: %0D%@"]
KILER4: $SAYRET (<?MCSJOR JSN IS OUT OF RANGE>)
KILER5: $SAYRET (<?MCSNKJ NO KILLABLE JOB IN THAT SLOT>)
RUNX:
PUSHJ P,GMPPSP ;YES-GET FILE SPEC
POPJ P, ;SOME SORT OF ERROR WITH SPEC
JUMPE T1,MPPNEX ;MPP NAME EXPECTED
PUSHJ P,FNDMPP## ;FIND MPP PROTOTYPE OF THIS ONE
JRST RUNX2 ;NONE-BUILD ONE
JRST RUNX1 ;GO RUN IT
RUNX2: PUSHJ P,BLDMPP## ;NONE-SO BUILD ONE
PJRST SETME3 ;GIVE AN ERROR
RUNX1: MOVE P2,T1 ;SAVE MPPINDEX
HRRZ P1,MPPTAB##(P2) ;GET MPP BLOCK
PUSHJ P,ACTJOB## ;COUNT NUMBER ALREADY RUNNING
AOS P4 ;WANT TO RUN 1 MORE OF THEM
TXO OPRFLG,CMDRUN ;RUN COMMAND IN PROGRESS
$CALL (MPPRUN,<P2,ZERO,P4>) ;START MPP UP
TXZ OPRFLG,CMDRUN ;CLEAR RUN COMMAND IN PROGRESS
CAIN $V,1 ;MPP STARTED?
POPJ P, ;YES-
RUN001: $SAYRET (<?MCSMNS MPP NOT STARTED>)
SWTCH:
PUSHJ P,GETSIX ;GET TYPE OF SWITCH
$DISPATCH <JOURNA,MPPLOG,MPP,TERMIN>,<SWJRN,SWLOG,SWMPP,SWTER>
SWJRN: PUSHJ P,GETSIX ;SEE IF FILESPEC THERE?
CAME T1,SWTTO ;IS SWITCH JOURNAL TO?
JRST SWTNXT ;NO-THEN MUST BE TO ALTERNATE
PUSHJ P,GETSPC ;YES-GET FILE SPEC
POPJ P, ;IF ILLEGAL SYNTAX,RETURN
JUMPE T1,FSPNEX ;FILE SPEC EXPECTED
PUSHJ P,CLOJRN ;CLOSE OUT OLD JOURNAL
MOVEI P1,I$SPEC ;POINT TO INPUT SPEC FROM OPR
PUSHJ P,JRNOPN ;OPEN NEW JOURNAL FILE
PJRST [ MOVSI T1,'JRN'
JRST ERRFIL ] ;TELL WHY OPEN FAILED
SETZM JORSPC## ;CLEAR MCSGEN'ED DEFAULT SPECS
SETZM JORSPC##+1 ;BECAUSE OPR HAS OVERIDDEN THEM
POPJ P, ;RETURN
SWTNXT: MOVEI P1,JORSPC## ;PICK UP ADDR OF SECONDARY SPEC
SUB P1,JORCUR## ;CONVERT TO PRIMARY OR SECONDARY
SETCMM JORCUR## ;AND CHANGE SENSE
HRRZ P1,0(P1) ;GET ADDR OF FILE SPEC
JUMPE P1,SWTER3 ;NONE-ERROR
SKIPN 0(P1) ;ANY FILE SPEC?
JRST SWTER3 ;NOPE-
PUSHJ P,JRNOPN## ;OPEN THE JOURNAL FILE
PJRST [ MOVSI T1,'JRN' ;FAILED SOMEHOW
JRST ERRFIL ] ;
POPJ P, ;OKAY!!!
SWTER3: $SAYRET (<?MCSNFN NO ALTERNATE FILE NAME EXISTS>)
SWTTO: SIXBIT "TO"
SWLOG: PUSHJ P,GETSIX ;FILESPEC THERE?
CAME T1,SWTTO ;PROPER FORMAT?
JRST SWTNX1 ;NOPE-
PUSHJ P,GETSPC ;YES - GET IT
POPJ P, ;NO-ILLEGAL FILE SYNTAX
JUMPE T1,FSPNEX ;IF NONE THERE,PROMPT
PUSHJ P,CLOLOG ;CLOSE OUT OLD LOG FILE
MOVEI P1,I$SPEC ;USE OPERATOR'S SPECIFICATION
PUSHJ P,LOGOPN## ;OPEN IT UP
JRST [ MOVSI T1,'LOG' ;FAILED
JRST ERRFIL ]
SETZM LOGSPC## ;CLEAR OUT OLD SPECS
SETZM LOGSPC##+1 ;SINCE OPR HAS CHANGED IT
POPJ P, ;RETURN
SWTNX1: MOVEI P1,LOGSPC## ;PICK UP PTR TO FILE SPEC
SUB P1,LOGCUR## ;GET TO PRIMARY OR SECONDARY PTR
SETCMM LOGCUR## ;AND THEN CHANGE IT
HRRZ P1,0(P1) ;GET ADDR OF FILE SPEC
JUMPE P1,SWTER3 ;NO FILE SPEC
SKIPN 0(P1) ;ANY FILE SPEC THERE?
JRST SWTER3 ;NO-
PUSHJ P,LOGOPN## ;YES-OPEN IT UP
JRST [ MOVSI T1,'LOG'
JRST ERRFIL ] ;
POPJ P, ;OKAY
SWMPP: PUSHJ P,GMPPSP ;GET FILE SPEC
POPJ P, ;NO- CAN'T CONTINUE
JUMPE T1,MPPNEX ;MPP NAME EXPECTED
PUSHJ P,FNDMPP## ;FIND MPP PROTOTYPE
PJRST ILLMPP ;ILLEGAL MPP IF NOT THERE
HRRZ P1,MPPTAB##(T1)
HRRZ T3,MP$ALT##(P1) ;GET ALTERNATE FOR THIS MPP
JUMPE T3,[$SAYRET(<?MCSMNA MPP has no more alternates>)]
HRRM T3,MPPTAB##(T1) ;STORE IN MPPTABLE
SETOM RUNROL## ;SWITCH MPP CAN START MPP/CHANGE QUOTA
POPJ P, ;RETURN
SWTER: SETOM RUNMSW## ;SCHEDULE WRITER
PUSHJ P,GETNAM ;GET TERMINAL NAME
JUMPE T1,TERNEX ;IF BLANK, TELL WHAT COMES HERE
HRRZI P1,0(T1) ;SAVE PTR TO NAME
$GW(<TO>) ;GW "TO" EXPECTED HERE
PUSHJ P,GETSIX ;YES-THEN GET OTHER PART
$DISPATCH <INITIA,ALTERN>,<SWINI,SWALT>
SWALT: TDZA T2,T2 ;T2 GETS 0 FOR ALT
SWINI: MOVEI T2,1 ;AND 1 FOR INITIAL
$CALL (CHGALT##,<P1,T2>) ;SWITCH
JUMPN $V,CPOPJ ;ALL OKAY? MAYBE-
$SAYRET (<?MCSTER NO FURTHER ALTERNATES>)
WHAT: PUSHJ P,GETSIX ;GET TOKEN
$DISPATCH <PORT,J,JOB,JSN,MPP,TERMIN,NODE,Q,RESOUR,QFILE,CORE,IPCF,AVAILA,TOTALS,DMPP,GREETI>
,<WHPORT,WHJOB,WHJOB,WHJOB,WHMPP,WHTER,WHNOD,WHOQ,WHRES,WHQFI,WHCOR,WHIPC,AVAIL,WHTOT,WHDMPP,WHGRE>
; WHAT Q COMMAND
WHOQ: $CALL (DCOUNT,)
POPJ P, ;DISPLAY QUEUES
; WHAT NODE [NODENAME NODENAME ETC..] OR [/ALL]
WHNOD: PUSHJ P,GETNOD ;GET NODE NAME
JUMPE T1,WHNLP1 ;IF NONE, ASSUME /ALL
CAIA ;SKIP OF REPEAT STUFF
WHNLP: PUSHJ P,GETNOD ;GET ANOTHER NODE NAME
JUMPE T1,CPOPJ## ;OK-SO EXIT
SKIPA T2,.+1 ;CHECK NODE NAME FOR /ALL
ASCALL: ASCII '/ALL'
CAMN T2,I$NODE
SETZ T1, ;YES-THEN ZERO ARG BLOCK
$CALL (WNODE,<T1>)
SKIPN $V ;ALL REPORTED OK FROM WNODE?
PUSHJ P,ILLNOD ;NO, GIVE ERROR MSG
JRST WHNLP ;GO FOR MORE
WHNLP1: $CALL (WNODE,<ZERO>)
POPJ P,
; WHAT PORT [PORTNAME PORTNAME ETC..] OR <CR-LF> FOR ALL
WHPORT: PUSHJ P,GETSIX ;GET PORT NAME
JUMPE T1,WHPLP1 ;NONE, GIVE ALL
CAIA
WHPLP: PUSHJ P,GETSIX ;GET ANOTHER PORT NAME
JUMPE T1,CPOPJ## ;ALL DONE ,SO EXIT
SKIPA T2,.+1
SIXALL: SIXBIT '/ALL' ;SEE IF /ALL PASSED
CAMN T2,T1
WHPLP1: SETZ T1, ;YES-CLEAR ARG BLOCK
$CALL (WPORT,<T1>)
SKIPN $V ;IS ALL OK?
PUSHJ P,ILLPRT ;NO, SO SAY SO
JRST WHPLP ;TRY NEXT PORT NAME
; WHAT TERMINAL [TERMINAL TERMINAL ETC..] OR [/ALL] OR [<CRLF>]
WHTER: PUSHJ P,GETNAM ;GET TERMINAL NAME
JUMPE T1,WHTER1 ;NO NAMES, MUST BE <CRLF>
CAIA
WHTLP: PUSHJ P,GETNAM ;GET ADDITIONAL TERMINAL NAMES
JUMPE T1,CPOPJ## ;NONE-SO ALL DONE
MOVE T2,ASCALL ;GET /ALL IN ASCII
CAMN T2,I$TERM
SETZ T1, ;YES-SET ARG BLOCK TO ZERO
$CALL (WTERM,<T1>)
SKIPN $V ;WAS IT OK?
PUSHJ P,ILLTRM ;NO
JRST WHTLP ;TRY FOR MORE
WHTER1: ;HERE FOR "WHAT TERM <CRLF>
$CALL(WNET,<T1>) ;GIVES SHORT LISTING
POPJ P, ;RETURN WITH "OK"
; WHAT TOTAL , WHICH GIVES THE TOTAL TRANSACTIONS IN AND OUT
WHTOT:
$SAY (<Received: >)
MOVE T1,LHTSN## ;GET TOTAL
PUSHJ P,PUTDEC ;OUTPUT IT
$SAY (< Sent: >) ;NEXT LABEL
MOVE T1,RHTSN## ;GET NUMBER SENT
PUSHJ P,PUTDEC ;GIVE THE NUMBER
PJRST PUTEOL ;END WITH <CR-LF>
WHDMPP: TXNN OPRFLG,CMDDEB ;CHECK DEBUG MPP ALLOWED BIT
$SAY(<No >)
$SAYRET(<Debugging MPPs are allowed>)
; WHAT RESOURCES, WHICH GIVES A COMBINATION OF WHAT CORE, WHAT IPCF AND WHAT QFILE
WHRES:
PUSHJ P,WHCOR ;OUTPUT THE "WHAT CORE"
PUSHJ P,WHQFI ;OUTPUT THE "WHAT QFILE"
PUSHJ P,WHIPC ;OUTPUT THE "WHAT IPCF"
PJRST AVAIL ;AND END WITH "AVAILABLE JOB SLOTS"
; WHAT CORE, GIVES SUMMARY OF CORE UTILIZATION
WHCOR: $SAY (<Free core: >) ;START MESSAGE
MOVE P1,C$USED## ;GET USED
MOVE P2,C$SIZE## ;GET MAXIMUM
MOVEI P3,[ASCIZ " CHUNKS "] ;AND STRING
PUSHJ P,OUTPCT ;OUTPUT THE PERCENTAGE
SKIPE C$FULL## ;IS THE FULL FLAG ON?
$SAY (< (Above safe limit)>)
PJRST PUTEOL ;IN ANY CASE, END THE LINE
; WHAT IPCF, GIVES SUMMARY OF IPCF PAGE POOL UTILIZATION
WHIPC: $SAY (<IPCF Pages: >) ;GET LABEL
MOVE P1,I$USED## ;NUMBER OF PAGES IN USE
MOVE P2,I$SIZE## ;SIZE OF POOL
MOVEI P3,[ASCIZ "@"]
PJRST OUTPCT ;OUTPUT PERCENTAGE
; WHAT QFILE, GIVES SUMMARY OF QFILE UTILIZATION
WHQFI: $SAY (<QUEUE File: >)
MOVE P1,Q$USED## ;GET NUMBER OF PARTICALS IN USE
MOVE P2,QP$MAX## ;AND MAXIMUM NUMBER
MOVEI P3,[ASCIZ " PARTICLES "];LABEL THEM
PUSHJ P,OUTPCT ;OUTPUT THE MESSAGE
SKIPE Q$FULL## ;IS QUEUE FILE FLAG UP?
$SAY (< (Above safe limit)>)
PJRST PUTEOL ;TO END THE LINE,RETURN
;OLD AVAILABLE COMMAND..
AVAIL: $SAY (<Job Slots: >)
MOVE P2,JSNCO0## ;TO SCAN THE UDX TABLE
SETZ P1, ;TO COUNT TAKEN SLOTS
SKIPE JB$UDX##(P2) ;SLOT IN USE
AOS P1 ;YES, COUNT TAKEN
AOBJN P2,.-2 ;COVER ALL AVAILABLE SLOTS
MOVEI P2,MAXJSN## ;MAXIMUM ALLOWED
MOVEI P3,[ASCIZ "@"]
PJRST OUTPCT ;OUTPUT PERCENTAGE
;SUBROUTINE CALLED BY RESOURCE TYPERS TO OUTPUT PERCENTAGES
;CALLED WITH:
; P1 = AMT USED
; P2 = AMT AVAILABLE
; P3 = "THINGS" (PAGES, PARTICLES, OR CHUNKS)
OUTPCT:
MOVE T1,P1 ;COPY AMT USED
PUSHJ P,PUTDEC ;OUTPUT FIRST NUMBER
MOVEI T1,"/" ;OUTPUT SEPARATING SLASH
PUSHJ P,OCHOPR ;OUTPUT IT
MOVE T1,P2 ;GET SECOND NUMBER
PUSHJ P,PUTDEC ;OUTPUT IT TOO.
$SAY (< = >) ;ALIGN THE OUTPUT
MOVE T1,P1 ;GET FIRST NUMBER AGAIN
IMULI T1,^D1000 ;GET SOME SIGNIFIGANCE ROOM
IDIV T1,P2 ;DIVIDE BY SECOND ARGUMENT
ADDI T1,5 ;ROUND IT OFF
IDIVI T1,^D10 ;MAKE IT 2 PLACE PERCENTAGE
PUSHJ P,PUTDEC ;OUTPUT IT
MOVEI T1,"%" ;GET PERCENT SIGN
PUSHJ P,OCHOPR ;GIVE IT TO OPERATOR
MOVE T1,P3 ;GET THE STRING TO LABEL IT
PJRST OSROPR ;OUTPUT IT,RETURN
; WHAT JSN [JSN NUMBER] OR [/ALL]
WHJOB: PUSHJ P,RECOVR## ;CLEAN UP BEFORE LISTING
PUSHJ P,GETDEC ;GET /ALL OR ZERO
SKIPGE NOINPUT ;ANYTHING ON THE LINE?
JRST WHJOB1 ;NO, ASSUME /ALL
JUMPN T1,WHJOK ;GOT A NUMBER
PUSHJ P,GETSIX ;MAYBE ZERO,BUT NOT SURE
JUMPE T1,WHJOK ;WE HAD A ZERO
HLRZS T1 ;WE HAD A /ALL
CAIE T1,'ALL' ;CHECK FOR ALL(SINCE / GOT LOST)
PJRST IJNERR ;NO , SO ILLEGAL JSN NUMBER
WHJOB1: SETZ T1, ;IT IS ALL,SO START AT JSN 0
HRRZI P2,MAXJSN##-1 ;GO ALL THE WAY TO END
CAIA ;SKIP OVER NUMBER STUFF
WHJOK: HRRZI P2,0(T1) ;ONLY WANT 1 JSN
HRRZI P1,0(T1) ;SET INITIAL VALUE
WHJLOP: CAILE P1,MAXJSN##-1 ;SEE IF WITHIN RANGE
JRST KILER4 ;NOPE-ERROR
$SAY (<JSN:>)
HRRZI T1,0(P1)
PUSHJ P,PUTDEC
SKIPE JB$UDX##(P1) ;ACTIVE???
JRST WHJACT ;YES-
$SAY (< INACTIVE@>)
JRST WHCNT ;GO THROUGH FOR MORE
WHJACT: SKIPG JB$UDX##(P1) ;DEBUGGING?
JRST WHDEB ;YES, SAY SO
$SAY (< JOB:>)
HLRZ T1,JB$UDX##(P1) ;GET JOB NUMBER
PUSHJ P,PUTDEC ;PUT OUT IN DECIMAL
$SAY (< FLAGS=>)
MOVE J,P1 ;SET JOB NUMBER
PUSHJ P,STSJSN ;GET IT'S STATUS BITS
TXNN T1,JB.UML ;AT MONITOR LEVEL?
JRST WHJAC1 ;TRY SOMETHING ELSE
$SAY (<^C+>) ; TYPE ^C+
JRST WHJAC2 ;DON'T BOTHER WITH CHECK FOR TI
WHJAC1: TXNE T1,JB.UDI ;JOB IN TI WAIT?
$SAY (<TI+>) ; TYPE TI+
WHJAC2: MOVE T4,JB$MLF##(P1) ;GET MCP STATUS
TXNE T4,JBIDL$ ;IN EPI STATE??
$SAY (<IDLE+>)
TXNE T4,JBIMM$ ;IMMORTAL MPP??
$SAY (<PERM+>)
TXNE T4,JBKIL$ ;KILL WHEN EPI SEEN?
$SAY (<OPRKIL+>)
TXNN T4,JBOPR$ ;STARTED BY OPR?
JRST AROPR ;NO-
$SAY (<(OPR ST)>)
JRST WHCNTX
AROPR: $SAY (<(MCS ST)>)
WHCNTX: $SAY (< MPP:>)
HRRZI T1,0(P1) ;PUT JSN IN T1
PUSHJ P,OMPPSP ;OUTPUT FILE SPEC
WHCLP: PUSHJ P,PUTEOL ;FORCE END OF LINE
WHCNT: ADDI P1,1 ;TRY NEXT JSN
CAIG P1,0(P2) ;STILL LEGAL?
JRST WHJLOP ;YES-
POPJ P, ;ELSE RETURN
WHDEB: $SAY (< DEBUG>)
JRST WHCLP ;GO DO MORE
; WHAT GREETINGS - GIVES A LIST OF ALL GREETINGS SET UP FOR COMM. NODES
WHGRE: SKIPN P1,CNDLST## ;LOAD HEAD OF LIST
$SAYRET(<No greetings have been set up>)
$SAY(<Name will be greeted with@@>)
WHGRE1: MOVE T1,2(P1) ;GET COMMUNICATION NETWORK NODE NAME
PUSHJ P,PUTSIX ;OUTPUT IT
SKIPN 3(P1) ;DO WE THINK THE NODE IS UP
$SAY(< >) ;NO , OUTPUT <TAB>,<SP>
SKIPE 3(P1) ;DO WE THINK THE NODE IS UP
$SAY(< *>) ;YES, OUTPUT <TAB>,<STAR>
MOVEI T1,4(P1) ;GET ADDR OF FILE SPEC
PUSHJ P,PUTSPC ;OUTPUT THE SPEC
PUSHJ P,PUTEOL ;NEXT LINE
MOVE P1,0(P1) ;STEP TO NEXT BLOCK
JUMPN P1,WHGRE1 ;IF NOT ZERO
PJRST PUTEOL ;ALIGN OUTPUT AND RETURN
; WHAT MPP [MPP NAME] OR [/ALL]
WHMPP: PUSHJ P,GMPPSP ;GET MPP FILE SPEC
POPJ P, ;
JUMPE T1,WHMPP1 ;FAKE "/ALL" IF NOTHING SAID
MOVE T2,ASCALL ;GET /ALL IN ASCII
CAME T2,2(T1) ;IS IT?
JRST WHMONE ;NO-JUST REGULAR W MPP
WHMPP1: MOVE P4,NMPPS## ;MAX NO. MPPS IN SYSTEM
SETZ P3, ;INITIAL DISPL
JRST WHMCOM ;GO TO COMMON CODE
WHMONE: PUSHJ P,FNDMPP## ;FIND PROTOTYPE IN SYSTEM
PJRST ILLMPP ;
HRRZI P3,0(T1)
MOVEI P4,1 ;ONLY ONE MPP
WHMCOM: HRRZ P1,MPPTAB##(P3)
MOVE P2,MP$HPQ(P1) ;GET FLAGS-IMMORTAL+LOCAL
TXNE P2,MPLOC$ ;LOCAL MPP
JRST WHMNXT ;YES, DON'T BOTHER LISTING THOSE
$SAY (<@MPP:>)
HRRZI T1,1(P1) ;POINT TO FILE SPEC
PUSHJ P,PMPPSP ;OUTPUT FILE SPEC FOR MPP
$SAY (<@CORE: >)
MOVE T1,MP$COR##(P1)
PUSHJ P,PUTDEC ;OUTPUT CORE SPEC
$SAY (< P@COPIES TO RUN-MIN: >)
HLRZ T1,MP$COP##(P1) ;GET MIN COUNT
PUSHJ P,PUTDEC
$SAY (<@ MAX: >)
HRRZ T1,MP$COP(P1) ;GET MAX COUNT
PUSHJ P,PUTDEC
$SAY (<@ INIT: >)
HLRZ T1,MP$RUN##(P1)
PUSHJ P,PUTDEC
$SAY (<@HPQ :>)
HLRZ T1,MP$HPQ##(P1)
PUSHJ P,PUTDEC
PUSHJ P,PUTEOL
TXNE P2,MPIMM$ ;IMMORTAL
$SAY (<NOT >) ;YES, SAY "NOT"
$SAY (<KILLABLE BY MCS@>)
TXNE P2,MPTMP$ ;TEMPORARLY RUNNING
$SAY (<OPERATOR DEFINED@>)
WHMNXT: AOS P3 ;INCR. DISPL COUNTER
SOJG P4,WHMCOM ;MORE TO DO???
POPJ P,
SET:
SETOM RUNROL## ;MIGHT CHANGE MPP PARAMETERS
PUSHJ P,GETSIX ;GET TYPE OF SET
$DISPATCH <CORE,HPQ,INITIA,MAXIMU,MINIMU,MPP,THRESH,QUOTA,CHECKP,NOCHEC>
,<SETCOR,SETHPQ,SETINI,SETMAX,SETMIN,SETMPQ,SETTHO,SETQUT,SETCP,SETNCP>
SETCOR: PUSHJ P,COMSET ;DO COMMON SET CODE STUFF
POPJ P, ;ERROR IN COMSET, RETURN
MOVEM T1,MP$COR##(T2) ;SAVE CORE SIZE IN MPP
POPJ P,
SETHPQ: PUSHJ P,COMSET
POPJ P, ;ERROR IN COMSET, RETURN
HRLM T1,MP$HPQ##(T2) ;SAVE HPQ VALUE
POPJ P,
SETINI: PUSHJ P,COMSET
POPJ P, ;ERROR IN COMSET, RETURN
HRRZ T3,MP$COP##(T2) ;GET MAX COUNT
CAIGE T3,0(T1) ;INIT .LE. MAX?
$SAYRET(<?MCSIBM INITIAL VALUE CANNOT BE GREATER THAN MAXIMUM VALUE>)
HRLM T1,MP$RUN##(T2) ;SAVE INITIAL VALUE
POPJ P,
SETMAX: PUSHJ P,COMSET
POPJ P, ;ERROR IN COMSET, RETURN
HLRZ T3,MP$COP##(T2) ;GET MIN COPIES
CAIGE T1,0(T3) ;MAX. GE. MIN?
$SAYRET(<?MCSMLM MAXIMUM VALUE CANNOT BE LESS THAN MINIMUM VALUE>)
HRRM T1,MP$COP##(T2) ;SAVE MAX MPP COUNT
POPJ P,
SETMIN: PUSHJ P,COMSET
POPJ P, ;ERROR IN COMSET, RETURN
HRRZ T3,MP$COP##(T2) ;GET MAX COUNT
CAILE T1,0(T3) ;MIN .LE. MAX?
$SAYRET(<?MCSMBM MAXIMUM VALUE MUST BE GREATER THAN MINIMUM VALUE>)
HRLM T1,MP$COP(T2) ;SAVE MIN MPP COUNT
POPJ P,
SETQUT: $GW(<AT>) ;IGNORE "AT"
PUSHJ P,GETNOD ;GET NODE NAME
JUMPE T1,NODNEX ;NODE NAME EXPECTED
$GW(<TO>) ;IGNORE "TO"
PUSHJ P,GETDEC ;GET COUNT
SKIPGE NOINPUT ;AND INPUT
PJRST DVENEX ;NO,PROMPT
JUMPL T1,[$SAYRET(<?MCSISC ILLEGAL VALUE FOR SET QUOTA>)]
MOVEI T2,I$NODE ;GET ADDRESS
$CALL (SETQUO,<T2,T1>)
PJUMPE $V,ILLNOD ;IF FALSE RETURN, ERROR
POPJ P, ;RETURN
SETTHO: $GW(<AT>) ;GUIDE WORD "AT"
PUSHJ P,GETNOD ;GET NODE NAME
JUMPE T1,NODNEX ;NODE NAME EXPECTED
$GW(<TO>) ;G.W. "TO"
PUSHJ P,GETDEC ;GET THRESHOLD VALUE
SKIPGE NOINPUT ;IF NO INPUT PAST HERE
PJRST DVENEX ;THEN PROMPT
JUMPLE T1,[$SAYRET(<?MCSIST ILLEGAL VALUE FOR SET THRESHOLD>)]
MOVEI T2,I$NODE ;LOAD BLOCK ADDRESS
$CALL (SETTHR,<T2,T1>)
PJUMPE $V,ILLNOD ;ERROR ON "FALSE" RETURN
POPJ P,
;SUBROUTINE COMSET - COMMON SUBROUTINE NEEDED BY SET COMMAND
;CALL PUSHJ P,COMSET
;RETURN CPOPJ ON ERROR, MESSAGE ISSUED
;RETURN CPOPJ1 T1=DATA,T2=ADDR OF MPP PROTOTYPE
COMSET: $GW(<FOR>) ;G.W. "FOR"
PUSHJ P,GMPPSP ;GET MPP SPEC PASSED
POPJ P, ;IF ERROR HAPPENS
JUMPE T1,MPPNEX ;MPP NAME EXPECTED
PUSHJ P,FNDMPP## ;FIND THE PROTOTYPE ADDR
JRST ILLMPP ;NONE-THEN ANOTHER ERROR
HRRZ P1,MPPTAB##(T1)
$GW(<TO>) ;BUZZ WORD "TO"
PUSHJ P,GETDEC ;GET DATA VALUE
SKIPGE NOINPUT ;ANY INPUT HERE?
PJRST DVENEX ;NO, PROMPT THE USER
MOVE T2,P1 ;RETURN PROTOTYPE ADDR.
JUMPGE T1,CPOPJ1## ;GIVE GOOD EDIT
$SAYRET (<?MCSVMP VALUE MUST BE POSITIVE>)
SETMPQ: $GW(<TO>) ;IGNORE THE "TO" BUZZ WORD
$GW(<RUN>) ;G.W. "RUN"
$GW(<AT>) ;BUZZ WORD "AT" COMES HERE
PUSHJ P,GETNOD ;GET NODE NAME
JUMPE T1,NODNEX ;NO NAME, PROMPT
$GW(<TO>) ;GUIDE WORD "TO" COMES HERE
PUSHJ P,GMPPSP ;GET MPP FILE SPEC
POPJ P, ;ERROR FROMP GMPPSP
JUMPE T1,MPPNEX ;MPP NAME EXPECTED
PUSHJ P,FNDMPP## ;FIND MPP
JRST SETMP0 ;NONE FOUND, GO BUILD ONE
JRST SETMP1 ;FOUND, USE IT
SETMP0: PUSHJ P,BLDMPP## ;NONE FOUND,SO BUILD ONE
JRST SETME3 ;ERROR
SETMP1: MOVEI T2,I$NODE ;GET ADDR OF NODE BLOCK
$CALL (SETRUN,<T2,T1>)
CAIN $V,1 ;ALL OK?
PUSHJ P,ILLNOD ;NO
JUMPGE $V,CPOPJ
SETME3: $SAYRET (<?MCSCAM CANNOT ADD MPP>)
; SET AND CLEAR CHECKPOINT FOR INDIVIDIUAL OR "ALL" LEAVES
;
; COMMAND FORMAT:
; SET CHECKPOINT FOR LEAF <LEAFNAME>,<LEAFNAME>....
; OR
; SET NOCHECKPOINT FOR LEAF <LEAFNAME>,<LEAFNAME>....
; NOTE: <LEAFNAME> CAN BE "/ALL"
SETNCP: TDZA P1,P1 ;INSURE P1 CONTAINS 0
SETCP: MOVEI P1,1 ;ELSE 1 FOR SET CHECKPOINT
$GW(<FOR>) ;BUZZ WORD "FOR"
PUSHJ P,GETNOD ;GET FIRST NODE SPECIFICATION
JUMPE T1,NODNEX ;ELSE PROMPT
SKIPA
CHKLOP: PUSHJ P,GETNOD ;GET NODE NAME
JUMPE T1,CPOPJ## ;IF NONE,RETURN
MOVE T2,ASCALL ;CHECK FOR ALL
CAMN T2,0(T1) ;IS IT?
SETZ T1, ;YES,INDICATE VIA ZERO NAME
$CALL (OPRCHK,<T1,P1> ) ;CALL WORKER ROUTINE
SKIPN $V ;DID ALL GO ALLRIGHT?
PUSHJ P,ILLNOD ;SAY "ILLEGAL NODE"
JRST CHKLOP ;GET NEXT NAME OR RETURN
ENABLE: TDZA P4,P4 ;INDICATE ENABLE
DISABL: SETO P4, ;INDICATE DISABLE
SETO P3, ;INDICATION OF FIRST NAME
PUSHJ P,GETSIX ;TYPE OF DISABLE
$DISPATCH <INPUT,OUTPUT>,<EDIN,EDOUT>
EDOUT: PUSHJ P,GETSIX ;SEE IF LEAF OR TERMINAL
$DISPATCH <LEAF,TERMIN>,<OLEAF,OTERM>
OTERM: TDZA P1,P1 ;P1 GETS ZERO FOR TERMINAL
OLEAF: MOVEI P1,1 ;AND ONE FOR LEAF
DISLOP: SKIPE P1 ;TERMINAL DISABLE?
PUSHJ P,GETNOD ;NODE-LEAF
SKIPN P1 ;LEAF DISABLE?
PUSHJ P,GETNAM ;NO-TERMINAL
JUMPE T1,[ AOJG P3,CPOPJ## ;IF NOT FIRST TIME, EXIT
JUMPE P1,TERNEX ;SAY TERMINAL NAME EXPECTED
JRST NODNEX ] ;OR NODE NAME EXPECTED
AOS P3 ;INCREMENT COUNT
PUSH P,T1 ;SAVE BLOCK ADDR
MOVE T2,ASCALL ;SEE IF /ALL SPECIFIER
CAMN T2,0(T1)
SETZ T1, ;YES-THEN SET ARG ADDR= 0
SKIPN P4 ;DISABLE COMMAND?
JRST DISNXT ;NO-
$CALL (OPRDO,<T1,P1>)
JRST DISCOM
DISNXT: $CALL (OPREO,<T1,P1>) ;YES-
DISCOM: HRRZ T1,0(P) ;GET ARG BLOCK LOCATION
SKIPE P1 ;GET RIGHT ROUTINE ADDRESS
SKIPA T2,[ILLNOD] ;I.E. EITHER NODE
MOVEI T2,ILLTRM ;OR TERMINAL
SKIPN $V ;GOOD RETURN?
PUSHJ P,0(T2) ;NO, GIVE ILLEGAL XXXXX MSG
POP P,0(P) ;BALANCE STACK
JRST DISLOP ;GO FOR MORE
EDIN: PUSHJ P,GETSIX ;GET TYPE-LEAF OR TERMINAL
$DISPATCH <LEAF,TERMIN>,<DISILP,DISINT>
DISILP: PUSHJ P,GETNOD ;GET NODE NAME
JUMPE T1,[ AOJG P3,CPOPJ## ;ALL DONE? MAYBE
JRST NODNEX] ;ELSE PROMPT
AOS P3 ;INCREMENT COUNT
MOVE T2,ASCALL ;
CAMN T2,0(T1) ;SEE IF /ALL USED
SETZ T1, ;YES-SET ARG BLOCK ADDR TO 0
SKIPN P4 ;DISABLE CMD?
JRST DISINX
$CALL (OPRDI,<T1>)
JRST DISICM
DISINX: $CALL (OPREI,<T1>) ;YES-
DISICM: SKIPN $V
PUSHJ P,ILLNOD ;INDICATE ANY ERRORS
JRST DISILP ;STILL CONTINUE
DISINT: PUSHJ P,GETNAM ;GET TERMINAL NAME
JUMPE T1,[ AOJG P3,CPOPJ## ;IF NOT FIRST TIME,RETURN
JRST TERNEX ] ;OTHERWISE PROMPT
AOS P3 ;INCREMENT COUNTER
SETZ $V,
PUSHJ P,GETNOD ;GET FIRST NODE NAME
JUMPE T1,NODNEX ;IF BLANK, PROMPT
SKIPA
DISTLP: PUSHJ P,GETNOD ;GET NODE NAME
JUMPE T1,CPOPJ## ;NO NODE NAME,SO EXIT
MOVEI T2,I$TERM ;GET TERMINAL ADDRESS
MOVE T3,ASCALL ;SEE IF /ALL
CAMN T3,I$NODE
SETZ T1, ;YES-THEN NO NODE NAMES
SKIPN P4 ;DISABLE?
JRST DISTNX
$CALL (OPRDIT,<T2,T1>)
JRST DISTCM
DISTNX: $CALL (OPREIT,<T2,T1>) ;YES-
DISTCM:
JUMPE $V,DISTLP ;IF VALUE = 0, ALL IS OK
CAIN $V,2 ;VALUE 2 INDICATES NODE
JRST ILLNOD ;SAY ILLEGAL NODE NAME
PJRST ILLTRM ;SAY ILLEGAL TERMINAL
$ENTRY (INFORM,<.TEXT,.ARG0,.ARG1,.ARG2,.ARG3,.ARG4>)
PUSHJ P,SAVE2## ;SAVE P1,P2
PUSH P,J ;SAVE J
SETZ J, ;INDICATE MPP TRAFFIC
MOVE P1,.TEXT ;GET THE BYTE POINTER
HRLI P1,(POINT 7) ;FORCE ASCII MODE
SETZ P2, ;SEE IF FIRST CHAR IS "F"
ILDB T1,P1 ;GET FIRST CHAR
PUSH P,T1 ;SAVE FIRST CHARACTER
CAIE T1,"F" ;FATAL ERROR MSG.?
JRST INFOR0 ;NO, SEE IF WARNING
MOVEI T1,"?" ;ERROR CHARACTER
JRST INFOR3 ;AND OUTPUT IT
INFOR0: CAIE T1,"W" ;WARNING
JRST INFOR2 ;NO, JUST OUTPUT IT
MOVEI T1,"%" ;WARNING CHARACTER
JRST INFOR3 ;OUTPUT IT
INFOR1: ILDB T1,P1 ;GET A CHARACTER
INFOR2: CAIN T1,"@" ;END
JRST INFXIT ;EXIT
CAIN T1,"#" ;EXIT WITH NO CR/LF
JRST INFXI1 ;YES
CAIN T1,"%" ;CONTROL CHARACTER
JRST INFCTL ;YES, PROCESS
INFOR3: PUSHJ P,OCHOPR ;NO, NORMAL TEXT TYPE IT
CAIE T1,15 ;CHECK FOR <CR>
JRST INFOR1 ;NOT <CR>, FORGET THIS AND GET NEXT CHR
MOVE T1,P1 ;GET COPY OF BYTE POINTER
ILDB T1,T1 ;GET NEXT BYTE
CAIN T1,12 ;CHECK FOR <LF>
JRST INFOR1 ;SEQUENCE WAS GOOD.. <CR><LF>
MOVEI T1,12 ;WASNT GOOD, PUT <LF> AFTER <CR>
JRST INFOR3 ;AND GO OUTPUT IT
INFCTL: ;PROCESS A % CONTROL CHARACTER
ILDB T4,P1 ;GET THE ARGUMENT NUMBER
ILDB T3,P1 ;GET THE FUNCTION CODE
MOVSI T2,-<INFTBS> ;GET THE TABLE SIZE
INFCT1: HLRZ T1,INFTBL(T2) ;LOOK FOR THE FUNCTION
CAIE T1,(T3) ;MATCH
AOBJN T2,INFCT1 ;NO, CONTINUE
JUMPGE T2,INFCT4 ;NOT IN THE TABLE (SCAN TO THE END)
SKIPA T3,.+1 ;BUILD AN ARGUMENTS FETCH INSTRUCTION
MOVE T1,.ARG0 ;ASSUME FIRST ARGUMENT
ADDI T3,-"0"(T4) ;OFFSET
XCT T3 ;GET THE ARGUEMNT
HRRZ T2,INFTBL(T2) ;GET THE DISPATCH ADDRESS
PUSHJ P,(T2) ;PROCESS THE ENTRY
JFCL ;IGNORE ERROR RETURN
INFCT4: ;REMOVE THE TERMINATING %
ILDB T1,P1 ;GET THE NEXT CHARACTER
CAIN T1,"%" ;LOOK FOR IT
JRST INFOR1 ;YES, GET THE REST OF THE TEXT
CAIE T1,"@" ;TERMINATOR
JUMPN T1,INFCT4 ;NO, CONTINUE SCAN
INFXIT: PUSHJ P,PUTEOL ;YES, END OF LINE ROUTINE
INFXI1: POP P,T1 ;RESTORE T1
POP P,J ;AND AC J
CAIN T1,"F" ;WAS THIS A FATAL ERROR MSG.?
PJRST ABORT## ;YES, TERMINATE THE RUN
POPJ P, ;ELSE RETURN TO CALLER
;DISPATCH TABLE
INFTBL:
XWD "A",OSROPR ;WRITE A STRING
XWD "O",PUTOCT ;WRITE OCTAL WORD
XWD "D",PUTDEC ;WRITE DECIMAL WORD
XWD "S",PUTSIX ;WRITE A SIXBIT WORD
XWD "H",PUTXWD ;WRITE HALF WORDS
XWD "J",OMPPSP ;WRITE MPP FILE SPECS
XWD "C",OCHOPR ;WRITE A CHARACTER
INFTBS==.-INFTBL ;TABLE SIZE
SUBTTL FILE ERROR MESSAGE OUTPUT ROUTINE
; ERRFIL - THIS ROUTINE PROCESSES THE FILE IO ERRORS SET UP BY
; THE ERRSET MACRO. TWO WORDS ARE SET UP BY THAT MACRO:
; ERRCOD: INDEX INTO ERROR TABLE TELLING REASON FOR ERROR
; ERRAUX: FULL WORD AVAILABLE FOR LONGER ERROR MESSAGES.
ERRFIL::
PUSHJ P,SAVE1## ;SAVE AN AC
PUSH P,T1 ;SAVE INPUT ARGUMENT
$SAY (<?MCSFFE >) ;GIVE FATAL FILE ERROR PREFIX
POP P,T1 ;RESTORE IT
PUSHJ P,PUTSIX ;OUTPUT FILE TYPE
$SAY (< file error: >)
MOVE P1,ERRCOD## ;GET THE ERROR TYPE
CAILE P1,ERRMAX ;INSIDE LEGAL RANGE?
$STPCD(ERF,ERROR NUMBER RANGE CHECK FAILED)
HRRZ T1,ERRTAB(P1) ;GET FIRST PART OF MESSAGE
PUSHJ P,OSROPR ;OUTPUT THAT STRING
HLRZ T1,ERRTAB(P1) ;GET CONTINUATION PART OF MESSAGE
JUMPN T1,0(T1) ;IF ITS THERE, GO DO IT
FILEND: PJRST PUTEOL ;END OF MESSAGE AND RETURN
; TABLE FOR ERROR MESSAGES, WHICH IS GENERATED BY THE FILERR MACRO
ERRTAB: ERRTB
ERRMAX==.-ERRTAB
SUBTTL ADDITIONAL FILE ERROR MESSAGE ROUTINES
; HERE ON OUTPUT AND INPUT ERRORS TO GIVE THE STATUS BITS
ERRIN:
ERROUT:
$SAY (<- STATUS=>) ;SET UP TO LABEL STATUS BITS
MOVE T1,ERRAUX## ;GET THE AUX WORD
TXZ T1,IO.MOD ;DONT WANT THE MODE
PUSHJ P,PUTOCT ;OUTPUT IT
MOVE T1,ERRAUX## ;GET AUXIALLARY WORD
PJRST FILEND ;END OF ERROR
; HERE ON DEVICE ERRORS TO TYPE OUT DEVICE NAME
ERRCDO:
ERRCDI:
ERRMDD:
ERROPN:
MOVE T1,ERRAUX## ;LOAD AUX WORD
PUSHJ P,PUTSIX ;OUTPUT IT
PJRST FILEND ;THATS ALL
; HERE ON MPX ERRORS TO TELL WHICH CHANNEL FAILED
ERRMPX: MOVE T1,ERRAUX## ;GET CHANNEL NUMBER
PUSHJ P,PUTOCT ;OUTPUT IT IN OCTAL
PJRST FILEND ;THEN CONTINUE ON
; HERE ON LOOKUP/ENTER ERRORS TO TYPE OUT CODE NUMBER AND EXPANSION
ERRLKP:
ERRENT:
MOVEI T1,"(" ;OUTPUT CHARACTER "("
PUSHJ P,OCHOPR ;TO OPERATOR
HRRZ T1,ERRAUX## ;GET CODE FOR FAILURE
PUSHJ P,PUTOCT ;OUTPUT IT
MOVEI T1,")" ;CLOSE IT OFF
PUSHJ P,OCHOPR ;BY RIGHT PAREN.
HRRZ T1,ERRAUX## ;RESTORE ERROR CODE
CAILE T1,LEEMAX ;A KNOWN ERROR TYPE?
SKIPA T1,[[ASCIZ " Uknown error type"]]
MOVE T1,LEETAB(T1) ;GET ADDRESS OF EXPANDED STRING
PUSHJ P,OSROPR ;OUTPUT STRING TO OPERATOR
PJRST FILEND ;THATS ALL
;GENERATE TABLE OF ADDRESSES OF ASCII STRINGS, ONE PER
;ERROR TYPE FOR LOOKUP/ENTER ERRORS.
LEETAB: LEETB
LEEMAX==.-LEETAB-1
SUBTTL ILLEGAL TERMINAL,NODE AND PORT ROUTINES
; ALL ROUTINES ARE CALLED WITH ARG OR ARG BLOCK IN T1
; AND RETURN CPOPJ
ILLPRT: PUSH P,T1 ;SAVE ARG
$SAY(<?MCSIPS Illegal PORT specified - >)
MOVE T1,0(P) ;GET ARGUMENT
PUSHJ P,PUTSIX ;OUTPUT IT
PUSHJ P,PUTEOL ;OUTPUT CR-LF
PJRST T1POPJ## ;RETURN
ILLTRM: $SAY(<?MCSITS Illegal TERMINAL specified - >)
MOVEI T1,I$TERM ;GET ARGUMENT ADDRESS
MOVX T2,<BYTE (7) 177,177>
ANDM T2,2(T1) ;INSURE ITS ONLY 12 CHARACTERS
PUSHJ P,OSROPR ;OUTPUT IT
PJRST PUTEOL ;OUTPUT CRLF
ILLNOD: $SAY(<?MCSINS Illegal NODE specified - >)
MOVEI T1,I$NODE ;GET ADDRESS OF CURRENT NODE
PUSHJ P,PUTNOD ;OUTPUT THE NODE NAME
PJRST PUTEOL ;OUTPUT CRLF
ILLMPP: $SAY(<?MCSIMS Illegal MPP specified - >)
MOVEI T1,I$MPP ;GET MPP SPEC
PUSHJ P,PMPPSP ;OUTPUT IT
PJRST PUTEOL ;RETURN WITH <CR-LF>
SUBTTL PUTXXX ROUTINES FOR OPERATOR OUTPUT
;SUBROUTINE PUT??? ;CONVERT A NUMBER IN THE RADIX AND OUTPUT
;CALL MOVEI T1,NUMBER
; PUSHJ P,PUTOCT ;OCTAL
; PUTDEC ;DECIMAL
; PUTRDX ;SPECIFY THE RADIX IN T3
;RETURN CPOPJ
PUTOCT::SKIPA T3,[^D8] ;LOAD OCTAL BASE
PUTDEC::MOVEI T3,^D10 ;LOAD DECIMAL BASE
PUTRDX: ;BASE LOADED IN T3
IDIVI T1,(T3) ;CONVERT THE NUMBER
HRLM T2,(P) ;SAVE THE REMAINDERS
SKIPE T1 ;ANY LEFT
PUSHJ P,PUTRDX ;YES, CONTINUE
HLRZ T1,(P) ;GET THE REMAINDERS BACK
MOVEI T1,"0"(T1) ;CONVERT TO ASCII
PJRST OCHOPR ;WRITE THE CHARACTER
;SUBROUTNE PUTSIX OUTPUT A SIXBIT NAME
;CALL MOVE T1,[SIXBIT /NAME/]
; PUSHJ P,PUTSIX
; CPOPJ
PUTSIX:: ;ENTRY
SKIPN T2,T1 ;COPY TO T2
POPJ P, ;DONE
PUTSI1: LSHC T1,6 ;GET A CHARACTER
ANDI T1,77 ;ONLY 6 BITS
ADDI T1," " ;CONVERT TO ASCII
PUSHJ P,OCHOPR ;WRITE THE CHARACTER
JUMPN T2,PUTSI1 ;END
POPJ P, ;YES, EXIT
;SUBROUTINE PUTNOD OUTPUT A NODE NAME
;CALL MOVEI T1,ADDR-OF-^D12 WORD-BLOCK
; PUSHJ P,PUTNOD
; CPOPJ
PUTNOD: PUSHJ P,SAVE2## ;SAVE A COUPLE OF REGS
MOVEI P1,4 ;LEVEL COUNTER
SKIPA P2,T1 ;INPUT ARGUMENT
PTNOD1: MOVEI T1,0(P2) ;GET ADDRESS OF CURRENT LEVEL STRING
MOVE T2,2(T1) ;GET LAST WORD
AND T2,[BYTE (7)177,177];INSURE IT ENDS ON TIME
MOVEM T2,2(T1) ;STORE IT BACK
PUSHJ P,OSROPR ;OUTPUT IT TO THE OPERATOR
SOJLE P1,CPOPJ## ;IF ALL LEVELS DONE, EXIT
ADDI P2,3 ;ELSE STEP TO NEXT LEVEL
SKIPN 0(P2) ;IF ITS BLANK, WE ARE DONE
POPJ P, ;SO EXIT
MOVEI T1,"." ;ELSE OUTPUT LEVEL SEPARATOR
PUSHJ P,OCHOPR ;
JRST PTNOD1 ;AND LOOP AROUND
;SUBROUTINE GMPPSP - GET MPP SPEC
;CALL PUSHJ P,GMPPSP
;RETURN CPOPJ IF ERROR
;RETURN CPOPJ1 T1 CONTAINS POINTER TO I$MPP, WHICH HAS SPEC
; OR T1/0 IF NO SPEC GIVEN
GMPPSP::
PUSHJ P,SAVE4## ;SAVE ALL PERM ACS
MOVE T1,[ASCII .DSK.] ;INITIALIZE DEFAULTS
MOVEM T1,I$MPP+0 ;SUCH AS DEVICE..
MOVE T2,PPNMCS## ;AND DEFAULT PPN
MOVEM T2,I$MPP+4 ;SAVE IN AREA
SETZM I$MPP+1 ;BLANK OUT THE REST
SETZM I$MPP+2 ;
SETZM I$MPP+3 ;
SETO P1, ;P1 IS FLAG COUNTER
MPPGET: HRRZI T1,P2 ;PUT DATA IN P2,P3, AND P4
PUSHJ P,GETLVL ;GET A LEVEL
JUMPE P2,[ AOJN P1,.+1 ;RETURN IF NOT FIRST TIME TO IN-LINE
SETZ T1, ;CLEAR T1
JRST CPOPJ1## ] ;AND GO HOME
AOS P1 ;INCREMENT COUNTER
ANDX P3,<BYTE (7) 177> ;MAKE SURE WE GET ONLY SIX CHARACTERS
MPPGE1: CAIN T4,":" ;DEVICE NAME?
JRST MPPDVC ;YES-
CAIN T4,"[" ;FILE EXTENSION?
JRST MPPNAM ;YES-
CAIN T4,"." ;FILE NAME?
JRST SPCERR ;YES-THIS IS ILLEGAL HERE
JUMPE P2,SPCERR ;ANY NAME? NO-EXIT
MOVEM P2,I$MPP+2 ;NO-JUST STORE FILE NAME
MOVEM P3,I$MPP+3
MPXIT: MOVEI T1,I$MPP ;YES-ALL DONE THEN
PJRST CPOPJ1## ;EXIT WITH GOOD RETURN
MPPNA1: MOVEM P2,I$MPP+2 ;SAVE FILE NAME
MOVEM P3,I$MPP+3
MOVEI T1,P2 ;BYPASS EXTENSION
PUSHJ P,GETLVL
JRST MPPGE1
MPPDVC: MOVEM P2,I$MPP+0 ;SAVE DEVICE NAME IN SPEC AREA
MOVEM P3,I$MPP+1
JRST MPPGET ;TRY FOR MORE
MPPNAM: MOVEM P2,I$MPP+2 ;SAVE MPP NAME
MOVEM P3,I$MPP+3
PUSHJ P,GETOCT ;GET PPN
TRNE T1,-1 ;ANY GIVEN
HRLM T1,I$MPP+4 ;YES,SAVE IT
LDB T1,OPRIN##+.BFPTR ;GET NEXT CHAR
SKIPE ATOOPR## ;IS THIS FROM AUTO FILE?
LDB T1,ATOIN##+.BFPTR ;YES-GET CHAR FROM IT
CAIE T1,"," ;PPN SEP?
JRST SPCERR ;NO-ERROR
PUSHJ P,GETOCT ;GET OTHER ONE?
TRNE T1,-1 ;NOTHER CHECK
HRRM T1,I$MPP+4
JRST MPXIT ;TRY FOR MORE
SPCERR: $SAYRET(<?MCSBMS Bad MPP specification syntax>)
MPPNEX: $SAYRET(<[MCSMNE MPP name expected]>)
;SUBROUTINE OMPPSP - OUTPUT MPP SPEC,WITH SPECIAL CALL
;CALL MOVEI T1,JSN TO BE USED
; PUSHJ P,OMPPSP
;RETURN CPOPJ
OMPPSP::
SKIPG T1,JB$MPP##(T1) ;GET PTR TO MPP
POPJ P,
HRRZI T1,MP$DEV##(T1) ;POINT TO FILE SPEC
PUSHJ P,PMPPSP ;OUTPUT THE SPEC
POPJ P, ;EXIT
;SUBROUTINE PMPPSP - PUT MPP SPEC
;CALL MOVEI T1,ADDR OF FILE SPEC
; PUSHJ P,PMPPSP
;RETURN CPOPJ
PMPPSP::
PUSHJ P,SAVE1## ;WE NEED TO USE P1
HRRZI P1,2(T1) ;POINT TO FILE NAME
HRLI T1,(POINT 7)
PUSH P,T1
PMPP01: ILDB T1,(P) ;GET A CHAR
JUMPE T1,PMP001 ;GOT ONE?
PUSHJ P,OCHOPR ;YES-OUTPUT IT
JRST PMPP01 ;GO FOR MORE
PMP001: MOVEI T1,":" ;OUTPUT SEP
PUSHJ P,OCHOPR
HRRZI T1,0(P1) ;POINTER TO FILE NAME
HRLI T1,(POINT 7)
MOVEM T1,0(P) ;SAVE BYTE POINTER
PMPP02: ILDB T1,0(P) ;GET A CHAR
JUMPE T1,PMP002 ;GOT ONE?
PUSHJ P,OCHOPR ;YES-OUTPUT IT
JRST PMPP02 ;GO FOR MORE
PMP002: POP P,(P)
SKIPN 2(P1) ;ANY PPN?
PJRST CPOPJ## ;NO-JUST EXIT
MOVEI T1,"[" ;YES-OUTPUT IT
PUSHJ P,OCHOPR
HLRZ T1,2(P1) ;GET PROJ #
PUSHJ P,PUTOCT
MOVEI T1,","
PUSHJ P,OCHOPR
HRRZ T1,2(P1) ;GET PRGM'R #
PUSHJ P,PUTOCT
MOVEI T1,"]"
PUSHJ P,OCHOPR
POPJ P, ;EXIT
;SUBROUTINE PUTSPC WRITE A FILE SPEC TO THE OPERATOR
;CALL MOVEI T1,[SIXBIT /DEVICE/
; SIXBIT /FILE/
; SIXBIT /EXT/
; XWD PROJECT,PROGRAMMER]
; PUSHJ P,PUTSPC
;RETURN CPOPJ
PUTSPC:: ;ENTRY
SKIPN T4,T1 ;COPY THE POINTER
POPJ P, ;NO POINTER
SKIPE T1,(T4) ;GET THE DEVICE
PUSHJ P,PUTSIX ;WRITE IT
MOVEI T1,":" ;AND A COLON
PUSHJ P,OCHOPR ;WRITE
MOVE T1,1(T4) ;GET THE FILE NAME
PUSHJ P,PUTSIX ;WRITE
HLRZ T3,2(T4) ;GET THE EXTENSION
JUMPE T3,PUTSP1 ;IF NONE SKIP IT
MOVEI T1,"." ;OUTPUT DOT
PUSHJ P,OCHOPR ;
MOVSI T1,0(T3) ;GET THE HALF WORD EXTENSION
PUSHJ P,PUTSIX ; WRITE IT OUT
PUTSP1: SKIPN 3(T4) ;CHECK FOR A PPN
POPJ P, ;NONE
MOVEI T1,"[" ;BRACKET
PUSHJ P,OCHOPR ;WRITE
MOVE T1,3(T4) ;GET THE PPN BACK
PUSHJ P,PUTXWD ;WRITE HALF WORDS
MOVEI T1,"]" ;BRACKET
PJRST OCHOPR ;WRITE AND RETURN
;SUBROUTINE PUTXWD- WRITE HALF WORD OCTAL SEPERATE BY A COMMA
;CALL MOVE T1,[HALF WORD]
;PUSHJ P,PUTXWD
;RETURN CPOPJ
PUTXWD: ;ENTRY POINT
PUSH P,T1 ;SAVE THE HALF WORD
HLRZ T1,(P) ;GET THE LEFT HALF
PUSHJ P,PUTOCT ;WRITE IT
MOVEI T1,"," ;SEPERATOR
PUSHJ P,OCHOPR ;WRITE IT
HRRZ T1,(P) ;GET THE RIGH HALF
PUSHJ P,PUTOCT ;WRITE IT
PJRST T1POPJ## ;EXIT
SUBTTL I/O ROUTINE TO THE CONTROLING TTY
;SUBROUTINE OSROPR - OUTPUT A STRING TO THE OPERATOR
;CALL MOVEI T1,[ASCII/STRING/]
; PUSHJ P,OSROPR
;RETURN CPOPJ ;RETURN
; OSROPA IS CALLED BY THE $SAY MACRO
; OSROPB IS CALLED BY THE $SAYRET MACRO
OSROPA::PUSH P,T1 ;SAVE ADDRESS TO RETURN TO
AOS 0(P) ;PUSH IT UP BY 1 TO NOT XCT NO-OP
OSROPB::HRRZ T1,0(T1) ;PICK OUT ADDRESS OF STRING
OSROPR::HRLI T1,(POINT 7) ;MAKE ASCII POINTER
OSROP0: PUSH P,T1 ;SAVE THE POINTER
OSROP1: ILDB T1,(P) ;GET A CHARACTER
JUMPE T1,T1POPJ## ;EXIT
CAIN T1,"@" ;IS IT FLAG CHARACTER MEANING <CRLF>?
JRST [ PUSHJ P,PUTEOL;YES, OUTPUT CR-LF PAIR
JRST OSROP1 ] ;THEN SKIP OVER THIS CHARACTER
PUSHJ P,OCHOPR ;WRITE THE CHARACTER
JRST OSROP1 ;CONTINUE
;SUBROUTINE OSRAST - PRINT OUT AN *
;CALL PUSHJ P,OSRAST
; CPOPJ ;ONLY RETURN POINT
OSRAST:: SKIPE ATOOPR## ;DOING AN AUTO FILE
POPJ P, ;YES, DON'T PROMPT
MOVEI T1,"!" ;PROMPT CHARACTER
TXNN OPRFLG,CMDSTR ;ARE WE STARTED
MOVEI T1,"/" ;NO, PROMPT WITH A SLASH INSTEAD
PUSHJ P,OCHOPX ;WRITE OUT TO OPERATOR
JRST OBKOPR ;FORCE OUT BUFFER AND RETURN
; SUBROUTINE PUTEOL - WRITE <CR>-<LF> PAIR OUT TO OPR TERMINAL
;CALL PUSHJ P,PUTEOL
;RETURN CPOPJ
;
PUTEOL::MOVEI T1,.CHCRT ;GET <CR>
PUSHJ P,OCHOPR ;OUTPUT TO OPERATOR
MOVEI T1,.CHLFD ;GET <LF>
; PJRST OCHOPR ;FALL INTO OCHOPR,RETURN FROM THERE....
;SUBROUTINE OCHOPR - WRITE A CHARACTER TO THE OPR
;CALL MOVE T1,[CHARACTER]
; PUSHJ P,OCHOPR
; CPOPJ
OCHOPR:
OCHOPX::
TXNN OPRFLG,CMDOTO ;IS COMMAND TERMINAL OPEN?
JRST [TTCALL 1,T1 ;NO, SO USE TTCALL
POPJ P,] ;AND RETURN
SOSG OPROUT##+.BFCTR ;REDUCE BYTE COUNT
PUSHJ P,OBKOPR ;WRITE BUFFER OUT
IDPB T1,OPROUT##+.BFPTR ;WRITE CHAR TO BUFFER
CAIN T1,.CHLFD ;END OF LINE?
PUSHJ P,OBKOPR ;YES-WRITE LINE OUT
POPJ P, ;IN ANYCASE,JUST RETURN
;SUBROUTINE OBKOPR - WRITE A BLOCK TO THE OPERATOR
;CALL PUSHJ P,OBKOPR
;RETURN CPOPJ
OBKOPR:: OUT OPR, ;WRITE
POPJ P, ;RETURN
PUSH P,T1 ;SAVE A REG
MOVEI T1,1 ;1 SECOND
SLEEP T1, ;WAIT FOR TYPE-OUT TO FINISH
POP P,T1 ;RESTORE CALLERS
JRST OBKOPR ;TRY AGAIN
;SUBROUTINE LOCENT- LOCATE ENTRY IN PORT TABLE
;CALL MOVE T1,[SIXBIT PORTNAME ]
; PUSHJ P,LOCENT
; CPOPJ -ERROR RETURN
; CPOPJ1 -OKAY RETURN
LOCENT: HRRZ P1,PORTTA## ;GET ADDRESS OF PORTTABLE
SKIPN (P1) ;ZERO ENTRY?(THEN END)
POPJ P,
CAMN T1,0(P1) ;COMPARE PORT NAMES
PJRST CPOPJ1##
ADDI P1,3 ;INCREMENT TO NEXT ENTRY
JRST LOCENT+1 ;CONTINUE
;SUBROUTINE GONOFF - RETURN VALUE OF ON/OFF
;CALL PUSHJ P,GONOFF
; HERE IF BAD ARGUMENT
; HERE WITH T1=1 IF "ON" T1=0 IF "OFF" T1=-1 IF NOTHING
GONOFF: PUSHJ P,GETSIX ;GET SOMETHING
JUMPE T1,[ SETCA T1, ;RETURN -1
PJRST CPOPJ1##]
$DISPATCH <ON,OFF>,<GOOON,GOOOFF>
GOOOFF: TDZA T1,T1 ;IF OFF, RETURN 0
GOOON: MOVEI T1,1 ;ON RETURNS 1
PJRST CPOPJ1## ;RETURN
;SUROUTINE GETNBK - GET FIRST NON BLANK CHARACTER
;CALL PUSHJ P,GETNBK
;RETURN CPOPJ ;FIRST NON BLANK CHARACTER IN T1
; ; 0 = NO MORE
GETNBK: ;ENTRY
PUSHJ P,ICHOPR ;READ A CHARACTER
JRST ZIPT1J ;NO MORE, RETURN T1 = 0
CAIE T1," " ;A TAB
CAIN T1," " ; OR A BLANK
JRST GETNBK ;YES, CONTINUE LOOKING
CAIN T1,.CHLFD ;IS IT LINE FEED?
SETZ T1, ;YES, RETURN 0 INSTEAD
POPJ P, ;NO, GOT SOMETHING
;SUBROUTINE TO INPUT A SIXBIT ALPHA/NUMBERIC
;CALL PUSHJ P,GETSIX ;GET SIXBIT
;RETURN CPOPJ ;T1=SIXBIT
GETSIX:: ;ENTRY
PUSHJ P,GETNBK ;GET NON-BLANK CHARACTER
PUSH P,ZERO ;PUT A ZERO ON THE STACK
MOVSI T2,(POINT 6,(P));BYTE POINTER
GETSI1: CAIN T1,"/" ;SLASH?
JRST GETSI2 ;YES-VALID CHAR
CAIL T1,"0" ;CHECK THE REANGE
CAILE T1,"Z" ;ALPHA/NUMBERIC
PJRST T1POPJ## ;NOT IN RANGE EXIT
CAILE T1,"9" ;AGAIN
CAIL T1,"A" ;ETC
JRST GETSI2 ;CHARACTER OK
PJRST T1POPJ## ;NOT IN RANGE EXIT
GETSI2: SUBI T1,40 ;CONVERT TO SIXBIT
TLNE T2,770000 ;END OF BYTE
IDPB T1,T2 ;STORE THE CHARACTER
PUSHJ P,ICHOPR ;GET THE NEXT CHARACTER
PJRST T1POPJ## ;NONE LEFT
JRST GETSI1 ;CONTINUE
;SUBROUTINE GETNAM - GET A STRING OF CHARS
;CALL PUSHJ P,GETNAM
; CPOPJ ;RETURN HERE T1=ADDRESS OF STRING OR 0
; ;POINTS TO LOADED I$TERM BLOCK
GETNAM:
MOVEI T1,I$TERM ;LOAD WITH WHERE TO PUT STUFF
PUSHJ P,GETLVL ;GET A LEVEL(ONE IN THIS CASE)
SKIPN I$TERM ;ANYTHING IN THE BLOCK
ZIPT1J: SETZ T1,
POPJ P, ;EXIT
;SUBROUTINE GETNOD - GET NODE NAME
;CALL PUSHJ P,GETNOD
;RETURN CPOPJ ;T1=0 OR ADDRESS OF 12 WORD BLOCK
;POINTS TO I$NODE, CURRENT NODE
GETNOD: PUSHJ P,SAVE2## ;SAVE TWO P ACS
HRROI P2,-3 ;MAX.NO OF NODES IN SYSTEM
MOVEI T1,I$NODE ;WHERE TO PUT INPUT
PUSH P,T1 ;SAVE ADDR OF CHUNK
GNDNXT: PUSHJ P,GETLVL ;GET A LEVEL NAME
CAIE T4,"." ;LAST CHAR A DOT??
JRST GNDEND ;NO-SO EXIT
HRRZI T1,3(T1) ;YES-SO TRY ANOTHER LEVEL
AOJLE P2,GNDNXT ;MORE? YES-THEN CONTINUE AGAIN
GNDEND: JUMPGE P2,GNDENA ;ALL LEVELS FULL?
GNDENB: MOVEI T1,3(T1) ;NO-CLEAR OUT ALL OTHERS
SETZM 0(T1)
SETZM 1(T1)
SETZM 2(T1)
AOJL P2,GNDENB
GNDENA: SKIPN I$NODE ;ANYTHING ENTERED AT ALL?
SETZM 0(P) ;NO, SO RETURN WITH T1/0
PJRST T1POPJ## ;YES-SO EXIT
;SUBROUTINE GETLVL - GET A LEVEL NAME
;CALL MOVEI T1,ADDR OF 3 WORD AREA
; PUSHJ P,GETLVL
;RETURN CPOPJ
GETLVL: PUSH P,T1 ;SAVE IT
SETZM 0(T1) ;CLEAR IT INITIALLY
SETZM 1(T1)
SETZM 2(T1)
HRLI T1,440700 ;BUILD BYTE PTR
MOVE T3,T1 ;PUT IN GOOD AREA
MOVEI T2,3*5 ;MAX NO.OF CHARS
PUSHJ P,GETNBK ;FIND NON BLANK CHAR FIRST
JUMPE T1,T1POPJ## ;IF NOE-THEN JUST EXIT
JRST .+3 ;OTHERWISE SKIP AROUND LOOP GET
GETNXT: PUSHJ P,ICHOPR ;GET A CHAR
PJRST T1POPJ## ;NONE-SO EXIT
HRRZI T4,0(T1) ;SAVE JUST IN CASE
CAIN T1," " ;SPACE?
PJRST T1POPJ## ;YES-EXIT
CAIN T1,12 ;CR CHAR??
PJRST T1POPJ## ;YES-
CAIN T1,"." ;LEVEL DELMITER?
PJRST T1POPJ## ;YES-
CAIN T1,":" ;FILE DEVICE DELIMITER
PJRST T1POPJ##
CAIN T1,"[" ;PPN FILE DELIMITER
PJRST T1POPJ##
IDPB T1,T3 ;NONE ABOVE,SO SAVE IT
SOJG T2,GETNXT ;MORE-THEN CONTINUE
PJRST T1POPJ ;ALL DONE,THEN EXIT
;SUBROUTINE GETNUM INPUT AN OCT/DECIMAL NUMBER
;CALL PUSHJ P,GETOCT GETDEC
;RETURN CPOPJ ;T1=NUMBER
GETOCT: SKIPA T2,EIGHT ;OCTAL INPUT
GETDEC: MOVEI T2,^D10 ;DECIMAL INPUT
GETRDX:
SETZM NOINPUT ;START WITH FLAG OFF
PUSHJ P,GETNBK ;GET FIRST NON-BLANK CHARACTER
JUMPE T1,[SETOM NOINPUT ;INDICATE BLANK LINE
POPJ P,] ;AND RETURN
SKIPA
GTRDX1: PUSHJ P,GETNBK ;SKIP BLANKS
CAIE T1,"-" ;MINUS
JRST GETNU0 ;NO,
MOVNS T2 ;NEGATE THE CONSTANT
JRST GTRDX1 ;TRY AGAIN
GETNU0: CAIN T1,"+" ;CHECK FOR A SIGH
JRST GTRDX1 ;YES, IGNORE PLUS
GETNUM: PUSH P,ZERO ;PUT ZERO ON THE STACK
GETNU1: SUBI T1,"0" ;CONVERT TO BINARY
JUMPL T1,T1POPJ## ;OUT OF RANGE
JUMPGE T2,GETNU2 ;JUMP IF + CONVERSION
CAMGE T1,T2 ;IN RANGE
PJRST T1POPJ## ;NO, EXIT
MOVNS T1 ;NEGATE
JRST GETNU3 ;INSERT THE NUMBER
GETNU2: CAILE T1,(T2) ;CHECK HIGH RANGE
PJRST T1POPJ## ;NO, EXIT
GETNU3: IMULM T2,(P) ;SHIFT THE DIGITS
ADDM T1,(P) ;INSERT THE DIGIT
PUSHJ P,ICHOPR ;READ A CHARACTER
PJRST T1POPJ## ;EXIT NO CHARACTER
JRST GETNU1 ;CONVERT ANOTHER
EIGHT: EXP ^D8
ZERO: EXP 0
;SUBROUTINE GETEOL - FORCE END OF LINE ON OPERATOR INPUT
;CALL PUSHJ P,GETEOL
;RETURN CPOPJ ;AT END OF LINE
GETEOL: ;ENTRY POINT
LDB T1,OPRIN##+.BFPTR ;GET THE CURRENT DELIMITER
SKIPE ATOOPR## ;ATO FILE IN PROCESS
LDB T1,ATOIN##+.BFPTR ;GET THE ATO FILE CHARACTER
GETEO1: PUSHJ P,ISBRK ;CHECK FOR BREAK CHARACTER
POPJ P, ;YES, EXIT
PUSHJ P,ICHOPR ;NO, READ A CHARACTER
POPJ P, ;NONE LEFT
JRST GETEO1 ;CONTINUE
SUBTTL GETSPC - GENERAL ROUTINE TO INPUT A FILE SPEC
;SUBROUTINE GETSPC - INPUT A FILE SPEC
;CALL PUSHJ P,GETSPC
;RETURN CPOPJ ;ILLEGAL FILE SPEC AFTER ERROR MSG
; CPOPJ1 ;LEGAL FILE SPEC T1 POINTS TO FILE SPEC BLOCK
; ;OR T1 = 0 IF NO SPEC SEEN
GETSPC: MOVEI T1,I$SPEC ;POINT TO SPEC BLOCK
MOVSI T1,'DSK' ;DEFAULT THE DEVICE
MOVEM T1,I$SPEC+0 ;STORE THE DEVICE NAME
SETZM I$SPEC+1 ;CLEAR THE FILE NAME
SETZM I$SPEC+2 ;EXTENSION
SETZM I$SPEC+3 ;PPN
PUSHJ P,GETSIX ;GET VERY FIRST WORD INPUT
JUMPE T1,CPOPJ1## ;RETURN WITH 0 POINTER IF NOTHING
SKIPA
GETSP1: PUSHJ P,GETSIX ;GET SOMETHING
CAIA ;SKIP
GETSP2: SETZ T1, ;CLEAR THE VALUE
LDB T2,OPRIN##+.BFPTR ;GET THE DELIMITER
SKIPE ATOOPR##
LDB T2,ATOIN##+.BFPTR
CAIN T2,":" ;DEVICE
JRST GETDEV ;YES
CAIN T2,"[" ;PPN
JRST GETPPN ;YA
CAIN T2,"." ;FILE NAME
JRST GETNAX ;GOT A FILE NAME
CAIN T2,.CHLFD ;LINE FEED
JUMPN T1,GETNAX ;MUST BE A FILE NAME IN T1
MOVEI T1,I$SPEC ;EXIT
JRST CPOPJ1## ;WITH GOOD RETURN
GETDEV: ;DEVICE NAME
MOVEM T1,I$SPEC ;STORE THE DEVICE NAME
JRST GETSP1 ;TRY AGAIN
GETNAX: MOVEM T1,I$SPEC+1 ;STORE THE FILE NAME
LDB T2,OPRIN##+.BFPTR ;GET THE DELIMITER
SKIPE ATOOPR## ;FROM AUTO FILE?
LDB T2,ATOIN##+.BFPTR ;YES-
CAIE T2,"." ;PERIOD
JRST GETSP2 ;NO, CONTINUE
PUSHJ P,GETSIX ;YES, LOOK FOR THE EXTENSION
HLLZM T1,I$SPEC+2 ;STORE THE EXTENSION
JRST GETSP2 ;CONTINUE
GETPPN: JUMPN T1,GETNAX ;MAY BE A FILE NAME BEFORE THE PPN
PUSHJ P,GETOCT ;GET THE PROJECT NUMBER
LDB T2,OPRIN##+.BFPTR ;GET THE DELIMITER
TLNN T1,-1 ;LT 777777
SKIPE ATOOPR## ;IS THIS FROM AUTO?
LDB T2,ATOIN##+.BFPTR ;YES-
CAIE T2,"," ;MUST BE A COMMA
JRST FSPERR ;GIVE ERROR MSG,RETURN POPJ
TRNN T1,-1 ;ANYTHING THERE
HLRZ T1,PPNMCS## ;NO, GET DEFAULT
HRLZM T1,I$SPEC+3 ;STORE THE PROJECT NUMBER
PUSHJ P,GETOCT ;GET THE PROGRAMMER NUMBER
LDB T2,OPRIN##+.BFPTR ;GET THE DELIMITER
SKIPE ATOOPR##
LDB T2,ATOIN##+.BFPTR
TLNN T1,-1 ;LT 777777
CAIE T2,"]" ;CLOSING BRACKET
JRST FSPERR ;RETURN WITH FAILURE
TRNN T1,-1 ;ANYTHING THERE
HRRZ T1,PPNMCS## ;NO, GET DEFAULT
HRRM T1,I$SPEC+3 ;STORE THE PROGRAMMER NUMBER
JRST GETSP1 ;CONTINUE
FSPERR: $SAYRET(<?MCSIFS Invalid file specification syntax>)
FSPNEX: $SAYRET(<[MCSFSE File specification expected]>)
SUBTTL OPERATOR TERMINAL AND ATO FILE I/O ROUTINES
;SUBROUTINE ICHOPR - READ A CHARACTER FROM THE OPERATOR
;CALL PUSHJ P,ICHOPR ;READ
;RETURN CPOPJ ;NO CHARACTRS AVAILABLE
; CPOPJ1 ;T1=THE ASCII CHARACTER
ICHOPR: ;ENTRY POINT
TXNE OPRFLG,EOFLAG ;END OF LINE SEEN
POPJ P, ;YES, GIVE NO MORE RETURN
SKIPE ATOOPR## ;ATO MODE
JRST ICHATO ;YES, READ THE ATO FILE
SOSL OPRIN##+.BFCTR ;NO, REDUCE THE ITEM COUNT
JRST ICHOP1 ;CHARACTERS AVAILABLE
PUSHJ P,IBKOPR ;READ A BLOCK
POPJ P, ;NO, CHARACTERS LEFT
ICHOP1: ILDB T1,OPRIN##+.BFPTR ;GET A CHARACTER
PUSHJ P,ISBRK ;IS IT A BREAK CHARACTER
JRST [ MOVEI T1,.CHLFD ;YES, CONVERT THEM ALL TO LINE FEED
DPB T1,OPRIN##+.BFPTR
JRST ICHOP2 ] ;AND BACK IN LINE
ICHOP2: JUMPE T1,ICHOPR ;IGNORE NULLS
CAIN T1,.CHCRT ;IGNORE C-R
JRST ICHOPR ;TRY AGAIN
CAIN T1,.CHLFD ;IS IT LINE FEED?
TXO OPRFLG,EOFLAG ;YES, MARK IT
CAIG T1,"z" ;LOWER CASE Z
CAIGE T1,"a" ;OR LOWER CASE A
PJRST CPOPJ1## ;NOT A LOWER CASE LETTER, RETURN
SUBI T1,"a"-"A" ;CONVERT TO UPPER CASE
PJRST CPOPJ1## ;RETURN
; SUBROUTINE ISBRK, CHECKS CHARACTER TO SEE IF IT IS ASCII BREAK CHARACTER
; CALL MOVEI T1,"?"
; PUSHJ P,ISBRK
; HERE IF BREAK
; HERE IF NOT
ISBRK:: CAIE T1,.CHLFD ;IS IT LINE-FEED?
CAIN T1,.CHESC ;OR ALT-MODE (FOR LEFTIES)
POPJ P, ;YES,ITS A BREAK
CAIE T1,.CHVTB ;IS IT VERTICAL TAB
CAIN T1,.CHFFD ;OR FORM FEED
POPJ P, ;YES, TAKE BREAK RETURN
CAIE T1,32 ;^Z
CAIN T1,7 ;^G
POPJ P, ;YES, TAKE BREAK RETURN
PJRST CPOPJ1## ;ELSE SKIP NEXT INSTRUCTION
;SUBROUTINE IBKOPR - READ A BLOCK FROM THE OPERATOR
;CALL PUSHJ P,IBKOPR
;RETURN CPOPJ ;NO, BLOCK AVAILAVBLE
; CPOPJ1 ;BLOCK READ
IBKOPR: ;ENTRY POINT
IN OPR, ;TRY A BLOCK
PJRST CPOPJ1## ;GOT ONE
STATO OPR,IO.EOF ;INPUT FAILED, CHECK FOR EOF
POPJ P, ;NO, REALLY NO BLOCKS LEFT
CLOSE OPR,CL.OUT ;CLOSE INPUT SIDE ONLY
JRST IBKOPR ;ONE MORE CHANCE
;SUBROUTINE ICHATO - READ A CHARACTER FROM THE ATO COMMAND FILE
;CALL PUSHJ P,ICHATO
;RETURN CPOPJ ;END OF FILE OR ERROR
; CPOPJ1 ;CHARACTER IN T1
ICHATO: SOSL ATOIN##+.BFCTR ;REDUCE THE ITEM COUNT
JRST ICHAT1 ;CHARACTERS AVAILABLE
PUSHJ P,IBKATO ;READ A BLOCK
POPJ P, ;NO, CHARACTERS LEFT
ICHAT1: ILDB T1,ATOIN##+.BFPTR ;GET A CHARACTER
PUSHJ P,ISBRK ;IS IT A BREAK CHARACTER?
JRST [MOVEI T1,.CHLFD;YES,CONVERT TO LINE FEED
DPB T1,ATOIN##+.BFPTR
PJRST ICHOP2]
PJRST ICHOP2 ;CONTINUE AS IF OPR
;SUBROUTINE IBKATO - READ A BLOCK FROM THE ATO FILE
;CALL PUSHJ P,IBKATO
;RETURN CPOPJ ;NO BLOCK LEFT
; CPOPJ1 ;BLOCK READ
IBKATO:: ;ENTRY POINT
IN ATO, ;READ
PJRST CPOPJ1## ;GOT A BLOCK
STATZ ATO,IO.EOF ;END OF AUTO FILE
PJRST ATOCLS## ;YES, ALL DONE
IBKAT1: ;ERROR IN ATO FILE
GETSTS ATO,T1 ;LOAD STATUS
ERRSET F%IN,T1 ;STORE STUFF AWAY
MOVSI T1,'ATO' ;LOAD THE FILE ID
PUSHJ P,ERRFIL ;TELL ABOUT THE ERROR
PJRST ATOCLS## ;CLOSE THE FILE
;SUBROUTINE OCHOPY - BLISS ENTRY POINT FOR OCHOPR
;
;
$ENTRY (OCHOPY,<.CHAR>)
SETZ $V, ;BECAUSE LOGGING NEEDS IT
MOVE T1,.CHAR ;GET CHAR
PJRST OCHOPX ;OUTPUT IT AND RETURN
;SUBROUTINE OSROPY - BLISS ENTRY POINT FOR OSROPR
;
;
$ENTRY (OSROPY,<.STRNG>)
SETZ $V,
HRRZ T1,.STRNG ;GET ADDR OF STRING
PJRST OSROPR ;OUTPUT THE STRING AND RETURN
SUBTTL STOREAGE AND LITERALS
$LOW
NOINPUT: BLOCK 1 ;-1 WHEN GETNUM FINDS NULL LINE
I$MPP:: BLOCK 5 ;INPUT MPP SPEC GOES HERE
I$NODE::BLOCK 14 ;INPUT NODE SPECIFICATION GOES HERE
I$TERM::BLOCK 3 ;INPUT TERMINAL SPECIFIED GOES HERE
I$PORT::BLOCK 1 ;INPUT PORT NAME, TEMPORARY STOREAGE
I$DROP::BLOCK 1 ;RDX DROP NUMBER OR NETWORK-NODE LINE NUMBER
I$SPEC::BLOCK 4 ;INPUT FILE SPEC GOES HERE
$HIGH
$LIT
PRGEND
TITLE KRNONC - MESSAGE CONTROL PROGRAM KERNEL ROUTINES
SUBTTL D.TODD/DRT/AAG/CDO/ILG 1 JUNE 1977
SEARCH KERNEL,MACTEN,UUOSYM ;LOAD ALL THE UNIVERSALS
$RELOC
SUBTTL MCS-10 ONCE ONLY CODE CALLED FROM "RUN" OR "START"
ONCE: JFCL ;AVOID CCL START
RESET ;RESET EVERYTHING
AOSE MNRFLG ;FIRST TIME AROUND?
JRST TWICE ;NO. TRY TO RECOVER
MOVEM .SGDEV,RUNBLK+0 ;SAVE RUN DEVICE
MOVEM .SGNAM,RUNBLK+1 ;SAVE RUN NAME
MOVEM .SGPPN,RUNBLK+4 ;SAVE RUN PPN
DEVCHR .SGDEV, ;SEE IF ACS WERE ACTUALLY SET UP
JUMPN .SGDEV,.+2 ;0 RETURN MEANS NON-EXISTENT DEVICE
SETZM RUNBLK+0 ;FLAG VIA 0 DEVICE NAME
SETZB OPRFLG,$F ;CLEAR OPERATOR FLAG,BLISS FRAME POINTER
TXO OPRFLG,CMDDEB ;ALLOW DEBUGGING MPPS
MOVE P,STKPTR## ;SET UP THE SYSTEM STACK POINTER
MOVEI T1,MCSVER ;GET OUR VERSION NUMBER
CAIE T1,.VRGEN## ;IS IT THE SAME AS MCSGEN VERSION NUMBER?
$STPCD(WVG,WRONG VERSION OF MCSGEN USED TO CREATE CONFIG FILE)
PJOB T1, ;GET THE JOB NUMBER
MOVEM T1,JOBMCS## ;STORE
GETPPN T1, ;GET RUNNING PPN
JFCL
MOVEM T1,PPNMCS## ;SAVE IT FOR LATER USE
$GETTB (T1,<-1,,.GTPRV>);GET MY PRIVELEGE WORD
TXNN T1,JP.IPC ;MUST HAVE IPCF
$STPCD(IPR,INSUFFICIENT PRIVELEGES TO RUN MCS-10)
SKIPA T1,.+1 ;GET A NEW NAME
SIXBIT/MCS-10/ ;SO CONTROLLED MPPS CAN FIND US
SETNAM T1,
;COMPUTE THE NUMBER OF ALLOCATED PAGES LOADED WITH MCS
;A ONE BIT = PAGE IS AVAILABLE
;A ZERO BIT = PAGE IS ALLOCATED
ONCPAG: ;COMPUTE THE ADDRESSABLE PAGES
SETOM P$BITS## ;SET THE PAGES INUSE
SKIPA T1,.+1 ;LOAD A BLT POINTER TO CLEAR THE PAGE TABLE
XWD P$BITS,P$BITS+1
BLT T1,P$BITS##+<<PAGMAX/^D36>+1>-1 ;SET ALL PAGES IN USE
SKIPA T4,.+1 ;LOAD A 1 BIT BYTE POINTER
POINT 1,P$BITS##
MOVSI T1,-<PAGMAX-PAGFRE>;PAGES IN THE ADDRESSING SPACE
ONCPA1: MOVEI T2,(T1) ;COPY THE PAGE NUMBER
HRLI T2,.PAGCA ;SET PAGE ACCESS FUNCTION
PAGE. T2, ;IS THE PAGE AVAILABLE
$STPCD(SPA,COULD NOT SET PAGE ACCESS)
TXNN T2,PA.GNE ;DOES THE PAGE EXIST
TROA T2,1 ;PAGE DOES NOT EXIST
SETZ T2, ;PAGE IS AVAILABLE
IDPB T2,T4 ;STORE THE BIT
AOBJN T1,ONCPA1 ;CONTINUE
;ALLOCATE THE FREE CORE
HLRZ T1,.JBHRL## ;GET HIGH SEG LENGTH
HRRZ T2,.JBHRL## ;AND LAST LOCN OF IT
MOVEI T1,777(T1) ;ROUND LENGTH
TRZ T1,777 ;TO A PAGE BOUNDRY
JUMPE T2,[MOVEI T2,PAGMAX-PAGFRE ;OVERHEAD
SUBI T2,MAXJSN##+1 ;MINUS IPCF NEEDED
LSH T2,P2WLSH ;TO AN ADDRESS
MOVEI T1,0 ;ZERO LENGTH IF NONE
SOJA T2,.+1] ;ADJUST AND RETURN IN LINE
AOS P4,T2 ;P4 = FIRST AVAILABLE LOCN
SUBI T2,0(T1) ;COMPUTE STARTING ADDRESS
MOVE T1,.JBFF## ;GET FIRST FREE WORD IN LOW SEG
MOVEM T1,C$BPTR## ;STORE RH OF POINTER TOO.
SUBB T2,.JBFF## ;T2 GETS WORDS BETWEEN LOW AND HI SEGMENT
LSH T2,W2PLSH ;CONVERT TO PAGES
SKIPE T2 ;??GET NO PAGES.
PUSHJ P,GETPAG## ;FETCH THAT MANY PAGES
$STPCD(CFB,COULD NOT ALLOCATE FREE CORE REGION "B")
MOVE T2,.JBFF## ;GET NUMBER OF WORDS AVAILABLE
HRRZ T1,C$BPTR## ;FETCH BASE ADDRESS
PUSHJ P,FREC ;CALCULATE BIT MAP FOR REGION "B"
MOVEM T1,C$BASE## ;STORE AS THE BASE
MOVNS T3 ;NEGATE LENGTH OF MAP
HRLM T3,C$BPTR## ;STORE INTO POINTER
IDIVI T2,FRECHK ;STORE NUMBER OF FREE CHUNKS GOTTEN
MOVEM T2,C$SIZE## ;TWIXT LO AND HI SEGMENT
MOVE T1,P4 ;GET HISEG FREE SLOT
MOVEM T1,C$APTR## ;STORE AS POINTER ADDRESS
MOVEI T2,PAGMAX-PAGFRE ;FIGURE OUT HOW MANY PAGES ARE RESERVED
SUBI T2,MAXJSN##+1 ;PLUS ONE FOR EACH JSN
LSH T2,P2WLSH ;CONVERT TO AN ADDRESS
SUB T2,T1 ;GET FREE WORDS
MOVE P4,T2 ;SAVE IT IN P4
ASH T2,W2PLSH ;CONVERT BACK TO PAGES
JUMPL T2,TMJERR ;IF NEGATIVE, RESERVED AREA OVERLAPS HISEG
JUMPE T2,NOHIGH ;IF NO PAGES,ASSUME NO HIGH SEGMENT
PUSHJ P,GETPAG## ;GRAB THAT MANY PAGES
$STPCD(CFA,COULD NOT ALLOCATE FREE CORE REGION "A")
MOVE T2,P4 ;RESTORE NUMBER OF WORDS
HRRZ T1,C$APTR## ;GET ADDRESS TO START WITH
PUSHJ P,FREC ;CONVERT TO BIT MAPS ETC...
MOVEM T1,C$ABASE## ;STORE THE BASE OF FREE CORE AREA"A"
MOVNS T3 ;GET NEGATIVE OF MAP LENGTH
HRLM T3,C$APTR## ;STORE INTO AREA B POINTER
IDIVI T2,FRECHK ;CONVERT SIZE OF FREE CORE TO CHUNKS
NOHIGH: ADDB T2,C$SIZE## ;STORE SIZE OF FREE CORE IN CHUNKS
MOVEI T1,0(T2) ;GET COPY FOR CALCULATIONS
IMULI T2,FREHI1 ;GET UPPER WARNING LIMIT
IDIVI T2,^D100 ;PERCENTAGE
CAIGE T2,-FREAB1(T1) ;IS %AGE RESERVE SMALLER THAN ABSOLUTE RESERVE?
MOVEI T2,-FREAB1(T1) ;NO, SO USE ABSOLUTE RESERVE
MOVEM T2,FREFUL## ;
MOVE T2,C$SIZE## ;ALSO GET THE LOWER PERCENTAGE
IMULI T2,FREHI2 ;USED FOR THE WARNING TOGGLE
IDIVI T2,^D100 ;
CAIGE T2,-FREAB2(T1) ;IS THIS %AGE RESERVE MORE THAN ABSOLUTE?
MOVEI T2,-FREAB2(T1) ;YES,SO USE SMALLER,ABSOLUTE RESERVE
MOVEM T2,FREFLL## ;STORE IT AWAY ALSO
SETOM .JBFF## ;MAKE SURE NOBODY ELSE ALLOCATES CORE
SETZM I$USED## ;SO FAR, 0 IPCF PAGES IN USE
MOVSI T1,-PAGMAX ;EXAMINE EVERY PAGE
MOVE T2,[POINT 1,P$BITS##] ;IN THE PAGE MAP
CNTP:
ILDB T3,T2 ;GET ONE BIT
JUMPN T3,.+2 ;IF NOT 0, DON'T ADD ONE TO AVAILABLE COUNT
AOS T4,I$SIZE## ;ELSE UPDATE IT
AOBJN T1,CNTP ;GO BACK IF MORE PAGES LEFT
CAIE T4,MAXJSN##+1 ;MAKE CHECK, SHOULD BE 1 PAGE PER JSN
$STPCD(IPW,IPCF POOL WRONG SIZE); PLUS ONE FOR JUNK MAIL
JRST ONCFIL ;GO OPEN FILES
TMJERR: OUTSTR [ASCIZ "
?MCSTMJ Too many JSNs to put high segment at specified address"]
EXIT
; SUBROUTINE TO SET UP THE MAP AREAS AND COUNTERS FOR THE TWO
; FREE CORE REGIONS.
; ENTER WITH:
; T1/BASE ADDRESS TO USE. THE BIT MAP STARTS HERE
; T2/NUMBER OF WORDS AVAILABLE
;
; RETURN WITH:
; MAP ALL SET UP WITH APPROPRIATE 1'S AND 0'S
; T1/ADDRESS OF THE FIRST WORD OF FREE SPACE
; T2/SIZE OF ACTUAL FREE REGION IN WORDS
; T3/SIZE OF THE MAP IN WORDS
;
FREC: SOJ T2, ;START WITH N-1 WORDS OF CORE AND
MOVEI T3,1 ;START WITH 1 BIT MAP WORD
FREC1: SETZM 0(T1) ;ZERO THE WORD
MOVE T4,T3 ;FETCH WORDS OF BIT MAP INUSE
IMULI T4,^D36*FRECHK ;CONVERT TO WORDS FREE SPACE THEY REPRESENT
CAIG T2,0(T4) ;HAVE ENOUGH BIT MAP WORDS?
JRST FREC2 ;YES.
ADDI T1,1 ;UPDATE ADDRESSES USED FOR BIT MAP
SUBI T2,1 ;WORDS LEFT FOR FREE SPACE
AOJA T3,FREC1 ;UPDATE WORDS OF BIT MAP,TRY AGAIN
FREC2: SETOM 0(T1) ;MARK LAST BIT MAP WORD ALL IN USE
SUBI T4,^D36*FRECHK ;BACK OFF ONE BIT MAP WORD'S WORTH
MOVE P2,[POINT 1,0(T1)] ;POINTER TO LAST WORD OF MAP
SETZ P1, ;GET A NICE WORD OF ZERO
FREC3: ADDI T4,FRECHK ;ADD ONE BITS WORTH OF WORDS OF FREE SPACE
CAILE T4,(T2) ;ARE WE IN RANGE?
AOJA T1,CPOPJ## ;LEAVE WITH T1 PTR TO FREE CHUNKS THEMSELVES
IDPB P1,P2 ;STORE IT
JRST FREC3 ;AND TRY AGAIN
SUBTTL - FILE OPEN PROCESS
ONCFIL:
;OPEN OPERATOR TTY FIRST
PUSHJ P,OPROPN
$STPCD(COT,CANNOT OPEN OPERATOR'S TERMINAL)
TXO OPRFLG,CMDOTO ;FLAG THAT OPERATOR TERMINAL IS OPEN
;OPEN THE REMOTE DEVICE CHANNELS
PUSHJ P,MX0OPN ;OPEN THE MPX CHANNELS TO MSGSER
JRST MPXERR
;OPEN THE MPX/PTY CHANNEL TO THE MPP'S
ONCFI0: PUSHJ P,MPPOPN ;OPEN THE MPP/PTY CHANNEL
JRST MPPERO
;ENABLE THE PI SYSTEM
$PISYS (<<IPC,0,PS.VTO,0>,<MX0,PS.RID!PS.ROD!PS.RDO,PS.VTO,0>,<MX1,PS.RID!PS.ROD!PS.RDO,PS.VTO,0>,<MX2,PS.RID!PS.ROD!PS.RDO,PS.VTO,-1>,<MX3,PS.RID!PS.ROD!PS.RDO,PS.VTO,-1>,<MPP,PS.RID,PS.VTO,0>,<OPR,PS.RID!PS.ROD,PS.VTO,0>,<DAT,0,PS.VTO,0>,<DSC,0,PS.VTO,0>,<NET,0,PS.VTO,0>>)
;NOW OPEN FILES THAT ARE OPTIONAL
;OPEN THE LOGGING FILE IF SPECIFIED
SKIPN MLOGGI## ;MPP LOGGING WANTED?
JRST ONCFI2 ;NO-
MOVE P1,LOGSPC## ;GET PRIMARY LOG FILE SPEC
PUSHJ P,LOGOPN ;OPEN IT
JRST LOGERO
;OPEN THE JOURNAL FILE
ONCFI2: SKIPN ILOGGI## ;JOURNAL FILE WANTED
JRST ONCFIX ;NO-
MOVE P1,JORSPC## ;GET FILE SPEC
PUSHJ P,JRNOPN ;OPEN IT
JRST JRNERO
;NOW OPEN UP THE FAILSOFT/ROLL OUT FILE
ONCFIX: PUSHJ P,QUEOPN ;DEFINE,OPEN,LOOKUP,ENTER Q FILE
JRST QUEERO ;COULDNT OPEN F/R FILE
SUBTTL INITILIZE IPCF
ONCIPC: $GETTB (T1,%IPCCP) ;GET THE PID ON [SYSTEM]IPCF
MOVEM T1,PIDIPC## ;STORE THE PID OF [SYSTEM]IPC
MOVE T1,JOBMCS## ;GET THE MCS JOB NUMBER
TLO T1,(1B0) ;
MOVEM T1,MSGSND##+.IPCS1 ;STORE OUR JOB NUMBER
MOVEI T1,.IPCSC ;MAKE PID FUNCTION
PUSHJ P,IPCCST## ;MAKE A PID FOR US
$STPCD(CMP,COULD NOT MAKE PID)
;SET OUR QUOTA VIR MAXJSN
MOVEI T1,<77B26!77B35> ;SEND /RECEIVE QUOTA
HRL T1,JOBMCS## ;OUT JOB NUMBER
PUSHJ P,IPCQTA## ;SEND THE MESSAGE
JFCL ;DON'T CARE
;SETUP [SYSTEM]INFO
$GETTB (T1,%IPCSI) ;GET THE PID OF [SYSTEM]INFO
MOVEM T1,PIDINF## ;STORE THE PID
JUMPN T1,ONCIP2 ;IT IS HERE
$SAY (<@%MCSIPC [SYSTEM]INFO NOT RUNNING SO DEBUGGING MPPS CANNOT RUN@>)
JRST ONCIP1
ONCIP2: SKIPA T1,.+1 ;BUILD A MESSAGE TO INFO
XWD 377776,.IPCII ;CREAT PID CODE
MOVEM T1,MSGSND##+.IPCI0 ;STORE THE FUNCTION CODE
SETZM MSGSND##+.IPCI1 ;CLEAR ARG 1
SKIPA T1,.+1 ;LOAD A BLT
XWD MCSNAM##,MSGSND##+.IPCI2; FOR THE MCS SYSTEM NAME
BLT T1,MSGSND##+.IPCI2+5 ;MOVE THE SYSTEM NAME
SETZ T1, ;CLEAR FLAGS
PUSHJ P,SNDINF## ;SEND TO [SYSTEM]INFO
ONCIP1: JFCL
SUBTTL INITILIZE THE SYSTEM
TXO OPRFLG,CMDBOT ;STOP UNTIL "START"
MOVNS JSNCO0##
MOVE T1,JSNCO1## ;ANOTHER FIX FOR MACRO
ADDI T1,1
MOVNS T1
HRLOS T1 ;MAKE -LH,,-1
MOVEM T1,JSNCO1## ;STORE IT
MOVE T2,[ SETZ T1, ] ;SET UP WHAT TO DO FOR CR/LF
HRRZI T1,015 ;IF THEY ARE IN INPUT BUFFER
CAIN T1,ESI## ;AND AN END INDICATOR!
MOVE T2,[ JFCL ]
CAIN T1,EMI## ;IF NOT AN E?I,THEN FORCE TO
MOVE T2,[ JFCL ] ;ZERO.IF IT IS AN E?I THEN
CAIN T1,EGI## ;LEAVE IT ALONE
MOVE T2,[ JFCL ]
MOVEM T2,FIXCR##
MOVE T2,[ SETZ T1, ] ;SAME FOR LINE FEED NOW
HRRZI T1,012
CAIN T1,ESI##
MOVE T2,[ JFCL ]
CAIN T1,EMI##
MOVE T2,[ JFCL ]
CAIN T1,EGI##
MOVE T2,[ JFCL ]
MOVEM T2,FIXLF##
MOVN P1,NMPPS## ;GET NUMBER OF MPPS IN THE SYSTEM
HRLZS P1 ;MAKE AN ABOJN POINTER
MOVE P2,PPNMCS## ;GET DEFAULT PPN
MOVX P3,MPLOC$ ;GET LOCAL MPP BIT
ONCMPP: HLRZ T1,MPPTAB##(P1) ;GET AN MPP POINTER
JUMPE T1,ONCMP2 ;DONE WITH THIS ONE
ONCMP1: TDNN P3,MP$HPQ##(T1) ;A LOCAL MPP
SKIPE MP$PPN##(T1) ;NO, ANY PPN SPECIFIED
SKIPA ;YES, USE IT
MOVEM P2,MP$PPN##(T1) ;NO, USE DEFAULT PPN
HRRZ T1,MP$ALT##(T1) ;GET POINTER TO BACKUP MPP
JUMPN T1,ONCMP1 ;DO THAT ONE TOO
ONCMP2: AOBJN P1,ONCMPP ;GET ALL MPPS DEFINED
PUSHJ P,OSRAST## ;PRINT OUT AN ASTRICK
JRST SCHED.## ;GO TO THE SCHEDULER
;ERROR HANDLING DURING INITIALIZATION
MPPERO: MOVSI T1,'MPP' ;
PUSHJ P,ERRFIL## ;DESCRIBE THE ERROR
JRST ABORT## ;DON'T CONTINUE
MPXERR: MOVSI T1,'MPX' ;MPX CHANNEL ERROR
PUSHJ P,ERRFIL## ;TELL ABOUT THE ERROR
JRST ABORT## ;DO NOT CONTINUE THE RUN
LOGERO: MOVSI T1,'LOG' ;LOG FILE
PUSHJ P,ERRFIL## ;DESCRIBE THE ERROR
JRST ONCFI2 ;DO SOME MORE
JRNERO: MOVSI T1,'JRN' ;JOURNAL FILE
PUSHJ P,ERRFIL##
JRST ONCFIX
QUEERO: MOVE T1,ERRCOD## ;GET ERROR CODE
MOVE T2,ERRAUX## ;AND REASON
CAXN T1,F%LKP ;IS THIS A LOOKUP ERROR?
CAXE T2,ERFNF% ;AND FILE NOT FOUND?
PUSHJ P,[ MOVSI T1,'QUE' ;NO, GIVE THE APPROPRIATE MSG.
PJRST ERRFIL##] ;FOR THE IO ERROR INVOLVED
PUSHJ P,QUERFR ;TRY TO REFRESH FILE
JRST [ MOVSI T1,'QUE'
PUSHJ P,ERRFIL##
JRST ABORT##] ;GIVE MESSAGE AND STOP IF
;CANNOT REFRESH FILE
JRST ONCIPC ;CAN,,, CONTINUE
SUBTTL OPROPN ROUTINES TO OPEN THE OPR (TTY/MPX) CHANNEL
OPROPN::
PUSHJ P,SAVE2## ;SAVE P1,P2
ERRSET F%OPN,OPRBLK+.OPDEV ;TRYING TO OPEN THE DEVICE
OPEN OPR,OPRBLK
POPJ P, ;ERROR RETURN
MOVSI T2,400000 ;MASK TO CLEAR THE USE BIT
SKIPA T1,.+1 ;LOAD THE INPUT RING BUFFER POINTER
EXP BF.VBR+OPRIBF##
MOVEM T1,OPRIN##+.BFADR;STORE
ANDCAM T2,(T1) ;CLEAR THE USE BIT
SKIPA T1,.+1 ;LOAD THE OUTPUT RING BUFFER POINTER
EXP BF.VBR+OPROBF##
MOVEM T1,OPROUT##+.BFADR;STORE
ANDCAM T2,(T1) ;CLEAR THE USE BIT
SETZM ATOOPR## ;CLEAR THE ATO MODE
PJRST CPOPJ1## ;EXIT
OPRBLK: EXP UU.AIO!UU.PHS!.IOASC
SIXBIT /TTY/
XWD OPROUT##,OPRIN## ;RING HEADER
SUBTTL FILOPN - ROUTINES TO OPEN THE MCS FILES SYSTEM
$HIGH
QUEOPN::
PUSHJ P,SAVE2## ;SAVE P1,P2
SKIPA T1,.+1
EXP UU.PHS!UU.IBC!IO.UWC!.IOBIN ;OPEN THE QUEUE FILES
PUSHJ P,QUEDEF ;DEFINE THE QUE/ROOL FILE
POPJ P, ;FATAL ERROR
ERRSET F%LKP ;LOOKUP ERROR?
LOOKUP QUE,.RBCNT(P1) ;LOOKUP THE QUEUE FILE
JRST QUOPN1 ;LOOKUP/ENTER ERROR
AOS .RBVER(P1) ;UPDATE THE VERSION NUMBER
ERRSET F%ENT ;SET ERROR CODE
ENTER QUE,.RBCNT(P1) ;UPDATE MODE
JRST QUOPN1 ;ERROR RETURN
SETZM QP$BLK## ;OPEN THE FILE
SETZM Q$BASE## ;FIRST PAT IS IN CORE, BASE PARTICLE = 0
MOVE T1,.RBSIZ(P1) ;GET THE FILE SIZE
IDIVI T1,QU$WA ;ROUND DOWN TO NEAREST FULL
IMULI T1,QU$WA ;ALLOCATION'S WORTH
JUMPE T1,[ERRSET F%EOF;PREMATURE END OF FILE
POPJ P,] ;TAKE NON-SKIP RETURN
CAME T1,.RBSIZ(P1) ;WAS ANYTHING LOST?
PUSHJ P,[ PUSH P,T1 ;SAVE NEW SIZE
$SAY(<%MCSPAI Partially allocated area at end of QUEUE file ignored@>)
PJRST T1POPJ## ]
IDIVI T1,QU$WP ;GET THE NUMBER OF PARTICALS
MOVEM T1,QP$MAX## ;STORE THE MAX PARTICAL NUMBER
MOVEI T2,(P1) ;GET THE LOOKUP BLOCK ADDRESS
MOVEI T1,.RBTIM+1 ;SIZE OF THE BLOCK
PUSHJ P,GIVWDS## ;RETURN FREE CORE
USETI QUE,1 ;FIRST LOGICAL BLOCK
INPUT QUE,QUEPAT## ;READ PAT BLOCK
STATO QUE,IO.EOF!IO.ERR ;ANY ERROR OR EOF?
JRST [AOS(P) ;GOING TO SKIP RETURN
PJRST USECNT##] ;COUNT THE FREE SPACE AND RETURN
GETSTS QUE,T2 ;GET THE FILE STATUS
ERRSET F%IN,T2 ;SET ERROR REASON AND CODE
POPJ P, ;TAKE ERROR RETURN
QUOPN1: ;HERE IF LOOKUP OR ENTER FAILS
HRRZ T1,.RBEXT(P1) ;GET THE ERROR CODE
ERRSET (,T1) ;SET IT DOWN
MOVEI T2,0(P1) ;RETURN CORE
MOVEI T1,.RBTIM+1 ;TO FREE SPACE
PJRST GIVWDS## ;AND GIVE ERROR RETURN
QUEDEF:: ;ENTRY TO DEFINE THE ROLL FILE
MOVE T2,FSPRIM## ;GET THE DEVICE NAME
SKIPA T3,.+1
XWD QUEOUT##,QUEIN## ;RING HEADERS
ERRSET F%OPN,T2 ;POSSIBLE OPEN ERROR
OPEN QUE,T1
POPJ P, ;ERROR RETURN
SKIPA T1,.+1 ;LOAD THE RING HEADER
EXP BF.VBR!BF.IBC+QUEPAT##
MOVEM T1,QUEIN##+.BFADR;SET UP THE INPUT HEADER
MOVEM T1,QUEOUT##+.BFADR;SET UP THE OUTPUT HEADER
MOVEI T2,.RBTIM+1 ;SIZE OF THE LOOKUP/ENTER BLOCK
ERRSET F%COR ;MIGHT NOT HAVE ENUFF CORE
PUSHJ P,GETWDS## ;ALLOCATE
POPJ P, ;ERROR RETURN
MOVEI P1,(T1) ;SAVE THE ADDRESS
HRLI T2,(T1) ;CLEAR OUT THE BLOCK
HRRI T2,1(T1) ;BUILD THE POINTER
SETZM (P1)
BLT T2,.RBTIM(P1) ;CLEAR THE BLOCK
MOVEI T1,.RBTIM ;GET THE LOOKUP LENGTH
MOVEM T1,.RBCNT(P1) ;STORE
DMOVE T1,FSPRIM##+1 ;GET THE FILE.EXT
DMOVEM T1,.RBNAM(P1) ;STORE
SKIPE T1,FSPRIM##+3 ;GET THE PPN
MOVEM T1,.RBPPN(P1) ;STORE
PJRST CPOPJ1## ;GOOD EXIT
SUBTTL QUERFR REFRESH THE ROLL/QUEUE FILE
;CALL PUSHJ P,QUERFR
;RETURN CPOPJ ;ILLEGAL FILE DEFINATION
; CPOPJ1 ;FILE REFRESHED
QUERFR:: ;ENTRY POINT
TXNE OPRFLG,RFRAD ;WAS REFRESH ALREADY DONE?
PJRST CPOPJ1 ;YES, SO RETURN WITH NO ACTION
PUSHJ P,SAVE4## ;SAVE P1,P2,P3,P4
CLOSE QUE, ;MAKE SURE THE QUE FILE IS CLOSED
$SAY (<[MCSRQF Refreshing QUEUE file]@>)
SKIPA T1,.+1
EXP UU.PHS!UU.IBC!IO.UWC!.IOBIN ;OPEN THE QUEUE FILES
PUSHJ P,QUEDEF ;DEFINE THE FILE
POPJ P, ;ILLEGAL FILE SPECS
MOVX T2,RP.ABC ;MARK FILE AS ALWAYS HAVEING BAD
IORM T2,.RBSTS(P1) ;CHECKSUM BECAUSE ALWAYS OPEN
ENTER QUE,(P1) ;ENTER THE FILE
JRST [ HRRZ T1,.RBEXT(P1)
ERRSET F%ENT,T1
POPJ P,] ;SET ERROR INFO AND GIVE BAD RETURN
MOVEI T2,(P1) ;GET THE ENTER BLOCK LOCATION
MOVEI T1,.RBTIM+1 ;AND THE LENGTH
PUSHJ P,GIVWDS## ;REMOVE FROM FREE CORE
MOVE P3,IBASE## ;GET START OF SPECIAL PARTICLE ALLOC.
SKIPN P1,FSSIZE## ;GET THE FILE SIZE IN BLOCKS
MOVEI P1,QU$DA ;DEFAULT TO ONE ALLOCATION'S WORTH
MOVMS P1 ;IN ANY CASE, GET MAGNITUDE
IMULI P1,QU$WD ;CONVERT BLOCKS TO WORDS
IDIVI P1,QU$WP ;WORDS /PARTICAL
IDIVI P1,QU$BA ;BITS PER ALLOCATION
MOVEI T4,1 ;START AT BLOCK1
SKIPE P2 ;ANY REMAINDER?
AOS P1 ;YES,ROUND UP
QUERF1: MOVSI T1,740000 ;MARK THE FIRST FOUR AS IN USE
MOVEM T1,QUEPAT##+2 ;STORE THE FIRST WORD
SETZM QUEPAT##+3
SKIPA T1,.+1
XWD QUEPAT##+3,QUEPAT##+4
BLT T1,QUEPAT##+201 ;CLEAR THE REST OF THE PAT BLOCK
MOVEI T1,^D128
MOVEM T1,QUEPAT##+1
PUSHJ P,IOBASF ;GO ALLOCATE IBASE-OBASE PARTICLES
USETO QUE,(T4) ;GO TO THE BLOCK
OUTPUT QUE,QUEPAT## ;WRITE AND BLOCK
STATZ QUE,IO.ERR ;ERROR WRITING THE BLOCK
JRST QUERF5 ;ERROR
ADDI T4,QU$DA ;STEP TO THE NEXT PAT BLOCK
SOJG P1,QUERF1 ;CONTIUE IF NEXT IS FULL
QUERF4: USETO QUE,0(T4) ;ALLOCAT TO THE END
MOVX T1,BF.VBR ;GET "VIRGIN BUFFER" BIT
IORM T1,QUEOUT## ;SET INTO HEADER SO CLOSE DOES NO I/O
CLOSE QUE, ;CLOSE THE FILE
TXO OPRFLG,RFRAD ;MARK REFRESH AS DONE
PJRST QUEOPN ;RE-OPEN THE FILE
QUERF5: GETSTS QUE,P1 ;GET FILE STATUS THAT IS IN ERROR
ERRSET F%OUT,P1 ;SET IT UP
PJRST TPOPJ## ;RETURN
;SUBROUTINE IOBASF - ROUTINE TO ALLOCATE IBASE-OBASE PARTICLES
;CALL IOBASF
; CPOPJ ;RETURN
IOBASF: CAIE T4,1 ;DO ONLY IF INITIAL PAT BLOCK
POPJ P, ;ISN'T, DON'T TOUCH BLOCK
SETOM P4 ;SET UP BIT FOR BYTE ALLOCATION
PUSH P,T1 ;SAVE TEMP
MOVE T2,P3 ;PREPARE TO FORM BYTE PTR
IDIVI T2,44 ;NO.BITS/WORD
MOVEI T1,QUEPAT##+2(T2) ;FORM ADDR PART OF BYTE PTR
MOVNS T3 ;NEGATE REMAINDER
ADDI T3,44
LSH T3,6
ADDI T3,01 ;1 BIT BYTES
LSH T3,6
HRLI T1,0(T3) ;ADD IN LH OF BYTE PTR
IOTST: CAIG P3,QU$BA-1 ;OFF THE TOP OF THE PAT BLOCK
CAIGE P3,4 ;OR BELOW THE BOTTOM
PJRST T1POPJ## ;YES, BAD IBASE/OBASE POINTERS FROM MCSGEN
ADDI P3,1 ;NO-INCR.CURRENT PARTICLE #
IDPB P4,T1 ;STORE ALLOCATED BIT(=1)
CAMG P3,OTOP## ;ALL ALLOCATED?
JRST IOTST ;NO-GO FOR MORE
PJRST T1POPJ## ;YES-EXIT
SUBTTL MX0OPN ROUTINES TO OPEN THE MX0 (MSGSER/MPX) CHANNEL
MX0OPN::
PUSHJ P,SAVE2## ;SAVE P1,P2
ERRSET F%MPX,[0] ;START WITH CHANNEL 0
OPEN MX0,MX0BLK
POPJ P, ;ERROR RETURN
SKIPA T1,.+1 ;LOAD THE INPUT RING BUFFER POINTER
EXP BF.VBR!BF.IBC+MX0IBF##
MOVEM T1,MX0IN##+.BFADR;STORE
SKIPA T1,.+1 ;LOAD THE OUTPUT RING BUFFER POINTER
EXP BF.VBR!BF.IBC+MX0OBF##
MOVEM T1,MX0OUT##+.BFADR;STORE
MX1OPN::
ERRSET F%MPX,[1] ;CHANNEL 1
OPEN MX1,MX1BLK
POPJ P, ;ERROR RETURN
SKIPA T1,.+1 ;LOAD THE INPUT RING BUFFER POINTER
EXP BF.VBR!BF.IBC+MX1IBF##
MOVEM T1,MX1IN##+.BFADR;STORE
SKIPA T1,.+1 ;LOAD THE OUTPUT RING BUFFER POINTER
EXP BF.VBR!BF.IBC+MX1OBF##
MOVEM T1,MX1OUT##+.BFADR;STORE
REPEAT 0,< ;;; DON'T OPEN MORE THAN CURRENTLY NEEDED
;;; DON'T FORGET TO CHANGE PIENB FOR EACH WHEN NEEDED
MX2OPN::
ERRSET F%MPX,[2] ;MPX CHANNEL 2
OPEN MX2,MX2BLK
POPJ P, ;ERROR RETURN
SKIPA T1,.+1 ;LOAD THE INPUT RING BUFFER POINTER
EXP BF.VBR!BF.IBC+MX2IBF##
MOVEM T1,MX2IN##+.BFADR;STORE
SKIPA T1,.+1 ;LOAD THE OUTPUT RING BUFFER POINTER
EXP BF.VBR!BF.IBC+MX2OBF##
MOVEM T1,MX2OUT##+.BFADR;STORE
MX3OPN::
ERRSET F%MPX,[3] ;CHANNEL 3
OPEN MX3,MX3BLK
POPJ P, ;ERROR RETURN
SKIPA T1,.+1 ;LOAD THE INPUT RING BUFFER POINTER
EXP BF.VBR!BF.IBC+MX3IBF##
MOVEM T1,MX3IN##+.BFADR;STORE
SKIPA T1,.+1 ;LOAD THE OUTPUT RING BUFFER POINTER
EXP BF.VBR!BF.IBC+MX3OBF##
MOVEM T1,MX3OUT##+.BFADR;STORE
> ;;; END OF REPEAT 0
PJRST CPOPJ1## ;EXIT
MX0BLK: EXP UU.AIO!.IOASC
SIXBIT /MPX/
XWD MX0OUT##,MX0IN## ;RING HEADER
MX1BLK: EXP UU.AIO!.IOASC
SIXBIT /MPX/
XWD MX1OUT##,MX1IN## ;RING HEADER
MX2BLK: EXP UU.AIO!.IOASC
SIXBIT /MPX/
XWD MX2OUT##,MX2IN## ;RING HEADER
MX3BLK: EXP UU.AIO!.IOASC
SIXBIT /MPX/
XWD MX3OUT##,MX3IN## ;RING HEADER
SUBTTL MPPOPN ROUTINES TO OPEN THE MPP (PTY/MPX) CHANNEL
MPPOPN::
PUSHJ P,SAVE2## ;SAVE P1,P2
ERRSET F%OPN,MPPBLK+.OPDEV
OPEN MPP,MPPBLK
POPJ P, ;ERROR RETURN
SKIPA T1,.+1 ;LOAD THE INPUT RING BUFFER POINTER
EXP BF.VBR!BF.IBC+MPPIBF##
MOVEM T1,MPPIN##+.BFADR;STORE
SKIPA T1,.+1 ;LOAD THE OUTPUT RING BUFFER POINTER
EXP BF.VBR!BF.IBC+MPPOBF##
MOVEM T1,MPPOUT##+.BFADR;STORE
PJRST CPOPJ1## ;EXIT
MPPBLK: EXP UU.AIO!.IOASC
SIXBIT /MPX/
XWD MPPOUT##,MPPIN## ;RING HEADER
SUBTTL LOGOPN - OPEN THE LOGGING FILES
;SUBROUTINE LOGOPN - OPEN THE LOG FILE
;CALL MOVE P1,[POINTER TO THE FILE SPEC]
; PUSHJ P,LOGOPN
;RETURN CPOPJ ;CAN NOT OPEN
; CPOPJ1 ;FILE OPEN
LOGOPN::
PUSHJ P,SAVE2## ;SAVE P1,P2
LOGOP0: MOVE T1,(P1) ;GET THE DEVICE NAME
ERRSET F%CDO,T1 ;PUT IT INTO PLACE
DEVCHR T1, ;DEVICE CHARASTICS
TXNE T1,DV.MTA!DV.DSK!DV.PTP!DV.LPT!DV.TTY
TXNN T1,DV.OUT ;CAN THE DEVICE DO OUTPUT
POPJ P, ;ERROR RETURN
PUSH P,T1 ;SAVE THE DEVICE CHARASTICS
SKIPA T1,.+1 ;BUILD THE OPEN BLOCK
EXP .IOASC ;ASCII MODE
MOVE T2,(P1) ;DEVICE
SKIPA T3,.+1 ;BUFFER HEADERS
XWD LOGOTA##,LOGINA##
ERRSET F%OPN,T1+.OPDEV
OPEN LOG,T1 ;OPEN THE DEVICE
PJRST T1POPJ## ;
POP P,T1 ;RESTORE THE DEVICE CHARASTICS
PUSHJ P,BUFINT ;INITIALIZE BUFFER FOR USE
TXNN T1,DV.DSK ;IS THIS A DISK
JRST LOGOP4 ;NO, SKIP LOOKUP/ENTER SEQUENCE
MOVEI T2,.RBTIM+1 ;GET A FOUR WORDS LOOKUP BLOCK
ERRSET F%COR
PUSHJ P,GETWDS## ;ALLOCATE
POPJ P, ;ERROR RETURN
MOVEI P2,(T1) ;SAVE THE ADDRESS
HRLI T2,(T1) ;CLEAR OUT THE BLOCK
HRRI T2,1(T1) ;BUILD THE POINTER
SETZM (P2)
BLT T2,.RBTIM(P2) ;CLEAR THE BLOCK
MOVEI T1,.RBTIM ;GET THE LENGTH
MOVEM T1,.RBCNT(P2) ;STORE THE LENGTH
MOVE T1,1(P1) ;GET THE FILE NAME
MOVEM T1,.RBNAM(P2) ;STORE
HLLZ T1,2(P1) ;GET THE EXTENSION
MOVEM T1,.RBEXT(P2) ;STORE
MOVE T1,3(P1) ;PPN
MOVEM T1,.RBPPN(P2) ;STORE
LOOKUP LOG,(P2) ;LOOKUP UP THE FILE
SKIPA T1,.RBEXT(P2) ;GET THE ERROR CODE
JRST LOGOP1 ;OK ON THE LOOKUP
ANDI T1,-1 ;KEEP THE ERROR CODE
ERRSET F%LKP,T1 ;STORE PERTINENT DATA
CAIE T1,ERFNF% ;IS THE FILE MISSING
JRST LOGERR ;ERROR RETURN
HLLZS .RBEXT(P2) ;CLEAR THE ERROR CODE
ENTER LOG,(P2) ;ENTER THE FILE
JRST [ HRRZ T1,.RBEXT(P2)
ERRSET F%ENT,T1
PJRST LOGERR]
CLOSE LOG, ;CLOSE THE LOG FILE OUT
MOVEI T1,.RBTIM+1 ;RETURN THE FREE CORE
MOVEI T2,(P2) ;THE ADDRESS
PUSHJ P,GIVWDS## ;RETURN THE FREE CORE
JRST LOGOP0 ;TRY AGAIN
LOGERR: MOVEI T1,.RBTIM+1 ;ERROR RETURN THE FREE CORE
MOVEI T2,(P2) ;THE ADDRESS
PJRST GIVWDS## ;RETURN THE FREE CORE
LOGOP1: ;ENTER THE BLOCK IN UPDATE MODE
AOS .RBVER(P2) ;UPDATE THE VERSION NUMBER
ENTER LOG,(P2) ;DO THE ENTER
JRST [HRRZ T1,.RBEXT(P2)
ERRSET F%ENT,T1
JRST LOGERR]
SKIPN T1,.RBSIZ(P2) ;GET THE FILE SIZE
JRST LOGOP2 ;ZERO LENGTH SKIP USETO
IDIVI T1,^D128 ;NUMBER OF BLOCKS
SKIPE T2 ;ANY REMAINDER
ADDI T1,1 ;STEP A BLOCK
USETO LOG,1(T1) ;SET THE OUTPUT BLOCK
LOGOP2:
MOVEI T1,.RBTIM+1 ;RETURN THE FREE CORE
MOVEI T2,(P2) ;THE ADDRESS
PUSHJ P,GIVWDS## ;RETURN THE FREE CORE
LOGOP4:
SKIPA T1,.+1 ;GET THE RING HEADER
XWD 400000,LOGOBF##
MOVEM T1,LOGOUT## ;STORE THE RING HEADER
AOS (P) ;GOING TO GIVE GOOD RETURN
TXO OPRFLG,CMDLOG ;LOG FILE IS OPEN
PJSP T1,STRLOG## ;APPEND FOLLOWING TEXT AND RETURN
BYTE (7)15,12,14 ;ADD CR-LF-FF
;SUBROUTINE BUFINT - INITIALIZE BUFFER FOR LOG USE
;CALL MOVE T1,DEVICE STATUS
; PUSHJ P,BUFINT
;RETURN CPOPJ ALWAYS HERE
BUFINT:
SETZM LOGOBF##-1 ;CLEAR FLAG BITS
SKIPA T2,.+1
201,,LOGOBF## ;ASSUME DISK INITIALLY
TXNE T1,DV.TTY ;TTY DEVICE?
HRLI T2,24 ;YES-SET NEW LENGTH
MOVEM T2,LOGOBF## ;SAVE IN BUFFER
HLRZS T2 ;PUT SIZE+1 IN RIGHT HALF
SUBI T2,1 ;SUBTRACT 1
MOVEM T2,LOGOBF##+1 ;SAVE IN WORD 3
POPJ P, ;RETURN
SUBTTL JRNOPN - OPEN THE JRNGING FILES
;SUBROUTINE JRNOPN - OPEN THE JRN FILE
;CALL MOVE P1,[POINTER TO THE FILE SPEC]
; PUSHJ P,JRNOPN
;RETURN CPOPJ ;CAN NOT OPEN
; CPOPJ1 ;FILE OPEN
JRNOPN::
PUSHJ P,SAVE2## ;SAVE P1,P2
JRNOP0: MOVE T1,(P1) ;GET THE DEVICE NAME
ERRSET F%CDO,T1
DEVCHR T1, ;DEVICE CHARASTICS
TXNE T1,DV.MTA!DV.DSK!DV.PTP!DV.LPT
TXNN T1,DV.OUT ;CAN THE DEVICE DO OUTPUT
POPJ P, ;ERROR RETURN
PUSH P,T1 ;SAVE THE DEVICE CHARASTICS
SKIPA T1,.+1 ;BUILD THE OPEN BLOCK
EXP .IOIBN ;BINARY MODE
MOVE T2,(P1) ;DEVICE
SKIPA T3,.+1 ;BUFFER HEADERS
XWD JRNOUT##,JRNIN##
ERRSET F%OPN,T1+.OPDEV
OPEN JRN,T1 ;OPEN THE DEVICE
PJRST T1POPJ## ;ERROR RETURN
POP P,T1 ;RESTORE THE DEVICE CHARASTICS
TXNN T1,DV.DSK ;IS THIS A DISK
JRST JRNOP4 ;NO, SKIP LOOKUP/ENTER SEQUENCE
MOVEI T2,.RBTIM+1 ;GET A FOUR WORDS LOOKUP BLOCK
ERRSET F%COR
PUSHJ P,GETWDS## ;ALLOCATE
POPJ P, ;ERROR RETURN
MOVEI P2,(T1) ;SAVE THE ADDRESS
HRLI T2,(T1) ;CLEAR OUT THE BLOCK
HRRI T2,1(T1) ;BUILD THE POINTER
SETZM (P2)
BLT T2,.RBTIM(P2) ;CLEAR THE BLOCK
MOVEI T1,.RBTIM ;GET THE LENGTH
MOVEM T1,.RBCNT(P2) ;STORE THE LENGTH
MOVE T1,1(P1) ;GET THE FILE NAME
MOVEM T1,.RBNAM(P2) ;STORE
HLLZ T1,2(P1) ;GET THE EXTENSION
MOVEM T1,.RBEXT(P2) ;STORE
MOVE T1,3(P1) ;PPN
MOVEM T1,.RBPPN(P2) ;STORE
ERRSET F%LKP
LOOKUP JRN,(P2) ;LOOKUP UP THE FILE
SKIPA T1,.RBEXT(P2) ;GET THE ERROR CODE
JRST JRNOP1 ;OK ON THE LOOKUP
ANDI T1,-1 ;KEEP THE ERROR CODE
CAIE T1,ERFNF% ;IS THE FILE MISSING
JRST JRNERR ;ERROR RETURN
HLLZS .RBEXT(P2) ;CLEAR THE ERROR CODE
ERRSET F%ENT
ENTER JRN,(P2) ;ENTER THE FILE
JRST JRNERR ;ENTER ERROR
CLOSE JRN, ;CLOSE THE JRN FILE OUT
MOVEI T1,.RBTIM+1 ;RETURN THE FREE CORE
MOVEI T2,(P2) ;THE ADDRESS
PUSHJ P,GIVWDS## ;RETURN THE FREE CORE
JRST JRNOP0 ;TRY AGAIN
JRNERR:
HRRZ T1,.RBEXT(P2) ;GET REASON FOR FAILURE
ERRSET (,T1)
MOVEI T1,.RBTIM+1 ;ERROR RETURN THE FREE CORE
MOVEI T2,(P2) ;THE ADDRESS
PJRST GIVWDS## ;RETURN THE FREE CORE
JRNOP1: ;ENTER THE BLOCK IN UPDATE MODE
AOS .RBVER(P2) ;UPDATE THE VERSION NUMBER
ERRSET F%ENT
ENTER JRN,(P2) ;DO THE ENTER
JRST JRNERR ;ERROR RETURN
SKIPN T1,.RBSIZ(P2) ;GET THE FILE SIZE
JRST JRNOP2 ;ZERO LENGTH SKIP USETO
IDIVI T1,^D128 ;NUMBER OF BLOCKS
SKIPE T2 ;ANY REMAINDER
ADDI T1,1 ;STEP A BLOCK
USETO JRN,1(T1) ;SET THE OUTPUT BLOCK
JRNOP2:
MOVEI T1,.RBTIM+1 ;RETURN THE FREE CORE
MOVEI T2,(P2) ;THE ADDRESS
PUSHJ P,GIVWDS## ;RETURN THE FREE CORE
JRNOP4:
SKIPA T1,.+1 ;GET THE RING HEADER
EXP BF.VBR+JRNOBF##
MOVEM T1,JRNOUT## ;STORE THE RING HEADER
TXO OPRFLG,CMDJOR ;JOURNAL FILE IS OPEN
PJRST CPOPJ1## ;RETURN
SUBTTL ATOOPN - OPEN THE AUTOMATIC COMMAND FILES
;SUBROUTINE ATOOPN - OPEN THE ATO FILE
;CALL MOVE P1,[POINTER TO THE FILE SPEC]
; PUSHJ P,ATOOPN
;RETURN CPOPJ ;CAN NOT OPEN
; CPOPJ1 ;FILE OPEN
ATOOPN::
PUSHJ P,SAVE2## ;SAVE P1,P2
$SAY(<[MCSATO - Processing AUTO command file: >)
MOVEI T1,0(P1) ;GET ADDRESS OF FILE SPEC BLOCK
PUSHJ P,PUTSPC## ;OUTPUT IT
$SAY(<]@>) ;CLOSE THE MESSAGE UP
MOVE T1,0(P1) ;GET THE DEVICE NAME
ERRSET F%MDD,T1
DEVCHR T1, ;DEVICE CHARASTICS
TXNN T1,DV.DIR ;MUST BE DIRECTORY DEVICE
POPJ P, ;ERROR RETURN
PUSH P,T1 ;SAVE THE DEVICE CHARASTICS
SKIPA T1,.+1 ;BUILD THE OPEN BLOCK
EXP .IOASC ;ASCII MODE
MOVE T2,(P1) ;DEVICE
SKIPA T3,.+1 ;BUFFER HEADERS
XWD 0,ATOIN##
OPEN ATO,T1 ;OPEN THE DEVICE
PJRST T1POPJ## ;ERROR RETURN
MOVEI T4,T1 ;ARGUEMNT FOR DEVSIZ UUO
DEVSIZ T4, ;HOW BIG ARE THE BUFFERS
MOVEI T4,203 ;DON'T KNOW, TRY DISK SIZE
LSH T4,1 ;TWO BUFFERS
HRLZM T4,ATOOPR## ;STORE THE BUFFER SIZE
MOVEI T2,(T4) ;ALLOCATE FREE CORE
ERRSET F%COR
PUSHJ P,GETWDS## ;GET THE BUFFER SPACE
PJRST T1POPJ## ;NONE AVAILABLE
HRRM T1,ATOOPR## ;STORE THE BUFFER ADDRESS
MOVEM T1,.JBFF ;ALLOW MONITOR TO BUILD THE BUFFERS
INBUF ATO,1 ;TWO BUFFERS
SETOM .JBFF ;FIX JOBFF
POP P,T1 ;RESTORE THE DEVICE CHARASTICS
TXNN T1,DV.DSK ;IS THIS A DISK
JRST ATOOP4 ;NO, SKIP LOOKUP/ENTER SEQUENCE
MOVEI T2,.RBTIM+1 ;GET A FOUR WORDS LOOKUP BLOCK
ERRSET F%COR
PUSHJ P,GETWDS## ;ALLOCATE
POPJ P, ;ERROR RETURN
MOVEI P2,(T1) ;SAVE THE ADDRESS
HRLI T2,(T1) ;CLEAR OUT THE BLOCK
HRRI T2,1(T1) ;BUILD THE POINTER
SETZM (P2)
BLT T2,.RBTIM(P2) ;CLEAR THE BLOCK
MOVEI T1,.RBTIM ;GET THE LENGTH
MOVEM T1,.RBCNT(P2) ;STORE THE LENGTH
MOVE T1,1(P1) ;GET THE FILE NAME
MOVEM T1,.RBNAM(P2) ;STORE
HLLZ T1,2(P1) ;GET THE EXTENSION
MOVEM T1,.RBEXT(P2) ;STORE
MOVE T1,3(P1) ;PPN
MOVEM T1,.RBPPN(P2) ;STORE
ATOOP3: LOOKUP ATO,(P2) ;LOOKUP UP THE FILE
JRST ATOERR ;CAN NOT FIND FILE
MOVEI T1,.RBTIM+1 ;ERROR RETURN THE FREE CORE
MOVEI T2,(P2) ;THE ADDRESS
PUSHJ P,GIVWDS## ;RETURN THE FREE CORE
ATOOP4:
MOVE T1,ATOOPR## ;GET THE BUFFER ADDRESS
ADDI T1,1 ;POINT TO THE SECOND WORD
HRLI T1,(BF.VBR) ;VIRGIN RING
MOVEM T1,ATOIN## ;STORE THE RING HEADER
PJRST CPOPJ1## ;RETURN
ATOERR: MOVE T1,.RBEXT(P2) ;GET EXTENSION
JUMPN T1,ATOER1 ;SOMETHING, GIVE ERROR NOW
MOVSI T1,'ATO' ;TRY DEFAULT EXTENSION
MOVEM T1,.RBEXT(P2) ;STORE IN FILE BLOCK
JRST ATOOP3 ;TRY AGAIN
ATOER1:
HRRZ T1,.RBEXT(P2) ;GET ERROR CODE
ERRSET F%LKP,T1 ;SET UP ERROR MESSAGE
MOVEI T1,.RBTIM+1 ;ERROR RETURN THE FREE CORE
MOVEI T2,(P2) ;THE ADDRESS
PUSHJ P,GIVWDS## ;RETURN THE FILE LOOKUP BLOCK
PJRST ATOCLS ;CLOSE THE FILE
;SUBROUTINE ATOCLS - CLOSE THE ATO FILE
;CALL PUSHJ P,ATOCLS
;RETURN CPOPJ ;FILE CLOSED
ATOCLS::CLOSE ATO, ;CLOSE THE FILE
HRRZ T2,ATOOPR## ;GET THE BUFFER ADDRESS
HLRZ T1,ATOOPR## ;AND THE SIZE
SETZM ATOOPR## ;CLEAR THE FLAG
PJRST GIVWDS## ;RETURN THE FREE CORE AND RETURN
$LIT ;DO HIGH SEGMENT LITERALS
$LOW ;TO THE LOW SEGMENT
TWICE: ;HERE WHEN CORE IMAGE IS NOT FRESH AND START IS GIVEN
SKIPN RUNBLK+0 ;IF NO DEVICE, NOT SET UP FOR RECOVERY
JRST TWICE1 ;
OUTSTR [ASCIZ !
[MCSFCI FETCHING NEW CORE IMAGE]
!]
MOVEI T1,RUNBLK ;SET UP FOR RUN UUO
RUN T1, ;RUN IT
JRST .+1
TWICE1: OUTSTR [ASCIZ !
?MCSCRM COULD NOT RESTART MCS
!]
EXIT
RUNBLK: 0 ;DEVICE WE WERE RUN FROM
0 ;FILENAME
0 ;EXTENSION
0 ;0
0 ;PPN
0 ;CORE ASSIGNMENT
MNRFLG: -1 ;FLAG TO PREVENT RESTART ON CORE IMAGE
LIT
END ONCE ;DEFINE THE ENTRY POINT