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

00100	COMMENT ⊗HISTORY
00200	AUTHOR,REASON
00300	021  201700000014  ⊗;
00400	
00500	
00600	COMMENT ⊗
00700	VERSION 15-2(12) 6-8-72 BY DCS BUG #GI# FIX THE #GI# BUG FIX CODE IN GET.DATA
00800	VERSION 15-2(11) 6-7-72 BY DCS BUG #HO# RIGHT ADDRESS TO MESPRO PARAM BLOCK
00900	VERSION 15-2(10) 4-28-72 BY JRL CHANGE TO NEW LEAP CALLING CONVENTIONS
01000	VERSION 15-2(9) 3-21-72 BY JRL CHANGE LEAP INTERLOCKS
01100	VERSION 15-2(8) 3-6-72 BY JRL REMOVE ARRPDP REFERENCES
01200	VERSION 15-2(6) 3-6-72 BY JRL DELETE TYPE BITS FROM COMPILER
01300	VERSION 15-2(4) 3-3-72 BY KKP BUG IN SET RELEASE CODE FOR ACTIVATE
01400	VERSION 15-2(3) 2-5-72 BY DCS BUG #GI# REMOVE TOPSTR, FIX STRNGC BUGS
01500	VERSION 15-2(2) 2-1-72 BY DCS ?
01600	VERSION 15-2(1) 12-24-71 BY DCS BUG #FS# INSTALL VERSION NUMBER, REMOVE SAILRUN
01700	
01800	⊗;
     

00100	
00200		LSTON	(MESPRO)
00300	NOEXPO <
00400	GLOB <
00500	COMMENT ⊗
00600	
00700	These are the routines for passing messages back and forth in
00800	the second segment.  The history of a message is some subset of
00900	the following sequence:
01000		1. message is composed.
01100		2. message is put in queue
01200		3. message is "sent"
01300		4. we wait for completion of the message.
01400		5. we activate the message (call the procedure)
01500		6. we acknowledge the processing of the message
01600		7. we kill the message
01700	
01800	There are in addition, several things that we may want to do
01900	to find out about the status of the queue, etc.
02000	
02100	ISSUE (directive,source name,dest. name, MESSAGE foo(param list));
02200	
02300	This returns an integer value which is the unique number associated
02400	with the queue entry made for this message.
02500	The legal things to mention in the directive are: DSEND,DWAIT.
02600	
02700	
02800	QUEUE (directive,unique number)
02900	
03000	This is for processing things in the queue already.  The legal bits
03100	in the directive are DSEND,DWAIT,DKILL,DACT,DACK.
03200	
03300	
03400	string ← GET_DATA (directive,unique number)
03500		 PUT_DATA (directive,unique number)
03600	
03700	These get and put the string entries (source,dest,proc name) in the
03800	blocks.  Directive is 1 for source, 2 for dest, 3 for proc name.
03900	
04000	
04100	integer ← GET_ENTRY (directive,source,destination,proc name)
04200	
04300	This searches the queue for an entry of the appropriate type.
04400	The directive bits say which strings we are interested in.
04500	Legal directive bits are DSOURCE,DDEST,DNAME,DWAITM.
04600	DWAITM says -- if there is not one, wait for it.  If integer is
04700	zero, no entry was found.
04800	
04900	
05000	
05100	⊗
     

00100	;FIRST THE INDICES INTO THE MESSAGE BLOCKS PASSED AROUND.
00200	
00300	MAXPAR ←← 6		;MAXIMUM NUMBER OF PARAMETERS.
00400		PNTR ←←0	;RH HAS POINTER TO NEXT QUEUE ENTRY.
00500		BITS←←1		;LH HAS GOOD BITS ABOUT THIS MESSAGE.
00600				;RH HAS JOB NUMBER THAT SENT IT.
00700		UNIQUE←←2	;THIS IS WHERE THE UNIQUE NUMBER IS STORED..
00800		ISOURCE←←3	;TWO WORDS FOR SOURCE NAME (10 CHARS)
00900		IDEST←←5	; AND DESTINATION
01000		INAME←←7	; AND PROCEDURE NAME.
01100		PARCNT←←11	;PLACE FOR COUNT OF AMOUNT OF PARAMETER BLOCK
01200				;  USED TO DATE.
01300		PARBEG←←11	;1 AHEAD OF BEGINNING OF PARAMETER AREA.
01400		PAREND←←PARBEG+3*MAXPAR ;3 WORDS PER PARAMETER ENTRY.
01500	
01600	MESBLK ←←PAREND+1 	;LENGTH OF MESSAGE BLOCK.
01700	
01800	
01900	;NOW THE DIRECTIVE BITS.  ALL ARE ASSUMED RIGHT HALF IN DIRECTIVE.
02000	
02100		DSEND←←1	;SEND THE MESSAGE.
02200		DWAIT←←2	;WAIT FOR COMPLETION.
02300		DKILL←←4	;KILL THE MESSAGE.
02400		DSOURCE←←10	; MASK FOR GET_ENTRY
02500		DDEST←←20	;  "
02600		DNAME←←40	;  "
02700		DWAITM←←100	; WAIT FOR AN ENTRY TO APPEAR.
02800		DACT←←200	;ACTIVATE THE MESSAGE
02900		DACK←←400	;ACKNOWLEDGE THE MESSAGE.
03000		DFIND←←1000	;THIS IS THE "FIND AND ENTRY" CALL.
03100		DEVERY←←2000	;FOR "FIND" -- LOOK AT EVERY ENTRY, NOT JUST THOS
03200				;"SENT"
03300		DNOACT←←4000	;SEND BUT DO NOT ACTIVATE USER.
03400		DNOTRACE←←10000	;DO NOT TRACE THIS MESSAGE.
03500		DRETURN←←40000	;RETURN REGARDLESS OF DWAITM
03600	
03700	;NOW FOR THE BITS IN THE LH OF BITS WORD.
03800	
03900		SENT ←← 1	;THIS MESSAGE HAS BEEN SENT!
04000		WAIT ←← 2	;SOMEONE IS WAITING FOR THIS MESSAGE
04100				;TO COMPLETE.  HE IS IN MAIL WAIT.
04200		KILL ←← 4	;KILL THIS MESSAGE AFTER ACKNOWLEDGEMENT IS RECD.
04300		ACT  ←← 200	;THIS MESSAGE IS ACTIVE.
04400		ACK ←←  400	;THIS MESSAGE HAS BEEN ACKNOWLEDGED.
04500		GOTCOR ←← 1000	;CORE HAS BEEN GOTTEN WHICH MUST BE RELEASED
04600	
04700	INTERNAL SETFIL, SETDEV
04800	
04900	SETFIL:	0		;	FILE THIS SEGMENT WAS LOADED FROM
05000	SETDEV:	0	;		DEVICE THIS SEGMENT WAS LOADER FROM
     

