COMMENT ⊗   VALID 00022 PAGES VERSION 15-2(14)
RECORD PAGE   DESCRIPTION
 00001 00001
 00003 00002	HISTORY
 00005 00003	
 00008 00004	FIRST THE INDICES INTO THE MESSAGE BLOCKS PASSED AROUND.
 00011 00005	NOW THE SEMANTIC BITS COPIED FROM THE COMPILER.
 00014 00006	MAGIC MACROS FOR TALKING ABOUT THE LOCKS.
 00016 00007	HERE (.MES2)			PROCESS ONE PARAMETER.
 00019 00008		HRLZI	B,CORGOT	SAY WE GOT CORE
 00022 00009	ARRYS:	TRNE	TAC1,SET!STRING
 00025 00010	SENDIT:	TRNN	A,DNOTRACE	IF NOT TRACING THIS MESSAGE, OR
 00028 00011	GGSEND:	QENT
 00030 00012	WAITC:	QENT
 00033 00013	TESR:
 00035 00014	QFIN:	TRNN	A,DWAITM
 00037 00015		MOVE	A,2(LPSA)		GOOD BITS WORD.
 00040 00016	T5:	TLNN	A,SETRECLM
 00042 00017	KILLIT:	QENT
 00044 00018	 *****						*****
 00046 00019	HERE (GET.DATA)
 00048 00020	XX1:		AOS D		REMOVE TABLE ENTRY
 00050 00021			CAMN	TAC2,DESTAB(D)		TEST FOR ALREADY DEFINED
 00052 00022	MORST:	SKIPN	RACS+1(USER)
 00054 ENDMK
⊗;
COMMENT ⊗HISTORY
AUTHOR,REASON
021  201700000016  ⊗;


COMMENT ⊗
VERSION 15-2(14) 1-25-74 BY KKP SAIL SCREW UP,USER VERSION IN RH(JOBVER) NOT LH
VERSION 15-2(13) 12-9-73 BY JRL REMOVE SPECIAL STANFORD CHARACTERS(WHERE POSSIBLE)
VERSION 15-2(12) 6-8-72 BY DCS BUG #GI# FIX THE #GI# BUG FIX CODE IN GET.DATA
VERSION 15-2(11) 6-7-72 BY DCS BUG #HO# RIGHT ADDRESS TO MESPRO PARAM BLOCK
VERSION 15-2(10) 4-28-72 BY JRL CHANGE TO NEW LEAP CALLING CONVENTIONS
VERSION 15-2(9) 3-21-72 BY JRL CHANGE LEAP INTERLOCKS
VERSION 15-2(8) 3-6-72 BY JRL REMOVE ARRPDP REFERENCES
VERSION 15-2(6) 3-6-72 BY JRL DELETE TYPE BITS FROM COMPILER
VERSION 15-2(4) 3-3-72 BY KKP BUG IN SET RELEASE CODE FOR ACTIVATE
VERSION 15-2(3) 2-5-72 BY DCS BUG #GI# REMOVE TOPSTR, FIX STRNGC BUGS
VERSION 15-2(2) 2-1-72 BY DCS ?
VERSION 15-2(1) 12-24-71 BY DCS BUG #FS# INSTALL VERSION NUMBER, REMOVE SAILRUN

⊗;

	LSTON	(MESPRO)
NOEXPO <
GLOB <
COMMENT ⊗

These are the routines for passing messages back and forth in
the second segment.  The history of a message is some subset of
the following sequence:
	1. message is composed.
	2. message is put in queue
	3. message is "sent"
	4. we wait for completion of the message.
	5. we activate the message (call the procedure)
	6. we acknowledge the processing of the message
	7. we kill the message

There are in addition, several things that we may want to do
to find out about the status of the queue, etc.

ISSUE (directive,source name,dest. name, MESSAGE foo(param list));

This returns an integer value which is the unique number associated
with the queue entry made for this message.
The legal things to mention in the directive are: DSEND,DWAIT.


QUEUE (directive,unique number)

This is for processing things in the queue already.  The legal bits
in the directive are DSEND,DWAIT,DKILL,DACT,DACK.


string ← GET!DATA (directive,unique number)
	 PUT!DATA (directive,unique number)

These get and put the string entries (source,dest,proc name) in the
blocks.  Directive is 1 for source, 2 for dest, 3 for proc name.


integer ← GET!ENTRY (directive,source,destination,proc name)

This searches the queue for an entry of the appropriate type.
The directive bits say which strings we are interested in.
Legal directive bits are DSOURCE,DDEST,DNAME,DWAITM.
DWAITM says -- if there is not one, wait for it.  If integer is
zero, no entry was found.



⊗
;FIRST THE INDICES INTO THE MESSAGE BLOCKS PASSED AROUND.

MAXPAR ←← 6		;MAXIMUM NUMBER OF PARAMETERS.
	PNTR ←←0	;RH HAS POINTER TO NEXT QUEUE ENTRY.
	BITS←←1		;LH HAS GOOD BITS ABOUT THIS MESSAGE.
			;RH HAS JOB NUMBER THAT SENT IT.
	UNIQUE←←2	;THIS IS WHERE THE UNIQUE NUMBER IS STORED..
	ISOURCE←←3	;TWO WORDS FOR SOURCE NAME (10 CHARS)
	IDEST←←5	; AND DESTINATION
	INAME←←7	; AND PROCEDURE NAME.
	PARCNT←←11	;PLACE FOR COUNT OF AMOUNT OF PARAMETER BLOCK
			;  USED TO DATE.
	PARBEG←←11	;1 AHEAD OF BEGINNING OF PARAMETER AREA.
	PAREND←←PARBEG+3*MAXPAR ;3 WORDS PER PARAMETER ENTRY.

MESBLK ←←PAREND+1 	;LENGTH OF MESSAGE BLOCK.


