Google
 

Trailing-Edge - PDP-10 Archives - BB-H506E-SM - cobol/source/lcm10.mac
There are 5 other files named lcm10.mac in the archive. Click here to see a list.
; UPD ID= 3565 on 6/3/81 at 4:28 PM by NIXON                            
TITLE	LCM - MESSAGE CONTROL SYSTEM FOR LIBOL.
SUBTTL	RUN-TIME SYSTEM FOR MCS



	SEARCH	COPYRT
	SALL

;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1974, 1985
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE.

; **** EDIT HISTORY ****

;DMN	 3-JUN-80	[635] INCORPORATE MCS-10 FIXES FROM B.C.TEL.

;  **** V11 ******
;DRO	11-NOV-77	[517] CHANGE SPACES TO NULLS FOR MCLASS
;DRO	19-SEP-77	[516]FIX MPP SEND WITH BAD ADDRESS
;JM	19-SEP-77	[511] SEND VERB ERROR RET FOR END INDICATOR
;JM	19-SEP-77	[510] DEFAULT TO OLD COMPILER

	SEARCH	INTERM


	SALL
	TWOSEG
	.COPYRIGHT		;Put COPYRIGHT statement in .REL file.

	RELOC	400000


;ENTRY POINTS
	ENTRY	M.SEND, M.INIT, M.IFM, M.AC, M.RMW, M.RSW
	ENTRY	M.RMNW, M.RSNW, M.DI, M.DIT, M.DO, M.EI, M.EIT, M.EO

IFN TOPS20,<
	ENTRY	MBIND, MNAME
	M.INIT:	M.RMW:	M.RSW:	M.RMNW:	M.RSNW:	M.SEND:	M.AC:
	M.IFM:	M.DI:	M.DIT:	M.DO:	M.EI:	M.EIT:	M.EO:
	MBIND:	MNAME:
