.TITLE *** STROBE MCR FUNCTION ***
/
/ COPYRIGHT (C) 1975
/ DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
/
/ THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY
/ ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH
/ THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS
/ SOFTWARE, OR ANY OTHER COPIES THEREOF, MAY NOT BE PRO-
/ VIDED OR OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON
/ EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO
/ THESE LICENSE TERMS.  TITLE TO AND OWNERSHIP OF THE
/ SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
/
/ THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE
/ WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COM-
/ MITMENT BY DIGITAL EQUIPMENT CORPORATION.
/
/ DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
/ OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY
/ DEC.
/
	.EJECT
/
/ EDIT #9	MAY 30 75	M. HEBENSTREIT
/ EDIT #10	24 JAN 78	PAUL HENDERSON - INCLUDE I/O COUNT
/				IN PBDL LISTING.
/
/ THIS TASK CAN BE USED TO STROBE A SYSTEM LIST AND DUMP THE CONTENTS
/ ONTO LUN 16.  THE COMMAND LINE FORMAT IS:
/
/	MCR>STROBE LIST
/
/ WHERE LIST IS STL,SCDL,ATL,CKQ,PDVL,PBDL, OR A NUMERIC LISTHEAD ADDRESS.
/
/ THIS TASK STROBES A DEQUE INTO AN INTERNAL BUFFER BEFORE PRINTING
/ THE CONTENTS OF NODES IN THE DEQUE. THIS STROBING PROCESS IS DONE WITH
/ INTERRUPTS INHIBITED TO PREVENT CHANGES TO THE DEQUE.  INTERRUPTS
/ WILL BE INHIBITED IN THIS TASK FOR A LONGER PERIOD OF TIME THAN FOUND IN 
/ THE REST OF THE SYSTEM..  USERS SHOULD TAKE CARE NOT TO USE THIS TASK
/ DURING PERIODS OF TIME WHEN INTERRUPT RESPONSE TIME IS CRITICAL.
/ THE INTERNAL BUFFER BEGINS IN THE INITIALIZATION CODE I.E. THE INITIAL
/ SECTION OF THIS TASK IS OVERLAYED. HENCE, IT IS NOT RESTARTABLE.  THE
/ ASSEMBLY PARAMETER BUFSIZ GOVERNS THE SIZE OF THE BUFFER.
/
/
/
	.IFUND BUFSIZ
BUFSIZ=1700
	.ENDC
/
PBSZ=60		/ PBDL NODE SIZE INCLUDES I/O COUNT		/(010)
/
FAC=174
MCRRI=171
CSIZE=136
FPHDWE=236
SS=163
MM=164
HH=165
X10=10
X11=11
ERRLUN=3
OUTLUN=20
.INH=705522
.ENB=705521
/
	.EJECT