;NOW THE DIRECTIVE BITS.  ALL ARE ASSUMED RIGHT HALF IN DIRECTIVE.

	DSEND←←1	;SEND THE MESSAGE.
	DWAIT←←2	;WAIT FOR COMPLETION.
	DKILL←←4	;KILL THE MESSAGE.
	DSOURCE←←10	; MASK FOR GET!ENTRY
	DDEST←←20	;  "
	DNAME←←40	;  "
	DWAITM←←100	; WAIT FOR AN ENTRY TO APPEAR.
	DACT←←200	;ACTIVATE THE MESSAGE
	DACK←←400	;ACKNOWLEDGE THE MESSAGE.
	DFIND←←1000	;THIS IS THE "FIND AND ENTRY" CALL.
	DEVERY←←2000	;FOR "FIND" -- LOOK AT EVERY ENTRY, NOT JUST THOS
			;"SENT"
	DNOACT←←4000	;SEND BUT DO NOT ACTIVATE USER.
	DNOTRACE←←10000	;DO NOT TRACE THIS MESSAGE.
	DRETURN←←40000	;RETURN REGARDLESS OF DWAITM

;NOW FOR THE BITS IN THE LH OF BITS WORD.

	SENT ←← 1	;THIS MESSAGE HAS BEEN SENT!
	WAIT ←← 2	;SOMEONE IS WAITING FOR THIS MESSAGE
			;TO COMPLETE.  HE IS IN MAIL WAIT.
	KILL ←← 4	;KILL THIS MESSAGE AFTER ACKNOWLEDGEMENT IS RECD.
	ACT  ←← 200	;THIS MESSAGE IS ACTIVE.
	ACK ←←  400	;THIS MESSAGE HAS BEEN ACKNOWLEDGED.
	GOTCOR ←← 1000	;CORE HAS BEEN GOTTEN WHICH MUST BE RELEASED

INTERNAL SETFIL, SETDEV

SETFIL:	0		;	FILE THIS SEGMENT WAS LOADED FROM
SETDEV:	0	;		DEVICE THIS SEGMENT WAS LOADER FROM
;NOW THE SEMANTIC BITS COPIED FROM THE COMPILER.
COMMENT ⊗ BITS NOW IN HEAD NO LONGER NEEDED HERE.

	VALUE←←4000	;LEFT HALF WORD
	REFRNC←←2000
	SBSCRP←1
	GLOBL←←200000	;RIGHT HALF WORD
	ITMVAR←4000
	ITEM←←400
	STRING←200
	LPARRAY←←100
	SET←40
	LABEL←←20
	FLOTNG←←2
	INTEGR←←1
⊗

;BITS TO BE ADDED TO LEFT HALF OF TBITS FOR OUR USE.
	CORGOT←←400000
	SETRECLM←←200000
	STRREF ←←100000		;STRING BY REFERENCE.

DEFINE GETJOB (X)
	<CALLI	X,30>

OPDEF	MAIL	[(710000)]

; NOW FOR SOME ACTUAL STORAGE AREAS....

MESQ:	0		;HOME FOR THE QUEUE.
QUETCH:	-1		;THE LOCK FOR DIDDLING THE QUEUE.
UNIQ:	0		;THE SOURCE OF UNIQUE NUMBERS.
VERS:	-1		;THE VERSION NUMBER
INTERNAL TRACING
TRACING:	0	;SET BY USER IF TRACING MESSAGES.

NJOB←←20;		NUMBER OF JOBS ALLOWED

INTERNAL .JCNT.,.JTAB.,.JD1.,.JD2.

.JCNT.:
JOBCNT: 0		;THIS IS THE NUMBER OF ENTRIES IN THE FOLLOWING
.JTAB.:
JOBTAB:	BLOCK NJOB	;TABLE.  THIS TABLE HAS (RH) JOB NUMBER, AND 
			;HIGH ORDER BIT SET IF THE JOB IS IN MAIL WAIT
			;WAITING FOR MESSAGES TO APPEAR IN ITS QUEUE.
.JD1.:
DESTAB: BLOCK NJOB	;ALSO INDEXED BY JOBCNT -- FIRST WORD OF LOGICAL
			;DESTINATION NAME.
.JD2.:
DESTB1: BLOCK NJOB	;AND SECOND WORD OF LOGICAL DEST. NAME.
	0		;SAVE FOR ERROR OUTPUT - MUST BE AFTER DESTB1
;MAGIC MACROS FOR TALKING ABOUT THE LOCKS.

DEFINE QENT	<AOSE	QUETCH
		PUSHJ	P,WAITX	;WAIT FOR IT
		>

DEFINE QLEV	<SOS QUETCH>

WAITX:	
	SOS	QUETCH	;AND BACK UP.
	PUSH	P,C		;SAVE AN AC
	MOVEI	C,10		;SLEEP FOR 10
	CALLI	C,31		;SLEEP SOUNDLY
	MOVNI	C,2		
	ADDM	C,-1(P)		;BACK UP PC
	POP	P,C		;RESTORE AC
	POPJ	P,



; FIRST THE ROUTINES FOR COMPOSING A MESSAGE.

INTERNAL .MES1,.MES2,ISSUE,QUEUE,GET.DATA,PUT.DATA,GET.ENTRY
INTERNAL GET.BIT,GET.SET


HERE (.MES1 )			;START A BRAND NEW MESSAGE BLOCK.
	PUSHJ	P,SAVE		;AS ALWAYS.
	PUSHJ	P,.MES3		;CALL LIKE THIS SO WE CAN USE INTERNALLY
GOA:	MOVE	LPSA,X11	;AND RETURN.
	JRST	RESTR

.MES3:	MOVEI	C,MESBLK	;THIS IS HOW MUCH CORE WE NEED.
	MOVEI	TABL,GLUSER	;FORCE CORGZR TO GET SEC SEG CORE.
	PUSHJ	P,CORGZR	;AND GET IT ZEROED.
	MOVEM	B,CURMES(USER)	;SAVE FOR .MES2
	GETJOB	(C)		;GET JOB NUMBER
	HRRZM	C,BITS(B)
	MOVEI	C,PARBEG(B)	;START UP THE PARAM COUNT.
	MOVEM	C,PARCNT(B)
	POPJ	P,
