Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-05 - 43,50337/19/simds2.mac
There are 2 other files named simds2.mac in the archive. Click here to see a list.
	PRINTX	SIMDS2.MAC
	SUBTTL	DSFK SIMDDT subroutine

	COMMENT;
	
	Purpose:	To look for a symbol in the keyword table

	Entries:	DSFKI	exact match must be found
			DSFK	A match is accepted if all nonblank
				input characters are found in one and
				only one table entry

	Input arguments:XDSYM1 and XDSYM2 contain symbol identifier
	Normal exit:	DRETUR

	Error exit:	none

	Output arguments:
			XDZKW address of matching keyword entry
				or
				zero if no match

	Call format:	DEXEC	DSFKI
			DEXEC	DSFK

	Used subroutines:none

	;
DSFKI:	PROC
	MDSFK				;Call DSFK to find possible match
	SKIPGE	X0	;[242]
	SETZ	XDZKW,	;[242] No match
	DRETURN
	EPROC

DSFK:	PROC
	LI	XDZKW,LAB(ZKW)
	SETZ	X0,
	DSTACK	X0		;Assume no match initially
LOOP
	LDB	X0,[POINT 6,XDSYM1,5]-$$RELO($$BAS)
	LDB	X1,[POINT	6,1(XDZKW),5]-$$RELO($$BAS)
	IF	;First 6 char's could match
		CAMLE	X0,X1
		GOTO	FALSE
	THEN	;This must be a match or we have no full match
		CAME	X0,X1
		GOTO	LAB(L2())		;No more match possible
		IF	;More than 6 char's
			L	X1,1(XDZKW)
			L	X0,XDSYM1
			JUMPE	XDSYM2,FALSE
		THEN
			IFOFF	ZKWLNE
			GOTO	LAB(L1())	;No match possible if table
						;entry is six letters only
						;Try next entry
			CAME	XDSYM1,1(XDZKW)
			GOTO 	LAB(L1())	;No match possible
						;First six letters must match
			L	X0,XDSYM2
			L	X1,2(XDZKW)
		FI
		;Compare part of first or last six letters
		IF	;Exact match
			CAME	X0,X1
			GOTO	FALSE
		THEN	;Signal exact match to DSFKI
			DUNSTK	X0
			DRETUR
		FI

		DSTACK	X0			;Save XDSYM1 or XDSYM2
		LI	X0,77
		LOOP	;Try to match symbol against part of table entry
			IOR	X1,X0
			XOR	X1,X0
		AS
			CAMN	X1,(XDSTK)
			GOTO	FALSE		;Match found
			LSH	X0,6
			JUMPN	X0,TRUE		;Blank next table character
			DUNSTK	X0
			GOTO	LAB(L1())	;All letters blank, try next entry
		SA
		;Partial  match found
		DUNSTK	X0
		IF	;A previous match exists
			SKIPN	,(XDSTK)
			GOTO	FALSE
		THEN	;Ambiguous keyword, failure
			SETZM	,(XDSTK)
			GOTO	LAB(L2())	;Exit, no match found
		FI
		;The right entry may have been found, check rest

		ST	XDZKW,(XDSTK)		;Save table entry in stack

	FI
AS
	;Try next entry
L1():!
	IFON	ZKWLNE
	AOJ	XDZKW,		;Table entry has 12 letters in name
	ADDI	XDZKW,2
	CAIG	XDZKW,LAB(ZKWL)
	GOTO	TRUE		;Next table entry exists
SA
L2():!	;Exit, stack is 0 or table entry address
	DUNSTK	XDZKW		;Return value
	SETO	X0,		;Signal no exact match to DSFKI
	DRETUR
	EPROC
	SUBTTL	DSTC SIMDDT subroutines

	Comment;

	Purpose:	To check if an input ascii character is valid
			If so convert character to sixbit code

	Entries:
			DSTCR	Relational characters and characters in
				SIMULA identifiers are accepted
			DSTCS	Only characters in SIMULA identifiers are accepted

	Input arguments:XDBYTE holds input ascii character

	Normal exit:	Skip DRETURN

	Error exit:	DRETUR, input not accepted

	Output argument:XDBYTE holds sixbit character if valid
			otherwise

			XDBYTE unchanged

			X1 address of valid character in table, used in DSGI

	CALL FORMAT:	DEXEC	DSTCR
			DEXEC	DSTCS

	SUBROUTINES:	NONE

	;

	PROC
DSTCSR:	;Accept relational characters
DSTCR:
	LI	X1,LAB(L3())
	GOTO	LAB(DSTC.1)
DSTCL:	;[304] Accept letters and '_' only
	LI	X1,LAB(L4())
	GOTO	LAB(DSTC.1)
DSTCS:	;Accept characters in symbols
DSTC:
	LI	X1,LAB(L1())
DSTC.1:	ST	XDBYTE,LABB(YDST1)

LOOP
	IF
		HLRZ	X0,(X1)
		CAMLE	X0,LABB(YDST1)
		GOTO	FALSE		;Not right entry
		HRRZ	X0,(X1)
		CAMGE	X0,LABB(YDST1)
		GOTO	FALSE		;Not right entry
	THEN	;Entry valid
		L	XDBYTE,LABB(YDST1)
		XCT	,1(X1)		;Convert to sixbit
		AOS	,(XDSTK)
		DRETUR			;Skip return, XDBYTE holds sixbit char.
	FI
AS	;Try next entry
	ADDI	X1,2
	CAIG	X1,LAB(L2())
	GOTO	TRUE
SA
	;No match
	L	XDBYTE,LABB(YDST1)
	DRETUR				;Return, XDBYTE unchanged
	;Conversion table
	;Two words per group of ascii characters
	;First halfword gives lower limit of ascii character
	;Second halfword gives upper limit
	;Second word gives conversion instruction


L3():!	;Relational characters
	XWD	057,057
	SUBI	XDBYTE,040
	XWD	074,076
	SUBI	XDBYTE,040	;Convert to sixbit
	XWD	134,134
	SUBI	XDBYTE,040
DSTC01:	;			Used in DSGI

L1():!	;Symbol characters
	XWD	"0","9"
	SUBI	XDBYTE,040
L4():!	XWD	"@","Z"		;@,A TO Z ;[304] Reordered to exclude digits
	SUBI	XDBYTE,040
	XWD	137,137		;_
	SUBI	XDBYTE,040
	XWD	043,044		;# $
	SUBI	XDBYTE,040
	XWD	140,172		;Low @,a to z
	SUBI	XDBYTE,100
	XWD	173,173		;LOW #
	LI	XDBYTE,003
L2():!	;LAST TABLE ENTRY
	XWD	175,175		;LOW $
	LI	XDBYTE,004


	EPROC
	SUBTTL	DSIT, SIMDDT Subroutine

	Comment;

	Purpose:	Input text from TTY or file to input text variable
	Entry:		DSIT

	Input arguments:none

	Normal exit:	DRETUR

	Error exit:	none
	Errors generated:Input longer than 135 characters

	CALL FORMAT:	DEXEC	DSIT

	Used subroutines:DSOEM,DSINL,DSCLOS,DSOFTM,IOIG,DSCRTU

	;
DSIT:	PROC
	MDSINL		;[41]
	IFOFFA	YDSITTY	;[41]
	 GOTO	LAB(DSITFI)	;[41]	Input from file
LOOP	;Input text from tty to input text variable
	MOVNI	X1,QDSION			;Max length
	;Initialize input text variable
	;Create byte pointer
	MDSINL

	LOOP
		WHILE	INCHWL	XDBYTE		;Read from tty one
						;character at a time but wait
						;until line is complete
			CAIGE	XDBYTE," "
			 GOTO	FALSE		;Test character
		DO
		L1():!	;Accept character
			AOSG	X1		;[41]  No store after overflow
			IDPB	XDBYTE,LABB(YDSIPO)
		OD
	AS
		JUMPE	XDBYTE,TRUE	;Null char. try next
		CAIN	XDBYTE,QCR
		 GOTO	TRUE		;Skip carriage return
		CAIN	XDBYTE,33	;[242] Replace altmode with LF
		 GOTO	FALSE
		CAIE	XDBYTE,QVT
		 CAIN	XDBYTE,QFF
		  GOTO	FALSE		;Replace VT and FF with LF
		CAIE	XDBYTE,"G"-"A"+1
		 CAIN	XDBYTE,"Z"-"A"+1
		  GOTO	FALSE		;Replace BELL (^G) and EOF with LF
		CAIE	XDBYTE,QLF
		 GOTO	LAB(L1())	;Accept char.
	SA
AS
	;Break character found in input
	LI	XDBYTE,0
	IDPB	XDBYTE,LABB(YDSIPO)	;Store one null character at end of input
	IDPB	XDBYTE,LABB(YDSIPO)	;One extra null to enable DSSKBN
	IF	;Not too many characters
		JUMPG	X1,FALSE
	THEN	;Fix text length, byte pointer
		ADDI	X1,QDSION
		SF	X1,ZTVLNG(XDINT)
		MDSINL
		DRETUR			;Return
	FI
	MDSOEM	QMITOW		;Overflow message
	GOTO	TRUE		;Try to read  new line
SA
DSITFI:	;[41]
	;Read input from file
	SKIPE	XWAC1,YDSIFO(XLOW)	;[242]
	 IFON	ZIFEND(XWAC1)
	  GOTO	LAB(L5())		;End of file
	SETZM	YDSIGS(XLOW)		;Byte pointer reset
	LI	XDRTSR,IOIG
	SETOFA	YDSERE
	DEXEC	DSCRTU			;Inimage
