Trailing-Edge
-
PDP-10 Archives
-
ap-c796e-sb
-
mic.mac
There are 19 other files named mic.mac in the archive. Click here to see a list.
TITLE MIC - MACRO INTERPRETED COMMANDS PETE HENRY/FRED BROWN/JOHN SERVICE
SUBTTL HATFIELD POLYTECHNIC COMPUTER CENTRE DEC 72
IFNDEF FT602,<FT602==-1> ;USE 6.02 STYLE TRMOP. UUO'S
;********************************************************************************
;
;
;******COPYRIGHT HATFIELD POLYTECHNIC COMPUTER CENTRE*********
;******1972,1973,1974,1975****************
;
;MIC was written at the HATFIELD POLYTECHNIC COMPUTER CENTRE
; THE HATFIELD POLYTECHNIC
; P.O. BOX 109
; HATFIELD
; HERTFORDSHIRE
; ENGLAND
;
;
;********************************************************************************
SEARCH MACTEN,UUOSYM
;ACCUMULATOR DEFINITIONS
F=0
BP=1
WD=2
CH=3
X=4
Y=5
T1=6
T2=7
T3=10
T4=11
P1=12
L=12
P2=13
S=13
P3=14
N=14
P4=15
N1=15
Z=16
R=16
P=17
;LDBMIC DEFINITIONS
LDLCHK==400000 ;SOME BIT SET IN LDBMIC 1-14
LDL.CC==200000 ;^C TYPED
LDL.OP==100000 ;OPERATOR CHAR SEEN IN COLUMN 1
LDL.ER==40000 ;ERROR CHAR SEEN IN COLUMN 1
LDL.CP==20000 ;^P TYPED
LDL.CB==10000 ;^B TYPED
LDL.XX==4000 ;SILENCE THIS LINE
LDL.MM==2000 ;LINE IN MONITOR MODE
LDL.TI==1000 ;LINE REQUIRES INPUT
LDL.TO==400 ;LINE HAS TO AVAILABLE
LDLCL1==400 ;LINE IS IN COL 1
LDL.CA==200 ;SET IF A ^A WAS TYPED
LDL.RS==100 ;LINE REQUIRES REPONSE ON ERROR
LDL.SY==40 ;ERROR CHAR. HAS REACHED INT LEVEL(RESPONSE)
LDL.LG==20 ;LOG FEATURE IS ENABLED
LDLCLR==LDLCHK!LDL.TO!LDL.TI!LDL.MM!LDL.CP!LDL.CB!LDL.OP!LDL.ER!LDL.CC!LDL.CA
LOC 124
MICTAT
LOC 137
VWHO==0 ;PETE & FRED 1 MEANS JS XPERMTL VERSION
VMIC==6 ;INTERPRETED IF/GOTO/BACKTO COMMANDS
VMINOR==0
IFN FT602,<VMINOR==1>
VEDIT==032 ;HATFIELD PATCH LEVEL
BYTE(3)VWHO(9)VMIC(6)VMINOR(18)VEDIT
RELOC
TWOSEG
RELOC 400000
-PCALEN,,PCA ;FACTS ABOUT PROCESS CONTROL AREA FOR
;THE USE OF OPERATOR CONTROL PROGGIE
-PDBSIZ,,PDB ;FOR USE OF OTHER JOBS WANTING TO RUN COJOBS
LDP.OP: POINT 7,S,21 ;BYTE POINTER TO THE OPER CHAR
LDP.ER: POINT 7,S,28 ;BYTE POINTER TO THE ERROR CHAR
LDPMJN: POINT 7,S,35 ;BYTE POINTER TO THE MASTER JOB NO.
LDPF: POINT 7,F,35 ;BYTE POINTER FOR SAVING CHAR. IN F
PEVNTN: POINT 6,T1,17 ;POINTER TO THE EVENT NUMBER
PACTNM: POINT 6,T1,11 ;POINTER TO THE ACTION NUMBER
;FLAG DEFINITIONS
FL.AST==1 ;SET IF AN ASTERISK SEEN AT START OF LINE
FL.LAB==2 ;SET ON FINDING A COLON
FL.BRK==4 ;SET IF BREAK SEEN
FL.MON==10 ;SET IF FORCING TO MONITOR MODE
FL.SMC==20 ;SET IF A COMMENT LINE WAS SEEN
FL.SAV==40 ;SET IF CHAR IN LOWER 7 BITS OF F
FL.CR==100 ;SET IF CR & LF TO BE IGNORED
FL.CRT==200 ;SET IF CR LAST CHAR TYPED
FL.INP==400 ;SET IF USER HAS AN I/P LINE ALREADY PREPARED IN PDB
FL.CB==1000 ;SET ON FINDING HE TYPED A ^B
FL.CMD==2000 ;SET IF A COMMAND WAS RECOGNISED
FL.XX==4000 ;SET IF WAS SILENCED WHEN BREAK OCCURED
FL.DOT=10000 ;SET IF A DOT WAS SEEN IN COLUMN 1
FL.PCT=20000 ;SET IF A %LABEL WAS READ
FL.CCM=40000 ;SET IF A ^C HAS BEEN ISSUED TO COJOB
FL.KJO=100000 ;SET IF KJOB/B HAS BEEN ISSUED TO COJOB
FL.TIM=400000 ;SET IF COJOB HAS HAD XTRA 10% TIME
; FLAG DEFNS. RIGHT HALF OF MASTER
FR.OWN==400000 ;SET IF A COJOB OWNER HAS GONE AWAY
FR.BAT==200000 ;SET IF THIS IS A BATCH JOB
FR.EOF==100000 ;SET IF EOF DETECTED ON INPUT
FR.CL1== 40000 ;SET IF INPUT FILE IS IN COLUMN ONE
FR.IF== 20000 ;SET IF NEXT I/P LINE IS IF (SOMETHING)
FR.JMP== 10000 ;SET IF NEXT I/P LINE IS GOTO/BACKTO
FR.DIS== 4000 ;SET IF DOING A DISPLAY AS A RESULT OF ".ON <EVENT>:DISPLAY A
;FLAG DEFINITIONS COMMON TO SLAVE AND MASTER
FL.MOP=200000 ;ENABLES MONADIC OPERATORS
;FLAG DEFINITIONS SLAVE REQUEST
FLS.PC==1 ;SET IF CLAIMED PROCESS AREA IN SLAVE REQUEST
FLS.CJ==2 ;SET IF PROCESSING COJOB REQUEST
FLS.BK==4 ;SET IF BREAK CHAR DETECTED ON I/P (NB. ==FL.BRK)
FLS.US==10 ;SET IF OTHER USERS ON SAME LINE
FLS.BR==20 ;SET IF SETTING UP A BATCH JOB
FLS.8==40 ;SET IF READING AN OCTAL NO.
FLS.BC==100 ;SET IF BATCH CONTROL
FLS.CCL==200 ;SET IF CCL ENTRY TO MIC
FLS.GD==400 ;SET IF GODLIKE ([1,2])
FLS.P1==1000 ;SET IF TRIED SUPERVISOR [PROJECT,1] AREA
FLS.BT==2000 ;SET IF PROCESSING A MIC BATCH REQUEST
FLS.IF==4000 ;SET IF PROCESSING A SLAVE MODE IF COMMAND WHICH HAS
; ".AND." OR ".OR." CONDITIONALS--(NON-NUMERIC ONES)
;IMMEDIATE MODE DEFINITIONS
ALT==33
ALT175==175
ALT176==176
BELL==7
CNTRLC==3
CNTRLB==2
CNTRLP==20
CNTRLZ==^D26
FF==14
LF==12
VT==13
CR==15
OPDEF PJRST [JRST]
IFE FT602,< ;OLD STYLE MIC UUO'S
OPDEF MIC[042000,,0] ;MIC UUO
>
IFN FT602,< ;NEW STYLE TRMOPS
DEFINE MIC(OP,AC)<
PUSHJ P,[PUSH P,AC
TRO AC,200000
HRRZM AC,MICBLK+1
MOVEI AC,OP+21
MOVEM AC,MICBLK
MOVEM AC+1,MICBLK+2
MOVE AC,[3,,MICBLK]
TRMOP. AC,
CAIA
AOS -1(P)
IFE <OP-1>,<
MOVE AC+1,MICBLK+2
>
IFE <OP-6>,<
MOVE AC+1,MICBLK+2
>
POP P,AC
POPJ P,]>
>
TYPE==0
GET==1
SET==2
CLEAR==3
DISPLAY==4 ;ARGUMENTS FOR MIC UUO
RESPONSE==5
; LOG==6
ARGNUM==^D26
; CONDITIONALS
FTMBCH==-1 ;=-1 IF MIC BATCH
FTCJOB==-1 ;-1 IF COJOBS
;DON'T INCLUDE FLASHY BITS ON STATUS COMMAND ETC.
FTRLSE==0 ;IF RELEASE VERSION
FTOLDL==0 ;SET TO -1 IF YOU DON'T WANT TO FORCE "::" ON LABELS
;(OLD VERSIONS OF MIC DID THIS)
FTAKJ==0 ;SET TO 1 TO TEST RELEASE VERSIONS OF MIC AT HATFIELD
FTLG56==-1 ;SPECIAL LOCATE STUFF FOR REMOTE STATIONS (LOGIN V56 REQD)
IFN FTRLSE,<
IFE FT602,<
IF2,<PRINTX RELEASE VERION 3. OF MIC>
>
IFN FT602,<
IF2,<PRINTX RELEASE VERSION 3A. OF MIC>
IF2,<PRINTX (USING TRMOP. STYLE MIC UUO'S)>
>
FTLG56==-1 ;ASSUME LOGIN V56 IF RELEASE
>
FTOPR==0 ;-1 IF MIC OPR COMMAND INCLUDED
IFE FTCJOB,<
IF2,<PRINTX MIC WITHOUT COJOBS BEING BUILT>
FTMBCH==0 ;CAN'T HAVE BATCH WITHOUT COJOBS
FTXPER==-1 ;=-1 ASSEMBLE EXPERIMENTAL STUFF
IFN FTRLSE,<FTXPER==0>
>
FTPSI==-1 ;IF SOFTWARE INTERRUPTS TO BE USED
FTPATH==0 ;SUPPORT FUNNY PATH STUFF
SFDLVL==6 ;MAX NESTING FOR SFDS(ONLY IF PATH STUFF SUPPORTED)
IMXLVL==^D50 ;INITIAL MAXIMUM NESTING FOR PROCESSES
MICDEV: 'MIC' ;IF ERSATZ DEVICE MIC IS DEFINED IN MONITOR
;OTHERWISE REDEFINED AS 'SYS' AT STARTUP
JIFFY: EXP ^D50 ;JIFFY VALUE FOR APPROPRIATE CLOCK
;RESET AT STARTUP TIME
IFN FTCJOB,< ;COJOB PARAMETERS INITIAL VALUES
IF2,<PRINTX MIC WITH COJOBS BEING BUILT>
ICJREQ==4 ;NO. OF COJOBS AVAILABLE AT STARTUP TIME
IDFTIM==^D60 ;DEFAULT RUN TIME FOR COJOBS AT STARTUP TIME
IMXTIM==^D600 ;MAXIMUM RUN TIME FOR COJOBS AT STARTUP TIME
>
IFN FTMBCH,<
IF2,<PRINTX INCLUDING SUPPORT FOR MIC BATCH.>
>
IFN FT602,<
IF2,<PRINTX USING TRMOP. STYLE MIC UUO'S>
>
;MIC PROFILE WORD BITS
;THERE IS ONE PROFILE WORD IN EACH PDB
;LEFT HALF
PL.CTL==200000 ;IF SET NO CONTROL CHARACTER SUBSTITUTION IS PERFORMED
PL.CL1==100000 ;IF SET NO COLUMN ONE CHECKING IS PERFORMED
PL.PRM==400000 ;IF SET NO PARAMETER SUBSTITUTION IS PERFORMED
PL.NSP==700000 ;TURN'S ALL OF ABOVE OF OR ON
PL.%FN==40000 ;IF SET DOES NOT CAUSE %FIN TO MATCH ANY LABEL
;RIGHT HALF
PR.TIM==400000 ;IF SET NO TIMESTAMPING IS PERFORMED
PR.LGN==200000 ;IF SET NO LOGGING IS DONE
PR.ALL==177777 ;OPPOSITE OF PR.LGN
IFN FTMBCH,<
;MIC BATCH WORD BITS
;ONE BATCH WORD IN EACH PDB--USED ONLY BY BATCH JOBS
;LEFT HALF
BTL.RQ==400000 ;REQUEST BIT
BTL.RN==200000 ;BATCH JOB RUNNING BIT
BTL.AS==100000 ;SET IF THIS BATCH JOB WAS CREATED BY ASPRIN
;RIGHT HALF
BTR.JB==777 ;MASK FOR BATCH CONTROLLER JOB NUMBER.
BATMST: POINT 9,BATWRD(X),35 ;POINTER TO BATCH CONTROLLER JOB NO.
>;END OF BATCH BITS
MIC: JRST MIC% ;NORMAL ENTRY
JRST CCLENT ;CCL ENTRY
IFN FTMBCH,< ;IF BATCH
JRST CMBENT ;DO A COMBAT STYLE ENTRY
>; END OF IF MIC BATCH
RESTRT: JRST GO%AGN ;RESTART
MIC%: RESET
RESCAN
MOVE [INCHWL CH]
MOVEM LOWIN ;LOW LEVEL I/P ROUTINE
SETZB F,CH.SAV ;CLLAR FLAG WORD AND CHARACTER BUFFER
MIC%1: MOVE T1,[OUTCHR CH]
MOVEM T1,LOWOUT ;CHAR. OUTPUT LOCATION
SKIPA P,[IOWD SIZ,STACK]
;HERE TO DISPATCH TO DEAL WITH COMMAND THAT INVOKED ME
.MIC: MOVEM CH,CH.SAV
PUSHJ P,FNDCMD ;GET THE USER'S COMMAND
SETO L, ;GET LINE NO.
GETLCH L
ANDI L,3777 ;GET RID OF UNIVERSAL BIT (NB IN 507)
REPEAT 0,<
PUSH P,T1 ;SAVE T1
>
MIC GET,L
REPEAT 1,<
SETZ S,
>
REPEAT 0,<
;THE FOLLOWING PIECE OF CODE IS DEFENSIVE AGAINST A LINE HAVING AN
;LDBMIC WORD SET UP - BUT NOT HAVING A PROCESS ARAE IN THIS MIC
SKIPA ;DOES NOT HAVE AN LDBMIC WORD ANYWAY
PUSHJ P,OTHUSR ;DOES HE HAVE A PROCESS AREA
JRST [SETZ S,
MIC SET,L
SETZ S,
JRST .+1]
; END OF DEFENSIVE BIT
POP P,T1 ;UNSAVEE T1
>
MOVE T2,MICTAB(T1) ;GET PROPER COMMAND NAME
MOVEM T2,LOWCMD ;AND REMEMBER FOR POSSIBLE ERROR MSG.
SKIPGE T1,DSPLST(T1) ;IF DISPATCH BIT SET
JUMPE S,LETER3 ;HE MUST BE RUNNING MIC
JRST (T1) ;ELSE DISPATCH
DEFINE CMD,< ;;**NB** THIS TABLE MUST BE IN STRICT ALPHABETICAL ORDER!!!
.. ABORT,MC!CJ!WH!ACT
.. BACKTO,MC!CJ!PRM!ACT!LBL
IFN FTMBCH,< .. BATCH >
.. BREAK,MC!CJ!WH!ACT
.. CANCEL,MC!CJ!WH!ACT
IFN FTCJOB,<.. COJOB >
.. DISPLAY,CJ!PRM!ACT
.. DO,CJ
.. ERROR,MC!CJ!WH!ACT
.. EXIT,CJ!ACT
.. GO,MC!CJ!PRM
.. GOTO,CJ!PRM!ACT!LBL
.. IF,MC!CJ
.. LET,MC!CJ
.. MIC,CJ
.. NOERROR,MC!CJ
.. NOOPERATOR,MC!CJ
.. ON,MC!CJ
.. OPERATOR,MC!CJ!WH!ACT
IFN FTOPR&FTCJOB,< .. OPR,MC >
.. PLEASE,MC!CJ
.. PROCEED,MC!CJ!WH!ACT
.. R
.. RESPONSE,MC
.. RETURN,MC!CJ!ACT
.. REVIVE,MC!CJ!ACT
.. RUN
.. SET,CJ
.. SILENCE,MC!CJ!ACT
.. START
.. STATUS
.. TYPE,MC!CJ!PRM!ACT
.. WH
.. WHAT,MC!CJ
.. WHENEVER,MC!CJ
>
IFN FTCJOB,< ;COJOB STUFF
NO.ARG==400000 ;SWITCH HAS NO ARGUMENTS
LM.BIT==200000 ;SWITCH HAS LIMITS
DEFINE SWTCH,< ;;**NB** THIS TABLE MUST BE IN STRICT ALPHABETICAL ORDER
.. TIME,NUMBR,LM.BIT ;;RUN TIME
.. VD,CHRCTR ;;DIPOSAL OF LOG FILE
.. ZQ,CHRCTR ;;DEGREE OF QUEING FOR LOG FILE
>
>
DEFINE ..(A,B),<<SIXBIT/'A/>>
IFWD: SIXBIT/IF/ ;FOR USE IN IF CHECKING
MICTAB: CMD
CMDSIZ=.-MICTAB
SIXBIT @/@ ;FOR USE BY ERROR MSG STUFF.
IFN FTCJOB,< ;MORE COJOB STUFF
;SWITCHES FOR COJOB REQUESTS
DEFINE ..(A,B,C),<SIXBIT/'A/>
SWTAB: SWTCH
TABSWT=.-SWTAB
>
.....==0 ;SOMETHING TO MAKE MACRO DEFINITION MORE UNDERSTANDABLE
;DISPATCH BITS FOR COMMAND DECODE
MC==400000 ;MUST BE RUNNING MIC
CJ==200000 ;LEGAL IN OWNER COJOB CONTROL
WH==100000 ;WHENEVER EVENT
ACT==40000 ;ACTION ON EVENT
PRM==20000 ;REQUIRES PARAMETERS IF USED AS AN EVENT
LBL==10000 ;IF PARAMETER IS A LABEL OTHERWISE A VARIABLE
EVNTNM==0 ;FIRST EVENT IS EVENT ZERO
ACTNUM==0 ;FIRST ACTION IS ACTION ZERO
DEFINE ..(...,....<.....>),<
......==....
IFN ......&WH,<......=......!EVNTNM
EVNTNM=EVNTNM+1>
IFN ......&ACT,<......=......!<<ACTNUM>B29>
ACTNUM=ACTNUM+1>
......,,.'...>
DSPLST: CMD
;HERE ON "/" AND "@" COMMANDS
JRST SLASH ;LET HIM INTRODUCE HIS COMMAND
IFN FTCJOB,< ;YET MORE COJOB STUFF
.NUMBR==N
.CHRCTR==T4
;THE ABOVE SPECIFIES WHICH ACC. THE RESULT IS IN
DEFINE ..(....,...<.....>,L<.....>),<'L'!.'...,,...>
DSPSWT: ;DISPATCH TABLE FOR SWITCHES
SWTCH
>
;MAKE UP A DEFAULT ACTION TABLE USED FOR WHENEVER EVENTS
;THIS DEFAULT TABLE IS PRELOADED INTO EVERYBODIES PDB
;ON THEIR STARTING TO RUN A MIC PROCESS.
;THE DEFAULT SETTINGS MAY BE MODIFIED BY USING A WHENEVER
;OR ON COMMAND
DEFINE .. (....,...<.....>),<
......==...
IFN ......&WH,<
JRST '....
BLOCK 1
> ;END OF MACRO TO DEF TABLE
>
DEFVNT: CMD ;HERE STARTETH THE TABLE
;MAKE UP A DISPATCH TABLE FOR ALL ACTIONS
;I.E WHEN AN ACTION IS TO BE PRFORMED THIS TABLE TELLS
;US WHERE TO GO.
DEFINE .. (....,...<.....>),<
......=...
IFN ......&ACT,<
IFE ......&PRM,<
JRST %.'....
>
IFN ......&PRM,<
PUSHJ P,%.'....
> > >
DSPACT: CMD ;DISPATCH TABLE FOR ALL ACTIONS
SUBTTL SLAVE PROCESSOR - RECORD USER COMMAND
IFN FTCJOB,< ;COJOBS
IFE FTMBCH,<XLIST>
IFN FTMBCH,< ;MIC BATCH FEATURE
.BATCH: TLO F,FLS.BT ;SAY WE IS BATCH
MOVE T1,[ASCII/BATCH/]
MOVEM T1,BUFFER ;STORE COMMAND IN Q'S INPUT BUFFER
MOVE T1,[POINT 7,BUFFER+1]
MOVEM T1,BUFBP ;SET UP POINTER TO THE INPUT BUFFER
TLNE F,FLS.CCL ;CCL ENTRY (MAY WANT THIS?)
SKIPA T1,[PUSHJ P,BCHRDX]
MOVE T1,[PUSHJ P,BCHRD]
MOVEM T1,LOWIN ;SPECIAL LOW-LEVEL I/P ROUTINE FOR BATCH
PUSHJ P,BCHRD+1 ;DEAL WITH CURRENT CHAR. (MAY BE SIGNIF.)
JRST BCJOB ;THEN PRETEND TO BE COJOB
> ;END OF MIC BATCH CONDITIONAL
LIST
.COJOB:
SETZ F,
BCNTL: SETO T1,
GETLCH T1
TDNE T1,WHONOT ;DECIDE WHO MAY HAVE COJOB
JRST CJNOTU
BCJOB: TLO F,FLS.CJ ;SAY WE ARE PROCESSING A COJOB RQST.
MOVEM CH,CH.SAV
PUSHJ P,WDREAD
CAIN CH,"-" ;IF ITS A COJOB CONTROL
JRST CJCNTL ;MAY BE COJOB CONTROL
MOVN N,COJOBN ;HOW MANY COJOBS AVAILABLE
SUB N,CJUP ;LESS HOW MANY IN USE
IFN FTMBCH,< ;IF BATCH
TLNN F,FLS.BT ;ARE WE BATCH REQUEST
> ;END OF BATCH
JUMPLE N,NOCJBS ;ARE THERE ANY LEFT
HRLOI T1,'L00'
MOVEM T1,LEXT
GETPPN T1,
JFCL
IFN FTMBCH,<
TLNE F,FLS.BT ;A BATCH REQUEST
MOVE T1,QUEPPN ;YES -LOG DEFAULT IS QUE DEVICE
> ;END OF BATCH BIT
MOVEM T1,LPPN
; MOVEM CH,CH.SAV ;MAY BE A "="
PUSHJ P,INSPC0 ;READ LOGFILE/DEV SPEC.
JRST LGFERR ;NOTA NICE ONE
SETZM CH.SAV
CAIN CH,"]" ;HE MAY HAVE SUPPLIED A LOGPPN
PUSHJ P,CHARIN
CAIN CH,"/" ;ANY SWITCHES?
PUSHJ P,RDSWCH ;YES--GET THEM
CAIE CH,"=" ;MACRO NAME YET!
IFE FTMBCH,< ;IF NOT BATCH
JRST SWTERR ;NO---ERROR
> ;END OF IF NOT BATCH
IFN FTMBCH,< ;IF BATCH
JRST [TLNE F,FLS.BT ;IF BATCH REQUEST
JRST CALLQ3 ;ALLOW FOR BATCH/L<BREAK>
JRST SWTERR] ;ERROR
>
> ;END OF COJOB CONDITIONAL
;HERE TO PROCESS COMMANDS WHICH START A MIC MACRO OFF
;ON THE GUY'S TERMINAL
.DO: ;AS FAVOURED BY DEC
SLASH: ;HATFIELD
AT: ;OTHER PEOPLES
SKIPN MASTNO ;IS THE MASTER RUNNING?
JRST NOMSTR
JRST OKPDB
IFE FTMBCH,<XLIST>
IFN FTMBCH,< ;BATCH BIT
;SPECIAL ENTRY HANDLING STUFF FOR COMBAT
CMBENT: MOVE P,P..SAV ;USE COMBAT'S STACK
POP P,F
TLNN F,FLS.BR ;IS IT BATCH
JRST SLENDX ;NO
TLNE F,FLS.BC ;BATCH CONTROL
JRST [RESCAN
SETZB CH,CH.SAV
PUSHJ P,WDREAD
CAIE CH,"-"
JRST [PUSH P,[EXP .MIC+2]
JRST FNDCMD+1]
TLO F,FLS.CJ
JRST CJCNTL
]
SETO T1,
HRRI T1,.GTPRG ;GETTAB TABLE
GETTAB T1,
SETZ T1, ;DEFENSIVE
CAME T1,[SIXBIT/COMBAT/]
JRST SLENDX
SETZ T1,
SETUWP T1,
HALT
MOVNI X,PDB ;SET UP DUMMY X
ADDI X,DUMPDB
MOVE T1,BATOPR ;BATCH OPERATOR
MOVEM T1,LINE(X) ;AND PRETEND HE IS THE OWNER
MOVSI T1,DEFVNT ;FIX UP DEFAULT ACTIONS
HRRI T1,FSTVNT(X)
BLT T1,LSTVNT(X) ;MUST BE DONE HERE AS MIC MAY HAVE CHANGED
JRST OK3 ;SET UP A BATCH JOB
> ;END OF BATCH BIT
LIST
;HERE TO PERFORM A CCL STYLE ENTRY ON MIC
;IE READ I/P FROM TMPCOR OR FROM nnnMIC.TMP
;INSTEAD OF FROM TTY
CCLENT: MOVSI T2,'MIC' ;NAME OF TMPCOR FILE
MOVE T3,[IOWD 77,TMPCBF] ;TMPCOR BUFFER
MOVE T1,[.TCRRF,,T2] ;OPERATION CODE
TMPCOR T1, ;DO IT
SKIPA ;NUFFIN
JRST GOTTMP ;GOT IT
MOVEI T1,17 ;DUMP MODE
MOVSI T2,'DSK' ;DEVICE
SETZB T3,T4 ;DBUFFER SPACE ETC.
OPEN 1,T1 ;GET THE DEV.
JRST CCLERR ;OOOOOOPS!!
PJOB T1, ;GET JOB NO.
PUSHJ P,.MKPJN ;MAKE A FUNNY FILE (nnnMIC)
HRRI T1,'MIC'
MOVSI T2,'TMP' ;WIF THIS EXTENSION
SETZB T3,T4
LOOKUP 1,T1 ;IS IT THERE?
JRST CCLERR ;NO!!!!
MOVE T1,[IOWD 77,TMPCBF] ;READ IT
SETZ T2,
INPUT 1,T1
SKIPA ;SUCCESS
JRST CCLERR ;FAILURE
RELEASE 1,
GOTTMP: MOVE T1,[PUSHJ P,CCLIN]
MOVEM T1,LOWIN ;SET UP SPECIAL LOW LEVEL I/P ROUTINE
SETZB F,CH.SAV ;CLEAR FLAG WORD AND CHAR BUFFER
TLO F,FLS.CCL ;AND REMEMBER CCL STYLE ENTRY
MOVE T1,[POINT 7,TMPCBF] ;VIRGIN POINTER
MOVEM T1,TMPCPT ;FOR I/P ROUTINE
SETZM TMPCPT-1 ;MAKE SURE BUFFER ENDS WITH ZERO BYTE
JRST MIC%1 ;AND BACK TO COMMON STUFF
;LOW LEVEL I/P ROUTINE USED BY CCL ENTRIES
;IF MODIFIED WATCH YOU DON'T CLOBBER BATCH I/P ROUTINE
CCLIN: ILDB CH,TMPCPT ;GET A CHAR
JUMPN CH,CPOPJ ;NICE ONE
MOVEI CH,ALT ;FORCE BREAK ON ZERO BYTE
POPJ P,0
CCLERR: OUTSTR [ASCIZ@
?(CCLERR)MIC FAILED TO GET ANY CCL I/P@]
JRST SLENDX
IFE FTCJOB,<XLIST>
IFN FTCJOB,<
; A ROUTINE TO READ THE SWITCHES FOR A COJOB REQUEST
RDSWCH: SETZB CH,CH.SAV ;GET RID OF /
RDSWC1: PUSHJ P,WDREAD ;READ SWITCH NAME
PUSHJ P,SWCHK ;CHECK IT
PUSHJ P,SWTARG ;GET SWITCH ARGUMENT
CAIN CH,"/" ;ANY MORE
JRST RDSWC1 ;YEA
POPJ P,0 ;NO
;A ROUTINE TO READ IN A NUMBER IN THE FORM
; N
;OR NK (N*1000)
;OR N:N:N (IE (N*60)+N)*60+N
NUMBR: PUSHJ P,INTIN ;GET A NO.
SKIPN N1 ;WE DID?
POPJ P,0 ;NOOO
CAIN CH,"K" ;TERMINATED BY A K
JRST M1000 ;YES NO.*1000
CAIN CH,":" ;TERMINATED BY A:
PUSHJ P,M60 ;YES NO.*60
JRST CPOPJ1 ;ANYTHING ELSE FINISH
M1000: IMULI N,^D1000
PJRST CHARIN ;READ NEXT CH
M60: IMULI N,^D60
PUSH P,N ;SAVE VALUE UP TO KNOW
PUSHJ P,DECIN ;GET ANOTHER NO.
CAIE CH,":" ;AGAIN?
JRST [POP P,N
POPJ P,0]
ADDM N,(P)
POP P,N
PUSHJ P,M60 ;DO IT
POPJ P,0
; A ROUTINE TO READ A SINGLE CHARACTER AND STORE IT IN T4
; THEN READ THE NEXT AND STORE IT IN CH
CHRCTR: PUSHJ P,CHARIN ;GET THE CHARACTER
MOVEM CH,T4 ;PUT IT IN ITS PLACE
PJRST CHARIN ;AND DO THE REST
;A ROUTINE TO HANDLE SWITCH ARGUMENTS
SWT.AC: POINT 4,T2,17 ;POINTER TO THE AC IN DSPSWT
SWTARG: SKIPG T2,DSPSWT(T1) ;LOOK AT THE DISPATCH BITS
JRST SWTRG1 ;NO ARGS
CAIE CH,":" ;O.K
JRST SWTERR
PUSH P,T1 ;MUST SAVE THE INDEX
PUSHJ P,(T2) ;GET THE ARG
JFCL ;DEFENSIVE(TEMPORARY)
POP P,T1 ;RESTORE T1
LDB T3,SWT.AC
PUSH P,(T3)
PUSHJ P,PRVCHK ;IS HE GOD LIKE
TLNE F,FLS.BT ;OR IS THIS A BATCH REQUEST
JRST SWTRG2 ;THEN HE MAY DO ANYFING
MOVSI T4,LM.BIT
TDNN T4,DSPSWT(T1) ;REQUIRE LIMIT CHECKING?
JRST SWTRG2 ;NO
HLRE T4,SWTLIM(T1) ;GET MAX. LIMIT
JUMPL T4,SWTRG3 ;IF -VE NO LIMIT
CAMGE T4,(P) ;DO WE EXCEED IT
JUMPG T4,MAXWRN ;YES
SWTRG3: HRRE T4,SWTLIM(T1) ;GET MIN. LIMIT
JUMPL T4,SWTRG2 ;IF -VE NO LIMIT
CAML T4,(P) ;ARE WE TO SMALL
JUMPGE T4,MINWRN ;YEP
SWTRG2: POP P,T3
MOVEM T3,LOWSWT(T1) ;PUT IT IN THE LOW SEG FOR NOW
POPJ P,0
MAXWRN: OUTSTR [ASCIZ/
%MAXWRN SWITCH ARGUMENT EXCEEDS MAXIMUM VALUE/]
MOVEM T4,(P) ;GIVE HIM THE LIMIT
JRST SWTRG2
MINWRN: OUTSTR [ASCIZ/
%MINWRN SWITCH ARGUMENT IS LESS THAN MINIMUM VALUE/]
MOVEM T4,(P) ;GIVE HIM THE LIMIT
JRST SWTRG2
SWTRG1: POPJ P,0 ;RESERVED FOR FUTURE
; A ROUTINE TO CHECK FOR VALID SWITCHES
SWCHK: MOVE T1,[-TABSWT,,SWTAB] ;ARG FOR SEARCH
PUSHJ P,FNDNAM ;SEARCH
IFE FTMBCH,< ;IF NOT BATCH
JRST SWTERR ;FAILED
> ;END OF IF NOT BATCH
IFN FTMBCH,< ;IF BATCH
JRST SWCHK1 ;MAY NOT BE AN ERROR
> ;END OF IF BATCH
HRRZ T1,T1 ;JUST WANT INDEX
POPJ P,0
IFN FTMBCH,< ;BATCH BIT
;HERE WE COME IF WE HAVE AN UNKNOWN SWITCH. IF WE ARE A BATCH JOB
;WE WILL LET IT PASS(QUEUE/SCAN WILL CHECK IT).
SWCHK1: TLNN F,FLS.BT ;IS THIS A BATCH REQUEST
JRST SWTERR ;NO-- ITS AN ERROR!
LSH WD,-^D22 ;GET FIRST TWO CHARACTERS OF SWITCH
CAIN WD,"LO" ;DOES IT LOOK LIKE A LOG SWITCH
JRST SWCHK2 ;OK -NO SPECIAL TREATMENT
LSH WD,-7 ;JUST THE FIRST CHARACTER NOW
CAIE WD,"M" ;MODIFY SWITCH?
CAIN WD,"K" ;KILL SWITCH?
JRST CALLQ3 ;ONE OF THESE
CAIN WD,"L" ;SOME FLAVOUR OF LIST SWITCH?
JRST CALLQ3 ;LOOKS LIKE ONE
SWCHK2: CAIE CH,"/" ;SKIP OVER SWITCH ARG. (IF ANY)
CAIN CH,"="
JRST CPOPJ1 ;AND RETURN
SKPINC ;ANY MORE TO READ?
JRST CPOPJ1 ;NO
PUSHJ P,CHARIN ;YES--SO READ IT
JRST SWCHK2 ;AND SEE IF DUN NOW
> ;END OF BATCH BIT
; A ROUTINE TO CHECK IF A LOG SPEC IS LEGAL
CHKFIL: MOVE T3,LDEV ;WHATS THE LOG DEV.
MOVEI T2,17 ;MODE
SETZ T4,
MOVEI BP,LGDERR ;PREPARE THE ERROR MESG.
OPEN 1,T2
JRST CPOPJ ;OOPS
MOVE T1,LFILE ;GET FILE NAME
MOVE T4,LPPN ;AND PPN
MOVE N,LEXT ;GET CURRENT EXTENSION
TRNN N,-1 ;DID HE SAY IT
JRST HESAID ;YES-DONT MAKE UP UNIQUE
HLRZS N
MOVEI BP,LFLERR ;ERROR MESS.
L00PLS: TRZE N,10 ;CHECK FOR SIXBIT 8
ADDI N,100 ;CAUSE IT'S NOT ALLOWED
TRZE N,1000 ;CHECK FOR SIXBIT 80
POPJ P,0 ;CAUSE THATS AN ERROR!
SETZ T3,
MOVE T4,LPPN ;RESET THE PPN
MOVS T2,N
LOOKUP 1,T1 ;DOES IT EXIST
SKIPA ;PROBABLY NOT
AOJA N,L00PLS ;TRY NEXT
TRNE T2,-1 ;JUST IN CASE SOME OTHER ERROR
JRST CPOPJ ;YES OOOPS
MOVE T4,LPPN ;RESET THE PPN
SKIPA
HESAID: HLRZS N
SETZ T3, ;PREPARE TO CHECK HE CAN ENTER IT
HRLZ T2,N
HRLZI T3,001000 ;LOW PROTECTION FOR LOG FILES
MOVEI BP,LFEERR ;ERROR MESS
ENTER 1,T1 ;TRY
JRST CPOPJ ;OH DEAR
HRLZM N,LEXT ;STORE THE EXT.
HRLZM N,LGSPEC+2(X)
CLOSE 1,20 ;UNCLE PETER SAYS THIS IS A CLEVER WAY TO CLOSE
AOS (P)
POPJ P,0 ;ALL WELL
LIST
> ;END OF FTCJOB
OKPDB: MOVNI X,PDB ;SET UP SLAVE X
ADDI X,DUMPDB
IFN FTCJOB,<
TLNN F,FLS.CJ ;IS WE A COJOB
JRST OKPDB1
MOVEI T1,LGSPEC(X) ;PREPARE TO MOVE LOGFILE SPEC TO PDB
HRLI T1,LDEV ;FROM HERE
BLT T1,ENDSWT(X) ;DO IT IT TO HERE
>;END OF COJOB BIT
OKPDB1: PJOB N1,
GETPPN N,
JFCL
SETZM LPPN ;TEMP STORAGE FOR DEV FILE SPEC
MOVEM N,OPPN(X)
MOVEM N1,JOB(X) ;JS BIT
MOVEM N1,OJOB(X) ;IN CASE COJOB
MOVEM L,LINE(X)
IFN FTCJOB,< ;COJOBS?
TLNE F,FLS.CJ ;ARE WE DOING A COJOB REQUEST
SETOM COJOB(X) ;REQUEST FOR COJOB SERVICE
> ;END OF COJOB CONDITIONAL
IFN FTMBCH,< ;IF BATCH
;WE INSIST THAT ALL BATCH JOBS MUST SPECIFY A CONTROL FILE
;I.E BATCH=<BREAK> IS ASSUMED TO BE QUEUE CONTROL
TLNN F,FLS.BT ;IS THIS A BATCH REQUEST
JRST OKPDB4 ;NO
MOVSI WD,'DSK' ;YES-DEFAULT DEVICE IS DISK
MOVEM WD,LDEV
MOVSI WD,'MIC' ;DEFAULT EXTENSION IS MIC
MOVEM WD,LEXT
SETZM LFILE ;NO DEFAULT FILE!
PUSHJ P,WDREAD ;GET FILENAM (IF ANY)
JUMPE WD,CALLQ3
PUSHJ P,INSPC0 ;READ WHAT HE SAID
JRST ERR ;HE GOT IT RONG
SKIPN LFILE ;DID HE SAY A FILE
JRST CALLQ3 ;NO LET QUEUE DEAL WIF IT
JRST OKPDB5 ;YES
OKPDB4:
> ;END OF BATCH CONDITIONAL
PUSHJ P,INSPEC
JRST ERR
OKPDB5: MOVEI T1,DEV(X) ;PUT DEV:MACRO.EXT[PPN] IN PDB
HRLI T1,LDEV ;FROM LOW SHARED AREA
BLT T1,PPN(X)
PUSHJ P,CHARIN ;GET NEXT SIGNIFICANT CHARACTER....
MOVEM CH,CH.SAV ;...AND SAVE IT FOR PARAMETER DECODE
SUBTTL SLAVE PROCESSOR - LOOKUP FILE
FINDFL: MOVE T3,DEV(X) ;GET DEVICE
FNDFL0: MOVEI T2,17 ;BINARY MODE
SETZ T4,
OPEN T2 ;AND OPEN IT
JRST NOTDEV ;HARD LUCK.
MOVE T1,PPN(X)
MOVEM T1,FILBLK+1
FNDFL1: MOVEI T1,32 ;NO OF ARGS FOR EXTENDED LOOKUP
MOVEM T1,FILBLK
MOVE T1,FILE(X)
MOVEM T1,FILBLK+2
MOVE T1,EXT(X)
MOVEM T1,FILBLK+3
LOOKUP FILBLK ;LOOKUP FILE
JRST [MOVE T2,DEV(X) ;GET DEVICE
CAMN T2,MICDEV ;WAS IT MIC?
JRST NOTFIL ;YES DUN TRYIN
SKIPE PPN(X) ;WAS HE SPECIFIC ABOUT THE PPN
JRST NOTFIL ;YES DONT HELP HIM
TLOE F,FLS.P1 ;ALREADY TRIED [PROJ,1]
JRST NOTFIL ;YES SO NO SUPERVISOR CHECK
HLLZ T1,OPPN(X) ;NO SO TRY TO FIND MACRO ON HIS
HRRI T1,1 ;SUPERVISORS AREA ([PROJECT,1])
MOVEM T1,FILBLK+1 ;STORE IN LOOKUP BLOCK
JRST FNDFL1 ] ;NOT THERE
MOVE T1,FILBLK+1
MOVEM T1,PPN(X) ;NOW COPY ARGS BACK
MOVE T1,FILBLK+16
MOVEM T1,DEV(X) ;WHAT UNIT FILE IS ON.
IFN FTCJOB,<
TLNE F,FLS.CJ
JRST RDPAR0 ;NOTHING FANCY IF COJOB REQUEST
>;END OF COJOB BIT
MOVEM S,LDBMIC(X) ;STORE HIS OLD LDBMIC
TLZ S,LDLCLR ;CLEAR VOLATILE BITS
TDO S,MASTNO
LDB T2,[POINT 3,FILBLK+4,2]
CAIN T2,2
TLO S,LDL.XX ;IF PROTECTION IS 2?? SILENCE
IFN FTCJOB,< ;COJOB BIT
JRST RDPAR
;JUST CHECK IF HIS LOG SPEC IS OK
RDPAR0: SKIPE T1,LGSPEC(X) ;DID HE SPECIFY
JRST OKPDB2 ;YES
SETO T1, ;NO
MOVEI T4,T1
JOBSTR T4, ;GET FIRST STRUCTURE ON HIS SEARCH LIST
MOVSI T1,'DSK' ;DEFENSIVE
MOVEM T1,LGSPEC(X)
OKPDB2: MOVEM T1,LDEV
SKIPE T1,LGSPEC+1(X) ;DID HE SPECIFY LOG FILE
JRST OKPDB3 ;YES
MOVE T1,LFILE ;NO-THEN USE MACROFILENAME
MOVEM T1,LGSPEC+1(X) ;AS DEFAULT
SKIPA
OKPDB3: MOVEM T1,LFILE
MOVE T1,LGSPEC+2(X) ;GET HIS LOG EXT. (DEFAULT SET BEFORE)
MOVEM T1,LEXT
MOVE T1,LGSPEC+3(X) ;GET LOGPPN
MOVEM T1,LPPN
PUSHJ P,CHKFIL ;CHECK IT
JRST ERLGFL ;NOT GOOD
>;END OF COJOB BIT
SUBTTL SLAVE PROCESSOR - READ ARGUMENTS
CHCNT==P3
BRKCNT==T2
PARCNT==T3
RDPAR: MOVEI CHCNT,ARGNUM*4*5-2 ;MAX CHARS.
CLEAR BRKCNT, ;CLEAR BRACKET COUNT
MOVE BP,[POINT 7,0]
ADDI BP,ARG(X) ;SET UP BYTE POINTER
MOVEI T4,ARGBP(X) ;AND PARAMETER TABLE POINTER
CLEAR PARCNT, ;CLEAR PARAMETER COUNT
NXTPAR: MOVEM BP,(T4) ;STORE BYTE POINTER
ADDI T4,1 ;AND INCREMENT
SETZ T1, ;NO OF CHARS / PAR.
NXTCHR: SOJLE CHCNT,OFLOW ;TOO MANY CHARS ON LINE?
PUSHJ P,PINCH
CAIN CH,"," ;COMMA?
JRST COMMA ;YES - GO DEAL
CAIN CH,"<" ;BRACKET?
JRST OANBRK ;YES
CAIN CH,"["
JRST OPBRK
CAIN CH,"("
JRST OPBRK
CAIN CH,">" ;CLOSE BRACKET?
JRST CANBRK ;YES
CAIN CH,"]"
JRST CLBRK
CAIN CH,")"
JRST CLBRK
PUSHJ P,ISBRK ;BREAK CHAR?
JRST CRLF ;YES
SKIPA ;NORMAL CHARACTER - SKIP
OPBRK: AOJ BRKCNT, ;BUMP BRACKET COUNT
IDPB CH,BP ;STORE CHAR
AOJA T1,NXTCHR ;AND READ NEXT
CLBRK: SOJGE BRKCNT,OPBRK+1 ;DECREMENT BRKCNT & STORE IF GE ZERO
JRST BRKMIS ;OTHER WISE ERROR
COMMA: JUMPN BRKCNT,OPBRK+1 ;IGNORE IF WITHIN BRACKETS
CLEAR CH, ;LOAD A NULL
IDPB CH,BP
AOJ PARCNT, ;INCREMENT THE PARAMETER NUMBER
CAILE PARCNT,ARGNUM-1
JRST TOOMNY ;TOO MANY PARAMETERS
JUMPN T1,NXTPAR ;GO READ NEXT PARAMETER IF NOT NULL
SETZM -1(T4) ;OTHERWISE CLEAR THE BYTE POINTER
JRST NXTPAR ;OTHERWISE CLEAR THE POINTER FIRST
OANBRK: JUMPN BRKCNT,OPBRK ;NOT FIRST ONE TREAT AS NORMAL
AOJA BRKCNT,NXTCHR ;OTHERWISE BUMP COUNT & IGNORE CHAR
CANBRK: SOJG BRKCNT,OPBRK+1 ;NOT LAST BRACKET TREAT AS NORMAL
JUMPE BRKCNT,NXTCHR ;LAST ONE - IGNORE CHAR
JRST BRKMIS ;OTHERWISE MISMATCH OF BRACKETS.
CRLF: JUMPN T1,.+2 ;WAS THE LAST PARAMETER NULL?
SETZM -1(T4) ;YES - CLEAR IT DOWN
IFN FTCJOB,<
CAIN CH,CR ;WAS EOL CHAR A <CR>
PUSHJ P,CHARIN ;THEN GOBBLE THE <LF>
TLNE F,FLS.CJ
JRST OK2 > ;IF COJOB NO OTHER PROCESS
CLRBFI ;CLEAR THE INPUT BUFFER
PUSHJ P,OTHUSR ;SUSPEND OTHER PROCESSES WITH SAME LINE
JRST OK2 ;NO OTHER USERS
HLRZ T3,LAST(T2) ;GET HIS LEVEL
HRLZM T3,LAST(X)
SUB T3,MAXLVL ;COMPARE WITH MAX
SKIPL MAXLVL ;-VE LEVEL MEANS INFINITY
JUMPG T3,E%%LVL ;TOO DEEP
SETZ T1,
SETUWP T1,
HALT
MOVNM T4,FLAG(T2)
SETUWP T1,
HALT
MOVE T1,PROFLE(T2)
MOVEM T1,PROFLE(X) ;CARRY DOWN PROFILE STUFF
MOVE T1,RS(T2)
MOVEM T1,RS(X) ;CARRY DOWN RESPONSE STUFF
IFN FTCJOB,<
MOVE T1,CJOWNR(T2)
MOVEM T1,CJOWNR(X)
MOVE T1,COJOB(T2)
MOVEM T1,COJOB(X) ;NESTED COJOB
IFN FTMBCH,<
MOVE T1,BATWRD(T2) ;IN CASE WE ARE BATCH
MOVEM T1,BATWRD(X) ;CARRY DOWN THE BATCH WORD
>
> ;END OF FTCJOB
MOVSI T1,FSTVNT(T2) ;CARRY DOWN WHENEVER STUFF
ADDI T2,1
HRRM T2,LAST(X) ;HOLD OTHER PROCESSES
MOVSI T2,1
ADDM T2,LAST(X) ;INCREMENT LEVEL COUNT
SKIPA
OK2: MOVSI T1,DEFVNT ;USE WHENEVER DEFAULTS
HRRI T1,FSTVNT(X) ;AND PUT IN HIS PDB
BLT T1,LSTVNT(X) ;THIS WAY
MOVE T1,[SIXBIT/TTY/]
WHERE T1,
SETZ T1,
HRRM T1,STATIN(X) ;STORE USER'S STATION NO.
OK3:
IFN FTMBCH,<
TLNE F,FLS.BT ;IF BATCH
JRST BCHENT
> ;END OF BATCH BIT
SETOM FLAG(X) ;INDICATE END OF SETUP PROCESS
;AS THIS IS LAST WORD IN REAL PDB
;IT WILL BE SET BY BLT
IFN FTMBCH,<
TLNN F,FLS.BR ;IS THIS A BATCH RUN
JFCL ;NO
> ; END OF BATCH BIT
SLOB1: PUSH P,X ;SAVE DUMMY X
SLOB: SKIPN MASTNO ;MIC STILL RUNNING
JRST NOMSTR ;NO
MOVE T1,[4,,CCTRP] ;SET US UP TO TRAP CONTRO-C
MOVEM T1,INTBLK
MOVEI T1,2
MOVEM T1,INTBLK+1
SETZM INTBLK+2
SETZM INTBLK+3
MOVEI T1,INTBLK
MOVEM T1,.JBINT## ;ENABLE TRAP
SETZ T1,
SETUWP T1,
HALT
AOSE LOCK ;CAN WE CLAIM A PDB
JRST .-1 ;NO TRY AGAIN
PUSHJ P,SETX ;CLAIM A PDB
;AND SET UP A REAL X
JRST NOPDB ;NONE FREE LET DADDY SORT IT OUT
MOVEI T1,2 ;WE GOT ONE
MOVEM T1,FLAG(X) ;SAY WE ARE USING IT TO PROCESS A REQUEST
SETOM LOCK ;RESET THE LOCK
MOVEI T1,1
SETUWP T1,
HALT
HLLZS F,F
IOR F,[FLS.PC,,FAIL] ;IN CASE HE CONTROL C'S
POP P,T2 ;DUMMY X
;**********TEMPORARY*************
MOVEI T3,ARGBP(T2) ;ADDR. OF DUMMY PARAMETER POINTERS
MOVN T2,T3
ADDI T2,ARGBP(X) ;CORRECTION TO PARAMETER POINTERS
IFN FTMBCH,< ;IF BATCH
MOVSI T4,BTL.AS ;NEED AN ASPRIN
TDNE T4,DUMPDB+<BATWRD-PDB> ;WAS THIS PDB CREATED BY ASPRIN
ADDI T2,DUMPDB ;YES - NEED AN EXTRA CORRECTIN FACTOR.
ANDCAM T4,DUMPDB+<BATWRD-PDB> ;CLEAR THE ASP BIT IN CAS NESTED PROCESSES
>
MOVE T4,[-ARGNUM,,0] ;LOOP CONTROL
PUSH P,T3 ;SAVE START OF POINTERS
BPXFIX: HRRZ T3,(P) ;GET ADDR.
ADDI T3,(T4) ;+ INDEX
HRRZS T3 ;GET RID OF NASTY BITS
SKIPE (T3) ;ANYFING
ADDM T2,(T3)
AOBJN T4,BPXFIX ;AND AGAIN
POP P,(P) ;A CLEAN STACK IS A HAPPY STACK
;**********END OF TEMPORARY***********
SETZ T1,
SETUWP T1,
HALT
IFN FTMBCH,<
TLNE F,FLS.BR ;IS WE BATCH
SETZM BATACT ;SET COMBAT/MIC INTERLOCK
>
MOVSI T1,DUMPDB ;ADDRESS OF THE DUMMY PDB
HRRI T1,PDB(X) ;ADDRESS OF THE REAL PDB
PUSH P,T1 ;SAVE THE BLT ARG.
TLNE F,FLS.BR!FLS.CJ ;IS WE BATCH RUN OR COJOB
SKIPA ;YEAH!
PUSHJ P,TOWAIT ;DO THE MIC SET,L
POP P,T1 ;RESTORE THE BLT ARG.
BLT T1,FLAG(X) ;AND SET UP THE PDB
SETZM .JBINT## ;CLEAR DOWN CONTROL-C TRAPPING
MOVE T1,MASTNO
WAKE T1, ;WAKE UP DADDY
JFCL ;WHO CARES
IFN FTMBCH,< ;FOR BATCH
TLNN F,FLS.BR ;BATCH RUN?
>;END OF BATCH BIT
JRST SLEND ;CLOSE DOWN
IFN FTMBCH,<
BATCOM:
RTCMBT: TLNE F,FLS.BC ;BATCH CONTROL
JRST COMBAT ;YES
SETZ T1,
SETUWP T1, ;MAKE SURE HI-SEG IS W/E
HALT
BATWAT: SKIPN BATACT ;CHECK ACTION WORD
JRST SLEEPY ;NOT READY YET
SKIPL BATACT ;SUCCESS?
AOS BATTOT ;YES
MOVE T1,BATACT ;GET ACTION
MOVEM T1,LWACTN ;AND PASS TO COMBAT
MOVEI T1,1 ;MAKE SURE WE WLOCK HI-SEG
SETUWP T1,
HALT
JRST COMBAT
SLEEPY: MOVE T1,^D5 ;SLEEP TIME IF HIBER FAILS
SETZ T2, ;SLEEP UNTIL WOKEN
HIBER T2, ;THIS IS WHERE COMBAT SLEEPS WHEN WAITING ON MIC
SLEEP T1,
JRST BATWAT ;SEE IF DUN!
MOVEI T1,1 ;MAKE SURE WE WLOCK IT
SETUWP T1,
HALT
JRST COMBAT
> ;END OF BATCH BIT
IFN FTMBCH,<
;HERE TO PROCESS A MIC BATCH REQUEST
QUEPPN: 3,,3 ;AREA TO MAKE ENTRIES ON
BCHENT: MOVSI T2,'DSK' ;Q DEVICE
SETZ T3,
MOVEI T1,17 ;DUMP MODE
OPEN T1 ;GRAB DEVICE
JRST BCHQDE
SETZ T1, ;CHANNEL 0
DEVNAM T1, ;WHAT DEVICE?
JRST BCHQDP ;OOOOOPS
HLRZS T1 ;JUST LEFT HALF
CAIE T1,'DSK' ;IS IT A PUBLIC DSK
JRST BCHQDP ;NO-ERROR
MOVEI N,'M00' ;FIRST MIC BATCH EXT.
MOVE T1,FILE(X) ;MACRO FILE NAME
NXTEXT: TRZE N,10 ;CHECK FOR SIXBIT 8
ADDI N,100 ;CAUSE IT'S NOT ALLOWED
TRZE N,1000 ;CHECK FOR SIXBIT 80
MOVEI N,'N00' ;***WOT WOULD U DO?
MOVS T2,N
SETZ T3,
MOVE T4,QUEPPN
LOOKUP T1 ;SEE IF ALREADY EXISTS
SKIPA ;NOT YET
AOJA N,NXTEXT ;TRY NEXT EXTENSION
TRNE T2,-1 ;FAILED FOR RIGHT REASON?
JRST BCHLFQ ;NO
HRLZI T3,001000 ;LOW PROTECTION(NEEDED FOR /MODIFY AND /KILL)
ENTER T1 ;OPEN THE FILE
JRST BCHEFQ
MOVE T1,[IOWD PDBSIZ,DUMPDB]
SETZ T2,
OUTPUT T1
SKIPA
JRST BCHOFQ
MOVE T1,FILE(X)
MOVEM T1,LFILE ;STORE MOO FILE NAME
MOVEM N,LEXT ;STORE MOO EXTENSION
RELEASE ;GET RID OF THE CHANNEL
OUTSTR [ASCIZ/
MIC BATCH REQUEST FOR -/]
MOVE WD,DEV(X)
PUSHJ P,SIXBP
OUTCHR [":"]
MOVE WD,FILE(X)
PUSHJ P,SIXBP
OUTCHR ["."]
MOVE WD,EXT(X)
PUSHJ P,SIXBP
MOVE WD,PPN(X)
HRLZ T1,MICDEV
CAME T1,DEV(X) ;DON'T BOTHER IF MIC DEVICE
PUSHJ P,PPNOUT
OUTSTR [ASCIZ/ - CREATED
/]
;HERE TO SET UP CALL AND CALL QUEUE(NEVER TO RETURN)
CALLQ: MOVE T1,LFILE ;GET FILE NAME
MOVEI WD,[ASCIZ/
/]
SKIPN T1
JRST CALLQ2
SETZ T2,
MOVE T3,[POINT 6,T1] ;POINTER TO FILE NAME
ILDB CH,T3 ;GET SIXBIT CHAR
JUMPE CH,.+3
ADDI CH," " ;MAKE IT ASCII
IDPB CH,BUFBP ;STORE IT
JUMPN CH,.-4
MOVEI CH,"." ;FILE.EXT
IDPB CH,BUFBP
SKIPN T1
HALT
MOVS T1,LEXT ;GET EXTENSION
MOVE T3,[POINT 6,T1] ;POINTER TO EXTENSION
ILDB CH,T3 ;GET SIXBIT CHAR.
JUMPE CH,.+4
ADDI CH," " ;MAKE IT ASCII
IDPB CH,BUFBP ;STORE IT
JUMPN CH,.-4
MOVEI WD,[ASCIZ/[3,3]
/] ;END OF I/P LINE STUFF
CALLQ2: MOVE T1,[POINT 7,(WD)]
ILDB CH,T1
IDPB CH,BUFBP ;STORE EOL STUFF
JUMPN CH,.-2
JRST CALQ3A
;HERE TO RUN QUEUE
;MUST DO IT THIS WAY CAUSE ALL QUEUE'S LIST ROUTINES ARE IN
;ITS LOW SEGMENT.
CALLQ3: RESET
PUSHJ P,ISBRK ;BREAK YET?
JRST CALQ3A ;YES
PUSHJ P,CHARIN ;READ A CHAR
JRST .-3 ;AND LOOP
CALQ3A: MOVE T1,[ASCII/MIC: /] ;PREPARE THE COMMAND LINE
MOVEM T1,BUFFER
HRRZ T2,BUFBP ;GET POINTER WORD
ADDI T2,1 ;ROUND UP
SUBI T2,BUFFER ;GET ITS SIZE
MOVNS T2
HRLZS T2 ;MAKE -BUFLEN,,0
HRRI T2,BUFFER-1 ;-SIZE,,ADDR-1 (JUST LIKE IOWD DOES)
PUSH P,T2 ;SAVE IN CASE TMPCOR UUO FAILS
MOVSI T1,'QUE' ;FILE NAME
MOVE T3,[.TCRWF,,T1] ;WRITE FILE,,CONTROL BLOCK
TMPCOR T3, ;WRITE A TMPCOR FILE
JRST NO.TMP ;NO TMPCOR TRY nnnQUE.TMP FILE.
CALQ3B: SETZ T1,
SETUWP T1, ;W/E HI-SEG
HALT
AOS CMDTOT ;UP THE COMMANDS TOTAL
AOS BRQTOT ;ONE MORE BATCH REQUEST
SETUWP T1, ;W/L HI-SEG
HALT
MOVSI 0,'SYS' ;TO RUN SYS:QUEUE
MOVE 1,[SIXBIT/QUEUE/]
SETZB 2,3
SETZB 4,5
MOVSI 6,1 ;CCL ENTRY TO QUEUE
RUN 6, ;RUNN IT
HALT
HALT
> ;END OF IF FTMBCH
;.MKPJN--SUBROUTINE TO MAKE A CCL JOB NUMBER
;CALL: MOVE T1,JOBB NUMBER
; PUSHJ P,.MKPJN
;RETURNS VALUE IN LH(T1)
;CHANGES T1,T2,T3,T4
.MKPJN: MOVEI T4,3 ;MAKE TEMP FILE NAME
MAKPJ1: IDIVI T1,^D10 ; BY TRIED AND
ADDI T2,'0' ; TRUE CCL
LSHC T2,-6 ; TECHNIQUE <SIC>
SOJG T4,MAKPJ1 ; ..
HLLZ T1,T3 ;POSITION ANSWER
POPJ P,0 ;AND RETURN
IFN FTMBCH,< ;BATCH STUFF
;HERE WHEN TMPCOR UUO FAILS MUST TRY TO WRITE A FILE
;OF THE FORM nnnQUE.TMP WHER nnn IS THE USERS JOB NUMBER
NO.TMP: MOVEI T1,17 ;DUMP MODE
MOVSI T2,'DSK' ;ON DSK
SETZ T3, ;NO BUFFERS
OPEN 1,T1 ;ON CHANNEL 1
JRST MICTMP ;FAILED
MOVE T1,JOB(X) ;GET USERS JOB NUMBER
PUSHJ P,.MKPJN ;MAK IT INTO SIXBIT
HRRI T1,'QUE' ;MAKE THE FILE NAME
MOVSI T2,'TMP' ;AND THE EXTENSION
SETZB T3,T4 ;NO OTHER ARGS
ENTER 1,T1 ;ENTER nnn QUE.TMP
JRST MICTMP ;FAILED
POP P,T1 ;GET THE IOWD BACK
SETZ T2,
OUTPUT 17,T1 ;WRITE THE COMMAND LINE
SKIPA ;DONE IT
JRST MICTMP ;OOOOOOPS!
RELEASE 1, ;CLOSE DOWN
JRST CALQ3B ;AND BACK TO RUN QUEUE
MICTMP: OUTSTR [ASCIZ/
?MICTMP FAILED TO WRITE TMP FILE FOR QUEUE!/]
JRST SLENDX
;SPECIAL INPUT ROUTINE FOR BATCH
BCHRDX: PUSHJ P,CCLIN ;THIS ENTRY IF CCL
SKIPA
BCHRD: INCHWL CH
CAIN CH,"[" ;START OF FIX FOR PROBLEMS TO Q INTERFACE
SETOM GTLOCK
CAIE CH,"]"
JRST .+3
SETZM GTLOCK
POPJ P,0
SKIPGE GTLOCK ;IF SET IGNORE
POPJ P,0 ;END OF Q FIX
IDPB CH,BUFBP ;STORE IT FOR Q
CAIE CH,"=" ;FINISH ON =
POPJ P,0
TLNE F,FLS.CCL ;CCL ENTRY
JRST [PUSH P,BCHRDX
JRST .+2] ;YES
PUSH P,BCHRD
POP P,LOWIN ;RESET LOW LEVEL I/P ROUTINE
POPJ P,0
;HERE ON BATCH REQUEST ERRORS
BCHQDE: OUTSTR [ASCIZ/
?BCHQDE SYSTEM QUEUE DEVICE ERROR/]
JRST SLENDX
BCHLFQ: OUTSTR [ASCIZ/
?BCHLFQ SYSTEM LOOKUP FAILURE ON QUE ENTRY/]
JRST SLENDX
BCHEFQ: OUTSTR [ASCIZ/
?BCHEFQ SYSTEM ENTER FAILURE ON QUE ENTRY/]
JRST SLENDX
BCHOFQ: OUTSTR [ASCIZ/
?BCHOFQ SYSTEM OUTPUT FAILURE ON QUE ENTRY/]
JRST SLENDX
BCHQDP: OUTSTR [ASCIZ/
?BCHQDP SYSTEM QUEUE DEVICE MUST BE PUBLIC DSK!/]
JRST SLENDX
> ;END OF FTMBCH
;HERE IF A USER TYPES CONTROL C WHILE WE ARE READING HIS COMMAND LINE
CCTRP: PUSH P,INTBLK+2 ;SAVE THE RETURN ADDRESS
SETZM INTBLK+2 ;RE-ENABLE TRAP
TLNE F,FLS.PC ;IF WE HAVE CLAIMED A PROCESS
EXCH F,(P) ;CLEAR FLAG AND POPJ TO FAIL
POPJ P,0 ;AND RETURN TO INLINE CODE
SUBTTL SLAVE PROCESSOR - ERROR MESSAGES
NOTDEV: OUTSTR [ASCIZ/?CANNOT INIT DEVICE /]
MOVE WD,DEV(X)
PUSHJ P,SIXBP ;O/P DEV NAME
OUTSTR [ASCIZ/:/]
JRST SLENDX
OFLOW: OUTSTR [ASCIZ/?TOO MANY CHARACTERS IN ARGUMENT/]
JRST SLENDX
ERR: OUTSTR [ASCIZ/?ERROR IN DEVICE FILE SPECIFICATION/]
JRST SLENDX
BRKMIS: OUTSTR [ASCIZ/?BRACKETS MISMATCH IN PARAMETER/]
JRST SLENDX
TOOMNY: OUTSTR [ASCIZ/?TOO MANY PARAMETERS - MAX = 26/]
JRST SLENDX
IFN FTCJOB,<
LGFERR: OUTSTR [ASCIZ/?LGFERR ERROR IN LOG FILE SPEC/]
JRST SLENDX
LGDERR: ASCIZ/?LGDERR CANNOT INIT. LOG DEV./
LFLERR: ASCIZ /?LFLERR CANNOT LOOKUP LOG FILE/
LFEERR: ASCIZ /?LFEERR CANNOT ENTER LOG FILE/
ERLGFL: OUTSTR (BP) ;PRINT THE ERROR
JRST SLENDX
SWTERR: OUTSTR [ASCIZ/?SWTERR SWITCH ERROR/]
JRST SLENDX
CJNOTU: OUTSTR [ASCIZ/?CJNOTU COJOBS NOT AVAILABLE AT THIS TIME/]
JRST SLENDX
NOCJBS: OUTSTR [ASCIZ/?NOCJBS NO COJOBS AVAILABLE/]
JRST SLENDX
> ;END OF COJOB BIT
NOMSTR: OUTSTR [ASCIZ/?NOMSTR MIC NOT RUNNING PLEASE TRY AGAIN/]
MOVEI S,[ASCIZ/NOMSTR MIC NOT RUNNING PLEASE INITIALISE/]
PUSHJ P,MSTOPR
JRST SLENDX
;HERE WHEN HE HAS NESTED HIS PROCESSES TOO DEEPLY
E%%LVL: OUTSTR [ASCIZ/?MICCND CANNOT NEST PROCESSES THIS DEEP MAX = /]
MOVE N,MAXLVL
PUSHJ P,DECPRT
JRST SLENDX
FAIL:
SETZ T1,
SETUWP T1,
HALT
SKIPE T3,LAST(X) ;HAVE WE HELD A PROCESS?
SETOM FLAG-1(T3) ;YES - RE-START IT
SKIPE S,LDBMIC(X) ;HAVE WE SET UP NEW LDBMIC WORD?
PUSHJ P,TOWAIT ;WAIT TILL I/O DONE THEN RESTORE ORIGINAL
JFCL
SETZM FLAG(X) ;RELEASE PROCESS AREA
IFN FTCJOB,<
SETZM COJOB(X) ;CLEAR DOWN COJOB FLAG
TLZ F,FLS.CJ ;THIS ONE AS WELL
>;END OF COJOB BIT
SLEND:
IFN FTMBCH,<
SETZ T1,
SETUWP T1,
HALT
>;END
AOS CMDTOT ;ONE MORE COMMAND
IFN FTCJOB,<
TLNE F,FLS.CJ ;COJOB?
AOSA CJBTOT ;SAY THAT WE DUN 1 MORE
>;END OF COJOB BIT
FAILED: CLRBFI
SETZM .JBINT##
EXIT1:
IFN FTMBCH,< ;IF MIC BATCH
TLNE F,FLS.BR
JRST BATCOM
>;END OF BATCH BIT
EXIT 1,
EXIT
SLENDX: OUTSTR [ASCIZ/ - IN "/] ;PRETTY ERROR MESSAGES
MOVE WD,LOWCMD ;GET NAME OF COMMAND
PUSHJ P,SIXBP ;O/P IT
OUTSTR [ASCIZ/" COMMAND/]
JRST FALSE
; A ROUTINE TO DO MIC SET UUO'S AFTER WAITING FOR THE TTY TO COMPLETE ANY CURRENT O/P
TOWAIT: MOVEI T1,2*^D1000 ;SHORTEST MESSAGE
PUSHJ P,OUTPNG ;HAS HE DONE
MIC SET,L ;O.K THEN PERHAPS SILENCE AND BREAK
HIBER T1, ;NO-SLEEP TIGHT
JRST CPOPJ ;DONE
JRST TOWAIT ;CHECK AGN
;HERE WHEN MACRO FILE COULD NOT BE FOUND
NOTFIL: MOVSI T1,'DSK' ;WAS INIT ON DSK?
CAME T1,DEV(X)
JRST NOFIL ;NO - FAIL
SKIPN PPN(X) ;HAS HE SPECIFIED A PPN?
JRST NOTFL0 ;NO
GETPPN T3,
JFCL
CAME T3,PPN(X)
JRST NOFIL ;IF HE WAS SPECIFIC ABOUT PPN DO NOT TRY MIC DEVICE
NOTFL0: HRLZ T3,MICDEV ;YES - TRY FROM MIC DEVICE.
MOVEM T3,DEV(X)
JRST FINDFL
NOFIL: OUTSTR [ASCIZ/?CANNOT OPEN FILE /]
MOVE WD,DEV(X)
PUSHJ P,SIXBP
OUTCHR [":"]
MOVE WD,FILE(X)
PUSHJ P,SIXBP ;PRINT FILE
OUTCHR ["."]
MOVE WD,EXT(X) ;AND EXT
PUSHJ P,SIXBP
MOVE WD,PPN(X)
JUMPE WD,SLENDX
HRLZ T1,MICDEV
CAME T1,DEV(X)
PUSHJ P,PPNOUT ;IF WE WERE NOT LOOKING ON MIC DEVICE TELL HIM THE PPN USED
JRST SLENDX
SUBTTL SLAVE PROCESSOR - SUBROUTINES
;A ROUTINE TO FIND IF THERE ARE ANY OTHER USERS ON THIS LINE
OTHUSR: HRLZ T1,PROCNO ;TRY FOR THIS MANY
SETZ T2, ;CLEAR X
OTHUS2: CAMN L,LINE(T2) ;THE SAME LINE?
JRST OTHUS3 ;YES
OTHUS4: ADDI T2,PDBSIZ ;NO - UPDATE T2
OTHUS5: AOBJN T1,OTHUS2 ;TRY FOR NEXT
POPJ P, ;NO MORE FAIL EXIT
OTHUS3: SKIPL T4,FLAG(T2) ;IS HE RUNNING?
JRST OTHUS4 ;NO - FURTHER CHECKING
IFN FTCJOB,<
SKIPN COJOB(T2) ;WAS THAT A COJOB?
JRST CPOPJ1 ;NO - SUCCESS EXIT
HRRZ T4,COJOB(T2) ;YES GET COJOB ACTION NO.
CAIE T4,-3
JRST OTHUS5 ;THEN U CANNOT RELY ON LINE NO.
MOVE T4,FLAG(T2) ;ELSE LINE NUMBER IS OK
>
JRST CPOPJ1 ;GO SUSPEND IT ETC.
;A ROUTINE TO SET UP X FOR THE SLAVE PROCESS
SETX: HRLZ T1,PROCNO ;TRY THIS MANY
CLEARB X,Y
JRST SETX2 ;FIRST TIME IN
SETX1: ADDI X,PDBSIZ ;NEXT AREA
SETX2: SKIPN FLAG(X) ;FREE?
AOSA (P) ;YES
AOBJN T1,SETX1 ;NO - TRY NEXT
POPJ P,0
;HERE WHEN THE SLAVE NEEDS A PROCESS AREA AND THERE
;IS NOT ONE AVAILABLE.
NOPDB: SETOM LOCK ;CLEAR THE INTERLOCK
SETZM .JBINT## ;LET HIM CC OUT
AOS T2,COMCNT ;TELL THE MASTER ABOUT IT
NOPDB1: MOVE T1,MASTNO
WAKE T1,
JFCL ;WHO CARES!
SLEEP T2, ;GO TO SLEEP FOR AN APPROPRIATE PERIOD
SKIPN T2,COMCNT
JRST SLOB ;THE MASTER HAS FIXED US UP
JRST NOPDB1 ;GO TO SLEEP AGAIN
SUBTTL SLAVE PROCESSOR - READ FILE SPEC
;A ROUTINE TO GET A FILE SPEC OF THE FORM DEV:FILE.EXT[P,P]
;FILL IN THE DEFAULTS
INSPEC: MOVSI WD,(SIXBIT/MIC/)
MOVEM WD,LEXT
MOVEM WD,LFILE
MOVSI WD,(SIXBIT/DSK/)
MOVEM WD,LDEV
;NOW READ IN USERS ATTEMPT
CHK: PUSHJ P,WDREAD
INSPC0: CAIN CH,":"
JRST DEVICE ;THAT WAS A DEVICE
CHK1: CAIN CH,"."
JRST FILNAM ;THAT WAS A FILENAME
SKIPE WD
MOVEM WD,LFILE
CHK2: CAIN CH,"["
JRST PROJECT ;HE IS INTRODUCING A PPN
MOVEM CH,CH.SAV ;PUT BACK THE UNUSED CHAR
JRST CPOPJ1 ;GOT IT ALL-EXIT
;HERE TO STORE DEVICE
DEVICE: JUMPE WD,CPOPJ ;HE TYPED : BUT NO DEVICE
MOVEM WD,LDEV
PUSHJ P,WDREAD
JUMPE WD,CHK2 ;HE TYPED DEV: BUT NO FILE
JRST CHK1
;HERE TO GRAB A FILENAME
FILNAM: MOVEM WD,LFILE
PUSHJ P,WDREAD
TRNE WD,-1
POPJ P,0 ;HE TYPED .AAA???
MOVEM WD,LEXT
JRST CHK2
;HERE TO GRAB A PPN
PROJEC: MOVE N,OPPN(X)
MOVEM N,LPPN ;SET UP DEFAULTS
PUSHJ P,OCTIN
PUSHJ P,ISBRK ;TERMINATED BY A BREAK
JRST .+3 ;YES
CAIE CH,"," ;OR A COMMA
POPJ P,0 ;NEITHER I.E. ERROR
SKIPE N1 ;DID WE READ ANYFING
HRLM N,LPPN ;YES STORE IT (OTHERWISE USE DEFAULT)
SETZ N1,
CAIN CH,"," ;IF NOT A BREAK CHAR
PUSHJ P,OCTIN ;READ SECOND PART
SKIPE N1
HRRM N,LPPN ;STORE THAT ATTEMPT
CAIG CH,"7" ;CHECK FOR TERMINATOR
CAIGE CH,"0" ;FOR 6-FIG. PROGRAMMERS
SKIPA
PUSHJ P,CHARIN
IFN FTPATH,<
CAIN CH,"," ;HAS HE GOT AN SFD
JRST PTHCHK ;MAYBE CHECK UP ON IT
>
PROJE1: PUSHJ P,ISBRK
SKIPA ;LIKE IT
CAIN CH,"]" ;WAS IT PROPERLY DELIMETED?
AOS (P) ;YES-GOOD EXIT
POPJ P,0 ;EXIT FROM INSPEC
;HERE TO GRAB AN OCTAL NO.
OCTIN: SETZB N,N1
PUSHJ P,CHARIU ;GET NEXT SIGNIFICANT CHARACTER AND SKIP
OCTIN1: PUSHJ P,PINCH
OCTIN2: CAIL CH,"0"
CAILE CH,"7"
POPJ P,
SETO N1, ;FLAG THAT A NO. WAS READ
TLZ F,FL.MOP ;CLEAR MONADIC OPS FLAG
LSH N,3
ADDI N,-"0"(CH)
TRNE N,700000
POPJ P,0
JRST OCTIN1
;A ROUTINE TO READ A SIXBIT WORD
WDREAD: MOVE BP,[XWD 440600,WD]
MOVEI WD,0
PUSHJ P,CHARIU ;GET NEXT SIGNIFICANT CHARACTER AND SKIP
WDRD3: PUSHJ P,PINCH
PUSHJ P,LOWUP ;CONVERT LOWER CASE TO UPPER
CAIN CH,"%"
JRST WDRD2
CAIL CH,"0"
CAILE CH,"Z"
POPJ P,
CAIGE CH,"A"
CAIG CH,"9"
JRST WDRD2
POPJ P,
WDRD2: SUBI CH," "
TLNE BP,770000
IDPB CH,BP
JRST WDRD3
;HERE TO DEAL WITH THE PATH STUFF
IFN FTPATH,<
PTHCHK: MOVEM CH,CH.SAV
PUSHJ P,CHARIN ;SKIP TRAILING SPACES
CAIE CH,","
POPJ P, ;NOT A COMMA
MOVEI T1,PATH+1(X)
MOVEM T1,PATH(X) ;SET UP POINTERS
MOVSI N,-SFDLVL ;MAX NO. OF SFD'S
PTHCH1: PUSHJ P,WDREAD ;READ SFD NAME
JUMPE WD,CPOPJ ;BLANK IS WRONG
MOVEM WD,@PATH(X)
MOVEM CH,CH.SAV
PUSHJ P,CHARIN ;SKIP TRAILING SPACES
PUSHJ P,ISBRK
CAIN CH,"["
JRST PTHCH2
AOS PATH(X)
CAIN CH,"," ;COMMA
AOBJN N,PTHCH1 ;ONTO NEXT IF NOT HAD SIX
POPJ P,0 ;NO ERROR
PTHCH2: MOVE N,PPN(X)
MOVE N,PATH(X) ;SAVE PPN AS START OF PATH
MOVEI N,PATH(X)
MOVEM N,PPN(X) ;SAVE ADDR. OF PATH
JRST PROJE1
>
SUBTTL PLEASE COMMAND
;HERE ON A PLEASE COMMAND
.PLEASE:
PUSHJ P,OTHUSR ;GET IN CONTEXT
JRST LETER3 ;MAY BE WE DO SOMETHING HERE SOME DAY
PUSHJ P,LININ ;READ IN THE PLEASE LINE
TLZE S,LDL.XX ;IF I AM SILENCED
MIC SET,L ;AWAKE
JRST .PLE1 ;ELSE NO NEED TO RE DISPLAY
OUTSTR [ASCIZ/
[/]
OUTSTR BUFFER
OUTSTR [ASCIZ/]
/]
TLOA S,LDL.XX!LDL.CB ;HE WAS SILENCED AND HE MQY NEED
.PLE1: TLO S,LDL.CB ;A BREAK
CAIN CH,ALT ;ANY FLAVOUR OF ALTMODE
TLZ S,LDL.CB ;WILL SCRAP A BREAK
CAIE CH,ALT175
CAIN CH,ALT176
TLZ S,LDL.CB
PLWAIT: MOVEI T1,2*^D1000 ;THE SHORTEST MESSAGE
MOVEI T3,.TOSOP
MOVEI T4,.UXTRM(L)
MOVE X,[2,,T3]
TRMOP. X,
MIC SET,L ;YES-THEN PERHAPS SILENCE AND BREAK
HIBER T1, ;ELSE REST SOME
IFN FTCJOB,< ;IF WE HAS COJOBS
SKIPA L,CJOWNR(T2) ;CHECK...
JRST PLWAIT ;AND CHECK IF HE GOT OUR MISSIVE
JUMPLE L,EXIT1 ;....IF WE GOT A COJOB TO TELL..OWNER
;HERE TO TELL THE OWNER OF A COJOB ABOUT A PLEASE COMMAND
PUSHJ P,OWNCHK ;IS OWNER AROUND
JRST EXIT1 ;NO
MIC GET,L ;GET OWNERS STATUS
JRST .PLE2 ;HE IS NOT RUNNING MIC
TLZE S,LDL.XX ;MAKE SURE HE SEES IT
MIC SET,L
JFCL
.PLE2: MOVE X,T2 ;GET IN CONTEXT FOR CJDSP
PUSHJ P,CJDSP
MOVEI S,[ASCIZ/.PLEASE /]
.TELLX: MIC DISPLAY,L
JFCL
MOVEI S,BUFFER
.PLE5: MIC DISPLAY,L
JFCL
MOVEI S,[ASCIZ/]
/]
MIC DISPLAY,L
JFCL
JRST EXIT1
> ;END OF COJO CONDITIONAL
IFE FTCJOB,<
JRST EXIT1
JRST PLWAIT
>;END OF IF NOT
;A SUBROUTINE TO GET A PLEASE LINE IN
LININ: MOVSI BP,440700
HRRI BP,BUFFER
.PLE4: PUSHJ P,ISBRK ;GOT A BREAK ALREADY?
JRST .PLE3
SPLIDG: IDPB CH,BP
PUSHJ P,PINCH ;GET THE NEXT CHARACTER IN
JRST .PLE4
.PLE3: SETZ T1,
IDPB T1,BP
POPJ P,0
SUBTTL MIC OPR COMMAND - COJOB/SYSTEM OPERATOR COMMUNICATIONS
IFN FTOPR&FTCJOB,<
.OPR: PUSHJ P,OTHUSR ;GET IN CONTEXT
JRST LETER3 ;WOT TO DO I DO NOT KNOW
SKIPN CJOWNR(T2) ;IS WE A COJOB
JRST EXIT1 ;NO--REGARD COMMAND AS A NO-OP
PUSHJ P,LININ ;GET THE MESSAGE IN
PUSH P,S ;SAVE S
MOVEI S,BUFFER ;LINE IS SAVED IN BUFFER
PUSHJ P,TELOPR ;LET THE OPERATOR KNOW
POP P,S ;RESTORE S
TLO S,LDL.CB ;MAY NEED A BREAK
CAIN CH,ALT ;BUT NOT IF THE LINE TERMINATED IN AN ALTMODE
TLZ S,LDL.CB ;OF ANY VALUE
CAIE CH,ALT175 ;EVEN THIS
CAIN CH,ALT176 ;OR THIS
TLZA S,LDL.CB ;SO DO AWAY WIF THE BREAK
SKIPA
JRST EXIT1 ;AND AWAY
PUSH P,S ;LET OPR KNOW THAT WE ARE WAITING
MOVEI S,[ASCIZ/[BREAK]/]
PUSHJ P,TELOPR ;ON TO OPR DEVICE
POP P,S ;COME BACK S ALL IS FORGIVEN
MIC SET,L ;BREAK
HALT ;DON'T KNOW WOT TO DO
JRST EXIT1 ;DONE!
>
SUBTTL SILENCE,REVIVE,ABORT,PROCEED,BREAK,NO/OPERATOR,NO/ERROR,DISPLAY,TYPE
;HERE ON SILENCE AND REVIVE
.SILENCE:
TLOA S,LDL.XX ;SHUT HIM UP
.REVIVE:TLZ S,LDL.XX ;KISS OF LIFE
JRST DOTMIC
;HERE ON MIC ABORT
.ABORT: TLO S,LDL.CA
JRST DOTMIC
;HERE ON MIC PROCEED
.PROCEED:
TLO S,LDL.CP
JRST DOTMIC
;HERE ON MIC BREAK
.BREAK: TLO S,LDL.CB
JRST DOTMIC
;HERE ON MIC RETURN - PRETEND THAT MASTER HAS SEEN EOF
.RETURN:
PUSHJ P,OTHUSR ;GET IN CONTEXT
JRST LETER3 ;COULDN'T
MOVEI T1,FR.EOF ;EOF FLAG
SETZ T3,
SETUWP T3,
HALT
IORM T1,FSAV(T2)
PUSHJ P,CHARSG ;GET SIGN. CHAR.
PUSHJ P,ISBRK ;IS IT A BREAK CHAR.
JRST DOTMIC ;YES - UP AND AWAY
SETUWP T3,
HALT
SKIPE T4,LAST(T2) ;HAVE WE HELD A PROCESS
RTRN0: SKIPG FLAG-1(T4) ;IS IT AWAKE
JRST DOTMIC
MOVE T1,MASTNO ;GET THE MASTER NO.
WAKE T1, ;WAKE DADDY UP
JRST DOTMIC ;FAILED
MOVEI T1,2*^D1000 ;HIBER TIME
HIBER T1,
JRST RTRN0
JRST RTRN0
;HERE ON A MIC TYPE
.TYPE: TDZA T1,T1
;HERE ON MIC DISPLAY
.DISPLAY:SETO T1,
TDAGN: MOVEM L,LLX ;SAVE LINE NO.
SETOM LLP
PUSHJ P,CHARIN ;GET NEXT SIGNF. CHAR.
CAIE CH,"$" ;IS IT
CAIN CH,42 ;OR "
JRST TDAG1
MOVEM CH,CH.SAV ;PUT BACK THAT WHICH WE DO NOT WANT YET
MOVEI CH,"$" ;PRETEND STRING
TDAG1: PUSH P,T1 ;SAVE T1
PUSHJ P,.LET3
MOVE L,LLX
POP P,T1
TLZE S,LDL.XX
MIC SET,L
CAIA
TLO F,FL.XX
HRRZI S,FIRST
MOVE L,LLX ;RESTORE LINE NO.
XCT TYPDIS(T1) ;DO APPROPRIATE FING.
JFCL
TLZN F,FL.XX
JRST .+3
TLO S,LDL.XX
PUSHJ P,TOWAIT
PUSHJ P,CHARIN ;SIGNIFICANT CHARS.
CAIN CH,"," ;ONE OF THESE?
JRST TDAGN ;PLAY IT AGAIN SAM
JRST DOTTY
MIC DISPLAY,L
TYPDIS: MIC TYPE,L
;HERE ON OPERATOR & NOOPERATOR
.NOOPERATOR:
SETZ CH, ;CLEAR OP CHAR
JRST .NOOP1
.OPERATOR:
PUSHJ P,GETARG ;GET HIS ARG
IFN FTRLSE,<
MOVEI CH,"$" ;DEFAULT IS $
>
IFE FTRLSE,<
MOVEI CH,"?" ;DEFAULT IS ?
>
.NOOP1: DPB CH,LDP.OP ;AND STORE IT
JRST DOTMIC ;RESET FLAGS AND FIND NEXT DOT
;HERE ON ERROR AND NOERROR
.NOERROR:
SETZ CH, ;CLEAR ERROR CHAR
JRST .NOER1
.ERROR: PUSHJ P,GETARG
MOVEI CH,"?" ;DEFAULT IS ?
.NOER1: DPB CH,LDP.ER ;STORE IT
JRST DOTMIC ;RESET FLAGS AND FIND NEXT DOT
GETARG: PUSHJ P,ISBRK ;IS IT A BREAK?
MOVEM CH,CH.SAV ;YES-MAKE SURE WE DO NOT MISS IT
PUSHJ P,CHARIN ;GET NEXT CHAR
PUSHJ P,ISBRK ;IS THIS A BREAK?
SKIPA ;YES-LOAD UP DEFAULT
JRST CPOPJ1 ;NO-THIS IS THE ARG
MOVEM CH,CH.SAV ;SAVE THE CHAR THAT WAS THE BREAK
POPJ P,0
SUBTTL CLEAR COMMAND - TO CLEAR A LINES MIC WORD
REPEAT 0,< ;MAY NOT WANT
TOTLIN==^D512
.CLEAR: PUSHJ P,PRVCHK ;IS HE PRIVILEDGED
JRST UNPRV ;NO-CAN ONLY CLEAR OWN LINE
PUSHJ P,WDREAD ;GET ARG
SKIPE WD ;MAY HAVE BEEN NUMERIC
JRST MAYBAL ;MAY BE ALL
CAIE CH,"%" ;MIC OCTAL
CAIN CH,"#" ;COMPATABILITY WIF SYSTAT LINE NO.S
JRST LINOCT
PUSHJ P,ISBRK ;BREAK ?
JRST EXIT1 ;NO TUF!
UNPRV: MIC CLEAR,L ;CLEAR THIS LINE ONLY
JFCL ;WOT WUD U DU
JRST EXIT1 ;AND AWAY
MAYBAL: CAME WD,[SIXBIT/ALL/]
JRST CLRER1 ;IF NOT ALL - NOOT ALLOWED
HRLZI T1,-TOTLIN ;HOW MANY LINES
HRRZ T2,T1
MIC CLEAR,T2
JFCL
AOBJN T1,.-3
JRST EXIT1 ;AND AWAY
LINOCT: PUSHJ P,RDOCTL ;GET THE LINE NO.
SKIPN N1,
JRST CLRER2 ;NOT NICE
MOVE L,N ;PUT IT IN LINE AC
JRST UNPRV ;DO IT
CLRER1: OUTSTR [ASCIZ/
?CLRER1 UNKNOWN ALPHA ARG./]
JRST SLENDX
CLRER2: OUTSTR [ASCIZ/
?CLRER2 IMPROPER NUMERIC ARG./]
JRST SLENDX
> ;END OF REPEAT
SUBTTL FNDCMD A ROUTINE TO SEARCH THE COMMAND TABLE
FNDCMD: PUSHJ P,WDREAD ;READ THE COMMAND
JUMPE WD,FNDCM1 ;NONE THERE
MOVE T1,[-CMDSIZ,,MICTAB]
PUSHJ P,FNDNAM
JRST EXIT1
POPJ P,0
FNDCM1: CAIN CH,"/" ;MAYBE THIS
JRST .+3 ;YES
CAIE CH,"@" ;OR THIS
JRST EXIT1 ;NO!!!!
MOVEI T1,CMDSIZ ;DUMMY UP THE APPROPRIATE INDEX
POPJ P,0
;FNDNAM--ROUTINE TO SEARCH FOR AN ABREV. NAME IN AN ALPHABETICALLY
;ORDERED TABLE
;CALL
; MOVE T1,AOBJN POINTER TO LIST OF NAMES
; MOVE WD,SIXBIT ABBREVIATION
; PUSHJ P,FNDNAM
;NON-SKIP RETURN IF NOT FOUND(T1=0) OR DUPLICATE (T1>1)
;SKIP RETURN IF FOUND WITH T1=INDEX IN TABLE
FNDNAM: SETZB N1,T4 ;CLEAR MATCH MASK AND POINTER
MOVSI T2,(77B5) ;START AT LEFT END
FNDNM1: TDNE WD,T2 ;SEE IF SPACE
IOR N1,T2 ;NO IMPROVE MASK
LSH T2,-6 ;MOVE RIGHT ONE CHAR.
JUMPN T2,FNDNM1 ;LOOP FOR SIX CHARS.
SETO T2, ;SET ABBREV COUNTER
HRRZ N,T1 ;SAVE POINTER
FNDNM2: MOVE T3,(T1) ;GET NEXT CANDIDATE
XOR T3,WD ;COMPARE
JUMPE T3,FNDNMW ;EXACT MATCH--WIN
AND T3,N1 ;MASK IT
JUMPN T3,FNDNM3 ;LOSE
MOVE T4,T1 ;CONDITIONAL WIN-SAVE POINTER
ADD T1,[1,,1] ;LOOK AT NEXT
JUMPGE T1,[SUB T1,[1,,1]
JRST FNDNMW] ;WIN ON LAST
MOVE T3,(T1) ;GET THE ONE
XOR T3,WD ;COMPARE
JUMPE T3,FNDNMW ;EXACT MATCH?
AND T3,N1 ;MASK IT
JUMPE T3,FNDNM4 ;NOT UNIQUE
SKIPA
FNDNM3: AOBJN T1,FNDNM2 ;LOOP FOR ALL ENTRIES
JUMPGE T1,FNDNM4
MOVE T1,T4 ;RESTORE POSSIBLE WINNER
FNDNMW: TLZ T1,-1 ;REMOVE JUNK
SUB T1,N ;COMPUTE INDEX
JRST CPOPJ1 ;SKIP RETURN
FNDNM4: MOVEI T1,1 ;TWO'S A CROWD
JRST CPOPJ ;FAIL RETURN
SUBTTL SLAVE PROCESS WHENEVER OR ON COMMAND
REPEAT 0,<
A WHENEVER OR ON COMMAND HAS THE FORMAT:-
WHENEVER EVENT:ACTION
ON EVENT:ACTION
WHICH ENABLES THE USER TO OVERRIDE THE DEFAULT PROCESSING
OF CERTAIN EVENTS
TO RESTORE DEFAULTS USE
WHENEVER EVENT:EVENT
ON EVENT:EVENT
>
.WHENEVER:
.ON: PUSHJ P,WDREAD ;READ THE COMMAND
MOVE T1,[-CMDSIZ,,MICTAB]
PUSHJ P,FNDNAM ;CHECK IT
JRST [CAMN WD,[SIXBIT/MATCH/]
JRST AMATCH
JRST WHNER2]
MOVE T1,DSPLST(T1) ;GET THE APPROPRIATE DISPATCH BITS
TLNN T1,WH ;IS IT ALEGAL EVENT
JRST WHNER1 ;NO
LDB N,PEVNTN ;GET EVENT NUMBER
PUSHJ P,CHARSG ;GET NEXT SIGNIF. CHAR.
LSH N,1 ;*2 TO ALLOW FOR ARGS.
PUSH P,N ;SAVE N (USED IN FNDNAM)
CAIE CH,":" ;LEGAL TERMINATOR ?
JRST WHNER2 ;NO
PUSHJ P,WDREAD ;GET THE ACTION COMMAND
MOVE T1,[-CMDSIZ,,MICTAB]
PUSHJ P,FNDNAM ;CHECK IT
JRST WHNER2 ;WRONG!
MOVE T1,DSPLST(T1) ;GET THE DISPATCH BITS
TLNN T1,ACT ;IS IT A LEGAL ACTION
JRST WHNER2 ;NO
LDB T3,PACTNM ;GET THE ACTION NUMBER
PUSH P,T1 ;SAVE T1
PUSHJ P,OTHUSR ;SET UP X AND Y
HALT ;GORN AND NEVER CALLED ME MOTHER
MOVE T3,DSPACT(T3) ;GET ACTION
POP P,T1 ;RESTORE T1
POP P,N ;GET N BACK
ADD T2,N ;POINT AT EVENT
TLNE T1,PRM ;ACTION REQUIRES ARG.
JRST ACTPRM ;YES DEAL WIF IT
SETZ T1,
SETUWP T1, ;W/E HI SEG.
HALT
ACTFIN: MOVEM T3,FSTVNT(T2) ;STORE IN HIS PDB
PUSHJ P,CHARSG ;GET NEXT SIGN. CHAR.
CAIN CH,"," ;IS IT A COMMA
JRST .ON ;YES DO SOME MORE WHENEVER STUFF
JRST DOTTY ;ANTHEM AND CLOSE DOWN
ACTPRM: ;HERE IF AN ACTION REQUIRES A PARAMETER
PUSHJ P,WDREAD ;READ IT
JUMPE WD,WHNER3 ;IF NONE DIE
TLNE T1,LBL ;LABEL?
JRST PRMLBL ;YES
MOVEM L,LLX ;SAVE LINE NO.
MOVEM CH,CH.SAV ;NO-MUST BE A-Z TYPE ARG
ROT WD,6 ;GET IN RITE PLACE
MOVEI CH," "(WD) ;BACK TO ASCII
CAIL CH,"A" ;CHECK IT
CAILE CH,"Z" ;MUST BE A-Z
JRST WHNER4 ;ITS NOT!
PUSH P,T3 ;SAVE
PUSH P,T2 ;SAVE
PUSHJ P,REFBP ;MAKE UP BYTE POINTER TO THAT PARAMETER
HRRZ WD,T3 ;AND IGNORE IT 'COS IN T3 IS THE ADDR. OF
;WHERE THE PARAMETER WILL BE PUT
;THIS ALLOWS HIM TO SPECIFY THE STRING LATER
HRLI WD,-1 ;FLAG
POP P,T2 ;UNSAVE
POP P,T3 ;UNSAVE
PRMLBL: SETZ T1,
SETUWP T1, ;W/E HI-SEG
HALT
MOVEM WD,FSTVNT+1(T2) ;STORE THE ARG
JRST ACTFIN ;BACK TO MAINSTREAM
AMATCH: OUTSTR [ASCIZ/
?(PWH) MATCH NOT IMPLEMENTED YET/]
JRST SLENDX
WHNER1: OUTSTR [ASCIZ/
?WHNER1 NOT AN EVENT/]
JRST SLENDX
WHNER2: OUTSTR [ASCIZ/
?WHNER2 ILLEGAL FORMAT/]
JRST SLENDX
WHNER3: OUTSTR [ASCIZ/
?WHNER3 NO ARGUMENT/]
JRST SLENDX
WHNER4: OUTSTR [ASCIZ/
?WHNER4 ARGUMENT IS NOT AN A-Z PARAMETER/]
JRST SLENDX
SUBTTL SLAVE PROCESS - MIC SET COMMAND
;THIS COMMAND IS USED TO SET AND UNSET VARIOUS
;CONTROLS TO THE BEHAVIOR OF A MIC PROCESS
;E.G. CONTROL OF O/P IN COJOBS
;FIRST THE TABLES
;EACH ENTRY IS DEFINED BY A MACRO .SS.
;WHICH MAY HAVE UP TO FIVE ARGUMENTS
;1-NAME OF THE COMMAND
;2-LEFT HALF BIT SETTINGS---OR DEFAULT VALUE
;3-RIGHT HALF BIT SETTINGS---OR ADDRESS TO BE SET
;4-PRIVILEGE BITS---SIGN BIT MEANS [1,2] ONLY
;5-DSPATCH ROUTINE ADDRESS-BY DEFAULT SETPRF
GODBIT==400000 ;[1,2]ONLY
OCTNUM==200000 ;OCTAL ARG
NEGBIT==100000 ;IF YOU READ A +VE NO. MAKE IT -VE BEFORE U STORE IT
BMPBIT==040000 ;ADD 1 TO COMCNT IN ORDER TO FORCE MIC TO RECOMPUTE CORE
DEFINE SETS,< ;;**NB** THIS TABLE MUST BE IN STRICT ALPHABETICAL ORDER!!
IFN FTMBCH,<.SS. BATOPR,1,BATOPR,GODBIT!OCTNUM,SETVAL>
IFN FTMBCH,<.SS. BCHREQ,0,BCHREQ,GODBIT!NEGBIT!BMPBIT,SETVAL>
IFN FTCJOB,<.SS. CJREQ,ICJREQ,CJREQ,GODBIT!NEGBIT!BMPBIT,SETVAL>
IFN FTCJOB,<.SS. CJTIM,IDFTIM,DEFTIM,GODBIT,SETVLR>
IFN FTCJOB,<.SS. COJOBS,777777,WHONOT,GODBIT,SETLBT>
.SS. COLUMN1,PL.CL1
.SS. CONTROL,PL.CTL
IFN FTCJOB,<.SS. DATASET,GL.DSL,WHONOT,GODBIT,SETLBT>
IFN FTCJOB,<.SS. DEFTIM,IDFTIM,DEFTIM,GODBIT,SETVLR>
.SS. FINMATCH,PL.%FN
.SS. LOGALL,,PR.ALL
.SS. LOGNONE,,PR.LGN!PR.TIM
.SS. MAXLVL,IMXLVL,MAXLVL,GODBIT,SETVAL
IFN FTCJOB,<.SS. MAXTIM,IMXTIM,LIMTIM,GODBIT,SETVLL>
IFN FTOPR!FTCJOB,<.SS. MICOPR,1,MICOPR,GODBIT!OCTNUM,SETVAL>
.SS. NO,,,,UNSET
.SS. PARAMETER,PL.PRM
IFN FTCJOB,<.SS. PTYCJB,GL.ITY,WHONOT,GODBIT,SETLBT>
IFN FTCJOB,<.SS. REMOTE,GL.REM,WHONOT,GODBIT,SETLBT>
IFN FTCJOB,<.SS. REMSTA,GL.RBS,WHONOT,GODBIT,SETLBT>
.SS. SPECIAL,PL.NSP
.SS. TIMESTAMP,,PR.TIM
>
DEFINE .SS. (NAME,LBIT,RBIT,PRVBIT,DSP),<
<SIXBIT/NAME/>
>
SETTBL: SETS
SETLEN==.-SETTBL
DEFINE .SS. (NAME,LBIT<0>,RBIT<0>,PRVBIT,DSP),<
IFB <LBIT>,<XBIT=0>
IFNB <LBIT>,<
IFN <LBIT&777777000000>,<
XBIT=<LBIT>_<-^D18>
>
IFE <LBIT&777777000000>,<
XBIT==LBIT
>
>
<XBIT,,RBIT>
>
SETBIT: SETS
DEFINE .SS. (NAME,LBIT,RBIT,PRVBIT<.....>,DSP<SETPRF>),<
XWD PRVBIT,DSP
>
DSPSET: SETS
UNSET: TDZA N,N ;SET NO <COMMAND>
.SET: SETO N, ;HERE ON A MIC SET COMMAND
PUSHJ P,WDREAD ;GET THE ARG
PUSH P,N ;SAVE N OVER CALL TO FNDNAM
MOVE T1,[-SETLEN,,SETTBL]
PUSHJ P,FNDNAM
JRST SETRNG
POP P,N ;UNSAVE
MOVE T2,DSPSET(T1) ;GET THE DISPATCH BITS
SKIPL T2
JRST (T2) ;DISPATCH
PUSHJ P,PRVCHK ;IS HE GOD LIKE
JRST SETNPV ;NO
JRST (T2) ;YES
SETPRF: JUMPE S,LETER3 ;MUST BE RUNNING MIC
MOVE T3,SETBIT(T1) ;YES - GET ITS BITS
PUSHJ P,OTHUSR ;GET IN CONTEXT
HALT ;GORN
SKIPL N ;SET OR UNSET
SKIPA T1,[IORM T3,PROFLE(T2)] ;SET
MOVE T1,[ANDCAM T3,PROFLE(T2)] ;UNSET
SETPR2: SETZ T4,
SETUWP T4,
HALT
XCT T1
PUSHJ P,CHARSG ;GET NEXT SIGN. CHAR.
CAIN CH,"," ;IS IT A COMMA
JRST .SET ;YES SET SOME MOR THINGS
JRST DOTTY ;DUN
SETRNG: OUTSTR [ASCIZ/
?(SETRNG) UNKNOWN ARG/]
JRST SLENDX
SETNPV: OUTSTR [ASCIZ/
?(SETNPV) NO PRIVILEGES TO DO THIS/]
JRST SLENDX
;HERE ON A SET COMMAND TO SET A MIC PARAMETER
SETVLL: PUSH P,[HRLM N,(T1)] ;SET THE LEFT HALF
JRST .+4
SETVAL: PUSH P,[MOVEM N,(T1)] ;SET THE WHOLE WORD
SKIPA
SETVLR: PUSH P,[HRRM N,(T1)] ;SET THE RIGHT HALF
JUMPE N,DFLTST
TLNN T2,OCTNUM ;IN OCTAL?
SKIPA T3,[PUSHJ P,INTIN] ;NO
MOVE T3,[PUSHJ P,OCTIN] ;YES
XCT T3
SKIPN N1 ;ANYTHING READ
DFLTST: HLRZ N,SETBIT(T1) ;NO-- USE DEFAULT
HRRZ T1,SETBIT(T1) ;WOT R WE 2 SET
SETZ T3, ;W/E HI-SEG
SETUWP T3,
HALT
TLNN T2,NEGBIT ;DO WE WANT TO FIX -VE
JRST .+3 ;NO
SKIPL N ;YES IS IT -VE ALREADY
MOVNS N ;NO--FIX IT
POP P,T3 ;GET THE SET ROUTINE
XCT T3 ;OBEY IT
TLNN T2,BMPBIT ;DO WE WANT TO RECOMPUTE CORE
JRST DOTTY ;UP AND AWAY
AOS COMCNT ;YES
MOVE T1,MASTNO ;GET THE MASTER'S JOB NO.
WAKE T1, ;WAKE HIM UP
JFCL
JRST DOTTY ;AND ON OUR WAY
;PRVCHK - CHECK IF GODLIKE [1,2]
PRVCHK: SETZ T3,
GETPPN T3, ;GET HIS PPN
JFCL
CAMN T3,[1,,2] ;IS HE ??
AOSA (P) ;NO
TLO F,FLS.GD
POPJ P,0
;HERE TO SET BITS IN A WORD SPECIFIED BY THE COMMAND
SETLBT: HLLZ T3,SETBIT(T1) ;SET THE BIT IN THE L.H.
SKIPA
SETRBT: HLRZ T3,SETBIT(T1) ;SET THE BIT IN THE R.H.
HRRZ T2,SETBIT(T1) ;GET THE WORD
SKIPL N ;DID HE SAY SET OR UNSET
SKIPA T1,[IORM T3,(T2)] ;SET
MOVE T1,[ANDCAM T3,(T2)] ;UNSET
JRST SETPR2 ;AND FALL INTO SET PROFILE STUFF
SUBTTL SLAVE PROCESS - GOTO COMMAND
.BACK: TDZA P4,P4 ;BACK TO
.GO: MOVEI P4,1 ;GO TO
PUSHJ P,WDREAD ;GO/BACK ??????
CAME WD,[SIXBIT/TO/] ;GOT TO BE "TO"
JRST SLENDX
JRST .BACKTO(P4) ;THE REST AS BACKTO/GOTO
.BACKTO:TDZA P4,P4 ;READY FOR BLAB
.GOTO: MOVEI P4,1 ;READY FOR LAB
JUMPE S,.GT1 ;NOT RUNNING MIC
PUSHJ P,WDREAD ;GET THE LABEL
JUMPE WD,NOLAB ;NONE THERE
SETZ T1,
SETUWP T1, ;W/E HI-SEG
JRST LETER3
PUSHJ P,OTHUSR ;SET UP TEMP X & Y
HALT ;HE'S NOT THERE!
ADD T2,P4 ;BLAB OR LAB
MOVEM WD,BLAB(T2) ;STORE THE LABEL
JRST DOTTY ;STOP NICELY
NOLAB: OUTSTR [ASCIZ /?NO ARGUMENT FOR LABEL/]
JRST SLENDX
.GT1: PUSHJ P,WDREAD ;GET LABEL
CAMN WD,[SIXBIT/HELL/];DID HE TYPE GOTO HELL
OUTSTR [ASCIZ/GET STUFFED/] ;YES - TELL HIM OFF!
JRST SLENDX ;AND DIE
;HERE WHEN USER TYPES CANCEL
.CANCEL:TLO S,LDL.CC ;FLAG A ^C
MIC SET,L
;HERE ON MIC EXIT
.EXIT: MIC CLEAR,L ;HE'S NOT RUNNING MIC NOW
JRST DOTTY
JRST DOTTY
SUBTTL LET COMMAND
;DECODE CONSTRUCTION OF THE FORM
;LET <PARAMETER REFERENCE NAME><= OR _><STRING OR INT EXPRESION>
.LET: MOVEM L,LLX ;SAVE THE LINE NO.
PUSHJ P,CHARIT ;CHECK LEGAL TERMIN
JRST LETERR ;NOT A LEGAL TERMINATOR
MOVEM CH,CH.SAV
.LET1: PUSHJ P,PRMIN ;GET THE PARAMETER NAMED IN
CAIE CH,"="
CAIN CH,"_" ;= OR _ OK HERE
PUSHJ P,CHARIU
JRST LETER2 ;SYNTAX ERROR
CAIE CH,"$" ;COULD BE STRING REF
CAIN CH,42 ;QUOTE?
.LET3: JRST LETSTR ;MUST BE A STRING
MOVEM CH,CH.SAV ;PUT BACK THAT WHICH WE SHOULD NOT HAVE EATEN
;HERE TO DECODE INTEGER EXPRESSION AND PRODUCE STRING AS DECIMAL RESULT
PUSHJ P,INIVAL ;PREPARE TO READ INTEGER EXPRESSION
PUSHJ P,PPOLISH ;GO DECODE INTEGER EXPRESSION
JRST SLENDX ;SYNTAX ERROR GIVE UP
MOVE N,N1
MOVEI A,FIRST
HRLZI T1,440700!A
MOVE SPLODG
MOVEM LOWOUT ;PREPARE TO WRITE DECIMAL RESULT TO FIRST
PUSHJ P,DECPRT ;PRINT INTEGER AS STRING
SETZ CH,
SPLODG: IDPB CH,T1 ;MAKE ASCIZ
;HERE WITH STRING IN FIRST .....NOW FIND SOME SPACE FOR IT
.LET2: SKIPGE LLP
POPJ P,0
PUSHJ P,PRMFIX ;COPY UP PARAMETER
PUSH P,F
MOVEI F,1
SETUWP F,
HALT ;WLOCK PDB AREA
POP P,F
PUSHJ P,CHARIN ;GET NEXT SIGNIFICANT CHARACTER
CAIE CH,"," ;IF NEXT CHAR IS A COMMA
JRST DOTTY
JRST .LET1 ;....GET NEXT ASSIGNMENT
;HERE TO DECODE STRING ASSIGNMENT
;LET <PARAMETER NAME><= OR _>"<STRING>"
LETSTR: MOVEI A,FIRST
PUSHJ P,INSTR
JRST .LET2 ;GO FIND SOME SPACE
PRMIN: PUSHJ P,CHARIN ;GET NEXT SIG CHAR
PUSHJ P,LOWUP ;CONVERT LOWER CASE TO UPPER
CAIL CH,"A"
CAILE CH,"A"+ARGNUM-1 ;CHECK PARAMETER NO.
JRST LETER1 ;OUT OF RANGE
MOVEM CH,LLP ;SAVE PARAMETER NAME
PUSHJ P,DECIN ;GET QUALIFIER TO PARAMETER
MOVEM N,LEVEL ;IT REFERS TO OUTER PROCESS
POPJ P,0
PRMFIX: MOVE L,LLX ;FIND APPROPRIATE PDB
PUSHJ P,OTHUSR
JRST LETER3 ;NONE THERE ....FATAL
MOVE P2,T2 ;PRESERVE X .ER
SKIPE N,LEVEL ;DID HE REFER TO OUTER LEVEL?
PUSHJ P,UP ;YES-FIX UP
PUSHJ P,DELETE ;DELETE OLD PARAMETER & SETUP LLP
PUSHJ P,HOLE ;FIND SPACE FOR PARAMETER
JRST LETER4 ;NONE THERE
PUSH P,P1 ;PRESERVE .ER TO NEW SPACE
MOVEI T1,FIRST
HRLI T1,440700 ;PREPARE TO COPY GENERATED STRING
PUSH P,F
SETZ F,
SETUWP F,
HALT ;WEENABLE PDB AREA
POP P,F
COPY: ILDB CH,T1 ;FROM FIRST ...
IDPB CH,P1 ;... TO NEW SPACE
JUMPN CH,COPY ;UNTIL END OF STRING IN FIRST
MOVE T1,LLP ;OFFSET TO NEW PARAMETER BYTE .ER
POP P,(T1) ;& INITIALIZE TO NEW PARAMETER
POPJ P,0
;ROUTINE TO READ NEXT SIGNIFICANT CHARACTER I.E. IGNORE SP. AND TAB
CHARIT: CAIE CH," "
CAIN CH," "
CHARIU: AOS (P)
CHARIN: PUSHJ P,PINCH
CHARSG: CAIN CH," "
JRST CHARIN
CAIN CH," "
JRST CHARIN
POPJ P,0
;A ROUTINE TO DELETE EXISTING PARAMETER IF ANY AND FIX UP PARAMETER NAME
DELETE: MOVEI T3,ARGBP(P2) ;P2 POINTS TO PDB
SUBI T3,"A"
ADDB T3,LLP ;C(LLP)=NEW PARAMETER NO.!
SKIPN T4,(T3) ;IF THERE IS NO OLD PARAMETER
POPJ P,0 ;...EXIT NOW
PUSH P,F
SETZ F,
SETUWP F,
HALT
PUSHJ P,LOSE1
SETUWP F,
HALT
POP P,F
POPJ P,0
LOSE1: ILDB CH,T4 ;PICK UP
TDZN CH,CH ;IF IT WAS ZERO ALREADY
POPJ P,0 ;THEN EXIT
DPB CH,T4 ;ELSE HAVING ZEROED IT
JRST LOSE1 ;GO LOSE THE NEXT BYTE
;HERE TO ADJUST POINTER TO AN OUTER LEVEL
UP1: MOVEI T2,-1(P2)
UP: SKIPN P2,LAST(T2) ;SUSPENDED OUTER PROCESS?
JRST UPERR ;NO SUCH PROCESS
SOJG N,UP1 ;NEDD TO GO UP SOME?
SOJA P2,CPOPJ ;NO WE ARE THERE
UPERR: OUTSTR [ASCIZ/%ATTEMPT TO REFERENCE PARAMETER IN NON-EXISTANT OUTER PROCESS/]
JRST SLENDX
;A ROUTINE TO FIND SPACE IN PDB PARAMETER AREA FOR THE STRING
;HELD IN FIRST P2 POINTS TO PDB
HOLE: HRLI T1,440700
HRRI T1,ARG(P2) ;C(T1):= BYTE .ER TO PARAMETER SPACE
HRLI P3,440700
HRRI P3,FIRST ;C(P3):= BYTE .ER TO NEW PARAMETER STRING
MOVSI T4,-ARGNUM*4*5+2;NO. OF BYTES AVAILABLE IN PDB
MOVE T3,P3
SETZ P1, ;THIS IS A BYTE POINTER TO A NULL STRING!
ILDB CH,T3 ;QUICK LOOK AT FIRST BYTE
JUMPE CH,CPOPJ1 ;NO NEED TO FIND A HOLE FOR A NULL STRING
HOLE1: MOVE T3,P3 ;STARTING AT FIRST
HOLE2: ILDB CH,T1 ;LOAD A CHAR FROM PARAMETER AREA
AOBJP T4,CPOPJ ;IF WE HAVE EXHAUSTED THE AREA
JUMPN CH,HOLE2 ;SEARCH FOR NULL BYTE
;HERE WHEN WE HAVE FOUND A NULL BYTE IN RANGE IN THE PARAMETER AREA
MOVE P1,T1 ;REMEMBER WHERE WE FOUND IT
HOLE3: ILDB CH,T1 ;PICK UP NEXT BYTE IN THE PARAMETER AREA
AOBJP T4,CPOPJ ;IF IT IS NOT IN RANGE EXIT
JUMPN CH,HOLE1 ;IF IT IS NOT NULL START AGAIN
;YES-WE HAVE SPACE FOR A BYTE
ILDB CH,T3 ;IS THERE A BYTE FROM FIRST TO PUT THERE?
JUMPN CH,HOLE3 ;YES-GO FIND SPACE FOR NEXT BYTE
;NO-WE HAVE ALL THE SPACE WE NEED
AOS (P)
POPJ P,0
;LET COMMAND ERROR MESSAGES
BUNGLE:
IFERR1:
LETERR: MOVEI T1,[ASCIZ/ ILLEGAL CHARACTER /]
LETERX: PUSHJ P,POLTYP
JRST CHTYP
LETER1: MOVEI T1,[ASCIZ/ PARAMETER MUST BE A-Z NOT/]
JRST LETERX
LETER2: MOVEI T1,[ASCIZ/ NO ASSIGNMENT SHOULD BE = NOT/]
JRST LETERX
LETER3: OUTSTR [ASCIZ/?NOT RUNNING MIC/]
JRST SLENDX
LETER4: OUTSTR [ASCIZ/?PARAMETER SPACE EXHAUSTED/]
JRST SLENDX
.RSERR:
DISERR: SETZ T1,
LETTYP: OUTSTR [ASCIZ/?SYNTAX ERROR - /]
SKIPE T1
OUTSTR (T1)
JRST SLENDX
SUBTTL RESPONSE COMMAND - READ ERROR LINE FEATURE
;MIC RESPONSE AN(N1)
; AN=PARMETER AND QUALIFIER TO GET ERROR LINE
; N1=NO OF CHARS SPACE TO BE RESERVED FOR ERROR LINES
.RESPO: MOVEM L,LLX
PUSHJ P,PRMIN ;READ PARAMETER PLUS QUALIFIER
CAIE CH,"("
JRST .RSERR
PUSHJ P,DECIN
CAIE CH,")" ;MUST BE AN(N1)
CAIG N,^D79
CAIG N,0
JRST .RSER1
MOVEI BP,FIRST ;WHERE THE ROUTINES EXPECT THE PARAMETER TO BE
HRLI BP,440700
MOVEI CH," " ;FILL WITH SPACES
IDPB CH,BP
SOJG N,.-1
SETZ CH,
IDPB CH,BP ;MAKE ASCIZ
PUSHJ P,PRMFIX ;COPY UP PARAMETER
MOVEM T1,RS(P2) ;REMEMBER WHERE HE WANTS RESPONSE TO GO
PUSH P,F
SETZ F,
SETUWP F,
HALT
POP P,F
MOVE L,LLX
MIC GET,L ;GET THE LINE CHARACTERISTICS AGAIN
HALT
TLO S,LDL.RS
JRST DOTMIC ;SET FLAG TO REQUEST FEATURE AND EXIT
.RSER1: MOVEI T1,[ASCIZ/MAX RESPONSE 79. CHARS/]
JRST LETTYP
SUBTTL IF COMMAND
;HERE ON FINDING IF COMMAND --- DECODE THE CONTENTS OF ()
.IF: MOVEM L,LLX ;SAVE LINE NUMBER FOR OTHUSR
PUSHJ P,CHARSG ;GET NEXT SIG. CHAR
CAIE CH,"(" ;HAVE WE GOT A ( ?
JRST IFERR3 ;NO - ERROR
PUSHJ P,ALPHI ;GET ALPHA WORD
JUMPE WD,EXPRES ;MUST BE SOME OTHER FLAVOUR OF CONDITIONAL EXPRESSION
CAIE CH,")" ;THE CONTENTS OF () IN WD WAS THAT A )
JRST IFERR3 ;NO
MOVE T1,[-PROSIZ,,PROTAB] ;TABLE INFO.
PUSHJ P,FNDNAM ;SEARCH IT
JRST IFERR3 ;FAILED
JRST @PRODSP(T1) ;AND DISPATCH REGARDLESS
DEFINE IF.COND,<
.IF. BATCH
.IF. COJOB
.IF. ERROR
.IF. NOERROR
>
DEFINE .IF. (NAME),<
<SIXBIT/NAME/>
>
PROTAB: IF.COND
PROSIZ==.-PROTAB
DEFINE .IF. (NAME),<
XWD 0,<%'NAME>
>
PRODSP: IF.COND
;HERE TO DECIDE WHETHER IT WAS A STRING OR AN INTEGER CONDITIONAL EXPRESSION IN ()
EXPRES: SETZM CH.SAV ;CLEAR THE CHAR BUFFER
CAIE CH,"$" ;REFSTRING?
CAIN CH,42 ;QUOTE?
JRST STRING
MOVEM CH,CH.SAV ;MUST HAVE EATEN BIT OF INTEGER EXPRESSION
JRST POLISH ;GO DECODE IT
IFERR2: PUSHJ P,BUNGLE
CHTYP: CAIGE CH," "
JRST ILCH2
OUTSTR [ASCIZ/ "/]
OUTCHR CH
OUTSTR [ASCIZ/"/]
ILCH2: OUTSTR [ASCIZ/ OCTAL /]
MOVE N,CH
PUSHJ P,OCTPRT
JRST SLENDX
;THAT WAS A FUNNY CONDITIONAL
IFERR3: MOVEM CH,CH.SAV ;SAVE THE TERMINATOR
LDB CH,[POINT 6,WD,5]
TLNE WD,007777 ;MUST BE ONE CHAR
JRST IFERX ;NOT
ADDI CH," " ;RETRIEVE PARAM AND MAKE ASCII
MOVEI T1,[ASCIZ/NO CONDITIONAL/]
CAIL CH,"A"
CAILE CH,"Z"
JRST LETERX ;GIVE UP
JRST AEXPRESS ;TWAS A-Z
AEXPRES:PUSHJ P,INIVAL
PUSHJ P,ATOM1 ;READ THAT AS AN INTEGER
PUSHJ P,PPOL1 ;AND READ IN THE REST OF THE CONDITIONAL
JRST FAILED ;SYNTAX ERROR MAKES FALSE
JRST POL1
IFERX: MOVEI T1,[ASCIZ /CONDITIONAL "/]
PUSHJ P,POLTYP
PUSHJ P,SIXBP
OUTSTR [ASCIZ/" NOT DEFINED/]
JRST SLENDX
;JS BIT TO O/P ERROR MESSAGES FOR BAD GETTABS
IFERR4: PUSHJ P,POLTYP ;ON ERROR EXIT FROM GETTAB
;T1 HOLDS ADDRESS OF ERROR MESSAGE
JRST SLENDX
;END OF THIS JS BIT
IFN FTCJOB,<
;HERE ON CONDITION COJOB
%COJOB: PUSHJ P,OTHUSR
JRST FAILED
SKIPE CJOWNR(T2)
JRST TRUE
JRST FALSE ;PROVIDE A METHOD THAT ALLOWS A USER TO DETECT IF COJOB
> ;END OF CONDITION COJOB
IFN FTMBCH,<
;HERE ON CONDITION BATCH
%BATCH: PUSHJ P,OTHUSR ;GET IN CONTEXT
JRST FAILED
SKIPE BATWRD(T2) ;=0 IF NOT BATCH
JRST TRUE
JRST FALSE
;PROVIDES A MEANS TO ALLOW THE USER TO DETECT IF BATCH JOB
>;END OF IFN FTMBCH
IFE FTCJOB,<
%COJOB: JRST FALSE
>
IFE FTMBCH,<
%BATCH: JRST FALSE
>
;HERE ON CONDITION (ERROR)
%NOERROR:TLC S,LDL.ER
%ERROR: TLNN S,LDL.ER ;IS THAT TRUE?
PUSHJ P,FNDEOL ;JUST EAT THE REST OF THE LINE
DOTMIC: TLZ S,LDLCHK!LDL.ER!LDL.TI!LDL.MM
MIC SET,L ;CLEAR ERROR BITS
JFCL
JRST TRUE
DOTTY:
CAIN CH,"\" ;E.O.L CHAR. (BY DEFN.)
JRST DOTTY1 ;LET COMCON EAT THE REST OF THE LINE
CAIN CH,"." ;IF THIS IS A DOT
JRST EXIT1 ;LET COMCON EAT WHAT FOLLOWS
PUSHJ P,ISBRK ;IF IT IS A BREAK
JRST [CAIE CH,CR ;CARRIAGE RETURN?
JRST EXIT1
JRST .+1]
DOTTY1: PUSHJ P,CHARIN
JRST DOTTY ;ELSE GO ROUND
FNDEOL: PUSHJ P,ISBRK ;BREAK ALREADY?
POPJ P,0 ;YES
PUSHJ P,CHARIN ;NO-GET THE NEXT CHAR
JRST FNDEOL ;AND SEE IF THAT IS A BREAK
TRUE: JRST DOTTY
FALSE: JRST FAILED
;HERE TO DEAL WITH CONSTRUCTIONS OF THE FORM
;<STRING>"<CONDITIONAL OPERATOR>"<STRING>"
STRING: MOVEI A,FIRST ;GET IN THE FIRST STRING
PUSHJ P,INSTR
PUSHJ P,LEGREQ ;GET IN THE CONDITIONAL OPERATOR
JRST STRER1 ;WOT!
PUSHJ P,CHARIN
CAIN CH,"$" ;COULD BE REF STRING PARAM
JRST STRIN2 ;IT WAS
CAIE CH,42 ;GET DELIMETER TO THE NEXT STRING
JRST STRER2 ;ILLEGAL
STRIN2: MOVEI A,SECOND ;GET IN THE SECOND STRING
PUSHJ P,INSTR
;HERE TO CHECK STRINGS AGREE WITH THE CONDITION IN BOOL
MOVE A,STRP1
MOVE B,STRP2
STRLUP: ILDB N,A
ILDB N1,B ;PICK UP CORRESPONDING BYTES
CAME N,N1 ;IF THEY ARE NOT THE SAME TEST NOW
JRST STRCHK
JUMPE N,STRCHK
JUMPN N1,STRLUP ;CHECK ALSO IF EITHER STRING EXHAUSTED
STRCHK: XCT BOOL ;TEST THE CONDITIONAL
JRST FALSE
JRST TRUE
STRP1: POINT 7,FIRST
STRP2: POINT 7,SECOND
STRER1: MOVEI T1,[ASCIZ/UNKNOWN CONDITIONAL OPERATOR /]
JRST LETERX
STRER2: JSP T1,LETTYP
ASCIZ/MISMATCH OF TYPES/
;A ROUTINE TO READ A STRING DELIMETED BY A QUOTE
INSTR: CAIE CH,"$" ;REF STRING PARAM?
JRST INSTR0 ;NO TWAS STRING CONSTANT
PUSHJ P,ALPHI ;GET IT'S NAME
MOVSI T3,-SYMSIZ ;WOT IS IT?
CAME WD,SYMTAB(T3) ;IS IIT ONE OF THESE?
AOBJN T3,.-1
JUMPLE T3,IFNPRM ;IF T1 #0 IT IS!
TLNE WD,7777 ;WE SHOULD BE LEFT WITH 1 SIXBIT CHAR.
JRST IFERR2 ;BUT WE HAD MORE!
LSH WD,-36 ;MAYBE IT'S A THRO' Z
CAIL WD,'A'
CAILE WD,'A'+ARGNUM-1
JRST IFERR2 ;IT'S NOT!!
MOVEM CH,CH.SAV ;JUST IN CASE WE HAVE BEEN GREEDY
MOVEI CH," "(WD) ;IT IS!!!
PUSH P,A ;SAVE THE IMPORTANT AC
PUSHJ P,REFBP ;COMPUTE POINTER TO PARAMETER
POP P,A ;RESTORE AC
INSTR5: HRLZI T1,440700!A ;MAKE BYTE POINTER TO STRING CONSTRUCTION SPACE
ILDB CH,BP
IDPB CH,T1 ;SHOVEL PARAMETER INTO SCRATCH SPACE
JUMPN CH,.-2
JRST INSTR3 ;GO DO SUBSCRIPT OR CON CATONATION
INSTR0: CAIE CH,42
JRST IFERR2
HRLZI T1,440700!A ;A. NOW POINTS TO STRING
INSTR1: PUSHJ P,PINCH ;GET A CHARACTER
CAIN CH,42 ;QUOTE?
JRST QUOTED ;YES
CAIN CH,LF
OUTSTR [ASCIZ/--/]
INSTR2: IDPB CH,T1 ;NO - JUST DEPOSIT THAT CHAR
JRST INSTR1 ;AND GET NEXT
QUOTED: PUSHJ P,PINCH ;GET NEXT CHAR
CAIN CH,42 ;QUOTE?
JRST INSTR2 ;YES - LET HIM HAVE THAT ONE FREE
EXCH CH,CH.SAV ;NO - NOTHING TO DO WITH US PUT IT BACK
IDPB CH,T1 ;MAKE ASCIZ
INSTR3: PUSHJ P,CHARIN ;GET NEXT SIGNIFICANT CHAR
INSTR4: CAIN CH,"." ;STRING DELIMETED BY .?
JRST SUBSCR ;YES-MUST BE SUBSCRIPTED
CAIN CH,"+" ;CONCATONATION
JRST CONCAT
MOVEM CH,CH.SAV ;NO-PUT IT BACK AGAIN
POPJ P,
;START OF A JS BIT
IFNPRM: MOVEM CH,CH.SAV ;SAVE THE TERMINATOR-THIS WILL NOT BE CORRECT IN
; ;THE CASE OF GETTABS
PUSHJ P,SYMGET
JRST IFERR4
JRST INSTR5
;HERE WHEN HAVING READ AN DECODED A STRING PLUS ANY SUBSCRIPTS A + IS FOUND
CONCAT: PUSH P,A ;SAVE A
ADDI A,1(T1) ;POINT PAST EXISTING STRING
PUSHJ P,CHARIN;GET $ OR "
PUSHJ P,INSTR ;AND GET IN THE STRING EXPRESSION U WISH TACKED ON
;HER WHEN A POINTS TO STRING U WISH TACKED ON
MOVE T2,A ;PRESERVE IT
HRLI T2,440700
;AND MAKE BYTE POINTER TO IT IN T2
POP P,A ;NOW T1 IS A BYTE POINTER TO NULL BYTE OF LAST STRING
MOVSI T1,440700!A
ILDB CH,T1
JUMPN CH,.-1 ;SYNC ON LAST BYTE OF CONSTRUCTED STRING
ILDB CH,T2 ;LOADING A BYTE FROM SECOND STRING
DPB CH,T1 ;OVERWRITE NULL BYTE IN FIRST STRING
JUMPE CH,CPOPJ;GIVE UP IF THE STRING WANTED CONCATONATED WAS NULL
ILDB CH,T2
IDPB CH,T1 ;ELSE KEEP SHOVELLING
JUMPN CH,.-2 ;UNTIL TACKED ON ALL OF SECOND STRING
POPJ P,0 ;THEN EXIT
;A ROUTINE TO ADJUST STRING POINTED TO BY C(A) TO REFLECT SUBSCRIPTS
;T1 POINTS TO TERMINATING BYTE IN STRING
;CONSTRUCTION COULD BE "<STRING>".[<STRING OR INT EXPRESSION>,<DITTO>]
;SECOND SUBSCRIPT MAY BE OMMITTED
SUBSCR: PUSHJ P,CHARIN ;GET NEXT SIG. CHAR
CAIE CH,"[" ;GOT TO BE THIS
JRST SUBERR
PUSH P,A ;SAVE A
PUSH P,T1 ;&T1
PUSHJ P,CHARIN
CAIE CH,"$" ;REFSTRING PARAM?
CAIN CH,42 ;QUOTE?
JRST SUBS1 ;YES THIS IS A STRING EXPPRESSION
MOVEM CH,CH.SAV ;NO-REPLACE IT
PUSHJ P,INIVAL ;GET FIRST SUBSCRIPT IN N1
PUSHJ P,PPOLISH
JRST SLENDX ;BAD INTEGER EXPPRESSION
;HERE TO LEFT SHIFT THE STRING ACCORDING TO THE FIRST SUBSCRIPT
SUBSCX: MOVE A,-1(P) ;RESTORE A
MOVSI T1,440700!A
MOVE T2,T1 ;START AT THE BEGGING OF THE STRING
JUMPG N1,SUBSC1 ;ARG POSITIVE PROCEED
TDZA N,N ;CLEAR COUNT AND SKIP
ADDI N,1 ;BUMP STRING LENGTH
ILDB CH,T1 ;LOAD CHAR FROM STRING
JUMPN CH,.-2 ;BUMP COUNT IF SIGNIFICANT
JUMPE N,Z2SUB ;THIS IS A NULL STRING
ADDI N1,1(N) ;ADD ON STRING LENGTH TO NEGATIVE SUBSCRIPT
JUMPLE N1,SUBSC3 ;STILL OUT OF RANGE
MOVE T1,T2 ;RESTORE ORIGINAL BYTE POINTER
SUBSC1: SOJLE N1,SUBSC2 ;COUNT THE SUBSCRIPT DOWN
ILDB CH,T1 ;CHECK THE CHAR.
JUMPE CH,SUBSC3 ;WE HAVE EXHAUSTED THE STRING...
JRST SUBSC1 ;KEEP COUNTING AND CHECKING
;HERE WHEN WE HAVE REACHED THE CORRECT BYTE NUMBER
SUBSC2: ILDB CH,T1 ;MOVE BYTES FROM HERE ON DOWN
SUBSC3: IDPB CH,T2 ;TO THE TOP OF THE STRING ONWARDS
JUMPN CH,SUBSC2 ;KEEP SHIFTING UNTIL MOVED ALL
;HERE WHEN LEFT SHIFTED STRING AFTER FIRST SUBSCIPT
Z2SUB: PUSHJ P,CHARIN ;GET THE NEXT CHAR
CAIE CH,"]" ;END OF SUBSCRIPT?
JRST Z2SUB1 ;NO-CHECK SOME MORE
MOVEI N1,1 ;YES-PRETEND SECOND ARG 1
MOVEM CH,CH.SAV ;FOOL THE REDUNDANT CHECK
JRST Z2SUB3
Z2SUB1: CAIN CH,"," ;GOT TO BE A COMMA
JRST Z2SUB2 ;AND IT IS
SUBERR: MOVEI T1,[ASCIZ/ STRING SUBSCRIPT ILLEGAL CHARACTER /]
JRST LETERX
Z2SUB2: PUSHJ P,CHARIN ;GET THE NEXT CHAR
CAIE CH,"$" ;REF STRING PARAM?
CAIN CH,42 ;QUOTE?
JRST SUBS2 ;YES THIS IS A STRING EXPRESSION
MOVEM CH,CH.SAV ;NO-PUT CHAR BACK
PUSHJ P,INIVAL ;PREPARE TO READ INTEGER EXPPRESSION
PUSHJ P,PPOLISH
JRST SLENDX
;HERE TO TRUNCATE STRING ACCORDING TO THE CONTENTS OF N1 FOR SECOND SUBSCRIPT
Z2SUB3: MOVE A,-1(P) ;RESTORE A
MOVSI T1,440700!A ;POINT TO IT
Z2SUB6: ILDB CH,T1
JUMPE CH,Z2SUB5 ;THIS STRING TOO SHORT ALREADY
SOJG N1,Z2SUB6 ;ELSE COUNT DOWN SECOND SUBSCRIPT
Z2SUB4: SETZ CH,
IDPB CH,T1 ;TRUNCATE THE STRING
Z2SUB5: POP P,T1
POP P,A
PUSHJ P,CHARIN ;MAKE SURE GOOD TERMINATOR
CAIE CH,"]" ;GOT TO BE THIS
JRST SUBERR
PUSHJ P,CHARIN ;GET POTENTIAL . OR +
JRST INSTR4 ;AND CHECK FOR IT
;HERE WHEN FIRST SUBSCRIPT IS A STRING EXPRESSION
SUBS1: PUSHJ P,SCRPTI ;TRY AND FIND MATCH FOR IT
JRST SUBS12 ;NO MATCH FOUND
LDB CH,T1
MOVSI T2,440700!B
JRST SUBSC3
SUBS12: SETZM (B) ;NO MATCH
JRST Z2SUB ;GET NEXT SUBSCRIPT
;HERE WHEN SECOND SUBSCRIPT IS A STRING EXPRESSION
SUBS2: PUSHJ P,SCRPTI ;TRY AND FIND MATCH FOR IT
JRST Z2SUB5 ;NO MATCH DO NOT TRUNCATE
DPB T3,T4
JRST Z2SUB5 ;TRUNCATE
;A ROUTINE TO GET A STRING SUBSCRIPT IN AND FIND MATCH IN OBJECT STRING
SCRPTI: MOVE T1,-1(P) ;RESTORE T1
MOVE A,-2(P) ;AND A
ADDI A,1(T1) ;POINT PAST EXISTING STRING
PUSHJ P,INSTR ;AND GET STRING SUBSCRIPT IN
MOVE B,-2(P) ;B POINTS TO OBJECT STRING
MOVSI T1,440700!B
LDB T4,[POINT 7,(A),6]
JUMPE T4,CPOPJ ;NULL SEARCH STRING
NOMAT2: MOVSI T2,440700!A
ILDB CH,T1 ;PICK UP BYTE FROM OBJECT STRING
SKIPA T4,T1 ;REMEMBER WHERE WE ARE
MAT2: ILDB CH,T1 ;GET NEXT BYTE AFTER LAST BYTE MATCHED
ILDB T3,T2 ;GET NEXT BYTE FROM SEARCH STRING
JUMPE T3,CPOPJ1 ;WE HAVE EXHAUSTED SEARCH STRING --SUCCESS
JUMPE CH,CPOPJ ;NO NEED TO TRUNCATE-TOO SHORT ALREADY
CAMN T3,CH ;THIS BYTE MATCH?
JRST MAT2 ;YES TRY NEXT
;NO
MOVE T1,T4 ;BACK UP OBJECT STRING TO A GOOD PLACE
JRST NOMAT2 ;AND START SEARCH AGAIN
;AC DEFINITIONS FOR THE EXPRESSION EVALUATING STUFF
STK=1 ;REVERSE POLISH STYLE STACK
A==P1 ;OPERATION CODE
B==P2 ;THUNK HEADER ADDRESS
C==P3 ;PRIORITY
D==P4 ;STACKED PRIORITY
E==R ;LOW ORDER RESULT IN EXP EVALUATION
H==X ;OUTPUT HEAP . WORKS LIKE STACK
;HERE TO DEAL WITH CONTRUCTIONS OF THE FORM
;<INTEGER EXPRESSION><CONDITIONAL OPERATOR><INTEGER EXPRESSION>)
POLISH: PUSHJ P,INIVAL ;PREPARE TO READ INTEGER EXPRESSION
PUSHJ P,PPOLISH ;EVALUATE EXPRESION
JRST FAILED ;SYNTAX ERROR MAKES IT FALSE
POL1: PUSH P,N1 ;SAVE THE INTEGER RESULT ON PERM. STACK
PUSHJ P,LEGREQ ;GET CONDITIONAL EXPRESSION
JRST STRER1
PUSHJ P,INIVAL ;PREPARE TO READ INTEGER EXPPRESSION
PUSH STK,.OB ;PRETEND WE SAW AN OPEN BRACKET
PUSHJ P,PPOLISH ;EVALUATE EXPRESION
JRST FAILED ;SYNTAX ERROR MAKES IT FALSE
POP P,N ;RESTORE FIRST INTEGER FROM PERM STACK
JRST STRCHK
;A ROUTINE TO INITIALIZE EXPRESSION READ
INIVAL: MOVE STK,SSS
MOVE H,HHH ;SET UP HEAP AND STACK
PUSH STK,.EOS ;MARK THE END OF THE STACK
TLO F,FL.MOP ;ENABLE MONADIC OPERATOR SCAN
POPJ P,0
SSS: IOWD 100,SS
HHH: IOWD 100,HH
;A ROUTINE TO GET THE ARITHMETIC CONDITION IN BOOL
;CAN ONLY BE > >= = <= #
LEGREQ: PUSHJ P,CHARIN ;GET THE NEXT CHAR
CAIN CH,"#" ;IS IT?
JRST NOTEQ ;YES
CAIN CH,"=" ;IS IT?
JRST EQ ;YES
CAIN CH,74 ; IS IT <
JRST LESS ;YES-BUT COULD BE <=
CAIN CH,76 ; IS IT >
JRST GREAT ;YES-BUT COULD BE >=
CAIN CH,"."
JRST LOGICL
POPJ P, ;NONE OF THOSE GIVE UP
NOTEQ: MOVSI T1,6000 ;CAMN
JRST LEGRE1
EQ: MOVSI T1,2000 ;CAME
JRST LEGRE1
LESS: PUSHJ P,PINCH ;MAY BE < OR <= SO CHECK NEXT CHAR.
MOVSI T1,3000 ;MAY BE CAMLE
CAIN CH,"=" ;IS IT?
JRST LEGRE1 ;YES
MOVSI T1,1000 ;NO MUST BE CAML
MOVEM CH,CH.SAV ;REPLACE THE DIVITS
JRST LEGRE1
GREAT: PUSHJ P,PINCH
MOVSI T1,5000 ;CAMGE?
CAIN CH,"="
JRST LEGRE1 ;YES
MOVSI T1,7000 ;NO MUST BE CAMG
MOVEM CH,CH.SAV
LEGRE1: MOVE A,[CAM N,N1]
ADD A,T1 ;FILL IN CORRECT FLAVOUR OF CAM
LEGRE2: MOVEM A,BOOL
AOS (P)
POPJ P,
;HERE TO CHECK UP ON LOGICAL CONDITIONALS
;(E.G. .AND. OR .OR. )
LOGICL: PUSHJ P,WDREAD ;GET THE OPERATION
PUSHJ P,CHARSG ;AND THE TERMINATOR
CAIE CH,"." ;CHECK IT
POPJ P,0 ;FAILED?
CAMN WD,[SIXBIT/AND/]
JRST ANDAND
CAMN WD,[SIXBIT/OR/]
JRST OROR
POPJ P,0
ANDAND: SKIPA A,[PUSHJ P,AND%IT]
OROR: MOVE A,[PUSHJ P,OR%IT]
JRST LEGRE2
AND%IT: AND N,N1
SKIPA
OR%IT: OR N,N1
SKIPE N
AOS (P)
POPJ P,0
PPOLISH:
NUMBER: PUSHJ P,ATOM ;READ INTEGER OR DECODE REF INT PARAM
PPOL1: PUSH H,.VALUE
PUSH H,N ;PASS NUMBER TO HEAP
OPDISP: MOVEI A,%PRI ;REQUEST POTENTIALLY
MOVSI T2,-OPLEN
TLZE F,FL.MOP ;JUMP IF MONADIC OPERATORS NOT LEGAL
SUBI T2,MADICN ;ENABLE SCAN OF MONADIC OPERATORS
OPCHK: HLRZ T1,OP(T2)
CAME T1,CH ;FIND A MATCH IN TABLE
AOBJN T2,OPCHK ;THERE IS A CATCHALL IF NOTHING
HRRZ T1,OP(T2)
JRST (T1) ;DISPATCH ON CHAR. TERMINATOR
MADIC: "-",,MMINUS ;MONADIC OPERATORS
MADICN==.-MADIC
OP: "]",,SEXIT
CR,,SEXIT
LF,,SEXIT
ALT,,SEXIT
ALT175,,SEXIT
ALT176,,SEXIT
".",,SEXIT
"#",,SEXIT
"=",,SEXIT
"(",,OB ;OPEN BRACKETS
074,,SEXIT
")",,CB ;CLOSE BRACKETS
",",,SEXIT
76,,SEXIT
"+",,PLUS
"-",,MINUS
"*",,TIMES
"/",,DIVIDE
"^",,EXPO
"&",,ANDED
"!",,ORED
"\",,SEXIT ;E.O.L. BY DEFN.
REPEAT MADICN,<IFERR2>
OPLEN=.-OP
IFERR2 ;CATCH ALL
;FUNNY ATOM INPUT DISPATCH ROUTINE
SEXIT: MOVEM CH,CH.SAV
JRST .END.
JUNK: POP STK,(STK) ;LOSE OPEN BRACKET FROM STACK
PUSHJ P,ATOM ;READ NEXT INT OR DECODE REFINT PARAM
JUMPN N1,PERR1 ;HE DID SOMETHING LIKE )NNN
SOJA N1,OPDISP ;SET FLAG TO SAY OK FOR NEXT OPERATOR AT DUBLOP: AND DISPATCH ON NEXT CHAR
OB: TLO F,FL.MOP ;(- ALLOWED
PUSH STK,.OB ;STACK OPEN BRACKET THUNK HEADER
POP H,N ;WE THOUGHT WE READ A NUMBER
POP H,(H) ;SO JUNK IT AND THUNK HEADER
JUMPN N1,PERR2 ;TUT-HE DID SOMETHING LIKE NNN(
;WITH NO INTERVENING OPERATOR
JRST NUMBER ;AND READ NEXT NO.
;HERE ON ENCOUNTERING CLOSED BRACKET INP
CB: JUMPE N1,PERR3 ;HE SAID NOTHING IN THOSE BRACKETS
MOVEI A,%OB ;SEARCH FOR CORRESPONDING
JRST @(STK) ;OPEN BRACKET ON STACK
;HERE ON ENCOUTERING ; INPUT ATOM
.END.: MOVEI A,%FIN ;TO FINISH WITH COPY
;EVERYTHING FROM STACK
JRST DUBLOP ;TO HEAP HAVING CHECKED SOMETHING IS THERE
;END OF FUNNY INPUT DISPATCH ROUTINES
;HERE TO PLACE ITEM ON STACK
STAK: PUSH STK,(B) ;STACK THUNK HEADER WORD
JRST NUMBER
;HERE TO OUTPUT ITEM TO HEAP
HEEP: PUSH H,(STK) ;PUT ITEM ON HEAP
POP STK,(STK) ;UPDATE
JRST @(STK) ;AND CARRY ON
;HERE TO CHECK ITEM PRIORITY
COMPAR: XCT (B) ;D:=INPUT ATOM PRIORITY
;C=STACKED CONSTITUENT PRIORITY
CAMG D,C
JRST HEEP ;LESS THAN INPUT CONSTITUENT
JRST STAK ;INPUT PRIORITY-STACK INPUT
;ITEM
;HERE TO CHECK THAT A NUMBER DID COME BETWEEN TWO ATOMS
DUBLOP: JUMPE N1,PERR4
JRST @(STK) ;GO DO ACCORDING TO CONTENTS OF A
;HERE WHEN A THUNK DECIDES ON A % EX
;OPERATION THAT THIS IS AN OPERATOR
;THAT CAN BE APPLIED TO THE TOP
;OF THE STACK USING THE STATEMENT
;CONTAINED IN AC D
DOIT: ADDI H,1 ;UPDATE HEAP POINTER
POP STK,C ;RESTORE TOP OF STACK
EXCH C,(STK)
XCT D ;DO OPERATOR (RESULT BACK ON STACK)
JRST @ (H) ;DO NEXT ATOM ON HEAP
;SAME AS DOIT BUT OPERATOR TOO COMPLEX
;TO BE EXECUTED IN D
;EXPONENTIATION X^N=X'*X2
DOEXP: ADDI H,1 ;UPDATE HEAP POINTER
POP STK,D ;RESTORE TOP OF STACK
MOVE C,(STK) ;EXPONENT IN C
;ACCUMULATE RESULT IN B
MOVEI B,1
DOEXP2: LSHC D,-1 ;BIT FROM EXPONENT
SKIPGE E ;IF THERE IS NO BIT HERE DO NOT.....
IMUL B,C ;INCLUDE IT IN RESULT
IMUL C,C ;SQUARE FOR NEXT BIT FROM EXPONENT
MOVEM B,(STK) ;STORE POTENTIAL RESULT
JUMPE D,@(H) ;IF EXPONENT CLEARED WE HAVE FINISHED
JRST DOEXP2 ;ELSE STORE RESULT AND GO ROUND
;THE EXPRESSION IS TRANSLATED TO REVERSE POLISH
;USING THE USUAL PRIORITY SCHEME FOR EACH ATOM
;ENCOUNTERED.
;OUTPUT FROM THE STACK IS COPIED TO THE HEAP
;NUMBERS ARE PASSED FROM INPUT DIRECTLY TO THE
;HEAP AS TWO ATOMS (A VARIABLE THUNK HEADER AND
;THE NUMBER ITSELF)
;A THUNK IS A SET OF VARIABLES ASSOCIATED
;WITH EACH ATOM (PRIORITY, DISPATCH ADDRESSES ETC)
;THE REVERSE POLISH EXPRESSION ON THE HEAP
;IS EXECUTED AGAIN USING THE STACK
;EACH OPERATION IS TABLE DRIVEN FROM THE
;THUNKS - AN OPERATION CODE IS LOADED
;IN AC A AND INITIATED BY DISPATCHING
;INDIRECTLY THROUGH THE APPROPRIATE THUNK
;HEADER WORD
;OPERATION CODES (COMPILE)
%PRI==0 ;TAKE ACTION DEPENDING ON INPUT ATOM
;PRIORITY
;C(B) = POINTER TO INPUT ATOM THUNK
%OB==2 ;ENCOUNTERED CLOSED BRACKET INPUT ATOM
;COPY STACK TO HEAP UNTIL OPEN BRACKET
;THUNK HEADER ENCOUNTERED ON STACK
%FIN==3 ;ENCOUNTERED ;INPUT ATOM COPY
;EVERYTHING TO HEAP (UNLESS WRONG
;THUNK HEADER FOUND ON STACK)
;FINISHED COMPILATION WHEN FOUND
;END-OF-STACK THUNK HEADER ON
;STACK
;OPERATION CODES (EXECUTE)
%EX==4 ;COLLAPSE HEAP TO STACK UNTIL
;OPERATION CODE THUNK HEADER
;ENCOUNTERED - THEN APPLY
;OPERATOR TO TOP TWO ATOMS (NUMBERS)
;ON STACK LEAVING ONE RESULT
;THUNK FOR OPERATOR DIVIDE /
DIVIDE: JSP B,DUBLOP
.DIVIDE:HRRZ D,.+1(A)
MOVEI C,3 ;%PRI
JRST COMPAR
JRST HEEP ;%OB
JRST HEEP ;%FIN
MOVE D,[IDIVM C,(STK)] ;%EX
JRST DOIT
;THUNK FOR EXPONENTIAL OPERATOR ^
EXPO: JSP B,DUBLOP
.EXPO: HRRZ D,.+1(A)
MOVEI C,4 ;%PRI
JRST COMPAR
JRST HEEP ;%OB
JRST HEEP ;%FIN
JRST DOEXP ;%EX - NO SINGLE INSTR.!
;THUNK FOR OPERATOR PLUS +
PLUS: JSP B,DUBLOP
.PLUS: HRRZ D,.+1(A)
MOVEI C,2 ;%PRI
JRST COMPAR
JRST HEEP ;%OB
JRST HEEP ;%FIN
MOVE D,[ADDM C,(STK)] ;%EX
JRST DOIT
;THUNK FOR OPERATOR *
TIMES: JSP B,DUBLOP
.TIMES: HRRZ D,.+1(A)
MOVEI C,3 ;%PRI
JRST COMPAR
JRST HEEP ;%OB
JRST HEEP ;%FIN
MOVE D,[IMULM C,(STK)]
JRST DOIT
;THUNK FOOR OPERATOR ! (.OR.)
ORED: JSP B,DUBLOP
.ORED: HRRZ D,.+1(A)
MOVEI C,3 ;%PRI
JRST COMPAR
JRST HEEP ;%OB
JRST HEEP ;%FIN
MOVE D,[ORM C,(STK)]
JRST DOIT
;THUNK FOR OPERATOR & (.AND.)
ANDED: JSP B,DUBLOP
.ANDED: HRRZ D,.+1(A)
MOVEI C,3 ;%PRI
JRST COMPAR
JRST HEEP ;%OB
JRST HEEP ;%FIN
MOVE D,[ANDM C,(STK)]
JRST DOIT
MINUS: JSP B,DUBLOP
.MINUS: HRRZ D,.+1(A)
MOVEI C,2 ;%PRI
JRST COMPAR
JRST HEEP ;%OB
JRST HEEP ;%FIN
MOVE D,[SUBM C,(STK)] ;%EX
JRST DOIT
;THUNK FOR OPERATOR MONADIC MINUS -
MMINUS: JSP B,@(STK) ;WE KNOW WE CAN ONLY GET HERE AFTER ( OR START
.MMINUS: HRRZ D,.+1(A)
MOVEI C,5 ;%PRI
JRST COMPAR
JRST HEEP ;%OB
JRST HEEP ;%FIN
MOVE D,[SUBM C,(STK)] ;%EX
JRST DOIT
;THUNK TO MARK END-OF-STACK
.EOS: HRRZ D,.+1(A)
MOVEI C,0 ;%PRI - NO PRIORITY
JRST STAK ;SO JUST STACK INPUT ATOM
JRST PERR5 ;%OB - OOPS BRACKETS MISMATCH
; JRST COMPIL ;%FIN - FINISHED COMPILING
COMPIL: PUSH H,.EOH ;MARK END OF HEAP WITH THUNK
MOVE STK,SSS
MOVEI H,HEAP ;AND START AT TOP OF HEAP
MOVEI A,%EX ;EXECUTE REVERSE POLISH
JRST @(H)
;THUNK FOR OPEN BRACKET
.OB: HRRZ D,.+1(A)
MOVEI C,0 ;%PRI - NO PRIORITY
JRST STAK ;SO JUST STACK INPUT ATOM
JRST JUNK ;%OB - FOUND ONE! JUNK IT
JRST PERR6 ;%FIN - BRACKETS MISMATCH
;THUNK FOR A VALUE
.VALUE: .-3(A)
; JRST EVAL ;%EX
EVAL: PUSH STK,1(H) ;STACK NO FROM HEAP
ADDI H,2 ;DISCARD THUNK HEADER & NO.
JRST @(H) ;EXECUTE NEXT ITEM ON HEAP
;THUNK TO MARK END-OF-HEAP
.EOH: .-3(A)
; JRST DONE ;%EX
DONE: POP STK,N1 ;RETURN LAST VALUE
AOS (P)
POPJ P,0
;A ROUTINE TO YIELD A DECIMAL INTEGER IN N HAVING DECODED POSS REF INT PARAM
ATOM: TLZ F,FLS.8 ;CLEAR THE OCTAL FLAG
PUSH P,STK ;SAVE THE STK AS WD=STK
ATOM1B: PUSHJ P,ALPHI ;GET THE CHAR/WORD
MOVEM CH,CH.SAV ;MAYBE WE SHOULD NOT HAVE EATEN THE TERMINATOR
;(A NON ALPHA CHAR).
JUMPN WD,ATOM3 ;IF WD IS 0 IT S NOT A LETTER OR A FUNCTION
ATOM4:
CAIN CH,"%" ;INTRODUCING AN OCTAL ?
JRST [TLO F,FLS.8
SETZM CH.SAV
JRST ATOM1B ] ;YES
CAIL CH,"0"
CAILE CH,"9"
JFCL ;ITS NOT A LETTER OR A NO. BUT LET IT PAST
POP P,STK
TLZE F,FLS.8 ;OCTAL
JRST RDOCTL ;YES
JRST DECIN
ATOM3:
MOVSI T3,-SYMSIZ
CAME WD,SYMTAB(T3) ;IS IT ASYMBOL WE KNOW ABOUT
AOBJN T3,.-1
JUMPLE T3,ATOM2
TLNE WD,7777
JRST IFERR4 ;INVALID FUNCTION
LSH WD,-36 ;MUST BES A LETTER
MOVEI CH," "(WD) ;MAKE IT ASCII
JRST ATOM1A ;IT'S A LETTER PROBABLY A PARAMETER
ATOM2: EXCH CH,CH.SAV
PUSH P,F ;SAVE THE FLAGS AS WE SHALL RECURSE
PUSHJ P,SYMGET ;IT'S A RECOGNISED SYMBOL
JRST IFERR4 ;BUT NOT O.K.
POP P,F ;RESTORE THE FLAGS
TLNN F,FLS.8 ;OCTAL NO.
JRST ATOM2A ;NO
CAIE T2,5
JRST REFER2
JRST ATOM2B
ATOM2A: CAIE T2,4 ;DID IT GET A DECIMAL NO.
JRST REFER2 ;NO
ATOM2B: POP P,STK
MOVE T2,SYMPNT
MOVE CH,[ILDB CH,T2]
PUSHJ P,SVLOWN ;SAVE AND CHANGE LOW LEVEL I/P ROUTINE
PUSH P,CH.SAV ;SAVE NXT CH ON LINE
SETZM CH.SAV ;DON'T READ IT JUST YET
TLZE F,FLS.8 ;OCTAL
JRST [PUSHJ P,RDOCTL
JUMPE N1,REFERR
JRST ATOM2C]
PUSHJ P,INTIN ;SHOULD READ AN INTEGER
JUMPE N1,REFERR ;OOPS DIDN'T
ATOM2C: POP P,CH.SAV
JRST CHARIN
ATOM1: PUSH P,STK
ATOM1A: PUSH P,P1
PUSH P,P2
PUSHJ P,REFBP ;PRODUCE BYTE POINTER TO ACTUAL PARAMETER
POP P,P2
POP P,P1
PUSH P,CH.SAV ;SAVE THE TERMINATING CHAR
SETZM CH.SAV
MOVE CH,[ILDB CH,BP]
PUSHJ P,SVLOWN ;SAVE AND CHANGE LOW LEVEL I/P ROUTINE
PUSHJ P,INTIN ;GO READ A POSS INTEGER
JUMPE N1,REFERR
POP P,T3
POP P,T4 ;SVLOWN PUT A NO. ON STACK
POP P,CH.SAV
POP P,STK
PUSH P,T4
PUSH P,T3
JRST CHARIN
;A ROUTINE TO PRODUCE BYTE POINTER TO ACTUAL PARAMETER IN BP
;FROM PARAMETER NAME IN CH
REFBP: PUSH P,CH ;SAVE PARAMETER NAME
MOVE WD,CH ;SAVE FOR ERROR MESSAGE IF REQUIRED
MOVE L,LLX
PUSHJ P,OTHUSR ;GET THE PDB
JRST LETER3 ;NOT FOUND
MOVE P2,T2 ;SAVE PDB ADDRESS
PUSHJ P,DECIN ;GET THE QULIFIER
MOVEM CH,CH.SAV ;SAVE THAT CHAR
SKIPE N
PUSHJ P,UP ;GO UP AS REQUIRED
POP P,CH ;RESTORE THE PARAM NAME
MOVEI T3,ARGBP(P2) ;ADDRESS OF START OF POINTER BLOCK
ADDI T3,-"A"(CH) ;OFFSET TO CORRECT PARAM
MOVE BP,(T3) ;&PICK UP POINTER TO PARAMETER
POPJ P,0
REFERR: OUTSTR [ASCIZ/?PARAMETER /]
OUTCHR WD
MOVE BP,(T3) ;REINTIALIZE BYTE POINTER
ILDB CH,BP
JUMPE CH,REFER1 ;NULL PARAM
OUTSTR [ASCIZ/ "/]
OUTCHR CH
REFER3: OUTCHR [ASCII/"/]
ILDB CH,BP ;JS BIT THE LABEL
OUTCHR CH
JUMPN CH,.-2 ;SHOVEL OUT OFFENDING PARAMETER
OUTSTR [ASCIZ/ IS NOT A NUMBER/]
JRST SLENDX
REFER1: OUTSTR [ASCIZ/ IS NULL/]
JRST SLENDX
REFER2: MOVE BP,[POINT 7,GTERR]
JRST REFER3+1
GTERR: ASCIZ /
?GTERR GETTAB RESULT/
INTIN: SETZB N,N1
PUSHJ P,CHARIN
INTIN2: CAIN CH,"+" ;MONADIC PLUS ALLOWED IN REF INT
JRST DECIN ;JUST IGNORE
CAIE CH,"-" ;MAY BE MOADIC MINUS
JRST DECIN1 ;NO
PUSHJ P,DECIN ;YES READ IT IN
MOVN N,N ;AND NEGATE IT
POPJ P,0 ;AND EXIT
DECIN: SETZB N,N1 ;N1 USED AS FLAG
PUSHJ P,CHARIN
DECIN1: CAIL CH,"0"
CAILE CH,"9"
JRST CHARSG
SETO N1, ;FLAG THAT A NUMBER WAS READ
TLZ F,FL.MOP ;CLEAR MONADIC OPERATORS ALLOWED FLAG
IMULI N,^D10
ADDI N,-"0"(CH)
DECIN2: PUSHJ P,PINCH
JRST DECIN1
;HERE TO READ AN OCTAL NO.
RDOCTL: SETZB N,N1
PUSHJ P,CHARIN
CAIN CH,"+"
JRST RDOCT1
CAIE CH,"-"
JRST RDOCT1
PUSHJ P,OCTIN
MOVN N,N
POPJ P,0
RDOCT1: PUSHJ P,OCTIN2
POPJ P,0
PINCH: SETZ CH,
SKIPN CH,CH.SAV
JRST PINCH2
SETZM CH.SAV
POPJ P,0
PINCH2: XCT LOWIN
POPJ P,0
;A ROUTINE TO GET ALPHA WORD IN WD
ALPHI: MOVE BP,[440600,,WD]
SETZ WD,
PUSHJ P,CHARIU
ALPHI1: PUSHJ P,PINCH
PUSHJ P,LOWUP
CAIL CH,"A"
CAILE CH,"Z"
POPJ P,0
SUBI CH," "
TLNE BP,770000
IDPB CH,BP
JRST ALPHI1
;HERE TO CONVERT LOWER CASE LETTERS TO UPPER IF REQUIRED
LOWUP: CAIL CH,141 ;LITTLE A
CAILE CH,172 ;THRU' LITTLE Z INCLUSIVE?
POPJ P,0 ;NO
TRZ CH,40 ;YEP - CHANGE TO BIG A-Z
POPJ P,0
;I/P ROTINE USED BY THE FUNCTION CALLS STUFF(FROM MASTER)
;GETS A SINGLE CHAR. FROM I/P FILE AND HANDLES PARAMETERS
;RETURNS A ZERO IF EOF OR ERROR.
GETTB1: PUSHJ P,FETCHR ;GET A CHARACTER
SETZ CH, ;EOF ERROR
CAIE CH,"'" ;ONE OF THESE
POPJ P,0 ;NO
PUSHJ P,PARAM ;YES DO PARAMETER STUFF
SETZ CH, ;EOF ERROR
POPJ P,0
DEFINE REP(A),<JSP T1,POLTYP
ASCIZ/'A/>
PERR1: REP <OPERATOR MISSING BETWEEN ) & NO.>
PERR2: REP <OPERATOR MISSING BETWEEN NO. & )>
PERR3: REP <NUMBER MISSING BETWEEN BRACKETS>
PERR4: REP <NUMBER MISSING BETWEEN TWO OPERATORS>
PERR5:
PERR6: REP <BRACKETS MISMATCH>
POLTYP: OUTSTR [ASCIZ/?SYNTAX ERROR - /]
OUTSTR (T1)
POPJ P,
SUBTTL MASTER PROCESS INITIALIZATION
.START:
.R:
.RUN:
MASTER: SETZM F ;FLAG ITS A NORMAL START-UP
SKIPN MASTNO ;ALREADY RUNNING?
JRST INITIA ;NO DO THE START UP STUFF
OUTSTR [ASCIZ/%MIC IS RUNNING /]
JRST SLENDX ;KILL US OFF
MSTR0: SETZB F,X ;CLEAR F & X 1ST TIME IN
SETZ Y,Z
JRST LOOP
GO%AGN: SETOM F ;FLAG ITS A RESTART
MOVEI S,[ASCIZ/IS RESTARTING/]
PUSHJ P,MSTOPR ;AND LET OPR KNOW
JRST INITIA
SUBTTL MASTER PROCESS - CRASH CONTROL
;HERE AFTER THE PSI SYSTEM HAS DETECTED A FATAL ERROR
;CLEAN UP- FORCE A NEW COPY OF MIC.SHR ONTO TH SWAPPER
;AND START IT RUNNING
IFN FTPSI,<
..DIE: MOVE P,[IOWD SIZ,STACK] ;RESET THE STACK
SETZ T1,
SETUWP T1, ;W/E HI-SEG
HALT
SETZM MASTNO ;SAY WE ARE NOT RUNNING SO NO NEW USERS START UP
MOVEI S,[ASCIZ/IS CRASHING/]
MOVE N,INTBLK+.PSVIS ;GET THE CONDITIONS STUFF
PUSHJ P,PRPOPR ;PREPARE THE SAD NEWS
PUSHJ P,MSTOPR ;LET THE OPR KNOW
RESET ;STOP ALL I/O
MOVEI T1,17
MOVSI T2,'SYS'
SETZB T3,T4
OPEN T1
JRST ..DIE0
MOVSI T1,'MIC'
MOVSI T2,'SHR'
SETZB T3,T4
LOOKUP T1 ;FIND SYS:MIC.SHR
JRST ..DIE0
RENAME T1 ;RENAME IT TO ISTSELF
JRST ..DIE0
CLOSE 20
MOVSI 0,'SYS'
MOVSI 1,'MIC'
MOVSI 2,'SHR'
SETZB 3,4
SETZ 5,
MOVSI 6,<RESTRT-MIC>
RUN 6, ;START MIC UP AGAIN
..DIE0: MOVEI S,[ASCIZ/CAN'T RESTART!!!/]
PUSHJ P,MSTOPR ;LET OPR KNOW WE FAILED
EXIT 1,
EXIT
>
SUBTTL MASTER PROCESS - CORE MANAGEMENT
;HERE TO DO CORE MANAGEMENT TO CHANGE
;THE NUMBER OF PROCESSES AVAILABLE
;COMCNT - INCREMENTED WHEN A SLAVE CANNOT FIND A PROCESS
;PROCNO - NEGATIVE NUMBER OF PROCESSES
LOOP:
SETZM ACTIVE ;NO ACTIVE PROCESSES
SCHED2: MOVE T1,COMCNT ;ANY COMPLAINTS FROM SLAVES
JUMPE T1,SHUFFLE ;NO GO SHRINK IF NEEDED
MOVN T3,PROCNO ;THIS MANY PROCESSES
ADD T3,COMCNT ;AND WE HAVE REQUESTS FOR THIS MANY
MOVE T2,T3 ;COPY IN A
IMULI T2,PDBSIZ ;HIGH SEGMENT PROCESSES AREA THIS BIG
IMULI T3,LPDBSIZ ;LOW " " " " "
ADDI T2,FLAG+1 ;HIGH SEGMENT LARGE ADDRESS
ADDI T3,POINTR+1 ;LOW " " "
HRL T3,T2 ;HIGH,,LOW
IFN FTCJOB,< ;FOR COJOBS ONLY
MOVN Y,COJOBN ;TAKE ACCOUNT OF THIS MANY COJOBS
SUBI Y,1 ;ALREADY ALLOCATED SPACE FOR 1
IFN FTMBCH,<
SUB Y,BCJOBN ;+ HOW MANY BATCH PROCESSES
>
IMULI Y,CJSIZ ;THIS BIG WHEN COMPUTING CORE
ADDI T3,(Y)
> ;END OF COJOB BIT
SETZ X, ;CLEAR AWAY X
CORE T3,
AOSG TRYCORE ;NUMBER OF TIMES TO TRY BETWEEN ERROR MESSAGES
SKIPA
JRST CORERR ;OOPS!
;GOT THE CORE
CAME T1,COMCNT
JRST SCHED2 ;SLAVES HAVE MOVED IT
SETZ T2,
SETUWP T2,
HALT
MOVNS T1 ;NEGATE
ADDM T1,PROCNO ;UPDATE NO OF PROCESSES
SETZM COMCNT ;AND TELL THE SLAVES
SETUWP T2,
HALT
JRST SCHED1
;HERE TO SHRINK CORE IF POSS.
SHUFFLE: JRST SCHED1 ;DUMMY FOR NOW
SUBTTL MASTER PROCESS - SCHEDULE SLAVE REQUEST
SCHED1: HRLZ P4,PROCNO ;TRY FOR THIS NO.
SCHED3: ADDI X,PDBSIZ
ADDI Y,LPDBSIZ
MOVN T2,PROCNO
IMULI T2,PDBSIZ
CAML X,T2
PUSHJ P,SCHED0 ;WRAP ROUND TO THE FIRST PROCESS
MOVE F,FSAV(X) ;SET UP FLAG WORD
SKIPE T1,FLAG(X) ;TO BE PROCESSED?
JRST SCHED5 ;GO SERVICE IF REQUIRED
SCHED4: TRZE F,FR.EOF ;EOF DETECTED YET?
JRST FIN1 ;YES!
CAMN F,FSAV(X) ;HAS ANY FLAG BITS CHANGED
JRST SCHD4A ;NO
SETZ T1,
SETUWP T1, ;W/E
HALT
MOVEM F,FSAV(X) ;PRESERVE FLAG WORD
SETUWP T1,
HALT
SCHD4A: AOBJN P4,SCHED3 ;NO TRY NEXT
SKIPN ACTIVE ;ANY ACTIVE PROCESSES?
JRST HIB ;NO - NORMAL HIBER
JRST HIB1 ;YES - HIBER BUT DON'T RESET CORE
SCHED0:
IFN FTCJOB,< ;COJOBS ONLY
MOVN Y,COJOBN
SUBI Y,1 ;OFFSET TO FIRST PDB PAST COJOBS
IFN FTMBCH,< ;IF BATCH
SUB Y,BCJOBN ;INCLUDE BATCH AREAS AS WELL
> ;END OF BATCH
IMULI Y,CJSIZ
> ;END OF COJOBS ONLY
IFE FTCJOB,< SETZ Y, >;IF NO COJOBS
SETZ X,
POPJ P,0
SCHED6: MOVEI P3,5 ;PRETEND SHORT LINE FOR QUICK SLEEP
PUSHJ P,SETHB1 ;SET IT UP
JRST SCHED4 ;NEXT PLEASE
IFN FTCJOB,<
SCHED7: SKIPN COJOB(X) ;IS HE A COJOB?
JRST SCHED4 ;NO. NEXT....
TLNN F,FL.CB ;IS IT IN CONTROL B WAIT
JRST SCHED4 ;NO
MSTIME T1,
CAMG T1,LTIME(Y) ;IS IT TIME
JRST SCHED4 ;TIME IS NOT YET?
PUSHJ P,OWNCHK ;IS HE STILL AROUND
JRST PROCEED ;NO...PROCEED
PUSH P,S ;YES...
MOVEI S,[ASCIZ/ WAITING..../] ;REMIND HIM OF OUR PRESCENCE
PUSHJ P,TELBTH
POP P,S ;COME BACK S
JRST STWAIT ;AND WAIT AGAIN
>
;HERE TO SEE IF WE CAN DEAL WITH A USER
GO: MOVE L,LINE(X) ;GET HIS LINE NO.
MIC GET,L ;AND HIS STATUS
JRST FIN1 ;HE'S NOT RUNNING MIC NOW
TRNE F,FR.EOF ;HAS HE HAD AN EOF
JRST FIN1 ;YES
JUMPG T1,SCHED4 ;HE'S HELD IGNORE HIM
TAL:
JUMPGE S,SCHED4 ;NOTHING INTERESTING
TLNE S,LDL.CB ;^B?
TLNE F,FL.CB ;DID WE KNOW?
SKIPA ;YES
JRST A.BREAK(X) ;NO ITS A NEW ONE!
TLNE S,LDL.CA ;DID HE TYPE ^A?
JRST A.ABORT(X) ;YES - JUST ABORT THIS PROCESS
TLNE S,LDL.CC ;^C
JRST %.CANCEL ;YES
TLNE S,LDL.RS!LDL.SY ;IS HE DABBLING IN RESPONSE STUFF
JRST RSPOND ;YUP-CHECK IT OUT
TAL1: TLZN S,LDL.TI ;TI WAIT OR MM
JRST SCHED4 ;NO - FORGET HIM
TLZE S,LDL.OP ;OPERATOR CHAR?
JRST A.OPERATOR(X) ;YES
TLNE S,LDL.ER ;ERROR?
IFN FTCJOB,<
JRST ANERROR ;YES
>
IFE FTCJOB,<JRST A.ERROR(X)
>
TLZE S,LDL.CP ;^P
JRST A.PROCEED(X) ;YES
TLNE S,LDL.CB ;IN ^B WAIT? (USE S 'COS DON'T TRUST F!)
IFE FTCJOB,<
JRST SCHED4 ;YES - FORGET HIM
>
IFN FTCJOB,<
JRST SCHED7 ;CHECK COJOB STUFF THEN FORGET HIM
>
REPEAT 1,< ;CODE WHICH SLOWS MIC DOWN
;BUT GETS "!" COMMAND RIGHT
TLNN S,LDL.XX ;IS HE SILENCED
PUSHJ P,OUTPNG ;NO-IS HE DOING O/P
JRST TAL3 ;NO-THEN HE MAY BE SCHEDULED
JRST SCHED6 ;DON'T SCHEDULE UNTIL LATER
>
TAL3: TLZE F,FL.INP ;HAVE WE ALREADY SET UP AN I/P LINE
JRST TAL4A ;YES
SKIPE ERRWRD(X) ;HAS A MASTER DETECTED ERROR OCCURED
JRST ERRTYP ;YES
SKIPE DISWRD(X) ;WANT A DISPLAY DUN
JRST MSTDIS ;YES DISPLAY THEN
SKIPE TYPWRD(X) ;WANT A TYPE DUN
JRST MSTTYP ;YES TYPE THEN
TRNE F,FR.JMP ;WAS LAST O/P A JUMP
TLNE F,FL.BRK ;DID WE FINISH LINE OFF?
SKIPA ;YES
JRST TAL6 ;IGNORE JUMP FOR A MOMENT
SKIPE BLAB(X)
JRST FNBLAB ;BACKTO LABEL
SKIPE LAB(X) ;DO WE WANT TO SEARCH FOR A LABEL?
JRST FNDLAB ;YES GO FIND IT
TAL6: PUSHJ P,IPLINE ;GO READ A LINE
JRST TAL8
TAL2: PUSHJ P,LDBCLR ;AND CLEAR HIS ERROR BITS
TAL4: TLZE F,FL.SMC ;WAS THAT A COMMENT
JRST TAL5 ;THEN DO NOT TYPE IT
TLZE F,FL.XX ;DID HE OUGHT TO BE SILENCED
TLON S,LDL.XX ;YES SHUT HIM UP
MIC SET,L
JFCL
TLNE S,LDL.MM ;IS WE IN MONITOR MODE?
TLNN F,FL.AST ;YES - IS THIS AN ASTERISK LINE
SKIPA ;NO - TO BOTH OR EITHER
JRST TAL5A ;DO DISPLAY NOT TYPE (NEED TO BECAUSE IN 507 "*"
;IS AN ILLEGAL COMMAND
TRNE F,FR.IF!FR.JMP ;WAS IT A GOTO/BACKTO OR IF(ERROR)/IF(NOERROR)
JRST TAL5A ;YES DO NOT TYPE IT.
SETZ CH, ;MAKE ASCIZ
IDPB CH,BUFBP
HRRI S,BUFFER
TLNN S,LDL.MM ;IN MONITOR MODE?
TLZN F,FL.MON ;REQUIRES MONITOR MODE?
JRST TAL4B ;DO THE LINE NOW
PUSHJ P,FRCMON ;FORCE HIM BACK TO MONITOR MOD?
TLO F,FL.INP ;AND REMEMBER A LINE IS ALREADY PREPARED
JRST SCHED4 ;AND PRINT IT NEXT TIME AROUND
TAL4A: HRRI S,INLINE(X) ;THIS IS THE REMEMBERED LINE
TAL4B: PUSHJ P,TYPER
JRST SCHED4 ;GO LOOK AT NEXT GUY
;HERE TO DISH OUT A COMMENT TO A LINE
TAL5: PUSHJ P,SETHIB ;MUST NOT SILENCE TOO SOON
TAL5A: CAIE CH,CR ;RETURN?
TAL7: TDZA CH,CH ;NO MAKE ASCIZ
MOVEI CH,LF ;YES DUMMY UP LINE FEED
IDPB CH,BUFBP
JUMPN CH,TAL7 ;AND MAKE ASCIZ
TDNE F,[FL.AST,,FR.IF!FR.JMP] ;ONE OF THESE
JRST TAL7A ;YEP
TLZE S,LDL.XX ;SILENCED?
MIC SET,L ;THEN WAKE UP
CAIA
TLO F,FL.XX ;AND REMEMBER U DID IT
TAL7A: HRRI S,BUFFER
MIC DISPLAY,L
JRST SCHED4
JRST SCHED4 ;SAY IT AND RESCHEDULE
;HERE WHEN WE HAVE REACHED EOF WE MUST CHECK IF ANTHING
;IN THE BUFFER AND IF SO DEAL WITH IT.
;THIS GETS OVER A PROBLEM WITH -
; !TEXT<EOF>
;
TAL8: MOVE T1,LINTOT ;GET HOW MANY CHARS IN THE BUFFER
CAIN T1,^D81 ;IS THE BUFFER EMPTY
JRST FIN1 ;YES - THEN WE ARE DONE
TRO F,FR.EOF ;REMEMBER THE EOF
JRST TAL2 ;AND DEAL WIF THE BUFFER
;HERE ON CANCEL TO TYPE [CANCEL]
CANCEL:
STOP:
CANCL1: SKIPA S,[[ASCIZ/[CANCEL]/]]
;HERE ON ABORT TO TYPE [ABORT] ETC.
%.ABORT:
ABORT: MOVEI S,[ASCIZ/[ABORT]/]
PUSHJ P,TELBT2 ;SORT OUT SILENCE ETC. AND LET EVERYONE KNOW
JRST FIN1 ;AND FINISH
;HERE TO SORT OUT SILENCE BITS ETC. BEFORE SENDING OUT A MESSAGE
;TO A USER AND HIS OWNER IF APPLICABLE
TELBT2: PUSH P,S ;SAVE THE MESSAGE
MIC GET,L ;GET HIS LDBMIC WORD
SETZ S, ;HASN'T GOT ONE - VERY ODD!
TLZE S,LDL.XX ;IF HE IS SILENCED
TLO F,LDL.XX ;REMEMBER
MIC SET,L ;AND UNSILENCE HIM
JFCL
POP P,S ;UNSAVE THE MESSAGE
;AND FALL INTO TELBTH
;HERE TO SEND A MESSAGE TO A USER AND HIS OWNER
TELBTH:
IFN FTCJOB,< ;COJOB BIT
SKIPE COJOB(X) ;ARE WE A COJOB
PUSHJ P,CJMESG ;YES - LET THE OWNER KNOW
MOVE T1,L ;****
MOVEI T2,[ASCIZ/
/] ;****
SKIPE COJOB(X)
MIC DISPLAY,T1 ;**** PUT CRLF IN LOG FILE
JFCL
>;END OF CONDITION COJOB
MIC DISPLAY,L ;SEND THE MESSAGE
JFCL
POPJ P,0 ;AND AWAY....
;HERE ON ERROR
IFN FTCJOB,<
ANERROR:
PUSHJ P,TYMCHK ;TIME LIMIT ERRORS ARE SPECIAL
JRST IFC3 ;KILL BOY KILL (HE'S HAD TIME+10%)
JRST A.ERROR(X) ;DO WHAT HE SAYS
>
ERROR:
%.ERROR:
IFCHK: TLNE F,FL.CB ;IN ^B WAIT?
JRST SCHED4 ;YES - FORGET IT.
IFC1: PUSHJ P,IPLINF ;GET A LINE
JRST IFC3 ;EOF
JUMPE CH,IFC1 ;MAKE SURE WE GOT SOMETHING.
TLZE F,FL.PCT ;%LABEL?
JRST IFC4 ;HE'S A GOOD 'UN
TLZN F,FL.DOT ;A MONITOR COMMAND?
JRST IFC1 ;NO - KEEP LOOKING
TRNN F,FR.IF ;IS IT AN IF COMMAND
JRST IFC2 ;NO.
JRST TAL6
IFC2: PUSHJ P,IPLINL ;HE'S GOING TO CAUSE TROUBLE!!
JRST IFC3 ;READ A LINE - ERROR ON EOF
JUMPE CH,IFC2 ;LET'S GET SOMETHING SENSIBLE!!
TLZN F,FL.PCT ;%LABEL?
JRST IFC2 ;OH WELL KEEP LOOKING..
IFC4: PUSHJ P,IPLINE ;WE'VE GOT A CLEVER USER!!!!
SKIPA
JRST TAL2
IFC3: MOVEI S,[ASCIZ/[ABORT ON ERROR]/]
PUSHJ P,TELBT2 ;TELL ALL
JRST FIN1
FRCMON: PUSH P,S ;PRESERVE S
HRRI S,[BYTE(7)3] ;^C
PUSHJ P,TYPER
POP P,S ;RESTORE S
TLO S,LDL.MM ;AND SAY WE ARE NOW IN MONITOR MODE
POPJ P, ;RETURN
IFN FTCJOB,< ;IF COJOBS
;A ROUTINE TO CALCULATE IF TIME LIMIT HAS BEEN EXCEEDED
;AND IF THIS IS THE FIRST TIME -GIVE THE JOB AN EXTRA 10%
TYMCHK: SKIPN COJOB(X) ;ARE WE A COJOB
JRST CPOPJ1 ;NO FORGET ALL THIS
MOVEI T1,.GTLIM ;TABLE NO.
HRL T1,JOB(X) ;INDEX NO.
GETTAB T1, ;GET THE TIME LIMIT
JFCL ;RUBBISH!!!
LDB CH,[POINT 24,T1,35] ;GET THE IMPORTANT BIT
JUMPN CH,CPOPJ1 ;EXIT IF ALL OK
SKIPLE TIME(Z) ;DOUBLE CHECK TO SEE IF
TLCE F,FL.TIM ;HAS HE HAD AN EXTRA 10%
POPJ P,0 ;YES-KILL HIM
PUSH P,S ;SAVE IT
MOVEI S,[ASCIZ/?TIME LIMIT EXCEEDED/] ;HELPFUL MESSAGE
PUSHJ P,CJMESG ;FOR COJOB OWNERS
POP P,S ;RESTORE IT
HRRZ T3,TIME(Z) ;GET HOW LONG HE RAN FOR
IDIVI T3,^D10 ;10% IS-
HRRM T3,TIME(Z)
HRLI T3,.STTLM ;SET TIME LIMIT FUNCTION
HRRZ T2,JOB(X) ;GET JOB NO.
MOVE T1,[2,,T2] ;SET UP JBSET ARGS
JBSET. T1, ;SET NEW TIME LLIMIT
JFCL ;EH!!!
SETOM TIME(Z) ;EXTRA REMINDER!
JRST CPOPJ1 ;AND LOOK FOR WOT TO DO
> ;END OF COJOB BIT
;HERE TO GET RESPONSE LINE ON ERROR CONDITION
RSPOND: TLNN S,LDL.ER ;HAS HE GOT AN ERROR?
JRST TAL1 ;NO-CARRY ON AS NORMAL
TLNN S,LDL.SY ;HAS THE ERROR CHAR REACHED INT LEVEL?
JRST SCHED4 ;NO-JUST IGNORE FOR TIME BEING
TLNE S,LDL.TI ;TTY INPUT WAIT?
JRST RSPND ;YES-GET HIS RESPONSE STUFF
TLNE S,LDL.RS ;TTY WAIT OF ANY SORT?
JRST SCHED4 ;NO-JUST IGNORE FOR TIME BEING
;HERE WHEN IN "TI" OR "TO" WAIT AN ERROR HAS OCCURED
;WHEN THE USER HAD ENABLED FOR RESPONSE STUFF AND
;THE ERROR CHARACTER HAS REACHED INTERUPPT LEVEL
;THEREFORE-UUO LEVEL OUTPUT STATIC SAFE TO DO RESPONSE UUO
RSPND: TLZ S,LDL.SY!LDL.RS
PUSH P,S
MOVEI S,BUFFER
SKIPE T2,RS(X) ;MUST BE A PLACE FOR IT
MIC RESPONSE,L
JRST RSPND2 ;NOPE
MOVE T2,(T2) ;POINTS TO BYTE POINTER TO USE
SETZ S,
SETUWP S,
HALT
MOVE T1,[POINT 7,BUFFER]
RSPND0: ILDB CH,T2 ;WHERE TO PUT RESPONSE
JUMPE CH,RSPND1 ;IF WE REACHED THE END OF THE PARAMETER
ILDB CH,T1
DPB CH,T2 ;ELSE COPY UP RESPONSE
JUMPN CH,RSPND0 ;UNLESS WE RUN OUT LOOP
SETZ T1,
JRST RSPND0 ;ZERO DOWN REST OF PARAMETER
RSPND1: SETUWP S,
HALT
RSPND2: POP P,S
JRST TAL1 ;CARRY ON AS NORMAL
;HERE ON ^B
BREAK:
%.BREAK:
OBREAK: TLO S,LDL.CB ;MAKE SURE THE BREAK FLAG IS SET
TLZE S,LDL.XX ;WAS HE SILENCED?
TLO F,FL.XX ;THEN REMEMBER
PUSHJ P,LDBCR1 ;CLEAR HIS ERROR BITS
MOVEI S,[ASCIZ/[BREAK]/]
TLO F,FL.CB ;IN ^B WAIT
PUSHJ P,TELBTH ;LET EVERBODY KNOW
IFN FTCJOB<SKIPN COJOB(X) ;IS WE A COJOB
>
JRST SCHED4
IFN FTCJOB,<
STWAIT: MSTIME T1, ;GET THE TIME
ADDI T1,^D60*^D1000*^D2 ;WAIT THIS LONG
MOVEM T1,LTIME(Y) ;AND THEN REMIND
JRST SCHED4 ;AND RESCHEDULE
>
;HERE ON ^P
PROCEED:
%.PROCEED:
PROCED: PUSH P,S ;PRESERVE S
IFN FTCJOB,< SETZM LTIME(Y) ;CLEAR WAITING TIME
>
MOVEI S,[ASCIZ/[PROCEED]/]
PUSHJ P,TELBTH ;TO WHOM IT MAY CONCERN
PROCD1: POP P,S ;RESTORE S
TLZ F,FL.CB ;NO LONGER IN ^B WAIT
PUSHJ P,LDBCLR ;;SET IT
JRST SCHED4
LDBCLR: TLZ S,LDLCLR ;CLEAR ERROR FLAGS
LDBCR1: MIC SET,L
JFCL
MIC GET,L
JFCL
POPJ P,
;HERE WHEN OPERATOR CHAR FOUND
OPERATOR:
%.OPERATOR:
OPRCHR: TLCN F,FL.CB ;ARE WE PAUSED?
JRST OBREAK ;NO BREAK
JRST PROCED ;YES PROCEED
;HERE TO FIND A LABEL
FNBLAB: SETZM POINTR(Y)
SETZM BLKNO(Y) ;SO WE WILL READ FROM START OF FILE
PUSH P,P4 ;KEEP P4
MOVE P4,BLAB(X) ;GET LABEL
JRST FNDLB1
FNDLAB: PUSH P,P4 ;PRESERVE P4
MOVE P4,LAB(X) ;GET THE LABEL
FNDLB1: PUSH P,P4 ;GOT TO SAVE LABEL AS GETTABS APPEAR TO GROT IT(******)
PUSHJ P,IPLINL ;READ NEXT LINE
JRST NOTLAB ;COULDN'T FIND LABEL
POP P,P4 ;GET LABEL BACK
MOVE T1,LABWD ;GET THE LABEL
MOVSI T2,PL.%FN ;%FIN MATCHING BIT
CAME T1,P4 ;THE RIGHT ONE?
JRST [TDNN T2,PROFLE(X) ;HAS HE SUPPRESSED %FIN MATCHING
CAME T1,[SIXBIT/%FIN/] ;NO IS THIS %FIN
JRST FNDLB1 ;NO MATCH
JRST .+3]
JRST .+2 ;SUCCESS
JRST FNDLB1 ;NO - KEEP LOOKING
POP P,P4 ;YES - RESTORE P4
SETZ T1,
SETUWP T1, ;UNLOCK HI-SEG
HALT
SETZM BLAB(X) ;CLEAR BLABEL
SETZM LAB(X) ;CLEAR LABEL
SETUWP T1,
HALT
JRST TAL2 ;AND TYPE THE LINE FOR HIM
NOTLAB: MOVEI S,[ASCIZ/?CANNOT FIND LABEL./]
JRST MSG
;HERE TO PERFORM TYPE/DISPLAY
ERRTYP: MOVEI T2,2 ;INDEX
JRST .+3
MSTTYP: TDZA T2,T2
MSTDIS: MOVEI T2,1
MOVE T3,T2 ;COPY
ADD T2,X ;INDEX INTO PDB
MOVE S,TYPWRD(T2) ;GET THE ADDR.
SETZ T1,
SETUWP T1, ;W/E HI-SEG
HALT
SETZM TYPWRD(T2) ;CLEAR THE WORD
SETUWP T1,
HALT
TLZN S,-1 ;L.H. IS USED AS A FLAG
JRST MSTDS0
MOVE S,(S) ;THAT (S)=[STRING]
JUMPE S,SCHED4 ;FUNNY
JUMPE T3,TYPFIX ;SPECIAL TREATMENT FOR TYPE
CAIN T3,1
JRST DISFIX ;AND DISPLAY
MOVE BP,[POINT 7,BUFFER]
ILDB CH,S ;GET THE STRING
IDPB CH,BP ;AND PUT IT IN THE I/P BUFFER
JUMPN CH,.-2
MOVEI S,BUFFER ;AND SET UP S
MSTDS0: MOVE L,LINE(X) ;GET HIS LINE NO.
XCT DISTYP(T3) ;DO TYPE OR DISPLAY AS APPROPRIATE
JFCL
JRST SCHED4 ;AND NEXT....
DISTYP: MIC TYPE,L
MIC DISPLAY,L
MIC TYPE,L
DISFIX: TRO F,FR.DIS ;SAY ITS ONE OF DESE
TYPFIX: MOVSI CH,-NESTY ;SPECIAL TREATMENT - PRETEND TYPE IS A PARAMETER
HRRI CH,CURBP(Y)
EXCH S,(CH)
JUMPE S,SCHED4 ;STACKED IT
AOBJN CH,.-2
JRST MACERR ;NO ROOM
HIB: SETZ T2,
SETUWP T2, ;UNLOCK HI-SEG
HALT
IFN FTCJOB,<
PUSHJ P,CMPREQ ;COMPUTE REQD. NO. OF COJOBS (AND BATCH JOBS)
>
MOVEI T1,PROCNU
MOVNM T1,PROCNO ;RESET TO ORIGINAL NO. OF PROCESSES
AOS COMCNT ;FLAG TO FORCE RECOMPUTE OF CORE
SETUWP T2, ;AND LOCK IT AGAIN
HALT
HIB1: SKIPE T1,HIBTIM ;IS THERE A TIME LIMIT
PUSHJ P,GETHIB
MOVEI T1,^D20*^D1000 ;WAKE EVERY 20 SECS.
TXO T1,HB.RPT
MOVEI T2,5 ;5 SECS F HIBER FAILS
HIBER T1, ;HIBER ..
SLEEP T2, ;.. OR SLEEP
JRST LOOP
GETHIB: MSTIME T2,
SUB T1,T2
JUMPG T1,GETHI1
MOVEI T1,^D1000
SETZM HIBTIM ;WE OVERSLEPT
GETHI1: CAILE T1,5*^D1000
MOVEI T1,1*^D1000
JRST CPOPJ1
IFN FTCJOB,<
CMPREQ: HRRE T1,CJREQ ;RESET TO REQUESTED NUMBER OF COJOB AREAS
SKIPLE T1 ;ALLOW FOR -VE OR +VE NO.S(DEFENSIVE)
MOVNS T1
CAMG T1,[EXP -^D15]
HRREI T1,-^D15 ;AT THE MOMENT CAN ONLY HAVE 15 COJOBS
MOVEM T1,COJOBN
IFN FTMBCH,< ;BATCH STUFF
HRRE T1,BCHREQ ;SIMILARILY FOR BATCH
SKIPLE T1
MOVNS T1
PUSH P,T1 ;SAVE IT
ADD T1,COJOBN ;GET TOTAL NO. OF BATCH JOBS AND COJOBS
CAMLE T1,[EXP -^D15] ;IS IT 15 OR LESS
JRST CMPRQ0 ;YES
POP P,(P) ;THROW WOT HE SAID AWAY
HRREI T1,-^D15 ;AND SEE HOW MANY LEFT
SUB T1,COJOBN ;I.E. 15-NO. OF COJOBS
SKIPA
CMPRQ0: POP P,T1 ;RESTORE
MOVEM T1,BCJOBN
>
POPJ P,0
>;END OF COJOB BIT
;HERE WHEN WE HAVE FINISHED WITH A USER
FIN: SETZ CH, ;MAKE ASCIZ
IDPB CH,BUFBP
MOVEI S,BUFFER ;PREPARE TO TYPE LINE
PUSHJ P,TYPER
FIN1: MIC GET,L ;GET OUR STATUS WORD
FIN1A: SETZ S, ;WE FAILED!??
MOVE P,[IOWD SIZ,STACK] ;RESET STACK
SETZ T2, ;WENABLE HIGH SEG
SETUWP T2,
HALT
SKIPE T3,LAST(X) ;START LAST PROCESS
SETOM FLAG-1(T3) ;IF REQUIRED
SETZ T2,
SKIPE T3 ;DEFEND AGAINST SPURIOUS LDBMIC WORDS
SKIPN T2,LDBMIC(X) ;IS THERE A PREVIOUS PROCESS?
JRST FIN4 ;NO
TRZ F,FR.EOF ;MAY NOT HAVE REACHED EOF FOR NEXT LEVEL
JUMPE S,FIN3 ;NOT RUNNING MIC ANY MORE
TLNN S,LDL.CC ;YES - WAS THERE A ^C TYPED?
JRST .+2 ;YES - OK
TLO T2,LDL.CC!LDLCHK;NO - SAY SO FOR PREVIOUS PROCESS
TLNE S,LDL.ER ;WAS THERE AN ERROR IN THIS PROCESS?
TLO T2,LDL.ER!LDLCHK;YES - SAY SO FOR PREVIOUS PROCESS
FIN2: MOVE S,T2 ;MOVE NEW WORD FOR...
LDB T1,LDP.ER ;GET THE ERROR CHAR
SKIPN T1
TLZ S,LDL.ER ;CLEAR THE ERROR BIT IN CASE SET BUT NO ERROR CHAR
MIC SET,L ;... SETTING UP
JFCL
FIN3: SETZM PDB(X)
HRLI T1,PDB(X)
HRRI T1,PDB+1(X)
BLT T1,FLAG(X) ;CLEAR DOWN PROCESS AREA
SKIPE COMCNT ;ANY SLAVES WAITING?
SOS COMCNT ;YES - WELL SAY 1 FREE PROCESS NOW
MOVEI T2,1 ;SET TO WLOCK
SETUWP T2,
HALT
SETZM LPDB(Y) ;NOW CLEAR DOWN LOW SEG
HRLZI T1,LPDB(Y)
HRRI T1,LPDB+1(Y)
BLT T1,POINTR(Y)
SETZ F,
JRST SCHED4 ;GO DO NEXT PROCESS
FIN4:
IFN FTCJOB,< ;COJOB BIT
SKIPN T1,COJOB(X) ;COJOB ACTIVE?
JRST FIN5 ;NO
TLZ F,FL.CCM!FL.KJO ;BETTER CHACK MON MODE AND ISSUE KJOB
MOVEM F,FSAV(X)
SETZ T1,
SETUWP T1,
HALT
HRRZI T1,KJOB ;ASK FOR KJOB MONITORING
HRRM T1,COJOB(X) ;IN COJOB FLAG WORD
JRST LOOP ;AND GO SERVICE THE OTHERS
>;END OF COJOB BIT
FIN5: TLZE S,LDL.XX ;SILENCED?
JRST FIN5A
TLNN F,FL.XX ;OR MEMORY OF SAME (CAN HAPPEN AFTER A TELBT2)
JRST FIN2 ;NO
FIN5A: PUSHJ P,LDBCLR ;CLEAR DOWN BITS
TLNN S,LDL.MM ;MONITOR MODE?
SKIPA S,[[ASCIZ/*/]] ;NO
MOVEI S,[ASCIZ/./] ;YES
MIC DISPLAY,L ;GIVE HIM NICE CHAR.
JRST FIN2
JRST FIN2
SUBTTL MASTER PROCESS - HANDLE NON-DEFAULT ACTIONS
%.BACKTO: TDZA T3,T3 ;HERE IF <EVENT> BACKTO ARG
%.GOTO: ;HERE IF <EVENT> GOTO ARG
MOVEI T3,1 ;FLAG
ADD T3,X
POP P,T2 ;GET ADDR. OF ARG
MOVE T2,(T2) ;GET ARG
SETZ T1,
SETUWP T1, ;UNLOCK
HALT
MOVEM T2,BLAB(T3) ;PUT IN HIS PDB
SETUWP T1,
HALT
JRST TAL3
;HERE ON <EVENT>:RETURN
%.RETURN:
TRO F,FR.EOF ;SET EOF
JRST SCHED4 ;AND CLEAN UP NEXT TIME
;HERE ON <EVENT>:EXIT
%.EXIT: MIC CLEAR,L ;CLEAR AWAY HIS LDBMIC WORD
JFCL
JRST SCHED4 ;AND CLEAN UP NEXT TIME AROUND
%.SILENCE:
MOVSI T1,FL.XX ;HERE ON <EVENT> SILENCE
SKIPA
%.REVIVE:
SETZ T1, ;HERE ON <EVENT> REVIVE
TLZ F,FL.XX ;CLEAR THE BIT
IOR F,T1 ;SET/NO-OP
MIC SET,L
JFCL
JRST TAL ;AND RESCHEDULE
%.TYPE: TDZA T3,T3 ;HERE ON <EVENT> TYPE
%.DISPLAY: ;HERE ON <EVENT> DISPLAY
MOVEI T3,1
ADD T3,X ;POINT TO TYPWRD OR DISWRD
POP P,T2 ;GET ADDR. OF ARG
MOVE T2,(T2)
JUMPE T2,TAL3 ;NOT AN ARG IN SIGHT
SETZ T1,
SETUWP T1, ;W/E HI SEG.
HALT
MOVEM T2,TYPWRD(T3) ;STORE IN HIS PDB
SETUWP T1,
HALT
PUSHJ P,LDBCLR ;CLEAR THE BITS
JRST TAL3
;THIS IS WHERE WE HANDLE THE USER'S CANCEL TRAPPING
;NOTE - THAT UNLIKE ALL THE OTHER TRAPS THIS TRAP IS UNSET EVERY TIME IT IS USED
;BUT MAY OF COURSE BE RESET
%.CANCEL:
MOVE T2,[JRST CANCEL] ;DEFAULT
CAMN T2,A.CANCEL(X) ;IS WE USING THE DEFAULT
JRST STOP ;YES-(SAVES A BIT OF CODE)
MOVE T3,A.CANCEL(X) ;GET HIS SETTING
MOVE T4,A.CANCEL+1(X) ;+ POSS. ARG.
SETZ T1,
SETUWP T1, ;W/E HI SEG
HALT
MOVEM T2,A.CANCEL(X) ;RESTORE DEFAULT
SETZM A.CANCEL+1(X) ;CLEAR ARG SPACE
SETUWP T1,
HALT
JRST T3 ;AND DO IT NOW
SUBTTL MASTER PROCESS - READ A LINE FROM THE FILE
IPLINF: SETO T1, ;ONLY INTERPRET IF COMMANDS
JRST IPLIN0
IPLINE: TDZA T1,T1 ; ALLOW INTERPRETED COMMANDS
IPLINL: MOVEI T1,1 ;DON'T ALLOW ANY
IPLIN0: MOVEM T1,ARGTYP ;REMEMBER
SKIPE T1
TLZ F,FL.MON
PUSHJ P,CLRIBF ;CLEAN THE INPUT BUFFER
PUSH P,[EXP STRIBF] ;TO FORCE AUTOMATIC STORAGE OF I/P LINE
;IN USERS HI PDB
; SKIPE BLKNO(Y) ;IS THIS THE FIRST TIME
; TLNE F,FL.BRK ;HAVE WE HAD A BREAK CHAR.
TDZ F,[FL.DOT!FL.PCT!FL.SMC!FL.AST!FL.CMD!FL.LAB,,FR.IF!FR.JMP]
;CLEAR UNWANTED BITS
TLZE F,FL.MON ;IF WE HAVE JUST FORCED TO MON MOD
TLO F,FL.DOT ;HE MUST HAVE HAD A DOT
SETZM LABWD ;CLEAR LABEL
IPLIN3: MOVEI WD,^D81
MOVEM WD,LINTOT
SETZ WD,
MOVE T1,[POINT 7,BUFFER]
MOVEM T1,BUFBP ;SET UP BUFFER POINTER
MOVE BP,[440600,,WD] ;SET UP BYTE POINTER FOR SIXBIT COMMAND
IPLIN1: PUSHJ P,INFILE ;READ CHAR
POPJ P, ;NON-SKIP RETURN ON EOF
IDPB CH,BUFBP ;STORE IT
SOSG LINTOT ;DECREMENT COUNT
JRST CPOPJ1 ;YES - SUCCESS RETURN
TLZE F,FL.LAB ;A LABEL?
JRST LABEL ;YES - GO DEAL WITH IT
TLNE F,FL.BRK ;IS THIS A BREAK CHAR?
JRST CMDCHK ;YES - GO CHECK COMMAND
TLNE F,FL.CMD!FL.AST!FL.CR!FL.SMC
;NO COMMAND OR LABEL CAN COME AFTER A * = ! OR ANOTHER COMMAND
JRST IPLIN4
TLNN BP,770000 ;IF BYTE POINTER EXHAUSTED
JRST CMDEND
CAIE CH," " ;SPACE?
CAIN CH," " ;OR TAB?
JRST IGNORE ;YES MAY WANT TO IGNORE IT
CAIN CH,"%"
JRST IPLIN2
CAIL CH,"0" ;IS IT A LETTER?
CAILE CH,"Z"
JRST CMDEND ;NO TERMINATE COMMAND
CAIGE CH,"A"
CAIG CH,"9"
JRST IPLIN2
JRST CMDEND
IPLIN2: SUBI CH," " ;CONVERT TO SIXBIT
IDPB CH,BP ;OTHERWISE PUT IT IN COMMAND WORD
JRST IPLIN1 ;AND GO READ NEXT CHAR
;HERE TO CLEAN THE INPUT BUFFER
CLRIBF: SETZM BUFFER
MOVE T1,[BUFFER,,BUFFER+1]
BLT T1,BUFFER+^D15
POPJ P,0
;HERE TO STORE THE I/P LINE IN THE USER'S PDB
STRIBF: SKIPA
AOS (P) ;CALLED AUTOMATICALLY
PUSH P,T1
SETZ T1,
SETUWP T1,
HALT
MOVSI T1,BUFFER ;ADDRESS OF COMMON BUFFER
HRRI T1,INLINE(X) ;ADDRESS OF USERS BUFFER
BLT T1,INLINE+^D15(X);TO HERE
MOVEI T1,1
SETUWP T1,
HALT
POP P,T1
POPJ P,0
;HERE TO DEAL WITH SOME INTERPRETED COMMANDS
IPLIN4: TRNN F,FR.IF!FR.JMP ;DOING AN INTERPRETED COMMAND
JRST IPLIN1 ;NO
MOVSI T1,770000
TDNN T1,ARGPNT ;ARGUMENT POINTER EXHAUSTED
JRST ARGEND ;YES
CAIE CH," " ;SPACE
CAIN CH," " ;OR TAB?
JRST IPLIN1 ;YES-IGNORE.
TRNE F,FR.IF ;DOING AN "IF"
JRST [CAIE CH,"(" ;YES-CHECK FOR OPENING BRACKET
JRST .+1 ;THIS ISN'T ONE
SKIPN ARGWRD ;HAVE WE READ ANFING YET?
JRST IPLIN1 ;NO-ALLOW 1 OPENING BRACKET
JRST .+1]
CAIN CH,"%" ;IS IT A %
JRST [SKIPN ARGWRD ;YES-ONLY ALLOWED AS FIRST CHAR.
JRST IPLIN5 ;OK
JRST ARGEND] ;TERMINATE THE ARGUMENT
CAIL CH,"0"
CAILE CH,"Z" ;IS IT ALPHA-NUMERIC
JRST ARGEND ;NO-TERMINATE THE ARG
CAIGE "A"
CAIG CH,"9"
SKIPA
JRST ARGEND ;NO-TERMINATE THE ARG.
IPLIN5: SUBI CH," " ;MAKE IT SIXBIT
IDPB CH,ARGPNT ;STORE IT
JRST IPLIN1 ;AND READ NEXT CHAR.
;HERE AT THE END OF AN INTERPRETED COMMANDS ARGUMENT
ARGEND: TRZN F,FR.IF ;END OF AN IF?
JRST ARGJMP ;NO
MOVE T1,ARGWRD ;YES GET THE ARG.
CAME T1,[SIXBIT/ERROR/] ;CHECK
CAMN T1,[SIXBIT/NOERROR/] ;FOR VALIDITY
JRST ARGND1 ;ITS A NICE ONE.
ARGND0: ;NOT AN IF(ERROR)/IF (NOERROR)
TRZ F,FR.IF!FR.JMP ;HERE WHEN WE HAVE FAILED
SETZM ARGWRD ;SO CLEAR UP
SETZM ARGPNT
JRST IPLIN1 ;AND LET SLAVE SORT IT OUT
ARGND1: CAIN CH,")" ;TERMINATOR ALREADY?
JRST ARGDUN ;YES-GOOD BOY!
ARGND2: PUSHJ P,INFILE ;READ A CHARACTER
JRST IPLIN1+1 ;EOF?
IDPB CH,BUFBP ;STORE IT
SOS LINTOT ;DECREMENT COUNT
TLNE F,FL.BRK ;BREAK CHARACTER
JRST CMDCHK ;YES!
CAIN CH,"R" ;FOR "NOERROR"
JRST ARGND3 ;YES
CAIE CH," " ;SPACE
CAIN CH," " ;OR TAB?
JRST ARGND3 ;YES IGNORE
ARGDUN: CAIE CH,")" ;MUST BE THIS
JRST ARGND0 ;SO SAD!
PUSH P,S ;IT IS A REAL IF (ERROR)/IF(NOERROR)
MIC GET,L ;GET LDBMIC WORD
SETZ S, ;OOOOPS
MOVE T1,ARGWRD ;GET ERROR/NOERROR
CAME T1,[SIXBIT/ERROR/]
TLC S,LDL.ER
TLNN S,LDL.ER ;IS IT TRUE?
PUSHJ P,EATLNE ;EAT THE REST OF THE LINE!
TLZ S,LDLCHK!LDL.ER!LDL.TI!LDL.MM
MIC SET,L
JFCL
POP P,S
;AT THIS POINT WE HAVE HANDLED THE STATEMEMT
;AND WE MUST NOW RETURN SO THAT IT WILL BE SHOWN TO THE USER
;(NB. FR.IF!FR.JMP IMPLY DISPLAY NOT TYPE)
TRO F,FR.IF!FR.CL1 ;RESET FLAGS (AND PRETEND IN COLUMN ONE)
ARGFN0: TLZ F,FL.MON!FL.SMC!FL.AST!FL.CMD
TLO F,FL.DOT!FL.BRK ;PRETEND DOT AND BREAK!
JRST CPOPJ1 ;RETURN
ARGND3: SKIPG LINTOT ;ANY ROOM
JRST ARGND0 ;NO
JRST ARGND2
;HERE TO INTERPRET JUMP STATEMENTS
ARGJMP: SETZ T1,
CAMN WD,[SIXBIT/GOTO/] ;GOTO STATEMENT
MOVEI T1,1 ;YES
ADD T1,X ;WORK OUT WHERE TO PUT LABEL
MOVE T2,ARGWRD ;GET THE ARG.
SETZ T3,
SETUWP T3, ;W/E HI-SEG
HALT
MOVEM T2,BLAB(T1) ;STORE
SETUWP T3, ;W/L HI-SEG
HALT
ARGJM1: TLNE F,FL.BRK ;BREAK ALREADY
JRST ARGJM4 ;YES
CAIE CH," " ;SPACE?
CAIN CH," " ;OR TAB?
SKIPA ;YES
JRST ARGJM2
PUSHJ P,INFILE ;READ A CHARACTER
POPJ P,0 ;EOF?
IDPB CH,BUFBP ;STORE CHAR.
SOSE LINTOT
JRST ARGJM1 ;LOOP FOR MORE
JRST ARGND0
ARGJM2: CAIE CH,"." ;DOT
CAIN CH,"*" ;OR ASTERISK
JRST ARGJM3 ;YES
CAIN CH,"\" ;MAYBE A EOL
JRST [TRO F,FR.CL1 ;YES
JRST ARGJM4]
PUSHJ P,EATLNE ;EAT REST OF LINE
JRST ARGFIN
ARGJM3: DPB CH,LDPF ;SAVE CHAR
TDO F,[FL.SAV,,FR.CL1] ;AND REMEMBER
ARGJM4: TLZ F,FL.DOT!FL.MON!FL.SMC!FL.AST!FL.CMD
JRST ARGFIN
EATLNE: ;ROUTINE TO EAT EVERYTHING UP TO AND INCLUDING A BREAK
PUSHJ P,INFILE ;READ A CHAR
POPJ P,0 ;EOF?
EATLN1: IDPB CH,BUFBP ;STORE IT
SOSG LINTOT ;DECREMENT COUNT
POPJ P,0 ;GET OUT OF THAT- IF U CAN
TLNN F,FL.BRK ;IS IT A BREAK?
JRST EATLNE ;TRY AGAIN
CAIE CH,CR ;CARRIAGE RETURN
POPJ P,0 ;NO-JUST RETURN
MOVEI CH,LF ;LET HIM HAVE A LINE FEED
JRST EATLN1
LABEL: MOVEM WD,LABWD
TRO F,FR.CL1 ;SAY WE ARE NOW IN COL 1
LDB CH,[POINT 6,WD,5] ;GET THE 1ST CHAR
CAIN CH,'%' ;"%"?
TLO F,FL.PCT ;YES - SET FLAG
PUSHJ P,CLRIBF ;CLEAR THE INPUT BUFFER
SKIPN ARGTYP
JRST IPLIN3 ;ALL INTERPRETATIONS ALLOWED
JRST CPOPJ1 ;ONLY "IF" OR NONE.
CMDEND: TLZ BP,-1 ;FLAG EOL
TLO F,FL.CMD ;READ A COMMAND
SKIPLE ARGTYP ;ANY INTERPS ALLOWED?
JRST IPLIN1 ;NO
CAMN WD,IFWD ;IS THIS AN IF COMMAND?
TRO F,FR.IF ;YES
SKIPE ARGTYP ;GOTO/BACKTO TO BE INTERPRETED?
JRST CMDND1 ;NO
CAME WD,[SIXBIT/GOTO/]
CAMN WD,[SIXBIT/BACKTO/]
TRO F,FR.JMP ;ITS A GOTO/BACKTO COMMAND
CMDND1: TRNE F,FR.IF!FR.JMP ;ARE WE DOING AN INTERPRET
PUSHJ P,ARGSTP ;YES-PREPARE THE GROUND
JRST IPLIN1
ARGSTP: SETZM ARGWRD ;CLEAR ARGUMENT SPACE
MOVE T1,[POINT 6,ARGWRD]
MOVEM T1,ARGPNT ;INITIALLISE POINTER
POPJ P,0
CMDCHK:
TRNE F,FR.IF!FR.JMP ;DID WE INTERPRET
JRST ARGEND
TLZ F,FL.CMD!FL.LAB
ARGFIN: JRST CPOPJ1 ;SUCCESS EXIT
IGNORE: SKIPN WD ;DON'T IGNORE SEPERATORS AFTER A COMMAND
TLNE F,FL.DOT ;OR AFTER A DOT IN COL 1
JRST CMDEND
TRO F,FR.CL1 ;SAY WE'RE IN COL 1
JRST IPLIN3 ;AND GO READ NEXT CHAR
INFILE: TLZ F,FL.BRK ;CLEAR THE BREAK FLAG
RCH1: PUSHJ P,FETCHR ;GET THE NEXT CHARACTER
POPJ P, ;ERROR OR END OF FILE - EXIT
COL2: CAIN CH,"'" ;IS IT A PARAMETER CALL?
JRST PARAM ;YES - GO & DEAL WITH IT
TRZE F,FR.CL1 ;COLUMN 1?
JRST COL1 ;YES - SPECIAL TREATMENT
CAIN CH,"^" ;CONTROL CHARACTER?
JRST CONTRL ;YES
CAIN CH,15 ;CARRIAGE RETURN?
JRST CRET ;YES
CAIN CH,12 ;LINEFEED?
JRST LFEED ;YES
CAIN CH,":" ;IS IT A COLON
JRST LABL ;YES SPECIAL HANDLING
RCH2: PUSHJ P,ISBRK ;IS IT A BREAK CHAR?
RCH3: TLO F,FL.BRK ;YES SET FLAG
JRST CPOPJ1 ;AND NORMAL EXIT
COL1: MOVSI T1,PL.CL1 ;CHECK IF HE WANTS COLUMN ONE STUFF
TRNE F,FR.DIS ;ARE WE DOING AN <EVENT>:DISPLAY
TROA F,FL.SMC ;YES-- DUMMY UP A COMMENT
TDNE T1,PROFLE(X) ;DOES HE?
JRST CPOPJ1 ;NOPE
CAIN CH,"!"
JRST COMENT
CAIN CH,"." ;Wants monitor mode?
JRST MONMD ;Yes
CAIN CH,"=" ;IGNORE CR & LF?
JRST EQUALS ;YES
CAIE CH,"*" ;User mode?
JRST COL2 ;No - O.K. continue
PUSHJ P,FETCHR ;YES - GET NEXT CHAR
POPJ P, ;ERROR RETURN - EXIT
CAIN CH,"*" ;ANOTHER ASTERISK?
JRST CPOPJ1 ;YES OK - EXIT
TLO F,FL.AST ;SAY U HAVE SEEN AN ASTERISK
TLNN S,LDL.MM ;IN MONITOR MODE?
JRST COL2 ;NO - O.K. CHECK COL2
TLO F,FL.SAV ;YES - SET FLAG
DPB CH,LDPF ;AND SAVE CHAR
MOVEI CH,"*" ;FORCE ASTERISK
JRST CPOPJ1 ;AND SUCCESS RETURN
COMENT: PUSHJ P,FETCHR ;DID HE MEAN A COMMENT
POPJ P,0 ;NO HE GOT AN EOF
CAIN CH,"!"
JRST CPOPJ1 ;HE MEANT !
TLO F,FL.SMC ;REMEMBER U WISH DISPLAY NOT TYPE
JRST COL2
CRET: TLNE F,FL.CR ;IGNORE IT?
JRST RCH1 ;YES
TLO F,FL.CRT ;SET TO SHOW CR TYPED
JRST RCH2 ;NO
LFEED: TLZN F,FL.CR ;IGNORE IT?
JRST LFEED2 ;NO
LFEED3: TDO F,[FL.BRK,,FR.CL1] ;SET BREAK FLAG
SETZ CH,
AOS (P)
PUSHJ P,SETHIB ;SET HIBER TIME LIMIT
JRST CPOPJ1 ;EXIT TO AVOID TYPING PSEUDO BREAK
LFEED2: TLZN F,FL.CRT ;WAS CR TYPED LAST?
JRST RCH2 ;NO - SEND IT DOWN
TRO F,FR.CL1 ;YES - SET COLUMN 1 FLAG
JRST RCH1 ;AND READ NEXT CHAR
EQUALS: PUSHJ P,FETCHR ;READ NEXT CHARACTER
POPJ P, ;ERROR RETURN - EXIT
CAIE CH,"=" ;ANOTHER?
TLO F,FL.CR ;NO - SET FLAG
JRST COL2 ;IN ANY CASE EXIT
CONTRL: MOVSI T1,PL.CTL ;CHECK IF HE WANTS CONTROL CHARACTER STUFF
TDNE T1,PROFLE(X) ;DOES HE
JRST CPOPJ1 ;NOPE
PUSHJ P,FETCHR ;Read next character
POPJ P, ;Error return - exit
CAIN CH,"^" ;Another ^ ?
JRST CPOPJ1 ;Yes - O.K. Exit
SUBI CH,100 ;No - convert to control character
JUMPG CH,RCH2 ;O.K. If positive
JRST RCH1 ;Otherwise ignore
MONMD: PUSHJ P,FETCHR ;GET NEXT CHAR.
POPJ P, ;ERROR RETURN - EXIT
CAIN CH,"." ;ANOTHER DOT?
JRST CPOPJ1 ;YES - O.K. EXIT
TLO F,FL.DOT ;SET THE FLAG
TLNE S,LDL.MM ;MONITOR MODE?
JRST COL2 ;YES - SUCCESSFUL RETURN
TLO F,FL.MON
JRST COL2
;IF YOU HAVE SEEN A COMMAND,*,.,!,= YOU CANNOT HAVE A LABEL
LABL: TLNE F,FL.CMD!FL.AST!FL.DOT!FL.SMC!FL.CR
JRST RCH2 ;YES NO MORE CHECKING
IFN FTOLDL,< ;IF WE DONT WISH TO FORCE :: ON LABELS
TLO F,FL.LAB ;SET TO SHOW LABEL READ
PUSHJ P,FETCHR ;YES - READ NEXT CHAR
POPJ P, ;RETURN FOR EOF
CAIN CH,":" ;IS THIS A SECOND COLON
JRST CPOPJ1 ;YES - RETURN
TLO F,FL.SAV ;NO - SAVE THE CHAR
DPB CH,LDPF
JRST CPOPJ1 ;AND RETURN
>
IFE FTOLDL,< ;NEW STYLE FORCE "::" ON A LABEL
PUSHJ P,FETCHR ;GET NEXT CHARACTER
POPJ P,0 ;ERROR - RETURN
CAIN CH,":" ;2ND COLON?
JRST LABL2 ;YES - MUST BE A LABEL
CAIN CH,CR ;<CR>?
JRST LABL3 ;THAT COULD BE A LABEL TOO
LABL4: TLO F,FL.SAV ;OTHERWISE NOT A LABEL
DPB CH,LDPF ;SO SAVE THE SECOND CHAR.
MOVEI CH,":" ;AND RESTORE THE FIRST COLON
JRST CPOPJ1 ;AND SUCCESS RETURN.
LABL3: PUSHJ P,FETCHR ;<CR> - GET THE <LF>
POPJ P,0 ;ERROR - RETURN
CAIE CH,LF ;MAKE SURE IT IS
JRST LABL4 ;ITS NOT - TOUGH
;FALL INTO LABL2
LABL2: TLO F,FL.LAB ;WE HAVE SEEN A LABEL
JRST CPOPJ1 ;SUCCESS RETURN
> ;END OF RELEASE BIT
PARAM: MOVSI T1,PL.PRM ;CHECK IF PARAMETTERS WANTED
TDNE T1,PROFLE(X) ;LOOK AND SEE
JRST CPOPJ1 ;NO
PUSHJ P,FETCHR ;GET NEXT CHAR
POPJ P, ;Error return - Exit
CAIN CH,"'" ;Another PRIME?
JRST PAR2 ;Yes - Exit
PUSHJ P,LOWUP
CAIGE CH,"A" ;MUST BE A LETTER
JRST NOTALF ;IT'S NOT A LETTER
SUBI CH,"A"-1 ;Convert to digit
CAILE CH,ARGNUM ;Within range?
JRST NOTNUM ;ITS NOT A LETTER OR ANUMBER
JUMPE CH,PARERR ; "
ADDI CH,ARGBP-1(X) ;Add base pointer
PARAM1: MOVE T1,@CH ;Get the byte pointer
JUMPE T1,PARAM2 ;[552] TEST FOR NULL PARAMETERS
PAR5: MOVSI CH,-NESTY ;U CAN NEST PARAMETERS THIS DEEP
HRRI CH,CURBP(Y)
PAR4: EXCH T1,(CH) ;SHOVE A ANOTHER
JUMPE T1,RCH1 ;ON THE STACK
AOBJN CH,PAR4 ;IF U HAVE THE ROOM
JRST MACERR
PAR2: TRZ F,FR.CL1 ;NO LONGER IN COL1
JRST CPOPJ1 ;AND EXIT
;[552] HERE WHEN WE ARE NESTING PARAMETERS AND THE CURRENT ONE IS NULL
PARAM2: PUSHJ P,FETCHR ;READ A CHAR
POPJ P,0 ;OOOPS
JRST COL2 ;LOOP BACK TO FIX IT UP
PAR3: PUSHJ P,SYMB1
JRST PARER2
JRST PAR5 ;IT WAS AN OK SYMBOL
NOTALF: CAIL CH,"0" ;HERE TO SEE IF IT'S A NUMBER OR A SYMBOL
CAILE CH,"9"
JUMPA NOTNM2 ;MUST BE A SYMBOL
JRST PARERR ;IT'S A DIGIT BUT THERE NOT ALLOWED YET
NOTNUM: ADDI CH,"A"-1 ;MAKE IT ASCII
NOTNM2: CAIN CH,"<"
JRST PAR3 ; < ARE OK
CAIN CH,"[" ; [ ARE OK
JRST PAR3
CAIN CH,"("
JRST PAR3 ; ( ARE OK
CAIN CH,173 ;UPPER CASE PARENTHISIS
JRST PAR3
JRST PARERR ;ANYTHING ELSE YEUGHHHH!
OPFIL: MOVE T3,DEV(X)
MOVEI T2,17
SETZ T4,
OPEN T2 ;Open the channel
JRST NODEV ;ERROR!!
MOVE T1,FILE(X) ;MOVE FILE SPEC TO AC'S
MOVE T2,EXT(X)
SETZ T3,
MOVE T4,PPN(X) ;And his PPN
LOOKUP T1 ;And LOOKUP his file
JRST NOFILE ;FILE WASN'T THERE
SKIPN BLKNO(Y) ;First time?
TRO F,FR.CL1 ;Yes - set column 1 flag.
PJRST CPOPJ1 ;AND EXIT
RDACTP: ILDB CH,CURBP(Y) ;GET NEXT CHAR.
JUMPN CH,CPOPJ1 ;EXIT IF NON-BLANK
MOVSI CH,CURBP+1(Y)
HRRI CH,CURBP(Y)
BLT CH,CURBP+NESTY-1(Y) ;POP NEXT PARAMETER
TRZ F,FR.DIS ;CLEAR EVENT:DISPLAY BIT
SETZM CURBP+NESTY-1(Y)
;FALL THROUGH
FETCHR: TLZE F,FL.SAV ;IS THERE A CHAR IN THE BUFFER?
JRST FETCH2 ;YES - GO AND GET IT
SKIPE CURBP(Y)
JRST RDACTP ;YES GO AND GET CHAR FROM IT.
PUSHJ P,GETCHR ;READ CHAR FORM DISK
POPJ P, ;ERROR RETURN - EXIT
JRST CPOPJ1 ;:OTHERWISE NORMAL RETURN
ISBRK: PUSH P,T1 ;PRESERVE T1
MOVSI T1,-BRKLTH ;NUMBER OF BREAK CHARS.
CAME CH,BRKLST(T1) ;COMPARE WITH NEXT IN LIST
AOBJN T1,.-1 ;NO MATCH
SKIPL T1
AOS -1(P) ;FOR NO MATCH RETURN
POP P,T1 ;RESTORE T1
POPJ P, ;RETURN
FETCH2: LDB CH,LDPF ;RESTORE CHAR
JRST CPOPJ1 ;AND EXIT
BRKLST: EXP CNTRLC,BELL,LF,VT,FF,CNTRLZ,ALT,ALT175,ALT176,CR
IFN FTRLSE,<
EXP CNTRLB
>
BRKLTH==.-BRKLST
NODEV: MOVEI S,[ASCIZ/?CANNOT INIT DEVICE./]
PJRST MSG
NOFILE: MOVEI S,[ASCIZ/?MACRO FILE NOT FOUND./]
PJRST MSG
PARERR: MOVEI S,[ASCIZ/?PARAMETER NUMBER OUT OF RANGE./]
PJRST MSG
PARER2: MOVE S,T1 ;ON ERROR EXIT FROM GETTAB HANDLER
; ERORR MSG. ADDRESS IS IN T1
PJRST MSG
MACERR: MOVEI S,[ASCIZ/?CANNOT NEST PARAMETER CALLS THIS DEEP/]
MSG: PUSH P,S ;PRESERVE S
MIC GET,L ;GET CURRENT STATUS
JFCL
TLNN S,LDL.MM ;IS HE IN MONITOR MODE?
PUSHJ P,FRCMON ;NO-HELL SOON WILL BE THO'
TLZE S,LDL.XX ;IS HE SILENCED
TLO F,FL.XX ;YES
TLZ S,LDL.XX!LDL.TI!LDL.MM
MIC SET,L ;TURN OFF SILENCE AND NON-PERMANENT BITS
JFCL
PUSHJ P,MCRLF ;GIVE HIM A CR LF
POP P,S ;RESTORE MSG POINTER
MSG2: MIC DISPLAY,L
JFCL
PUSHJ P,PCRLF ;GIVE HIM A <CR><LF>PERIOD.
JRST FIN1
MCRLF: MOVEI S,[ASCIZ/
/]
MIC DISPLAY,L
POPJ P,0
POPJ P,0
PCRLF: MOVEI S,[ASCIZ/
./]
MIC DISPLAY,L
POPJ P,0
POPJ P,0
SETHIB: MOVN P3,LINTOT
ADDI P3,^D80
SETHB1: MSTIME T1, ;NOW
IMULI P3,^D100 ;ESTIMATE OF TIME TAKEN TO DISPLAY
ADD T1,P3 ;+NOW=THEN
SKIPE HIBTIM ;IF NOBODY USING IT LET US
CAMGE T1,HIBTIM ;SOMEBODY SAID WAKE UP SOONER
MOVEM T1,HIBTIM
MOVEM T1,LTIME(Y) ;PUT THAT IN THE PROCESS
POPJ P,0
OUTPNG: MOVEI T3,.TOSOP ;THIS ROUTINE SKIP RETURNS IF LINE IS STILL DOING O/P
MOVEI T4,.UXTRM(L) ;UNIVERSAL TERMINAL STUFF
MOVE T2,[2,,T3]
TRMOP. T2,
POPJ P,0 ;NON SKIP RETURN
JRST CPOPJ1 ;SKIP
;A routine to read a char.
;BLKNO(Y) = Block no. within file
;FILBLK(Y) = Dump area for one block of file
;POINTR(Y) = 7 Bit pointer to dump area
GETCHR: ILDB CH,POINTR(Y) ;Get a char
JUMPE CH,NOBYT1 ;Out of chars in this block
CPOPJ1: AOS (P) ;Skip return for success
CPOPJ: POPJ P,
NOBYT1: HRRZ T1,POINTR(Y)
JUMPE T1,NOBYT
CAIE T1,FILBLK+200
JRST GETCHR
NOBYT: PUSHJ P,OPFIL ;Open the file
POPJ P, ;Not there
AOS T1,BLKNO(Y) ;Look at next block
USETI (T1) ;Of file
MOVEI T1,FILBLK-1(Y) ;Set up IOWD
HRLI T1,-^D128
SETZ T2,
IN T1 ;Grab the block
SKIPA T1,[XWD 440700,FILBLK(Y)]
POPJ P, ;Must be end of file
RELEAS
MOVEM T1,POINTR(Y)
HRLI T1,^D-128
HRRI T1,FILBLK(Y)
NOBYT2: MOVE T2,(T1) ;GET WORD OF BUFFER
TRNE T2,1 ;IS IT A LINE NO?
PUSHJ P,NOBYT3 ;YES-ITS NOT NOW
AOBJN T1,NOBYT2 ;DO THE WHOLE BUFFER
JRST GETCHR ;Go grab next char.
;HERE TO DELETE LINE NUMBER TEXT POINTED TO BY T1
NOBYT3: SETZB T2,(T1) ;THAT TAKES CARE OF NNNNN
DPB T2,[POINT 7,1(T1),6]
;AND THAT TAKES CARE OF SPACE OR TAB IN NEXT WORD
POPJ P,0
SUBTTL FUNCTION SERVICE ROUTINE
;THIS ROUTINE HANDLES FUNCTIONS SUCH AS GETTAB JOB ETC.
;EACH FUNCTION IS SPECIFED BY 6 ARGUMENTS:-
; A - NAME
; B - TYPE-OUT MODE (A NUMERIC VALUE)
; C - CODE TO GET FUNCTION VALUE (IF CALLED IN MASTER)
; D - CODE TO GET FUNCTION VALUE (IF CALLED IN SLAVE)
; E - ADDR. FOR MASTER CALL TO DISPATCH TO.
; F - ADDR. FOR SLAVE CALL TO DISPATCH TO
DEFINE FUNCTN,< ;;TABLE OF FUNCTIONS
.FF. DATE,12,<DATE T1,>,<DATE T1,>
.FF. TIME,7,<MSTIME T1,>,<MSTIME T1,>
.FF. PPN,6,<MOVE T1,OPPN(X)>,<GETPPN T1,>
.FF. PROGRAMMER,11,<HRRZ T1,OPPN(X)>,<GETPPN T1,>,SYMOUT,SYMPG0
.FF. PROJECT,11,<HLRZ T1,OPPN(X)>,<GETPPN T1,>,SYMOUT,SYMPJ0
.FF. TTY,11,<HRRZ T1,LINE(X)>,<SETO T1,>,SYMOUT,SYMTY0
.FF. JOB,4,<HRRZ T1,JOB(X)>,<PJOB T1,>
.FF. GETTAB,1,,,SYMGTX,SYMGT0
>
DEFINE .FF.(A,B,C,D,E,F),<<SIXBIT/'A/>>
SYMTAB: FUNCTN
SYMSIZ==.-SYMTAB
;MASTER SYMBOL DISPATCH
DEFINE .FF.(A,B,C,D,E<SYMOUT>,F),<B,,E>
MSTDSP: FUNCTN
;SLAVE SYMBOL DISPATCH
DEFINE .FF.(A,B,C,D,E,F<SYMOUT>),<B,,F>
SLVSDP: FUNCTN
;MASTER ACTION
DEFINE .FF.(A,B,C<JFCL>,D,E,F),<
IFB <C>,<
JFCL
>
IFNB <C>,<
C
>
>
MSTACT: FUNCTN
;SLAVE ACTION
DEFINE .FF.(A,B,C,D<JFCL>,E,F),<
IFB <D>,<
JFCL
>
IFNB <D>,<
D
>
>
SLVACT: FUNCTN
;HERE IS WHERE WE COME TO DEAL WITH FUNCTIONS CALLED FROM MASTER
SYMB1: SKIPE CH,CURBP+7(Y) ;CHECK THE PARAMETER STACK
JRST MACERR ;NO ROOM
MOVE CH,[JRST GETTB1] ;SET UP NEW LOW LEVEL I/P ROUTINE
PUSHJ P,SVLOWN ;AND SAVE THE EXISTING ONE
PUSH P,["<"] ;PUT A MARKER ON THE STACK
HRRZ T1,JOB(X) ;JOB # IS DEFAULT TABLE INDEX
MOVEM T1,DEFNDX ;SET UP THE DEFAULT INDEX
PUSHJ P,ALPHI ;READ A 6-BIT WORD
;IS IT A SYMBOL WE KNOW ABOUT
MOVSI T3,-SYMSIZ
CAME WD,SYMTAB(T3)
AOBJN T3,.-1
JUMPG T3,SYMER3
MOVEM CH,CH.SAV ;SAVE THE TERMINATOR
XCT MSTACT(T3) ;DO THE APPROPRIATE ACTION
JFCL ;DEFENSIVE
HLRZ T2,MSTDSP(T3) ;SET UP THE APPROPRIATE MODE
HRRZ T3,MSTDSP(T3) ;GET DISPATCH ROUTINE NAME
JRST (T3) ;AND DISPATCH
;HERE FOR GETTABS FORM MASTER
SYMGTX: SKIPE GTLOCK ;LOCK FOR RECURSIVE GETTABS
JRST SYMERM ;WHICH ARE NOT ALLOWED
SETOM GTLOCK ;SET THE LOCK
SETZM CH.SAV ;GETTABS DON'T WANT TO SAVE THE TERMINATOR
JRST SYMGT1 ;DO THE GETTAB
; THIS IS WHERE WE COME FROM SLAVE
SYMGET: PUSH P,["$"] ;MARKER
HLRZ T2,SLVSDP(T3) ;GET MODE
XCT SLVACT(T3) ;DO APPROPRIATE FING.
JFCL ;DEFEND AGAINST FUNNY GETPPN'S
HRRZ T3,SLVSDP(T3) ;GET ADDR. OF DISPATCH ROUTINE
JRST (T3) ;DISPATCH
SYMGT0: SETZM CH.SAV ;ENTRY FOR GETTABS
PJOB T1, ;GET HIS JOB NO.
MOVEM T1,DEFNDX ;SET UP THE DEFAULT INDEX
JRST SYMGT1
SYMERS: MOVEI T1,[ASCIZ/?SYMERS - MIC UNKNOWN FUNCTION/]
JRST CPOPJ
SYMERM: MOVEI T1,[ASCIZ/?SYMERM - NESTED GETTABS NOT ALLOWED/]
PJRST CLNSTK
SYMTY0: GETLCH T1 ;GET LINE NO
ANDI T1,3777 ;NO UDX
JRST SYMOUT ;DO IT
SYMPG0: HRRZS T1 ;JUST PROG
JRST SYMOUT
SYMPJ0: HLRZS T1 ;JUST PROJ
JRST SYMOUT ;DO IT
;FROM HERE BOTH GETTAB ENTRIES USE COMMON CODE
;THAT IS COMMON TO SLAVE AND MASTER !!!!
SYMGT1: CAIE CH,"(" ;IF ANY ARGS
JRST SYMDF3 ;WANTS ALL DEFAULTS (I HOPE!)
PUSHJ P,SYMPRM ;GET A PARAMETER
JRST SYMERR ;SOMAT WRONG!
JUMPGE N1,SYMER4 ;(, IS ILLEGAL
PUSH P,N ;SAVE IT TILL READY
CAIN CH,")" ;IF THERE IS NO 2ND PARAMETER THE LIST SHOULD END WITH A ) OTHERWISE ,
JRST SYMDF2 ;1 PARAMETER ONLY USE DEFAULTS FOR REST
PUSHJ P,SYMPRM ;GET 2ND PARAMETER
JRST SYMERR ;BETTER LUCK NEXT TIME
CAMN N,[-1] ;INDEX=-1 MEANS USE JOB NO.
MOVE N,DEFNDX ;ITS HERE
JUMPGE N1,SYMER4 ;N1=0 MEANS FORMAT IS ,, OR ,) I.E. ERROR
PUSH P,N ;SAVE IT
CAIN CH,")" ; IS THERE A 3RD PARAMETER
JRST SYMDF1 ;NO--USE DEFAULT
PUSHJ P,ALPHI ;GET NAME OF TYPE OUT MODE
JUMPE WD,[MOVEM CH,CH.SAV
JRST SYMGT2] ;PROBABLY OLD-STYLE NUMERIC
TLNN WD,7777 ;NAME MUST BE AT LEAST 3 CAHRS LONG
JRST [SKIPE GTLOCK ;WOT R WE (MASTER OR SLAVE
JRST SYMER4 ;MASTER THEREFORE ERROR
PUSH P,STK ;FOR COMPATABILLITY
PUSHJ P,ATOM1B
JRST SYMGT3]
HLRZS WD
MOVSI N,-VALMODS ;NO. OF VALID MODES
HLRZ N1,MODTAB(N) ;GET A MODE NAME
CAME N1,WD ;THIS ONE?
AOBJN N,.-2 ;NOPE
JUMPGE N,SYMER4 ;DIDN7T FIND IT
HRRZ N,MODTAB(N) ;GET THE MODE INDEX
JRST SYMGT3
SYMGT2: PUSHJ P,SYMPRM ;GET 3RD PARAMETER
JRST SYMERR ;OH DEAR
JUMPGE N1,SYMER4 ;NO NO.THUS FORMAT IS ,, ,) I.E. ERROR
SYMGT3: PUSH P,N ;SAVE IT TILL READY
CAIE CH,")" ;SHOULD END WITH )
JRST SYMERR ;DIDN'T
JRST SYMDO ;NOW TO DO THE GETTAB
SYMDF3: PUSH P,DEFTBL ;HERE IF USING ALL DEFAULTS
SYMDF2: PUSH P,DEFNDX ;DEFAULT INDEX AND TABLE
SYMDF1: PUSH P,DEFMOD ;DEFAULT MODE ONLY
; JRST SYMDO
SYMDO: SETZM GTLOCK ; CLEAR THE GETTAB LOCK
POP P,T2 ;GET THE ARGS.. FIRST MODE
POP P,T1 ;INDEX
HRLZS T1 ;IN RIGHTFUL PLACE
POP P,N ;THEN TABLE ?
HRR T1,N ;IN ITS PLACE
GETTAB T1, ;DO THE GETTAB
JRST SYMER2 ;DIDN'T WORK
;RESULT OF GETTAB IS IN T1 NOW TO O/P IT
SYMOUT: CAIE T2,0 ;CHECK IF VALID OUTPUT MODE
CAILE T2,VALMOD
JRST SYMERR ;NO....
MOVE N,T1 ;PUT IT IN O/P PLACE
MOVE T4,SYMPNT ;SET UP POINTER TO THE O/P AREA
MOVE T3,[IDPB CH,T4]
PUSH P,LOWOUT ;SAVE THE EXISTING OUTPUT PATH
MOVEM T3,LOWOUT ;AND SET UP THE ONE WE WANT
XCT PRNTAB(T2) ;DO THE PRINT
SETZ CH,
CAIE T2,2 ;SKIP IF ASCII
IDPB CH,T4 ;PUT A ZERO BYTE AT END OF RESULT
POP P,LOWOUT ;RESTORE ORIG. O/P PATH
MOVE CH,(P) ;ARE WE SLAVE OR ?
CAIN CH,"$" ;OR $GETTAB
JRST SLVCLS
PUSHJ P,CHARIN ;GET THE CLOSING DELIMITER
CAIN CH,">" ;ONE OF THESE
JRST SYMDO4 ;YES
CAIN CH,"]" ;OR...
JRST SYMDO4 ;YES
CAIN CH,")" ;OR...
JRST SYMDO4 ;YES
CAIE CH,175 ;OR
JRST SYMERR ;NONE OF THESE..OH DEAR
SYMDO4: POP P,CH ;CLEAN THE STACK
SETZB CH,CH.SAV
MOVE T1,SYMPNT ;PUT THE POINTER ON THE STACK AND IT
;WILL BE PUSHED BY PARAM(PAR5)
;THIS IS WHERE WE LEAVE "GETTAB" IF IT HAS BEEN CALLED FROM THE MASTER PROCESS
JRST CPOPJ1 ;UP UP AND AWAY
SLVCLS: MOVE BP,SYMPNT ;SET UP THE POINTER TO RESULT
POP P,CH ;CLEAN THE STACK
PUSHJ P,CHARIN ;GET THE NXT CH MAY BE . OR +
MOVEM CH,CH.SAV ;OR ARITH OP.
JRST CPOPJ1
PRNTAB: JRST SYMERR ;TABLE OF O/P ENTRIES
PUSHJ P,BINPRT ;BINARY PRINTING
PUSHJ P,ASCPRT ;ASCII PRINTING
PUSHJ P,SSIXBP ;SIXBIT PRINTING
PUSHJ P,DECPRT ;DECIMAL PRINTING
PUSHJ P,PRTOCT ;OCTAL PRINTING
PUSHJ P,PRTPPN ;PPN PRINTING
PUSHJ P,TIMPRT ;TIME PRINTING
PUSHJ P,TMPRTS ;TIME PRINTING ARG. IN SECONDS
PUSHJ P,OCTPRT ;OCTAL PRINTING - SUPPRESS LEADING ZEROES
PUSHJ P,PRDATE ;DATE PRINTING
VALMODE==.-PRNTAB-1
SYMPNT: POINT 7,SYMBUF
SYMERR: MOVEI T1,[ASCIZ/?SYMERR ERROR IN FUNCTION CALL/]
PJRST CLNSTK
SYMER2: MOVEI T1,[ASCIZ/?SYMER2 ERROR RETURN TAKEN BY GETTAB CALL/]
PJRST CLNSTK
SYMER3: MOVEI T1,[ASCIZ/?SYMER3 UNKNOWN FUNCTION/]
PJRST CLNSTK
SYMER4: MOVEI T1,[ASCIZ/?SYMER4 ILLEGAL ARGUMENT FORMAT TO FUNCTION CALL/]
PJRST CLNSTK
;A ROUTINE TO CLEAN UP A MESSY STACK
;POP'S AND THROWS AWAY EVERYTHING ON TOP OF THE STACK
;UP TO AND INCLUDING AN "$" OR "<"
;NORMALLY ONLY CALLED AFTER AN ERROR
CLNSTK: POP P,T2 ;GET SOMAT
CAIN T2,"<" ;IS IT THIS MARKER
JRST STKCLN ;YES
CAIE T2,"$" ;OR THIS
JRST CLNSTK ;NO TRY AGAIN
STKCLN: SETZM GTLOCK ;CLEAR THE LOCK
JRST CPOPJ ;WE HAVE A CLEAN STACK(I THINK)
;TABLES OF PRINT OUT MODES
DEFINE MODES,<
.M. BIN,1 ;;BINARY
.M. ASC,2 ;;ASCII
.M. SIX,3 ;;SIXBIT
.M. DEC,4 ;;DECIMAL
.M. OCT,5 ;;OCTAL
.M. PPN,6 ;;PPN
.M. MSE,7 ;;MSEC TIME
.M. SEC,10 ;;SECONDS
.M. OC2,11 ;;OCTAL - NO LEADING ZEROES
.M. DAT,12 ;;DATE
>
DEFINE .M.(A,B)<
XWD ''A'',B
>
MODTAB: MODES
; THIS ROUTINE READS IN PARAMETERS TERMINATED BY , OR )
SYMPRM: MOVN N,GTLOCK ;MASTER OR SLAVE?
XCT GETRIT(N) ;DO APPROPRIATE THING
SKIPN GTLOCK ;SLAVE MODE?
PUSHJ P,PLSMNS ;YES-CHECK UP ON +,-
;NB!!!! AT MOMENT ARITH. EXPR. ARE NOT!! ALLOWED
; IN GETTAB ARGUMENTS
SYMPR2: CAIE CH,"," ;END OF A PARAMETER OK
CAIN CH,")" ;END OF PARAMETER LIST OK
JRST CPOPJ1
CAIE CH,"%" ;OCTAL?
POPJ P,0 ;NO
JUMPN N1,CPOPJ ;CAN'T HAVE IN MIDDLE
PUSHJ P,RDOCTL
JRST SYMPR2
GETRIT: PUSHJ P,ATOM ;SLAVE PROCESS
PUSHJ P,INTIN ;MASTER
;THIS ROUTINE DEALS WITH AN ASCII WORD IN TABLE
ASCPRT: MOVEM T1,SYMBUF ;NO CONVERSION NEC.
SETZM SYMBUF+1 ;MAKE SURE A 0 BYTE FOLLOWS
POPJ P,0
;THIS ROUTINE HANDLES SIXBIT TABLE ENTRIES
SSIXBP: MOVE WD,T1
PUSHJ P,SIXBP ;DO THE SIX BIT ROUTINE
TLNN BP,770000
POPJ P,0
PUSHJ P,SIXBP2
JRST .-3
;HERE TO HANDLE PPN STYLE TABLE ENTRIES
PRTPPN: MOVE WD,T1 ;GET PPN IN RITE AC
PJRST PPNOUT ;USE THE STANDARD BIT
PLSMNS: CAIE CH,"+" ;PLUS?
CAIN CH,"-" ;OR MINUS
SKIPA ;YES
POPJ P,0 ;NO
JUMPN N1,CPOPJ ;NOT IN MIDDLE
PUSH P,CH ;SAVE IT
PUSHJ P,ATOM ;DO IT AGAIN
EXCH CH,(P)
CAIN CH,"-"
MOVNS N ;NEGATE
POP P,CH
POPJ P,0
;PRINT OCTAL STYLE WITH LEADING ZEROES SIGNIF.
PRTOCT: MOVE BP,[POINT 3,T1]
MOVEI N,^D12 ;COUNT
PRTOC2: ILDB CH,BP ;GET A CHAR.
ADDI CH,"0" ;MAKE IT ASCII
PUSHJ P,OUCH ;O/P THE CHAR.
SOJG N,PRTOC2
POPJ P,0
;THIS ROUTINE SAVE THE CURRENT LOW LEVEL I/P ROUTINE
;AND REPLACES IT BY THE CONTENTS OF CH
SVLOWN: EXCH CH,LOWIN
EXCH CH,(P)
PUSHJ P,(CH)
JRST .+2
AOS -1(P)
POP P,LOWIN
POPJ P,0
SUBTTL STATUS - PRODUCE DISPLAY OF CURRENT MIC STATUS
;A ROUTINE TO PRINT OUT MIC STATUS
MICTAT: RESCAN
SETZB F,CH.SAV
MOVE P,[IOWD SIZ,STACK] ;SET UP THE STACK
PUSHJ P,WDREAD ;READ THE REENTER
.STATUS:
MOVEM CH,CH.SAV ;SAVE THE TERMINATOR
MOVE T1,[OUTCHR CH]
MOVEM T1,LOWOUT ;MAKE SURE OUTPUT GOES WHERE EXPECTED
MOVEI BP,[ASCIZ/
Status of MIC at /]
IFN FTCJOB,<
PUSHJ P,STROUT
>
IFE FTCJOB,<
OUTSTR (BP)
>
MSTIME N,
PUSHJ P,TIMPRT ;PRINT THE TIME
PUSHJ P,PRVCHK
JRST STATS2 ;HES NOT GOD LIKE
TLO F,FLS.GD ;REMEMBER
IFN FTCJOB,<
MOVEI BP,[ASCIZ/
COJOBS available = /]
PUSHJ P,STROUT
MOVN N,COJOBN
PUSHJ P,DECPRT ;NO. OF COJOBS
MOVEI BP,[ASCIZ/ in use = /]
PUSHJ P,STROUT
MOVE N,CJUP
IFN FTMBCH,<
SUB N,BCHUP
>
PUSHJ P,DECPRT
MOVEI BP,[ASCIZ/
Runtime for COJOBS:
Default = /]
PUSHJ P,STROUT
HRRE N,DEFTIM
JUMPL N,[MOVEI BP,[ASCIZ/ +INF. /]
PUSHJ P,STROUT
JRST .+2]
PUSHJ P,TMPRTS
MOVEI BP,[ASCIZ/ sec(s). Maximum = /]
PUSHJ P,STROUT
HLRE N,LIMTIM ;GET MAX LIMIT
JUMPL N,[MOVEI BP,[ASCIZ/ +INF.
/]
PUSHJ P,STROUT
JRST .+4 ]
PUSHJ P,TMPRTS ;PRINT IT
MOVEI BP,[ASCIZ/ sec(s).
/]
PUSHJ P,STROUT
IFN FTMBCH,<
MOVEI BP,[ASCIZ/BATCH jobs available = /]
PUSHJ P,STROUT
MOVN N,BCJOBN ;HOW MANY
PUSHJ P,DECPRT
MOVEI BP,[ASCIZ/ in use = /]
PUSHJ P,STROUT
MOVE N,BCHUP
PUSHJ P,DECPRT
>
>
STATS2: OUTSTR [ASCIZ/
PROCESSES-/]
MOVE N,PROCNO
PUSHJ P,DECPRT
PUSHJ P,TAB
OUTSTR [ASCIZ/WAITING--/]
MOVE N,COMCNT
PUSHJ P,DECPRT
PUSHJ P,TAB
OUTSTR [ASCIZ/LOCK /]
MOVE N,LOCK
PUSHJ P,DECPRT
OUTSTR [ASCIZ/ MASTER /]
MOVE N,MASTNO
PUSHJ P,DECPRT
OUTSTR [ASCIZ/ CMDTOT /]
MOVE N,CMDTOT
PUSHJ P,DECPRT
IFN FTCJOB,<
OUTCHR ["("]
MOVE N,CJBTOT ;HOW MANY COJOBS HAVE WE RUN
PUSHJ P,DECPRT
IFN FTMBCH,< ;MIC BATCH CONDITIONAL
OUTCHR ["-"]
MOVE N,BRQTOT ;HOW MANY BATCH REQUESTS
PUSHJ P,DECPRT
OUTCHR ["-"]
MOVE N,BATTOT ;HOW MANY BATCH JOBS RUN
PUSHJ P,DECPRT
> ;END OF MIC BATCH CONDITIONAL
OUTCHR [")"]
> ;END OF COJOB CONDITIONAL
OUTSTR [ASCIZ/
NO. MODE PPN LINE MACRO ARGS
/]
HRLZ T1,PROCNO
TDZA X,X ;START AT FIRST PROC. BUT DO NOT BUMP X
STAT1: ADDI X,PDBSIZ
HRRZI N,1(T1)
PUSHJ P,DECPRT ;PROCESS NUMBER
PUSHJ P,TAB
SKIPA
STATX: SETZ T1, ;CLEAR THE LOOP COUNTER FOR 'WHAT' ENTRIES
MOVE T2,FLAG(X)
XCT MODE(T2) ;PROCESS MODE
JUMPE T2,STAT2 ;IF IT IS FREE DISPLAY NO FURTHER INFO
MOVE WD,OPPN(X)
PUSHJ P,PPNOUT ;WHO
OUTSTR [ASCIZ/ /]
MOVE N,LINE(X)
PUSHJ P,OCTPRT
PUSHJ P,TAB
MOVE WD,FILE(X)
PUSHJ P,SIXBP ;MACRO NAME
PUSHJ P,SPACE
GETPPN N, ;GET HIS PPN
JFCL
CAME N,[1,,2] ;BIG G?
CAMN N,OPPN(X) ;OR OWNER
SKIPA ;YEP
JRST STATX2 ;NEITHER
PUSHJ P,ARGPRT ;& ALL HIS ARGS
PUSHJ P,LNEPRT ;AND HIS CURRENT I/P LINE BUFFER
STATX2:
IFN FTCJOB,< ;IF WE USE COJOBS
SKIPE T2,COJOB(X)
PUSHJ P,STAT3 ;REPORT COJOB STATUS
> ;END OF COJOB BIT
STAT2:
IFE FTRLSE,<
OUTSTR [BYTE (7) 37,15,12]
>
IFN FTRLSE,< ;DON'T INCLUDE FLASHY BEEHIVE STUFF ON RELEASE VERSION
OUTSTR [BYTE (7) 15,12]
>
AOBJN T1,STAT1
IFN FTMBCH,<
TLNE F,FLS.BR
JRST COMBAT
>
JRST DOTTY
IFE FTRLSE,< ;INCLUDE HATFIELD STUFF
OUTSTR [ASCIZ/ ACTIVE /]
MODE: OUTSTR [ASCIZ/ FREE /]
OUTSTR [ASCIZ/ HELD /]
OUTSTR [ASCIZ/ SLAVE /]
>
IFN FTRLSE,< ;FOR OTHER PEOPLE
OUTSTR [ASCIZ/ ACTIVE /]
MODE: OUTSTR [ASCIZ/ FREE /]
OUTSTR [ASCIZ/ HELD /]
OUTSTR [ASCIZ/ SLAVE /]
>
IFN FTCJOB,<
OUTSTR [ASCIZ/LOGOUT/]
OUTSTR [ASCIZ/ACTIVE/]
OUTSTR [ASCIZ/LOGIN /]
OUTSTR [ASCIZ/REQUEST/]
CJMESS: JFCL
STAT3: OUTSTR [ASCIZ/
/]
IFE FTMBCH,<
OUTSTR [ASCIZ/*COJOB /]
>
IFN FTMBCH,<
SKIPE BATWRD(X)
SKIPA CH,[[ASCIZ/*BATCH JOB /]]
MOVEI CH,[ASCIZ/*COJOB /]
OUTSTR (CH)
> ;END OF BATCH BIT
HLRZ CH,CJOWNR(X)
ADDI CH,"A"-1
OUTCHR CH
MOVEI CH," "
OUTCHR CH
XCT CJMESS(T2)
OUTSTR [ASCIZ/ OWNER /]
HRRZ N,CJOWNR(X)
PUSHJ P,OCTPRT
CAIN T2,-2 ;IF IN LOGIN MODE
POPJ P,0 ;DON'T TYPE RUNTIME (MIGHT GET IT WRONG)
MOVS T2,JOB(X)
OUTSTR [ASCIZ/ RUNTIME /]
HRRI T2,.GTTIM
GETTAB T2,
JFCL
SKIPE N,T2
IDIV N,JIFFY
PUSHJ P,TMPRTS
OUTSTR [ASCIZ/ SEC(S)./]
POPJ P,0
> ;END OF COJOBS BIT
;A ROUTINE TO PRINT ALL THE ARGS IN PROCESS AREA
ARGPRT: MOVSI N,-ARGNUM
HRRI N,ARGBP(X) ;THIS IS WHERE THE POINTERS ARE
ARGPR1: MOVE BP,(N) ;GRAB A BYTE .ER
JUMPE BP,ARGPR4
HRRZ CH,N
SUBI CH,ARGBP-"A"(X) ;MAKE PARAMETER NAME
PUSHJ P,OUCH
MOVEI CH,"="
PUSHJ P,OUCH ;<PARAMETER>=
ARGPR2: ILDB CH,BP ;A CHAR
JUMPE CH,ARGPR3
PUSHJ P,OUCH
JRST ARGPR2
ARGPR3: MOVEI CH,","
PUSHJ P,OUCH
ARGPR4: AOBJN N,ARGPR1
PJRST TAB
;HERE TO PRINT THE CONTENTS OF A GUY'S I/P LINE BUFFER
LNEPRT: SKIPN INLINE(X) ;ANYFING?
POPJ P,0 ;NO
LNEPR0: MOVEI BP,[ASCIZ/
[/]
PUSHJ P,STROUT
MOVE N,[POINT 7,INLINE(X)]
LNEPR2: ILDB CH,N
JUMPE CH,LNEPR1 ;FINISH ON A NULL
PUSHJ P,ISBRK ;BREAK CHARACTER
JRST LNEPR1
PUSHJ P,OUCH
JRST LNEPR2
LNEPR1: CAIN CH,ALT ;ALTMODE
SKIPA BP,[[ASCIZ/$ ]/]]
MOVEI BP,[ASCIZ/ ]/]
PUSHJ P,STROUT
POPJ P,0
SUBTTL WHAT COMMAND
;HERE ON WHAT COMMAND FROM MIC (NOT COJOB CONTROL)
;INCLUDED FOR ORTHOGONALITY
.WH:
.WHAT: PUSHJ P,OTHUSR ;GET IN CONTEXT
JRST LETER3 ;SO IT GOES
MOVE X,T2 ;AND IN RIGHT PLACE
JRST STATX ;DO IT
SUBTTL OTHER PRINT ROUTINES
SIXBT: PUSHJ P,SIXBP
JRST TAB
SIXBP: MOVE BP,[XWD 440600,WD]
SIXBP1: ILDB CH,BP
JUMPE CH,[POPJ P,0]
SIXBP2: ADDI CH,40
PUSHJ P,OUCH
TLNE BP,770000
JRST SIXBP1
POPJ P,0
OCTPRT: IDIVI N,10
HRLM N1,(P)
SKIPE N
PUSHJ P,OCTPRT
HLRZ CH,(P)
ADDI CH,"0"
XCT LOWOUT
POPJ P,0
DECPR2: CAIL N,^D10
JRST RDXPRT
MOVEI CH,"0"
PUSHJ P,OUCH
JRST RDXPRT
DECPRT: MOVEI CH,"-"
SKIPGE N
PUSHJ P,OUCH
MOVMS N
RDXPRT: IDIVI N,^D10
HRLM N1,0(P)
SKIPE N
PUSHJ P,RDXPRT
HLRZ CH,0(P)
ADDI CH,"0"
OUCH: XCT LOWOUT ;USUALLY OUTCHR CH
POPJ P,0
;SUBROUTINE TO PRINT THE DATE
;CALL WITH
; PUSHJ P,PRDATE
; RETURN
PRDATE: PUSH P,P1 ;SAVE
PUSH P,P2 ;SAVE
DATE P1, ;GET THE DATE
IDIVI P1,^D31 ;GET THE DAY
MOVEI N,1(P2) ;ADD AND MOVE
PUSHJ P,TWODIG ;PRINT THE DAY
IDIVI P1,^D12 ;GET THE MONTH
MOVE WD,[POINT 7,MNTAB(P2)] ;LOAD A BYTE POINTER
MOVEI T3,5 ;CHAR. COUNT
ILDB CH,WD ;LOAD A CHAR.
PUSHJ P,OUCH ;OUTPUT IT
SOJG T3,.-2 ;LOOP OVER WORD
MOVEI N,^D64(P1) ;ADD YEAR ZERO
POP P,P2 ;UNSAVE
POP P,P1 ;UNSAVE
PJRST DECPRT ;AND PRINT
MNTAB: ASCII /-JAN-/
ASCII /-FEB-/
ASCII /-MAR-/
ASCII /-APR-/ ;OR SHOULD IT BE CPU <SIC>
ASCII /-MAY-/
ASCII /-JUN-/
ASCII /-JUL-/
ASCII /-AUG-/
ASCII /-SEP-/
ASCII /-OCT-/
ASCII /-NOV-/
ASCII /-DEC-/
;HERE TO PRINT A TWO DIGIT NUMBER WITH A LEADING ZERO (IF NECC.)
TWODIG: CAIL N,^D10 ;DOES IT NEAD A ZERO?
PJRST DECPRT ;NO
MOVEI CH,"0" ;YES
PUSHJ P,OUCH ;LET HIM HAVE ONE
PJRST DECPRT
COLON: MOVEI CH,":"
JRST OUCH
TAB: MOVEI CH,11
PJRST OUCH
SPACE: MOVEI CH," "
PJRST OUCH
PPNOUT: MOVEI CH,"["
PUSHJ P,OUCH
HLRZ N,WD
PUSHJ P,OCTPRT
MOVEI CH,","
PUSHJ P,OUCH
HRRZ N,WD
PUSHJ P,OCTPRT
MOVEI CH,"]"
PJRST OUCH
BINPRT: MOVSI N1,400000
BINPR1: TDNE N,N1
SKIPA CH,["1"]
MOVEI CH,"0"
PUSHJ P,OUCH
LSH N1,-1
JUMPN N1,BINPR1
POPJ P,0
;END OF JS BIT
SUBTTL COJOB SERVICING AND INITIALIZATION
;HERE HAVING DECIDED A PROCESS IS ACTIVE
SCHED5: AOS ACTIVE ;MUST NOT GO TO SLEEP ON THE JOB
CAIN T1,2 ;LEAVE HIM HE IS STILL TYPING
JRST SCHED4
IFE FTCJOB,< JRST GO
XLIST
> ;IF NO COJOBS
IFN FTCJOB,<
;HERE WHEN COJOB SERVICING IS REQUIRED
MOVE Z,COJOB(X)
;C(Z) 0 NOT A COJOB
; -1 COJOB PROCESS AREA REQUIRED
; COJOB AREA OFFSET,,-2 COJOB LOGIN IN PROGRESS
; COJOB AREA OFFSET,,-3 COJOB REQUIRES LISTENING
; COJOB AREA OFFSET,,-4 COJOB REQUIRES KJOB TEXT ONLY
JRST @COTAB(Z)
CCJ0 ;JUST LOG ALL UNTIL HE FINISHES
BCJ0 ;LOG ALL INPUT
ACJ0 ;FIX UP TO RUN MIC
CJ0 ;FIX UP Z & LOGIN
COTAB: GO ;NOT A COJOB
KJOB==-4 ;OFFSET FOR CCJ0 OPERATION
;HERE ON FINDING A NEW COJOB REQUEST
;ATTEMPT TO ASSIGN A COJOB PROCESS AREA AND PTY
CJ0:
IFN FTMBCH,<
SKIPN T1,BATWRD(X)
JRST CJ0A
TRO F,FR.BAT
SETZ T1,
SETUWP T1,
HALT
MOVEI S,[ASCIZ/[NO BATCH JOBS AVAILABLE]/]
AOS T2,BCHUP ;TRY FOR ONE MORE BATCH JOB
ADD T2,BCJOBN
JUMPG T2,CJOOPS ;ANY FREE
SETUWP T1,
HALT
>;END OF BATCH BIT
CJ0A: SETZ Z, ;START AT TOP
MOVE T1,COJOBN ;SCAN THIS MANY PROCESSES
IFN FTMBCH,<
TRNE F,FR.BAT
ADD T1,BCJOBN ;AS WELLAS THESE IF BATCH
>
HRLZS T1 ;MAKE ONE OF THESE AOBJN THINGS
CJ1: SKIPN CJFLAG(Z) ;THIS COJOB IN USE?
JRST CJ2 ;NO - USE IT
ADDI Z,CJSIZ
AOBJN T1,CJ1 ;SCAN FOR FREE COJOB
;HERE IF RAN OUT OF COJOB AREAS
MOVEI S,[ASCIZ/[NO COJOB AVAILABLE]/]
CJOOPS:IFN FTMBCH,<
MOVNI T1,2 ;ERROR CODE
>
IFN FTMBCH,<
TRNE F,FR.BAT
SKIPA L,BATOPR
>;BATCH BIT
MOVE L,LINE(X)
MIC DISPLAY,L ;COMPLAIN TO OWNER
JFCL
SETZ T2,
SETUWP T2,
HALT
SETZM COJOB(X) ;DO FOR COJOB LINKS
IFN FTMBCH,<
TRNN F,FR.BAT ;IS WE BATCH
JRST FIN1A
MOVEM T1,BATACT ;YES-THEN SAY WE FAILED
LDB T1,BATMST ;GET CONTROLLER JOB NO.
WAKE T1, ;WAKE IT UP
SETZM BATWRD(X) ;DO FOR BATCH WORD
SOS BCHUP ;ONE LESS BATCH JOB
>
JRST FIN1A ;AND GO TIDY UP
;HERE TO INITIALIZE A PTY FOR COJOB AREA WE HAVE SELECTED
CJ2: SETZ T2,
SETUWP T2,
HALT
AOS CJUP ;BUMP COUNT OF COJOBS IN USE
SETUWP T2,
HALT
AOS CJFLAG(Z) ;CLAIM THIS PROCESS AREA
HRRZM T1,PTY.IC(Z)
AOS PTY.IC(Z)
SETZ T1, ;ASCII MODE
MOVSI T2,'PTY' ;LET MONITOR FIND US A PTY
MOVSI T3,PTY.OH(Z)
HRRI T3,PTY.IH(Z) ;BUFFERS ARE IN SELECTED COJOB AREA
MOVEI S,[ASCIZ/[COJOB FAILED NO PTY]/]
HRLZ T4,PTY.IC(Z)
LSH T4,5 ;FIX UP OPEN UUO
ADD T4,[OPEN T1]
XCT T4
IFN FTMBCH,<
JRST [SETO T1, ;ERROR CODE
JRST CJOOPS]
>
IFE FTMBCH,<
JRST CJOOPS
>
;SET UP VIRGIN BUFFERS FOR OUR PTY
MOVSI T1,400000 ;UNTOUCHED BUFFER
HRRI T1,PTY.OB+1(Z)
MOVEM T1,PTY.OH(Z) ;FOR OUTPUT...
HRRI T1,PTY.IB+1(Z)
MOVEM T1,PTY.IH(Z) ;....AND FOR INPUT
MOVSI T1,700 ;UNTOUCHED ASCII BYTE POINTER
MOVEM T1,PTY.OH+1(Z) ;FOR OUTPUT...
MOVEM T1,PTY.IH+1(Z) ;...AND FOR INPUT
MOVSI T1,20+1 ;A BUFFER OF 20 DATA WORDS
HRRI T1,PTY.OB+1(Z)
MOVEM T1,PTY.OB+1(Z)
HRRI T1,PTY.IB+1(Z)
MOVEM T1,PTY.IB+1(Z)
;PUT ALL LOGGING INTO LOW SEG
MOVEI T1,LOGDEV(Z)
HRLI T1,LGSPEC(X)
BLT T1,ELOWSWT(Z)
;HERE TO ISSUE LOGIN COMMAND ON APPROPRIATE COJOB
PUSHJ P,PTYIN ;CLEAR UP ANYTHING THAT IS LYING AROUND
JFCL
PUSHJ P,BUFCLR ;AND JUNK IT
PUSHJ P,TIMSTP ;AND TIMESTAMP FIRST LINE
HRRI S,[ASCIZ/LOGIN /]
PUSHJ P,PTYTYP
HLRZ N,OPPN(X)
PUSHJ P,OCTPRT ;DISH OUT PROJECT
MOVEI CH,","
PUSHJ P,PTYO
HRRZ N,OPPN(X) ;PROGRAMMER
PUSHJ P,OCTPRT
MOVEI S,[ASCIZ@/SPOOL:ALL@]
PUSHJ P,PTYTYP
SETZ T4,
SETUWP T4,
HALT
SETZM LGSPEC(X) ;CLEAN UP PDB AREA
MOVSI T1,LGSPEC(X) ;[551]
HRRI T1,LGSPEC+1(X) ;[551]
BLT T1,ENDSWT(X)
IFE FTLG56,< ;PRE LOGIN 56 FRIGG
HRRZ T2,STATIN(X) ;GET HIS STATION
CAIE T2,2 ;CENTRAL?
JRST CJ01 ;YES
HRRZI S,[ASCIZ/LOCATE 2
/]
MOVEM S,TYPWRD(X)
CJ01:>
IFN FTLG56,< ;LOGIN 56 HANDLES ALL REMOTE STATIONS
HRRZ T2,STATIN(X) ;GET HIS STATION NO.
CAIGE T2,2 ;IS WE REMOTE
JRST CJ01 ;NO
HRRZI S,[ASCIZ?/LOCATE:?]
PUSHJ P,PTYTYP ;TYPE A LOCATE SWITCH
HRRZ N,STATIN(X) ;GET THE STATION NO.
PUSHJ P,OCTPRT ;[555]PRINT IT
CJ01:> ;END OF LOGIN 56 REMOTE STATION FIX
HRLM Z,COJOB(X)
IFN FTMBCH,< ;BATCH BIT
IFE FTRLSE,< ;IF HATFIELD CODE
TRNN F,FR.BAT ;AND IF ITS A BATCH JOB
SKIPA S,[[ASCIZ@/NOBATCH@]]
HRRZI S,[ASCIZ@/BATCH@] ;WE FORCE A /BATCH SWITCH TO LOGIN
;SO THAT BATCH JOBS GET EXTRA QUOTA
;/NOBATCH ENSURES COJOBS DO NOT
PUSHJ P,PTYTYP ;TYPE THE SWITCH
> ;END OF HATFIELD BIT
TRNN F,FR.BAT
JRST CJ02
HRRZ CH,BATOPR
HRRM CH,LINE(X)
HRL CH,PTY.IC(Z) ;GET CBATCH JOB NAME
HLLZM CH,BATACT
HRRI T1,PDB(X) ;COMBAT LIKES TO KNOW PDB'S
HRRM T1,BATACT
MOVSI T1,BTL.RN ;BATCH RUN BIT
ORM T1,BATWRD(X)
MOVSI T1,BTL.RQ ;SAY REQUEST MET
ANDCAM T1,BATWRD(X) ;(COMBAT MAY WANT TO KNOW)
LDB T1,BATMST ;GET CONTROLLER JOB NO.
WAKE T1, ;WAKE IT UP
MOVEM F,FSAV(X) ;SAVE THE FLAG WORD
> ;END OF BATCH BIT
CJ02: HRR CH,LINE(X)
HRL CH,PTY.IC(Z)
MOVEM CH,CJOWNR(X) ;RECORD OWNER STUFF
SOS COJOB(X) ;PRIME TO NEXT COJOB ACTION
SETUWP T4,
HALT
PUSHJ P,CJDSP
MOVEI S,[ASCIZ/ STARTED]
/]
MIC DISPLAY,L
JFCL
;HERE TO NOTE DISCRIPTIVE INFORMATION IN COJOB LOG FILE
PUSH P,LOWOUT ;SAVE LOW SEGMENT OUTPUT CALL
MOVE T1,XCTLOG
MOVEM T1,LOWOUT ;REPLACE WITH CALL TO LOG FILE
MOVEI BP,[ASCIZ?
?]
PUSHJ P,STROUT
IFN FTMBCH,<
TRNE F,FR.BAT ;IS THIS A BATCH JOB
SKIPA BP,[[ASCIZ/[* MIC BATCH JOB * OPERATOR LINE /]]
>; END OF BATCH COND.
MOVEI BP,[ASCIZ/[* MIC COJOB * LINE /]
PUSHJ P,STROUT
HRRZ N,CJOWNR(X)
PUSHJ P,OCTPRT
MOVEI BP,[ASCIZ?* /?]
PUSHJ P,STROUT
MOVE WD,FILE(X)
PUSHJ P,SIXBP
PUSHJ P,SPACE
PUSHJ P,ARGPRT
MOVEI BP,[ASCIZ?]
?]
PUSHJ P,STROUT
MOVEI BP,[ASCIZ?[ * TIME LIMIT = ?]
PUSHJ P,STROUT ;O/P TIME LIMIT
HRRZ N,TIME(Z) ;GET TIME LIMIT
SKIPN N ;HAS HE SAID A TIME
HRRZ N,DEFTIM ;N-O-- USE DEFAULT
PUSHJ P,TMPRTS ;PRINT IT (IN SECONDS)
MOVEI BP,[ASCIZ/ SECOND(S). *]
/]
PUSHJ P,STROUT
POP P,LOWOUT
MOVEI CH,CR
PUSHJ P,PTYO
JRST SCHED1 ;GO BACK AND SCHEDULE FROM THE START
;HERE HAVING ISSUED THE LOGIN COMMAND A COJOB MUST BE SERVICED
ACJ0: MOVS Z,Z
PUSHJ P,STATES ;GET LINE STATES
JFCL
TLNE S,LDL.TO ;OUTPUT AVAILABLE?
PUSHJ P,PTYIN ;GO GET IT
TLNN S,LDL.TI ;INPUT REQUIRED?
JRST SCHED4 ;NO OR IT IS STILL BABBLING
;IF INPUT IS REQUIRED AT THIS STAGE WE ASSUME COJOB IS LOGGED IN
HRRZ L,S ;JUST THE JOB
JUMPE L,NJA ;NULL JOB IS AS GOOD AS NO JOB
TRMNO. L, ;GET THE GUYS LINE NUMBER
JRST NJA ;HE WENT AWAY
TRZ L,.UXTRM ;WHAT IS UNIVERSAL TERMINAL THINGY?
SETZ T1,
SETUWP T1,
HALT
HRRZM S,JOB(X) ;REMEMBER NEW JOB NUMBER
SKIPN T3,TIME(Z) ;DID HE SUPPLY A RUNTIME
HRRZ T3,DEFTIM ;NO USE DEFAULT
HRRM T3,TIME(Z) ;AND STORE IT
HRLI T3,.STTLM ;SET TIME LIMIT FUNCT.
HRRZ T2,S ;JOB NO.
MOVE T1,[2,,T2] ;JBSET ARG
JBSET. T1,
JFCL
SOS COJOB(X) ;JUST LOG PTY BABBLING FROM NOW ON
MOVEM L,LINE(X) ;PRETEND HE INITIATED THAT COMMAND MACRO
SETUWP T1,
HALT
MOVE S,MASTNO ;THIS IS US
ADDI S,<"?">_7 ;WATCHING FOR ERROS
MIC SET,L ;HE IS UP AND GOING
JFCL ;I THINK
JRST SCHED1 ;AND SCHEDULE ANOTHER REQUEST
;HERE TO SERVICE A COJOB THAT IS RUNNING MIC
BCJ0: MOVS Z,Z ;GET ADDR COJOB AREA RIGHT
MOVE P2,PTY.IC(Z) ;ON THIS CHANNEL
PUSHJ P,STATES ;GET LINE STATES
TLO F,FL.CCM!FL.KJO ;HE PUSHED OFF
TLNE S,LDL.TO ;ELSE...IF HE HAS OUTPUT
PUSHJ P,PTYIN ;THEN LOG IT
CAIA
JRST SCHED4 ;ELSE SERVICE THEN OTHER MIC PROCESSES
MOVE T1,FLAG(X)
JRST GO ;AND IF THAT WAS ALL PROCESS AS NORMAL
;HERE TO SERVICE A COJOB THAT IS LOGGING OUT
CCJ0: MOVS Z,Z
PUSHJ P,STATES ;GET HIS LINE STAES
TLO F,FL.CCM!FL.KJO ;FLAG HE PUSHED OFF ON OWN ACCORD
CCJ1: TLNN S,LDL.TO!LDL.TI;READY FOR I/O?
JRST CCJ7 ;NO
TLNN S,LDL.TO ;GOT SUMMAT TO SAY?
JRST CCJ2 ;NO-HE MAY HAVE FINISHED
PUSHJ P,PTYIN ;READ INPUT
JRST CCJ1 ;THAT WAS THE LAST JUST CHECK AGAIN
JRST SCHED4
CCJ2: TLON F,FL.CCM ;REQUIRES ^C FOR MON MODE
JRST CCJ3 ;YES
;NO
CCJ5: TLON F,FL.KJO ;REQUIRES KJOB COMMAND
JRST CCJ4 ;YES
HRLZ T4,PTY.IC(Z)
LSH T4,5
ADD T4,[RELEAS] ;SAY BYE BYE TO THE TTY
XCT T4
;HERE IS THE GOOD GUYS WAY OUT OF COJOB PROCESSING
PUSHJ P,OWNCHK ;IS THE OWNER THERE
JRST CJZAP0 ;NO
PUSHJ P,CJDSP ;SAY BYE BYE
MOVEI S,[ASCIZ/ COMPLETE]
/]
MIC DISPLAY,L
JFCL
CJZAP0: MOVE L,LINE(X)
CJZAP: SETZ T2,
SETUWP T2,
HALT
CJZAP1: SETZM COJOB(X) ;NO LONGER A COJOB
SOS CJUP ;ONE LESS COJOB
IFN FTMBCH,<
SKIPN BATWRD(X) ;IS WE A BATCH JOB
JRST CJZAP2 ;NO
SOS BCHUP ;SAY ONE LESS
PUSHJ P,WAKBCH ;AND WAKE UP COMBAT
SETZM BATWRD(X) ;AND FORGET
CJZAP2: >
SETUWP T2,
HALT
SETZM CJFLAG(Z)
JRST FIN1
CCJ7: TLNE F,FL.KJO ;IS HE KJOBBED
JRST SCHED4 ;YES
JRST CCJ6 ;NO
;HERE TO PUT JOB INTO MONITOR MODE IF REQUIRED
CCJ3: TLNE S,LDL.MM ;IN MONITOR MODE ALREADY?
JRST CCJ5 ;YES-CHECK IF KJOB REQUIRED
CCJ6: PUSHJ P,FRCMON
JRST SCHED4
;SUBROUTINE TO WAKE COMBAT IF IT IS RUNNING
IFN FTMBCH,<
WAKBCH: LDB T1,BATMST ;GET COMBATS JOB NUMBER
HRLZ T4,T1 ;PREPARE FOR GETTAB
HRRI T4,.GTPRG
GETTAB T4, ;TO FIND OUT WHAT IA RUNNING AS JOB (T1)
SETZ T4, ;DEFENSIVE
CAMN T4,[SIXBIT/COMBAT/] ;IS IT COMBAT
WAKE T1, ;YES-WAKE HIM UP
POPJ P,0
POPJ P,0
>
;HERE TO TYPE KJOB
CCJ4: HRRI S,[ASCIZ?KJOB ?]
PUSHJ P,TYPER
MOVE WD,LOGDEV(Z)
PUSHJ P,SIXBP ;LOG FILE
MOVEI CH,":"
PUSHJ P,OUCH
MOVE WD,LOGFIL(Z)
PUSHJ P,SIXBP
MOVEI CH,"."
PUSHJ P,OUCH
MOVE WD,LOGEXT(Z)
PUSHJ P,SIXBP
MOVE WD,LOGPPN(Z)
PUSHJ P,PPNOUT
HRRI S,[ASCIZ?=/Z:?] ;DEGREE OF Q ING DESIRED
PUSHJ P,TYPER
SKIPN CH,ZQ(Z)
HLRZ CH,DEFDSP ;GET DESPATCH SETTING
PUSHJ P,OUCH
HRRI S,[ASCIZ?/B/VD:?]
PUSHJ P,TYPER
HRRZ CH,VDISP(Z) ;DISPOSITION OF LOG FILE
SKIPN CH ;IF HE DID NOT SAY THEN
HRRZ CH,DEFDSP ;GET DEFAULT DISPOSAL SETTING
PUSHJ P,OUCH
IFN FTMBCH,< ;BATCH ONLY
HLRZ CH,VDISP(Z) ;WAS A SEQUENCE NO. SPECIFIED
JUMPE CH,CCJ4A ;NO
HRRI S,[ASCIZ?/VS:?] ;YES - SO USE IT
PUSHJ P,TYPER
HLRZ N,VDISP(Z)
PUSHJ P,DECPRT
CCJ4A:>
MOVEI CH,CR
PUSHJ P,LOGO
MOVEI CH,LF+200 ;FLAG NO TIMESTAMP
PUSHJ P,LOGO
PUSHJ P,LOG ;LOG A CRLF AND TIDY UP
JFCL
HRRI S,[ASCIZ/
/]
PUSHJ P,TYPER ;AND TYPE ONE NOW
CAMN F,FSAV(X) ;HAS F CHANGED
JRST SCHED1 ;NO
SETZ T1,
SETUWP T1,
HALT
MOVEM F,FSAV(X)
SETUWP T1,
HALT
JRST SCHED1
NJA: PUSHJ P,CJDSP
MOVEI S,[ASCIZ/ LOGIN FAILED]/]
NOCOJO: HRRZ L,CJOWNR(X) ;TELL THE OWNER
MIC DISPLAY,L
JFCL
IFE FTMBCH,<
JRST CJZAP
> ;END OF IF NOT BATCH BIT
IFN FTMBCH,<
TRNE F,FR.BAT ;IS WE BATCH
JRST CJZAP ;NO
SETZ T2,
SETUWP T2, ;W/E HI-SEG.
HALT
MOVNI T2,3 ;PUT -3 IN BATCH ACTION WORD
MOVEM T2,BATACT
MOVEI T2,1 ;AND RESET SETUWP THINGY
JRST CJZAP1 ;AND AWAY
>;END OF BATCH BIT
;HERE TO READ A BUFFER LOAD OF PTY OUTPUT AND LOG IT
PTYIN: HRLZ T4,PTY.IC(Z)
LSH T4,5
ADD T4,[INPUT]
XCT T4
PUSHJ P,STATES ;GET THE LINE STATES
JFCL ;NOT TO INTERESTED HERE IF JOB DISAPEARED
TLNE S,LDL.TO ;STILL GOT OUTPUT
AOS (P) ;YES PREPARE FOR SKIP EXIT
PTYIN1: SOSGE PTY.IH+2(Z) ;BYTE AVAILABLE?
POPJ P,0 ;NO EXIT
ILDB CH,PTY.IH+1(Z) ;READ A CHARACTER
PUSHJ P,LOGO ;LOG IT
JRST PTYIN1 ;AND GET MORE
;A ROUTINE TO TYPE A CHARACTER DOWN A PTY AND LOG IT
PTYCR: PUSHJ P,LOGO
MOVEI CH,LF
PTYO: SOSG PTY.OH+2(Z) ;IF NO SPACE
PUSHJ P,PTYOUT ;MAKE SOME
IDPB CH,PTY.OH+1(Z) ;AND DEPOSIT THE CHARACTER
CAIN CH,CR
JRST PTYCR ;APPEND LF TO CR
PUSHJ P,ISBRK ;ANY BREAK
PUSHJ P,PTYOUT ;WILL CAUSE AN OUTPUT
;A ROUTINE TO WRITE A CHARACTER TO THE LOG BUFFER
LOGO: MOVEI T1,PR.LGN ;NO LOG BIT
TDNE T1,PROFLE(X)
POPJ P,0 ;IT IS SET
SOSGE LOGTOT(Z) ;SPACE?
JRST LOGO1 ;NO GO MAKE SOME SPACE
IDPB CH,LOGBP(Z)
CAIN CH,LF
JRST TIMSTP ;IF THAT WAS A LINE FEED TIMESTAMP LOG
POPJ P,0
LOGO1: PUSHJ P,LOG ;GO WRITE OUT THAT BLOCK
JRST LOGERR ; LOGGING ERRORS
XCTLOG: JRST LOGO ;AND START ON THE NEXT
; A ROUTINE TO WRITE AN ASCIZ LINE TO THE LOG BUFFER
LOGDIS: SETZ T1, ;W/E HI-SEG
SETUWP T1,
HALT
MOVEM S,DISWRD(X) ;PRETEND WE ARE DOING A DISPLAY
SETUWP T1,
HALT
POPJ P,0 ;DUN
;A ROUTINE TO DISPLAY TYPICAL INFO ON COJOB OWNERS TTY
CJDSP: MOVE L,CJOWNR(X)
ECJDSP:
IFN FTMBCH,<
SKIPN BATWRD(X) ;IS HE BATCH
JRST .+3 ;NO
MOVE L,BATOPR ;SET UP BATCH OPERATOR LINE NO.
SKIPA S,[[ASCIZ/
[BATCH JOB /]]
>;END
MOVEI S,[ASCIZ/
[COJOB /]
MIC DISPLAY,L
JFCL
HLRZ S,CJOWNR(X)
ADDI S,"@"+<S>_7
ROT S,-7
MIC DISPLAY,L
JFCL
POPJ P,
;A ROUTINE TO FORCE AN OUTPUT ON THE PTY
PTYOUT: HRRZ T4,PTY.IC(Z)
DEVCHR T4,
SKIPN T4
PJRST OUTERR ;WE HAS GOT PROBLEMS LET OPR KNOW
HRLZ T4,PTY.IC(Z)
LSH T4,5
ADD T4,[OUTPUT]
XCT T4
POPJ P,0
;A ROUTINE TO TYPE ON A GUYS TERMINAL
TYPER: SKIPE COJOB(X) ;IS IT A COJOB?
JRST PTYTYP ;YES TYPE DOWN A PTY
MIC TYPE,L ;NO TYPE ON HIS TERMINAL
JFCL
POPJ P,0
;A ROUTINE TO TYPE A STRING POINTED TO BY S DOWN A PTY AND LOG IT
PTYTYP: HRRI BP,(S) ;MAKE A BYTE POINTER
;A ROUTINE TO OUTPUT AN ASCIZ STRING POINTED TO BY BP
STROUT: HRLI BP,440700
STROU1: ILDB CH,BP
JUMPE CH,CPOPJ
PUSHJ P,OUCH
JRST STROU1
; A ROUTINE WHICH DISPLAYS A MESSAGE ON A COJOB OWNERS TERMINAL
CJMESG: PUSHJ P,OWNCHK ;CHECK IF OUR OWNER IS STILL THERE
JRST CPOPJ ;HE AIN'T
PUSH P,S ;SAVE THE MESSAGE
PUSHJ P,CJDSP ;WHILE HE HAS THE STANDARD BIT
MOVE S,(P) ;WOT MESG.?
MIC DISPLAY,L ;DISPLAY MESSAGE (L SET UP BY CJDSP THANKS)
JFCL ;WHO CARES
MOVEI S,[ASCIZ/]
/] ;END OF MESSAGE
MIC DISPLAY,L ;LET HIM HAVE IT
JFCL
MOVE L,LINE(X) ;RESET THIS JOBS LINE
POP P,S
POPJ P,0 ;AND AWAY...
; THIS ROUTINE CHECKS IF THE JOB WHICH STARTED A COJOB
;IS STILL IT'S OWNER AND IF IT IS-- SKIP RETURNS
OWNCHK: TRZE F,FR.OWN ;DO WE KNOW
JRST OWNCK1 ;YES
IFN FTMBCH,<
SKIPE BATWRD(X) ;IS WE BATCH
JRST CPOPJ1
>
HRLZ T1,OJOB(X) ;GET OWNERS JOB N0.
HRRI T1,.GTPPN
GETTAB T1, ;GET THAT JOB'S PPN
SETZ T1, ;DEFENSIVE---AS T1 UNCHANGED
CAMN T1,OPPN(X) ;IS HE OUR OWNER
JRST CPOPJ1 ;YEAH!
MOVEI S,[ASCIZ/[COJOB OWNER NOT AVAILABLE - CONTINUING]
/] ;NO
PUSHJ P,LOGDIS ;LEAVE A MESSAGE IN HIS LOG FILE
TRO F,FR.OWN ;SET THE OWNER GONE AWAY BIT
OWNCK1: TLZ F,FL.CB ;MAKE SURE HE DOES NOT [BREAK]
POPJ P,0
;A ROUTINE TO MAKE A LINE STATES WORD FROM A JOBSTS UUO
STATES: MOVE S,PTY.IC(Z) ;CHANNEL
JOBSTS S,
SETZ S, ;SOME ONE RELEASED THE PTY
TLZ S,617777 ;CLEAR ALL BUT JB-UML,UOA,UDI
TXZE S,JB.UML ;MONITOR LEVEL?
TLO S,LDLCHK!LDL.MM ;YEP
TXZE S,JB.UOA ;OUTPUT AVAILABLE
TLO S,LDLCHK!LDL.TO ;YEP
TXZE S,JB.UDI ;WANTS INPUT?
TLO S,LDLCHK!LDL.TI ;YEP
TRNE S,-1 ;IF HE HAS A JOB
AOS (P)
POPJ P,0 ;SKIP OUT
;A ROUTINE TO APPEND A BLOCK TO THE COJOB LOG FILE
LOG: MOVEI T1,PR.LGN ;GET NO LOGGING BIT
TDNE T1,PROFLE(X) ;IS IT SET
JRST BFCLR1 ;YES
SKIPN LOGBUF(Z) ;IF NOTHING TO LOG
JRST CPOPJ1 ;STAY HAPPY
MOVEI T1,17 ;DUMP MODE
MOVE T2,LOGDEV(Z) ;THIS DEVICE
SETZ T3, ;NO BUFFERS
OPEN T1 ;GRAB DEVICE
JRST BUFCLR ;FAILED JUST CLEAR DOWN BUFFER
PUSHJ P,SAVEP3 ;SAVE PRESERVED AC
MOVE T1,LOGFIL(Z)
MOVE T2,LOGEXT(Z)
SETZ T3,
MOVE T4,LOGPPN(Z)
LOOKUP T1 ;FIND LOG FILE
TDZA P3,P3 ;TIS ZERO LENGTH
HLRE P3,T4 ;P3 IS LENGTH OF FILE
MOVE T4,LOGPPN(Z) ;CALIM THE LOG FILE
ENTER T1
JRST BUFCLR ;FAILED JUST CLEAR DOWN BUFFER
JUMPGE P3,LOG1 ;SIZE WAS IN BLOCKS
MOVNS P3
ADDI P3,177
LSH P3,-7 ;CONVERT SIZE TO BLOCKS
LOG1: USETO 1(P3) ;WRITE NEXT BLOCK
OUTPUT LOGDMP(Z)
RELEAS ;LET THE CHANNEL GO
BFCLR1: AOS (P) ;GOOD THUS FAR
BUFCLR: MOVEI T1,200*5
MOVEM T1,LOGTOT(Z)
MOVE T1,[POINT 7,LOGBUF(Z)]
MOVEM T1,LOGBP(Z)
SETZM LOGBUF(Z) ;ZAP THAT BLOCK
MOVSI T1,LOGBUF(Z)
HRRI T1,LOGBUF+1(Z)
BLT T1,LOGBUF+177(Z)
MOVEI T1,LOGBUF-1(Z) ;SET UP DUMPER
HRLI T1,-200
MOVEM T1,LOGDMP(Z)
POPJ P,0
;HERE TO TYPE COMMANDS ON BEHALF OF A COJOB
;E.G. MIC COJOB A PROCEED
CJCNTL: TLNE WD,7777 ;1 LETTER NAME ONLY
JRST CJCNT4 ;NOOOO
MOVEM WD,CH ;PUT IT IN CH
SETZ WD,
LSH CH,-36 ;AND
ADDI CH," " ;MAKE IT ASCII
MOVEM CH,LINTOT ;SAVE NAME FOR POSS. ERROR MESG.
HRLZ T1,PROCNO ;THIS NUMBER OF PROCESSES
TDZA X,X ;START SKIP
CJCNT1: ADDI X,PDBSIZ ;ADVANCE TO NEXT
HLRZ T2,CJOWNR(X) ;OWNED?
JUMPE T2,CJCNT2 ;NO
CAIN T2,1-"A"(CH) ;DID HE SAY THIS ONE
SKIPL FLAG(X) ;YES-RUNNIG?
CJCNT2: AOBJN T1,CJCNT1 ;NO-LOOP
JUMPL T1,CJCNT3 ;YES-GO CHECK PRIVS
CJCNT4: OUTSTR [ASCIZ/%CONTROL COMMAND "/]
PUSHJ P,SIXBP
OUTSTR [ASCIZ/" NOT VALID FOR COJOB /]
OUTCHR LINTOT
JRST SLENDX ;UNHELPFULL MESSAGE FOR HACKERS
CJCNT3: GETPPN N,
JFCL
CAMN N,[1,,2]
TLOA F,FLS.GD
CAMN N,OPPN(X) ;OR OWNER PPN
SKIPA L,LINE(X) ;OK PICK UP LINE
JRST CJCNT4 ;NO-BOMB
PUSHJ P,WDREAD ;GET COMMAND IN
CAMN WD,[SIXBIT/WH/] ;ALLOW "WH" TO MEAN "WHAT"
MOVE WD,[SIXBIT/WHAT/]
MOVE T1,[-CMDSIZ,,MICTAB] ;COMMAND TABLE
PUSHJ P,FNDNAM ;SEARCH IT
JRST CJCNT4 ;NOT PRESENT
MOVE WD,MICTAB(T1) ;GET NAME IN FULL
CAMN WD,[SIXBIT/WHAT/] ;SPECIAL TREATMENT
JRST STATX ;GO GIVE HIM SOME WHAT INFO
MOVE T1,DSPLST(T1) ;PICK UP DISPATCH BITS
TLNE T1,CJ ;RUNNING CJ OK
MIC GET,L ;GET IN MIC BITS
JRST CJCNT4 ;NO-MIC-OR WRONG COMMAND
MOVE L,LINE(X) ;SET UP L
JRST (T1)
;A ROUTINE TO TIMESTAMP THE LOG FILE
TIMSTP: MOVEI N,PR.TIM ;GET NO TIMSTAMP BIT
TDNE N,PROFLE(X) ;IS IT SET
POPJ P,0 ;YES
PUSH P,LOWOUT ;SAVE LOW OUTPUT CALL
MOVE N,XCTLOG ;JUST WRITE TO LOG FILE
MOVEM N,LOWOUT
MSTIME N, ;GET DAY TIME
PUSHJ P,TIMPRT ;PRINT IT
PUSHJ P,SPACE
TLNE S,LDL.MM ;TIMESTAMP ACCORDING TO MODE
SKIPA WD,[SIXBIT/MONTR/]
MOVE WD,[SIXBIT/USER/]
PUSHJ P,SIXBT
POP P,LOWOUT ;BACK TO STANDARD
POPJ P,0
> ;END OF COJOB MAIN BIT
LIST
TMPRTS: IMULI N,^D1000 ;MAKE SECONDS INTO MILLI SECS. (I KNOW ITS WASTE OF TIME BUT......)
TIMPRT: IDIV N,[15567200]
PUSH P,N1 ;SAVE LOW RESULT
PUSHJ P,DECPR2
PUSHJ P,COLON
MOVE N,(P)
IDIVI N,165140
MOVEM N1,(P)
PUSHJ P,DECPR2
PUSHJ P,COLON
POP P,N
IDIVI N,^D1000
PUSHJ P,DECPR2
POPJ P,0
;THE REMAINING CODE IS CONCERNED WITH REPORTING OPERATIONAL ERRORS
IFE FTCJOB,<XLIST>
IFN FTCJOB,<
OUTERR: MOVEI S,[ASCIZ?%(OUTERR)ATTEMPT TO USE UNASSIGNED I/O CHANNEL
?]
PUSHJ P,TELOPR ;LET OPR KNOW
TRNE Z,770000
MOVS Z,Z
POPJ P,0
LOGERR: MOVE S,[XWD 440700,[ASCIZ/ LOGGING ERROR-NON-FATAL-- CODE /]]
HRRZ N,T2 ;POSITION ERROR CODE
PUSHJ P,PRPOPR ;PREPARE THE NEWS
PUSHJ P,TELOPR ;TELL THE OPERATOR
JRST LOGO
;HERE TO PREPARE AN ASCIZ MESSAGE IN BUFFER FROM AN ASCIZ STRING IN S
;AND AN OCTAL NO. IN N
PRPOPR: MOVE BP,[POINT 7,BUFFER]
MOVE CH,[IDPB CH,BP] ;NEW LOW-LEVEL OUTPUT ROUTINE
PUSH P,LOWOUT ;SAVE LOW-LEVEL O/P ROTINE (WHY?)
MOVEM CH,LOWOUT ;AND REPLACE IT WITH OUR OWN
ILDB CH,S ;GET ACHAR
JUMPE CH,.+3 ;IS IT NULL
IDPB CH,BP ;NO DEPOSIT IT
JRST .-3 ;LOOP FOR MORE
PUSHJ P,OCTPRT ;PRINT IT
SETZ CH,
IDPB CH,BP ;MAKE ASCIZ
MOVEI S,BUFFER ;GET IN CONTEXT
POP P,LOWOUT ;RESTOR ORIGINAL LOW-LEVL O/P REOTINE
POPJ P,0
>
LIST
CORERR: MOVEI S,[ASCIZ/CORERR - CORE UUO FAILED - CONTINUING /]
PUSHJ P,MSTOPR ;LET OPR KNOW
MOVNI S,^D50 ;RESET TRY COUNTER
MOVEM S,TRYCORE
JRST SCHED1 ;AND CONTINUE
;HERE TO TELL THE SYSTEM OPERATOR THAT MIC HAS HAD A
;PROBLEM
MSTOPR: PUSH P,L ;FOR COMPATABILLITY
MOVE L,MICOPR
SKIPGE MICOPR
PUSHJ P,NO.OPR
PUSH P,S ;FOR COMPATA.....
MOVEI S,[ASCIZ/
[(MIC) - /]
MIC DISPLAY,L ;LET HIM KNOW WHO WE ARE
JFCL
JRST TELOP1
IFN FTCJOB,<
;HERE TO TELL THE SYSTEM OPERATOR ABOUT SOME ERROR IN A PARTICULAR
;COJOB - I.E. MIC ERROR?
TELOPR: PUSH P,L ;SAVE USER'S LINE NUMBER
MOVE L,MICOPR ;GET MIC OPR. LINE NO.
SKIPGE L
PUSHJ P,NO.OPR ;-1 MEANS NO OPR
PUSH P,S ;SAVE MESG. OVER CALL TO CJDSP
PUSHJ P,ECJDSP ;STANDARD BIT
>
TELOP1: POP P,S ;GET THE STRING BACK
MIC DISPLAY,L ;DISPLAY MESSAGE ON OPR
JFCL ;NOWT WE CAN DO
MOVEI S,[ASCIZ/]
/]
MIC DISPLAY,L
JFCL
JRST TELDUN
NO.OPR: MOVSI L,'OPR' ;WORK OUT LINE NO. OF SYTEM OPR
IONDX. L, ;THIS IS A NICE UUO
JRST TELDN1 ;OOOOOOOOPS
TRZ L,.UXTRM ;REMOVE UNIVERSAL DEVICE THINGY
POPJ P,0 ;AND TRY THIS
TELDN1: POP P,(P) ;DONT RETURN
TELDUN: POP P,L ;RESTORE USER'S LINE NUMBER
POPJ P,0 ;AND AWAY...
LIST
IFE FTCJOB,< ;IF NOT COJOB
TYPER: MIC TYPE,L
JFCL
POPJ P,0
> ;END OF IF NOT COJOB BIT
;A ROUTINE TO SAVE AC P3
SAVEP3: EXCH P3,(P)
PUSHJ P,(P3)
JRST .+2
AOS -1(P)
POP P,P3
POPJ P,0
XLIST ;PUT LITERALS BEFORE SPACE TO BE USED FOR COMMUNICATION AREA
LIT
VAR
LIST
SUBTTL PROCESS CONTROL AREA IN LOW CORE COMMON TO ALL MODES
RELOC
SIZ==100
LOWIN: BLOCK 1 ;THIS CONTAINS THE LOW LEVEL I/P CALL
LOWOUT: BLOCK 1 ;THIS CONTAINS THE LOW LEVEL OUTPUT CALL
CH.SAV: BLOCK 1 ;PLACE TO SAVE CHAR WHEN EATEN MORE THAN CAN CHEW
LINTOT: BLOCK 1
LOWCMD: BLOCK 1 ;PLACE TO STORE SIXBIT NAME OF COMMAND ON PROGRESS
F.CMBT:
DEFNDX: BLOCK 1 ;PLACE TO STORE THE DEFAULT INDEX TO A GETTAB
;USUALLY A JOB NO.
P..SAV: ;USED BY COMBAT
SYMBUF: BLOCK 8 ;WHERE THE RESULT OF A DELIMITER IS PUT
GTLOCK: BLOCK 1 ;LOCK FOR NESTED GETTABS
STACK: BLOCK SIZ
LDEV: BLOCK 1 ;STORAGE FOR DEV:
LFILE: BLOCK 1 ; .. .. FILNAME
LEXT: BLOCK 1 ; :: :: EXT
LPPN: BLOCK 1 ; .. .. PPN
IFN FTCJOB,<
LOWSWT: BLOCK TABSWT ;SPACE FOR SETTING UP SWITCHES
>
TRYCORE: BLOCK 1 ;WHERE TO COUNT THE NO. OF TIMES WE TRIED FOR CORE
INTBLK: BLOCK 4 ;SPACE FOR CONTROL C INTERCEPT BLOCK IN SLAVE
;AND ERROR INTERCEPT BLOCK IN MASTER
;USED BY AUTO-RESTART
MICBLK: BLOCK 3 ;BLOCK USED FOR TRMOP. ARGS
.LOW=. ;END OF COMMON DATA STORAGE SLAVE AND MASTER
;MASTER PROCESS AREA IN LOW CORE
BUFBP: BLOCK 1
BUFFER: BLOCK <^D80/5>+1
ACTIVE: BLOCK 1
LABWD: BLOCK 1
HIBTIM: BLOCK 1 ;TIME FOR HIBER
CORSAV: BLOCK 1
ARGPNT: BLOCK 1 ;POINTER TO ARG.
ARGWRD: BLOCK 1 ;ARG.
ARGTYP: BLOCK 1 ;TYPES OF ARG. ALLOWED
; =0 MEANS ANY
; =-1 MEANS "IF" ONLY.
; =1 MEANS NONE.
RELOC
SUBTTL PROCESS CONTROL AREA IN SHARED CORE
PCA:
IFN FTCJOB,<
DEFDSP: "0",,"D" ;DEFAULT QUEING AND DISPOSAL
DEFTIM: .STTLM,,IDFTIM ;SIXTY SECONDS DEFAULT RUNTIME
WHONOT: 0,,0 ;WHO MAY NOT INITIATE COJOBS
COJOBN: -1 ;NEGATIVE NUMBER OF USABLE COJOBS
CJREQ: -ICJREQ ;" " " " DESIRED COJOBS
CJUP: 0 ;NUMBER OF COJOBS IN USE
> ;END OF COJOB BIT
CMDTOT: 0 ;NUMBER OF SUCCESSFULL / COMMANDS
IFN FTCJOB,<
CJBTOT: 0 ;NO. OF COJOBS RUN
>;END
IFN FTMBCH,<
BRQTOT: 0 ;BATCH REQUESTS
BATTOT: 0 ;BATCH JOBS
BATOPR: 1
BATACT: Z ;MIC/COMBAT INTERLOCK
BCHREQ: -1 ;-VE NO. OF DESIRED BATCH JOBS
BCJOBN: Z ;-VE NO. OF USABLE BATCH JOBS
BCHUP: Z ;NO. OF BATCH JOBS IN USE
>;END FTMBCH
MICOPR: -1 ;MIC OPERATOR'S LINE NO.
IFN FTCJOB,<
SWTLIM:; BLOCK TABSWT ;BLOCK FOR HOLDING SWITCH LIMITS****TEMP***
LIMTIM: IMXTIM,,-1 ;TIME LIMIT
REPEAT TABSWT-1,< EXP -1 >
>
PROCNU==1 ;NUMBER OF PROCESS AREA YOU START WITH
PROCNO: -PROCNU ;NEGATIVE NUMBER OF PROCESS AREAS AVAILABLE
MAXLVL: 77 ;MAXIMM LEVEL OF NESTING FOR PROCESSES
DEFTBL: 0 ;DEFAULT TABLE FOR GETTABS
DEFMOD: 1 ;DEFAULT MODE FOR GETTABS
LOCK: -1 ;INTERLOCK FOR GRABBING A PROCESS AREA IN SHARED CORE
;-1 FREE
;+VE IN USE
COMCNT: 0 ;NUMBER OF UNSATIFIED REQUEST FOR PROCESS AREAS
MASTNO: BLOCK 1 ;JOB NO. OF MASTER PROCESS
PCALEN=.-PCA
.HIGH==.
SUBTTL PROCESS DATA AREA IN SHARED CORE
DEFINE .. (....,...<.....>),<
......=...
IFN ......&WH,<
A.'....: BLOCK 2
>
> ;END OF MACRO
PDB:
IFN FTCJOB,<
COJOB: 0 ;FLAG FOR COJOB PROCESSING
CJOWNR: 0
IFN FTMBCH,<
BATWRD: 0 ;WORD FOR BATCH PROCESSING
>
>
LDBMIC: 0
LINE: 0
STATIN: 0 ;STATION INFO
DEV: 0
FILE: 0 ;FILE NAME
EXT:: 0 ;EXTENSION
PPN: 0 ;THIS JOB'S PPN
IFN FTPATH,<
PATH: BLOCK 7 ;SPACE FOR PATH
>
OPPN: 0 ;PPN OF OWNER
OJOB: 0 ;OWNER'S JOB NO.
JOB: 0 ;JOB NO.
BLAB: 0 ;SPACE FOR BACKTO LABEL DO NOT SEPERATE THIS FROM
LAB: 0 ;SPACE FOR LABEL THIS.....
FSAV: 0 ;FLAG WORD (SAVED COPY OF AC F ---USED TO BE IN LOW SEG)
PROFLE: 0 ;MIC PROFILE WORD
TYPWRD: 0 ;SPACE FOR ADDR. OF TYPE ARG.
DISWRD: 0 ;SPACE FOR ADDR. OF DISPLAY ARG.
ERRWRD: BLOCK 1 ;SPACE FOR ADDR. OF ERROR MESSAGE
ARGBP: BLOCK ARGNUM
IFN FTCJOB,<
ARG: BLOCK ARGNUM*4-4-TABSWT
LGSPEC: BLOCK 4
BLOCK TABSWT
ENDSWT==.-1
>
IFE FTCJOB,<
ARG: BLOCK ARGNUM*4
>
FSTVNT: CMD
LSTVNT==.-1
INLINE: BLOCK <^D80/5>+1 ;SPACE FOR USERS CURRENT I/P LINE
RS: 0 ;WHERE THE BYTE POINTER TO A RESPONSE PARAMETER IS PUT
LAST: 0 ;SET WHEN A PREVIOUS PROCESS HAS BEEN STOPPED
;CONTAINS THE X POINTER OF THE PREVIOUS PROCESS+1
FLAG: 0 ;INTERLOCK FOR SLAVE MASTER PROCESS
; 0=FREE
; 1=IN USE SLAVE MODE
;-1=AVAILABLE FOR THE MASTER PROCESS
PDBSIZ==.-PDB
RELOC
SUBTTL COJOB NON-SHARED PROCESS AREA
IFN FTCJOB,< ;COJOBS ONLY
DEFINE ..(....,.....,C<0>),<
....: BLOCK 1
>
PTY.IC: BLOCK 1 ;CHANNEL FOR PTY IO
PTY.IH: BLOCK 3 ;PTY INPUT BUFFER HEADER
PTY.IB: BLOCK 23 ;PTY INPUT BUFFER
PTY.OH: BLOCK 3 ;PTY OUTPUT BUFFER HEADER
PTY.OB: BLOCK 23 ;PTY OUTPUT BUFFER
LOGTOT: BLOCK 1 ;FREE BYTES IN LOGGING BUFFER
LOGBP: BLOCK 1 ;LOG BUFFER PUTTER
LOGBUF: BLOCK 200 ;LOG BUFFER
LOGDEV: BLOCK 1 ;ON WOT
LOGFIL: BLOCK 1 ;IN WOT
LOGEXT: BLOCK 1 ;MORE OF WHERE
LOGPPN: BLOCK 1 ;WHERE
SWTCH
ELOWSWT=.-1
VDISP==VD
LOGDMP: BLOCK 2 ;DUMP MODE COMMAND LIST
CJFLAG: BLOCK 1 ;NON - ZERO TO INDICATE COJOB AREA IN USE
CJSIZ==.-PTY.IC
> ;END OF COJOBS ONLY
LPDB:
NESTY==10 ;MAX NESTING ON PARAMETERS
LTIME: BLOCK 1 ;MORATORIUM FOR THIS PROCESS
CURBP: BLOCK NESTY
BLKNO: BLOCK 1
FILBLK: BLOCK ^D128+1
TMPCBF==FILBLK+32 ;BUFFER FOR CCL I/P IN SLAVE
TMPCPT: ;POINTER TO CCL BUFFER IN SLAVE
POINTR: BLOCK 1
LPDBSIZ==.-LPDB
.LOW2==.
SUBTTL LOW STORAGE FOR SLAVE PROCESS SPECIAL COMMANDS
RELOC
;IF/LET
;/ COMMAND SPECIAL LOW CORE STORAGE
RELOC .LOW
LEVEL: BLOCK 1 ;REFERENCE TO OUTER LEVEL
LLX: BLOCK 1 ;LINE NUMBER
LLP: BLOCK 1 ;PARAMETER NAME...THEN ADDRESS PARAMETER .ER
BOOL: BLOCK 1 ;CONDITIONAL OPERATOR DECODE TO CAM?? N,N1
FIRST: BLOCK ARGNUM*8
SS: BLOCK 100
SECOND: BLOCK ARGNUM*8
HEAP:
HH: BLOCK 100
RELOC .LOW2
;DUMMY PDB IS SET UP HERE
;ALSO BATCH RETURN AREA ETC.
DUMPDB: BLOCK PDBSIZ
DUMMYX=DUMPDB-PDB ;CORRECTED VALUE FOR SLAVE X
IFN FTMBCH,<
LWACTN: BLOCK 1 ;MIC/COMBAT COMMUNICATION
COMBRG: BLOCK 6
COMBAT: BLOCK 2
> ;END OF MIC BATCH
SUBTTL MASTER PROCESS - ONCE ONLY INITIALLISATION
RELOC .HIGH
;HERE TO DO THE START UP CODE FOR MIC
;NB THIS CODE IS WIPED OUT AFTER USE!
INITIA: SETZM LPDB ;CLEAR CORE
MOVSI P,LPDB ;FROM HERE...
HRRI P,LPDB+1
SKIPN .JBDDT## ;DO NOT ZERO CORE IF LOADED WITH DDT
BLT P,@.JBREL## ;...TO HERE
CLRBFI
MOVE P,[IOWD SIZ,STACK]
SETZ T1,
SETUWP T1,
HALT
PJOB T2, ;GET JOB NO.
IFN FT602,<
CAIL T2,^D127 ;JOB NO. GREATER THAN 127
JRST [OUTSTR [ASCIZ/?MICJTH MIC JOB NO. GREATER THAN 127/]
EXIT]
>
MOVEM T2,MASTNO ;AND PRESERVE
SETUWP T1,
HALT
WAKE T2, ;SET TO WAKE
SETZ T1,
HIBER T1, ;HIBERNATE
JFCL
MOVE T1,[.TCRDD,,T2] ;CLEAR TMPCOR
SETZB T2,T3
TMPCOR T1,
JFCL
IFE FTRLSE,<
MOVE T1,[.TCRWF,,T2] ;WRITE AKJ FILE
MOVSI T2,'AKJ'
HRROI T3,T4-1 ;SET UP IOWD
MOVE T4,[ASCIZ/AK
/]
TMPCOR T1,
JRST [SKIPL F
OUTSTR [ASCIZ/?NO TMPCOR ?/]
EXIT]
> ;END OF IF NOT RELEASE BIT
JUMPL F,INIT0 ;IS THIS A RESTART
;NO -NORMAL INITIALLISATION
;SO TELL HIM OUR VERSION NUMBER.
OUTSTR [ASCIZ/
MIC VERSION - /]
LDB N,[POINT 9,.JBVER##,11] ;MAJOR VERSION NUMBER
PUSHJ P,OCTPRT ;PRINT IT
LDB N,[POINT 6,.JBVER##,17] ;MINOR VERSION NUMBER
JUMPE N,.+3
MOVEI CH,"A"-1(N) ;(CHANGE THIS IF VMINOR>26)
PUSHJ P,OUCH
OUTCHR ["("] ;LEFT BRACKET
HRRZ N,.JBVER## ;EDIT NO.
PUSHJ P,OCTPRT ;PRINT IT
OUTCHR [")"] ;RIGHT BRACKET
LDB N,[POINT 3,.JBVER##,2] ;WHO MODIFIED DIS
SKIPE N ;NOBODY?
OUTCHR ["-"] ;NO SOMEBODY
SKIPE N
PUSHJ P,OCTPRT ;PRINT IT OUT
OUTSTR [ASCIZ/
/]
;MORE INITIALLISATION
INIT0: SETO T1, ;NOW DET TTY
IFN FTCJOB,< ;IF COJOBS
MOVE T1,[JRST PTYO]
MOVEM T1,LOWOUT ;FOR COJOB ACTIVITY
> ;END OF IF COJOBS
SETZ T1, ;NOW TO CHECK UP ON MIC DEVICE
MOVSI T2,'MIC' ;DOES MIC EXIST
SETZ T3,
OPEN T1
MOVSI T2,'SYS' ;NO--WE MUST USE MIC
SETZ T1,
SETUWP T1,
HALT
HLRZM T2,MICDEV ;MAKE THAT THE MIC DEVICE
IFN FTRLSE,<
MOVE T2,[%CNSTS,,.GTCNF]
MOVEI T3,^D50 ;DEFAULT IS 50 CYCLE CLOCK
GETTAB T2,
SETO T2,
TLNN T2,ST%CYC ;IS IT A 50 CYCLE CLOCK
MOVEI T3,^D60 ;NO
MOVEM T3,JIFFY ;REMEMBER
>
SETO T1, ;NOW DET TTY
GETLCH T1
HRLZS T1
HRRZ T2,.JBDDT## ;GET ADDR OF DDT IF ANY
JUMPN T2,INDDT ;DON'T DET IF DDT
GETLIN T3, ;GET LINE
TLNN T3,-1 ;ARE WE DETACHED?
JRST INIT1 ;YES SO DONT DETACH AGAIN
OUTSTR [ASCIZ/DETACHING
./]
ATTACH T1,
OUTSTR [ASCIZ/CAN'T DETACH
/]
SKIPA
INDDT: OUTSTR [ASCIZ/DDT LOADED - MIC WILL NOT DETACH!
/]
INIT1:
IFN FTPSI,<
PUSHJ P,SETPSI ;INITIALLISE SOFTWARE INTERRUPTS
>
PUSHJ P,CLRLDB ;CLEAR ANY SPURIOUS LDBMIC WORDS
MOVE 4,[INITIA,,INITIA+1]
SETZM INITIA ;PREPARE TO WIPE OUT START UP CODE
MOVE 0,[BLT 4,E.INITIA]
MOVE 1,[SETUWP 6,]
MOVE 2,[HALT]
MOVE 3,[JRST MSTR0]
JRST 0 ;WIPE OUT!
SUBTTL INITIALLISE SOFTWARE INTERUPTS TO MAKE MIC SELF-RESTARTING
IFN FTPSI,< ;LET THIS BE CONFIGUARABLE OUT
SETPSI: MOVEI T1,..DIE ;ADDR. TO DIE AT
MOVEM T1,INTBLK ;IN PSI INTERRUPT BLOCK
SETZ T1,
TXO T1,PS.VPO!PS.VTO!PS.VDS!PS.VPM ;ENABLE FLAGS
MOVEM T1,INTBLK+.PSVFL ;IN CONTROL BLOCK
MOVEI T1,INTBLK ;GET BASE ADDR. OF INTERRUPT BLOCK
PIINI. T1, ;INITIALLISE THE PSI SYSTEM
JRST E%%PIN ;FAILED
MOVE T1,[EXP PS.FAC+[EXP .PCIUU
Z
Z]] ;TRAP ILLEGAL UUO
PISYS. T1,
JRST E%%PSI ;FAILED
MOVE T1,[EXP PS.FAC+[EXP .PCIMR
Z
Z ]] ;ILL MEM REF.
PISYS. T1,
JRST E%%PSI
MOVE T1,[EXP PS.FAC+[EXP .PCPDL
Z
Z ]] ;PDL OVERFLOW
PISYS. T1,
JRST E%%PSI
MOVE T1,[EXP PS.FAC!PS.FON+[EXP .PCSTP
Z
Z ]] ;^C
PISYS. T1,
JRST E%%PSI
POPJ P,0 ;PSI SET UP
E%%PIN: OUTSTR [ASCIZ/?MICPIN PIINI. UUO FAILED/]
JRST ERRPS0
E%%PSI: OUTSTR [ASCIZ/?MICPSI PISYS. UUO FAILED/]
ERRPS0: MOVE N,T1
OUTSTR [ASCIZ/ CODE-/]
PUSHJ P,OCTPRT ;PRINT THE AC
OUTSTR [ASCIZ/
/]
POPJ P,0
>
SUBTTL CLRLDB - ON A RESTART CLEAR UP ANY OLD LDBMIC WORDS
;THIS ROUTINE LOOKS AT ALL THE LINES ON THE SYSTEM
;AND IF THEY HAVE AN LDBMIC WORD SET UP - WHICH POINTS AT THIS JOB
;IT IS CLEARED DOWN AND A MESSAGE OUTPUT
CLRLDB: MOVE T1,[EXP %CNLNP]
GETTAB T1, ;GET NO. OF LINES
JRST CPOPJ ;FAILED - JUST CARRY ON
HLRI N,0 ;-VE NO. OF TTY'S IS ALREADY IN T1
;SO SET UP AN AOBJN THINGY
CLRLD0: HRRZ L,N ;GET LINE NO.
MIC GET,L ;GET LDBMIC WORD
JRST CLRLD1 ;HASN'T GOT ONE
LDB T3,LDPMJN ;WHO DOES HE BELONG TO
CAME T3,MASTNO ;IS IT US
JRST CLRLD1 ;NO - LEAVE HIM ALONE
MIC CLEAR,L ;CLEAR IT DOWN
JFCL
MOVEI S,[ASCIZ/?
?MICSYS MIC SYSTEM ERROR - YOUR MIC COMMAND HAS BEEN ABORTED
/]
MIC DISPLAY,L ;TELL HIM THE SAD NEWS
JFCL
CLRLD1: AOBJN N,CLRLD0 ;LOOP FOR ALL LINES
POPJ P,0
XLIST
LIT
VAR
LIST
E.INITIA==.-1
END MIC ;PHEW