HERE (.MES2)			;PROCESS ONE PARAMETER.
	EXCH	TAC1,(P)	;SAVE TBITS WORD FROM COMPILER.
	PUSH	P,TAC1		;THE HORROR IS COMPLETE
	PUSHJ	P,SAVE		;AS ALWAYS.
	SKIPN	PNT,CURMES(USER)	;SHOULD BE ONE THERE.
	ERR	<MESSAGE: CONFUSION>,1
	MOVE	TAC1,-1(P)	;TBITS WORD.
	MOVE	A,-2(P)		;PARAMETER.
	TLNN	TAC1,VALUE	;WAS IT BY VALUE ??
	JRST	REFRNG		;NO -- REFERENCE.
	TRNE	TAC1,ITEM!ITMVAR	;THESE ??
	JRST	[CAIGE A,GBRK	;IS IT A GLOBAL ITEM ?
ITMER:		ERR <MESSAGE: ITEM MUST BE GLOBAL>,1,RETIT
		 JRST COPY]	;OK -- GO AHEAD.
	TRNE	TAC1,STRING
	JRST	[PUSHJ P,STRCOP		;COPY STRING INTO SEC SEG.
		 PUSH	P,(P)		;SINCE THERE WAS NO P PARAM.
		 JRST	COPY]
	TRNN	TAC1,SET	;A SET ?
	JRST	COPY		; NO -- MUST BE ARITHMETIC -- OK.
	MOVE	D,-2(P)		;THE SET AGAIN
	PUSH	P,[COPY]	
CHKSET:	JUMPE	D,CPOPJ		;IF NULL SET, WE ARE OK
	HRRZ	D,(D)		;GO DOWN SET TO MAKE SURE ALL ARE
TTZ:	HLRZ	B,(D)		;GLOBAL ITEMS.
	CAIGE	B,GBRK		;?
	ERR	<MESSAGE: ITEM MUST BE GLOBAL>,1
	HRRZ	D,(D)		;AND CONTINUE
	JUMPN	D,TTZ
	TRNE	A,400000	;IS IT A GLOBAL SET ?
	POPJ	P,		;YES -- GO AHEAD.
	PUSH	P,C		;SAVE THIS.
	PUSH	P,PNT
	MOVSI	FLAG,GLBSRC	;...
	WRITSEC		;FOOL WITH LEAP RUNTIME ROUTINES.
	MOVEI	TABL,GLUSER
	PUSH	P,A		;THE SET.
	PUSH	P,[0]		;
	PUSHJ	P,UNION		;COPY IT....
	POP	P,A		;THE RESULT.
	HLRE	B,A
	MOVMS	B
	HRLM	B,A
	MOVE	D,A		;AND IN REGISTER D.
	MOVE	TAC1,-4(P)	;THE TBITS AGAIN
	TLO	TAC1,SETRECLM	;A SET TO BE RECLAIMED.
	HRLZI	B,CORGOT;	SAY WE GOT CORE
	ORM	B,BITS(PNT)
	POP	P,PNT
	POP	P,C
	NOSEC
	POPJ	P,		;GO AWAY.


STRCOP:	HRRZ	C,-1(SP)		;COUNT
	ADDI	C,2*5+4		;ENOUGH FOR BYTE PS.
	IDIVI	C,5
	PUSHJ	P,CORE2		;GET CORE
	ERR	<NO CORE FOR MESSAGE>,1
	MOVE	TAC1,-2(P)	;SINCE CORE2 CLOBBERED.
	HRRZ	C,-1(SP)	;COUNT
	MOVEM	C,(B)		;FIRST WORD OF BYTE P.
	HRLI	D,(<POINT 7,0>)
	HRRI	D,2(B)
	MOVEM	D,1(B)		;SECOND WORD.
	SOJL	C,STDQ		;COUNT DOWN COUNT.
	ILDB	(SP)
	IDPB	D
	JRST	.-3
STDQ:	TLO	TAC1,CORGOT	;GOT CORE.
	HRLZI 	D,GOTCOR	;SAY WE GOT CORE
	ORM	D,BITS(PNT)
	MOVE	D,B
	MOVE	A,B		;FOR COPY
	SUB	SP,X22		;ADJUST STACK.
	POPJ	P,

REFRNG:				;REFERENCE VARIABLES.
	TRNE	A,400000	;GLOBAL ALREADY?
	JRST	COPY		;YES -- PASS ON.
	TLNE	TAC1,SBSCRP	;AN ARRAY?
	JRST	ARRYS		;YES -- COPY IT.
	TRNE	TAC1,STRING	;OH GOD.
	JRST	[PUSH	SP,-1(A) ;FIRST WORD OF BYTE P.
		 PUSH	SP,(A)
		 PUSHJ	P,STRCOP
		 TLO	TAC1,STRREF;STRING BY REFERENCE.
		 JRST	COPY]
	MOVE	C,PARCNT(PNT)	;OK. FUDGE UP A PLACE FOR THE REFERENCE.
	MOVE	D,(A)		;D NOW HAS THE ARGUMENT.
	HRRI	A,3(C)		;A NOW POINTS TO THE DATUM BLOCK FOR THIS PARAM
	TRNN	TAC1,SET	;IF NOT GLOBAL SET,
	JRST	COPY
	PUSHJ	P,CHKSET	;CHECK THE SET, AND RECOPY IF NECESSARY.
	MOVEI	A,3(C)		;RE ESTABLISH THE REFERENCE.
	JRST	COPY
ARRYS:	TRNE	TAC1,SET!STRING
	ERR	<MESSAGE: THESE ARRAYS TOO COMPLICATED>,1,RETIT
	SETOM	USCOR2(USER)	;WE WILL NEED CORE.
	PUSH	P,A		;ARRAY
;;#HO#! 6-7-72 DCS (1-2) ..ARCOP PROVIDES CORGET ADDR IN B
	PUSHJ	P,..ARCOP	;COPY THE ARRAY IN -1(P)
	SETZM	USCOR2(USER)
	MOVE	TAC1,-1(P)	;GET IT BACK.
	TLO	TAC1,CORGOT	;MARK FOR RELEASING
	HRLZI	C,GOTCOR	;SAY WE GOT CORE
	ORM	C,BITS(PNT)
;;#HO#! 6-7-72 DCS (2-2) PROVIDE CORGET ADDR TO PARAM BLOCK
	MOVE	D,B		;CORGET BLOCK ADDR RETURNED BY ..ARCOP
;	JRST	COPY