00100	;NOW THE SEMANTIC BITS COPIED FROM THE COMPILER.
00200	COMMENT ⊗ BITS NOW IN HEAD NO LONGER NEEDED HERE.
00300	
00400		VALUE←←4000	;LEFT HALF WORD
00500		REFRNC←←2000
00600		SBSCRP←1
00700		GLOBL←←200000	;RIGHT HALF WORD
00800		ITMVAR←4000
00900		ITEM←←400
01000		STRING←200
01100		LPARRAY←←100
01200		SET←40
01300		LABEL←←20
01400		FLOTNG←←2
01500		INTEGR←←1
01600	⊗
01700	
01800	;BITS TO BE ADDED TO LEFT HALF OF TBITS FOR OUR USE.
01900		CORGOT←←400000
02000		SETRECLM←←200000
02100		STRREF ←←100000		;STRING BY REFERENCE.
02200	
02300	DEFINE GETJOB (X)
02400		<CALLI	X,30>
02500	
02600	OPDEF	MAIL	[(710000)]
02700	
02800	; NOW FOR SOME ACTUAL STORAGE AREAS....
02900	
03000	MESQ:	0		;HOME FOR THE QUEUE.
03100	QUETCH:	-1		;THE LOCK FOR DIDDLING THE QUEUE.
03200	UNIQ:	0		;THE SOURCE OF UNIQUE NUMBERS.
03300	VERS:	-1		;THE VERSION NUMBER
03400	INTERNAL TRACING
03500	TRACING:	0	;SET BY USER IF TRACING MESSAGES.
03600	
03700	NJOB←←20;		NUMBER OF JOBS ALLOWED
03800	
03900	INTERNAL .JCNT.,.JTAB.,.JD1.,.JD2.
04000	
04100	.JCNT.:
04200	JOBCNT: 0		;THIS IS THE NUMBER OF ENTRIES IN THE FOLLOWING
04300	.JTAB.:
04400	JOBTAB:	BLOCK NJOB	;TABLE.  THIS TABLE HAS (RH) JOB NUMBER, AND 
04500				;HIGH ORDER BIT SET IF THE JOB IS IN MAIL WAIT
04600				;WAITING FOR MESSAGES TO APPEAR IN ITS QUEUE.
04700	.JD1.:
04800	DESTAB: BLOCK NJOB	;ALSO INDEXED BY JOBCNT -- FIRST WORD OF LOGICAL
04900				;DESTINATION NAME.
05000	.JD2.:
05100	DESTB1: BLOCK NJOB	;AND SECOND WORD OF LOGICAL DEST. NAME.
05200		0		;SAVE FOR ERROR OUTPUT - MUST BE AFTER DESTB1
     

00100	;MAGIC MACROS FOR TALKING ABOUT THE LOCKS.
00200	
00300	DEFINE QENT	<AOSE	QUETCH
00400			PUSHJ	P,WAITX	;WAIT FOR IT
00500			>
00600	
00700	DEFINE QLEV	<SOS QUETCH>
00800	
00900	WAITX:	
01000		SOS	QUETCH	;AND BACK UP.
01100		PUSH	P,C		;SAVE AN AC
01200		MOVEI	C,10		;SLEEP FOR 10
01300		CALLI	C,31		;SLEEP SOUNDLY
01400		MOVNI	C,2		
01500		ADDM	C,-1(P)		;BACK UP PC
01600		POP	P,C		;RESTORE AC
01700		POPJ	P,
01800	
01900	
02000	
02100	; FIRST THE ROUTINES FOR COMPOSING A MESSAGE.
02200	
02300	INTERNAL .MES1,.MES2,ISSUE,QUEUE,GET.DATA,PUT.DATA,GET.ENTRY
02400	INTERNAL GET.BIT,GET.SET
02500	
02600	
02700	HERE (.MES1 )			;START A BRAND NEW MESSAGE BLOCK.
02800		PUSHJ	P,SAVE		;AS ALWAYS.
02900		PUSHJ	P,.MES3		;CALL LIKE THIS SO WE CAN USE INTERNALLY
03000	GOA:	MOVE	LPSA,X11	;AND RETURN.
03100		JRST	RESTR
03200	
03300	.MES3:	MOVEI	C,MESBLK	;THIS IS HOW MUCH CORE WE NEED.
03400		MOVEI	TABL,GLUSER	;FORCE CORGZR TO GET SEC SEG CORE.
03500		PUSHJ	P,CORGZR	;AND GET IT ZEROED.
03600		MOVEM	B,CURMES(USER)	;SAVE FOR .MES2
03700		GETJOB	(C)		;GET JOB NUMBER
03800		HRRZM	C,BITS(B)
03900		MOVEI	C,PARBEG(B)	;START UP THE PARAM COUNT.
04000		MOVEM	C,PARCNT(B)
04100		POPJ	P,
     

00100	HERE (.MES2)			;PROCESS ONE PARAMETER.
00200		EXCH	TAC1,(P)	;SAVE TBITS WORD FROM COMPILER.
00300		PUSH	P,TAC1		;THE HORROR IS COMPLETE
00400		PUSHJ	P,SAVE		;AS ALWAYS.
00500		SKIPN	PNT,CURMES(USER)	;SHOULD BE ONE THERE.
00600		ERR	<MESSAGE: CONFUSION>,1
00700		MOVE	TAC1,-1(P)	;TBITS WORD.
00800		MOVE	A,-2(P)		;PARAMETER.
00900		TLNN	TAC1,VALUE	;WAS IT BY VALUE ??
01000		JRST	REFRNG		;NO -- REFERENCE.
01100		TRNE	TAC1,ITEM!ITMVAR	;THESE ??
01200		JRST	[CAIGE A,GBRK	;IS IT A GLOBAL ITEM ?
01300	ITMER:		ERR <MESSAGE: ITEM MUST BE GLOBAL>,1,RETIT
01400			 JRST COPY]	;OK -- GO AHEAD.
01500		TRNE	TAC1,STRING
01600		JRST	[PUSHJ P,STRCOP		;COPY STRING INTO SEC SEG.
01700			 PUSH	P,(P)		;SINCE THERE WAS NO P PARAM.
01800			 JRST	COPY]
01900		TRNN	TAC1,SET	;A SET ?
02000		JRST	COPY		; NO -- MUST BE ARITHMETIC -- OK.
02100		MOVE	D,-2(P)		;THE SET AGAIN
02200		PUSH	P,[COPY]	
02300	CHKSET:	JUMPE	D,CPOPJ		;IF NULL SET, WE ARE OK
02400		HRRZ	D,(D)		;GO DOWN SET TO MAKE SURE ALL ARE
02500	TTZ:	HLRZ	B,(D)		;GLOBAL ITEMS.
02600		CAIGE	B,GBRK		;?
02700		ERR	<MESSAGE: ITEM MUST BE GLOBAL>,1
02800		HRRZ	D,(D)		;AND CONTINUE
02900		JUMPN	D,TTZ
03000		TRNE	A,400000	;IS IT A GLOBAL SET ?
03100		POPJ	P,		;YES -- GO AHEAD.
03200		PUSH	P,C		;SAVE THIS.
03300		PUSH	P,PNT
03400		MOVSI	FLAG,GLBSRC	;...
03500		WRITSEC		;FOOL WITH LEAP RUNTIME ROUTINES.
03600		MOVEI	TABL,GLUSER
03700		PUSH	P,A		;THE SET.
03800		PUSH	P,[0]		;
03900		PUSHJ	P,UNION		;COPY IT....
04000		POP	P,A		;THE RESULT.
04100		HLRE	B,A
04200		MOVMS	B
04300		HRLM	B,A
04400		MOVE	D,A		;AND IN REGISTER D.
04500		MOVE	TAC1,-4(P)	;THE TBITS AGAIN
04600		TLO	TAC1,SETRECLM	;A SET TO BE RECLAIMED.
     