DSIT02:;[304] To be checked on i/o error
	IFONA	YDSUFR
	 GOTO	LAB(L5())		;File error
	IFON	ZIFEND(XWAC1)
	 GOTO	LAB(L5())		;/* End of file
	SETZM	,ZTE%S+QDSION/5+LABB(ZDSZTE)
					;Zero to last word in buffer
	IF	;Command output to TTY if necessary
		SKIPN	,YDSIGS(XLOW)
		GOTO	FALSE
		IFON	ZFITTY(XWAC1)	;[302]
		GOTO	FALSE
	THEN	;Put zero at end of ASCIZ string
		LI	X0,0
		DPB	X0,YDSIGS(XLOW)
		OUTSTR	ZTE%S+LABB(ZDSZTE)
		OUTSTR	LAB(DSOTCL)	;CRLF
		LI	X0," "	;Replace null with space
		DPB	X0,YDSIGS(XLOW)
	FI

	DRETUR
L5():!	;Error or end of file
	SKIPE	XWAC1,YDSIFO(XLOW)	;[242]
	 DEXEC	DSCLOS
	LI	XDMN,QMITTI		;"USE INPUT FROM TTY"
	DEXEC	DSOFTM
	SETONA	YDSITTY			;[304]
	GOTO	LAB(DSIT)
	EPROC
	SUBTTL	DSO, SIMDDT subroutines

	Comment;

	Purposes:	To create a message in the output buffer and/or
			to write the buffer on the user tty and/or the
			output file (defined in USE command or SYSOUT)

	ENTRIES:	DSOFM	Create message and output to current file

			DSOF01
			DSOF	Output to current file

			DSOBM
			DSVOM
			DSOFTM	Create message and output both to current file
				and to tty

			DSVO
			DSOFTA
			DSOFT	Output both to current file and to tty

			DSOTM	Create message and output to tty

			DSOT	Output to tty

			DSOFCR	Output blank line to file if present

			DSOCR	Reset ^O bit

			DSOEM	Output current input buffer and
				output error to tty and file

	Input argument:	XDMN, message number if relevant

	Normal exit:	DRETUR

	Error exit:
	Error exit:	none

	Output argument: Output text pointer initialized

	Call formats: DEXEC	routine-name

	Subroutines used:DSONL,DSPM,IOOG,DSSCI,DSCRTU

	;
DSOTTC:	edit(302) edit(304)
	PROC
	;[302] Non-skip return if USE file is a TTY (not controlling)
	DSTACK	X1
	IFONA	YDSTTY	;[304]
	 GOTO	LAB(L2())
	SKIPE	X1,YDSUFO(XLOW)
	 SKIPL	OFFSET(ZFIOPN)(X1)
	  GOTO	LAB(L2())	;No USE file or not open
	WLF	,ZFIKAR(X1)	;DEVCHR bits
	IFOFFA	ZFITA		;Controlling TTY?
	 IFOFFA	ZFITTY		;No, another TTY?
L2():!	  AOS -1(XDSTK)		;Controlling TTY or no usable TTY
	DUNSTK	X1
	DRETUR
	EPROC

	PROC


DSOFM:	;Create message and output text to file
	MDSPM			;Create message

DSOF:	;Output text to file

	IFONA	YDSTTY		;If current file is controlling tty
	 BRANCH	LAB(DSOT)	;then continue at DSOT and return from there
DSOF01:	;Output to file

	;Current file is not controlling tty
	;Use RTS routine Outimage

	DSTACK	X1
	DSTACK	X2
	DSTACK	XDT3
	DSTACK	XDRTSR

	;Make length of text variable equal to current pos
					edit(242)
	HRRZ	XWAC1,YDSUFO(XLOW)	;[242]
	LF	X0,ZTVCP(XDINT,ZTV%S)
	HRL	X0,X0
	ST	X0,OFFSET(ZFIICP)(XWAC1)

				edit(2)	;[2]
	LI	XDRTSR,IOOG
	IFONA	YDSBOI			;[2]
	 LI	XDRTSR,IOBO		;[2] Call IOBO (Breakoutimage) instead
	DEXEC	DSCRTU			;Call IOOG or IOBO
DSOF02:	;Checked from DSINC2 to find output error on USE file
	SETOFA	YDSUFR
	ST	XDSWIT,YDSWIT(XLOW)

	DUNSTK	XDRTSR
	DUNSTK	XDT3
	DUNSTK	X2
	DUNSTK	X1

	MDSONL

	DRETUR

DSOFCR:	;Output blank line if file USEd (if not a TTY)

	IFOFFA	YDSTTY
	 DEXEC DSOTTC	;[302]
	  DRETUR

	GOTO	LAB(DSOF01)
DSOBM:
DSOFTM:
	;Create message and output to file and tty
	MDSPM
	GOTO	LAB(DSOFT)

DSVOM:	;
	DEXEC	DSOCR		;Inhibit ^O


	MDSPM			;Create message

DSVO:	;Output text to file and tty

	IFONA	YDSOCOM
	 GOTO	LAB(DSOFT)	;If output command
	IFOFFA	YDSDBG		;Only to file in debug mode
	 IFONA	YDSALL
	  BRANCH LAB(DSOF)	;Output to file if command is ALL

DSOFT:
DSOFTA:	;Always to both tty and file even if ALL

	DEXEC	DSOTTC	;[302]
	 BRANCH	LAB(DSOF)	;[302] Output only on another TTY
	;Save position  if both tty and file output
	DSTACK	ZTV%S+OFFSET(ZTVCP)(XDINT)
	MDSOT			;Output to tty
	DUNSTK
	IFONA	YDSTTY
	 DRETUR			;Already done

	;Output to current file

	ST	X0,ZTV%S+OFFSET(ZTVCP)(XDINT)
	BRANCH	LAB(DSOF)	;Continue at DSOF and return there

	EPROC
	PROC
DSOTM:	;Create message and output text to tty

	MDSPM			;Create message

DSOT:	;Output text to tty

	DEXEC	DSOTTC		;[302]
	 BRANCH	LAB(DSOF01)	;[302]
	;Place null char at end of text
	;Position unchanged

	SETZ	X0,
	IDPB	X0,LABB(YDSOPO)

	;Calculate text start address

	OUTSTR	ZTE%S+<QDSION+5>/5+LABB(ZDSZTE)
	IFOFFA	YDSBOI		;[2] Skip <CR><LF> if Breakoutimage
	 OUTSTR	LAB(DSOTCL)	;Output <CR><LF>
	MDSONL

	DRETUR

DSOTCL:	BYTE	(7)QCR,QLF
	EPROC


DSOEM:	PROC
	;Output error to tty and file
	;Call DSOBM but output current input buffer
	;upto last handled character on tty

	IF	;Valid input buffer
		IFONA	YDSINO
		GOTO	FALSE
	THEN
		DEXEC	DSSCI
		SETZ	X0,		;Place null at string end
		DPB	X0,LABB(YDSIPO)
		IF	;[302] USE file is not another tty
			DEXEC DSOTTC
			 GOTO FALSE
		THEN	;Copy accepted part of command to tty
			LI	X0," "
			OUTCHR	X0
			OUTSTR	ZTE%S+LABB(ZDSZTE)
			OUTSTR	LAB(DSOTCL)
		ELSE	;Copy the same info to the other tty
			MDSINL		;Restore input byte pointer
			LI X0," "	;Initial " "
			LOOP
			  MDSOCH	;Copy one char to output
			  ILDB X0,LABB(YDSIPO) ;Next char
			AS		;Long as null char not found
			  JUMPN X0,TRUE
			SA
			LI X0,QCR
			MDSOCH
			LI X0,QLF
			MDSOCH
		FI
	FI
	MDSPM			;Create message
	BRANCH	LAB(DSOFTA)	;Output to both tty and file
	EPROC

DSOCR:	PROC	;Reset ^O bit
	IF	;[302] USE file is not another TTY
		DEXEC	DSOTTC
	 	GOTO	FALSE
	THEN	;Use ordinary TTCALL
		SKPINC
		 DRETUR
		DRETUR
	FI
	DRETUR	;Dummy?

	EPROC

	SUBTTL	DSSCI and DSSK, SIMDDT subroutines

	Comment;
	Purpose:	To load next input character in XDBYTE

	Entries:	DSSCI load next input char in XDBYTE

			DSSKB load next input char in XDBYTE which is not blank or tab

			DSSKBN load next input char in XDBYTE which is not blank or
			tab but start by testing current character

	Normal exit:	DRETUR

	Error exit:	none

	Output argument:XDBYTE is zero if end of input
				otherwise
			XDBYTE is current input char.

	Call format:	DEXEC	DSSCI
			DEXEC	DSSKB
			DEXEC	DSSKBN

	Errors generated:none

	Used subroutines:none

	;
DSSCI:	PROC
	;Load next input byte in XDBYTE and update position field
	;XDBYTE := 0 if no more input characters present

	DSTACK	,LABB(YDSIPO)
	ILDB	XDBYTE,LABB(YDSIPO)
	IF	;Not end of input
		JUMPE	XDBYTE,FALSE
	THEN	;[41] Replace special characters with spaces
		CAIE	XDBYTE,QVT
		 CAIN	XDBYTE,QFF
		  LI	XDBYTE," "		;Replace with blank
		CAIE	XDBYTE,"G"-100
		 CAIN	XDBYTE,"Z"-100
		  LI	XDBYTE," "
		AOS	1(XDINT)		;Update pos
		DUNSTK	LABB(YDSTIC)		;Previous pointer saved here
		DRETUR
	FI
	DUNSTK	,LABB(YDSIPO)			;Restore
	LDB	XDBYTE,LABB(YDSIPO)
	SKIPE	,XDBYTE				;Pointer to first null character
	 ILDB	XDBYTE,LABB(YDSIPO)
	DRETUR

	EPROC

DSSCIR:	;Back up input pointer one character
	IF	;Not at end of input string
		LDB	X0,LABB(YDSIPO)
		JUMPE	X0,FALSE
	THEN	;Back up one step
		L	X0,LABB(YDSTIC)
		ST	X0,LABB(YDSIPO)
		SOS	1(XDINT)
	FI
	DRETUR

DSSKB:	PROC	;Skip blanks and tabs in input text
		;XDBYTE contains first char which is not blank or tab
		; or 0 on end of input

	LOOP
		MDSSCI			;Find next byte
	AS
L1():!		CAIE	XDBYTE," "	;Skip spaces
		 CAIN	XDBYTE,QHT
		  GOTO	TRUE		;and tabs
	SA
	DRETUR
DSSKBN:	;Entry if last input character must be tested first
	LDB	XDBYTE,LABB(YDSIPO)
	GOTO	LAB(L1())

	EPROC
	SUBTTL	DSGI, SIMDDT subroutine

	Comment;

	Purpose:	Get identifier or relation operator from input

	Entries:	DSGIR	Both identifier and relational operator accepted

			DSGI	Identifier accepted, advance input pointer before test

			DSGIS	Identifier accepted, but do not advance input pointer
[304]			DSGIK	As DSGI, but no digits in identifier (keyword)


	Input argument:	none

	Normal exit:	Skip DRETURN when identifier or operator found

	Error exit:	DRETUR when identifier or operator not found

	Errors generated:none

	Output  arguments:XDSYM1 and XDSYM2 contain identifier in sixbit code
			  YDSSYM contains the same

	Call format:	normal

	Used subroutines:DSTCR,DSTC,DSTCL,DSSCI,DSSKB,DSSKBN

	;
	PROC
DSGIR:	;Get identifier or relation operator from input
	LI	X1,LAB(DSTCSR)	;Define entry point for translation
	GOTO	LAB(DSGI.1)	;[242]
DSGIK:	;Get keyword (identif with no digit) from input
	MDSSKB			;Advance input ptr
	LI	X1,LAB(DSTCL)	;[304] Entry point for char translation
	GOTO	LAB(DSGI.1)
DSGI:	;Get identifier from input
	MDSSKB			;Advance input pointer
DSGIS:	;Get identifier from input but do not advance pointer
	LI	X1,LAB(DSTCS)	;Define entry point for translation
DSGI.1:	DSTACK	X1		;Save entry point
	n==1			;Count saved words

	DEXEC	DSSKBN		;Skip blanks and tabs
IF
	MDSSUB			;Translate character
	GOTO	FALSE		;No identifier found
	CAIGE	XDBYTE,'0'	;Identifier may not start with digit
	GOTO	TRUE
	CAIG	XDBYTE,'9'
	GOTO	FALSE

THEN
	SETOFA	YDSRLC
	CAIGE	X1,LAB(DSTC01)
	 SETONA	YDSRLC		;If relational character found
				;all following must also be relational
	;First character valid start of identifier
	SETZ	XDSYM1,	;[242]
	L	XDSYM2,XDBYTE	;[242]

	LOOP
		MDSSCI				;Fetch next character
		JUMPE	XDBYTE,FALSE		;No more input char.
		MDSSUB				;Translate char.
		GOTO	FALSE			;End of identifier
	AS
		IF	;[242] Not yet 12 characters
			TLNE	XDSYM1,(77B5)		;[242]
			GOTO	FALSE
		THEN	LSHC	XDSYM1,6		;Shift one sixbit char
			IOR	XDSYM2,XDBYTE
		FI
		IFONA	YDSRLC
		CAIGE	X1,LAB(DSTC01)
		GOTO	TRUE			;Save character
	SA

	;Fill rest of XDSYM1 and XDSYM2 with blanks
	SKIPN	XDSYM1				;[242]
	 EXCH	XDSYM1,XDSYM2			;[242]
	WHILE
		TLNE	XDSYM1,(77B5)		;[242]
		GOTO	FALSE
	DO
		LSHC	XDSYM1,6
	OD
	AOS	-n(XDSTK)			;Skip return
	STD	XDSYM1,LABB(YDSSYM)		;Save symbol
FI
	DUNSTK
	n==0
	DRETUR

	EPROC
	SUBTTL	DSIFK, SIMDDT subroutine
	PROC
	Comment;
	Purpose:	Find if keyword identifier follows in input buffer

	Entry:	DSIFK

	Input argument:	input pointer (XDINT)

	Normal exit:	skip DRETURN if keyword found

	Error exit:	DRETURN if no keyword

	Output arguments:
			X1 address of ZKW entry if found
			input pointer

	Used subroutines: DSGI and DSFK

	;

DSIFK:	;Find keyword in input

	DSTACK	XDZKW
	IF	;Identifier
		MDSGI
		GOTO	FALSE
	THEN
		MDSFK
		L	X1,XDZKW
		AOS	-1(XDSTK)
	FI

	DUNSTK	XDZKW
	DRETUR

	EPROC
	SUBTTL	DSPM, SIMDDT subroutine

	Comment;

	Purpose:	Put message in output text
			Possible messages:
					SIMDDT error message
					SIMRTS error message
					SIMDDT message with error number
						prefix deleted
					SIMRTS error message where ZYQ has
						to be replaced by ZYD

	Entry:		DSPM

	Input argument:	XDMN message number

	Normal exit:	DRETURN
	Error exit:	none

	Output argument:none

	Call format:	normal

	Used subroutines:DSPOC
	;

DSPM:	PROC
	;Put message in output text
	;XDMN contains message number
	;
	DSTACK	XDT3
	DSTACK	XDT2
	DSTACK	X1
	DSTACK	X0
	DSTACK	XDM1
	DSTACK 	XDM2
	DSTACK	XDM3
	DSTACK	XDMN
DSPM02:	;Invalid error number
	;Check message number

	L	X1,XDMN
	LI	XDM1,"Q"			;Assume ZYQ message
	JUMPE	XDMN,LAB(DSPM01)
	IF	;Not a ZYQ message number
		CAIG	XDMN,QZYQLN
		GOTO 	FALSE
	THEN	;Check for ZYD range
		CAIGE	XDMN,QZYDFN
		GOTO	LAB(DSPM01)		;Wrong number
		CAILE	XDMN,QZYDLN
		GOTO	LAB(DSPM01)
		;Valid ZYD number
		SUBI	XDMN,QZYDFN-QZYQLN-1	;Skip entries in YEMI
		LI	XDM1,"D"

		;Skip ZYDnnn if message is one of the first ZYD messages
		CAIG	XDMN,QMSUPN-QZYDFN+QZYQLN+1	;Last message with
							; suppressed number
		GOTO	LAB(DSPM03)
	FI

	IFONA	YDSERE
	LI	XDM1,"D"		;Replace ZYQ with ZYD if error
	SETOFA	YDSERE			; occurred in SIMDDT
	;Output ZYQnnn or ZYDnnn
	LI	X0,"Z"
	OUTCHA
	LI	X0,"Y"
	OUTCHA
	LI	XDCNT,4			;Output Qnnn or Dnnn
	LSH	X1,^D27
	L	X0,XDM1
	MDSPOC
	OUTCHB
DSPM03:
	;Find entry address to YEMI table
	IDIVI	XDMN,2
	ADD	XDMN,XDBAS
	ADD	XDMN,LAB(YDSDN)
	ADD	XDMN,LAB(YDSMN)

	HRRZ	X1,YDSED-1-DSSTAR(XDMN)		;Fetch YEMI entry for even messages
IF
	JUMPE	XDMN2,FALSE
THEN
	HLRZ	X1,YDSED-DSSTAR(XDMN)		;Fetch YEMI entry for odd messages
FI
	LDB	XDCNT,LAB(<[POINT 4,X1,23]>)	;Save number of words in message
	JUMPE	XDCNT,LAB(DSPM01)		;No words in message

	;Handle type if relevant

	;Find  entry in YEM
	LDB	XDM1,LAB(<[POINT 12,X1,35]>)	;Fetch index
	IDIVI	XDM1,4
	;Find byte pointer -1-XDM2
	L	XDM3,LAB(<[POINT 9,LAB(YDSED-1),26]>)
	ADD	XDM3,XDM1
	ADD	XDM3,LAB(YDSDN)
LOOP
	ILDB	X0,XDM3
AS
	SOJGE	XDM2,TRUE
SA

	;Find word in dictionary
LOOP
	ILDB	XDMN,XDM3		;Fetch word index
	;Check that it is not a control word

	;Scan through YEDL until word interval found
	LI	X1,LAB(YDSEDL-1)
	LOOP
		AOJ	X1,
		LF	X0,YDSDLW(X1)	;Fetch word number
	AS
		CAMLE	XDMN,X0
		GOTO	TRUE		;Interval not reached
	SA
	;Calculate number of characters preceding word in YED

	LF	XDM1,YDSDLC(X1)		;Character count
	LF	X0,YDSDLW(X1,-1)

	SUBI	X1,LAB(YDSEDL)		;Word length
	IF
		JUMPE	X1,FALSE	;Word length is 1
	THEN
		SUB	XDMN,X0
	FI
	LI	X1,1(X1)		;Correct word length
	SOJ	XDMN,
	IMUL	XDMN,X1
	ADD	XDM1,XDMN
	IDIVI	XDM1,6
	ADD	XDM1,XDBAS
	;Find byte pointer in dictionary
	L	XDM,LAB(<[POINT	6,YDSED-1-DSSTAR(XDM1),29]>)	;Char pointer
	LOOP
		ILDB	X0,XDM
	AS
		SOJGE	XDM2,TRUE
	SA

	;Transfer word from YED plus one blank

	LOOP
		ILDB	X0,XDM
		ADDI	X0,40		;Convert to ascii
		OUTCHA
	AS
		DECR	X1,TRUE		;X1 characters
		LI	X0," "-40	;Fetch blank
		JUMPE	X1,1+TRUE
	SA

AS
	DECR	XDCNT,TRUE	;More words in message
SA

	;Exit
	DUNSTK	XDMN
	DUNSTK	XDM3
	DUNSTK	XDM2
	DUNSTK	XDM1
	DUNSTK	X0
	DUNSTK	X1
	DUNSTK	XDT2
	DUNSTK	XDT3
	DRETUR
		DSPM01:	;Invalid message number
	LI	XDMN,QMPMNI		;Invalid message number
	GOTO	LAB(DSPM02)

	EPROC
	SUBTTL	DSIS, SIMDDT subroutine

	Comment;
	Purpose:	To initialize SIMDDT
	Entry:		DSIS
	Input argument:	none
	Normal exit:	RETURN (POPJ XPDP,0)
	Call format:	EXEC DSIS, SIMDDT stack not yet created
	Used subroutines:DSONL,CSNA,DSISRB and DSBUTX

	;
DSIS:	PROC
	ST	XDBAS,YDSBAS(XLOW)		;Save in case first call

	SETON	YDSACT(XLOW)
	L	XDSWIT,YDSWIT(XLOW)

	IF	;Not initialized yet
		IFONA	YDSINI
		GOTO	FALSE
	THEN	;Initialize
		;Create text array ZDSTXT
		MCSNA	QTEXT,1,QDSTN
		ST	XWAC1,YDSTXT(XLOW)	;Save address

		MCSNA	QREF,1,QDSRN		;Create ref array
		ST	XWAC1,YDSREF(XLOW)
		EXEC	LAB(DSISRB)		;Set registers and
						; remove any old breakpoints

		LI	X0,LABB(ZDSZTE)		;Save address of ZDSZTE
		ST	X0,YDSIOT(XLOW)

		HRLI	X1,LAB(DSIS01)		;Create YDSINC entry
		HRRI	X1,YDSINC(XLOW)
		BLT	X1,YDSINC+3(XLOW)


		LI	X0,YDSBSAV(XLOW)	;Relocate breakpoint return
		HRRM	X0,LABB(YDSBRETUR)	;instructions in ZBR
		HRRM	X0,2+LABB(YDSBRETUR)

		LI	X0,YDSBCOM(XLOW)
		HRRM	X0,1+LABB(YDSLEAVE)
		HRRM	X0,2+LABB(YDSLEAVE)
		HRRM	X0,3+LABB(YDSLEAVE)

		SETZM	,LABB(YDSRRA)		;Initialize ZBR
		HRLZI	X0,700000
		ST	X0,LABB(YDSTRA)		;3 elements used


						;Initialize ZBE links
		LI	X0,QBRN*2+3		;First unused ZBE
		HRLZM	X0,LABB(DSZBRU)
		LI	X1,QBRN*2+LABB(DSZBRF)

		LOOP
			ADDI	X0,QZBEL
			HRLZM	X0,(X1)
		AS
			ADDI	X1,QZBEL
			CAIGE	X1,LABB(DSZBRK)
			GOTO	TRUE
		SA

		SETZM	,-QZBEL+LABB(DSZBRK)


		;Find ZLN address for main program

		IF
			L	X1,YDSZLA(XLOW)
			JUMPE	X1,FALSE			;No ZLN table present
		THEN
			LF	X0,ZLNADF(X1)
			ST	X0,LABB(YDSCZS)			;Save start address
								;of current line
								;number table

		FI	ST	X1,YDSZLN(XLOW)			;Save main line number
								; table



		SETONA	YDSINI			;SIMDDT initialized
		SETONA	YDSTTY			;Output via tty
		SETONA	YDSITTY			;Input via tty [41]
	FI
	;Initialize accumulators

	LI	XDZBR,LAB(DSZBRS)
	LI	XDSTK,LABB(DSZBRK)
	HRLI	XDSTK,-QSTAKL+1

	SETZ X1,	;[242]
	IF ;[242] Channel zero is active
	   DEVCHR X1,
	    JUMPE X1,FALSE
	THEN ;[242] Force out any buffer, save non-standard chnl sts
	   HLRZ X1,YIOCHT(XLOW)
	   IF ;Buffers exist
	      JUMPE X1,FALSE
	      LF XBH,ZFIOBH(X1)
	      SOJL XBH,FALSE
	   THEN
	      L XWAC1,X1
	      LF X1,ZBHZBU(XBH)
	      HRRZ OFFSET(ZBHBUP)(XBH)
	      IF ;Something not yet output
		CAIG 2(X1)
		SKIPE 2(X1)
		GOTO TRUE
		GOTO FALSE
	      THEN ;Force out the buffer
		SKIPA
	        SKIPA	;IONB returns here!!
	         XEC IONB
;[302]		OUTSTR LAB(DSOTCL)
	       FI
	   FI
	   GETSTS X1
	   ST X1,LABB(YDSST0)
	   TRZE X1,IO.TEC+IO.SUP+IO.LEM+16
	    SETSTS (X1)
	   CAMN X1,LABB(YDSST0)
	    SETZM LABB(YDSST0)	;Save only non-standard status
	FI ;[242]

	DEXEC	DSBUTX		;Initiate text pointers and stack

	DEXEC	DSPLEE
	;Assume normal switches

	SETONA	YDSDBG
	SETOFA	YDSSTA
	SETOFA	YDSREE
	SETOFF	YDSSUP(XLOW)		;[41]

	ST	XDSWIT,YDSWIT(XLOW)
	RETURN			;Exit DSIS

DSIS01:	;YDSINC entry
	; moved to YDSINC(XLOW) area
	;Call RTS routine from SIMDDT when garbage collection may occur
	;Return address must be valid even if SIMDDT moved by g.c.
	PUSHJ	XPDP,(XDRTSR)
DSIS02:	LOWADR
	L	XDBAS,YDSBAS(XLOW)
	BRANCH	LAB(DSINC)

	EPROC
	SUBTTL	DSISRB, SIMDDT subroutine

	Comment;
	Purpose:	Remove all breakpoints

	Entry:	DSISRB

	Input argument:none

	Normal exit:	Return

	Error exit:	none

	Output arguments:None

	Call format:	EXEC	DSISRB

	Used subroutines:DSRLBI

	;
DSISRB:	;Remove any breakpoints from program
	LI	XDZBR,LAB(DSZBRS)		;Not ok if SIMDDT
						; in high segment

	LI	X1,LABB(DSZBRF)

	LOOP
		LI	XDSTK,LABB(DSZBRK)
		HRLI	XDSTK,-QSTAKL+1
		DEXEC	DSRLBI		;Remove breakpoint instructions
					;if any exist
	AS
		ADDI	X1,2
		CAIGE	X1,2*QBRN+LABB(DSZBRF)
		GOTO	TRUE
	SA


	RETURN
	SUBTTL	DSOC, SIMDDT subroutine

	Comment;
	Purpose:	Put character in output text

	Entries:	DSOCH	put character in output text

			DSOCO	output  if overflow

			DSOCB	put blank in output text
			DSOCT	put tab in output text

	Input argument:	X0 contains character to be stored in outtext

	Normal exit:	DRETUR

	Error exit:	None

	Output argument:None

	Call format:	Normal

	Used subroutine:DSOFT and DSOF
	;

	PROC
DSOCT:	LI	X0,"	"	;Output tab
	GOTO	LAB(DSOCH)
DSOCB:	LI	X0," "		;Output blank

DSOCH:
	IDPB	X0,LABB(YDSOPO)

	LF	X0,ZTVCP(XDINT,ZTV%S)
	AOJ	X0,
	SF	X0,ZTVCP(XDINT,ZTV%S)

	CAIG	X0,QDSION
	DRETUR			;No overflow
DSOCO:	;Entry from DSTXO if line overflow
	;error

	IF
		IFOFFA	YDSALL
		IFOFFA	YDSOBOTH
		GOTO	FALSE
	THEN
		MDSOFT			;Output to both files if overflow
		DRETUR
	FI
	MDSOF				;In debug  mode overflow only
					;to output file
	DRETUR
	SUBTTL	DSOSWS, SIMDDT subroutine

DSOSWS:	;Set switch YDSOBOTH to control output in case of
	;line overflow
	;Called from DSSC,DSCH and DSVA routines

	SETONA	YDSINO
					;[41]
	IFOFFA	YDSDBG
	SETONA	YDSOBOTH

	DRETUR

	EPROC


	SUBTTL	DSONL AND DSINL, SIMDDT subroutines

	Comment;



	Purpose:	Initialize input and output text pointers

	Entries:	DSONL	initialize output text
			DSINL	initialize input text


	Input argument:	None

	Normal exit:	DRETUR

	Error exit:	None

	Output argument:None

	Call format:	DEXEC	DSONL or DEXEC	DSINL

	Used subroutines:None

	;


DSONL:	PROC

	ZF	ZTVCP(XDINT,ZTV%S)

	L	X0,LAB(<[POINT 7,ZTE%S-1+<QDSION+5>/5+LABB(ZDSZTE),34]>)
	ST	X0,LABB(YDSOPO)
	DRETUR

	EPROC

DSICH=DSSCI

DSINL:	PROC
	ZF	ZTVCP(XDINT)

	L	X0,LAB(<[POINT 7,ZTE%S-1+LABB(ZDSZTE),34]>)
	ST	X0,LABB(YDSIPO)
	DRETUR
	EPROC
	SUBTTL	DSPL, SIMDDT subroutine

	Comment;


	Purpose:	Locate address in line number table and
			Put module:nnnnn line number in output text
			or
			put Onnnnnn (octal address) in output text if
			no table entry exists
			or
			put module:Onnnnnn in output text
			if module but not linenumber entry known

	Entries:	DSPL
			DSPLL
			DSPLO
			DSPLE
			DSPLEE	[2]

	Input arguments:XDSTA address

	Normal exit:	DRETUR

	Error exit:	none

	Output argument:XDZLN points at line number table entry if valid entry found
			YDSCZL,YDSZLN and YDSCZS updated if DSPLE entry

	Call format:	Normal

	Used subroutines:DSLO,DSTXPI,DSPOC and DSPSP
	;

DSPL:	PROC

	SETOM	,LABB(YDSSLN)

	IF
		MDSLO			;Locate instruction
		GOTO	FALSE		;Address not in ZLN table

DSPLL:	;Entry if line number entry already known

		ST	X0,LABB(YDSSZN)		; [2] Save ZLN table pointer
		ST	XDT2,LABB(YDSSLN)	;Save block structure entry
		ST	X1,LABB(YDSSLS)		;Save start of ZLN table
		LF	XDZPR,ZLNADF(X1)
		MDSPSP				;Create module name

		LI	X0,":"
		OUTCHA
	THEN	;Create line number nnnnn
		LF	XWAC3,ZLNLIN(XDZLN)	;Fetch line number
						;Remove bit for declaration
		TRZ	XWAC3,200000
		CAIN	XWAC3,QLINEM
		GOTO	LAB(DSPLO)		;Output octal address if linenumber is
						;Max used to signal that program is
						;compiled with -I switch
		MTXPI				;Output  digits


	ELSE
DSPLO:	;Entry if octal number to be put in  outtext

		;Create Onnnnnn octal address
		LI	XDCNT,7
		LI	X0,"O"
		OUTCHA
		LI	X0," "
		HRLZ	X1,XDSTA
		MDSPOC
	FI
	DRETUR

	EPROC
	PROC
DSPLE:	;Call DSPL and change environment variables

	IF	;Valid line no table entry
		MDSLO
		GOTO	FALSE
	THEN
		ST	XDT2,LABB(YDSCZL)
		ST	X0,YDSZLN(XLOW)
		ST	X1,LABB(YDSCZS)
		DEXEC	DSPLL

		IF	;Error mode or breakpoint	;[163] Start of change
			IFOFFA	YDSDBG
			GOTO	TRUE
			IFOFFA	YDSREE
			GOTO	FALSE
		THEN	;Check if XCB and interrupt address are compatible

			L	XDZLN,LABB(YDSCZL)
			LI	X0,LAB(L1())
			DEXEC	DSSS		;Search line number table for blocks
			BRANCH	LAB(DSTERM) 	;Terminating error if block not found

		L1():!
			LF	X0,ZBIZPR(XCB)	;Fetch current prototype
			IF	;Not same as stacked
				CAMN	X0,-1(XDSTK)
				GOTO	FALSE
			THEN
				LF	X1,ZDRZBI(XCB)	;Try calling block
				JUMPLE	X1,FALSE	;None exists
				LF	X0,ZBIZPR(X1)	;New prototype
				CAME	X0,-1(XDSTK)
				GOTO	FALSE		;Calling block not ok
				L	XCB,X1		;Change environment
				LI	X0,0
				HRLM	X0,YDSENR(XLOW)	;Forbid continuation
			FI

			DEXEC	DSSSR		;Exit DSSS
		FI			;[163] End of change
	ELSE	;No valid line found

		;Output block identification
		LF	XDZPR,ZBIZPR(XCB)
		MDSPSP
		OUTCHB

		DEXEC	DSPLO

		;[2]	Try to find prototype in ZLN table
		LF	XDT4,ZBIZPR(XCB)
		DEXEC	DSLPR
		STD	XDT2,LABB(YDSCZL)
		ST	X1,YDSZLN(XLOW)
	FI

DSPLEE:	; [2]
	;Initiate reset and start variables for INSPECT command

	ST	XCB,YDSSXCB(XLOW)
	ST	XCB,YDSRXCB(XLOW)
	LD	XDT2,LABB(YDSCZL)
	STD	XDT2,LABB(YDSSZL)
	STD	XDT2,LABB(YDSRZL)
	L	X1,YDSZLN(XLOW)
	ST	X1,LABB(YDSSZE)
	ST	X1,LABB(YDSRZE)


	DRETUR

	EPROC
	SUBTTL	DSLL and DSLO subroutines

	Comment;

	Purpose:	Locate line number in line number table or
			locate octal address in line number table

	Entries:	DSLL locate line number
			DSLO locate octal address

	Input arguments:
			XDLIN line number and XDT2 address of ZLN table if DSLL call or
			XDSTA octal address if DSLO call

	Normal exit:	Skip DRETUR if valid ZLN entry found

	Error exit:	DRETUR if no valid entry found

	Output argument:XDZLN,	pointer to ZLN entry if valid
			XDT2,	pointer to first block structure entry
			X1,	pointer to start of relevant ZLN TABLE

			X0,	pointer to main ZLN table entry
				Value of YDSZLN(XLOW) if DSLO call

	Errors generated:None

	Call format:	 Normal

	Used subroutines:DSEZLN

	;

	PROC
IF
	;Two different entry points
THEN
DSLL:	;Locate line number in a ZLN table
	SETOM	,LABB(YDSFLG)		;Indicate DSLL entry
ELSE

DSLO:	;Locate octal address in ZLN table

	;Try main ZLN table first
	L	XDT2,YDSZLA(XLOW)
	L	X1,XDT2
DSLO02:
	DSTACK	X1

	IF	;Valid ZLN entry found
		DEXEC	DSLO01
		GOTO	FALSE
	THEN
		DUNSTK
		AOS	(XDSTK)
		DRETURN			;Return from DSLO
	FI
		;Try any external tables
	DUNSTK	X1
	DEXEC	DSEZLN			;Find next external ZLN table
	IF	;No luck
		JUMPN	X1,FALSE
	THEN	;Return from DSLO, no valid ZLN entry found
		DRETUR
	FI
	LF	XDT2,ZSMZLN(XDT2)
	GOTO	LAB(DSLO02)

DSLO01:	;Search one ZLN table
	SETZM	,LABB(YDSFLG)		;Indicate DSLO entry
FI

IF	;There is a ZLN table
	JUMPE	XDT2,FALSE
THEN
	LF	X1,ZLNADF(XDT2)		;First table entry
	LI	XDZLN,1(XDT2)
	;X1 points at first entry
	;XDZLN at last entry +1
	;XDT2 at last entry
DSLC:	;Common part
	WHILE
		SOJ	XDZLN,
		CAME	XDT2,XDZLN
		GOTO	FALSE		;Valid line number entry
		CAMN	XDZLN,X1
		DRETUR			;First entry in ZLN reached, no match
	DO
		;Block structure entry
		LF	XDT2,ZLNBLK(XDZLN)
		ADD	XDT2,X1			;Find previous block structure entry
	OD
	IF	;DSLL entry
		SKIPL	,LABB(YDSFLG)
		GOTO	FALSE
	THEN
		LF	X0,ZLNLIN(XDZLN)
		IF	;Declaration entry
			CAIGE	X0,QLINEM
			GOTO	FALSE
		THEN
			TRZ	X0,200000	;Delete declaration flag
			CAMLE	X0,XDLIN
			GOTO	LAB(DSLC)	;Skip entry if table value>XDLIN
			GOTO	LAB(L2())	;Accept last line entry
		FI
		SOS	,LABB(YDSFLG)
		IF
			CAMGE	X0,XDLIN
			GOTO	FALSE
		THEN
			IF	;Matching line no
				CAME	X0,XDLIN
				GOTO	FALSE
			THEN	;Check if first line entry in table
				DSTACK	XDZLN
				LOOP
					SOJ	XDZLN,
				AS
					CAMN	XDZLN,X1
					GOTO	FALSE		;No line entry found
					LF	X0,ZLNLIN(XDZLN)
					CAILE	X0,QLINEM
					GOTO	TRUE		;Declaration entry
								;or block entry
					DUNSTK XDZLN
					GOTO	LAB(DSLC)	;Try previous line
				SA
				DUNSTK XDZLN
				GOTO	LAB(L1())
							;Use first entry
			FI

			;Table value > XDLIN
			LF	X0,ZLNLIN(XDT2,1)
			TRZ	X0,200000		;Remove declaration flag
			CAMLE	X0,XDLIN
			LI	XDZLN,1(XDT2)		;Skip to next block entry
			GOTO	LAB(DSLC)


		FI

		;Table value < XDLIN
		;Seek first entry where XDLIN <= table entry
		AOS	,LABB(YDSFLG)
L2():!
		AOSN	,LABB(YDSFLG)
		DRETUR			;Last line number entry
		LOOP
			AOJ	XDZLN,
		AS
			LF	X0,ZLNLIN(XDZLN)
			CAIG	X0,QLINEM
			GOTO	FALSE			;Valid number
			CAIL	X0,1B18			;Skip if declaration entry
			L	XDT2,XDZLN		;Update block entry pointer
			GOTO	TRUE
		SA
	ELSE
		;DSLO entry
		AOS	,LABB(YDSFLG)
		LF	X0,ZLNADR(XDZLN)

		IF
			CAMG	X0,XDSTA
			GOTO	FALSE
		THEN
			LF	X0,ZLNADR(XDT2,1)
			CAMLE	X0,XDSTA
			LI	XDZLN,1(XDT2)
			GOTO	LAB(DSLC)
		FI
		CAME	X0,XDSTA	;Exact match
		SOSE	,LABB(YDSFLG)	;Last entry not valid
	FI
L1():!	;Return valid entry
	AOS	,(XDSTK)		;Skip return
FI	DRETUR

	EPROC
	SUBTTL	DSEZLN, SIMDDT subroutine

	Comment;
	Purpose:	Find next external block entry in main ZLN table

	Entry:		DSEZLN

	Input arguments:X1 previous external block entry in main ZLN table
			   or address of main ZLN table(first call)

	Normal exit:	DRETUR

	Error exit:	none

	Output arguments:X1 is 0 if no external entries exist or
			       address of external block entry
			 XDT2 is address of external symbol table if X1 valid

	Used subroutines:none
	;
	PROC
DSEZLN:	;Find next external symbol table

	L	XDT2,YDSZLA(XLOW)
	LF	XDT2,ZLNADR(XDT2)

	LOOP
		IF
			LF	X1,ZLNBLK(X1)
			JUMPN	X1,FALSE
		THEN
			DRETUR			;X1 is 0
		FI

		ADD	X1,XDT2
		LF	X0,ZLNTYP(X1)
	AS
		CAIL	X0,QCEXT
		CAILE	X0,QFEXT
		GOTO	TRUE			;Try previous ZLN entry
	SA

	;External block found
	LF	XDT2,ZLNADF(X1)			;Fetch prototype
	LF	XDT2,ZPRSYM(XDT2)
	DRETUR

	EPROC

	SUBTTL	DSPO, SIMDDT subroutines
	Comment;


	Purpose:	Put octal digits in text

	Entries:	DSPO	put octal digits in text
			DSPOC	put octal digits in text, X0 contains first
				char to be put in outtext

	Input argument(s):	X1	octal number left adjusted
				XDCNT	number of characters to be put in text
				X0	first output char. if DSPOC call

	Normal exit:	DRETUR

	Error exit:	none

	Output argument(s):	none

	Call format:	normal

	Used subroutines:DSOCH and DSOCO
	;
DSPO:	PROC
	;Put octal digits in text
	;Input XDCNT number of octal digits in text
	;Input X1, octal number left adjusted
	LOOP
		LI	X0,6
		LSHC	X0,3


DSPOC:	;Entry if X0 already contains first output char.
		OUTCHA
	AS
		DECR	XDCNT,TRUE
	SA
	DRETUR
	EPROC
	SUBTTL	DSTX, SIMDDT subroutines
	Comment;


	Purpose:	Subroutines to handle the communication
			with RTS text routines:
			TXPI, TXPR, TXGI and TXGR


	Entries:	DSTXO	initialize output via RTS
			DSTXI	initialize input via RTS
			DSTXPC	output integer and calculate number of digits in text
			DSTXPI	output integer, number of digits in XDCNT
			DSTXGI	input integer
			DSTXPR	output real
			DSTXGI	input real


	Input argument(s):	XDCNT	number of output digits (characters)
					  if DSTXPI call
				XWAC3	integer to be output
				XWAC3,XWAC4 	real number to be output
				XWAC5		number of significant digits
						if real output


	Normal exit:	DRETUR if real output or integer output
			Skip DRETUR if input real or integer ok

	Error exit:	 DRETUR if input real or integer not ok

	Output arguments:Text buffer pointers updated

	Call format:	Normal


	Used subroutines: DSTXB internal routine
			  DSCTX called to input real or integer
			  DSOF,DSPOC,DSOCH,DSSCI,DSOEM,
			  RTS routines TXPI and TXPR

	;
DSTXO:	PROC
	;Initialize output via RTS
	LI	X1,ZTV%S(XDINT)
	;XDCNT contains number of output characters

	LF	X0,ZTVCP(X1)
	ADD	X0,XDCNT
	IF
		CAIG	X0,QDSION
		GOTO	FALSE
	THEN
		;Overflow in buffer
		DEXEC	DSOCO		;Output current buffer
	FI

	DSTACK	XDCNT

	MDSTXB

	DUNSTK	X1
	LOOP
		OUTCHA
	AS
		DECR	X1,TRUE
	SA


	DRETUR

	EPROC

	PROC
DSTXI:	;Initialize for input
	L	X1,XDINT

DSTXB:	;
	;Build temporary text variable
	;Input XDCNT number of characters
	;Input X1 text variable
	;Note code not field independent
	HRLZ	X0,1(X1)		;Fetch ZTVCP
	ADD	X0,(X1)			;ZTVSP, ZTVZTE
	ST	X0,LABB(YDSTTX)

	HRLZM	XDCNT,1+LABB(YDSTTX)	;ZTVLNG, ZTTVSP

	LI	XWAC1,LABB(YDSTTX)	;Address of temporary TEXT variable
	DRETUR

	EPROC
	PROC
DSTXPC:	;Entry when number of output characters to be calculated

	DSTACK	XDCNT
	LI	XDCNT,0
	L	X0,XWAC3
	CAIGE	XWAC3,0
	AOJ	XDCNT,

	LOOP

		AOJ	XDCNT,
		IDIVI	X0,^D10
	AS
		JUMPN	X0,TRUE
	SA

	SKIPA

DSTXPI:	;Entry when number of output characters in XDCNT

	DSTACK	XDCNT
	;Call TXPI
	MDSTXO			;Initiate  for RTS text routine
	EXEC	TXPI		;Call RTS routine
	DUNSTK	XDCNT
	DRETUR
	EPROC
	PROC

;Not used
;DSTXGR:	;Call TXGR

;	SETONA	YDSTXR
;	SKIPA

DSTXGI:	;Call TXGI
	SETOFA	YDSTXR


DSTXG:	;Common entry point when switch YDSTXR ALREADY SET
	LI	XTAC,XWAC1	;[242]
DSTXG1:	;[242] Entry when XTAC is already set


	HLRZ	XDCNT,1(XDINT)
	HRRZ	X0,1(XDINT)
	SUB	XDCNT,X0		;Calculate length of remaining input
	MDSTXI				;Initiate temporary TEXT variable

	LI	X1,TXGI
	IFONA	YDSTXR
	LI	X1,TXGR

	DEXEC	DSCTX
	SOS	,(XDSTK)		;Dretur if error found in TX routine

	;Update YDSIPO
	HRRZ	XDT2,1+LABB(YDSTTX)	;Number of scanned positions
	LOOP
		MDSSCI			;Dummy read
	AS
		DECR	XDT2,TRUE
	SA
	AOS	,(XDSTK)
	DRETUR			;Skip return when valid integer or real found

	EPROC
DSTXPR:	PROC
	;Call TXPR
	;XWAC3,XWAC4 loaded
	;XWAC5 number of significant digits

	IF	;True zero
		JUMPN	XWAC3,FALSE
	THEN	;Output 0
		LI	X0,"0"
		OUTCHA
		DRETUR
	FI


L1():!	;Real number not 0
	LI	XDCNT,6(XWAC5)		;Plus blank . E + 00

	MDSTXO				;Prepare for text output via RTS

	EXEC	TXPR
	DRETUR

	EPROC
	SUBTTL	DSCTX and DSCRTS (call RTS routines), SIMDDT subroutines
	Comment;
	Purpose:	Call special RTS routines
			IOLN,IOOP,IOOG,IOCL,CPNE,CSEN,
			SAGC,TXBL,TXCY,TXGI and TXGR
			These routines are treated specially to be able
			to allow garbage collection during the call or
			to be able to handle errors that may be detected
			by the calling routine.

	Entries:	DSCRTU i/o routines
			DSCRTS normal routines
			DSCRTP routines with parameters
				placed in 1+YDSINC(XLOW)
			DSCTX TXGI and TXGR

	Input arguments:XDRTSR address of RTS routine
			X1 address of TXGR or TXGI routine (if DSCTX entry)
			Parameter in 1+YDSINC(XLOW) if DSCRTP entry

	Normal exit:	BRANCH YDSINC(XLOW)	return to SIMDDT
						from YDSINC(XLOW)+3

			Skip DRETUR if DSCTX entry

	Error exit:	DRETUR if DSCTX entry

	Output argument:Integer or real in XWAC1,XWAC2  if DSCTX normal exit
			otherwise none

	Call format:	Normal

	Used subroutines:TXGI and TXGR
			 The other RTS routines are not used as subroutines to
			 DSCR rather as subroutines to SIMDDT.
	;
	;

	PROC
DSCRTU:	;Call i/o routines
	SETONA	YDSUFR		;USE or DISPLAY file invoked via RTS

DSCRTS:
	;Restore LOWADR instruction, may have been destroyed
	DSTACK	LAB(DSIS02)
	DUNSTK	1+YDSINC(XLOW)

DSCRTP:	;Parameters placed in YDSINC+1(XLOW)
	SETONA	YDSGCO

DSCTX2:	;Call text input routines

	ST	XDSWIT,YDSWIT(XLOW)
	ST	XDZBR,LABB(YDSOBR)
	ST	XDSTK,LABB(YDSOST)
	ST	XPDP,LABB(YDSOXPDP)

	DSTACK	YSAGCN(XLOW)
	DUNSTK	LABB(YDSOSAGCN)		;Save number of garbage collections

	IFONA	YDSGCO
	BRANCH	YDSINC(XLOW)		;Call from static low area
					;if garbage collection may occur
	;Call TXGI or TXGR routine

	EXEC	0(X1)
	AOS	,(XDSTK)
DSCTX1:	SETOFA	YDSTXC
	ST	XDSWIT,YDSWIT(XLOW)
	DRETUR

DSCTX:	;Call TXGI or TXGR routines
	SETONA	YDSTXC
	GOTO	LAB(DSCTX2)

	EPROC
	SUBTTL	DSCLOS, SIMDDT subroutine

	Comment;	[2]
			[242] Reworked to take care of "transient files"
			(Opened without garbage collection, special buffers)
	Purpose:	Call IOCL to close any opened file
			used by the SIMDDT system
	Entries:	DSCLOS 	close file, file object is given in XWAC1
			DSCLOU	close any use file and reset switch
			DSCLOD	close display file if it exists
			DSCLOI	close indirect command file if it exists [242]
			DSCLOF	[242] close any file, X1 points to word with file
				pointer. DSCLOF clears this word if negative.
			DSCL.	File ref in XWAC1, XDSWIT new value of YDSWIT.
				Close file [242].
	Input argument:	See above - X1, XWAC1, XDSWIT.
	Output argument:None
	Used routine:	IOCL
	;

	PROC
DSCLOD:	;Close any open DISPLAY file
	LI	X1,YDSDFO(XLOW)	;[242]
	BRANCH	LAB(DSCLOF)		;[242]

DSCLOU:	;Close USE file
	IFONA	YDSTTY
	DRETURN				;[242] Do not close TTY
	SETONA	YDSTTY
	LI	X1,YDSUFO(XLOW)
	BRANCH	LAB(DSCLOF)

DSCLOI:	;Close indirect command file
	IFONA	YDSITTY
	DRETURN				;[242] Do not close TTY
	SETONA	YDSITTY
	LI	X1,YDSIFO(XLOW)
;	BRANCH	LAB(DSCLOF)

DSCLOF:	;[242] Close file whose address is at (X1)
	;[242] Delete reference if temporarily allocated
	SKIPL	XWAC1,(X1)
	BRANCH	LAB(DSCL.)
	DSTACK	X1
	DEXEC	DSCL.
	DUNSTK	X1
	;Deallocate if possible **** later***
	SETZM	(X1)
	DRETURN

	;[41]
DSCLOS:	;Close any opened file
	;[41]
	CAMN	XWAC1,YDSUFO(XLOW)
	BRANCH	LAB(DSCLOU)
	CAMN	XWAC1,YDSIFO(XLOW)
	BRANCH	LAB(DSCLOI)		;[242]
	CAMN	XWAC1,YDSDFO(XLOW)
	BRANCH	LAB(DSCLOD)
	BRANCH	LAB(DSCL.1)

DSCL.:	ST	XDSWIT,YDSWIT(XLOW)
DSCL.1:	IF	;File exists and is open
		JUMPE	XWAC1,FALSE
		IFOFF	ZFIOPN(XWAC1)
		GOTO	FALSE
	THEN	;Call RTS Close procedure
		LI	XDRTSR,IOCL
		DEXEC	DSCRTS
	FI
	DRETUR
	EPROC
	SUBTTL	DSBUTX, SIMDDT subroutine
	Comment;
	Purpose:	To initialize text variables and SIMDDT stack
	Entry:		DSBUTX

	Output arguments:XDINT and text pointers initialized

	Used subroutines:DSINL and DSONL
	;

	PROC
DSBUTX:
	;Fill in underflow stack address

	LI	X0,LAB(DSTERM)
	ST	X0,LABB(DSZBRK)

	DSTACK	XDT2
	;Build text variables
	;Elements 0,1,2 in text array

	L	XDINT,YDSTXT(XLOW)
	LF	XDINT,ZARBAD(XDINT)	;Calculate XDINT
	LI	XDT2,2
	LI	X1,LABB(ZDSZTE)		;Text record address

LOOP
	WSF	X1,ZTVZTE(XDINT)
	HRLZI	X0,QDSION		;Length of text variable
	WSF	X0,ZTVLNG(XDINT)
AS
	ADDI	XDINT,ZTV%S
	HRLI	X1,QDSION+5		;Next ZTVSP
	DECR	XDT2,TRUE
	HRLI	X1,2*<QDSION+5>		;Last input text variable
	JUMPE	XDT2,TRUE
SA
	SUBI	XDINT,3*ZTV%S		;Restore XDINT
	MDSONL
	MDSINL

	DUNSTK	XDT2
	DRETUR
	EPROC
	SUBTTL	DSEXPR, SIMDDT subroutine

	Comment;		[2]
	Purpose:	To close any open display file and update variables
	Entry:		DSEXPR
	Used subroutine: DSCLOD
	;

	PROC
DSEXPR:
	DEXEC	DSCLOD
	;No display file exists
	SETZM	YDSDFO(XLOW)
	SETZM	LABB(YDSDZLN)
	SETZM	LABB(YDSNDL)	;[242]

	DRETUR
	EPROC
	SUBTTL	DSFSP, SIMDDT subroutine

	Comment;	[2]
	Purpose:	Create file specification to be used by RTS i/o routines

	Entry:		DSFSP

	Input arguments:X1,X2,X3 name to convert to ascii and place in input buffer
			XDT4	number of characters to convert
			Null character in input buffer marks end of input

	Output arguments: Input buffer filled and cr placed at end of input
			  Input text variable initialized

	Normal exit:	DRETUR
;

	PROC
DSFSP:
	MDSINL			;Initialize input buffer
	HRLZI	XDSTA,600	;[41] Build byte pointer to X1,X2,X3
LOOP
	ILDB	X0,XDSTA		;[41]
	ADDI	X0,040
	IDPB	X0,LABB(YDSIPO)
AS
	DECR	XDT4,TRUE		;[41]

SA
	;Find end of input
	;If call from DSUS file specification still exists

LOOP
	MDSSCI
AS
	JUMPN	XDBYTE,TRUE
SA
	LI	X0,15
	DPB	X0,LABB(YDSIPO)
	HRLZI	X0,QDSION
	WSF	X0,ZTVLNG(XDINT)	;Create text variable for input

	DRETUR

	EPROC
	SUBTTL	DSCF, SIMDDT subroutine

	Comment;	[2]
	Purpose:	Create file object and open file

	Entries:	DSCF	create file object and open file
			DFCFO	open a file for which file object already exists

	Input arguments:	X0 parameters to CPNE RTS routine
				File specification in input buffer area

	Output arguments:	XWAC1 new file object if ok
					0 if file not ok

	Normal exit:		DRETUR

	Used subroutines:IOOP,CPNE,CSEN,DSCFAB,DSCFLB,DSCRTU and DSCRTP

	;
	PROC

DSCF:	IF	;[242] GC is ok
		DEXEC	DSCHGC
DSCF02:		GOTO	FALSE	;[242] Address checked in DCCHGC, no message on failure
	THEN	;Ok, use ordinary allocation of buffers etc
	ELSE	;Make sure there will be no GC, or give up
		LF	X1,ZDNTYP(XCB)
		IF	;Class body
			CAIE	X1,QZCL
			GOTO	FALSE
		THEN	;Check for file subclass
			LF	X1,ZBIZPR(XCB)	;Prototype of current block
			LF	X1,ZCPGCI(X1)
			IF	;File subclass
				CAIE	X1,QIOFI
				GOTO	FALSE
			THEN	;Reissue check for GC to get message, then abort
				DEXEC	DSCHGC
				BRANCH	LAB(L1())
			FI
		FI
		SETON	SWNOGC(XLOW)
		ZBU%S==203	;Buffer size
		ZBH%S==4	;Buffer header size
		q==QPFLNG+10+2*ZBU%S+10	;Adequate space for file obj and 2 bufs
		LI	X1,q
		ADD	X1,YSATOP(XLOW)
		SUB	X1,YSALIM(XLOW)	;Neg diff if space remains
		IF	;Not enough
			JUMPLE	X1,FALSE
		THEN	;Try one buffer only
			SUBI	X1,ZBU%S
			IF	;Not even space for one buffer
				JUMPLE	X1,FALSE
			THEN	;Try more core
				EXTERN	.JBREL
				L	X1,.JBREL
				ADDI	X1,1000		;One page suffices
				CORE	X1,
				 GOTO	LAB(L1())	;Failed

				;Ok, adjust limits
				L	X1,.JBREL
				HRRM	X1,.JBFF
				SUBI	X1,QSALIM
				ST	X1,YSALIM(XLOW)
	FI	FI	FI

	ST	XCB,YDSXCB(XLOW)	;Save XCB in dynamic part of static
					;area. XCB will be changed on error
					;during file creation and opening
	LD	XWAC2,(XDINT)
	ST	X0,1+YDSINC(XLOW)	;Place parameter in low segment area
	SETONA	YDSUFR			;Indicate  i/o call to RTS
	LI	XDRTSR,CPNE
	DEXEC	DSCRTP			;Call CPNE RTS routine
	IFONA	YDSUFR
	GOTO	LAB(L1())		;File error
	LD	XWAC2,(XDINT)		;File spec. in input buffer
	STD	XWAC2,OFFSET(ZFISPC)(XWAC1)

	ST	XWAC1,YDSCFO(XLOW)	;Save file object

	IF	;[242] No GC allowed
		IFOFF	SWNOGC(XLOW)
		GOTO	FALSE
	THEN	;Allocate buffers in a special way
		DEXEC	DSCFAB
		SETON	ZFIBNW(XWAC1)	;Tell .IOCF not to allocate any buffer
		HRROS	XWAC1,YDSCFO(XLOW)	;Mark file obj addr not to be saved
					; over return to code
	FI

	LI	XDRTSR,CSEN
	DEXEC	DSCRTU			;Call CSEN i/o routine
	ZF	ZFISPC(XWAC1)		;NOTEXT to file name
	ZF	ZFISPC(XWAC1,1)
	IFONA	YDSUFR
	GOTO	LAB(L1())		;File error

	SKIPGE	XWAC1,YDSCFO(XLOW)	;[242] Link buffers if specially
	DEXEC	DSCFLB			;[242] allocated

	SKIPA
DSCFO:
	ST	XCB,YDSXCB(XLOW)

	ST	XWAC1,YDSCFO(XLOW)
	LD	XWAC2,ZTV%S(XDINT)
	HRRZ	X0,(XDSTK)		;[41]
	CAIN	X0,LAB(DSGET1)		;[41] From DSGET routine
	LD	XWAC2,(XDINT)		;[41] Read to input area
	LI	XDRTSR,IOOP
	DEXEC	DSCRTU			;Call i/o open routine
	IFONA	YDSUFR
L1():!	SETZM	,YDSCFO(XLOW)		;Output argument is 0
	;File ok
	SETOFA	YDSUFR
	ST	XDSWIT,YDSWIT(XLOW)

	SETZB	XCB,XWAC1		;[242]
	EXCH	XCB,YDSXCB(XLOW)	;[242]
	EXCH	XWAC1,YDSCFO(XLOW)	;[242]

	DRETUR

	EPROC
	SUBTTL	DSCFAB, special buffer allocation	[242]

Comment;
Purpose:	Allocate one or two buffers at the top of the pool.
		To be used when normal GC was not allowed when allocating
		a file from SIMDDT. The buffers will not stay in core
		over any GC. Open the channel before linking buffers.

Input:		XWAC1 = File pointer.

Output:		ZFIIBH or ZFIOBH points to the buffer header of a buffer ring
		allocated in a ZYS record.

Uses registers:	X0, X1 without restoring.
;

DSCFAB:	PROC	;[242]
	DSTACK	X2
	LF	X1,ZFIBFS(XWAC1)	;Buffer size
	IF	;Size not determined or too big
		CAIG	X1,ZBU%S
		JUMPG	X1,FALSE
	THEN	;Make it standard
		LI	X1,ZBU%S
		SF	X1,ZFIBFS(XWAC1)
	FI
	ADDI	X1,ZBH%S+2(X1)		;Overhead, ZBH and 2 buffers
	LI	X2,(X1)
	L	X2
	ADD	YSATOP(XLOW)		;New tentative top address
	IF	;There was enough space for two buffers
		CAMLE	YSALIM(XLOW)
		GOTO	FALSE
	THEN	;Ok, 2 buffers it is
		LI	X1,2
	ELSE	;Only one buffer will have to do
		SUB	X2,OFFSET(ZFIBFS)(XWAC1)	;Adjust size
		SUB	OFFSET(ZFIBFS)(XWAC1)
		LI	X1,1
	FI
	SF	X1,ZFIBUF(XWAC1)
	L	X1,YSATOP(XLOW)
	SF	X2,ZYSLG(X1)		;Record length
	HRRZM	YSATOP(XLOW)		;New top
	LI	QZYS			;Record type
	SF	,ZDNTYP(X1)

	;Determine buffer header address

	LI	X1,3(X1)
	LF	,ZBIZPR(XWAC1)	;Prototype
	CAIN	IOIN		;Infile?
	SF	X1,ZFIIBH(XWAC1)
	CAIE	IOIN		;Not Infile?
	SF	X1,ZFIOBH(XWAC1)
	DUNSTK	X2
	DRETURN
	EPROC
	SUBTTL	DSCFLB, link special buffers [242]

Comment;
Purpose:	Sets up the buffer pool defined by XWAC1.
Input:		XWAC1 is file object address.
;

DSCFLB:	PROC
	WLF	X1,ZFIIBH(XWAC1)	;Buffer header address in one halfword
	TRNN	X1,-1			;If rhs=0,
	MOVSS	X1			; swap halves
	LI	4(X1)			;First buffer address
	SETONA	ZBHUSE
	WSF	,ZBHZBU(X1,-1)
	MOVSI	(POINT 7,0)
	HRRI	5(X1)
	SF	,ZBHBUP(X1,-1)

	LF	,ZFIBFS(XWAC1)
	SUBI	2
	SF	,ZBUSIZ(X1,-1)
	IF	;More than one buffer
		LF	,ZFIBUF(XWAC1)
		CAIG	1
		GOTO	FALSE
	THEN	;Chain to next
		LI	4(X1)
		SF	,ZBUZBU(X1,ZBU%S-1)
		LF	,ZFIBFS(XWAC1)
	SUBI	2
		SF	,ZBUSIZ(X1,ZBU%S-1)
		LI	4+ZBU%S(X1)
	ELSE
		LI	4(X1)
	FI
	SF	,ZBUZBU(X1,-1)		;Close the ring
	DRETURN
	EPROC
	SUBTTL	DSRUC,  SIMDDT subroutine

	Comment;

		[2]
	Purpose:	Find static or dynamic link

	Entries:	DSRUC

	Input arguments:Switches YDSCH if operating chain requested
				 YDSUP if static block
				 YDSRE if dynamic block
			XDZLN  line number entry
			YDSSBA current block address

	Output arguments:YDSSBA new block address
			 If 0 no valid environment found

	Normal exit: 	DRETUR

	Used subroutines: DSSS,DSSSR,DSRUCS,DSFA,DSVO,DSVOM and  DSONL
	;

	PROC
DSRUC:	;Find static or dynamic link

	SETOM	,LABB(YDSTIC)		;Counter used if call from DSPC
WHILE
	LI	X0,LAB(L3())
	MDSSS
	DRETUR

DO

L3():!	;Subroutine called from DSSS

	L	XDZPR,-1(XDSTK)
					;Fetch prototype address
	HLRZ	X0,-2(XDSTK)
	JUMPN	X0,LAB(L6())		;Subblock
	ST	XDZLN,LABB(YDSSLN)	;Save pointer if not subblock

	IF
		IFOFFA	YDSCH		;[41]
		GOTO	TRUE
		IFON	YDSSUP(XLOW)
		DRETUR			;Command suppressed
		GOTO	FALSE
					;[41] END
	THEN
		L	X1,@YDSZLA(XLOW)
		LF	X1,ZLNADF(X1)		;Fetch prototype for outermost block
		CAMN	XDZPR,X1
		GOTO	LAB(L7())		;Outermost block reached, exit DSRUC
		IF	;Outermost external block and /UP
			SKIPE	,LABB(YDSTIC)	;Ok if second time
			IFONA	YDSRE
			GOTO	FALSE
		THEN
			CAMN	XDZLN,LABB(YDSCZS)
			GOTO	LAB(L7())
		FI

	FI
	LF	X1,ZPRSYM(XDZPR)

	IF
		LF	X0,ZSMTYP(X1)
		CAIN	X0,QPROCB
		GOTO	TRUE			;Dynamic link
		CAIGE	X0,QPEXT
		GOTO	LAB(L4())
		CAIG	X0,QFEXT
		GOTO	TRUE
	L4():!	CAIE	X0,QCEXT
		CAIN	X0,QCLASB
		GOTO	LAB(L2())
		CAIE	X0,QPBLOCK
		CAIN	X0,QSYSCL
		GOTO	LAB(L2())
	L6():!	IFONA	YDSCH
		GOTO	LAB(L1())
		L	X0,LABB(YDSNLN)		;Find line number entry for subblock
		SKIPE	,LABB(YDSSLN)
		L	X0,LABB(YDSSLN)		;Valid pointer
		ST	X0,LABB(YDSCZL)		;Update current pointer
		SETZM	,LABB(YDSSLN)		;Make sure that YDSNLN is used next
		GOTO	LAB(L5())

L2():!	;Remove prefix classes
		WHILE
			LF	XDZPR,ZCPZCP(XDZPR)
			JUMPE	XDZPR,FALSE
		DO
			ST	XDZPR,-1(XDSTK)
		OD
	THEN	;Part of operating chain

	L5():!
		DSTACK	XDZLN
		DEXEC	DSOCT
		L	XDSTA,LABB(YDSSBA)
		IF	;Operating
			IFON	ZDNTERM(XDSTA)
			GOTO FALSE
		THEN	;Find block instance address
			ADD	XDSTA,LABB(YDSEBL)
			L	XDSTA,(XDSTA)
		FI
		MDSFA
		DUNSTK	XDZLN

		IF	;INSPECT block
			LF	X0,ZLNTYP(XDZLN)
			CAIE	X0,QINSPEC
			GOTO	FALSE
		THEN	;no change in dynamic link
			DEXEC	DSOCB
			MDSPM	QMCHIN		;INSPECT block
			IF
				IFONA	YDSCH
				GOTO	FALSE
			THEN
				ST	XDZLN,LABB(YDSCZL)
				AOS	,LABB(YDSCZL)	;Indicate second of two
							;Inspect entries in ZLN
				SETZM	,LABB(YDSSLN)	;Indicate update already done
			ELSE
				MDSVO			;Output text
			FI

			GOTO	LAB(L1())
		FI
		IF	;[55] Update XCB pointer
			IFOFFA	YDSCH
			GOTO	TRUE
			IFON	ZDNTERM(XDSTA)
			GOTO	FALSE
		THEN
			LF	X0,ZDNTYP(XDSTA)
			CAIE	X0,QZBI		;Unreduced block without display
			ST	XDSTA,LABB(YDSSBA)
		FI	;[55] End
		;Check for error
		IF


			IFOFFA	YDSCH		;[55] ok if chain
			SKIPL	LABB(YDSTIC)
			GOTO	FALSE		;Ok
			IFON	ZDNTERM(XDSTA)
			GOTO	TRUE		;Error if terminated block
			IFOFFA	YDSRE
			GOTO	FALSE
			IFOFF	ZDNDET(XDSTA)
			GOTO	FALSE
			LF	X0,ZDNTYP(XDSTA)
			CAIN	X0,QPBLOCK
			GOTO	FALSE
		THEN
			;Error found

			MDSONL
			MDSVOM	QMRUCE
							;[55]
			GOTO	LAB(L7())		;Exit DSRUC
		FI

		IFONA	YDSCH
		MDSVO
	FI
	IFONA	YDSUP
	GOTO	LAB(L1())
	IFONA	YDSACB
	SKIPG	,LABB(YDSSLN)		;No valid line number found
	GOTO	LAB(L1())
	;Change environment, return to calling point
	LF	XDSTA,ZDRZBI(XDSTA)	;New block instance
	ST	XDSTA,LABB(YDSSBA)
	DEXEC	DSSSR			;Exit DSSS
	L	XDZLN,LABB(YDSSLN)
	L	X0,LABB(YDSSLS)
	ST	X0,LABB(YDSCZS)
	L	X0,LABB(YDSSZN)
	IFOFFA	YDSCH
	ST	X0,YDSZLN(XLOW)	;Update external table pointer
				;set in DSPL
	DEXEC	DSRUCS
OD

L1():!	;Static link
	DEXEC	DSRUCS
	IFONA	YDSCH
	DRETUR			;Return to DSSS

	SKIPE	,LABB(YDSSLN)
	ST	XDZLN,LABB(YDSCZL);Save current pointer if valid
	SKIPLE	,LABB(YDSTIC)
L7():!	;
	DEXEC	DSSSR		;Exit DSSS
	DRETUR			;Exit DSRUC the second time
				;Return to DSSS the first time
DSRUCS:
	IFONA	YDSCH
	DRETUR

	SETOFA	YDSRE
	SETONA	YDSUP
	AOSG	,LABB(YDSTIC)	;Increment counter
	MDSONL			;Remove block id
	DRETUR


	EPROC

	SUBTTL	DSRU,  SIMDDT subroutine
	Comment;
		[2]
	Purpose: To call DSRUC for INSPECT /UP or /RETURN to
		 change current block pointer

	Entry:  DSRU
	Input arguments: See DSRUC
	Output arguments: YDSSXCB

	Used routines:  DSRUC
	;
DSRU:	;Call DSRUC

	SETOFA YDSACB
	L	X0,YDSSXCB(XLOW)
	ST	X0,LABB(YDSSBA)
	L	XDZLN,LABB(YDSCZL)
	DEXEC	DSRUC

	L	XDSTA,LABB(YDSSBA)
	ST	XDSTA,YDSSXCB(XLOW)
	DRETUR
	SUBTTL	DSLPR, SIMDDT subroutine

	Comment;
		[2]
	Purpose:	Search all ZLN tables for prototype
			or class identifier [41]
	Entry:	DSLPR

	Input arguments: XDT4 contains prototype
	Output arguments: XDT2 is 0 if no entry found
			XDT2 points at ZLN entry with prototype in ZLNADF
			XDT3 points at start of ZLN table
			X1 points at ZLN table
	Normal exit:  DRETUR
	Error exit:  DRETUR

	Used routines:DSEZLN
	;

	PROC
						;[151] Proc added
DSLPR:	;Find prototype class in ZLN table

	L	XDT2,YDSZLA(XLOW)
	L	X1,XDT2		;Begin with main ZLN table
LOOP
	IF
		JUMPE	XDT2,FALSE
		LF	XDT3,ZLNADF(XDT2)
	THEN

		LOOP
			IF
				JUMPE	XDT4,FALSE
			THEN	;Find prototype in ZLN table
				IF	;Same prototype, right type of block
					LF	X0,ZLNADF(XDT2)
					CAME	X0,XDT4
					GOTO	FALSE		;Not same prototype
					LF	X0,ZLNTYP(XDT2)
					CAIE	X0,QPROCB
					CAIN	X0,QUBLOCK
					GOTO	TRUE
					CAIE	X0,QPBLOCK
					CAIN	X0,QCLASB
				THEN
					DRETUR		;Right entry in ZLN table found
				FI
			ELSE	;Find class in ZLN table
				IF
					LF	XDT4,ZLNADF(XDT2)  ;[151]
					LF	X0,ZLNTYP(XDT2)
					CAIE	X0,QCLASB
					GOTO	FALSE
								;[151]
				THEN				;[151]
					DEXEC	DSLPRR		;[151]
					DRETUR			;[151] Entry found
					LF	XDT4,ZLNADF(XDT2) ;[151]

					GOTO	LAB(L1())	;[151]
		DSLPRR:						;[151]
								;[151] Help procedure
				LF	XDT4,ZPRSYM(XDT4)  ;Fetch name
				IF	;[151] The right name is found
					CAMN	XDSYM1,-2(XDT4)
					CAME	XDSYM2,-1(XDT4)
					GOTO	FALSE
				THEN	;Find prefix with correct qualif
					LF	XDT4,ZLNADF(XDT2)
					WHILE	;Prefixes exist
						JUMPE	XDT4,FALSE  ;Not found
					DO
						LF	XDT4,ZCPZCP(XDT4)
						CAMN	XDT4,LABB(YDSSQU)
						DRETUR		;Exit ZLN table found
					OD
				FI	;Not found
				AOS 	,(XDSTK)		;[151] Skip return
				DRETUR			;[151]

				ELSE			;[151]Start of change

				IF	;Prefixed block
					CAIE	X0,QPBLOCK
					GOTO	FALSE
				THEN
		L1():!		;Check if class has Simulation or Simset as prefix

					WHILE
						LF	XDT4,ZCPZCP(XDT4)
						JUMPE	XDT4,FALSE
					DO
						DSTACK	XDT2
						DSTACK	X1
						DSTACK	XDT4
						IF
							LF	XDT4,ZPRSYM(XDT4)
							LD	X0,-2(XDT4)
							JUMPE	X1,LAB(L2())
							CAMN	X0,LAB([SIXBIT "SIMULA" ])
							CAME	X1,LAB([SIXBIT "TION" ])
							GOTO	FALSE
							LI	X1,-5(XDT4)
							GOTO	TRUE
		L2():!
							LI	X1,-4(XDT4)
							CAME	X0,LAB([SIXBIT "SIMSET" ])
							GOTO	FALSE
						THEN
							LI	X0,-3(XDT4)	;Last prototype
							LOOP
								L	XDT4,(X1)
								LI	XDT2,LABB(YDSDUZLN)
								ST	XDT4,LABB(YDSDUZLN)
								DEXEC	DSLPRR
								GOTO	LAB(L3())
							AS
								CAME	X0,X1
								AOJA	X1,TRUE
							SA
						FI

						DUNSTK 	XDT4
						DUNSTK	X1
						DUNSTK	XDT2
					OD
				FI	FI     			;[151]   End of change
				SETZ	XDT4,
			FI
		AS
			CAMN	XDT2,XDT3
			GOTO	FALSE		;Not in this ZLN table
			LF	XDT2,ZLNBLK(XDT2)
			ADD	XDT2,XDT3
			GOTO	TRUE
		SA
	FI

AS
	DEXEC	DSEZLN		;Find next ZLN table
	JUMPE	X1,FALSE	;No valid entry
	LF	XDT2,ZSMZLN(XDT2)
	GOTO	TRUE
SA
	SETZ	XDT2,
	DRETUR
L3():!					;[151]
	DUNSTK				;[151]
	DUNSTK				;[151]
	DUNSTK				;[151]
	L	XDT4,(X1)		;[141]
	DRETUR				;[151]

	EPROC				;[151]
	SUBTTL	DSCHGC, SIMDDT subroutine
	Comment;
		[41]
	Purpose:	Check if call allowed if REENTER or error mode
	Entry:		DSCHGC
	Input argument:	SIMDDT status
	Output argument: None, message is created if command not valid
	Normal return:	Skip DRETUR
	Error return:	DRETUR		if command not possible
	;
DSCHGC:
	DSTACK	X0	;[242]
	n==1
IF
	IFOFFA	YDSREE
	IFOFFA	YDSDBG
	SKIPA
	GOTO	FALSE
	HLLZ	X0,LABB(YDSSENR)
	JUMPE	X0,FALSE		;No problem
THEN
	HRRZ	X0,-n(XDSTK)
	IF	;Not special return address
		CAIE	X0,LAB(DSCF02)	;[242]
		CAIN	X0,LAB(DSVA02)
		GOTO	FALSE
	THEN	;Command not allowed
		MDSOTM	QMGVNS
		MDSOTM	QMCHQS		;Give NOPROCEED command and reenter
					;current command
	FI
ELSE
	AOS	-n(XDSTK)
FI
	DUNSTK	X0	;[242]
	n==0
	DRETUR
	SUBTTL	DSVAK, SIMDDT subroutine
	Comment;
	Purpose:	[41]
			Find /-ARRAY,/-TEXT and/or /-GC in command
			and set switches
			[242] /START:oooooo specifies first address to output
				(in octal)
	Entry:		DSVAK
	Input argument: Input text pointer
	Output arguments: Switches YDSSGC, YDSSNA and/or YDSSKTX
	Normal return:	Skip DRETUR if ok
	Error return:	DRETUR if invalid key after /
	Used subroutines: DSGI,DSSKB

	;
	PROC
DSVAK:
	DSTACK	XDZBE
	DSTACK	XDTYP
	DSTACK	XDT5
	n==3

	WHILE
		DEXEC	DSSKBN
		CAIE	XDBYTE,"/"
		GOTO	FALSE		;No keyword found
	DO
		LI	XDMN,QMVAKE	;Invalid key
		DEXEC	DSSKB
		IF	;[242] - sign
			CAIE	XDBYTE,"-"
			GOTO	FALSE
		THEN	;Check for valid keywords
			DEXEC	DSGI
			GOTO	LAB(L1())
			MDSFK
			GOTOE	XDZKW,LAB(L1())
			IF	;/-ARRAY
				CAIE	XDZKW,LAB(ZKWSKA)
				GOTO	FALSE
			THEN
				SETONA	YDSSNA
			ELSE
			IF	;/-TEXT
				CAIE	XDZKW,LAB(ZKWSKT)
				GOTO	FALSE
			THEN
				SETONA	YDSSKT
			ELSE	;Should be /-GC
				CAIE	XDZKW,LAB(ZKWSKG)
				GOTO	LAB(L1())
				SETONA	YDSSGC
			FI	FI
		ELSE	;[242] May be /START:oooooo
			DEXEC	DSGIS
			GOTO	LAB(L1())
			MDSFK
			JUMPE	XDZKW,LAB(L1())
			CAIE	XDZKW,LAB(ZKWSTA)
			GOTO	LAB(L1())
			DEXEC	DSSKBN
			CAIE	XDBYTE,":"
			GOTO	LAB(L1())
			DEXEC	DSIOCT		;Get value
			IF	;Neg value
				JUMPGE	X1,FALSE
			THEN	;Add YSATOP
				ADD	X1,YSATOP(XLOW)
			FI
			ST	X1,LABB(YDSVFA)
		FI
	OD

	AOS	-n(XDSTK)
L2():!
	DUNSTK	XDT5
	DUNSTK	XDTYP
	DUNSTK	XDZBE
	n==0
	DRETUR
L1():!	MDSOEM
	GOTO	LAB(L2())
	DRETUR
	EPROC
	SUBTTL	DSIOCT, input of octal value

Comment;
Purpose:	Compute binary value from [-]oooooooooooo (octal digits).
Input:		Next character is non-blank.
Output:		Value in X1.
Exit:		DRETURN
Calls:		DSSKB,DSSKBN,DSSCI
;

DSIOCT:	PROC
	DEXEC	DSSKB
	SETZ	X1,
	DSTACK	X1	;Positive flag
	IF	;Minus sign
		CAIE	XDBYTE,"-"
		GOTO	FALSE
	THEN	;Flag with -1 in stack
		SETOM	(XDSTK)
		DEXEC	DSSKB
	FI
	WHILE	;[242] Digit(Inchar)
		JUMPE	XDBYTE,FALSE
		SUBI	XDBYTE,"0"
		JUMPL	XDBYTE,FALSE
		CAILE	XDBYTE,7
		GOTO	FALSE
	DO	;Accumulate value from octal digits
		LSH	X1,3
		ADD	X1,XDBYTE
		MDSSCI
	OD
	SKIPE	(XDSTK)
	MOVNS	X1	;Neg value
	DUNSTK	(XDSTK)
	DRETURN
	EPROC