COPY:	AOS	C,PARCNT(PNT)	;INDEX COUNT
	MOVEM	A,(C)		;ARGUMENT (WILL BE PUSHED).
	AOS	C,PARCNT(PNT)
	MOVEM	TAC1,(C)	;TBITS,
	AOS	C,PARCNT(PNT)
	HRRZM	D,(C)		;OTHER POINTER
	CAILE	C,PAREND(PNT)	;GONE OFF END ??
	ERR	<MESSAGE: TOO MANY PARAMS>,1
RETIT:	MOVE	LPSA,X33
	JRST	RESTR


;NOW FOR THE MAIN "DOIT" CODE.  THE ENTRY IS WITH:
; A ::: DIRECTIVE
; B ::: POINTS TO MESSAGE (OPTIONAL)
; C ::: UNIQUE NUMBER OF MESSAGE


QDOIT:	MOVE	USER,GOGTAB
	TRNE	A,DSEND		;SEND THE MESSAGE??
	PUSHJ	P,SENDIT
	TRNE	A,DWAIT	;WAIT FOR COMPLETION?
	PUSHJ	P,WAITC
	TRNE	A,DFIND		;IS THIS GET!ENTRY?
	PUSHJ	P,FIND1
	TRNE	A,DACT		;ACTIVATE
	PUSHJ	P,ACTIV
	TRNE	A,DACK		;ACKNOWLEDGE
	PUSHJ	P,ACKIT
	TRNE	A,DKILL
	PUSHJ	P,KILLIT
	MOVE	A,RACS+1(USER)
	POPJ	P,
SENDIT:	TRNN	A,DNOTRACE	;IF NOT TRACING THIS MESSAGE, OR
	SKIPN	TRACING		;NOT TRACING
	 JRST	 GGSEND		;DO IT.
	PUSH	P,A
	PUSH	P,C
	QENT
	PUSHJ 	P,FNDMES	;FIND MESSAGE 	*** KKP HAS MODIFIED THIS CODE ****
	JRST [	POP P,C
		POP P,A
		JRST ALD1]	;NO SUCH MESSAGE
	PUSH	P,B		;SAVE POINTER TO MESSAGE
	PUSHJ	P,.MES3		;START MESSAGE, PNTR IN B
	MOVEI	C,6		;TWO PARAMETERS
	ADDB	C,PARCNT(B)
	MOVE	A,-1(P)		;NUMBER OF MESSAGE BEING TRACED.
	MOVEM	A,-5(C)		;STORE AWAY IN MESSAGE BLOCK.
	CALLI	A,23		;MILLISECOND
	MOVEM	A,(C)		;TIME OF DAY.
	SETZM	PARBEG+3(B)	;CLEAR ARGUMENT COUNT
	MOVEI	A,-2(C)		;STORE POINTER TO ITSELF
	MOVEM	A,-2(C)		;THIS ALLOWS HE TO FIND REST OF INFO
	POP	P,PNT		;GET POINTER TO MESSAGE
	MOVEI	D,PARBEG+1(PNT)	;SET TO START OF ARGUMENTS IN MESSAGE
ARGLOP:	CAML	D,PARCNT(PNT)	;CHECK FOR END OF ARGUMENTS
	JRST 	ARGEND
	AOS	PARBEG+3(B)	;INDEX ARGUMENT COUNT
	MOVE	A,1(D)		;GET SOME GOOD BITS
	MOVEM	A,2(C)		;AND STORE IN TRACE
	TDNE	A,[XWD SBSCRP,ITMVAR!ITEM!LPARRAY!SET!LABEL]
	JRST	ARGIND		;DO NOT STORE THESE ARGUMENTS
	MOVE	TAC1,(D);	GET ARGUMENT
	TLNE	A,STRREF	;IF REFERENCE STRING - OK
	JRST	.+3
	TLNE 	A,REFRNC;	;BY REFERENCE?
	MOVE	TAC1,(TAC1)	;YES, GET REAL ARGUMENT
	MOVEM	TAC1,1(C)	;STORE IN TRACE
ARGIND:	ADDI	D,3		;INDEX POINTER FOR NEXT ARGUMENT
	ADDI	C,2
	JRST	ARGLOP
ARGEND:	QLEV
	PUSH	P,[DSEND+DWAIT+DKILL+DNOTRACE];		*********************
	PUSH	SP,[0]		;THE ABOVE KLUDGE CAN BE UNDERSTOOD BY HE (AND ONLY HE)
	PUSH	SP,[0]		;SOURCE.....
	PUSH	SP,[5]
	PUSH	SP,[POINT 7,GODNAM]
	PUSH	SP,[5]
	PUSH	SP,[POINT 7,TRACNAM]
	PUSHJ	P,ISSUE		;DO IT.
	POP	P,C
	POP	P,A		;AND FINALLY SEND THE REAL MESSAGE.
GGSEND:	QENT
	PUSHJ	P,FNDMES	;FIND THE MESSAGE
	 JRST	 ALD1		;DISAPPEARED - FORGET ABOUT IT
	MOVSI	D,SENT		;TURN ON THE BIT.
	TRZE	A,DKILL		;IF HE ASKS TO KILL,
	 TLO	 D,KILL		;MARK FOR KILLING LATER.
	TLO	B,-1		;FLAG TO SEE IF DESTINATION LOCATED.
	IORM	D,BITS(B)
	MOVE	D,JOBCNT	;NOW GO THROUGH THE TABLE, SENDING
	TRNE	A,DNOACT	;IF NOT ACTIVATE, ALL DONE.
	 JRST	 QLD2
AG1:	SOJL	D,ALD1		;MAIL TO EVERYONE WHO IS IN MAIL WAIT.
	MOVE	PNT,IDEST(B)	;FIRST WORD OF LOGICAL DESTINATION.
	CAME	PNT,DESTAB(D)	;SAME AS STATED ?
	JRST	AG1		;NO
	MOVE	PNT,IDEST+1(B)	;
	CAME	PNT,DESTB1(D)	;AND SECOND WORD.
	JRST	AG1
	TLZ	B,-1		;DESTINATION FOUND.
	SKIPL	LPSA,JOBTAB(D)	;IN WAIT??
	JRST	ALD1		;NO
	HRRZS	LPSA
	MAIL	4,LPSA		;SEE IF HE ALREADY HAS MAIL WAITING.
	SKIPA			;NO -- SEND SOME.
	JRST	ALD1		;..
	EXCH	LPSA,A		;GET JOB # IN A.
				;B HAS ADDRESS OF A FINE 32 WORD BLOCK.