00100		HRLZI	B,CORGOT;	SAY WE GOT CORE
00200		ORM	B,BITS(PNT)
00300		POP	P,PNT
00400		POP	P,C
00500		NOSEC
00600		POPJ	P,		;GO AWAY.
00700	
00800	
00900	STRCOP:	HRRZ	C,-1(SP)		;COUNT
01000		ADDI	C,2*5+4		;ENOUGH FOR BYTE PS.
01100		IDIVI	C,5
01200		PUSHJ	P,CORE2		;GET CORE
01300		ERR	<NO CORE FOR MESSAGE>,1
01400		MOVE	TAC1,-2(P)	;SINCE CORE2 CLOBBERED.
01500		HRRZ	C,-1(SP)	;COUNT
01600		MOVEM	C,(B)		;FIRST WORD OF BYTE P.
01700		HRLI	D,(<POINT 7,0>)
01800		HRRI	D,2(B)
01900		MOVEM	D,1(B)		;SECOND WORD.
02000		SOJL	C,STDQ		;COUNT DOWN COUNT.
02100		ILDB	(SP)
02200		IDPB	D
02300		JRST	.-3
02400	STDQ:	TLO	TAC1,CORGOT	;GOT CORE.
02500		HRLZI 	D,GOTCOR	;SAY WE GOT CORE
02600		ORM	D,BITS(PNT)
02700		MOVE	D,B
02800		MOVE	A,B		;FOR COPY
02900		SUB	SP,X22		;ADJUST STACK.
03000		POPJ	P,
03100	
03200	REFRNG:				;REFERENCE VARIABLES.
03300		TRNE	A,400000	;GLOBAL ALREADY?
03400		JRST	COPY		;YES -- PASS ON.
03500		TLNE	TAC1,SBSCRP	;AN ARRAY?
03600		JRST	ARRYS		;YES -- COPY IT.
03700		TRNE	TAC1,STRING	;OH GOD.
03800		JRST	[PUSH	SP,-1(A) ;FIRST WORD OF BYTE P.
03900			 PUSH	SP,(A)
04000			 PUSHJ	P,STRCOP
04100			 TLO	TAC1,STRREF;STRING BY REFERENCE.
04200			 JRST	COPY]
04300		MOVE	C,PARCNT(PNT)	;OK. FUDGE UP A PLACE FOR THE REFERENCE.
04400		MOVE	D,(A)		;D NOW HAS THE ARGUMENT.
04500		HRRI	A,3(C)		;A NOW POINTS TO THE DATUM BLOCK FOR THIS PARAM
04600		TRNN	TAC1,SET	;IF NOT GLOBAL SET,
04700		JRST	COPY
04800		PUSHJ	P,CHKSET	;CHECK THE SET, AND RECOPY IF NECESSARY.
04900		MOVEI	A,3(C)		;RE ESTABLISH THE REFERENCE.
05000		JRST	COPY
     

00100	ARRYS:	TRNE	TAC1,SET!STRING
00200		ERR	<MESSAGE: THESE ARRAYS TOO COMPLICATED>,1,RETIT
00300		SETOM	USCOR2(USER)	;WE WILL NEED CORE.
00400		PUSH	P,A		;ARRAY
00500	;;#HO#↓ 6-7-72 DCS (1-2) ..ARCOP PROVIDES CORGET ADDR IN B
00600		PUSHJ	P,..ARCOP	;COPY THE ARRAY IN -1(P)
00700		SETZM	USCOR2(USER)
00800		MOVE	TAC1,-1(P)	;GET IT BACK.
00900		TLO	TAC1,CORGOT	;MARK FOR RELEASING
01000		HRLZI	C,GOTCOR	;SAY WE GOT CORE
01100		ORM	C,BITS(PNT)
01200	;;#HO#↓ 6-7-72 DCS (2-2) PROVIDE CORGET ADDR TO PARAM BLOCK
01300		MOVE	D,B		;CORGET BLOCK ADDR RETURNED BY ..ARCOP
01400	;	JRST	COPY
01500	
01600	
01700	COPY:	AOS	C,PARCNT(PNT)	;INDEX COUNT
01800		MOVEM	A,(C)		;ARGUMENT (WILL BE PUSHED).
01900		AOS	C,PARCNT(PNT)
02000		MOVEM	TAC1,(C)	;TBITS,
02100		AOS	C,PARCNT(PNT)
02200		HRRZM	D,(C)		;OTHER POINTER
02300		CAILE	C,PAREND(PNT)	;GONE OFF END ??
02400		ERR	<MESSAGE: TOO MANY PARAMS>,1
02500	RETIT:	MOVE	LPSA,X33
02600		JRST	RESTR
02700	
02800	
02900	;NOW FOR THE MAIN "DOIT" CODE.  THE ENTRY IS WITH:
03000	; A ::: DIRECTIVE
03100	; B ::: POINTS TO MESSAGE (OPTIONAL)
03200	; C ::: UNIQUE NUMBER OF MESSAGE
03300	
03400	
03500	QDOIT:	MOVE	USER,GOGTAB
03600		TRNE	A,DSEND		;SEND THE MESSAGE??
03700		PUSHJ	P,SENDIT
03800		TRNE	A,DWAIT	;WAIT FOR COMPLETION?
03900		PUSHJ	P,WAITC
04000		TRNE	A,DFIND		;IS THIS GET_ENTRY?
04100		PUSHJ	P,FIND1
04200		TRNE	A,DACT		;ACTIVATE
04300		PUSHJ	P,ACTIV
04400		TRNE	A,DACK		;ACKNOWLEDGE
04500		PUSHJ	P,ACKIT
04600		TRNE	A,DKILL
04700		PUSHJ	P,KILLIT
04800		MOVE	A,RACS+1(USER)
04900		POPJ	P,
     