IFN ANS68,<
	OUTSTR	[ASCIZ	"?LIBOL IS NOT CONFIGURED TO SUPPORT TPS-20.
"]
>
IFN ANS74,<
	OUTSTR	[ASCIZ	"?C74OTS IS NOT CONFIGURED TO SUPPORT TPS-20.
"]
>
	JRST	KILL.##
	END
>
IFE MCS,<
	M.INIT:	M.RMW:	M.RSW:	M.RMNW:	M.RSNW:	M.SEND:	M.AC:
	M.IFM:	M.DI:	M.DIT:	M.DO:	M.EI:	M.EIT:	M.EO:
IFN ANS68,<
	OUTSTR	[ASCIZ	"?LIBOL IS NOT CONFIGURED TO SUPPORT MCS.
"]
>
IFN ANS74,<
	OUTSTR	[ASCIZ	"?C74OTS IS NOT CONFIGURED TO SUPPORT MCS.
"]
>
	JRST	KILL.##
	END
>


;THIS MODULE USES ONLY ONE DATA STRUCTURE WHICH MIGHT BE OF INTEREST---
;THE PAGE TABLE.  THIS TABLE IS A LIST OF ALL ACTIVE PAGES (DATA PAGES
;FOR "RECEIVES" AND ACTIVE TRANSACTION PAGES FOR "SENDS").  THE FORMAT
;OF THE PAGE TABLE IS SIMPLY:
;
;		BIT 0 = 1 OUTPUT CD
;			0 INPUT CD
;		BIT 1-8   ZERO
;		BIT 9-17  PAGE #
;		BIT 1-35  PTR TO CD,ASSOCIATED WITH THIS PAGE
;
;
;
;REGISTER DEFINITIONS
R.FG=0		;MCS FLAGS
R.CP=1		;CURRENT PAGE POINTER
R.CD=2		;CD-ENTRY PTR
R.PT=3		;PTR TO CURRENT ENTRY IN PAGE TABLE
R.TD=4		;CURRENT TEXT DESCRIPTOR
R.TX=5		;PTR TO TEXT (USUALLY RECEIVING ITEM)
R.6=6
R.IN1=7		;1ST INPUT-ARGUMENT REG
R.IN2=10	;2ND "
R.OUT=11	;USED FOR OUTPUT ARG OF SUBROUTINES
R.13==13
R.14==14
R.15==15
R.16==16
R.17==17
PP==17




;TEMP REGS FOR USE WITH IPCF
T1=1
T2=T1+1
T3=T2+1
T4=T3+1


;FLAG DEFINITIONS IN "R.FLG"

F.SEG==1	;SEGMENT COMMAND (RSW OR RSNW)
F.ERR==2	;THERE WAS AN ERROR IN THE SEND COMMAND
F.AT==4		;THERE IS AN ACTIVE TRANSACTION
F.TOLG==10	;RECEIVED MESSAGE WAS "TOO LONG" FOR RCV ITEM
F.IFM==20	;COMMAND WAS "IF MESSAGE ..."
F.AT==40	;THERE IS AN "ACTIVE TRANSACTION"
;OFFSETS INTO CURRENT PAGE

FC==0		;FUNCTION CODE
STATUS==1	;STATUS CODE
TNUM==2		;TRANS NUMBER
PW==3		;PASSWORD
Q.0==5		;PRIMARY Q
SQ.1==^D8	;SUB-QUEUE 1
SQ.2==^D11	;SUB-QUEUE 2
SQ.3==^D14
SRCNAM==^D17	;SOURCE NAME
DATE==^D20
TIME==^D21
TDCNT==^D22	;TEXT DESCRIPTOR COUNT
GRPCNT==^D23	;GROUP COUNT
CLASS==^D24	;CLASS
DSTCNT==^D26	;DESTINATION COUNT
CHKSUM==^D27	;CHECKSUM
ADVFLG==^D28	;ADVANCING FLAG
DSTTAB==^D106	;DESTINATION TABLE
TEXT==^D256
	SUBTTL	MORE PARAMETERS AND OFFSETS FOR LIBOL-MCS

;OFFSETS INTO CD-POINTER TABLE

CD.Q==0
CD.SQ1==1
CD.SQ2==2
CD.SQ3==3
CD.DAT==4
CD.TIM==5
CD.SRC==6
CD.LEN==7
CD.END==10
CD.STS==11
CD.CNT==12

;END INDICATOR VALUES

ESI.==1
EMI.==2
EGI.==3
EPI.==4


;SHIFTING CONSTANTS TO CONVERT PAGE # TO WORDS, AND VICE VERSA:
P2WLSH==11
W2PLSH==-11


;VALUES USED FOR LINE PRINTER CHANNEL CONTROL
LF==12
CR==15
VT==13
FF==14
DLE==20
DC1==21
DC2==22
DC3==23
DC4==24

;TABLE OF POINTERS INTO THE CURRENT INPUT CD-ENTRY
;TEMPORARY GLOBAL
	INTERN	X
X:
;

CDPTRS:	POINT	7,(R.CD)	;Q-NAME
	POINT	7,2(R.CD),13	;S-Q 1
	POINT	7,4(R.CD),27	;SUB-Q 2
	POINT	7,7(R.CD),6	;SUB-Q 3
	POINT	7,11(R.CD),20	;DATE
	POINT	7,12(R.CD),27	;TIME
	POINT	7,14(R.CD),13	;SOURCE
	POINT	7,16(R.CD),27	;TEXT LENGTH
	POINT	7,17(R.CD),20	;END KEY
	POINT	7,17(R.CD),27	;STATUS KEY
	POINT	7,20(R.CD),6	;MESSAGE COUNT


;BYTE POINTER FOR END INDICATOR
ENDPTR:	POINT	6,(R.TD),17
	SUBTTL	MACRO DEFINITIONS

;A FEW MACROS...

	DEFINE	SWON(SWITCH),<
	TRO	R.FG,SWITCH>

	DEFINE	SWOFF(SWITCH),<
	TRZ	R.FG,SWITCH>

	DEFINE	TSWT(SWITCH),<
	TRNN	R.FG,SWITCH>

	DEFINE	TSWF(SWITCH),<
	TRNE	R.FG,SWITCH>


	DEFINE	PUTMUL(OFFSET,CHAR,LENGTH),<
	MOVE	R.IN1,CDPTRS+OFFSET
	MOVEI	R.IN2,LENGTH
	MOVEI	R.OUT,"CHAR"
	IDPB	R.OUT,R.IN1
	SOJG	R.IN2,.-1>


	DEFINE	RETURN,<
	POPJ	PP,
	>

	DEFINE	GETARG(NUM),<	
	MOVE	R.OUT,NUM-1(16)	;GET ARGUMENT
	>
	DEFINE	STORE(OFFSET),<
	MOVEM	R.6,OFFSET(R.CP)
	>

	DEFINE	GET(OFFSET),<
	MOVE	R.OUT,OFFSET(R.CP)
	>

	DEFINE	CHKSTS,<
	MOVE	R.15,STATUS(R.CP)
	JUMPL	R.15,E.STS
	JRST	.+1(R.15)
	>

	DEFINE	SETVAL(OFFSET,WHAT,LENGTH),<
	MOVE	R.IN2,CDPTRS+OFFSET
	MOVE	R.IN1,[POINT 7,[ASCIZ /WHAT/]]
	MOVEI	R.15,LENGTH
	PUSHJ	PP,TRNFER
	>




	DEFINE	OUTSTS(CODE),<
	MOVEI	R.IN1,"CODE"
	DPB	R.IN1,[POINT 14,1(R.CD),34]	;STORE OUTPUT STATUS CODE
	>
	SUBTTL	"RECEIVE" PROCESSOR FOR LIBOL-MCS



;THESE ROUTINES RECEIVE A MESSAGE (OR PART THEREOF) FROM
;MCS AND PASS IT BACK TO THE APPLICATION PROGRAM.  UNLESS
;R.SW OR R.SNW WERE CALLED, THE PROGRAM RECEIVES AT LEAST
;A COMPLETE MESSAGE (I.E., END INDICATOR IS EQUAL TO OR GREATER THAN EMI).
;OTHERWISE, A MESSAGE SEGMENT MAY BE RECEIVED.
;THE OPERATION OF THE "WAIT" AND "NO-WAIT" ROUTINES
;ARE IDENTICAL EXCEPT THAT A STATUS OF 2 IS POSSIBLE DURING
;THE "NO-WAIT" ROUTINES. IN THIS CASE, A SKIP RETURN IS MADE
;TO THE CALLING PROGRAM.


M.RMNW:	PUSHJ	PP,SETUP
	JRST	.+3

M.RSNW:	PUSHJ	PP,SETUP
	SWON	F.SEG		;SET SEGMENT FLAG
	MOVEI	R.6,3		;SET FUNCTION CODE=3
	JRST	RCVSTR		;...AND BEGIN

M.RMW:	PUSHJ	PP,SETUP
	JRST	.+3

M.RSW:	PUSHJ	PP,SETUP
	SWON	F.SEG		;SET SEGMENT
	MOVEI	R.6,2		;FUNCTION CODE=2

;AND FALL THRU TO START OF MAIN BODY...
;					.
;					 .
;					 .
;					 .
	SUBTTL	START OF "RECEIVE" PROCESSING

;ALL RECEIVES COME HERE TO DO THEIR THING
RCVSTR:	SKIPN	R.PT,MCSPT##	;GET PTR TO PAGE TABLE
	PUSHJ	PP,FRMTAB	;NO, GO FORM A TABLE
RCV.1:	SKIPN	(R.PT)		;ARE WE AT THE END OF PAGE TABLE?
	JRST	RCV.3		;YES
;NOTE-THERE IS NO CHECK HERE FOR A FULL PAGE TABLE.

;COME HERE TO CHECK IF CURRENT CD Q-SPEC MATCHES
;A CURRENTLY ACTIVE TRANSACTION.
RCV.2:	SKIPG	(R.PT)		;IS THIS EVEN AN INPUT CD?
	AOJA	R.PT,RCV.1	;NO
	PUSHJ	PP,CMPQ		;YES, BUT DO Q'S MATCH?
	AOJA	R.PT,RCV.1	;NO, KEEP TRYING

;WE HAVE FOUND A MATCHING ACTIVE TRANSACTION PAGE, SO
;WE ASSUME THAT THIS NEW "RECEIVE" IS A CONTINUATION
;OF THAT TRANSACTION.

	HLRZ	R.CP,(R.PT)	;SET CURRENT PAGE PTR
	LSH	R.CP,P2WLSH
	STORE	FC
	GET	TDCNT		;GET TEXT COUNT
	ANDI	R.OUT,777777	;NEED RIGHT SIDE ONLY
	SKIPN	R.OUT		;IS THIS PAGE THRU?
	PUSHJ	PP,GETMOR	;YES, GET ANOTHER PAGE
	CHKSTS
	JRST	RCV.80			;STATUS=0
	JRST 	RCV.7			;STATUS=1
	JRST	RCV.S2			;STATUS=2
	JFCL
	JFCL
	JRST 	RCV.6			;STATUS=5


RCV.3:	PUSHJ	PP,GETPAG	;GET A FREE PAGE
	MOVE	R.CP,R.OUT	;SET PTR TO IT
	STORE	FC		;STORE FUNCION CODE
	PUSHJ	PP,SETQ		;SET UP ALL Q-SPECS ON IT
RCV.4:	PUSHJ	PP,MCP.S	;SEND A PAGE TO MCS
	PUSHJ	PP,MCP.R	; AND GET A RESPONSE
	MOVE	R.CP,R.OUT
	CHKSTS			;JUMP ON STATUS
	JRST	RCV.8		;STATUS=0
	JRST	RCV.7		;STATUS=1
	JRST	RCV.S2		;STATUS=2
	JFCL
	JFCL
	JRST	RCV.6		;STATUS=5 MAX.COUNT VIOLATION


;STATUS=5  DATA VIOLATION
RCV.6:	SETVAL	CD.STS,<51>,2
	SETVAL	CD.LEN,<0000>,4
	SETVAL	CD.CNT,<000000>,6
	SETVAL	CD.END,<0>,1
	JRST 	RCV.4A

;STATUS=2...NO DATA AVAILABLE
RCV.S2:	SETVAL	CD.LEN,<0000>,4	;NO DATA AVAILABLE
	SETVAL	CD.STS,<00>,2
	SETVAL	CD.CNT,<000000>,6
	AOS	(R.17)		;BUMP RETURN ADDRESS
RCV.4A:	MOVE	R.IN1,R.OUT	;GET PAGE PTR
	PUSHJ	PP,RELPAG	;GIVE PAGE BACK TO MONITOR
	PUSHJ	PP,DELPAG	;DELETE ENTRY IN PAGE TABLE
	RETURN			;EXIT********
;STATUS=1....UNKNOWN Q-STRUCTURE
RCV.7:	SETVAL	CD.STS,<20>,2
	JRST	RCV.4A		;GO RELEASE PAGE

;STATUS=0....EVERYTHING IS OK!!
RCV.8:	MOVE	R.CP,R.OUT	;SET PTR TO PAGE
	LSH	R.OUT,W2PLSH	;MAKE PAGE ADDR
	HRLM	R.OUT,(R.PT)	;SAVE IT
	HRRM	R.CD,(R.PT)	;ALSO SAVE CD ADDRESS
	GET	TNUM		;GET TRANSACTION NUMBER
	MOVEM	R.OUT,MCSTN##	;SAVE IT
RCV.80:	GETARG	2		;GET RECEIVING ITEM PTR
	MOVE	R.TX,(R.OUT)
	MOVE	R.6,1(R.OUT)	;GET SIZE OF RECEIVING ITEM
	HLLZS	M.TMP2	;ZERO LENGTH
	PUSHJ	PP,GETQ		;UPDATE Q-SPECS

RCV.8A:	GET	TDCNT		;GET # OF TEXT DESC.
	JUMPE	R.OUT,BADERR	;BAD COUNT FROM MCS***
	PUSHJ	PP,FINDTD	;GET ADDRESS OF CURRENT ONE

;NOW, WE'RE READY TO START MOVING THE TEXT INTO THE CD.

RCV.8B:	PUSHJ	PP,GETUNT	;GET A TEXT UNIT
	TSWF	F.TOLG		;WAS IT TOO LONG FOR RCV ITEM
	JRST	R.END		;YES
	HLRZ	R.15,(R.TD)	;GET END INDICATOR
	TRZ	R.15,777700
	JUMPE	R.15,RCV.8C	;JUMP IF CONTINUATION
	CAIE	R.15,ESI.	;IS THIS AN ESI?
	JRST	R.END		;NO, END OF MESSAGE
	TSWF	F.SEG		;YES, ARE WE IN A SEGMENT COMMAND?
	JRST	R.END		;YES, SO LEAVE NOW
RCV.8C:	SOS	R.15,TDCNT(R.CP)	;DECREMENT COUNT
	TRNN	R.15,-1		; IF ANY LEFT
	PUSHJ	PP,GETMORE	;THEN GET MORE
	CHKSTS
	JRST	RCV.8A		;SKIP OVER ESI AND GET NEXT UNIT
	JRST 	RCV.7		;STATUS=1
	JRST	RCV.S2		;STATUS=2
	JFCL
	JFCL
	JRST	RCV.6		;STATUS=5
	SUBTTL	END OF RECEIVE PROCESSING

;FINISH UP BY STORING SOME DATA ITEMS IN CD

R.END:
;CONVERT AND STORE DATE AND TIME...
	PUSHJ	PP,SAVREG
	GET	DATE
	MOVE	4,R.OUT		;GET DATE
	PUSHJ	PP,TODA1.##	;CONVERT IT TO ASCII
	MOVE	R.15,R.FG	;GET IT IN R15
	PUSHJ	PP,RESREG
	MOVE	R.IN2,CDPTRS+CD.DAT	;GET CD PTR TO DATE
	MOVEI	R.IN1,R.15
	MOVEI	R.13,6		;LENGTH =6
	PUSHJ	PP,SIX.7	;SIXBIT TO ASCII

	GET	TIME
	MOVE	4,R.OUT
	IDIVI	4,^D1000	;SET UP TO COMPUTE TIME
	IDIVI	5,^D10		;SAVE HUNDRETHS OF SECS
	PUSHJ	PP,SAVREG
	PUSHJ	PP,MCSTIM##
	MOVE	R.14,1		;R14=TIME IN SIXBIT
	PUSHJ	PP,RESREG
	MOVE	R.IN1,5		;RETRIEVE HUNDRETHS
	IDIVI	R.IN1,^D10	;SPLIT INTO TENTHS AND HUNDRETHS
	LSH	R.IN1,6		;MAKE ROOM FOR REMAINDER
	ADDI	R.IN1,(R.IN2)	;INSERT THE OTHER DIGIT
	TRO	R.IN1,2020	;CONVERT BOTH TO SIXBIT
	DPB	R.IN1,[POINT 12,R.15,11]  ;STORE IN LEFT 12 BITS OF R15
	MOVE	R.IN2,CDPTRS+CD.TIM
	MOVEI	R.IN1,R.14	;TIME IS IN R14,R15
	MOVEI	R.13,^D8	;LENGTH
	PUSHJ	PP,SIX.7	;CONVERT AND MOVE
	MOVE	R.IN1,[POINT 7,SRCNAM(R.CP)]	;MOVE SOURCE NAME
	MOVE	R.IN2,CDPTRS+CD.SRC
	MOVEI	R.15,^D12
	PUSHJ	PP,TRNFZ	;STRAIGHT TRANSFER ( NULLS TO SPACES )
	GET	TDCNT		;GET TEXT DESC COUNT
	PUSHJ	PP,FINDTD	;FIND CURRENT TEXT DESC
	HRRZ	R.15,M.TMP2	;GET CHAR COUNT IN CURRENT PAGE
	GETARG	2		;GET RECEIVING ITEM PTR
	HRRZ	R.14,1(R.OUT)	;GET LENGTH OF RCV ITEM
	CAML	R.15,R.14	;WHICH IS LESS?
	MOVE	R.15,R.14
	PUSHJ	PP,SAVREG	;R.15 CONTAINS THE LESSER LENGTH
	MOVE	16,[Z	1,2]
	HRRZ	2,R.CD		;GET CD ADDRESS
	ADD	2,CDPTRS+CD.LEN	;SET UP ARGS
	TLZ	2,7777		;GET RID OF GARBAGE
	TLO	2,4		;LENGTH =4
	MOVE	1,R.15		;COPY TEXT LENGTH
	PUSHJ	PP,PD7.##	;CHANGE BINARY TO ASCII AND MOVE
	PUSHJ	PP,RESREG
;STORE END INDICATOR
	HLRZ	R.15,(R.TD)
	TSWF	F.TOLG		;IS MSG BIGGER THAN RCV FIELD?
	SETZ	R.15,		;YES-END KEY=0 THEN
	TRZ	R.15,777700
	ADDI	R.15,"0"	;CONVERT IT TO ASCII
	MOVE	R.14,CDPTRS+CD.END
	IDPB	R.15,R.14	;STORE IT IN CD
	SETVAL	CD.STS,<00>,2	;SET STATUS

;STORE GROUP COUNT
	PUSHJ	PP,SAVREG
	GET	GRPCNT		;GET GROUP COUNT
	HRRZ	2,R.CD
	ADD	2,CDPTRS+CD.CNT
	MOVE	16,[Z	1,2]
	TLZ	2,7777
	TLO	2,6		;LENGTH IF ITEM IS 6
	MOVE	1,R.OUT		;COPY VALUE
	PUSHJ	PP,PD7.##
	PUSHJ	PP,RESREG

;NOW, WE HAVE TO CHECK IF WE'RE AT THE END OF A TRANSACTION
	TSWF	F.TOLG		;EXIT IF MESSAGE WAS TOO LONG
	RETURN
	SOS	TDCNT(R.CP)	;DECR TUD COUNT
	HLRZ	R.15,(R.TD)	;GET CURRENT END INDICATOR
	TRZ	R.15,777700	;CLEAR OUT JUNK
	CAIGE	R.15,EGI.	;IS THIS AN EGI?
	RETURN			;IF ESI,OR EMI
	PUSHJ	PP,DELPAG	;NO, REMOVE PAGE FROM PAGE-TABLE
	MOVE	R.IN1,R.CP
	PUSHJ	PP,RELPAG	;AND GIVE IT BACK
	RETURN			;EXIT
	SUBTTL	"SEND" MESSAGE TO MCP

;THIS MODULE PROCESSES ALL "SEND" COMMANDS.  IT BUFFERS ALL
;OUTPUT UNTIL AN EMI OR GREATER IS REACHED.  AT THIS POINT,
;THE ENTIRE PAGE IS SENT TO MCP.  HOWEVER, THE TRANSACTION
;IS CONSIDERED TO BE ACTIVE UNTIL AN EGI OR EPI IS FOUND.  WHEN
;THIS OCCURS, THE TRANSACTION PAGE IS FLUSHED FROM THE
;PAGE TABLE.  IF AN EPI IS RECEIVED AND THERE ARE AT LEAST 2 ACTIVE
;TRANSACTIONS, AN EGI IS SUBSTITUTED FOR THE EPI AND AN ERROR CODE
;IS RETURNED TO THE USER.


;TEMPORARY STORAGE:
;M.TMP1	=	DESTINATION COUNT,,TEXT LENGTH
;M.TMP2	=	END INDICATOR VALUE,,TEXT LENGTH (FOR "RECEIVE" ONLY)

M.SEND:	PUSHJ	PP,SETUP
;	HERE WE ARE CHECKING THE DESTINATION COUNT
;	IN THE CD TO MAKE SURE IT IS LESS THEN OR 
;	EQUAL TO LENGTH OF DESTINATION TABLE IN CD

	MOVE	R.IN1,R.CD
	MOVEI	R.IN2,4
	PUSHJ	PP,BINARY	;GET BINARY DESTINATION COUNT

IFN ANS68,<			;[510] OLD COMPILER DEFAULTS TO 0
	SKIPN	R.OUT		;[510] IS DEST.COUNT = 0?
	ADDI	R.OUT,1		;[510] YES - DEFAULT TO 1
>				;[510] END IFN ANS68

	HRLZM	R.OUT,M.TMP1##	;SAVE IT FOR LATER

;FOR COBOL-68 ONLY
;WE CANNOT CHANGE COBOL-74 SINCE FCTC TESTS WILL FAIL
;[635] MAKE JUMPLE A JUMPL
;[635] SUCH THAT A DESTINATION COUNT OF 0 WILL WORK PROPERLY WITH
;[635] A MESSAGE CLASS OF "ALL".
;[635] OTHERWISE AN ERROR CODE OF <30> OCCURS.

IFN ANS68,<
	JUMPL	R.OUT,CASE7	;[635] DESTINATION COUNT MUST BE POSITIVE
>
IFN ANS74,<
	JUMPLE	R.OUT,CASE7	;DESTINATION COUNT MUST BE POSITIVE/ZERO
>
	MOVE	R.6,R.OUT
	GETARG	1		;GET CD-RECORD
	MOVE	R.14,1(R.OUT)	;FIND ITS LENGTH
	SUBI	R.14,^D18	;COMPUTE LENGTH OF TABLE
	IDIVI	R.14,^D13
	CAMG	R.6,R.14	;IS COUNT GREATER THAN TABLE LENGTH?
	JRST	SEND1		;NO
CASE7:
	OUTSTS	<30>
	SWON	F.ERR		;AND SET ERROR FLAG FOR LATER

;CHECK TEXT LENGTH
SEND1:	MOVE	R.IN1,R.CD
	HRLI	R.IN1,100700	;FORM BYTE PTR TO TEXT LENGTH
	MOVEI	R.IN2,4		;SET LENGTH
	PUSHJ	PP,BINARY	;ASCII TO BINARY
	SKIPGE	R.6,R.OUT	;POSITIVE?
	JRST	CASE8		;NO, BOOBOO!!
	HRRM	R.6,M.TMP1	;SAVE IT ALSO FOR LATER
	GETARG	2
	SKIPE	R.OUT		;SKIP IF NO "FROM" CLAUSE
	HRRZ	R.OUT,1(R.OUT)	;GET SENDING ITEM LENGTH
	CAMG	R.6,R.OUT	;LENGTH TOO BIG?
	JRST	SEND2		;NO
CASE8:	OUTSTS	<50>
	SETZ	R.6,		;CLEAR OFFENDING COUNT
	SWON	F.ERR

;CHECK END INDICATOR
SEND2:	GETARG	3
	MOVE	R.IN1,R.OUT
	PUSHJ	PP,ARG3.4	;FIND BINARY VALUE OF END IND.
	HRLZM	R.OUT,M.TMP2##	;SAVE IT
	JUMPN	R.OUT,SEND3	;END INDIC MUST BE NON-0
	JUMPN	R.6,SEND3	;AS WELL AS TEXT LENGTH
	OUTSTS	<60>
	SWON	F.ERR

;CHECK END IND AGAIN
SEND3:
IFN ANS68,<
	JUMPLE	R.OUT,STS61	;[511] END IND MUST BE POSITIVE
>
IFN ANS74,<
				;DO NOT CHANGE THIS OR FCTC TESTS WILL FAIL
	JUMPL	R.OUT,STS61	;END IND MUST BE POSITIVE OR ZERO
>
	CAIG	R.OUT,4		;AND NOT GREATER THAN 4
	JRST	SEND4		;OK
STS61:	OUTSTS	<61>
	SWON	F.ERR
;CHECK ADVANCING ITEM
SEND4:	GETARG	4
	MOVE	R.IN1,R.OUT
	TLNN	R.IN1,-1	;DON'T CHECK IF PAGE OR MNEMONIC
	JRST	SEND5
	PUSHJ	PP,ARG3.4	;FIND VALUE
	JUMPGE	R.OUT,SEND5	;ADVANCING ITEM MUST BE POSITIVE
	OUTSTS	<62>
	SWON	F.ERR		;YES, ERROR

SEND5:	TSWF	F.ERR		;DID WE HAVE ANY ERRORS?
	RETURN			;YES, FLUSH SEND REQUEST
				;NO, FALL THRU TO NEXT PAGE...
	SUBTTL	CHECK FOR ACTIVE TRANSACTION IN "SEND" VERB

;NOW, WE MUST CHECK THE PAGE TABLE TO SEE IF THERE
;IS A CURRENTLY ACTIVE TRANSACTION FOR THIS DESTINATION TABLE.
	SKIPN	R.PT,MCSPT	;IF NO PAGE TABLE...
	PUSHJ	PP,FRMTAB	;..FORM ONE
SEND6:
;NOTE--NO CHECK FOR FULL PAGE TABLE HERE EITHER!
	SKIPN	(R.PT)		;IS THIS ENTRY EMPTY?
	JRST	S.NEW		;YES, NO ACTIVE TRANSACTION
	SKIPL	(R.PT)		;BUT IS THIS AN OUTPUT CD?
	AOJA	R.PT,SEND6	;NO, IGNORE IT
	HLRZ	R.CP,(R.PT)		;GET PAGE NO.
	ANDI	R.CP,777	;GET RID OF INOUT BIT
	LSH	R.CP,P2WLSH	;CONVERT IT TO ADDRESS
	HLRZ	R.6,M.TMP1	;GET DESTINATION COUNT
	CAME	R.6,DSTCNT(R.CP)	;DO THE COUNTS MATCH?
	AOJA	R.PT,SEND6	;NO
	JUMPE	R.6,SEND8	;DON'T CHECK FURTHER IF BOTH COUNT ARE 0
	MOVE	R.IN2,R.CD
	ADDI	R.IN2,2		;MAKE PTR TO CD DEST TABLE
	IBP	R.IN2		;BUMP OVER ERROR KEY
	MOVEI	R.IN1,DSTTAB(R.CP)	;AND PTR TO OTHER TABLE
SEND6A:	HRLI	R.IN1,440700
	MOVEI	R.13,^D12	;COMPARE 12 CHARS
	PUSHJ	PP,COMPAR	;MATCH?
	AOJA	R.PT,SEND6	;NO, KEEP TRYING
	SOJE	R.6,SEND8	;YES, DONE WHOLE TABLE?
	IBP	R.IN2		;NO, BUMP OVER ERROR KEY
	AOJA	R.IN1,SEND6A	;BUMP PAGE PTR

;WE HAVE NOW FOUND AN ACTIVE TRANSACTION IN THE PAGE TABLE
SEND8:	HRRZ	R.6,(R.PT)	;CHECK CD ADDRESS
	HRRZI	R.15,0(R.CD)	;NEED ADDRESS ONLY
	CAIE	R.15,0(R.6)	;IF NOT THE SAME THEN ERROR
	JRST 	SEND8X
	SWON	F.AT		;SET "ACTIVE TRANSACTION"
	MOVEI	R.6,5
	STORE	FC		;SET FUNCTION CODE=5
	PUSHJ	PP,GETCLS	;GET PTR TO MESSAGE CLASS
	MOVE	R.IN1,R.OUT
	MOVEI	R.IN2,CLASS(R.CP)
	TLO	R.IN2,440700	;MAKE PTR TO PAGE MSG CLASS
	MOVEI	R.13,^D8
	PUSHJ	PP,COMPAR	;COMPARE MESSAGE CLASSES
	CAIA			;NO MATCH
	JRST	MS.AT
	OUTSTS	<14>
	JRST	MS.AT
SEND8X:	OUTSTS	<25>
	RETURN


;COME HERE IF NO ACTIVE TRANSACTION EXISTS...
S.NEW:	AOS	M.ATCT##	;BUMP ACTIVE TRANSACTION COUNT
	PUSHJ	PP,GETPAG	;GET A NEW PAGE
	HRRZI	R.CP,0(R.OUT)	;FIX UP ENTRY IN PAGE TABLE
	LSH	R.OUT,W2PLSH	;CONVERT ADDRESS TO PAGE NO.
	TRO	R.OUT,1B18	;SET OUTPUT CD BIT ON
	HRLM	R.OUT,(R.PT)	;SAVE IN PAGE TABLE
	HRRM	R.CD,(R.PT)	;ALSO SAVE CD ADDRESS
	MOVEI	R.6,4
	STORE	FC		;SET FUNCTION CODE=4
	SETZM	TNUM(R.CP)
	HRRZ	R.IN1,MCSTN	;SET TRANSACTION NUMBER FOR NEW SEND
	HRLZM	R.IN1,TNUM(R.CP)	;...
	PUSHJ	PP,SETDST	;MOVE DEST TABLE TO NEW PAGE
	PUSHJ	PP,GETCLS	;GET PTR TO MESSAGE CLASS
SEND10:	MOVE	R.IN1,R.OUT
	MOVEI	R.IN2,CLASS(R.CP)
	TLO	R.IN2,440700
	MOVEI	R.15,^D8	;SET UP TO MOVE MSG CLASS
	PUSHJ	PP,TRNFER	;[517] DO IT ( CONVERT SPACES TO NULLS )
;WE NOW HAVE A PAGE INTO WHICH WE CAN MOVE THE TEXT FROM
;THE SENDING ITEM.  FIRST, WE MUST CREATE A NEW TEXT DESCRIPTOR
;(IF THERE'S ROOM).

;NOTE--R6 MUST REMAIN INTACT FROM HERE...
MS.AT:	PUSHJ	PP,FORMTD	;MAKE A NEW TD
	GETARG	5		;GET "AFTER" FLAG
	HRRZ	R.OUT,(R.OUT)
	SKIPE	R.OUT		;SHOULD WE ADVANCE NOW?
	PUSHJ	PP,ADVANC	;YES
	GETARG	2		;NO, DO IT LATER
	JUMPE	R.OUT,MS.AT2	;JUMP IF NO "FROM" ITEM
	MOVE	R.14,(R.OUT)	;GET ITS PTR
	HRRZ	R.15,M.TMP1	;..AND ITS LENGTH
	SETZB	R.13,R.IN1
	LDB	R.13,[POINT 6,R.14,11]	;GET BYTE SIZE

SEND12:	JUMPE	R.15,MS.AT2	;JUMP IF TEXT LENGTH FINISHED
	ILDB	R.IN1,R.14	;GET CHARACTER
	CAIE	R.13,7		;IS THIS ASCII?
	ADDI	R.IN1,40	;NO, MAKE IT ASCII
	PUSHJ	PP,PUTCHR	;PUT OUT CHAR
	SOJA	R.15,SEND12	;DECREMENT TEXT LENGTH

MS.AT2:	GETARG	5		;CHECK AGAIN FOR ADVANCING
	MOVE	R.OUT,(R.OUT)
	SKIPN	R.OUT		;"AFTER"?
	PUSHJ	PP,ADVANC	;NO, DO ADVANCING NOW

;...TO HERE!!!
	HLRZ	R.6,M.TMP2	;GET END INDICATOR
	CAIE	R.6,EPI.	;IS THIS AN EPI?
	JRST	NOEPI		;NO, GO ON
	HRRZ	R.15,M.ATCT##	;YES, CHECK # OF "AT"S
	CAIGE	R.15,2		;IF THERE ARE OTHERS BESIDES THIS ONE...
	JRST	NOEPI		;NO, THERE ARE NONE
	MOVEI	R.6,EGI.	;THEN CONVERT IT TO AN EGI
	OUTSTS	<63>
NOEPI:	DPB	R.6,ENDPTR	;PUT IN TD
	PUSHJ	PP,WRDCNT	;FILL IN WORD COUNT
	HRRZ	R.15,FC(R.CP)	;IS THIS THE FIRST CALL?
	CAIE	R.15,5
	JRST	S.1ST		;YES, GET A RESPONSE FROM MCP
	CAIGE	R.6,EMI.	;END OF MESSAGE?
	RETURN			;NO, EXIT
	PUSH	R.17,R.6
	PUSHJ	PP,PUTOUT	;SEND CURRENT PAGE
	POP	R.17,R.6
	CAIGE	R.6,EGI.	;END-OF-TRANSACTION?
	RETURN
NOEPI2:	SOSGE	M.ATCT		;DECREMENT TRANSACTION COUNT
	JRST	CNTERR		;****MCP ERROR******
	MOVE	R.IN1,R.CP	;YES, RELEASE OLD PAGE
	PUSHJ	PP,RELPAG
	PUSHJ	PP,DELPAG	;AND SHUFFLE PAGE TABLE
	CAIE	R.6,EPI.	;IF THIS IS A VALID EPI..
	RETURN
	HRRZ	R.PT,MCSPT	;..THEN FLUSH ALL OUTSTANDING
FLUSH:	HLRZ	R.IN1,(R.PT)	;GET PAGE NO.
	ANDI	R.IN1,777	;GET RID OF HIGH BIT
	LSH	R.IN1,P2WLSH	;MAKE INTO ADDRESS
	JUMPE	R.IN1,FLUSH2	;JUMP IF END OF PAGE TABLE
	PUSHJ	PP,RELPAG	;RELEASE THIS PAGE
	PUSHJ	PP,DELPAG	;SHUFFLE TABLE UP
	JRST	FLUSH
FLUSH2:	SETZM	MCSTN##		;CLEAR TRANSACTION NUMBER
	MOVE	R.IN1,R.PT	;NOW, RELEASE PAGE TABLE
	SETZM	MCSPT##
	JRST	RELPAG
;
;COME HERE ON THE FIRST CALL TO MCP FOR A NEW TRANSACTION...
S.1ST:	PUSH	PP,R.6		;SAVE R.6 FOR LATER USE
	PUSHJ	PP,GETPAG	;GET A PAGE TO SEND TO MCP
	MOVE	R.IN1,R.OUT
	PUSHJ	PP,CPYPAG	;COPY OLD PAGE
	MOVE	R.CP,R.OUT	;GET ITS ADDRESS BACK AGAIN
	PUSHJ	PP,MCP.S
	PUSHJ	PP,MCP.R	;GET A RESPONSE
	MOVE	R.CP,R.OUT
	CHKSTS			;WHAT HAPPENED????
	JRST	S.STS0		;STATUS=0
	JRST	S.STS1		;STATUS=1
	JRST	S.STS2		;STATUS=2
	JRST	S.STS3		;STATUS=3
	OUTSTS	<20>
				;STATUS=4 (SAME ERROR CODE AS 3)
	PUSHJ	PP,GETDST	;***FATAL ERROR**
	MOVE	R.IN1,R.CP	;WE MUST FLUSH ENTIRE TRANSACTION
	PUSHJ	PP,RELPAG
	SOSGE	M.ATCT		;[516] FIX UP ACTIVE TRANSACTION COUNT
	JRST	CNTERR		;[516] HANDLE ERROR
	HLRZ	R.IN1,(R.PT)	;GET PAGE NO.
	ANDI	R.IN1,777	;GET RID OF INOUT BIT
	LSH	R.IN1,P2WLSH
	PUSHJ	PP,RELPAG
	POP	PP,R.6		;RESTORE R6
	JRST	DELPAG

S.STS3:	OUTSTS	<20>
	JRST	SEND11
S.STS0:	OUTSTS	<00>
	JRST	SEND11
S.STS1:	OUTSTS	<13>
	JRST	SEND11
S.STS2:	OUTSTS	<10>

SEND11:	PUSHJ	PP,GETDST	;UPDATE ERROR KEYS IN CD
	MOVE	R.IN1,R.CP
	PUSH	PP,TNUM(R.CP)	;SAVE OLD TRANSACTION SEQ NO.
	PUSHJ	PP,RELPAG	;RELEASE RESPONSE PAGE
	HLRZ	R.CP,(R.PT)	;GET PAGE NO.
	ANDI	R.CP,777	;DELETE HI BIT
	LSH	R.CP,P2WLSH	;CONVERT TO ADDRESS
	POP	PP,TNUM(R.CP)	;STORE THE TRANSACTION SEQUENCE NUMBER
				; IN THE OLD PAGE
	CLEARM	TDCNT(R.CP)	;WIPE OUT LAST MESSAGE CHUNK
	POP	PP,R.6		;RESTORE R.6
	CAIGE	R.6,EGI.	;IS THIS AN END OF GROUP OR END OF PROCESS?
	RETURN			;NO LEAVE
	JRST	NOEPI2		;OTHERWISE RETURN TO PROCESS SOME MORE
	SUBTTL	SUBROUTINES FOR "SEND" VERB

;OUTPUT 1 CHARACTER ONTO CURRENT PAGE, IF FULL, OUTPUT THAT PAGE.
;
;ENTER:		R.TD=PTR TO CURRENT TEXT DESC
;		R.IN1=CHAR
;		R.6= CURRENT PAGE TEXT PTR
;
PUTCHR:	CAIE	R.TD,1(R.6)	;[635] HAVE WE REACHED TD WORD
	JRST	PUTCH1		;[635] NO GO ON
	PUSH	PP,R.IN1	;[635] SAVE CHAR
	LDB	R.IN1,[POINT 6,R.6,5] ;[635] GET BIT POINTER 
	CAIN	R.IN1,1		;[635] HAVE WE FILLED LAST BYTE OF WORD
	PUSHJ	PP,PUTCH2 	;[635] YES GET NEW PAGE
	POP	PP,R.IN1	;[635] GET BACK CHAR
PUTCH1:	IDPB	R.IN1,R.6	;[635] DEPOSIT CHAR IN BUFFER
	AOS	1(R.TD)		;[635] BUMP CHAR COUNT
	RETURN			;[635]

PUTCH2:	PUSHJ	PP,SAVTMP	;[635] SAVE SOME TEMPS
	PUSHJ	PP,WRDCNT	;COMPUTE WORD COUNT
	PUSHJ	PP,PUTOUT	;YES, OUTPUT THIS PAGE
	PUSHJ	PP,FORMTD	;FORM A NEW TD
	PUSHJ	PP,RESTMP	;RESTORE TEMPS
	RETURN

;SEND A FULL PAGE TO MCP AND START A NEW ONE
PUTOUT:	PUSHJ	PP,GETPAG	;GET A PAGE
	MOVE	R.IN1,R.OUT
	PUSHJ	PP,CPYPAG	;COPY OLD ONE
	MOVE	R.CP,R.OUT
	PUSHJ	PP,MCP.S
	HLRZ	R.CP,(R.PT)	;GET PAGE NO.
	ANDI	R.CP,777	;SET HIGH BITS TO ZERO
	LSH	R.CP,P2WLSH	;CONVERT TO ADDRESS
	CLEARM	TDCNT(R.CP)	;CLEAR OLD TEXT DESC COUNT
	RETURN
;CREATE A NEW TEXT DESCRIPTOR ON THE CURRENT PAGE.
;
ROOM==5		;THIS VARIABLE INDICATES THE MINIMUM # OF WORDS
		;WHICH MUST BE AVAILABLE ON THIS PAGE.  IF
		;THERE IS LESS THAN THIS NUMBER, THE CURRENT PAGE IS 
		;SENT AND A NEW ONE IS STARTED.  "ROOM" MUST BE AT
		;LEAST 3.
;
FORMTD:	HRRZ	R.OUT,TDCNT(R.CP)	;GET # OF TEXT DESC'S
	JUMPN	R.OUT,FORM2	;JUMP IF THERE ARE TEXT DESC'S
	MOVEI	R.TD,^D512(R.CP)	;NO, RESET ALL STUFF
	MOVEI	R.IN1,TEXT(R.CP)	;PTR TO START OF TEXT
	JRST	FORM3
FORM2:	PUSHJ	PP,FINDTD	;FIND THE LAST TD
	HRRZ	R.IN1,(R.TD)	;GET THE LAST TEXT PTR
	HLRZ	R.14,1(R.TD)	;AND ITS LENGTH
	ADD	R.IN1,R.14	;COMPUTE START OF NEXT FREE HOLE
	ADD	R.IN1,R.CP	;ADD START OF CURRENT PAGE
	TLZ	R.IN1,-1	;CLEAR LEFT HALF
	CAIL	R.TD,ROOM(R.IN1)	;IS THERE ROOM FOR IT
	JRST	FORM3		;YES
	PUSHJ	PP,PUTOUT	;NO, PUTOUT THIS PAGE
	JRST	FORMTD		;..AND START OVER

FORM3:	SUBI	R.TD,2		;BUMP BACK TO NEXT TD PLACE
	MOVE	R.6,R.IN1	;SAVE TEXT POINTER
	HRLI	R.6,440700	;MAKE IT A BYTE PTR
	SUB	R.IN1,R.CP	;CHANGE IT TO OFFSET
	HRLI	R.IN1,440700	;FORM BYTE PTR
	MOVEM	R.IN1,(R.TD)	;STORE PTR
	CLEARM	1(R.TD)		;CLEAR WORD COUNT,,CHAR COUNT
	AOS	TDCNT(R.CP)	;BUMP TEXT COUNT
	RETURN


;COMPUTE WORD COUNT FOR CURRENT TEXT DESCRIPTOR
WRDCNT:	HRRZ	R.14,1(R.TD)
	IDIVI	R.14,5		;CHARS TO WORDS
	SKIPE	R.15
	AOS	R.14
	HRLM	R.14,1(R.TD)
	RETURN
;RETRIEVE THE VALUE OF EITHER ARG3 OR ARG4.  
;
;ENTER:		R.IN1 = ACTUAL ARGUMENT (E.G., 640,,[POINT P,...])
;
;EXIT:		R.OUT = VALUE OF ITEM
ARG3.4:	HLRZ	R.IN2,R.IN1	;GET LEFT HALF OF ARG
	CAIN	R.IN2,100
	JRST	ARG100		;1-WORD COMP
	CAIN	R.IN2,440
	JRST	ARG400		;2-WORD COMP
	CAIE	R.IN2,640	;6-BIT OR ASCII?
	JRST	BADARG		;NO, COMPILER ERROR
	MOVE	R.IN2,1(R.IN1)	;GET LENGTH OF ITEM
	MOVE	R.IN1,(R.IN1)	;AND ITS PTR
	LDB	R.14,[POINT 6,R.IN1,11]	;GET BYTE SIZE
	CAIN	R.14,7		;ASCII?
	JRST	BINARY		;YES, "BINARY" WILL DO THE REST
	PUSHJ	PP,SAVREG	;(JUST IN CASE)
	MOVE	16,[Z	1,2]
	MOVE	2,R.IN1
	TLZ	2,7777
	TLO	2,(R.IN2)	;SET LENGTH
	PUSHJ	PP,GD6.##	;SIXBIT TO BINARY
	MOVE	R.15,1		;COPY ANSWER
	PUSHJ	PP,RESREG
	MOVE	R.OUT,R.15
	RETURN

ARG100:	MOVE	R.OUT,(R.IN1)	;1-WORD COMP
	RETURN
ARG400:	MOVE	R.OUT,1(R.IN1)	;GET LOW-ORDER WORD
	SKIPE	(R.IN1)		;IF HIGH-ORDER WORD IS NOT 0,..
	TLO	R.OUT,1B18	;MAKE VALUE NEGATIVE. (THIS WILL
				;BE FLAGGED AS AN ERROR ON RETURN)
	RETURN
;PERFORM ALL ADVANCING.
;THIS ROUTINE STORES THE CORRECT CHARACTERS IN THE PAGE TO CORRESPOND
;TO THE ADVANCING ITEM.
;
;ENTER:		R.6 = TEXT PTR
;
ADVANC:	GETARG	4		;GET ADVANCING ITEM
	JUMPN	R.OUT,ADV0	;JUMP IF THERE IS ADVANCING
	HLRZ	R.15,M.TMP2	;IS THERE AN END INDICATOR?
	JUMPE	R.15,CPOPJ	;RETURN IF NO END INDICATOR
	MOVEI	R.14,1		;OUTPUT 1 LINE FEED
	JRST	ADV1
ADV0:	TLNN	R.OUT,-1	;IS LEFT HALF=0?
	JRST	ADV2		;YES, ITS A "PAGE" OR CHANNEL NUMBER
	MOVE	R.IN1,R.OUT
	PUSHJ	PP,ARG3.4	;COMPUTE VALUE
	JUMPE	R.OUT,CPOPJ	;EXIT IF "0" LINES
	MOVE	R.14,R.OUT
ADV1:	MOVEI	R.15,LF		;PUT LINE FEED IN R15, COUNT IN R14
	JRST	ADV3
ADV2:	HLRZ	R.15,(R.OUT)	;GET CHANNEL NUMBER
	MOVE	R.15,CHNTAB-1(R.15)	;GET CONTROL CHARACTER
	MOVEI	R.14,1		;OUTPUT 1 OF THEM
ADV3:	PUSHJ	PP,SAVTMP
	MOVEI	R.IN1,CR	;PUTOUT A CR FIRST
	PUSHJ	PP,PUTCHR
	PUSHJ	PP,RESTMP
	MOVE	R.IN1,R.15
	PUSHJ	PP,PUTCHR
	SOJG	R.14,.-2	;LOOP UNTIL ALL CHARS ARE OUT
	RETURN

;TABLE OF CONTROL CHARACTERS FOR LINE PRINTER CONTROL TAPE
CHNTAB:	EXP	FF
	EXP	DLE
	EXP	DC1
	EXP	DC2
	EXP	DC3
	EXP	DC4
	EXP	VT
	EXP	FF

;SUBROUTINES TO SAVE AND RESTORE TEMP REGISTERS
SAVTMP:	POP	R.17,R.IN2
	PUSH	R.17,R.14
	PUSH	R.17,R.15
	JRST	(R.IN2)

RESTMP:	POP	R.17,R.IN2
	POP	R.17,R.15
	POP	R.17,R.14
	JRST	(R.IN2)
;CONVERT A ASCII STRING TO ITS BINARY VALUE
;
;ENTER:		R.IN1 = PTR TO ASCII STRING
;		R.IN2  = LENGTH
BINARY:	PUSHJ	PP,SAVREG
	MOVE	16,[Z	1,2]
	MOVE	2,R.IN1
	TLZ	2,7777
	TLO	2,(R.IN2)
	PUSHJ	PP,GD7.##
	MOVE	R.15,1
	PUSHJ	PP,RESREG
	MOVE	R.OUT,R.15
	RETURN


;COMPUTE A PTR TO THE CD MESSAGE CLASS
GETCLS:	GETARG	1
	HRRZ	R.14,1(R.OUT)
	SUBI	R.14,^D8	;COMPUTE LENGTH OF CD-MSG CLASS
	IDIVI	R.14,5		;CONVERT TO WORDS
	ADD	R.14,R.CD
	JUMPE	R.15,.+3	;REMAINDER?
	IBP	R.14		;YES, BUMP 1 CHAR
	SOJN	R.15,.-1	;LOOP FOR ALL EXTRA CHARS
	MOVE	R.OUT,R.14
	RETURN



;COMPARE 2 TEXT STRINGS
;
;ENTER:		R.IN1, R.IN2 ARE PTRS TO STRINGS
;		R.13 = LENGTH
;
;EXIT:		NORMAL EXIT IF NO MATCH
;		SKIP RETURN IF MATCH
COMPAR:	ILDB	R.14,R.IN1
	ILDB	R.15,R.IN2
	SKIPN	R.14		;SKIP IF A REAL CHARACTER
	  MOVEI	R.14," "	;NO, GET AN ASCII BLANK
	SKIPN	R.15		;SKIP IF A REAL CHARACTER
	  MOVEI	R.15," "	;NO, GET AN ASCII BLANK
	CAME	R.14,R.15	;MATCH?
	RETURN			;NO
	SOJG	R.13,COMPAR
CPOPJ1:	AOS	(R.17)		;BUMP RETURN ADDRESS
CPOPJ:	RETURN
	SUBTTL	INITIALIZE INPUT CD ENTRY

;M.INIT--CALLED WHEN AN INPUT CD SPECIFIES FOR "INITIAL" INPUT.
M.INIT:	PUSHJ	PP,SETUP
	PUSHJ	PP,GETPAG
	MOVE	R.CP,R.OUT
	MOVEI	R.6,1		;FUNCTION CODE=1
	STORE	FC		;STORE IT
	PUSHJ	PP,MCP.S
	PUSHJ	PP,MCP.R
	MOVE	R.CP,R.OUT
	CHKSTS			;WHAT'S THE STATUS?
	JRST	INIT0		;STATUS=0
	JRST	INIT1		;STATUS=1
	JRST	INIT1		;STATUS=2
INITX:	MOVE	R.IN1,R.CP	;EXIT POINT
	JRST	RELPAG		;RELEASE PAGE AND EXIT

INIT0:	PUSHJ	PP,GETQ		;UPDATE Q-SPEC
	GET	GRPCNT		;GET # OF MESSAGE GROUPS
PUTCNT:	PUSHJ	PP,SAVREG
	MOVE	16,[Z	1,2]
	HRRZ	2,R.CD		;GET CD ADDRESS
	ADD	2,CDPTRS+CD.CNT
	TLZ	2,7777		;GET RID OF GARBAGE
	TLO	2,6		;LENGTH=6
	MOVE	1,R.OUT		;SET VALUE
	PUSHJ	PP,PD7.##
	PUSHJ	PP,RESREG
	JRST	INITX		;LEAVE

INIT1:	PUTMUL	CD.Q,< >,^D48	;SPACE OUT ALL QUEUES
	PUTMUL	CD.CNT,<0>,6
	JRST	INITX
	SUBTTL	IF MESSAGE/ACCEPT COUNT

;IF MESSAGE...
M.IFM:	PUSHJ	PP,SETUP	;DO THE SETUP STUFF
	TROA	R.FG,F.IFM	;SET "IF MSG" FLAG AND SKIP

;ACCEPT COUNT
M.AC:	PUSHJ	PP,SETUP
	PUSHJ	PP,GETPAG
	MOVE	R.CP,R.OUT
	MOVEI	R.6,6		;SET FUNCTION CODE
	STORE	FC
	PUSHJ	PP,SETQ		;SET Q-SPEC
	PUSHJ	PP,MCP.S
	PUSHJ	PP,MCP.R
	MOVE	R.CP,R.OUT
	CHKSTS			;HOW'D WE DO?
	JRST	IFM0		;STATUS=0
	SETVAL	CD.STS,<20>,2	;SET STATUS=20
	SETVAL	CD.CNT,<000000>,6
IFMX:	MOVE	R.IN1,R.CP
	JRST	RELPAG		;EXIT

IFM0:	SETVAL	CD.STS,<00>,2
	GET	GRPCNT		;GET GROUP COUNT
	TSWT	F.IFM		;IS THIS AN IFM?
	JRST	PUTCNT		;NO, FORGET ABOUT COUNT
	SKIPLE	R.OUT		;IS THERE A MESSAGE?
	AOS	(R.17)		;;YES, BUMP RETURN ADDRESS
	JRST	PUTCNT		;PROCEED AS ABOVE
	SUBTTL	DISABLE/ENABLE INPUT

;DISABLE INPUT
M.DI:	PUSHJ	PP,SETUP
	MOVEI	R.6,^D7		;FUNCTION CODE=7
	JRST	DI.EI

;ENABLE INPUT
M.EI:	PUSHJ	PP,SETUP
	MOVEI	R.6,^D10	;FUNCTION CODE=10
DI.EI:	PUSHJ	PP,GETPAG
	MOVE	R.CP,R.OUT	;GET A FRESH PAGE
	STORE	FC		;STORE FUNCTION CODE
	PUSHJ	PP,SETPSW	;..AND PASSWORD
	PUSHJ	PP,SETQ		;..AND Q-SPECS
	PUSHJ	PP,MCP.S
	PUSHJ	PP,MCP.R
	MOVE	R.CP,R.OUT
	CHKSTS			;CHECK RESULTS OF MCP SEND
	JRST	EI.0		;STATUS=0
	JRST	EI.1		;STATUS=1
EI.2:	SETVAL	CD.STS,<40>,2	;SET STATUS=40

M.EIX:	MOVE	R.IN1,R.CP
	JRST	RELPAG		;RELEASE PAGE AND EXIT

EI.0:	SETVAL	CD.STS,<00>,2
	JRST	M.EIX

EI.1:	SETVAL	CD.STS,<20>,2
	JRST	M.EIX
	SUBTTL	DISABLE/ENABLE INPUT TERMINAL

;DISABLE INPUT TERMINAL
M.DIT:	PUSHJ	PP,SETUP
	MOVEI	R.6,^D8
	JRST	DITEIT

;ENABLE INPUT TERMINAL
M.EIT:	PUSHJ	PP,SETUP
	MOVEI	R.6,^D11
DITEIT:	PUSHJ	PP,GETPAG
	MOVE	R.CP,R.OUT
	STORE	FC
	PUSHJ	PP,SETPSW	;SET PASSWORD
	PUSHJ	PP,SETQ		;AND Q'S
	MOVE	R.IN1,CDPTRS+CD.SRC
	MOVEI	R.IN2,SRCNAM(R.CP)
	TLO	R.IN2,440700
	MOVEI	R.15,^D12	;SET UP ARGS FOR MOVE
	PUSHJ	PP,TRNFER		
	PUSHJ	PP,MCP.S	;SEND THE PAGE
	PUSHJ	PP,MCP.R
	MOVE	R.CP,R.OUT
	CHKSTS
	JRST	EI.0		;STATUS=0
	JRST	EIT.1		;STATUS=1
	JRST	EI.2		;STATUS=2
	JRST	EI.1		;STATUS=3
	JRST	EIT.1		;STATUS=4
EIT.1:	SETVAL	CD.STS,<21>,2
	JRST	M.EIX
	SUBTTL	DISABLE/ENABLE OUTPUT

;DISABLE OUTPUT
M.DO:	PUSHJ	PP,SETUP
	MOVEI	R.6,^D9
	JRST	DOEO

;ENABLE OUTPUT
M.EO:	PUSHJ	PP,SETUP
	MOVEI	R.6,^D12
DOEO:	MOVE	R.IN1,R.CD
	MOVEI	R.IN2,4		;CONVERT DESTINATION COUNT
	PUSHJ	PP,BINARY	; TO BINARY

IFN ANS68,<			;[510] OLD COMPILER DEFAULTS TO 0
	SKIPN	R.OUT		;[510] IS DEST.COUNT = 0?
	ADDI	R.OUT,1		;[510] YES - DEFAULT TO 1
>				;[510] END IFN ANS68
	JUMPLE	R.OUT,EO.ERR	;DEST COUNT MUST NOT BE NEGATIVE
	MOVE	R.13,R.OUT	;SAVE IT
	GETARG	1
	MOVE	R.14,1(R.OUT)	;GET LENGTH OF CD-ENTRY
	SUBI	R.14,^D18
	IDIVI	R.14,^D13	;COMPUTE # OF "OCCURS"
	CAMG	R.13,R.14	;IS COUNT BIGGER THAN THIS?
	JRST	DO.OK
EO.ERR:	MOVEI	R.IN1,"30"	;BAD DESTINATION COUNT
	DPB	R.IN1,[POINT 14,1(R.CD),34]
	RETURN			;STORE STATUS AND EXIT

DO.OK:	PUSHJ	PP,GETPAG
	MOVE	R.CP,R.OUT
	STORE	FC
	PUSHJ	PP,SETPSW	;SET UP PAGE
	PUSHJ	PP,SETDST	;MOVE ENTIRE DESTINATION TABLE
	PUSHJ	PP,MCP.S	;SEND A PAGE
	PUSHJ	PP,MCP.R	;AND GET ONE BACK
	MOVE	R.CP,R.OUT
	CHKSTS			;HOW DID IT GO?
	JRST	EO.0		;STATUS=0
	JRST	E.STS		;STATUS=1
	JRST	EO.2		;STATUS=2
	JFCL			;STATUS=3 SAME AS 4
	MOVEI	R.IN1,"20"	;STATUS=4
EO.X1:	DPB	R.IN1,[POINT 14,1(R.CD),34]	;STORE STATUS

	PUSHJ	PP,GETDST	;RETURN ERROR KEYS
	MOVE	R.IN1,R.CP
	JRST	RELPAG


EO.2:	MOVEI	R.IN1,"40"
	JRST	EO.X1

EO.0:	MOVEI	R.IN1,"00"
	JRST	EO.X1
	SUBTTL	SUBROUTINES FOR LIBOL-MCS

;MISCELLANEOUS SUBROUTINES FOR LIBOL-MCS

;FORM A NEW PAGE-TABLE (CALLED ONLY ONCE)
FRMTAB:	PUSHJ	PP,ONCE##	;SET UP PID'S, ETC.
	PUSHJ	PP,GETPAG
	MOVE	R.PT,R.OUT	;GET ADDRESS OF NEW PAGE
	MOVEM	R.OUT,MCSPT##
	RETURN



;SAVE IMPORTANT REGISTERS
SAVREG:	POP	17,R.13
	PUSH	17,0
	PUSH	17,1
	PUSH	17,2
	PUSH	17,3
	PUSH	17,4
	PUSH	17,5
	PUSH	17,6
	PUSH	17,7
	PUSH	17,10
	PUSH	17,11
	PUSH	17,16
	JRST	(R.13)



;RESTORE REGISTERS
RESREG:	POP	17,R.13
	POP	17,16
	POP	17,11
	POP	17,10
	POP	17,7
	POP	17,6
	POP	17,5
	POP	17,4
	POP	17,3
	POP	17,2
	POP	17,1
	POP	17,0
	JRST	(R.13)
;RETRIEVES ERROR KEYS FROM DESTINATION TABLE AND STORES
;THEM IN OUTPUT CD.
;
GETDST:	MOVEI	R.IN1,DSTTAB+2(R.CP)	;POINT TO TABLE
	MOVE	R.IN2,R.CD
	ADDI	R.IN2,2		;BUMP PTR TO DESTINATION TABLE
	MOVE	R.6,DSTCNT(R.CP)	;# OF ENTRIES
	JUMPE	R.6,CPOPJ	;EXIT IF NO ENTRIES
GDST0:	HRRZ	R.15,(R.IN1)	;GET WORD FROM PAGE
	TRZ	R.15,777600	;CLEAR OTHER BITS IN CASE OF EXTENSIONS
	ADDI	R.15,"0"	;BINARY TO ASCII
	IDPB	R.15,R.IN2
	ADDI	R.IN1,3		;BUMP PAGE PTR
	ADDI	R.IN2,2		;LIKEWISE FOR CD PTR
	IBP	R.IN2		;SKIP OVER 2 CHARS
	IBP	R.IN2
	SOJG	R.6,GDST0
	RETURN


;RETRIEVES A PASSWORD FROM CD TO CURRENT PAGE
SETPSW:	GETARG	2
	MOVE	R.IN1,(R.OUT)	;GET PTR TO IT
	HRRZ	R.15,1(R.OUT)	;AND LENGTH
	MOVEI	R.IN2,PW(R.CP)
	TLO	R.IN2,440700
	TLNE	R.IN1,(1B11)	;IS THIS A SIXBIT PASSWORD?
	JRST	TRNFER		;NO, ASCII TO ASCII
	MOVE	R.13,R.15	;MOVE LENGTH SPEC
	JRST	SIX.7		;CONVERT SIXBIT TO ASCII


;MOVES A DESTINATION TABLE FROM THE OUTPUT CD TO THE CURRENT PAGE
;
SETDST:	MOVE	R.IN1,R.CD
	MOVEI	R.IN2,4		;SET LENGTH OF DEST COUNT
	PUSHJ	PP,BINARY	;CONVERT TO BINARY
	SKIPN	R.6,R.OUT	;DEST COUNT=0?
	ADDI	R.6,1		;YES-DEFAULT TO 1
	STORE	DSTCNT		;STORE IT ON PAGE
	MOVE	R.IN1,R.CD
	ADDI	R.IN1,2		;BUMP PTR TO TABLE
	MOVEI	R.IN2,DSTTAB(R.CP)
SETD2:	HRLI	R.IN2,440700
	IBP	R.IN1		;SKIP OVER ERROR KEY
	PUSHJ	PP,SETQ1
	AOS	R.IN2
	SOJG	R.6,SETD2
	RETURN
;PERFORM COMMON INITIALIZATION
SETUP:	SKIPN	R.PT,MCSPT##	;GET POINTER TO PAGE TABLE
	PUSHJ	PP,FRMTAB	;NO, GO GENERATE A TABLE
	CLEAR	R.FG,		;CLEAR ALL FLAGS
	GETARG	1		;GET CD-ENTRY
	MOVE	R.CD,(R.OUT)
	RETURN


;MOVE	Q-SPECS FROM CD ENTRY TO CURRENT PAGE
;ENTER:		R.CP, R.CD SET
;
;(R.15 IS DESTROYED)
SETQ:	MOVE	R.IN1,R.CD	;GET CD-Q PTR
	MOVE	R.IN2,R.CP
	ADDI	R.IN2,Q.0	;BUMP TO Q-SPEC
SETQ0:	MOVEI	R.13,4		;MOVE 4 Q'S
SETQ0A:	HRLI	R.IN2,440700	;RESET TO START OF WORD
	PUSHJ	R.17,SETQ1	;DO IT
	AOS	R.IN2		;BUMP PTR TO NEXT Q-SPEC
	SOJG	R.13,SETQ0A	;MOVED ALL 3?
	RETURN			;YES


;GET Q-SPEC FROM CURRENT PAGE AND MOVE IT TO CD ENTRY
GETQ:	MOVE	R.IN1,R.CP	;SOURCE PTR
	ADDI	R.IN1,Q.0
	MOVE	R.IN2,CDPTRS	;CD BYTE PTR
	MOVEI	R.13,4
GETQ0A:	HRLI	R.IN1,440700
	PUSHJ	R.17,GETQ1
	AOS	R.IN1
	SOJG	R.13,GETQ0A
	RETURN
;GET ANOTHER MESSAGE PAGE WHEN THE LAST ONE RAN OUT.
GETMOR:	PUSHJ	PP,MCP.S	;SEND IT TO MCP
	PUSHJ	PP,MCP.R	;GET RESPONSE
	MOVE	R.CP,R.OUT	;PUT PAGE ADDR IN GOOD PLACE
	POPJ	PP,


;FIND THE CURRENT TEXT DESCRIPTOR BLOCK
;
;ENTER:		R.OUT=TEXT COUNT
;
;EXIT:		R.TD=PTR TO TEXT DESC.
FINDTD:	HRRZ	R.TD,R.CP
	ADDI	R.TD,^D510	;START AT LAST TD ENTRY
	HLRZ	R.15,TDCNT(R.CP)	;GET ORIGINAL COUNT
	SKIPN	R.15		;SKIP IF IN A "RECEIVE"
	SOSA	R.15,R.OUT	;GET # OF TD'S FOR "SEND"
	SUB	R.15,R.OUT	;COMPUTE # WE HAVE USED
	LSH	R.15,1		;DOUBLE IT
	SUB	R.TD,R.15	;BACK UP THAT NUMBER OF ENTRIES
	RETURN
;TRANSFER A SERIES OF CHARACTERS. STOP WHEN COUNT
;RUNS OUT. ( CONVERTS SPACES TO NULLS ALONG THE WAY )
;
;ENTER:		R.IN1= SOURCE PTR
;		R.IN2= DEST PTR
;		R.15= LENGTH

SETQ1:	MOVEI	R.15,^D12	;ENTRY FOR MOVING Q-SPECS
TRNFER:	ILDB	R.14,R.IN1	;GET SOURCE BYTE
	CAIN	R.14," "	;CHANGE SPACES...
	SETZ	R.14,		;...TO NULLS
	IDPB	R.14,R.IN2
	SOJG	R.15,TRNFER
	RETURN

; ENTRY SAME AS TRNFER EXCEPT CONVERSION IF FROM NULLS TO SPACES


GETQ1:	MOVEI	R.15,^D12	;ENTRY FOR MOVING Q-SPECS
TRNFZ:	ILDB	R.14,R.IN1	;GET SOURCE CHARACTER
	SKIPN	R.14		;CHANGE NULL...
	MOVEI 	R.14," "	;...TO SPACE
	IDPB	R.14,R.IN2	;STORE DESTINATION CHARACTER
	SOJG	R.15,TRNFZ	;GET THEM ALL
	RETURN

;GET THE NEXT TEXT UNIT(SEGMENT, MESSAGE, ETC.)
;
;ENTER:		R.TD = TEXT DESCRIPTOR PTR
;		R.TX = RECEIVING ITEM PTR
;		R.6  = LENGTH OF RECEIVING ITEM
;
;EXIT:		TEXT DESCRIPTOR UPDATED
GETUNT:	HRRE	R.15,1(R.TD)	;GET CHAR COUNT
	JUMPL	R.15,UNITX	;IF NEGATIVE CHAR COUNT EXIT
	CAMG	R.15,R.6	;ITEM LONGER THAN RECV. ITEM?
	JRST	.+3		;NO
	SWON	F.TOLG		;SET "TOO LONG"
	SKIPA	R.14,R.6	;LENGTH = LESSER OF 2 LENGTHS
	MOVE	R.14,R.15
	LDB	R.13,[POINT 6,R.TX,11]	;GET DEST BYTE SIZE
	JUMPE	R.14,UNITX	;ZERO LENGTH, EXIT
	PUSH	R.17,R.14	;SAVE LENGTH FOR LATER
	MOVE	R.15,(R.TD)	;GET TD BYTE PTR
	LDB	R.IN2,[POINT 6,(R.TD),17]	;SAVE END INDICATOR
	TLZ	R.15,77		;CLEAR INDEX FIELD
	TLO	R.15,R.CP	;SET IT AGAIN
	MOVEM	R.15,(R.TD)	;AND PUT IT BACK
UNIT1:	ILDB	R.15,(R.TD)	;GET CHAR
	CAIE	R.13,6		;RCV ITEM IS SIXBIT?
	JRST	UNIT2		;NO, NO CONVERSION
	CAIGE	R.15,140	;LOWER CASE?
	SKIPA	R.IN1,[EXP	40]
	MOVEI	R.IN1,100	;YES
	SUB	R.15,R.IN1	;CONVERT TO SIXBIT

UNIT2:	IDPB	R.15,R.TX	;DEPOSIT IN RECEVING ITEM
	SOS	1(R.TD)		;DECREMENT COUNT
	SOJG	R.14,UNIT1	;THRU?
	POP	R.17,R.14	;COMPUTE NEW LENGTH OF..
	SUB	R.6,R.14	;..RECEIVING ITEM
	HRRZ	R.15,M.TMP2	;GET CURRENT LENGTH
	ADD	R.15,R.14	;ADD ADDITIONAL LENGTH
	HRRM	R.15,M.TMP2	;SAVE IT FOR LATER
	DPB	R.IN2,[POINT 6,(R.TD),17]	;RESTORE END INDICATOR

UNITX:	RETURN			;YES


;CONVERT A SIXBIT STRING TO ASCII
;
;ENTER:		R.IN1 = PTR TO SIXBIT STRING (NOT BYTE PTR)
;		R.IN2 = BYTE PTR TO DESTINATION
;		R.13  = LENGTH
SIX.7:	TLO	R.IN1,440600
SIX.7L:	ILDB	R.OUT,R.IN1	;GET SIXBIT BYTE
	SKIPE	R.OUT		; DON'T CONVERT SPACES
	ADDI	R.OUT,40	;CONVERT
	IDPB	R.OUT,R.IN2
	SOJG	R.13,SIX.7L
	RETURN
;REMOVE A PAGE-TABLE ENTRY AND SHUFFLE THE REST OF THE TABLE UP
DELPAG:	MOVEI	R.IN1,1(R.PT)
	CLEARM	(R.PT)		;DELETE CURRENT ENTRY
DEL2:	SKIPN	(R.IN1)		;END OF TABLE?
	RETURN
	MOVE	R.15,(R.IN1)
	MOVEM	R.15,(R.PT)	;MOVE ENTRY DOWN 1 WORD
	CLEARM	(R.IN1)
	AOS	R.PT
	AOJA	R.IN1,DEL2


;COPY CONTENTS OF A COMPLETE PAGE
;
;ENTER:		R.CP = PTR TO OLD PAGE
;		R.IN1= PTR TO NEW PAGE
CPYPAG:	HRL	R.IN1,R.CP
	MOVEI	R.IN2,^D511(R.IN1)
	BLT	R.IN1,(R.IN2)
	RETURN


;RECEIVE A PAGE FROM MCP
MCP.R:	PUSHJ	PP,SAVT##	;SAVE T1-T4
	PUSHJ	PP,RECPAG##	;CALL RECEIVE PAGE
	JRST	RCVERR		;ERROR
	HRRZ	R.OUT,T1	;GET PAGE NUMBER
	LSH	R.OUT,P2WLSH	;MAKE INTO AN ADDRESS
	HRLS	TDCNT(R.OUT)	;SAVE ORIGINAL TEXT COUNT
	RETURN			;(THIS ALSO RESTORES T1-T4)


;SEND A PAGE TO MCP
;NOTE--THE "R.CP" PAGE IS SEND TO MCP, NOT THE "R.IN1" PAGE!!!
MCP.S:	PUSHJ	PP,SAVT		;SAVE TEMP REGS
	MOVE	R.IN1,R.CP	;GET ADDRESS OF PAGE TO SEND
	LSH	T1,W2PLSH	;MAKE INTO A PAGE NUMBER
	PUSHJ	PP,SNDPAG##	;DO IT
	JRST	SNDERR		;BAD RETURN
	RETURN			;RETURN AND RESTORE T1-T4


;RELEASE CUSTODY OF A PAGE
RELPAG:	PUSHJ	PP,SAVT
	HRRZS	R.IN1		;JUST INCASE OF A WISE PERSON
	MOVE	T1,R.IN1	;GET ADDRESS OF PAGE TO GET RID OF
	LSH	T1,W2PLSH	;MAKE INTO A PAGE NUMBER
	PUSHJ	PP,KILPAG##	;KILL IT
	RETURN			;RESTORE AND RETURN


;GET A FREE PAGE FROM THE MONITOR
GETPAG:	PUSHJ	PP,SAVT
	SKIPE	PAGLST##	;[635] Is there a page on the free chain?
	JRST	GETPG3		;[635] Yes - go get next one
GETPG1:	PUSHJ	PP,GTPAG.##	;[635] NO, GET PAGE FROM IPCF
	  JRST	CRTERR		;NO PAGES AVAILABLE
	PUSH	R.17,T1		;SAVE THE AGE NUMBER
	PUSHJ	PP,CRPAG.##	;CREATE IT IN ADDRESS SPACE
	JRST	[POP	R.17,T1	;RESTORE T1
		JRST	CRTERR]
	POP	R.17,T1		;RESTORE THE PAGE NUMBER
GETPG2:	LSH	T1,P2WLSH	;[635]
	MOVE	R.OUT,T1	;PUT IN OUT REGISTER
	RETURN			;RESTORE AND RETURN

GETPG3:	PUSHJ	PP,GETPG.##	;[635] Get page from free chain
	  JRST	GETPG1		;[635] Page went away - create one
	JRST	GETPG2		;[635] o do the standard thing
;COMPARE THE Q-SPECS OF THE CD WITH THOSE OF THE
;CURRENT PAGE-TABLE ENTRY TO SEE IF AN ACTIVE TRANSACTION EXITS.
;
;ENTER:		R.PT SET
;
;EXIT:		SKIP RETURN IF A MATCH EXISTS
CMPQ:	HLRZ	R.15,(R.PT)	;GET PAGE NO.
	ANDI	R.15,777	;DELETE BIT
	LSH	R.15,P2WLSH	;CONVERT TO PAGE ADDRESS
	ADDI	R.15,5		;BUMP TO Q-SPEC
	MOVE	R.14,CDPTRS+CD.Q
	MOVEI	R.OUT,4		;COMPARE 4 Q-SPECS
CMPQ1:	HRLI	R.15,440700	;RESET TO START OF WORD
	MOVEI	R.13,^D12	;LENGTH OF Q-SPECS

CMPQ2:	ILDB	R.IN1,R.14	;GET CD CHAR
	CAIN 	R.IN1," "	;SPACE IN CD NAME?
	SETZ	R.IN1,		;YES-CONVERT TO NULL
	ILDB	R.IN2,R.15	;GET PAGE CHAR
	CAME	R.IN1,R.IN2	;MATCH?
	RETURN			;NO, STOP

CMPQ3:	SOJG	R.13,CMPQ2	;THRU?
	AOS	R.15		;BUMP PAGE PTR
	SOJG	R.OUT,CMPQ1	;DONE IT 4 TIMES?
	JRST	CPOPJ1		;YES, A MATCH--RETURN TO CALL+2
	SUBTTL	ERROR PROCESSING FOR LIBOL-MCS
LCMFTL:: OUTSTR	[ASCIZ/?Cannot connect to MCS-10/]
	JRST	ALLERR

;ERROR IN CREATING A NEW PAGE
CRTERR:	OUTSTR	[ASCIZ /?Free page cannot be found/]
	JRST	ALLERR

;ERROR IN SENDING A PAGE
SNDERR:	OUTSTR	[ASCIZ /?Cannot send page to IPCF/]
	JRST	ALLERR

;CANNOT RECEIVE A PAGE FROM LCMIPC
RCVERR:	OUTSTR	[ASCIZ /?Cannot receive a page from MCS/]
	JRST	ALLERR

;NOT ALL ACTIVE TRANSACTIONS WERE CORRECTLY FLUSHED FROM SYSTEM--
CNTERR:	OUTSTR	[ASCIZ /?Fatal--Spurious transaction pages found/]
	JRST	ALLERR

;A NULL TEXT COUNT WAS PASSED BACK BY MCP
BADERR:	OUTSTR	[ASCIZ /%Fatal--Null text count received from MCP
/]
	JRST	RCV.6		;[635] Go to RCV.6, not RCV.4 (causes loop)

;BAD TRANSACTION NUMBER
BADREQ:	OUTSTR	[ASCIZ /?Fatal--Bad transaction number from MCP/]
	JRST	ALLERR

;BAD STATUS CODE RETURNED FROM MCP
E.STS:	SKIPLE	R.15		;CHECK FOR LEGAL ERROR CODE
	  SETZ	R.15,		;NOT..
	OUTSTR	[ASCIZ /?Fatal error detected by MCS-10 /]
	OUTSTR	@CONERS(R.15)	;APPEND ERROR FOUND
	JRST	ALLERR
[ASCIZ/(system is not accepting debug MPPs)/]				;-6
[ASCIZ/(asking for new transaction but never EPI'ed the previous)/]	;-5
[ASCIZ/(asking for more data beyond EGI)/]				;-4
[ASCIZ/(asking for old transaction but no current found)/]		;-3
[ASCIZ/(appending to old output but no current found)/]			;-2
[ASCIZ/(LCM sent an invalid function code)/]				;-1
CONERS:	[ASCIZ/(whoops! MCS-10 returned an invalid error indicator)/]	; 0

BADARG:	OUTSTR	[ASCIZ /?Compiler error--bad argument list/]
ALLERR:	OUTSTR	[ASCIZ /
?Cannot continue
/]
	JRST	STOPR.##


 		END