;*** TEMPORARY ONLY
	PUSH	P,B
	MOVEI	B,0
;***
	MAIL	A		;SEND MAIL TO JOB NUMBER.....
MSER:	JRST [	QLEV
		ERR	<MAIL SCREW>,1]
;****
	POP	P,B
;****
	EXCH	A,LPSA
	JRST	AG1		;BACK FOR MORE.

ALD1:	QLEV
	TLNE	B,-1
	ERR	<MESSAGE: NO SUCH DESTINATION>,1
	POPJ	P,

GODNAM:
TRACNAM: ASCII /TRACE/
WAITC:	QENT
	PUSHJ	P,FNDMES
	JRST	ALD1		;MESSAGE HAS DISAPPEARED, ASSUME ACK.
	MOVE	D,BITS(B)	;GET HIS BITS.
	TLNE	D,ACK		;ACKNOWLEDGED.
	JRST	DON		;YES -- OK.
	MOVSI	D,WAIT		;WE WILL GO INTO MAIL WAIT.
	IORB	D,BITS(B)	;
;*** BUG TRAP ***
	GETJOB	(B)		;GET JOB NUMBER IN B.
	MOVE	D,JOBCNT
	SOJL	D,ALDX
	SKIPL	LPSA,JOBTAB(D)
	JRST	.-2		;
	CAIE	B,(LPSA)		;ARE WE IN THIS KIND OF WAIT
	JRST	.-4		;NO -- NOT US
	MOVE	TAC1,JOBTAB(D);	ARE WE REALLY WAITING? ******KKP INSERT
	TLNE	TAC1,1
	JRST [	QLEV
		OUTSTR [ASCIZ .MAIL WAIT CONFLICT
. ]						; YES - CAN'T HAPPEN
		JRST .+1]			;BUT GO ON ANYWAY-MAYBE WE RESTARTED
	HRRZS	JOBTAB(D);	NO - WE WERE IN INTERRUPT MODE  ************
ALDX:	QLEV			;GOING
				;WAIT FOR MAIL AND SEE IF THIS IS THE ONE.
	MAIL	1,1(P)		;A PLACE TO THROW MAIL		
	JRST	WAITC		;AND DO IT AGAIN.
DON:	TLNE	D,KILL		;IS THIS GUY TO BE KILLED??
	TRO	A,DKILL		;YES- DO THAT NEXT.
QLD2:	QLEV
	POPJ	P,

; *****						*****
; *****						*****

FIND1:	PUSHJ	P,GETSTR	;GET THE STRINGS.
	GETJOB	(0)		;GET JOB NUMBER IN 0.
DF1:	QENT
	SKIPA	D,MESQ		;LOOK INTO CURRENT QUEUE
NEXQ:	HRRZ	D,PNTR(D)	;GO DOWN QUEUE
	JUMPE	D,QFIN		;DONE
	MOVE	LPSA,BITS(D)	;GET GOOD BITS.
	TRNE	A,DEVERY	;LOOK AT EVERY MESSAGE?
	 JRST	 TESR		;YES
	TLNE	LPSA,SENT		;ONLY IF SEND
	TLNE	LPSA,ACT!ACK	;AND NOT ALREADY PROCESSED.
	 JRST	 NEXQ		;NOT THIS ONE.
TESR:
	MOVE	LPSA,INAME(D)	;GET PROCEDURE NAME.
	MOVE	PNT,INAME+1(D)	; BOTH WORDS.
	CAMN	LPSA,[ASCII /RESTA/]
	CAME	PNT,[ASCIZ /RT/]
	JRST	TESR1
	QLEV			;LEAVE QUEUE CORRECT.
	MOVE	C,UNIQUE(D)	;GET MESSAGE NUMBER.
	PUSHJ	P,KILLIT	;TAKE AWAY THE MESSAGE.
	MOVE	A,JOBSA
	JRST	(A)		;AND RESTART THE PROGRAM.
TESR1:
DEFINE	COMP(DIR,X,Y) <
	TRNN	A,DIR
	JRST	.+7
	MOVE	LPSA,-Y-1(SP)	;FIRST WORD OF NAME.
	CAME	LPSA,X(D)
	JRST	NEXQ		;FAIL
	MOVE	LPSA,-Y(SP)
	CAME	LPSA,X+1(D)
	JRST	NEXQ
	>

	COMP	(DSOURCE,ISOURCE,4)
	COMP	(DDEST,IDEST,2)
	COMP	(DNAME,INAME,0)

	MOVE	C,UNIQUE(D)	;THE NUMBER
NOJXX:	MOVEM	C,RACS+1(USER)	;..ANSWER
	
	MOVE	D,JOBCNT
TT2:	SOJL	D,NOJB1		;ALL DONE.
	SKIPL	LPSA,JOBTAB(D)	;GET JOB NUMBER
	JRST	TT2
	CAIE	(LPSA)		;SAME AS US ?
	JRST	TT2
	HRRZS	JOBTAB(D)	;SAY WE ARE NO LONGER WAITING.

	MAIL	2,1(P)		;READ MAIL IF ANY IS THERE.
	JFCL

NOJB1:	QLEV
	POPJ	P,
QFIN:	TRNN	A,DWAITM
	JRST	[MOVEI	C,0
		JRST	NOJXX]
	MOVE	D,JOBCNT
TT3:	SOJL	D,[	QLEV
			ERR <WHO ARE YOU??>,1,TTY5+1]
	HRRZ	LPSA,JOBTAB(D)
	CAIE	(LPSA)		;US ?
	JRST	TT3