00100	SENDIT:	TRNN	A,DNOTRACE	;IF NOT TRACING THIS MESSAGE, OR
00200		SKIPN	TRACING		;NOT TRACING
00300		 JRST	 GGSEND		;DO IT.
00400		PUSH	P,A
00500		PUSH	P,C
00600		QENT
00700		PUSHJ 	P,FNDMES	;FIND MESSAGE 	*** KKP HAS MODIFIED THIS CODE ****
00800		JRST [	POP P,C
00900			POP P,A
01000			JRST ALD1]	;NO SUCH MESSAGE
01100		PUSH	P,B		;SAVE POINTER TO MESSAGE
01200		PUSHJ	P,.MES3		;START MESSAGE, PNTR IN B
01300		MOVEI	C,6		;TWO PARAMETERS
01400		ADDB	C,PARCNT(B)
01500		MOVE	A,-1(P)		;NUMBER OF MESSAGE BEING TRACED.
01600		MOVEM	A,-5(C)		;STORE AWAY IN MESSAGE BLOCK.
01700		CALLI	A,23		;MILLISECOND
01800		MOVEM	A,(C)		;TIME OF DAY.
01900		SETZM	PARBEG+3(B)	;CLEAR ARGUMENT COUNT
02000		MOVEI	A,-2(C)		;STORE POINTER TO ITSELF
02100		MOVEM	A,-2(C)		;THIS ALLOWS HE TO FIND REST OF INFO
02200		POP	P,PNT		;GET POINTER TO MESSAGE
02300		MOVEI	D,PARBEG+1(PNT)	;SET TO START OF ARGUMENTS IN MESSAGE
02400	ARGLOP:	CAML	D,PARCNT(PNT)	;CHECK FOR END OF ARGUMENTS
02500		JRST 	ARGEND
02600		AOS	PARBEG+3(B)	;INDEX ARGUMENT COUNT
02700		MOVE	A,1(D)		;GET SOME GOOD BITS
02800		MOVEM	A,2(C)		;AND STORE IN TRACE
02900		TDNE	A,[XWD SBSCRP,ITMVAR!ITEM!LPARRAY!SET!LABEL]
03000		JRST	ARGIND		;DO NOT STORE THESE ARGUMENTS
03100		MOVE	TAC1,(D);	GET ARGUMENT
03200		TLNE	A,STRREF	;IF REFERENCE STRING - OK
03300		JRST	.+3
03400		TLNE 	A,REFRNC;	;BY REFERENCE?
03500		MOVE	TAC1,(TAC1)	;YES, GET REAL ARGUMENT
03600		MOVEM	TAC1,1(C)	;STORE IN TRACE
03700	ARGIND:	ADDI	D,3		;INDEX POINTER FOR NEXT ARGUMENT
03800		ADDI	C,2
03900		JRST	ARGLOP
04000	ARGEND:	QLEV
04100		PUSH	P,[DSEND+DWAIT+DKILL+DNOTRACE];		*********************
04200		PUSH	SP,[0]		;THE ABOVE KLUDGE CAN BE UNDERSTOOD BY HE (AND ONLY HE)
04300		PUSH	SP,[0]		;SOURCE.....
04400		PUSH	SP,[5]
04500		PUSH	SP,[POINT 7,GODNAM]
04600		PUSH	SP,[5]
04700		PUSH	SP,[POINT 7,TRACNAM]
04800		PUSHJ	P,ISSUE		;DO IT.
04900		POP	P,C
05000		POP	P,A		;AND FINALLY SEND THE REAL MESSAGE.
     

00100	GGSEND:	QENT
00200		PUSHJ	P,FNDMES	;FIND THE MESSAGE
00300		 JRST	 ALD1		;DISAPPEARED - FORGET ABOUT IT
00400		MOVSI	D,SENT		;TURN ON THE BIT.
00500		TRZE	A,DKILL		;IF HE ASKS TO KILL,
00600		 TLO	 D,KILL		;MARK FOR KILLING LATER.
00700		TLO	B,-1		;FLAG TO SEE IF DESTINATION LOCATED.
00800		IORM	D,BITS(B)
00900		MOVE	D,JOBCNT	;NOW GO THROUGH THE TABLE, SENDING
01000		TRNE	A,DNOACT	;IF NOT ACTIVATE, ALL DONE.
01100		 JRST	 QLD2
01200	AG1:	SOJL	D,ALD1		;MAIL TO EVERYONE WHO IS IN MAIL WAIT.
01300		MOVE	PNT,IDEST(B)	;FIRST WORD OF LOGICAL DESTINATION.
01400		CAME	PNT,DESTAB(D)	;SAME AS STATED ?
01500		JRST	AG1		;NO
01600		MOVE	PNT,IDEST+1(B)	;
01700		CAME	PNT,DESTB1(D)	;AND SECOND WORD.
01800		JRST	AG1
01900		TLZ	B,-1		;DESTINATION FOUND.
02000		SKIPL	LPSA,JOBTAB(D)	;IN WAIT??
02100		JRST	ALD1		;NO
02200		HRRZS	LPSA
02300		MAIL	4,LPSA		;SEE IF HE ALREADY HAS MAIL WAITING.
02400		SKIPA			;NO -- SEND SOME.
02500		JRST	ALD1		;..
02600		EXCH	LPSA,A		;GET JOB # IN A.
02700					;B HAS ADDRESS OF A FINE 32 WORD BLOCK.
02800	;*** TEMPORARY ONLY
02900		PUSH	P,B
03000		MOVEI	B,0
03100	;***
03200		MAIL	A		;SEND MAIL TO JOB NUMBER.....
03300	MSER:	JRST [	QLEV
03400			ERR	<MAIL SCREW>,1]
03500	;****
03600		POP	P,B
03700	;****
03800		EXCH	A,LPSA
03900		JRST	AG1		;BACK FOR MORE.
04000	
04100	ALD1:	QLEV
04200		TLNE	B,-1
04300		ERR	<MESSAGE: NO SUCH DESTINATION>,1
04400		POPJ	P,
04500	
04600	GODNAM:
04700	TRACNAM: ASCII /TRACE/
     