/
/ GET THE UPPER BOUND FOR NODE POINTERS (SAVE THIS AS A 2'S COMP.)
/
BUFF	LAC*	(CSIZE		/GET CORE SIZE
	TCA			/NEGATE
	TAD	(77777		/ADD 32K-1
	SPA			/IS CORE SIZE >32K?
	JMP	BUFF1		/YES -- USE 32K AS UPPER BOUND
	LAC*	(CSIZE		/NO -- USE CORE SIZE AS UPPER BOUND
	SKP
BUFF1	LAC	(77777
	AAC	-11		/BE SURE THERE'S ROOM FOR THE NODE CONTENTS
	TCA			/SAVE THE LIMIT AS A 2'S COMP
	DAC	PTRMSK
/
/ GET THE 1ST MEANINGFUL CHARACTER IN COMMAND LINE
/
	JMS*	(FAC		/READ A CHARACTER
	SAD	(40		/SPACE?
	JMP	.-2		/YES -- IGNORE SPACES
	SAD	(15		/NO -- CARRIAGE RETURN?
	JMP	ERR1		/YES -- ERROR
	SAD	(175		/NO -- ALTMODE?
	JMP	ERR1		/YES -- ERROR
/
/ NOW SCAN THE LINE FOR A POSSIBLE ATL,STL,CKQ,SCDL,PDVL,PBDL INDICATOR
/
	SAD	(101		/NO -- ATL?
	JMP	ATL		/MAYBE
	SAD	(103		/NO -- CKQ?
	JMP	CKQ		/MAYBE
	SAD	(120		/NO -- PDVL OR PBDL?
	JMP	PL		/MAYBE
	SAD	(123		/NO -- SCDL OR STL?
	JMP	SL		/MAYBE
	.EJECT
/
/ NO LIST HAS BEEN EXPLICITLY NAMED, CONSIDER THE PARAMETER TO BE
/ THE ADDRESS OF THE LISTHEAD FOR SOME ARBITRARY LIST.  NOTE THAT 
/ THE LIST HEAD MUST BE IN THE LOWER 32K OF CORE.
/
	DAC	TEMP		/SAVE THE CHAR.
	LAW	-5		/NO -- SET DIGIT COUNTER
	DAC	COUNT
	DZM	NUM		/ZERO PREVIOUS RESULTS
	LAC	TEMP		/PICK UP THE CHAR AGAIN
	SKP
NUM1	JMS*	(FAC		/GET A CHARACTER
	DAC	NUMT		/SAVE IT TEMPORARILY
	AAC	-60		/IS IT A DIGIT?
	SPA
	JMP	NUM2		/NO -- EITHER A BREAK OR AN ERROR
	DAC	CHAR		/SAVE THE POTENTIAL DIGIT
	AAC	-10
	SMA
	JMP	NUM2		/NO -- EITHER A BREAK OR AN ERROR
	LAC	NUM		/YES -- PICK UP THE REAL NUMBER
				/THAT HAS ALREADY BEEN CONSTRUCTED
	CLL
	ALS	3		/SHIFT THE CONTENTS
	TAD	CHAR		/ADD THE DIGIT JUST READ
	DAC	NUM		/SAVE THE RESULTING DECIMAL NUMBER
	ISZ	COUNT		/HAVE 5 DIGITS BEEN READ?
	JMP	NUM1		/NO -- READ SOME MORE
	JMS*	(FAC		/YES -- READ A BREAK CHARACTER
NUM3	DAC	TERM		/SAVE THE BREAK CHAR
	SAD	(15		/MAKE SURE THE BREAK CHAR WAS
	SKP			/EITHER A CR, ALT., OR SPACE.
	SAD	(175
	SKP
	SAD	(40
	SKP
	JMP	ERR1
	DZM	NAME		/CLEAR THE NAME FLAG
	LAC	NUM		/PICK UP THE DECIMAL NUMBER
	DAC	LISTHD		/SAVE THE ADDR. OF LIST HEAD
	SNA			/BE SURE LIST HEAD IS NOT ZERO
	JMP	ERR3		/IT IS -- ERROR
	AAC	-11		/SUBTRACT NODE SIZE -1
				/THIS IS DONE BECAUSE PTRMSK ALREADY HAS BEEN
				/UPDATED FOR NODE SIZE WHICH IS NOT NEEDED FOR
				/HEADER WORDS.
	TAD	PTRMSK		/SUBTRACT THE LIMIT
	SMA!SZA			/IS THIS A LEGAL ADDRESS?
	JMP	ERR3		/NO -- ERROR
	LAW	-12		/SET UP THE WORD COUNT
	DAC	COUNT
	LAC	TERM		/PICK UP THE BREAK CHAR
	JMP	FINDCR+1	/GO LOOK FOR THE LINE TERMINATOR
NUM2	LAW	-5		/CHARACTER IS EITHER A BREAK OR ERROR
	SAD	COUNT		/IF THIS WAS THE 1ST CHARACTER READ
				/ITS AN ERROR. OTHERWIZE ITS A BREAK.
	JMP	ERR1		/ERROR
	LAC	NUMT		/BREAK -- GET THE CHARACTER INTO AC
	JMP	NUM3
CHAR	0
NUM	0
NUMT	0
/
MSGE1	MSGE3-MSGE1/2*1000
	0
	.ASCII "STROBE -- FORMAT ERROR"<15>
MSGE3	ENDMSG-MSGE3/2*1000
	0
	.ASCII "STROBE -- ILLEGAL LISTHEAD"<15>
ENDMSG=.
	.EJECT
/
/ A POSSIBLE STL,ATL,SCDL,PDVL,PBDL,CKQ INDICATOR HAS BEEN TYPED.
/ FIND OUT IF THE PROPER NAME OF THIS LIST HAS BEEN SPECIFIED.
/
/ HERE WE LOOK FOR ATL INDICATORS
/
ATL	LAW	124		/IS NEXT CHAR A T?
	JMS	COMP		/CHECK IT
	LAW	114		/IS NEXT CHAR AN L?
	JMS	COMP		/CHECK IT
	LAC	(244		/IT'S THE ATL, SET UP LISTHD
	DAC	LISTHD
	LAC	(MSGATL		/ENTER THE NAME: ATL
LOC1	DAC	NAME
	LAW	-12		/SET THE NODE DATA COUNT TO 10(10)
	DAC	COUNT
	JMP	FINDCR		/GO LOOK FOR THE LINE TERMINATOR.
/
/ HERE WE LOOK FOR CKQ INDICATORS
/
CKQ	LAW	113		/IS NEXT CHAR A K?
	JMS	COMP		/CHECK IT
	LAW	121		/IS NEXT CHAR A Q?
	JMS	COMP		/CHECK IT
	LAC	(246		/IT'S THE CKQ, SET UP LISTHD
	DAC	LISTHD
	LAC	(MSGCKQ		/ENTER THE NAME: CKQ
	JMP	LOC1
/
/ HERE WE LOOK FOR PDVL AND PBDL INDICATORS
/
PL	JMS*	(FAC		/GET THE NEXT CHAR.
	SAD	(104		/IS IT A D?
	JMP	PDVL		/YES -- MAYBE PDVL
	SAD	(102		/NO -- IS IT A B?
	SKP			/YES -- MAYBE PBDL
	JMP	ERR1		/NO -- ERROR
/
/ HERE WE LOOK FOR A PBDL INDICATOR
/
PBDL	LAW	104		/IS NEXT CHAR A D?
	JMS	COMP		/CHECK IT
	LAW	114		/IS NEXT CHAR AN L?
	JMS	COMP		/CHECK IT
	LAC	(250		/IT'S THE PBDL, SET UP LISTHD
	DAC	LISTHD
	LAC	(MSGPBD		/ENTER THE NAME: PBDL
	DAC	NAME
	LAW	-PBSZ		/SET THE NODE DATA COUNT TO 50(10) /(010)
	XCT*	(FPHDWE		/IS THERE FLOATING POINT HARDWARE?
	AAC	-6		/NO -- RESET COUNT TO 42(10)	/(010)
	DAC	COUNT
	LAC	PTRMSK		/ADJUST PTRMSK FOR BIG NODES
	AAC	+45		/ADD DIFFERENCE IN SIZE
	XCT*	(FPHDWE		/FPP ON SYSTEM?
	AAC	-6		/NO -- SUBTRACT 6
	DAC	PTRMSK		/YES -- SAVE THE NEW VALUE
	JMP	FINDCR		/GO LOOK FOR THE LINE TERMINATOR
	.EJECT
/
/ HERE WE LOOK FOR A PDVL INDICATOR
/
PDVL	LAW	126		/IS THE NEXT CHAR A V?
	JMS	COMP		/CHECK IT
	LAW	114		/IS THE NEXT CHAR AN L?
	JMS	COMP		/CHECK IT
	LAC	(252		/IT'S THE PDVL, SET UP LISTHD
	DAC	LISTHD
	LAC	(MSGPDV		/ENTER THE NAME: PDVL
	JMP	LOC1
/
/ HERE WE LOOK FOR SCDL AND STL INDICATORS
/
SL	JMS*	(FAC		/GET THE NEXT CHAR
	SAD	(124		/IS IT A T?
	JMP	STL		/YES -- MAYBE STL
	SAD	(103		/NO -- IS IT A C?
	SKP			/YES -- MAYBE SCDL
	JMP	ERR1		/NO -- ERROR
/
/ HERE WE LOOK FOR SCDL INDICATORS
/
SCDL	LAW	104		/IS THE NEXT CHAR A D?
	JMS	COMP		/CHECK IT
	LAW	114		/IS THE NEXT CHAR AN L?
	JMS	COMP		/CHECK IT
	LAC	(254		/IT'S THE SCDL, SET UP LISTHD
	DAC	LISTHD
	LAC	(MSGSCD		/ENTER THE NAME: SCDL
	JMP	LOC1
/
/ HERE WE LOOK FOR STL INDICATORS
/
STL	LAW	114		/IS THE NEXT CHAR AN L?
	JMS	COMP		/CHECK IT
	LAC	(242		/IT'S THE STL, SET UP LISTHD
	DAC	LISTHD
	LAC	(MSGSTL		/ENTER THE NAME: STL
	JMP	LOC1
	.EJECT
/
/ NOW WE NEED TO LOOK FOR THE REAL LINE TERMINATOR
/
FINDCR	JMS*	(FAC		/GET THE NEXT CHAR
	SAD	(15		/IS IT A CR?
	SKP			/YES
	SAD	(175		/NO -- IS IT AN ALTMODE?
	SKP			/YES
	JMP	FINDCR		/NO -- IGNORE THIS CHAR
	DAC	TERM		/SAVE THE TERMINATOR
	JMP	GETLST		/GO STROBE THE LIST
/
/ SUBROUTINE COMP -- COMPARE THE NEXT CHAR WITH THE LOWER 7 BITS OF AC
/			RETURN AT JMS+1 IF EQUAL
/			JMP TO ERR1 IF NOT EQUAL
/
COMP	0
	AND	(177
	DAC	TEMP
	JMS*	(FAC
	SAD	TEMP
	JMP*	COMP
	JMP	ERR1
/
	.IFPNZ BUFSIZ-.
	.BLOCK BUFSIZ-.
	.ENDC
BUFEND=.
/
/  **************THE CODE BELOW HERE IS OVERLAYED********************
/
	.EJECT
/
/ STROBE THE LIST AND PUT THE CONTENTS OF EACH NODE IN THE BUFFER
/ THE ENTIRE LIST IS STROBED AT THIS POINT SO NO INTERRUPTS ARE ALLOWED.
/ ALSO THE TIME OF DATE IS OBTAINED FROM SCOM AND SAVED.
/
GETLST	LAC	(BUFF-1		/INIT. X10 TO START OF BUFFER
	DAC*	(X10
	.INH
	LAC*	(SS		/GET THE TIME OF DAY FROM SCOM AND SAVE IT
	DAC	TSS
	LAC*	(MM
	DAC	TMM
	LAC*	(HH
	DAC	THH
/
	LAC*	LISTHD		/GET THE PTR TO 1ST NODE
	SAD	LISTHD		/CHECK TO SEE IF LIST IS EMPTY
	JMP	NOLIST		/LIST IS EMPTY SO DON'T TRY TO STROBE
	JMS	NXMCHK		/CHECK FOR A POSSIBLE NXM
LOC2	TAD	(-1		/SET X11 TO ACCESS NODE
	DAC*	(X11
	LAC	COUNT		/SET UP TEMP AS A COUNTER FOR NO. OF WDS. IN NODE
	DAC	TEMP
	LAC*	X11		/TRANSFER CONTENTS OF NODE TO BUFFER
	DAC*	X10
	ISZ	TEMP
	JMP	.-3
	LAC*	ADDR		/GET THE ADDR OF NEXT NODE
	SAD	LISTHD		/END OF LIST?
	JMP	PRINT		/YES
	JMS	NXMCHK		/CHECK FOR A POSSIBLE NXM
	LAC	COUNT		/CHECK TO SEE IF NEXT NODE
	TCA			/CAN FIT IN BUFFER
	TAD*	(X10
	IAC
	TCA
	TAD	(BUFEND
	SPA
	JMP	ERR		/IT CAN'T -- ERROR
	LAC	ADDR		/IT CAN -- PROCESS NEXT NODE
	JMP	LOC2
/
ERR	.ENB			/ENABLE INTERRUPTS BEFORE PRINTING MESSAGE
	LAC	(MSGE2
	DAC	WRT+4
	LAC*	(X10
	DAC	TEMP2
	CAL	WRT
	CAL	WAIT
	LAC	TEMP2
	DAC*	(X10
	JMP	PRINT+1
/
NOLIST	CLC			/SET THE NO LIST FLAG
	DAC	NONODE
	JMP	PRINT
/
/ SUBROUTINE NXMCHK -- CHECK THE POINTER FOR A POSSIBLE NXM
/
/	ON ENTRY AC HAS ADDRESS OF NEXT NODE
/	IF ALL'S WELL AC HAS SAME ADDRESS ON RETURN
/	IF AN ERROR IS FOUND THE SCAN MUST STOP
/
NXMCHK	0
	DAC	ADDR		/SAVE THE ADDR OF NEXT NODE
	SNA			/IS ADDRESS ZERO -- THAT'S ILLEGAL?
	JMP	NXM		/YES -- ERROR
	TAD	PTRMSK		/NO -- ADD THE 2'S COMP OF UPPER LIMIT
	SMA!SZA			/IS ADDR WITHIN LIMITS?
	JMP	NXM
	LAC	ADDR		/YES -- RETURN WITH ADDR IN AC
	JMP*	NXMCHK
NXM	.ENB			/NO -- ENABLE INTERRUPTS
	LAC	(MSGE5		/PREPARE TO PRINT A MESSAGE
	JMP	ERR+2
	.EJECT
/
/ HERE WE ENABLE INTERRUPTS AND DUMP THE CONTENTS OF THE LIST
/
PRINT	.ENB
	LAC*	(X10		/REMEMBER THE END OF THE BUFFER
	DAC	DATAN
	LAC	NONODE		/HAVE THERE BEEN ANY NODES FOUND?
	SZA
	JMP	PRINT1		/NO -- NO NODES ARE IN THE LIST
	LAC	DATAN		/YES -- THERE ARE NODES IN THE LIST
	SAD	(BUFF-1		/HAS ANY DATA GONE INTO THE BUFFER?
	JMP	EXIT		/NO -- EXIT
				/YES
/
PRINT1	LAC	(MSGFF		/PRINT A HEADER
	JMS	OUTLIN
	LAC	(MSGBL
	JMS	OUTLIN
	LAC	(MSGBL
	JMS	OUTLIN
/
	LAC	NAME		/WAS THE LIST NAMED?
	SZA
	JMS	OUTLIN		/YES -- PRINT THE NAME
	LAC	(MSGBL		/NO -- PRINT BLANK LINE
	JMS	OUTLIN
/
	LAC	(OUTBUF
	JMS	IPACK		/PREPARE TO PRINT THE TIME
	LAC	THH		/SET UP TO PRINT HOURS
	JMS	PDNUM
	LAC	TMM		/SET UP TO PRINT MINUTES
	JMS	PDNUM
	LAC	TSS		/SET UP TO PRINT SECONDS
	JMS	PDNUM
	LAC	(15		/FINISH THE LINE
	JMS	PACK
	LAC	(OUTBUF		/PRINT THE LINE
	JMS	OUTLIN
	LAC	(MSGBL
	JMS	OUTLIN
/
	LAC	NONODE		/WERE THERE ANY NODES IN THE LIST?
	SNA
	JMP	OUTPUT		/YES -- PREPARE TO DUMP THE LIST
	LAC	(MSGNO		/NO -- PRINT A MESSAGE
	JMS	OUTLIN
	JMP	EXIT
	.EJECT
/
/ HERE WE DUMP TO LIST
/
OUTPUT	LAC	(BUFF-1		/SET UP X10 TO ACCESS BUFFER
	DAC*	(X10
/
LOC3	LAC*	(X10		/PROCESS NEXT NODE -- PRINT THE NAME
	AAC	2
	DAC*	(X11
	LAC	COUNT		/SET UP THE COUNTER FOR DATA ITEMS
	DAC	TEMP1
	LAC	(OUTBUF
	JMS	IPACK
	LAC*	X11		/PICK UP 1ST HALF OF NAME
	JMS	CONVRT		/CONVERT FROM SIXBT AND STORE
	LAC*	X11		/PICK UP 2ND HALF OF NAME
	JMS	CONVRT		/CONVERT FROM SIXBT AND STORE
	LAC	(15		/END THE LINE
	JMS	PACK
	LAC	(OUTBUF		/PRINT THE 'NAME' LINE
	JMS	OUTLIN
/
LOC4	LAC	(OUTBUF		/PROCESS NEW LINE
	JMS	IPACK
	LAW	-12		/SET UP WD./LINE COUNTER
	DAC	TEMP
LOC5	LAC*	X10		/GET NEXT DATA ITEM
	LMQ
	JMS	DOIT		/CHANGE DIGITS INTO ASCII
	JMS	DOIT
	JMS	DOIT
	JMS	DOIT
	JMS	DOIT
	JMS	DOIT
	LAC	(40		/END EACH DATA ITEM WITH A SPACE
	JMS	PACK
/
	ISZ	TEMP1		/END OF NODE?
	JMP	LOC6		/NO
	LAC	(15		/YES -- END THE LINE
	JMS	PACK
	LAC	(OUTBUF
	JMS	OUTLIN
	LAC	(MSGBL
	JMS	OUTLIN
	JMP	LOC7
/
LOC6	ISZ	TEMP		/END OF LINE?
	JMP	LOC5		/NO
	LAC	(15		/YES -- FINISH THE LINE OFF
	JMS	PACK
	LAC	(OUTBUF		/PRINT THE LINE
	JMS	OUTLIN
	JMP	LOC4
/
LOC7	LAC*	(MCRRI		/WAS A ^C TYPED?
	SAD	(-1
	JMP	EXIT		/YES -- QUIT
/
	LAC*	(X10		/NO -- END OF DATA?
	SAD	DATAN
	SKP
	JMP	LOC3		/NO -- CONTINUE
	.EJECT
/
EXIT	LAC	TERM		/YES
	SAD	(15
	JMP	EXITCR
	DZM*	(MCRRI
	CAL	(10
EXITCR	CAL	REQMCR
	CAL	(10
	.EJECT
/
/ SUBROUTINE PDNUM -- PACK THE CONTENTS OF THE AC AS A DECIMAL INTEGER
/
/	ALL REGISTERS ARE ALTERED
/
/	RETURN AT JMS+1 UNCONDITIONALLY
/
PDNUM	0
	DAC	PDNV.1		/SAVE THE NUMBER
	LAW	-1		/SET UP DIVISION COUNTER
	DAC	PDNV.2
	LAC	(PDNDIV-1	/SET UP X11 AS A POINTER TO DIVISION TABLE
	DAC*	(X11
PDN1	LAC*	X11		/GET THE NUMBER TO DIVIDE BY
	DAC	PDN2		/SAVE IT IN THE DIVISION AREA
	LAC	PDNV.1		/PICK UP THE NUMBER
	LMQ
	CLA!CLL
	DIV			/DIVIDE BY A POWER OF 10
PDN2	0
	DAC	PDNV.1		/SAVE THE REMAINDER
	LACQ			/GET THE QUOTIENT
	TAD	(60		/ADD 60(8) TO GET AN INTEGER
	JMS	PACK		/STORE ASCII IN BUFFER
	ISZ	PDNV.2		/CHECK THE DIV. COUNTER -- ARE WE DONE?
	JMP	PDN1		/NO -- DIVIDE AGAIN
	LAC	PDNV.1		/YES -- GET THE LAST DIGIT
	TAD	(60		/MAKE IT ASCII
	JMS	PACK		/SAVE IT IN THE BUFFER
	LAC	(57		/END THE NUMBER WITH A SLASH
	JMS	PACK
	JMP*	PDNUM		/RETURN
/
PDNV.1	0
PDNV.2	0
PDNDIV=.
	.DEC
	10
	.OCT
/
	.EJECT
/
/ SUBROUTINE DOIT -- CONVERT HIGH BITS OF MQ INTO ASCII
/
DOIT	0
	CLA
	LLS	3
	AAC	60
	JMS	PACK
	JMP*	DOIT
/
/ SUBROUTINE OUTLIN -- PRINT A LINE 
/
OUTLIN	0
	DAC	WRITE+4
	LAC*	(X10
	DAC	TEMP2
	CAL	WRITE
	CAL	WAIT
	LAC	EV
	SPA
	JMP	ERR4
	LAC	TEMP2
	DAC*	(X10
	JMP*	OUTLIN
/
/ SUBROUTINE CONVRT -- CONVERT AC FROM SIXBT TO ASCII
/
CONVRT	0
	LMQ
	JMS	CON1
	JMS	CON1
	JMS	CON1
	JMP*	CONVRT
/
/ SUBROUTINE CON1 -- CONVERT A CHAR TO ASCII
/
CON1	0
	CLA
	LLS	6
	DAC	TEMP2
	AAC	-33
	SPA!SNA
	AAC	100
	AAC	33
	JMS	PACK
	JMP*	CON1
	.EJECT
/
/ EDIT #1 	APRIL 8, 1974		M. HEBENSTREIT
/
/ THE STANDARD DOS-15 PACKING SUBROUTINES
/ ENTRY TO IPACK WITH AC=BUFFER ADDRESS
/ ENTRY TO PACK WITH AC=CHARACTER
/
/ THIS PAIR OF SUBROUTINES WILL SET UP THE HEADER WORD PAIR AS WELL
/ AS PACK CHARACTERS INTO THE BUFFER.
/
/
SHAL=660000
/
IPACK	0
	DAC	KLBUFH
	TAD	L2
	DAC	KLPUTP
	DZM	KL57
	DZM	CHRCNT
	LAC	(1000
	DAC*	KLBUFH
	JMP*	IPACK
/
PACK	0
	ISZ	CHRCNT
	AND	L177
	DAC	KLCHR2
	CLL
	LAC	KL57
	TAD	(JMP*	KLJ57
	DAC	.+2
	LAC	KLCHR2
	XX
KLJ57	KL571
	KL572
	KL573
	KL574
	KL575
KL571	PAX
	LAC	(1000
	TAD*	KLBUFH
	DAC*	KLBUFH
	PXA
	ALS!SHAL	13
KL571A	DZM*	KLPUTP
	JMP	KLND57
KL572	ALS!SHAL	4
	JMP	KLND57
KL573	RTR
	RAR
	AND	L17
	XOR*	KLPUTP
	DAC*	KLPUTP
	ISZ	KLPUTP
	LAC	KLCHR2
	ALS!SHAL	17
	JMP	KL571A
KL574	ALS!SHAL	10
	JMP	KLND57
KL575	RCL
	DZM	KL57
	SKP
KLND57	ISZ	KL57
	XOR*	KLPUTP
	DAC*	KLPUTP
	LAC	KL57
	SNA
	ISZ	KLPUTP
	LAC	KLCHR2
	JMP*	PACK
/
KL57	0
KLPUTP	0
KLBUFH	0
KLCHR2	0
CHRCNT	0
L2	2
L177	177
L17	17
/
	.EJECT
/
/
ERR1	LAC	(MSGE1
	SKP
ERR3	LAC	(MSGE3
	SKP
ERR4	LAC	(MSGE4
	DAC	WRT+4
	CAL	WRT
	CAL	WAIT
	JMP	EXITCR
/
/
WRITE	2700
	EV
	OUTLUN
	2
	XX
/
WAIT	20
	EV
/
WRT	2700
	EV
	ERRLUN
	2
	XX
/
REQMCR	1
	0
	.SIXBT "..."
	.SIXBT "MCR"
	0
/
	.EJECT
/
MSGFF	MSGBL-MSGFF/2*1000
	0
	.ASCII <14><15>
MSGBL	MSGNO-MSGBL/2*1000
	0
	.ASCII "  "<15>
MSGNO	MSGE2-MSGNO/2*1000
	0
	.ASCII "LIST IS EMPTY"<15>
MSGE2	MSGE4-MSGE2/2*1000
	0
	.ASCII "STROBE -- BUFFER OVERFLOW"<15>
MSGE4	MSGE5-MSGE4/2*1000
	0
	.ASCII "STROBE -- OUTPUT ERROR"<15>
MSGE5	MSGATL-MSGE5/2*1000
	0
	.ASCII "STROBE -- ILLEGAL POINTER"<15>
MSGATL	MSGSTL-MSGATL/2*1000
	0
	.ASCII "ACTIVE TASK LIST"<15>
MSGSTL	MSGSCD-MSGSTL/2*1000
	0
	.ASCII "SYSTEM TASK LIST"<15>
MSGSCD	MSGCKQ-MSGSCD/2*1000
	0
	.ASCII "SYSTEM COMMON LIST"<15>
MSGCKQ	MSGPDV-MSGCKQ/2*1000
	0
	.ASCII "CLOCK QUEUE"<15>
MSGPDV	MSGPBD-MSGPDV/2*1000
	0
	.ASCII "PHYSICAL DEVICE LIST"<15>
MSGPBD	EV-MSGPBD/2*1000
	0
	.ASCII "PARTITION BLOCK LIST"<15>
/
	.EJECT
/
EV	0
PTRMSK	0
NONODE	0
COUNT	0
LISTHD	0
ADDR	0
TEMP	0
TEMP1	0
TEMP2	0
NAME	0
TERM	0
THH	0
TMM	0
TSS	0
DATAN	0
/
OUTBUF	.BLOCK 40
/
	.END