TT4:	HRROM	JOBTAB(D)	;SAY WE ARE WAITING FOR MAIL.
TTY5:	QLEV
	TRNE	A,DRETURN	;**** KKP ADDITION
	JRST [	HRLZI TAC1,1	;SET INTERRUPT MODE FLAG
		ANDCAM TAC1,JOBTAB(D)
		SETZM RACS+1(USER)	;NO MESSAGE READY
		POPJ P,]	;RETURN ANYWAY - FOR USE WITH INTERRUPT ROUTINE ********
	MAIL	1,1(P)		;WAIT FOR MAIL.
	JRST	DF1

ACTIV:	QENT
	PUSHJ	P,FNDMES	;LOCATE THE MESSAGE.
	 JRST	 ALD1		;SORRY - NO CAN DO
	MOVE	LPSA,INAME(B)	;GET THE NAME
	MOVE	PNT,INAME+1(B)	;AND THE SECOND PART OF THE NAME.
	MOVE	D,SPLNK(USER)	;SPACE ALLOCATION.
QT1:	SKIPL	FP,$MSLNK(D)	;MESSAGE PROCEDURE HOME.
	JRST	QT2		;NO MESSAGE PROCEDURES IN THIS PROGRAM.
TEST:	CAMN	LPSA,2(FP)
	CAME	PNT,3(FP)	;SAME PROCEDURE??
	JRST	[HRRZ	FP,(FP) ;GO TO NEXT PROCEDURE
		 JUMPN	FP,TEST
QT2:		 HRRZ	D,(D)
		 JUMPN	D,QT1
		 JRST	[SETZM	RACS+1(USER)
			QLEV
			 POPJ	P,]
		]
	HRRZ	FP,1(FP)		;ADDRESS OF PROCEDURE.
	PUSH	P,C		;UNIQUE NUMBER
	PUSH	P,A		;DIRECTIVE.
	MOVEI	LPSA,PARBEG(B)	;START OF PARAMETERS.
T3:	CAML	LPSA,PARCNT(B)
	JRST	CALLIT		;ALREADY TO GO.
	MOVE	A,2(LPSA)		;GOOD BITS WORD.
	TRNE	A,STRING	;WAS IT A STRING??
	JRST	[MOVE	D,1(LPSA)	; PNT TO  FIRST WORD OF STRING DESC.
;;#GI# DCS 2-5-72 REMOVE TOPSTR, FIX STRNGC BUG
		 PUSH	P,A	;SAVE
		 MOVE	A,(D)	;COUNT -- MUST BE IN A FOR GC
;;  #GI#   WAS USING C!
		 ADDM A,REMCHR(USER)
		 SKIPLE REMCHR(USER)
		 PUSHJ	P,STRNGC
		 PUSH	SP,A		;FIRST WORD OF RESULT
		 HRROS	(SP)		;NON-CONSTANT
		 PUSH	SP,TOPBYTE(USER); AND SECOND.
STRRZ:		 SOJL	A,STRR
		 ILDB	1(D)		;GET A CHAR
		 IDPB	TOPBYTE(USER)	;AND ANOTHER.
		 JRST	STRRZ
STRR:		 POP	P,A		;GET BITS BACK
;;#GI#
		 TLNN	A,REFRNC	;REFERENCE ?
		 JRST	.+2		;NO -- GO AWAY.
		 POP	SP,1(D)		;SAVE IN SEC. SEG.
		 POP	SP,(D)		;...
		 AOS	D		;POINT TO SEC WORD OF BP.
		 PUSH	P,D		;AND A POINTER.
		 JRST	.+2]
	PUSH	P,1(LPSA)			;ARGUMENT.
	ADDI	LPSA,3
	JRST	T3		;AND LOOP