00100	WAITC:	QENT
00200		PUSHJ	P,FNDMES
00300		JRST	ALD1		;MESSAGE HAS DISAPPEARED, ASSUME ACK.
00400		MOVE	D,BITS(B)	;GET HIS BITS.
00500		TLNE	D,ACK		;ACKNOWLEDGED.
00600		JRST	DON		;YES -- OK.
00700		MOVSI	D,WAIT		;WE WILL GO INTO MAIL WAIT.
00800		IORB	D,BITS(B)	;
00900	;*** BUG TRAP ***
01000		GETJOB	(B)		;GET JOB NUMBER IN B.
01100		MOVE	D,JOBCNT
01200		SOJL	D,ALDX
01300		SKIPL	LPSA,JOBTAB(D)
01400		JRST	.-2		;
01500		CAIE	B,(LPSA)		;ARE WE IN THIS KIND OF WAIT
01600		JRST	.-4		;NO -- NOT US
01700		MOVE	TAC1,JOBTAB(D);	ARE WE REALLY WAITING? ******KKP INSERT
01800		TLNE	TAC1,1
01900		JRST [	QLEV
02000			OUTSTR [ASCIZ .MAIL WAIT CONFLICT
02100	. ]						; YES - CAN'T HAPPEN
02200			JRST .+1]			;BUT GO ON ANYWAY-MAYBE WE RESTARTED
02300		HRRZS	JOBTAB(D);	NO - WE WERE IN INTERRUPT MODE  ************
02400	ALDX:	QLEV			;GOING
02500					;WAIT FOR MAIL AND SEE IF THIS IS THE ONE.
02600		MAIL	1,1(P)		;A PLACE TO THROW MAIL		
02700		JRST	WAITC		;AND DO IT AGAIN.
02800	DON:	TLNE	D,KILL		;IS THIS GUY TO BE KILLED??
02900		TRO	A,DKILL		;YES- DO THAT NEXT.
03000	QLD2:	QLEV
03100		POPJ	P,
03200	
03300	; *****						*****
03400	; *****						*****
03500	
03600	FIND1:	PUSHJ	P,GETSTR	;GET THE STRINGS.
03700		GETJOB	(0)		;GET JOB NUMBER IN 0.
03800	DF1:	QENT
03900		SKIPA	D,MESQ		;LOOK INTO CURRENT QUEUE
04000	NEXQ:	HRRZ	D,PNTR(D)	;GO DOWN QUEUE
04100		JUMPE	D,QFIN		;DONE
04200		MOVE	LPSA,BITS(D)	;GET GOOD BITS.
04300		TRNE	A,DEVERY	;LOOK AT EVERY MESSAGE?
04400		 JRST	 TESR		;YES
04500		TLNE	LPSA,SENT		;ONLY IF SEND
04600		TLNE	LPSA,ACT!ACK	;AND NOT ALREADY PROCESSED.
04700		 JRST	 NEXQ		;NOT THIS ONE.
     

00100	TESR:
00200		MOVE	LPSA,INAME(D)	;GET PROCEDURE NAME.
00300		MOVE	PNT,INAME+1(D)	; BOTH WORDS.
00400		CAMN	LPSA,[ASCII /RESTA/]
00500		CAME	PNT,[ASCIZ /RT/]
00600		JRST	TESR1
00700		QLEV			;LEAVE QUEUE CORRECT.
00800		MOVE	C,UNIQUE(D)	;GET MESSAGE NUMBER.
00900		PUSHJ	P,KILLIT	;TAKE AWAY THE MESSAGE.
01000		MOVE	A,JOBSA
01100		JRST	(A)		;AND RESTART THE PROGRAM.
01200	TESR1:
01300	DEFINE	COMP(DIR,X,Y) <
01400		TRNN	A,DIR
01500		JRST	.+7
01600		MOVE	LPSA,-Y-1(SP)	;FIRST WORD OF NAME.
01700		CAME	LPSA,X(D)
01800		JRST	NEXQ		;FAIL
01900		MOVE	LPSA,-Y(SP)
02000		CAME	LPSA,X+1(D)
02100		JRST	NEXQ
02200		>
02300	
02400		COMP	(DSOURCE,ISOURCE,4)
02500		COMP	(DDEST,IDEST,2)
02600		COMP	(DNAME,INAME,0)
02700	
02800		MOVE	C,UNIQUE(D)	;THE NUMBER
02900	NOJXX:	MOVEM	C,RACS+1(USER)	;..ANSWER
03000		
03100		MOVE	D,JOBCNT
03200	TT2:	SOJL	D,NOJB1		;ALL DONE.
03300		SKIPL	LPSA,JOBTAB(D)	;GET JOB NUMBER
03400		JRST	TT2
03500		CAIE	(LPSA)		;SAME AS US ?
03600		JRST	TT2
03700		HRRZS	JOBTAB(D)	;SAY WE ARE NO LONGER WAITING.
03800	
03900		MAIL	2,1(P)		;READ MAIL IF ANY IS THERE.
04000		JFCL
04100	
04200	NOJB1:	QLEV
04300		POPJ	P,
     

00100	QFIN:	TRNN	A,DWAITM
00200		JRST	[MOVEI	C,0
00300			JRST	NOJXX]
00400		MOVE	D,JOBCNT
00500	TT3:	SOJL	D,[	QLEV
00600				ERR <WHO ARE YOU??>,1,TTY5+1]
00700		HRRZ	LPSA,JOBTAB(D)
00800		CAIE	(LPSA)		;US ?
00900		JRST	TT3
01000	TT4:	HRROM	JOBTAB(D)	;SAY WE ARE WAITING FOR MAIL.
01100	TTY5:	QLEV
01200		TRNE	A,DRETURN	;**** KKP ADDITION
01300		JRST [	HRLZI TAC1,1	;SET INTERRUPT MODE FLAG
01400			ANDCAM TAC1,JOBTAB(D)
01500			SETZM RACS+1(USER)	;NO MESSAGE READY
01600			POPJ P,]	;RETURN ANYWAY - FOR USE WITH INTERRUPT ROUTINE ********
01700		MAIL	1,1(P)		;WAIT FOR MAIL.
01800		JRST	DF1
01900	
02000	ACTIV:	QENT
02100		PUSHJ	P,FNDMES	;LOCATE THE MESSAGE.
02200		 JRST	 ALD1		;SORRY - NO CAN DO
02300		MOVE	LPSA,INAME(B)	;GET THE NAME
02400		MOVE	PNT,INAME+1(B)	;AND THE SECOND PART OF THE NAME.
02500		MOVE	D,SPLNK(USER)	;SPACE ALLOCATION.
02600	QT1:	SKIPL	FP,$MSLNK(D)	;MESSAGE PROCEDURE HOME.
02700		JRST	QT2		;NO MESSAGE PROCEDURES IN THIS PROGRAM.
02800	TEST:	CAMN	LPSA,2(FP)
02900		CAME	PNT,3(FP)	;SAME PROCEDURE??
03000		JRST	[HRRZ	FP,(FP) ;GO TO NEXT PROCEDURE
03100			 JUMPN	FP,TEST
03200	QT2:		 HRRZ	D,(D)
03300			 JUMPN	D,QT1
03400			 JRST	[SETZM	RACS+1(USER)
03500				QLEV
03600				 POPJ	P,]
03700			]
03800		HRRZ	FP,1(FP)		;ADDRESS OF PROCEDURE.
03900		PUSH	P,C		;UNIQUE NUMBER
04000		PUSH	P,A		;DIRECTIVE.
04100		MOVEI	LPSA,PARBEG(B)	;START OF PARAMETERS.
04200	T3:	CAML	LPSA,PARCNT(B)
04300		JRST	CALLIT		;ALREADY TO GO.
     

00100		MOVE	A,2(LPSA)		;GOOD BITS WORD.
00200		TRNE	A,STRING	;WAS IT A STRING??
00300		JRST	[MOVE	D,1(LPSA)	; → FIRST WORD OF STRING DESC.
00400	;;#GI# DCS 2-5-72 REMOVE TOPSTR, FIX STRNGC BUG
00500			 PUSH	P,A	;SAVE
00600			 MOVE	A,(D)	;COUNT -- MUST BE IN A FOR GC
00700	;;  #GI#   WAS USING C!
00800			 ADDM A,REMCHR(USER)
00900			 SKIPLE REMCHR(USER)
01000			 PUSHJ	P,STRNGC
01100			 PUSH	SP,A		;FIRST WORD OF RESULT
01200			 HRROS	(SP)		;NON-CONSTANT
01300			 PUSH	SP,TOPBYTE(USER); AND SECOND.
01400	STRRZ:		 SOJL	A,STRR
01500			 ILDB	1(D)		;GET A CHAR
01600			 IDPB	TOPBYTE(USER)	;AND ANOTHER.
01700			 JRST	STRRZ
01800	STRR:		 POP	P,A		;GET BITS BACK
01900	;;#GI#
02000			 TLNN	A,REFRNC	;REFERENCE ?
02100			 JRST	.+2		;NO -- GO AWAY.
02200			 POP	SP,1(D)		;SAVE IN SEC. SEG.
02300			 POP	SP,(D)		;...
02400			 AOS	D		;POINT TO SEC WORD OF BP.
02500			 PUSH	P,D		;AND A POINTER.
02600			 JRST	.+2]
02700		PUSH	P,1(LPSA)			;ARGUMENT.
02800		ADDI	LPSA,3
02900		JRST	T3		;AND LOOP
03000	CALLIT:	QLEV
03100		PUSHJ	P,(FP)		;CALL THE PROCEDURE.
03200		MOVE	USER,GOGTAB
03300		QENT
03400		MOVE	C,-1(P)		;GET UNIQUE NUMBER
03500		PUSHJ P,FNDMES		;GET MESSAGE AGAIN (DON'T LOCK OUT JOBS DURING MESSAGE ACTIVATION)
03600		JRST [	QLEV
03700			OUTSTR [ASCIZ .YOUR MESSAGE HAS DISAPPEARED
03800	.]
03900			JRST OLDT]
04000		MOVE	D,BITS(B)	;TURN OFF CORE BIT
04100		TLZ	D,GOTCOR
04200		MOVEM	D,BITS(B)
04300		MOVEI	D,PARBEG(B)
04400	T4:	CAML	D,PARCNT(B)
04500		JRST	OLDTT		;DONE
04600		MOVE	A,2(D)		;TBITS WORD
04700		TLNN	A,CORGOT
04800		JRST	T5
04900		PUSH	P,B
05000		MOVE	B,3(D)
05100		PUSHJ	P,CORREL	;RELEASE IT.
05200		POP	P,B
     

00100	T5:	TLNN	A,SETRECLM
00200		JRST	T6
00300		MOVSI	FLAG,GLBSRC
00400		WRITSEC			;FIDDLE WYTH LEAP FREE STORAGE
00500		MOVE	FP,FP1+GLUSER
00600		MOVE	TAC1,3(D)		;.. SET.
00700		HLRZ	LPSA,(TAC1)
00800		HRRM	FP,(LPSA)
00900		MOVEM	TAC1,FP1+GLUSER
01000		NOSEC			;DONE WITH FREE STORAGE.
01100	
01200	T6:	ADDI	D,3		;LOOP
01300		JRST	T4
01400	
01500	OLDTT:	QLEV
01600	OLDT:	POP	P,A
01700		POP	P,C
01800		POPJ	P,
01900	
02000	ACKIT:	QENT
02100		PUSHJ	P,FNDMES
02200		 JRST	 ALD1;		IF SOMEONE WAS IS WAIT, HE IS HUNG FOR GOOD
02300		MOVE	D,BITS(B)	;GET THE GOOD BITS.
02400		TLZ	D,SENT		;TURN OFF SO ANOTHER GET ENTRY DOESN'T
02500		TLO	D,ACK		;SEE IT -- ALSO ACKNOWLEDGE.
02600		MOVEM	D,BITS(B)
02700		TLNN	D,WAIT		;WAS THERE SOMEONE INWAIT??
02800		JRST	[TLNE	D,KILL	;IF IT WAS MARKED FOR KILLING, THEN
02900			 TRO	A,DKILL	;KILL IT NOW.
03000			 JRST	T7]
03100		PUSH	P,A		;SAVE A.
03200		HRRZ	A,D		;GET JOB NUMBER ONLY.
03300		MAIL	4,A		;SEE IF HE HAS MAIL WAITING.
03400		SKIPA			;NO -- OK.
03500		JRST 	MSER
03600	;*** TEMPORARY
03700		PUSH	P,B
03800		MOVEI	B,2
03900	;***
04000		MAIL	A		;SEND MAIL TO HIM......
04100		JRST	MSER
04200	;***
04300		POP	P,B
04400	;***
04500		POP	P,A
04600	T7:	QLEV			;ALL DONE.
04700		POPJ	P,
     

00100	KILLIT:	QENT
00200		PUSHJ	P,FNDMES
00300		JRST	ALD1
00400		MOVE	C,BITS(B)
00500		TLNE	C,GOTCOR	;WAS CORE RELEASED FOR THIS MESSAGE
00600		JRST [	QLEV
00700			ERR <MESSAGE SNATCHER!!>,1,KILLAB]
00800		HRRZ	C,(B)		;LINK DOWN LIST
00900		HRRZM	C,(LPSA)		;PATCH US OUT.....
01000		QLEV
01100		JRST	CORREL		;RELEASE CORE.
01200	
01300	
01400	; *****						*****
01500	; *****						*****
01600	
01700	
01800	;SERVICE ROUTINES.....
01900	
02000	GETSTR:	MOVEI	D,-5(SP)	;DCS -- FIX OFLOW PROBLEM AFTER 6 CHARS
02100		PUSHJ	P,GET10
02200		MOVEI	D,-3(SP)
02300		PUSHJ	P,GET10
02400		MOVEI	D,-1(SP)
02500	;	JRST 	GET10
02600	
02700	GET10:	MOVE	FP,1(D)		;BYTE POINTER.
02800		MOVE	LPSA,[POINT 7,(D)]
02900		HRRZ	TABL,(D)	;COUNT.
03000		CAILE	TABL,=10
03100		MOVEI	TABL,=10
03200		SETZM	(D)
03300		SETZM	1(D)		;ZERO THE TARGETS
03400		SOJL	TABL,CPOPJ
03500		ILDB	FP
03600		IDPB	LPSA
03700		JRST	.-3
03800	
03900	
04000	FNDMES:	MOVEI	LPSA,MESQ	;ALWAYS CALLED WITH LOCK SET
04100		AOS	(P)
04200	ANOMES:	MOVE	B,(LPSA)		;GO DOWN LIST
04300		JUMPE	B,NOMES
04400		CAMN	C,UNIQUE(B)
04500		JRST	[MOVEM	C,RACS+1(USER)
04600			 POPJ	P,]
04700		HRRZ	LPSA,B
04800		JUMPN	LPSA,ANOMES
04900	NOMES:	SOS	(P)
05000		SETZM	RACS+1(USER)
05100	KILLAB:	POPJ	P,
     

00100	; *****						*****
00200	; *****						*****
00300	
00400	
00500	HERE (ISSUE)				;A REAL RUNTIME ROUTINE.
00600		PUSHJ	P,GETSTR	;GET STRINGS.
00700		MOVE	B,CURMES(USER)
00800		HRLI	C,-5(SP)
00900		HRRI	C,ISOURCE(B)
01000		BLT	C,INAME+1(B)	;BLT IN STRINGS.
01100		SUB	SP,[XWD 6,6]
01200		AOS	C,UNIQ		;NEW NUMBER
01300		MOVEM	C,UNIQUE(B)
01400		QENT			;PREPARE TO PUT IN QUEUE.
01500		MOVEI	D,MESQ		;
01600		MOVEI	E,(D)
01700		HRRZ	D,PNTR(D)	;GO DOWN LIST.
01800		JUMPN	D,.-2		;UNTIL END.
01900		HRRM	B,PNTR(E)
02000		QLEV
02100		SETZM	CURMES(USER)	;RESET THIS.
02200		MOVE	A,-1(P)		;DIRECTIVE......
02300		ANDI	A,DSEND!DWAIT!DKILL!DNOTRACE
02400		TRNN	A,DSEND		;IF HE DID NOT ASK TO SEND,
02500		 SKIPA 	 A,C		;THEN JUST RETURN THE UNIQUE NUMBER.
02600		PUSHJ	P,QDOIT		;GO TO IT.
02700		SUB	P,X22
02800		JRST	@2(P)		;GO AWAY.
02900	
03000	
03100	HERE (QUEUE)			;AND ANOTHER ROUTINE.
03200		MOVE	C,-1(P)		;UNIQUE NUMBER
03300		MOVE	A,-2(P)		;DIRECTIVE
03400		ANDI	A,DSEND!DWAIT!DACK!DACT!DKILL
03500		JUMPE	A,[ERR <NO DIRECTIVE>,1,QU2]
03600		PUSHJ	P,QDOIT
03700	QU2:	MOVE	A,RACS+1(USER)	;.....GULP.....
03800		SUB	P,X33
03900		JRST	@3(P)		;GO AWAY.
     

00100	HERE (GET.DATA)
00200		MOVE	USER,GOGTAB	;OH YES.
00300		MOVE	C,-1(P)		;UNIQUE NUMBER
00400		QENT
00500		PUSHJ	P,FNDMES
00600		JRST	[ADD	SP,X22	;NULL STRING RESULT
00700			 SETZM	-1(SP)
00800			 JRST	ALDON]
00900	;;#GI# DCS 2-5-72 REMOVE TOPSTR, FIX SOME STRNGC BUGS
01000	;; #GI# CHAR COUNT MUSTMUSTMUST BE IN A WHEN STRNGC CALLED
01100		MOVE	A,B		;QUEUE BLOCK POINTER
01200		MOVE	B,-2(P)
01300		ANDI	B,3
01400		LSH	B,1		;NOW READY FOR INDEX.
01500		ADDI	B,ISOURCE-2(A)
01600		HRLI	B,(<POINT 7,0>) ;TO GET BYTES.
01700	
01800		MOVEI	A,=10
01900		ADDM	A,REMCHR(USER)
02000		SKIPLE	REMCHR(USER)
02100		PUSHJ	P,STRNGC
02200		PUSH	SP,[0]		;START HERE
02300		PUSH	SP,TOPBYTE(USER)
02400	
02500	LOPJ:	ILDB	B		;Queue names are a maximum of two
02600		JUMPE	ALDON		; words long.  Transfer all of them
02700		IDPB	TOPBYTE(USER)	; to the string (null indicates end).
02800		SOJGE	A,LOPJ		;A=max# chars left
02900	ALDON:	MOVN	A,A		;Replace number of chars left in REMCHR.
03000		ADDM	A,REMCHR(USER)
03100		ADDI	A,=10		;10-#left=#used
03200		HRROM	A,-1(SP)	;Non-constant string, this long
03300		QLEV
03400		SUB	P,X33
03500		JRST	@3(P)		;GO AWAY
03600	
03700	HERE (PUT.DATA)			;PUT A STRING IN.
03800		MOVE	USER,GOGTAB
03900		MOVEI	D,-1(SP)
04000		PUSHJ	P,GET10
04100		SKIPGE -2(P)
04200		JRST [	MOVE C,-1(P);	KILL JOB
04300			MOVE D,JOBCNT
04400			POP SP,TAC1;	FLUSH GARBAGE
04500			POP SP,TAC2
04600	NXXQ:		SOJL D,PUTQQ
04700			MOVE B,JOBTAB(D)
04800			CAIE C,(B);	FIND TABLE ENTRY
04900			JRST NXXQ
     

00100	XX1:		AOS D;		REMOVE TABLE ENTRY
00200			CAML D,JOBCNT
00300			JRST [	SOS JOBCNT
00400				JRST PUTQQ]
00500			MOVE C,JOBTAB(D)
00600			MOVEM C,JOBTAB-1(D)
00700			MOVE C,DESTAB(D)
00800			MOVEM C,DESTAB-1(D)
00900			MOVE C,DESTB1(D)
01000			MOVEM C,DESTB1-1(D)
01100			JRST XX1]
01200		SKIPG	C,-1(P)
01300		JRST	[GETJOB (0)	;JOB NUMBER IN ZERO.
01400			SETZM B
01500			POP SP,TAC1
01600			POP SP,TAC2
01700			SKIPG C,VERS;		TEST FOR VERSION #
01800			JRST [	HLRZ C,JOBVER;	INITIALIZE
01900				CAILE C,1000;	NONE GIVEN
02000				SETZM C
02100				MOVEM C,VERS
02200				JRST NXTLAB]
02300	NXTLAB:		HLRZ D,JOBVER;		GET CURRENT JOBS VERSION
02400			CAILE D,1000
02500			SETZM D;		ZERO IF NONE
02600			CAIE C,(D);		THEY MUST AGREE
02700			JRST [
02800	NOSEG:			MOVEM TAC2,DESTB1+NJOB-2;
02900				MOVEM TAC1,DESTB1+NJOB-1
03000				OUTSTR DESTB1+NJOB-2
03100				CAIG C,(D)
03200				ERR < - VERSION # TOO HIGH>,0
03300				ERR < - VERSION # TOO LOW>,0]
03400			MOVE	D,JOBCNT
03500	NOXQ:		SOJL	D,[JUMPN B,PUTQQ;		FOUND NAME
03600				   QENT;			LETS PLAY SAFE HERE
03700				   AOS D,JOBCNT
03800				   SUBI	D,1
03900				   CAILE D,NJOB
04000				   JRST [ SOS JOBCNT
04100					  QLEV
04200					  ERR <TOO MANY JOBS>,1,PUTQQ]
04300				   HRRZM JOBTAB(D) ;JOB NUMBER RECORDED.
04400				   QLEV
04500				   JRST PUTXX]
04600			MOVE	C,JOBTAB(D)
04700			CAIN	(C)	;SAME AS US??
04800			JRST	PUTXX	;YES -- STORE
     

00100			CAMN	TAC2,DESTAB(D);		TEST FOR ALREADY DEFINED
00200			CAME	TAC1,DESTB1(D)
00300			CAIA
00400			JRST [	ERR	<LOGICAL NAME ALREADY DEFINED>,1,PUTZZ
00500	PUTZZ:			MOVEM JOBTAB(D)
00600				SETOM B;	BUT REDEFINE IF FORCED TO
00700				JRST	NOXQ]
00800			JRST	NOXQ
00900	
01000	PUTXX:		MOVEM	TAC1,DESTB1(D)
01100			MOVEM	TAC2,DESTAB(D)	;FILL LOGICAL NAME TABLES.
01200			SETOM	B
01300			JRST	NOXQ]
01400		QENT
01500		PUSHJ	P,FNDMES	;FIND IT
01600		JRST	[MOVEI A,0
01700			 JRST GOXX]
01800		MOVE	A,-2(P)
01900		ANDI	A,3
02000		LSH	A,1
02100		ADDI	A,ISOURCE-2(B)
02200	GOXX:	POP	SP,1(A)		;PUT THE CHARACTERS DOWN.
02300		POP	SP,(A)
02400		QLEV
02500	PUTQQ:	SUB	P,X33
02600		JRST	@3(P)
02700	
02800	
02900	
03000	HERE (GET.ENTRY)		;ANOTHER ROUTINE
03100		MOVE	A,-1(P)
03200		ANDI	A,DWAITM!DSOURCE!DDEST!DNAME!DRETURN
03300		JUMPE	A,[ERR <NO GET_ENTRY DIRECTIVE>,1,GETT4]
03400		TRO	A,DFIND
03500		PUSHJ	P,QDOIT
03600	GETT4:	SUB	P,X22
03700		SUB	SP,[XWD 6,6]
03800		JRST	@2(P)
03900	
04000	
04100	HERE (GET.SET)
04200		MOVE	USER,GOGTAB
04300		PUSH	P,[0]		;NULL SET.
04400		MOVE	A,-2(P)		;DIRECTIVE......
04500		PUSHJ	P,FIND1		;GET STRINGS, LOOK FOR A MATCH.
04600					;IF NONE, THEN WAIT IF DWAITM SET.
04700		PUSH	P,RACS+1(USER)	;SAVE FOR CHAINING.
     

00100	MORST:	SKIPN	RACS+1(USER)
00200		 JRST	 NOMORQ
00300		PUSH	P,RACS+1(USER)	;RESULT.
00400		MOVEI	TAC1,-2(P)	;...
00500		MOVEI	FLAG,47		;TO PUT IN SET
00600		PUSHJ	P,LEAP		;PUT IT IN SET.
00700		MOVEI	A,DWAITM
00800		ANDCAB	A,-3(P)		;TO DIRECTIVE.
00900		POP	P,C		;UNIQUE NUMBER LAST FOUND.
01000		QENT
01100		PUSHJ	P,FNDMES	;GET ADDRESS IN B.
01200		ERR	<MESSAGE: CONFUSION>,1
01300		MOVEI	D,(B)		;COPY
01400		GETJOB	(0)
01500		PUSHJ	P,NEXQ		;AND LOOK FOR NEXT ONE. LOCK RELEASED IN SUBR
01600		PUSH	P,RACS+1(USER)	;SAVE UNIQUE NUMBER.
01700		 JRST	 MORST
01800	NOMORQ:	POP	P,(P)		;LAST RESULT.
01900		SKIPN	MAXITM(USER)
02000		ERR	<GET_SET: NEED LEAP INITIALIZATION>,1
02100		POP	P,A		;THE SET
02200		SUB	P,X22
02300		SUB	SP,[XWD 6,6]
02400		JRST	@2(P)
02500	
02600	HERE (GET.BIT) 
02700		MOVE	USER,GOGTAB
02800		MOVE	C,-1(P)		;GET GOOD BITS FROM MESSAGE
02900		QENT
03000		PUSHJ	P,FNDMES	;FIND THE MESSAGE
03100		SKIPA	A,[0]
03200		HLRZ	A,BITS(B)	;GET THE LEFT HALF TO THE RIGHT HALF.
03300		QLEV
03400		SUB	P,X22
03500		JRST	@2(P)
03600	
03700	
03800	>;GLOB
03900	>;NOEXPO