CALLIT:	QLEV
	PUSHJ	P,(FP)		;CALL THE PROCEDURE.
	MOVE	USER,GOGTAB
	QENT
	MOVE	C,-1(P)		;GET UNIQUE NUMBER
	PUSHJ P,FNDMES		;GET MESSAGE AGAIN (DON'T LOCK OUT JOBS DURING MESSAGE ACTIVATION)
	JRST [	QLEV
		OUTSTR [ASCIZ .YOUR MESSAGE HAS DISAPPEARED
.]
		JRST OLDT]
	MOVE	D,BITS(B)	;TURN OFF CORE BIT
	TLZ	D,GOTCOR
	MOVEM	D,BITS(B)
	MOVEI	D,PARBEG(B)
T4:	CAML	D,PARCNT(B)
	JRST	OLDTT		;DONE
	MOVE	A,2(D)		;TBITS WORD
	TLNN	A,CORGOT
	JRST	T5
	PUSH	P,B
	MOVE	B,3(D)
	PUSHJ	P,CORREL	;RELEASE IT.
	POP	P,B
T5:	TLNN	A,SETRECLM
	JRST	T6
	MOVSI	FLAG,GLBSRC
	WRITSEC			;FIDDLE WYTH LEAP FREE STORAGE
	MOVE	FP,FP1+GLUSER
	MOVE	TAC1,3(D)		;.. SET.
	HLRZ	LPSA,(TAC1)
	HRRM	FP,(LPSA)
	MOVEM	TAC1,FP1+GLUSER
	NOSEC			;DONE WITH FREE STORAGE.

T6:	ADDI	D,3		;LOOP
	JRST	T4

OLDTT:	QLEV
OLDT:	POP	P,A
	POP	P,C
	POPJ	P,

ACKIT:	QENT
	PUSHJ	P,FNDMES
	 JRST	 ALD1;		IF SOMEONE WAS IS WAIT, HE IS HUNG FOR GOOD
	MOVE	D,BITS(B)	;GET THE GOOD BITS.
	TLZ	D,SENT		;TURN OFF SO ANOTHER GET ENTRY DOESN'T
	TLO	D,ACK		;SEE IT -- ALSO ACKNOWLEDGE.
	MOVEM	D,BITS(B)
	TLNN	D,WAIT		;WAS THERE SOMEONE INWAIT??
	JRST	[TLNE	D,KILL	;IF IT WAS MARKED FOR KILLING, THEN
		 TRO	A,DKILL	;KILL IT NOW.
		 JRST	T7]
	PUSH	P,A		;SAVE A.
	HRRZ	A,D		;GET JOB NUMBER ONLY.
	MAIL	4,A		;SEE IF HE HAS MAIL WAITING.
	SKIPA			;NO -- OK.
	JRST 	MSER
;*** TEMPORARY
	PUSH	P,B
	MOVEI	B,2
;***
	MAIL	A		;SEND MAIL TO HIM......
	JRST	MSER
;***
	POP	P,B
;***
	POP	P,A
T7:	QLEV			;ALL DONE.
	POPJ	P,
KILLIT:	QENT
	PUSHJ	P,FNDMES
	JRST	ALD1
	MOVE	C,BITS(B)
	TLNE	C,GOTCOR	;WAS CORE RELEASED FOR THIS MESSAGE
	JRST [	QLEV
		ERR <MESSAGE SNATCHER!!>,1,KILLAB]
	HRRZ	C,(B)		;LINK DOWN LIST
	HRRZM	C,(LPSA)		;PATCH US OUT.....
	QLEV
	JRST	CORREL		;RELEASE CORE.


; *****						*****
; *****						*****


;SERVICE ROUTINES.....

GETSTR:	MOVEI	D,-5(SP)	;DCS -- FIX OFLOW PROBLEM AFTER 6 CHARS
	PUSHJ	P,GET10
	MOVEI	D,-3(SP)
	PUSHJ	P,GET10
	MOVEI	D,-1(SP)
;	JRST 	GET10

GET10:	MOVE	FP,1(D)		;BYTE POINTER.
	MOVE	LPSA,[POINT 7,(D)]
	HRRZ	TABL,(D)	;COUNT.
	CAILE	TABL,=10
	MOVEI	TABL,=10
	SETZM	(D)
	SETZM	1(D)		;ZERO THE TARGETS
	SOJL	TABL,CPOPJ
	ILDB	FP
	IDPB	LPSA
	JRST	.-3


FNDMES:	MOVEI	LPSA,MESQ	;ALWAYS CALLED WITH LOCK SET
	AOS	(P)
ANOMES:	MOVE	B,(LPSA)		;GO DOWN LIST
	JUMPE	B,NOMES
	CAMN	C,UNIQUE(B)
	JRST	[MOVEM	C,RACS+1(USER)
		 POPJ	P,]
	HRRZ	LPSA,B
	JUMPN	LPSA,ANOMES
NOMES:	SOS	(P)
	SETZM	RACS+1(USER)
KILLAB:	POPJ	P,
; *****						*****
; *****						*****


HERE (ISSUE)				;A REAL RUNTIME ROUTINE.
	PUSHJ	P,GETSTR	;GET STRINGS.
	MOVE	B,CURMES(USER)
	HRLI	C,-5(SP)
	HRRI	C,ISOURCE(B)
	BLT	C,INAME+1(B)	;BLT IN STRINGS.
	SUB	SP,[XWD 6,6]
	AOS	C,UNIQ		;NEW NUMBER
	MOVEM	C,UNIQUE(B)
	QENT			;PREPARE TO PUT IN QUEUE.
	MOVEI	D,MESQ		;
	MOVEI	E,(D)
	HRRZ	D,PNTR(D)	;GO DOWN LIST.
	JUMPN	D,.-2		;UNTIL END.
	HRRM	B,PNTR(E)
	QLEV
	SETZM	CURMES(USER)	;RESET THIS.
	MOVE	A,-1(P)		;DIRECTIVE......
	ANDI	A,DSEND!DWAIT!DKILL!DNOTRACE
	TRNN	A,DSEND		;IF HE DID NOT ASK TO SEND,
	 SKIPA 	 A,C		;THEN JUST RETURN THE UNIQUE NUMBER.
	PUSHJ	P,QDOIT		;GO TO IT.
	SUB	P,X22
	JRST	@2(P)		;GO AWAY.


HERE (QUEUE)			;AND ANOTHER ROUTINE.
	MOVE	C,-1(P)		;UNIQUE NUMBER
	MOVE	A,-2(P)		;DIRECTIVE
	ANDI	A,DSEND!DWAIT!DACK!DACT!DKILL
	JUMPE	A,[ERR <NO DIRECTIVE>,1,QU2]
	PUSHJ	P,QDOIT
QU2:	MOVE	A,RACS+1(USER)	;.....GULP.....
	SUB	P,X33
	JRST	@3(P)		;GO AWAY.
HERE (GET.DATA)
	MOVE	USER,GOGTAB	;OH YES.
	MOVE	C,-1(P)		;UNIQUE NUMBER
	QENT
	PUSHJ	P,FNDMES
	JRST	[ADD	SP,X22	;NULL STRING RESULT
		 SETZM	-1(SP)
		 JRST	ALDON]
;;#GI# DCS 2-5-72 REMOVE TOPSTR, FIX SOME STRNGC BUGS
;; #GI# CHAR COUNT MUSTMUSTMUST BE IN A WHEN STRNGC CALLED
	MOVE	A,B		;QUEUE BLOCK POINTER
	MOVE	B,-2(P)
	ANDI	B,3
	LSH	B,1		;NOW READY FOR INDEX.
	ADDI	B,ISOURCE-2(A)
	HRLI	B,(<POINT 7,0>) ;TO GET BYTES.

	MOVEI	A,=10
	ADDM	A,REMCHR(USER)
	SKIPLE	REMCHR(USER)
	PUSHJ	P,STRNGC
	PUSH	SP,[0]		;START HERE
	PUSH	SP,TOPBYTE(USER)

LOPJ:	ILDB	B		;Queue names are a maximum of two
	JUMPE	ALDON		; words long.  Transfer all of them
	IDPB	TOPBYTE(USER)	; to the string (null indicates end).
	SOJGE	A,LOPJ		;A=max# chars left
ALDON:	MOVN	A,A		;Replace number of chars left in REMCHR.
	ADDM	A,REMCHR(USER)
	ADDI	A,=10		;10-#left=#used
	HRROM	A,-1(SP)	;Non-constant string, this long
	QLEV
	SUB	P,X33
	JRST	@3(P)		;GO AWAY

HERE (PUT.DATA)			;PUT A STRING IN.
	MOVE	USER,GOGTAB
	MOVEI	D,-1(SP)
	PUSHJ	P,GET10
	SKIPGE -2(P)
	JRST [	MOVE C,-1(P);	KILL JOB
		MOVE D,JOBCNT
		POP SP,TAC1;	FLUSH GARBAGE
		POP SP,TAC2
NXXQ:		SOJL D,PUTQQ
		MOVE B,JOBTAB(D)
		CAIE C,(B);	FIND TABLE ENTRY
		JRST NXXQ
XX1:		AOS D;		REMOVE TABLE ENTRY
		CAML D,JOBCNT
		JRST [	SOS JOBCNT
			JRST PUTQQ]
		MOVE C,JOBTAB(D)
		MOVEM C,JOBTAB-1(D)
		MOVE C,DESTAB(D)
		MOVEM C,DESTAB-1(D)
		MOVE C,DESTB1(D)
		MOVEM C,DESTB1-1(D)
		JRST XX1]
	SKIPG	C,-1(P)
	JRST	[GETJOB (0)	;JOB NUMBER IN ZERO.
		SETZM B
		POP SP,TAC1
		POP SP,TAC2
		SKIPG C,VERS;		TEST FOR VERSION #
		JRST [	HRRZ C,JOBVER;	INITIALIZE
			CAILE C,1000;	NONE GIVEN
			SETZM C
			MOVEM C,VERS
			JRST NXTLAB]
NXTLAB:		HRRZ D,JOBVER;		GET CURRENT JOBS VERSION
		CAILE D,1000
		SETZM D;		ZERO IF NONE
		CAIE C,(D);		THEY MUST AGREE
		JRST [
NOSEG:			MOVEM TAC2,DESTB1+NJOB-2;
			MOVEM TAC1,DESTB1+NJOB-1
			OUTSTR DESTB1+NJOB-2
			CAIG C,(D)
			ERR < - VERSION # TOO HIGH>,0
			ERR < - VERSION # TOO LOW>,0]
		MOVE	D,JOBCNT
NOXQ:		SOJL	D,[JUMPN B,PUTQQ;		FOUND NAME
			   QENT;			LETS PLAY SAFE HERE
			   AOS D,JOBCNT
			   SUBI	D,1
			   CAILE D,NJOB
			   JRST [ SOS JOBCNT
				  QLEV
				  ERR <TOO MANY JOBS>,1,PUTQQ]
			   HRRZM JOBTAB(D) ;JOB NUMBER RECORDED.
			   QLEV
			   JRST PUTXX]
		MOVE	C,JOBTAB(D)
		CAIN	(C)	;SAME AS US??
		JRST	PUTXX	;YES -- STORE
		CAMN	TAC2,DESTAB(D);		TEST FOR ALREADY DEFINED
		CAME	TAC1,DESTB1(D)
		CAIA
		JRST [	ERR	<LOGICAL NAME ALREADY DEFINED>,1,PUTZZ
PUTZZ:			MOVEM JOBTAB(D)
			SETOM B;	BUT REDEFINE IF FORCED TO
			JRST	NOXQ]
		JRST	NOXQ

PUTXX:		MOVEM	TAC1,DESTB1(D)
		MOVEM	TAC2,DESTAB(D)	;FILL LOGICAL NAME TABLES.
		SETOM	B
		JRST	NOXQ]
	QENT
	PUSHJ	P,FNDMES	;FIND IT
	JRST	[MOVEI A,0
		 JRST GOXX]
	MOVE	A,-2(P)
	ANDI	A,3
	LSH	A,1
	ADDI	A,ISOURCE-2(B)
GOXX:	POP	SP,1(A)		;PUT THE CHARACTERS DOWN.
	POP	SP,(A)
	QLEV
PUTQQ:	SUB	P,X33
	JRST	@3(P)



HERE (GET.ENTRY)		;ANOTHER ROUTINE
	MOVE	A,-1(P)
	ANDI	A,DWAITM!DSOURCE!DDEST!DNAME!DRETURN
	JUMPE	A,[ERR <NO GET!ENTRY DIRECTIVE>,1,GETT4]
	TRO	A,DFIND
	PUSHJ	P,QDOIT
GETT4:	SUB	P,X22
	SUB	SP,[XWD 6,6]
	JRST	@2(P)


HERE (GET.SET)
	MOVE	USER,GOGTAB
	PUSH	P,[0]		;NULL SET.
	MOVE	A,-2(P)		;DIRECTIVE......
	PUSHJ	P,FIND1		;GET STRINGS, LOOK FOR A MATCH.
				;IF NONE, THEN WAIT IF DWAITM SET.
	PUSH	P,RACS+1(USER)	;SAVE FOR CHAINING.
MORST:	SKIPN	RACS+1(USER)
	 JRST	 NOMORQ
	PUSH	P,RACS+1(USER)	;RESULT.
	MOVEI	TAC1,-2(P)	;...
	MOVEI	FLAG,47		;TO PUT IN SET
	PUSHJ	P,LEAP		;PUT IT IN SET.
	MOVEI	A,DWAITM
	ANDCAB	A,-3(P)		;TO DIRECTIVE.
	POP	P,C		;UNIQUE NUMBER LAST FOUND.
	QENT
	PUSHJ	P,FNDMES	;GET ADDRESS IN B.
	ERR	<MESSAGE: CONFUSION>,1
	MOVEI	D,(B)		;COPY
	GETJOB	(0)
	PUSHJ	P,NEXQ		;AND LOOK FOR NEXT ONE. LOCK RELEASED IN SUBR
	PUSH	P,RACS+1(USER)	;SAVE UNIQUE NUMBER.
	 JRST	 MORST
NOMORQ:	POP	P,(P)		;LAST RESULT.
	SKIPN	MAXITM(USER)
	ERR	<GET!SET: NEED LEAP INITIALIZATION>,1
	POP	P,A		;THE SET
	SUB	P,X22
	SUB	SP,[XWD 6,6]
	JRST	@2(P)

HERE (GET.BIT) 
	MOVE	USER,GOGTAB
	MOVE	C,-1(P)		;GET GOOD BITS FROM MESSAGE
	QENT
	PUSHJ	P,FNDMES	;FIND THE MESSAGE
	SKIPA	A,[0]
	HLRZ	A,BITS(B)	;GET THE LEFT HALF TO THE RIGHT HALF.
	QLEV
	SUB	P,X22
	JRST	@2(P)


>;GLOB
>;NOEXPO