Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-05 - 43,50337/19/simds3.mac
There are 2 other files named simds3.mac in the archive. Click here to see a list.
	PRINTX	SIMDS3.MAC
	SUBTTL	DSRB, SIMDDT subroutines
	Comment;
	Purpose:	Release all linked ZBE entries

	Entries:	DSRB	release all linked entries
			DSRBD	release all ZBE entries for dummy breakpoint

	Input argument:	XDZBE	first ZBE entry in chain
				Only for DSRB entry
	Normal exit:	DRETUR

	Error exit:	NONE

	Output argument:NONE

	Call format:	Normal

	Used subroutines:none
	;

	PROC
DSRBD:	;Release all ZBE entries for dummy breakpoint

	LI	XDZBE,LABB(YDSBRD)
	SKIPN	,LABB(YDSBRD)
	DRETUR			;Already released
	MDSNB			;First real entry
	SETZM	,LABB(YDSBRD)

DSRB:	;Release all linked ZBE ENTRIES
	JUMPGE	XDZBE,LAB(DSIE)
	LF	X0,ZBRZBE(XDZBR,QZBRUN)		;Empty link
	HRRZ	X1,XDZBE
	LOOP
		;DECREMENT ONLY
	AS
		AOBJN	XDZBE,TRUE
	SA

	SUBI	XDZBE,QZBEL
	
	IF	;Part of ZBE
		CAMN	XDZBE,X1
		GOTO	FALSE
	THEN
		LF	X1,ZBEZBE(XDZBE)
		JUMPN	X1,LAB(L1())		;Release complete ZBE entries
		DRETUR				;Exit when no complete ZBE released
	FI
	;Release complete ZBE entries

	SUBI	X1,(XDZBR)		;Calculate offset
L1():!
	SF	X1,ZBRZBE(XDZBR,QZBRUN)

LOOP
	JUMPLE	X1,LAB(DSIE)
	CAMN	X0,X1
	DRETURN				;Already released
	ADDI	X1,(XDZBR)
	L	XDT2,X1
	LF	X1,ZBEZBE(X1)		;Find new link
AS
	JUMPN	X1,TRUE
SA
	;Last linked ZBE found
	SF	X0,ZBEZBE(XDT2)
	DRETUR

	EPROC
	SUBTTL	DSNB and DSFB, SIMDDT subroutines

	Comment;

	Purpose:	DSNB 	to find already reserved ZBE entries
			DSFB	to find free ZBE entries and reserve them

	Entries:	DSNBW	find next reserved ZBE word
			DSNB	find next reserved ZBE entry

			DSFBW	reserve one more ZBE word
			DSFB	reserve one more ZBE entry

	Input argument:	XDZBE	pointer to ZBE entry, current word
				Left part of XDZBE contains negative counter
				of number of unused words within ZBE entry

	Normal exit:	DRETUR if DSNB call
			Skip DRETUR if DSFB call

	Error exit:	DRETUR if no more ZBE entries free to be reserved at DSFB call

	Output argument:XDZBE	new value of ZBE pointer

	Call format:	Normal

	Used subroutines:DSOEM

	Errors generated:All breakpoint work space used, release some

	;
	PROC
	;Subroutines for using ZBE records

DSNBW:	;Next word within ZBE record
	;If ZBE overflow find linked entry
	IF
		AOBJP	XDZBE,FALSE
	THEN
		DRETUR
	FI
	SUBI	XDZBE,QZBEL		;Restore XDZBE to first ZBE word

	DEXEC	DSNB
	GOTO	LAB(DSNBW)

DSNB:	;Find next reserved ZBE record
	LF	XDZBE,ZBEZBE(XDZBE)
	IF
		JUMPE	XDZBE,FALSE
	THEN
		ADDI	XDZBE,(XDZBR)	;Calculate ZBE address
		HRLI	XDZBE,-QZBEL	;Construct counter
		DRETUR
	FI
	BRANCH	LAB(DSIE)		;Implementation error

DSNBC:	;Find next command if any
	;At entry XDZBE may point within command
	;AT exit XDZBE is address of next command or  0 if none present

	IF
		JUMPG	XDZBE,FALSE
	THEN
		;Find start of ZBE
		LOOP
		AS
			AOBJN	XDZBE,TRUE
		SA

		SUBI	XDZBE,QZBEL
	FI
	IF
		LF	X0,ZBEZBE(XDZBE)
		JUMPE	X0,FALSE
	THEN
		DEXEC	DSNB
		LF	X0,ZBETYP(XDZBE)
		CAIN	X0,QBECON
		GOTO	LAB(DSNBC)
	ELSE
		SETZ	XDZBE,
	FI
	DRETUR
DSFBW:	;Next word within ZBE record
	;If ZBE overflow reserve new ZBE record

	IF
		AOBJP	XDZBE,FALSE
	THEN
		AOS	(XDSTK)		;Skip return
		DRETUR
	FI
	SUBI	XDZBE,QZBEL

	DEXEC	DSFB
	DRETUR			;Error
	GOTO	LAB(DSFBW)

DSFB:	;Find free ZBE record and link to previous entry
	LF	X1,ZBRZBE(XDZBR,QZBRUN)		;First empty ZBE record
	IF
		JUMPE	X1,FALSE	;No more ZBE records
	THEN

		SF	X1,ZBEZBE(XDZBE)
		ADDI	X1,(XDZBR)
		LF	X0,ZBEZBE(X1)		;Next empty
		SF	X0,ZBRZBE(XDZBR,QZBRUN)
		SETZM	,(X1)
		AOS	,(XDSTK)	;Skip return
		GOTO	LAB(DSNB)
	FI
	;No more ZBE entries left

	MDSOEM	QMFBOV
	;Release all true breakpoints in error mode and set
	;Switch to indicate this
	;Skip return
	DRETUR

	EPROC
	SUBTTL	DSPS, SIMDDT subroutines

	Comment;
	Purpose:	Put symbol or identifier in outtext

	Entries:	DSPS	put symbol from symbol table in outtext
			DSPSK	put symbol from keyword table in outtext
			DSPSKB	put keyword symbol + blank in outtext
			DSPSC	put class identifier in outtext
			DSPSP	put class or procedure name from symbol table
				in outtext

	Input arguments:XDZBE	symbol table entry if DSPS
			X1	keyword table entry if DSPSK or DSPSKB
				Symbol table name entry if DSPSC
			XDZPR	prototype address if DSPSP

	Normal exit:	DRETUR

	Error exit:	NONE

	Output argument:NONE

	Call format:	Normal

	Used subroutines:DSOCH

	;
	PROC
DSPS:	;Put symbol in text variable

	LF	X1,ZBEZSD(XDZBE)		; Symbol address in X1

DSPSK:	;Keyword symbol address in X1

	LI	XDT2,^D6
	SKIPGE	,(X1)
L1():!	;Entry from DSPSP always 12 letters
DSPSC:	;Class identifier to outtext call from DSPB
	LI	XDT2,^D12

	DSTACK	X1
	HRLI	X1,600			;Create byte pointer
	LOOP
		ILDB	X0,X1
		JUMPE	X0,FALSE	;Blank found end of symbol
		ADDI	X0,040
		OUTCHA
	AS
		DECR	XDT2,TRUE
	SA
	DUNSTK	X1
	DRETUR

DSPSP:	;Output symbol ZSMRNM
	;Input is prototype address in XDZPR

	LF	X1,ZPRSYM(XDZPR)

	IF
		LF	X0,ZSMTYP(X1)
		CAIE	X0,QPROCB
		CAIN	X0,QCLASB		;Name exists
		GOTO	FALSE
		;Name exists if qcext,qpext,qmext,qfext,qsyscl
		CAIL	X0,QCEXT
		CAILE	X0,QSYSCL
		GOTO	TRUE
		GOTO	FALSE			;Name exists
	THEN
		LI	X1,3+LAB(ZKWBLOCK)
		CAIE	X0,QPBLOCK
		GOTO	FALSE
		L	X1,@YDSZLA(XLOW)
		LF	X0,ZLNADF(X1)
		LI	X1,3+LAB(ZKWMAIN)
		CAMN	X0,XDZPR		;Main block
		GOTO	FALSE

		DSTACK	XDZPR
		MDSPM	QMPSPB

		LF	XDZPR,ZCPZCP(XDZPR)	;Prefix class prototype

		DEXEC	DSPSP

		DUNSTK	XDZPR

		DRETUR

	FI
	SUBI	X1,3
	GOTO	LAB(L1())

DSPSKB:	;Put keyword symbol +blank in outtext
	DEXEC	DSPSK
	DEXEC	DSOCB
	DRETUR
	EPROC

	SUBTTL	DSPI, SIMDDT subroutines

	COMMENT;

	Purpose:	Put identification in output text variable
			ZBE entries contain description of identification

	Entry:		DSPI

	Input argument:	XDZBE	pointer to start entry in ZBE for
				identification

	Normal exit:	DRETUR

	Error exit:	none

	Output arguments:XDZBE unchanged
			 X0 last referenced ZBE word

	Call format:	MDSPI (normal)

	Used subroutines:DSPS,DSOCH,DSNB,DSTXPI

	;
	PROC
DSPI:	;Put identification in output text variable
	;Input  XDZBE

	DSTACK	XDT5
	DSTACK	XDZBE
	DSTACK	XDADR
	DSTACK	XDTYP

	SETOFA	YDSLIST
	IFON	ZBEIDL(XDZBE)
	SETONA	YDSLIST
LOOP
	DSTACK	XDZBE
	;[41]
	IF
		IFOFF	ZBESTAR(XDZBE)
		GOTO	FALSE
	THEN
		;OUTPUT *
		LI	X0,"*"
		OUTCHA
	ELSE
	IF	;"THIS"
		IFOFF	ZBETHIS(XDZBE)
		GOTO	FALSE
	THEN	LI	X1,LAB(ZKWTHIS)
		DEXEC	DSPSKB
		LI	XDZPR,ZBEZSD(XDZBE)
		MDSPSP
	ELSE
	IF				;[166] Start of change
		LF	X1,ZBEZSD(XDZBE)
		CAIE 	X1,LABB(YDSPZSD)
		GOTO	FALSE
	THEN				;Procedure identifier
		MDSNBW
		LF	X1,ZBEZSD(XDZBE)	;Address of procedure name
		SUBI X1,1			;Dummy control word before name
		DEXEC	DSPSC			;Output name
		EXCH	XDZBE,(XDSTK)
	ELSE
					;[166] End of change
		MDSPS				;Put identifier
		LF	X1,ZBESUN(XDZBE)
		IF
			JUMPE	X1,FALSE	;No subscripts
		THEN	;Process subscripts
			ST	X1,LABB(YDST1)
			LI	X0,"["

			LOOP	OUTCHA
				MDSNBW
				LF	XWAC3,ZBEVSU(XDZBE)
				MTXPI
			AS
				LI	X0,","
				SOSLE	,LABB(YDST1)
				GOTO	TRUE
			SA

			LI	X0,"]"
			OUTCHA
			EXCH	XDZBE,0(XDSTK)	;Restore identifier entry address

	FI	FI			;[166]
	FI	FI
	IF	;[41] QUA
		IFOFF	ZBEQUA(XDZBE)
		GOTO	FALSE
	THEN
		DEXEC	DSOCB
		LI	X1,LAB(ZKWQUA)
		DEXEC	DSPSKB
		EXCH	XDZBE,(XDSTK)
		MDSNBW
		L	XDZPR,ZBEZSD(XDZBE)
		MDSPSP
		EXCH	XDZBE,(XDSTK)
	FI
	;Check for dot
AS
	IFOFF	ZBEIDD(XDZBE)
	GOTO	FALSE		;No more identifers
	DUNSTK	XDZBE
	LI	X0,"."
	OUTCHA
	MDSNBW
	GOTO	TRUE		;Next identifier
SA
	;Exit, XDZBE contains address of first identifier entry
	DUNSTK
	L	X1,XDZBE		;Save address of last identifier entry
	DUNSTK	XDTYP
	DUNSTK	XDADR
	DUNSTK	XDZBE
	DUNSTK	XDT5
	DRETUR

	EPROC
	SUBTTL	DSNI, SIMDDT subroutines

	Comment;

	Purpose:	Get next identification from input text

	Entries:	DSNI	normal entry
			DSNIS	one identifier has already been fetched
				from input

	Input arguments:XDZLN	entry in ZLN table pointing to current
				block, that gives the
				starting point for symbol table search
			XDZBE	last used ZBE entry, identification if any
				valid found must be placed in following
				ZBE entries
			YDSOCOM	switch on if scanning output command
				and subscripts may be skipped

	Normal exit:	DRETUR

	Error exit:	Skip DRETUR

	Output arguments:XDZLN unchanged
			XDZBE 	last used ZBE entry
			YDSOAI	switch on if array identifier without subscripts found
			YDSSTP	type of identifier returned in variable field

	Call format:	MDSNI (normal call) or
			BRANCH LAB(DSNI)	(special call)

	Used subroutines:DSOEM,DSGI,DSSS,DSSSP,DSSSR,DSCT,DSFB,DSSK,DSTXGI,DSO,DSRB

	Errors generated:
			All messages with  error constant starting qmni
			see page assembly time constants

	;
DSNI:	PROC
	;Get new identification from input text
	;Input	XDZLN
	;	XDZBE
	;Return when input not correct
	;Skip return if ok

	DSTACK	XDZBE
	DSTACK	XDZLN
	ASSERT	<
	LI	XDMN,QMAS01
	JUMPE	XDZLN,3+LAB(.)
	SKIPL	,(XDZLN)
	GOTO	LAB(DSIE)	;Implementation error
	>
IF
	LI	XDMN,QMNIII
	MDSGI
	GOTO	LAB(DSNI01)		;[41] No identifier found in input

DSNIS:	;Entry point when identifier already located in input

THEN
	IF	;[41] THIS was found
		CAME	XDSYM1,1+LAB(ZKWTHI)
		GOTO	FALSE
	THEN	LI	XDMN,QMNICI
		MDSGI
		GOTO	LAB(L4())		;Error no class identifier follows
		L	XDZLN,(XDSTK)
		LI	X0,LAB(DSNI02)
		L	XDZLN,(XDSTK)
		MDSSS
		LI	XDMN,QMNICI
		GOTO	LAB(L4())
	DSNI02:	;Subroutine in DSNI called from DSSS

		IF
			L	XDZPR,-1(XDSTK)	;Fetch prototype
			LF	X1,ZPRSYM(XDZPR)
			LF	X0,ZSMTYP(X1)
			CAIE	X0,QCEXT
			CAIN	X0,QCLASB
			GOTO	TRUE		;Class found
			CAIE	X0,QSYSCL
			GOTO	FALSE		;No class
		THEN
		IF
			LF	X0,ZLNTYP(XDZLN)
			CAIN	X0,QPBLOCK
			GOTO	FALSE		;Prefixed block not valid
		THEN
			LD	X0,-2(X1)	;Fetch class name
			CAMN	X0,LAB(YDSSYM)
			CAME	X1,1+LAB(YDSSYM)
		FI
		FI			DRETUR			;Try next if any
		;Right prototype found

		L	XDT3,XDZPR
		ST	XDZPR,LABB(YDSSQU)	;Save qualification
		SETONA	ZBETHI(XDT3)		;Indicate "THIS"
		LI	XDTYP,QREF
		DEXEC	DSSSR
		GOTO	LAB(DSNI03)
	FI
	L	XDZLN,(XDSTK)	;Restore

	LI	X0,LAB(L9())	;Parameter to DSSS subroutine address
	MDSSS			;Call DSS to search all visible symbol tables
	;Error, identifier not found in symbol tables

	IF				;[151] Start of change
		L	XDT3,LABB(YDSSYM)
		CAMN	XDT3,LAB([ SIXBIT "SYSIN" ])
		GOTO	TRUE			;Sysin requested
		SKIPN	X0,1+LABB(YDSSYM)	;Last part of name must be 0
		CAME	XDT3,LAB([ SIXBIT "SYSOUT" ])
		GOTO	FALSE			;No
	THEN
		L	XDZLN,YDSZLA(XLOW)		;Fetch main line number table
		LF	XDZLN,ZLNADF(XDZLN)		;Start of table
		LI	X0,LAB(L9())
		MDSSS
	FI				;[151] End of change
	LI	XDMN,QMNINV
	GOTO	FALSE

L9():!	;Subroutine in DSNI  called from DSSS

	IF				;[166] Start of change
					;Procedure requested?
		LF	X0,ZLNTYP(XDZLN)
		CAIE	X0,QPROCB
		GOTO	FALSE		;No procedure block
		IFOFFA	YDSCHG		;Procedure not allowed after IFCHANGED
		IFONA	YDSIFF		;or relation in breakpoints
		GOTO	FALSE
	THEN
		L	XDT3,-1(XDSTK)	;Fetch prototype
		LF	XDT3,ZPRSYM(XDT3)
		L	X0,-2(XDT3)
		L	XDT4,-1(XDT3)	;Fetch name of procedure

		IF
			CAMN	X0,LABB(YDSSYM)
			CAME	XDT4,1+LABB(YDSSYM)
			GOTO	FALSE		;Procedure not requested
		THEN
			LI	X0,-2(XDT3)
			ST	X0,LABB(YDSSSA)		;Save symbol address for DSPI
			LI	X1,LABB(YDSPZSD)
			GOTO	LAB(L7())		;dummy ZSD entry
							;Exit DSSS
		FI
	FI						;[166] End of change

	LD	XDT3,LABB(YDSSYM)	;Fetch symbol
	SKIPE	,X1

	WHILE

		SKIPN	,(X1)
		DRETUR			;No more ZSD entries for this block
	DO

		IF
			CAME	XDT3,1(X1)
			GOTO	FALSE			;No match
		THEN
			IF
				SKIPL	,(X1)
				GOTO	FALSE
			THEN
				CAMN	XDT4,2(X1)
				GOTO	LAB(L7())	;Match
			ELSE
				;Last six letters blank
				JUMPE	XDT4,LAB(L7())
			FI

		FI
		LF	X0,ZSDTYP(X1)
		SKIPGE	,(X1)
		AOJ	X1,
		ADDI	X1,2
		CAIN	X0,QREF
		AOJ	X1,
	OD
	;[41]

DSNI01:	;Check for * in input
	DEXEC	DSSKBN
	CAIE	XDBYTE,"*"
	GOTO	LAB(L4())		;Error no identifier found
	;Check if * allowed
	LI	XDMN,QMNIST
	IFOFFA	YDSOCO
	GOTO	LAB(L4())
	;* Ok
	DEXEC	DSSKB
	MDSFBW
	GOTO	LAB(L3())
	SETZM	,(XDZBE)
	SETON	ZBESTA(XDZBE)
	GOTO	LAB(L2())	;Return
L7():!	;Match symbol found
	;Exit from DSSS, restore stack!

	DEXEC	DSSSR		;Return from DSNI L9() subroutine
				;Remove stack entries for DSSS routine

	IF	;Symbol was accepted
L8():!						;[2] Main text attribute found
		MDSCT				;Check type, kind and mode of symbol
		JUMPL	XDTYP,FALSE
	THEN
		IF	;[41] REF
			CAIE	XDTYP,QREF
			GOTO	FALSE
		THEN	;Save prototype
			LF	X0,ZSDZPR(X1,-1)
			SKIPGE	,(X1)		;Six letters
			LF	X0,ZSDZPR(X1)
			ST	X0,LABB(YDSSQU)
		FI
		L	XDT3,X1			;Save X1
	DSNI03:	;Jump here if THIS found [41]
		MDSFBW
		GOTO	LAB(L3())		;No free ZBE entry?
		ST	XDTYP,LABB(YDSSTP)	;Save type, used in DSAT
		WSF	XDT3,ZBEZSD(XDZBE)
		MOVM	X1,LABB(YDSEBL)		;Effective block level

		SF	X1,ZBEEBL(XDZBE)
		L	XDT4,XDZBE		;Save
		IF	;Not Lastitem
			DEXEC	DSSKBN
			JUMPE	XDBYTE,FALSE
		THEN
			IF	;Left bracket
				CAIN	XDBYTE,"["
				GOTO	TRUE
				CAIE	XDBYTE,"("
				GOTO	FALSE		;. (dot) may follow
			THEN	;Find subscripts
				LOOP
					MTXGI
					GOTO	LAB(L3())	;Error

					;XWAC1 contains integer
					MDSFBW
					GOTO	LAB(L3())  	;If no ZBE entries
					ST	XWAC1,(XDZBE)
					LF	X0,ZBESUN(XDT4)
					AOJ	X0,
					SF	X0,ZBESUN(XDT4)
				AS
					DEXEC	DSSKB
					CAIE	XDBYTE,"]"
					CAIN	XDBYTE,")"
					GOTO	FALSE		;Check for .
					CAIN	XDBYTE,","
					GOTO	TRUE
					LI	XDMN,QMNISE
					GOTO	LAB(L4())

				SA
				MDSSKB
			FI
		FI

		;Error if array and no subscripts
		;Error if no array and subscripts present
		SETOFA	YDSOAI				;[41] No array identifier
		L	XDT2,XDT4
		LF	X1,ZBEZSD(XDT2)			;Fetch symbol entry
		LF	X1,ZSDKND(X1)
		LF	XDT5,ZBESUN(XDT2)
		IF	;ARRAY
			CAIE	X1,QARRAY
			GOTO	FALSE
		THEN	;Subscripts should follow except in OUTPUT command
			LI	XDMN,QMNINS

			IF	;No subscripts present
				JUMPN	XDT5,FALSE
			THEN	;Could be error
				IFOFFA	YDSOCOM
				GOTO	LAB(L4())	;Error if no subscripts
							;not output command
				SETONA	YDSOAI		;Indicate this
				GOTO	LAB(L2())	;Output of complete
							;array possible
			FI
		ELSE
			LI	XDMN,QMNINA
			JUMPN	XDT5,LAB(L4())
		FI
		IF	;QUA is allowed here
			L	X0,LABB(YDSSTP)	;[41]
			CAIE	X0,QREF
			GOTO	FALSE
		THEN
			DSTACK	XDT2
			DSTACK	LABB(YDSIPO)
			DSTACK	1(XDINT)
			DSTACK	LABB(YDSTIC)
		IF	;[41] QUA is used
			MDSGIS
			GOTO	FALSE
			CAME	XDSYM1,1+LAB(ZKWQUA)
			GOTO	FALSE
		THEN
			DUNSTK
			DUNSTK
			DUNSTK

			;Find class identifier

			LI	XDMN,QMNICI
			MDSGI
			GOTO	LAB(DSNI05)

			;Check if valid class identifier

			L	XDT2,LABB(YDSSQU)
			LOOP
				IF
					LF	X1,ZPRSYM(X2)
					CAME	XDSYM1,-2(X1)
					GOTO	FALSE		;Not found
					CAME	XDSYM2,-1(X1)
					GOTO	FALSE
				THEN
					GOTO	LAB(DSNI04)	;Class in prefix chain
				FI
			AS
				LF	XDT2,ZCPZCP(XDT2)
				JUMPN	XDT2,TRUE
			SA
			;Not found in prefix chain
			SETZ	XDT4,
			DEXEC	DSLPR		;Find any class with name XDSYM1,XDSYM2
						;and YDSSQU in its prefix chain
			IF
				JUMPE	XDT2,FALSE		;Not found
			THEN
				LF	XDT2,ZLNADF(XDT2)
				GOTO	LAB(DSNI04)
			FI

			LI	XDMN,QMNICI
		DSNI05:	DUNSTK	XDT2
			GOTO	LAB(L4())		;Qualification not ok

		DSNI04:	;Qualification ok
			MDSFBW
			GOTO	LAB(DSNI05)
			WSF	XDT2,ZBEZSD(XDZBE)	;Save prototype
			ST	XDT2,LABB(YDSSQU)
			DUNSTK	XDT2

			SETON	ZBEQUA(XDT2)
		ELSE
			DUNSTK	,LABB(YDSTIC)
			DUNSTK	,1(XDINT)
			DUNSTK	,LABB(YDSIPO)
			DUNSTK	XDT2
		FI
		FI
		IF	;Dot
			DEXEC	DSSKBN
			CAIE	XDBYTE,"."
			GOTO	FALSE
		THEN
			IF	;[41] not (after THIS or REF var or TEXT var)
				IFON	ZBETHI(XDT2)
				GOTO	FALSE
				LI	XDMN,QMNINR
				LF	XDT3,ZBEZSD(XDT2)
				;[2]
				IFEQF	(XDT3,ZSDTYP,QREF)
				GOTO	FALSE
			THEN
				IFNEQF	(XDT3,ZSDTYP,QTEXT)
				GOTO	LAB(L4())	;Error, no ref or text
							; variable
			FI
			SETON	ZBEIDD(XDT2)
			LI	XDMN,QMNIID
			MDSGI
			GOTO	LAB(DSNI01)		;No identifier in input after .

			IF	;[2] REF
				L	X0,LABB(YDSSTP)	;[41]
				CAIN	X0,QREF
				GOTO	FALSE
			THEN	;Check for Main
				LI	XDMN,QMNINM

				CAME	XDSYM1,1+LAB(ZKWMAIN)	;Only Main allowed
				GOTO	LAB(L4())		;Error
				LI	X1,LAB(DSZSDM)		;Address
								;of ZSD entry
								;for main
				GOTO	LAB(L8())
			FI

			;Find class prototype
			L	X1,LABB(YDSSQU)		;[41]

			;Change XDZLN to outermost block
			;Only class and prefix classes may be searched
			L	XDZLN,LABB(YDSCZS)

			LI	X0,LAB(L9())
			DEXEC	DSSSP			;Look for symbol match
							;Special entry only
							;Class and prefix classes
							;searched
			LI	XDMN,QMNIIA
			GOTO	LAB(L4())		;Attribute identifier not found
							;in symbol table

		FI
L2():!

		IF			;[166] Start of change
			LF	X0,ZBEZSD(XDZBE)
			CAIE	X0,LABB(YDSPZSD)
			GOTO	FALSE
		THEN
			MDSFBW			;Procedure id
			GOTO	LAB(L3())
			L	X0,LABB(YDSSSA)	;Symbol address
			WSF	X0,ZBEZSD(XDZBE)
		FI			;[166] End of change
		AOS	,-2(XDSTK)	;Skip return correct identification
		GOTO	LAB(L5())

	FI
FI


L4():!	;Error found

	MDSOEM			;Create error message

L3():!	;Error but message already created
	;Release any ZBE entries

	L	XDZBE,-1(XDSTK)	;Fetch input ZBE
	MDSRB
L5():!	;Exit
	DUNSTK	XDZLN
	DUNSTK			;XDZBE updated, X0 holds calling XDZBE
	DRETUR

	EPROC
	SUBTTL	DSSS, SIMDDT subroutines

	Comment;

	Purpose:	Search all blocks accessible via current display

	Entry:		DSSS	normal entry all symbol tables are searched
			DSSSP	entry if only classes and its prefix
				classes is to be searched, used to find
				class attributes (called from DSNI)
			DSSSR	exit DSSS subroutine

	Input arguments:X0	address of subroutine to be called when
				a ZSD entry located
			XDZLN	pointer to block type entry in ZLN
				See DSNI

	Normal exit:	DRETUR

	Error exit:	none

	Output arguments:XDZLN	unchanged

	Used subroutines:Input subroutine is called when valid
			ZSD entry located
			Stack contains prototype address
			X1 points at ZSD entry
	;
	PROC
DSSS:	;
	;Search all blocks acessible via current display
	;Input	X0	address of subroutine to be called
	;		when a ZSD entry located
	;	XDZLN	pointer to block type entry in ZLN
	;
IF
	JUMPE	XDZLN,FALSE		;No block structure entry identified
THEN

	DSTACK	X0
	DSTACK	XDZLN
	LOOP
		;Symbol in YDSSYM

		LF	X1,ZLNTYP(XDZLN)
		IF
			CAIN	X1,QPROCB
			GOTO	TRUE		;Block with prototype
			CAIN	X1,QPBLOCK
			GOTO	TRUE
			CAIN	X1,QCLASB
			GOTO	TRUE
			CAIN	X1,QUBLOCK
			GOTO	TRUE
			CAIE	X1,QRBLOCK
			GOTO	LAB(L1())

			;Reduced block

			HLRZ	X0,(XDSTK)
			IF
				JUMPE	X0,FALSE	;Innermost subblock
			THEN
							;[2]
				SKIPN	LABB(YDSNLN)
				ST	XDZLN,LABB(YDSNLN)	;Save address of entry
								;for innermost block
								;but one
								;[2]

			ELSE
				SETZM	LABB(YDSNLN)
				ST	XDZLN,LABB(YDSSLN)	;Save address of entry
								;for innermost block
				LF	X0,ZLNADF(XDZLN)
				HRLM	X0,(XDSTK)	;Save state
			FI
			GOTO	FALSE		;Next ZLN entry
		L1():!
			CAIE	X1,QEBLOCK
			GOTO	LAB(L2())

			;End of block(s)

			LF	XDZLN,ZLNADF(XDZLN)
			GOTO	FALSE		;Skip all inner blocks
		L2():!
			CAIGE	X1,QCEXT
			GOTO	LAB(L9())
			CAIG	X1,QFEXT
			GOTO	FALSE		;External module, try next entry
		L9():!

			;Inspect block

			ASSERT	<
				LI	XDMN,QMAS02
				CAIE	X1,QINSPEC
				GOTO	LAB(DSIE)	;Implementation error
				>
			HRRE	X0,0(XDZLN)		;Fetch right level

							;for inspect block
			SOJ	XDZLN,
			LF	X1,ZLNADF(XDZLN)
			GOTO	1+LAB(L7())
		THEN	;Symbol table address via prototype address in ZLN

			LF	X1,ZLNADF(XDZLN)	;Prototype address
		L7():!
			LFE	X0,ZPREBL(X1)
			ST	X0,LABB(YDSEBL)		;Save level
		L8():!	DSTACK	X1			;Save prototype
L6():!	;Search symbol table
			HLRZ XDT2,-1(XDSTK)

			LF	X1,ZPRSYM(X1)
			JUMPE	X1,LAB(L3())			;No symbol table

			;Calculate start  address in ZSM
			LSHC	XDT2,-1
			ADD	XDT2,X1
			IF
				JUMPL	XDT3,FALSE
			THEN
				;Even state number
				LF	X1,ZSMZSR(XDT2)
			ELSE
				;Odd
				LF	X1,ZSMZSL(XDT2,1)

			FI

		L3():!	;Call subroutine given as input parameter
			PUSHJ	XDSTK,@-2(XDSTK)
			;Return from subroutine, find next ZSD entry
			L	X1,(XDSTK)		;Fetch prototype address

			IF	;Reduced block
				IFONA	YDSOSB			;[41]
				GOTO	FALSE			;[41] Only one block
				HLRZ	XDT2,-1(XDSTK)
				JUMPE	XDT2,FALSE
			THEN
				LF	XDT3,ZPRMAP(X1)		;Find map
				L	X0,XDT2
				IMULI	X0,ZMP%S
				ADD	XDT3,X0
				LF	XDT3,ZMPZMP(XDT3)
				LF	XDT2,ZPRMAP(X1)
				SUB	XDT3,XDT2
				IDIVI	XDT3,ZMP%S
				HRLM	XDT3,-1(XDSTK)		;Save new state number
				GOTO	LAB(L6())		;New subblock
			FI

			LF	XDT2,ZPRSYM(X1)
			LF	X0,ZSMTYP(XDT2)
			IF
				CAIE	X0,QSYSCL
				CAIN	X0,QCLASB
				GOTO	TRUE
				CAIN	X0,QCEXT
				GOTO	TRUE
				CAIE	X0,QPBLOCK
				GOTO	FALSE
				HLRZ	X0,-1(XDSTK)		;[41]
				IFONA	YDSOSB
				JUMPN	X0,FALSE		;Not outer block
			THEN	;Block may be prefixed
				LF	X1,ZCPZCP(X1)		;Prototype address if
								;Prefix exists
				JUMPE	X1,FALSE
				DUNSTK
				GOTO	LAB(L8())	;Symbol is prefix
							;attribute
			FI

			DUNSTK	X0			;Remove prototype address
		FI	;Try enclosing block if any
	AS
		LI	XDZLN,(XDZLN)		;Remove any block state variable
		CAMN	XDZLN,LABB(YDSCZS)
		GOTO	FALSE			;No more blocks
		LF	XDZLN,ZLNBLK(XDZLN)
		ADD	XDZLN,LABB(YDSCZS)
		GOTO	TRUE
	SA
	DUNSTK	XDZLN
	DUNSTK			;Subroutine address
FI
	DRETUR
DSSSP:	;Entry into DSSS when search of only prefix classes is to be performed
	;from DSNI

	DSTACK	X0
	DSTACK	XDZLN
	GOTO	LAB(L7())

DSSSR:	;Exit DSSS from subroutine given in call to DSSS

	DUNSTK			;Exit DSSSR address
	ST	X0,-4(XDSTK)
	DUNSTK			;Exit subroutine address
	DUNSTK	XDZPR
	DUNSTK	XDZLN
	DUNSTK			;Subroutine address
	DRETUR

	EPROC
	SUBTTL	DSCT, SIMDDT subroutine
	Comment/
	Purpose:	Check symbol table entry
			Check if kind, mode and type of symbol
			can be handled by SIMDDT

	Entry:		DSCT

	Input argument:	X1 addresses ZSD entry

	Exit:	DRETUR

	Output:		XDTYP is -1 if symbol not valid
				otherwise it contains ZSDTYP
			X0    is ZSDKND
			XDMN  is message number if symbol is not valid

	/

DSCT:	PROC
	LI	XDMN,QMNITL
	LF	XDTYP,ZSDTYP(X1)
	IF	;Not label, name param
		CAIN	XDTYP,QLABEL
		GOTO	FALSE
		LI	XDMN,QMNIMN
		IFEQF	(X1,ZSDMOD,QNAME)
		GOTO FALSE
	THEN
		LF	X0,ZSDKND(X1)

		IF	;[2] Procedure
			CAIE	X0,QPROCEDURE
			GOTO	FALSE
		THEN	;Standard procedure ?
			LF	XDMN,ZSDSPI(X1)
			JUMPN	XDMN,FALSE	;Ok, standard proc
			LI	XDMN,QMNIKP
			GOTO	LAB(L1())	;Not standard procedure
		FI
		LI	XDMN,QMNIKC
		CAIN	X0,QCLASS
		GOTO	LAB(L1())		;[242] Class not possible
		LI	XDMN,QMNIUN
		CAIN	X0,QUNDEF
	FI
L1():!	SETO	XDTYP,				;-1 signals error return
	DRETUR
	EPROC
	SUBTTL	DSLV, SIMDDT subroutines

	Comment/
	Purpose:	Locate value address

	Entry:		DSLV

	Input arguments:
			XDZBE	pointer into ZBE entry which
				starts an identification
			XCB	from RTS, current block pointer

	Normal exit:	DRETUR

	Error exit:	DRETUR

	Output arguments:
			Normal return:
			XDADR	address of value
			XDTYP	type of value
			XDZBE	unchanged
			XDT5	address of ZSD entry
			Switch YDSOAI set if array identifier without subscripts found
			Error return:
			XDADR	0

	Call format:	Normal

	Used subroutines:DSOEM,DSNB,DSCSQU

	/

DSLV:	PROC

	DSTACK	XDZBE
	SETOFA	YDSOAI			;[41]
	;[2]
	L	X1,YDSSXCB(XLOW)	; [2] Find current block
	IF
		IFON	ZBESTAR(XDZBE)	;[41]
		GOTO	FALSE			;[41] * found
		LF	X0,ZBEEBL(XDZBE)	;[41] Block level
		LF	XDMN,ZBIZPR(X1)
		LFE	XDMN,ZPREBL(XDMN)	;Find effective level of block
		ADD	XDMN,X0
		JUMPE	XDMN,FALSE		;X1 valid
	THEN
		;Find block instance address
		DSTACK	X0			;Save level

		IF	;Terminated block or without display vector
			IFOFF ZDNTER(X1)
			GOTO	FALSE
			IFON	ZDNKDP(X1)
			GOTO	FALSE
		THEN	;Error
			LI	XDMN,QMLVET
			GOTO	LAB(L1())
		FI
		DUNSTK
		SUB	X1,X0
		L	X1,(X1)
	FI
	SETZ	XDT2,		;[41]
LOOP
	DSTACK	XDZBE

	;[41] Check for *
	IF	;* found
		IFOFF ZBESTAR(XDZBE)
		GOTO	FALSE
	THEN	;X1 points at block
		LI	XDT5,"*"
		GOTO	LAB(L4())		;Exit DSLV
	FI
	IF	;[41] THIS
		IFOFF	ZBETHIS(XDZBE)
		GOTO	FALSE
	THEN	;Create dummy entry for THIS
		MOVSI	X0,000701		;Simple declared REF variable
		ST	X0,LABB(YDSTHD)
		ST 	X1,1+LABB(YDSTHD)	;Save class block address
		LI	X1,1+LABB(YDSTHD)	;Update address
		LF	XDT2,ZBEZSD(XDZBE)
		ST	XDT2,2+LABB(YDSTHD)	;Save class prototype
		LI	XDT2,LABB(YDSTHD)
		GOTO	LAB(L5())
	FI

	IF	;[2] System procedure handled by SIMDDT
		LF	XDT2,ZBEZSD(XDZBE)
		IFNEQF	(XDT2,ZSDKND,QPROCEDURE)
		GOTO	FALSE
	THEN
		IF	;[166] Type procedure
			CAIE	XDT2,LABB(YDSPZSD)
			GOTO	FALSE
		THEN
			LF	X0,ZDNTYP(X1)
			CAIE	X0,QZBP
			GOTO	LAB(DSTERM)
			LF	XDMN,ZBIZPR(X1)		;Fetch prototype
			LF	X0,ZPCTYP(XDMN)
			LI	XDMN,QMLVNP
			CAIN	X0,QNOTYPE		;Type procedure
			GOTO	LAB(L1())		;No,  error
			LI	XDT2,LABB(YDSTPZSD)	;Type proc entry
			LSH	X0,6			;Construct ZSD entry
			ADDI	X0,1			;Simple var
			HRLM	X0,LABB(YDSTPZSD)	;Insert type
			GOTO	LAB(L9())		;Treat like ordinary symbol
		FI			;[166] End of change
		DEXEC	DSSPV
		JUMPN	XDMN,LAB(L1())	;Error in evtime
	ELSE
	L9():!						;[166]
		LF	X0,ZSDOFS(XDT2)
		ADD	X1,X0			;Address of variable
	FI


	IF
		IFNEQF	(XDT2,ZSDKND,QARRAY)
		GOTO	FALSE
	THEN	;ARRAY
		HRRZ	XDT5,(X1)		;Fetch array address
						;[1] Only in rh
		;Check if array initialized
		LI	XDMN,QMPVRI
		JUMPE	XDT5,LAB(L1())
		CAIN	XDT5,NONE
		GOTO	LAB(L1())

		LF	X0,ZARSUB(XDT5)
		LF	XDT3,ZBESUN(XDZBE)

		SETONA	YDSOAI
		JUMPE	XDT3,FALSE		;[41] Array identifier
		SETOFA	YDSOAI
		L	X1,XDT5			;Array address to X1
						;Array identifier specified
						;in output command
		LI	XDMN,QMLVSN
		CAME	X0,XDT3
		GOTO	LAB(L1())		;Error wrong number of subscripts
		DSTACK	X1

		LOOP
			;Get next ZBE word
			MDSNBW
			LF	X0,ZBEVSU(XDZBE)
			LI	XDMN,QMLVSL
			CAMGE	X0,ZARLOO(X1)
			GOTO	LAB(L3())		;Error
			LI	XDMN,QMLVSU
			CAMLE	X0,ZARUPO(X1)
			GOTO	LAB(L3())

			IF	;First subscript
				JUMPL	XDT3,FALSE
			THEN
				L	XDT2,X0
				MOVN	X0,XDT3
				ASH	XDT3,1
				ADDI	XDT3,3(X1)
				HRL	XDT3,X0
				;XDT3 is [-n,,address of first dope vector]
			ELSE
				IMUL	X0,0(XDT3)
				ADD	XDT2,X0
			FI
		AS
			ADDI	X1,2
			AOBJN	XDT3,TRUE		;Next subscript
		SA
		DUNSTK	XDT3		;XDT3 contains variable address
		EXCH	XDZBE,(XDSTK)
		L	X1,XDT2
		LF	XDT2,ZBEZSD(XDZBE)
		LF	X0,ZSDTYP(XDT2)
		CAIE	X0,QLREAL
		CAIN	X0,QTEXT
		ASH	X1,1		;Size of element is 2
		ADD	X1,ZARBAO(XDT3)
	FI
	;XDZBE  points at last identifier entry
	;Stack points at last referenced ZBE entry
	;XDT2 points at ZSD entry
	;X1 points at element

L5():!	;[41] THIS found
	IF	;QUA found
		IFOFF	ZBEQUA(XDZBE)
		GOTO	FALSE
	THEN	EXCH	XDZBE,(XDSTK)
		MDSNBW
		LF	X0,ZBEZSD(XDZBE)	;Fetch prototype
		ST	X0,2+LABB(YDSTHD)
		L	XDT2,(XDT2)		;Fetch ZSD entry
		TLZ	XDT2,400000		;Force name length to 6 letters
		ST	XDT2,LABB(YDSTHD)
		LI	XDT2,LABB(YDSTHD)
		EXCH	XDZBE,(XDSTK)
	FI
AS
	IFOFF	ZBEIDD(XDZBE)
	GOTO	FALSE
	;Dot notation in identification

	IF	;[2] not TEXT
		LF	X0,ZSDTYP(XDT2)
		CAIN	X0,QTEXT
		GOTO	FALSE		;Text attribute main
	THEN
		HLLOI	X0,0		;NONE not valid but subclass ok
		MCSQU			;Check qualif
		GOTO	LAB(L2())	;Error
	FI
	DUNSTK	XDZBE		;Skip any subscripts
	MDSNBW
	CAIE	X0,QTEXT	;[2] Ref to text variable in X1 if text
	L	X1,(X1)		;Object address
	GOTO	TRUE		;Next identifier
SA

	;End of identification  found

	LF	XDT5,ZSDTYP(XDT2)
	IF
		IFOFFA	YDSOAI			;Not possible to check
						;qualification if array output
		CAIE	XDT5,QREF
		GOTO	FALSE
	THEN
		SETO	X0,		;Both NONE and subclass ok
		MCSQU
		GOTO	LAB(L2())	;Error
	FI

L4():!	;[41]
	EXCH	XDT5,XDTYP		;At exit XDTYP loaded
					;XDT5 contains ZSD pointer
	L	XDADR,X1
	GOTO	1+LAB(L2())		;Normal return

L3():!	DUNSTK
L1():!	;Error
	MDSOEM
L2():!	SETZB	XDADR,XDTYP
	DUNSTK
	DUNSTK	XDZBE
	DRETUR

	EPROC
	SUBTTL	DSSPV, SIMDDT subroutines

Comment;[2]  new SIMDDT facility

Purpose:	To get system procedure value address for
		MAIN, SYSIN, SYSOUT, FIRST, LAST, SUC, PRED,PREV,
		EVTIME, NEXTEV,TIME and CURRENT

Entry:		DSSPV

Input arg.:	X1	points at block instance
		X2=XDT2 points at ZSD entry

Normal exit:	DRETURN

Error exit:	DRETURN

Output arg.:	X1	address of variable
		XDMN	= 0 if no error
			= Error number if error in evtime

Call format:	DEXEC	DSSPV

Used subroutines:	TXMN, SUNE

	;



DSSPV:	PROC
	DSTACK	X2		;Save X2
	SETZ	XDMN,		;Indicate no error
	LF	X2,ZSDSPI(X2)
	ADDI	X2,-1(XDBAS)	;DSMAIN first entry at offset 0 from DSSPVT
				;DSMAIN has ZSDSPI=QIMAIN=1
	GOTO	@DSSPVT-DSSTAR(X2)	;Jump to the routine given by index ZSDSPI


DSSPVT:			;Jump table
	LAB(DSMAIN)
	LAB(DSSYSIN)
	LAB(DSSYSOUT)
	LAB(DSFIRST)
	LAB(DSLAST)
	LAB(DSSUC)
	LAB(DSPRED)
	LAB(DSPREV)
	LAB(DSEVTIME)
	LAB(DSNEXTEV)
	LAB(DSTIME)
	LAB(DSCURRENT)



DSMAIN:	LD	X1,(X1)
	STD	X1,LABB(YDSSPV)
	LI	XTAC,LABB(YDSSPV)
	MTXMN
	L	X1,XTAC		;Text ref in X1
	GOTO	LAB(DSSPVX)



DSSYSIN:
	LI	X1,YSYSIN(XLOW)
	GOTO	LAB(DSSPVX)



DSSYSOUT:
	LI	X1,YSYSOUT(XLOW)
	GOTO	LAB(DSSPVX)




DSFIRST:
	LF	X0,ZLGSUC(X1)
L2():!	CAMN	X0,X1
	LI	NONE
L3():!	ST	X0,LABB(YDSSPV)
	LI	X1,LABB(YDSSPV)
	GOTO	LAB(DSSPVX)




DSLAST:
	LF	X0,ZLGPRE(X1)
	GOTO	LAB(L2())




DSSUC:	LF	X0,ZLGSUC(X1)
L4():!	L	X1,X0
	IF
		CAIN	X1,NONE
		GOTO	FALSE
	THEN
		L	X2,(XDSTK)		;ZSD entry
		L	X2,OFFSET(ZSDZPR)-1(X2)	; .SSLK
						; ZSDNM2 not present for
						; SUC or PRED
		LF	X1,ZBIZPR(X1)
		WHILE
			JUMPE	X1,FALSE
		DO
			CAMN	X2,X1
			GOTO	LAB(L3())
			LF	X1,ZCPZCP(X1)
		OD
		LI	X0,NONE
	FI
	GOTO	LAB(L3())




DSPRED:	LF	X0,ZLGPRE(X1)
	GOTO	LAB(L4())




DSPREV:	LF	X0,ZLGPRE(X1)
	GOTO	LAB(L3())




DSEVTIME:	;If the process is idle i.e. has no event notice,
		; give error message number in XDMN

	LF	X1,ZPSZEV(X1)
	IF
		JUMPN	X1,FALSE
	THEN
		SETZ	X0,		;Set evtime to 0 = initial value
					; not visible after var command
		IFONA	YDSOCOM	;[237] No error in VAR, ALL or OUTPUT * commands
		SETONA	YDSERE
		LI	XDMN,QSUENO+2	;ZYQ145 = SUERR 2

		GOTO	LAB(L3())
	ELSE
		LI	X1,OFFSET(ZEVTIM)(X1)
		GOTO	LAB(DSSPVX)
	FI




DSNEXTEV:
	DSTACK	XWAC1		;Save XWAC1
	LI	XTAC,XWAC1
	L	XWAC1,X1
	MSUNE
	L	X0,XWAC1
	DUNSTK	XWAC1		;Restore XWAC1
	GOTO	LAB(L3())




DSTIME:		;Simulation block address in X1
	LF	X1,ZSUFT(X1)
	LI	X1,OFFSET(ZEVTIM)(X1)
	GOTO	LAB(DSSPVX)




DSCURRENT:	;Simulation block address in X1
	LF	X1,ZSUFT(X1)
	LF	X0,ZEVZPS(X1)
	GOTO	LAB(L3())




DSSPVX:		;Exit from DSSPV
	DUNSTK	X2
	DRETURN
	EPROC
	SUBTTL	DSCSQU, SIMDDT subroutines

	Comment/
	Purpose:	Call RTS routine CSQU

	Entry:		DSCSQU

	Input arguments:X1 address of ref variable
			XDT2 ZSD entry
			X0 qualification parameter to CSQU

	Normal exit:	Skip DRETURN if ok

	Error exit:	DRETUR if qualification error
			Message already created

	Call format:	normal

	Used subroutines:DSOBM and CSQU
	/
	;
DSCSQU:	PROC
	DSTACK	XWAC1
	DSTACK	XSAC
	n==2

	L	XWAC1,(X1)		;Fetch object reference

	;Check if address initialized
	LI	XDMN,QMPVRI
	JUMPE	XWAC1,LAB(L1())		;Error

	JUMPE	XDT2,LAB(L2())		;[166] Procedure values lacks ZSD reference
	;Find prototype address
	LF	XSAC,ZSDZPR(XDT2,-1)
	SKIPGE	,(XDT2)
	LF	XSAC,ZSDZPR(XDT2)	;2 words for symbol
	JUMPE	XSAC,LAB(L2())		;[166] Skip test

	EXEC	CSQU
	IF	;Qualification error
		JUMPN	XWAC1,FALSE
	THEN	LI	XDMN,QMCSQE
L1():!		MDSOEM
		GOTO	LAB(L9())	;Return
	FI
L2():!					;[166]
	AOS	-n(XDSTK)		;Skip return
L9():!	DUNSTK	XSAC
	DUNSTK	XWAC1
	n==0
	DRETUR

	EPROC
	SUBTTL	DSNILV, SIMDDT subroutine

	PROC
	Comment/

	Purpose:Call DSNI and DSLV
		Called from DSOP, DSPC [2]  and DSIP command routines
		Dummy ZBE  entries used

	Entry:	DSNILV

	Input arguments:-

	Normal exit:	Skip DRETURN

	Error exit:	DRETURN
			Branch DSCM if no free ZBE entries

	Output arguments:See DSLV
			Dummy ZBE entries built
	Used subroutines:DSNB,DSFB,DSLV and DSNI
	/

DSNILV:
	IF
		SETZM	,LABB(YDSBRD)
		LI	XDZBE,LABB(YDSBRD)
		MDSFB
		GOTO	LAB(L1())
		L	XDZLN,LABB(YDSCZL)	;Fetch right environment

		MDSNI
		GOTO	FALSE

		LI	XDZBE,LABB(YDSBRD)
		MDSNB
		MDSNBW
		MDSLV
		JUMPE	XDADR,FALSE
	THEN
		AOS	,(XDSTK)		;Normal return
	FI

	DRETUR

L1():!	;Exit to DSCM if no free ZBE entries

	DUNSTK
	BRANCH	LAB(DSCM)

	EPROC
	SUBTTL	DSPV, SIMDDT subroutines
	PROC
	Comment/
	Purpose:	Put value in output text preceded by = or ==

	Entries:	DSPVT	put  tab assign value
			DSPV	put blank assign value
			DSPVN	put value
			DSPVS	put text constant

	Input arguments:XDADR	address of value
			XDTYP	type of value
			XDZSD if ref variable

	Normal exit:	DRETUR

	Error exit:	-

	Output arguments:-

	Used subroutines:DSOC,CSQU,TXPI,TXPR,DSPM,DSPLO,TXST,DSPSK,DSFA
	/

DSPVT:	;Put value preceded by tab assign characters
	DEXEC	DSOCT
	SKIPA
DSPV:	;Put value preceded by blank assign characters
	DEXEC	DSOCB
	LI	XDMN,QMOPAS
	LI	X0,"="
	CAIE	XDTYP,QREF
	CAIN	XDTYP,QTEXT
	OUTCHA
	MDSPM				;Create = or ==
DSPVN:	;Put value in output text no assign characters
	SETONA	YDSSTRING		;Text variable
DSPVNS:	;Text constant output
	LD	XWAC3,(XDADR)		;Load value
IF
	CAIE	XDTYP,QINTEGER
	GOTO	FALSE
THEN
	;Treat integer
	MTXPI
	DRETUR
FI
IF	;REAL
	CAIE	XDTYP,QREAL
	GOTO	FALSE
THEN	SETZ	XWAC4,
	LI	XWAC5,QNSDR	;Number of significant digits for real
	GOTO	LAB(L1())
FI
IF
	CAIE	XDTYP,QLREAL
	GOTO	FALSE
THEN
	LI	XWAC5,QNSDLR	;Number of significant digits  for long real
L1():!	;From real
	MTXPR
	DRETUR
FI

IF	CAIE	XDTYP,QBOOLEAN
	GOTO	FALSE
THEN
	LI	X1,LAB(ZKWFALSE)
	JUMPE	XWAC3,LAB(L2())		;Put FALSE in text
	LI	X1,LAB(ZKWTRUE)
	GOTO	LAB(L2())		;Put TRUE in text
FI
IF
	CAIE	XDTYP,QCHARACTER
	GOTO	FALSE
THEN
	IF	;Possible special char
		CAIL	XWAC3,40
		GOTO	FALSE
	THEN	;Output CHAR i instead
		MDSPM	QMPVCH		;CHAR
		MTXPI
		OUTCHB
	ELSE	;Output 'c'
		LI	X0,"'"
		OUTCHA
		L	X0,XWAC3
		CAIE	X0,0		;Skip if delete char
		OUTCHA
		LI	X0,"'"
		OUTCHA
	FI

	DRETUR
FI
IF	;TEXT
	CAIE	XDTYP,QTEXT
	GOTO	FALSE
THEN
	IF	;NOTEXT
		JUMPN	XWAC3,FALSE
	THEN
		LI	X1,LAB(ZKWNOTEXT)
		GOTO	LAB(L2())
	FI
	IF	;Not a string
		IFOFFA	YDSSTRING
		GOTO	FALSE
	THEN
		;Output octal address of text variable

		HRRZ	XDSTA,XWAC3
		DEXEC	DSPLO
		DEXEC	DSOCB

		DSTACK	XWAC4
		DSTACK	XWAC3
		LI	XTAC,XWAC3

		MTXST		;Strip

		DUNSTK	XWAC3
		EXCH	XWAC4,(XDSTK)	;Save new length

	FI

	;Create byte pointer to first character
	HLRZ	X0,1(XWAC3)	;[51] Check for subtext by comparing Main.Length
	HLRZ	X1,XWAC4	;[51] to Length
	SUB	X0,X1		;[51] Difference
	HLRZ	X1,XWAC3	;Offset within Main text

	IF	;Subtext
		JUMPE	X0,FALSE		;[51]
	THEN	;Output position where subtext starts
		MDSPM	QMPVST
		DSTACK	XWAC3
		LI	XWAC3,1(X1)		;[51] Add 1 to start pos
		MTXPI
		OUTCHB
		DUNSTK	XWAC3
		HLRZ	X1,XWAC3
	FI
	IDIVI	X1,5
	ADDI	XWAC3,ZTE%S(X1)
	HRLI	XWAC3,(POINT 7,0)
	WHILE
		SOJL	X2,FALSE
	DO
		IBP	,XWAC3
	OD
	ST	XWAC3,LABB(YDST2)
	HRRZ	X1,XWAC4		;Save length
	IF	;Not a string
		IFOFFA	YDSSTRING
		GOTO	FALSE
	THEN
		;Output length
		MDSPM	QMPVLE
		HLRZ	XWAC3,XWAC4
		MTXPI
		OUTCHB

		;Output pos
		MDSPM	QMPVPO
		HRRZ	XWAC3,XWAC4
		AOJ	XWAC3,		;Calculate user pos value
		MTXPI
		OUTCHB

		HLRZ	X1,XWAC4	;Save original length
		DUNSTK	XWAC4		;Fetch length of stripped text
	FI
	IFONA	YDSSKT		;[41]
	DRETURN			;[41] /-TEXT was given in command, skip characters
	LI	X0,QTEXTQ
	OUTCHA

	;Output characters
	HLRZ	XWAC3,XWAC4		;Number of characters
	SUB	X1,XWAC3		;Calculate length difference

	LOOP
		ILDB	X0,LABB(YDST2)
		;[41][2]
		IF
							;[41] DO NOT SKIP 0
		THEN
			IF	;Special character
				CAIL	X0," "		;[41]
				GOTO	FALSE
			THEN	;Output ^ plus alphanumeric char.
				DSTACK	X0
				LI	X0,"^"
				OUTCHA
				DUNSTK
				ADDI	X0,100
			FI
			OUTCHA
		FI
	AS
		IFON	YDSSUP(XLOW)	;[41]
		DRETURN			;[41]	Do not output characters if ^C - REENTER given
		DECR	XWAC3,TRUE
	SA

	LI	X0,QTEXTQ
	IFONA	YDSSTRING		;[51]
	SKIPN	,X1			;Blanks found at the end, omit "

	OUTCHA
	DRETUR
FI
IF	;REF
	CAIE	XDTYP,QREF
	GOTO	FALSE
THEN
	HRRZS	XWAC3	;[1] zero lh
	IF	;NONE
		CAIE	XWAC3,NONE
		GOTO	FALSE
	THEN	;Output NONE
		LI	X1,LAB(ZKWNONE)
	L2():!	;Output symbol
		MDSPSK
		DRETUR
	FI
	IF	;REF var uninitialized
		JUMPN	XWAC3,FALSE
	THEN
		MDSPM	QMPVRI		;Ref variable 0
		DRETUR	;[242]
	FI

	;Valid ref variable
	;Check qualification
	LI	X1,XWAC3
	L	XDT2,XDZSD
	SETO	X0,		;Both NONE and subclass ok
				;[66] No ZSD check, moved to DSCSQU
	MCSQU
	SKIP			;Ignore error
	L	XDSTA,XWAC3
	MDSFA			;Output class identifiction
	DRETUR
FI
	;SIMDDT implementation error, invalid type
	GOTO	LAB(DSIE)
	EPROC
	SUBTTL	DSPVS, SIMDDT subroutine
	Comment/
	Purpose:
		Treat output of array identifier and complete blocks
		Input arguments see DSPV

	Normal exit:	DRETUR if array or * found
			SKIP DRETUR if no action

	/
	PROC
DSPVS:	;[41]
	IF	;ARRAY output enabled
		IFOFFA	YDSOAI
		GOTO	FALSE
	THEN
		;Output array
		;That is name plus array bounds and
		;all elements that do not have their initial values
		ST	XDTYP,LABB(YDSTYP)	;Save type
		L	X1,XDT5			;Address of ZSD entry
						;XDADR=address of  array
		DSTACK	X1			;
		DEXEC	DSPAE			;Output elements
		DUNSTK
		GOTO	LAB(DSPVS1)
	FI
	IF
		CAIE	XDTYP,"*"
		GOTO	FALSE
	THEN
		;Output all variables in block
		;* or .* found
		LF	X0,ZTVCP(XDINT,ZTV%S)
		SKIPE	X0,X0
		MDSVO			;Start on new line
		SETONA	YDSOSB
		DSTACK	XDSTA
		ST	XDADR,LABB(YDSSBA)
		L	XDSTA,XDADR
		DSTACK	XDT5
		MDSFA
		MDSVO			;Output block identification
		DUNSTK	XDT5
		L	XDZLN,LABB(YDSCZS)
		IF
			JUMPE	XDT5,FALSE		;*
		THEN	;Reference.*
			LF	X1,ZSDZPR(XDT5,-1)
			SKIPGE	,(XDT5)
			LF	X1,ZSDZPR(XDT5)
		ELSE	;Current block output
			DEXEC	DSPCL		;Output line identification
			L	XDZLN,LABB(YDSCZS)
			L	X1,LABB(YDSCZL)
			JUMPE	X1,LAB(L3())		;[154] No line found
			WHILE
				LF	X0,ZLNTYP(X1)
				CAIGE	X0,QCEXT
				GOTO	LAB(L2())
				CAIG	X0,QFEXT
				GOTO	LAB(L1())
			L2():!	CAIE	X0,QEBLOCK
				GOTO	FALSE
			DO
				LF	X1,ZLNADF(X1)
			L1():!
				LI	X1,(X1)
				CAMN	X1,LABB(YDSCZS)
				BRANCH	LAB(DSTERM)
				LF	X1,ZLNBLK(X1)
				ADD	X1,LABB(YDSCZS)
			OD
				;Fetch prototype or subblock state
			IF	;Reduced subblock
				CAIE	X0,QRBLOCK
				GOTO	FALSE
			THEN
				LF	X1,ZLNADF(X1)
				HRL	XDZLN,X1	;Insert sublock level
				L	X1,LABB(YDSSBA)
				LF	 X1,ZBIZPR(X1)	;Fetch prototype
			ELSE
			IF	;INSPECT block
				CAIE	X0,QINSPEC
				GOTO	FALSE
			THEN
				HRRE	XDSTA,(X1)		;Fetch display level
				ADD	XDSTA,LABB(YDSSBA)
				L	XDSTA,(XDSTA)
				ST	XDSTA,LABB(YDSSBA)
				SOJ	X1,
			FI

			LF	X1,ZLNADF(X1)		;Fetch prototype
			IF	;Unreduced subblock
				CAIE	X0,QUBLOCK
				GOTO	FALSE
			THEN
				LFE	XDSTA,ZPREBL(X1)
				ADD	XDSTA,LABB(YDSSBA)
				L	XDSTA,(XDSTA)
				ST	XDSTA,LABB(YDSSBA)
			FI
			FI
		FI
	L4():!					;[154]
		Li	X0,LAB(DSVA01)
		DEXEC	DSSSP
		DUNSTK	XDSTA

		SETOFA	YDSOSB
	DSPVS1:	IFONA	YDSCSTOP
		SETONA	YDSTOP		;Control stop if breakpoint processing
		DRETUR
	FI
	AOS	,(XDSTK)
	DRETUR
			;Skip return normal case with no action

L3():!				;[154] Find  prototype and level from current block
				;[154] when no line number table exists

	L	X1,LABB(YDSSBA)		;[154]
	LF	X0,ZBIBNM(X1)		;[154]
	LF	X1,ZBIZPR(X1)		;[154]
	HRL	XDZLN,X0		;[154]
	GOTO	LAB(L4())		;[154]

	EPROC
	SUBTTL	DSFA, SIMDDT subroutines
	Comment/
	Purpose:
		Put class,procedure or block identification
		in outtext
		Find reactivation address in ZDRARE and
		call DSPL to locate line and put line
		identification in output buffer
	Entry:	DSFA

	Input argument:	 XDSTA block instance address

	Normal exit:	DRETUR

	Error exit:	-

	Output argument:-

	Used subroutines:DSPSP,DSPLO,DSOC,DSPM and DSPL

	/

DSFA:	PROC

	DSTACK	XDSTA
	SETOFA	YDSACB
	LF	XDZPR,ZBIZPR(XDSTA)
	MDSPSP				;Put name or block type
	OUTCHB		;Output octal address of block instance
	DEXEC	DSPLO
	OUTCHB
	OUTCHB

	;[2]
	LF	X0,ZDNTYP(XDSTA)
	CAIE	X0,QZBI		;Subblocks and
	CAIN	X0,QZPB		;prefixed blocks have
	GOTO	LAB(L1())	;no valid return address
	IF	;Terminated block
		IFOFF	ZDNTER(XDSTA)
		GOTO	FALSE
	THEN
		MDSPM	QMFAAT		;Terminated class
	ELSE
		SETONA	YDSACB		;Assume active block
		IF	;Detached
			IFOFF	ZDNDET(XDSTA)
			GOTO	FALSE
		THEN
			SETOFA	YDSACB
			MDSPM	QMFADE		;DETACHED CLASS
		FI

		LF	XDSTA,ZDRARE(XDSTA)
		MDSPL				;Put line ident.
	FI


L1():!	;[2]
	DUNSTK	XDSTA
	DRETUR
	EPROC

	SUBTTL	DSVIV, SIMDDT subroutines

	Comment/
	Purpose:	Check if variable value is initial value

	Entry:	DSVIV

	Input arguments:
			XDADR	address of variable
			XDTYP	variable type

	Normal exit:	DRETURN if initial value

	Error exit:	Skip DRETURN

	Output arguments:-

	Used subroutines:-
	/

DSVIV:	PROC

	IF	;LONG REAL
		CAIE	XDTYP,QLREAL
		GOTO	FALSE
	THEN	;Check second word first, fall into false branch if zero
		SKIPN	1(XDADR)
		GOTO	FALSE
	ELSE
		IF	;[1] Not REF
			CAIN	XDTYP,QREF
			GOTO	FALSE
		THEN	;Initial value is zero
			SKIPN	(XDADR)
			GOTO	LAB(L1())
		ELSE	;Must clear left half for REF
			HRRZ	X0,(XDADR)	;[1]
			CAIE	X0,NONE
		FI
	FI
	AOS	(XDSTK)		;Skip return if not initial value

L1():!	DRETUR


	EPROC

	SUBTTL	DSVAR, SIMDDT subroutines
	Comment/
	Purpose:	Fetch subscript, dope vector and base address for
			array element

	Entry:	DSVAR

	Input argument:Array address in -3(XDSTK )

	Normal exit:	DRETUR

	Error exit:	-

	Output arguments:XDT5 last subscript
			XDT3	last dope vector
			XDT4	number of subscripts
			X0	-start address of zero element

	Used subroutines:-
	/

DSVAR:	PROC

	L	XDT3,-3(XDSTK)		;Fetch array address
	MOVN	X0,ZARBAO(XDT3)
	LF	XDT4,ZARSUB(XDT3)
	ADDI	XDT3,(XDT4)
	ADDI	XDT3,2(XDT4)
	L	XDT5,XDT3
	ADDI	XDT3,(XDT4)


	DRETUR

	EPROC
	SUBTTL	DSGS, SIMDDT subroutines
	Comment/
	Purpose:	Get next string character from input

	Entry:	DSGS

	Input arguments:Current input pointer

	Normal exits:	DRETUR if end of input
			Skip DRETUR if final " found
			Double skip DRETUR if normal character found

	Output argument:XDBYTE current character

	Used subroutines:DSSCI

	/

DSGS:	PROC

	LI	XDMN,QMGSSE
	MDSSCI		;Get next input byte
	IF	;Not end of input
		JUMPE	XDBYTE,FALSE
	THEN
		AOS	,(XDSTK)
		IF	;Text quote
			CAIE	XDBYTE,QTEXTQ
			GOTO	FALSE
		THEN	;Check next char also
			MDSSCI
			IF	;Not also a quote
				CAIN	XDBYTE,QTEXTQ
				GOTO	FALSE
			THEN	;We have the final quote
				LI	XDBYTE,QTEXTQ
				GOTO	LAB(L9())
			FI
		FI
		AOS	,(XDSTK)
	FI

L9():!	DRETUR

	EPROC
	SUBTTL	DSGL, SIMDDT subroutines
	Comment/
	Purpose:	Get statement identification <line> from input.
			Return address of corresponding line number table entry

	Entry:		DSGL

	Input arguments:
			Input pointer
			Current module in YDSZLN

	Normal exit:	Skip DRETUR if <line> ok
					[2] or call from DSDP and
					  <line> not located in ZLN table

	Error	exit:	DRETUR

	Output arguments:
			See DSLL subroutine
			YDSNDL	new line number
	Used subroutines:DSGI,DSSKB,DSEZLN,DSSCIR,DSLL,DSOEM

	/
DSGL:	PROC
	DSTACK	YDSZLN(XLOW)			;Current module
	n==1
	DEXEC	DSSKBN	;[242]

	IF	;Identifier follows
		DEXEC	DSGIS	;[242]
		GOTO	FALSE
	THEN	;Module name
		DEXEC	DSSKBN
		LI	XDMN,QMGLCM		;Colon missing
		IF	;[242] No colon found
			CAIN	XDBYTE,":"
			GOTO	FALSE
		THEN	;Check for end of line, ok if so
			DEXEC	DSSKBN
			LI	XDMN,QMGLCM	;Missing colon after module
			JUMPN	XDBYTE,LAB(L1())
		ELSE
			DEXEC	DSSKB
		FI	;[242]
		L	X1,YDSZLA(XLOW)
		IF	;Not "MAIN"
			CAMN	XDSYM1,1+LAB(ZKWMAIN)
			GOTO	FALSE		;MAIN FOUND
		THEN	;Probably external module
			LOOP	;Through main ZLN table
				DEXEC	DSEZLN
				LI	XDMN,QMGLEM
				IF	;[242] Not found
					JUMPN	X1,FALSE
				THEN	;Check against program name
					HRROI	X0,3
					GETTAB	X0,
					GOTO	LAB(L1())
					CAME	X0,XDSYM1
					GOTO	LAB(L1())	;No match
					L	X1,YDSZLA(XLOW)	;OK, use MAIN
					GOTO	LAB(L5())
				FI
			AS
				CAMN	XDSYM1,OFFSET(ZSMRN1)(XDT2)
				CAME	XDSYM2,1+OFFSET(ZSMRN1)(XDT2)
				GOTO	TRUE			;Try next
			SA
			;Valid external module name
		FI
L5():!		ST	X1,(XDSTK)
	FI
	DEXEC	DSSCIR				;Back up one input character
	IF	;[242] Called from DSDP
		HRRZ	X0,-n(XDSTK)
		CAIE	X0,LAB(DSDPGL)
		GOTO	FALSE
	THEN	;Allow extended line no format
		L	X0,1-n(XDSTK)		;Line no table address determined
		DEXEC	DSGLEL
		GOTO	LAB(L2())
		ST	XWAC1,LABB(YDSNDL)	;New display line
	ELSE	;Accept only an integer
		MTXGI
		GOTO	LAB(L2())		;Error already given
	FI
	L	XDLIN,XWAC1
	L	XDT2,(XDSTK)			;Fetch module entry in main ZLN
	IF	;External module
		CAMN	XDT2,YDSZLA(XLOW)
		GOTO	FALSE
		JUMPE	XDT2,FALSE		;[154]
	THEN
		LF	XDT2,ZLNADR(XDT2)
		LF	XDT2,ZPRSYM(XDT2)
		LF	XDT2,ZSMZLN(XDT2)
	ELSE	;[154] assume main prog
		L	XDT2,YDSZLA(XLOW)
	FI

	MDSLL
	GOTO	LAB(L3())	;Error found
L4():!	AOS	-n(XDSTK)	;Normal return
L2():!
	DUNSTK
	SKIPN	;[242]
	L	YDSZLA(XLOW)	;[242]
	DRETUR

L3():!	HRRZ	X0,-n(XDSTK)	;Fetch return address
	CAIN	X0,LAB(DSDPGL)	;[2]
	GOTO	LAB(L4())	;[2] Skip error message if called from DSDP
	LI	XDMN,QMGLIL	;Invalid line number
L1():!	MDSOEM
	GOTO	LAB(L2())

	EPROC
	SUBTTL	DSGLEL, SIMDDT internal subroutine	;[242]

Comment/
Purpose:	Interpret a line definition in one of the following forms:
		a) n
		b) n+k	(not implemented)

		n is normally a decimal number, but may be replaced by:
		. to denote the current display line + 1
		^ to denote the first line of the file
		* to denote the last line of the file
		n may be omitted to denote last displayed line + 1
		  (same as .)
		n+k designates the kth line following the line numbered n

Input:		YDSCDL	current display line
		YDSDZLN	current display file or zero
		X0	module name of new display file

Output:		Line number in XWAC1 ...
		No valid spec is interpreted as ".",
		 but YDSLDL is set to -1 to flag this.

Normal return:	Skip
Error return:	No skip

Uses:		DSTXG1
/

DSGLEL:	PROC
	DSTACK	X0
	n==1	;One stack item
	MDSSCI				;Next character
	IF	;A digit follows
		CAIL	XDBYTE,"0"
		CAILE	XDBYTE,"9"
		GOTO	FALSE
	THEN	;Get the value
		DEXEC	DSSCIR		;Back up to previous char
		DEXEC	DSTXGI
		GOTO	LAB(L9())	;Should not happen
		GOTO	LAB(L8())	;No error, we have an integer
	FI

	;There was no integer, check for other valid characters
	SETZ	XWAC1,
	CAIN	XDBYTE,"^"	;Treat "^" like zero
	GOTO	LAB(L8())
	IF	;"*"
		CAIE	XDBYTE,"*"
		GOTO	FALSE
	THEN	;Return maxint
		HRLOI	XWAC1,377777
		GOTO	LAB(L8())
	FI
	IF	;"."
		CAIE	XDBYTE,"."
		GOTO	FALSE
	THEN	;Current line + 1 if same module, otherwise 0
L7():!		L	(XDSTK)		;New module line no table
		IF	;Same as any current display module line no table
			CAME	LABB(YDSCDZLN)
			GOTO	FALSE
		THEN	;Take current line + 1
			L	XWAC1,LABB(YDSCDL)
			ADDI	XWAC1,1
		FI
		GOTO	LAB(L8())
	FI
	;None of the valid characters, return current line no
	SETOM	LABB(YDSLDL)	;Flag "no line no"
	DEXEC	DSSCIR		;Back up one char
	GOTO	LAB(L7())	;Join code for "."
L8():!	AOS	-n(XDSTK)
L9():!	DUNSTK
	DRETURN
	EPROC
	SUBTTL	DSGV, SIMDDT subroutines
	Comment/
	Purpose:	Get <value> from input text
			and save information in ZBE entries

	Entry:		DSGV

	Input arguments:
			XDZBE	first free ZBE entry
			XDZLN	current block stack entry in ZLN
			XDTYP	type of value which must match new value

	Normal exit:	Double skip DRETUR if identifier value

			Skip DRETUR if constant value found

	Error exit:	DRETUR

	Output arguments:
			XDZLN and XDZBE unchanged
			XDTYP	type of constant or identification found
			YDST1	constant value if any

	Used subroutines:DSGI,DSFKI,DSNIS,DSSCIR,DSGS,DSRAT,TXCY,DSTXG,
			 DSSKB,DSFBN,DSGVTP,DSOEM

	/
DSGV:	PROC
	;Input
	;	XDZBE
	;	XDZLN
	;	XDTYP

	;Saving of accumulators is dependent on DSNI coding!
	DSTACK	XDTYP
	DSTACK	XDZBE
	DSTACK	XDZLN
	IF	;Identifier found
		MDSGI
		GOTO	FALSE
	THEN
		IF	;Not a keyword or not a constant
			MDSFKI
			JUMPE	XDZKW,TRUE		;No match
			IFEQF	(XDZKW,ZKWTYP,QZKWTQ)
			GOTO	FALSE			;Constant
		THEN	;Normal identification must follow
			;Call DSNI
			L	XDZBE,-1(XDSTK)
			LI	X0,LAB(DSGVR)
			EXCH	X0,-2(XDSTK)	;Store return address
			ST	X0,LABB(YDSTYP)
			BRANCH	LAB(DSNIS)	;Special entry
		DSGVR:	;Return from DSNI
			DRETUR			;Error found, return

			L	XDZBE,X0	;Identifier XDZBE
			L	XDTYP,LABB(YDSTYP)
			;Restore stack
			DSTACK	XDTYP
			DSTACK	XDZBE
			DSTACK	XDZLN
			DEXEC	DSGVTP			;Check type

			AOS	,-3(XDSTK)
			BRANCH	LAB(L4())		;Exit correct
		FI					;identification found
		;Constant found
		DEXEC	DSSCIR			;Back one char.

L7():!				;"" Found
		SETZ	X1,
		LF	X0,ZKWVAL(XDZKW)
		CAIN	X0,1
		SETO	X0,	;TRUE found
		LF	XDTYP,ZKWCOD(XDZKW)
		L	XDZBE,-1(XDSTK)
		GOTO	LAB(L3())
	FI
	;No start of identifier
	LDB	XDBYTE,LABB(YDSIPO)
	JUMPE	XDBYTE,LAB(L5())

	IF	;Character constant
		CAIE	XDBYTE,"'"
		GOTO	FALSE
	THEN
		MDSSCI			;Character
		L	X1,XDBYTE	;Save
		MDSSCI			;Should be closing '
		LI	XDMN,QMGVCE
		CAIE	XDBYTE,"'"
		GOTO	LAB(L2())	;Error final ' missing
		LI	XDTYP,QCHARACTER
		L	X0,X1		;RESTORE VALUE
		GOTO	LAB(L3())
	FI

	IF	;Text string
		CAIE	XDBYTE,QTEXTQ
		GOTO	FALSE
	THEN
		SETZ	X1,
		;Initiate extra  input buffer
		L	X0,LAB(<[POINT	7,ZTE%S-1+2*<QDSION+5>/5+LABB(ZDSZTE),34]>)
		ST	X0,LABB(YDSIPE)
		ZF	ZTVCP(XDINT,<ZTV%S+ZTV%S>)

		LOOP	;Get string contents
			MDSGS
		AS
			GOTO	LAB(L2())		;Error exit
			GOTO	FALSE			;End of text input
			IDPB	XDBYTE,LABB(YDSIPE)	;New character
			AOJA	X1,TRUE
		SA

		IF	;NOTEXT
			JUMPN	X1,FALSE
		THEN	LI	XDZKW,LAB(ZKWNOT)
			GOTO	LAB(L7())
		FI
		;Correct string found
		SF	X1,ZTVLNG(XDINT,<2*ZTV%S>)
		DMOVE	X0,2*ZTV%S(XDINT)

		IF	;AT command
			HRRZ	XDT2,-3(XDSTK)
			CAIE	XDT2,LAB(DSAT02)
			GOTO	FALSE
		THEN
			DEXEC	DSCHGC		;[41]
			GOTO	LAB(L1())	;[41] Not allowed if GC inhibited
			;String must be copied and saved
			DEXEC	DSRAT			;Reserve array element
			JUMPE	X1,LAB(L2())
			ST	X1,LABB(YDST1)		;Save

			DUNSTK	XDZLN			;Not to be relocated
			LD	XWAC1,2*ZTV%S(XDINT)
			MTXCY				;Copy string
			DSTACK	XDZLN
			L	X2,YDSTXT(XLOW)
			LF	X2,ZARBAD(X2)
			ADD	X2,LABB(YDST1)
			ADD	X2,LABB(YDST1)		;2 Words per element
			SUBI	X2,2
			STD	XWAC1,(X2)		;Save string copy
							; reference in array
			L	X0,LABB(YDST1)
		FI

		LI	XDTYP,QTEXT
		GOTO	LAB(L3())
	FI
	;Integer or real constant
	L	XDTYP,-2(XDSTK)
	SETOFA	YDSTXR	;Assume integer
	IF	;Not integer
		CAIN	XDTYP,QINTEGER
		GOTO	FALSE
	THEN	;Must be (long) real
		IF	;Not (long) real
			CAIE	XDTYP,QLREAL
			CAIN	XDTYP,QREAL
			GOTO	FALSE
		THEN	;Error
			GOTO	LAB(L5())
		FI
		SETONA	YDSTXR
	FI
	;Call TXGI or TXGR
	DEXEC	DSSCIR			;Back one char.
	DEXEC	DSTXG
	GOTO	LAB(L1())		;Error
	L	XDTYP,-2(XDSTK)
	DMOVE	X0,XWAC1		;Fetch value
L3():!	;Return constant

	DMOVEM	X0,LABB(YDST1)
	DEXEC	DSSKB
	SETON	ZBETCI(XDZBE)

	MDSFBW
	GOTO	LAB(L1())
	L	X0,LABB(YDST1)
	SF	X0,ZBEVAL(XDZBE)	;Save value

	IF
		CAIE	XDTYP,QLREAL
		GOTO	FALSE
	THEN
		MDSFBW
		GOTO	LAB(L1())
		L	X1,1+LABB(YDST1)
		SF	X1,ZBEVAL(XDZBE)
	FI


	DEXEC	DSGVTP
L4():!
	AOS	,-3(XDSTK)
L1():!	;Exit
	DUNSTK	XDZLN
	DUNSTK	XDZBE
	DUNSTK
	DRETUR

L5():!	LI	XDMN,QMGVEL		;CONSTANT OR VALUE EXPECTED

L2():!	;Create message
	MDSOEM
	GOTO	LAB(L1())

DSGVTP:	;Internal subroutine
	;XDTYP and YDSSTP
	IF
		CAMN	XDTYP,LABB(YDSSTP)
		GOTO	FALSE
	THEN
		LI	X1,LAB(L2())	;Address of error exit
		LI	XDMN,QMGVTD	;Possible type error
		CAIE	XDTYP,QREAL
		CAIN	XDTYP,QLREAL
		SKIPA
		ST	X1,(XDSTK)	;Change return address on error
		L	X0,LABB(YDSSTP)
		CAIE	X0,QREAL
		CAIN	X0,QLREAL
		SKIPA
		ST	X1,(XDSTK)
	FI

	DRETUR

	EPROC
	SUBTTL	DSRL, SIMDDT subroutine
	PROC

	Comment/
	Purpose:	Remove breakpoint commands

	Entries:	DSRLB	removes all information from one breakpoint command
			DSRLBA	same as DSRLB but error has occurred
				while scanning command
			DSRLBI	removes a breakpoint instruction from user code
				Does not remove ZBE entries
			DSRL	removes information from all breakpoint commands
				that refer to the same breakpoint line

	Input arguments:
			XDZBE	start of breakpoint ZBE entry
				for DSRLB and DSRLBA calls
				Start of ZBR entry for DSRL call
			X1	ZBR entry if DSRLBI call
			-1(XDSTK) ZBR entry for breakpoint on DSRLB and DSRLBA calls

	Normal exit:	DRETUR

	Error exit:	-

	Output arguments:-

	Used subroutines:
			DSNB,DSPI,DSONL,DSFAT,DSFAR
	/
DSRLB:	;Reset for one breakpoint only
	;Release breakpoint instruction if no more commands left

	;-1(XDSTK)contains ZBR entry
	;XDZBE contains start of breakpoint

	DSTACK XDZBE

	LF	XDT2,ZBETYP(XDZBE)

	IFON	ZBESTB(XDZBE)
	MDSNBW
	IF	;AT ... <relation> or AT ... IFCHANGED command
		CAIN	XDT2,QBEATR
		GOTO	TRUE
		CAIE	XDT2,QBEATC
		GOTO	FALSE
	THEN
		LOOP
			MDSNBW
			MDSPI

			L	XDZBE,X0		;Last referenced ZBE entry
			LI	XDT3,QREF	;Assume THIS
			IF	;[41] THIS
				IFON	ZBETHI(X1)
				GOTO	FALSE
			THEN
				LF	X1,ZBEZSD(X1)	;Last referenced identifier
				LF	XDT3,ZSDTYP(X1)
			FI				;[41] End

			DEXEC	DSONL			;Remove identification
			MDSNBW

			IF	;AT nnn <relation>
				CAIE	XDT2,QBEATR
				GOTO	FALSE
			THEN
				IFOFF	ZBETCI(XDZBE)
				SETZ	XDT3,			;No interesting ZBE
				CAIN	XDT3,QREF
				SETZ	XDT3,
				MDSNBW				;Skip operator entry
			FI

			L	X1,(XDZBE)		;Element number
			CAIN	XDT3,QLREAL
			MDSNBW
			CAIN	XDT3,QREF
			DEXEC	DSFAR			;Release element
			IF
				CAIE	XDT3,QTEXT
				GOTO	FALSE
				DEXEC	DSFAT
				CAIE	XDT2,QBEATC
				GOTO	FALSE
			THEN
				MDSNBW
				L	X1,(XDZBE)
				DEXEC	DSFAT

			FI
		AS
			IFONA	YDSLIST
			GOTO	TRUE			;Check next identification
		SA
	FI
	;QBEAT and QBEATL no special processing
	DUNSTK	XDZBE
DSRLBA:	;Reset from DSAT if error occurred
	;Array elements for text and ref released already
	DSTACK	XDZBE
IF	JUMPE	XDZBE,FALSE
THEN

	LOOP	;Find all continuation entries

		LF	XDT2,ZBEZBE(XDZBE)
	AS
		JUMPE	XDT2,FALSE		;No more continuation entries
		ADDI	XDT2,(XDZBR)
		LF	X1,ZBETYP(XDT2)
		CAIE	X1,QBECON
		GOTO	FALSE
		L	XDZBE,XDT2
		HRLI	XDZBE,-QZBEL		;Build ZBE pointer
		GOTO	TRUE
	SA

	SETZM	,(XDZBE)			;Indicate end of chain

	;XDT2 is 0 or points at new command ZBE entry after the one to be released

	;Complete chain again
	L	XDZBE,-2(XDSTK)			;Fetch ZBR entry

	LOOP
		L	X1,XDZBE
		MDSNB				;Next ZBE

	AS
		CAME	XDZBE,0(XDSTK)
		GOTO	TRUE
	SA

	;X1 points at ZBR entry or last ZBE before
	;the one to be released
	SKIPE	,XDT2
	SUBI	XDT2,(XDZBR)			;Calculate link
	SF	XDT2,ZBEZBE(X1)
FI
	IF	;All commands for the line are not reset
		L	X1,-2(XDSTK)		;Fetch ZBR pointer
		LF	X0,ZBRZBE(X1)
		JUMPN	X0,FALSE		;More break commands left
	THEN
		DEXEC	DSRLBI			;Remove breakpoint

	FI

IF
	JUMPE	XDZBE,FALSE
	;XDZBE contains start of breakpoint command
	;to be reset

THEN
	MDSRB
FI

	DUNSTK
	DRETUR

	EPROC

	PROC
DSRLBI:	;Remove breakpoint instruction if any
	;X1 points at ZBR entry

	IF
		LF	XDT2,ZBRZLN(X1)
		JUMPE	XDT2,FALSE
	THEN
		LF	XDT2,ZLNADR(XDT2)	;Fetch instruction address
		HLRZ	X0,(XDT2)
		IF	;There is a breakpoint instr in the code
			CAIE	X0,(BREAK)
			GOTO	FALSE
		THEN	;Restore original instr
			LF	X0,ZBRINS(X1)
			ST	X0,(XDT2)
	FI	FI
	SETZM	(X1)				;Clear breakpoint entry
	DRETUR
	EPROC
	PROC

DSRL:	;Remove all commands for one breakpoint line
	;XDZBE	points at ZBR entry

	DSTACK	XDZBE

	WHILE
		L	XDZBE,(XDSTK)
		DEXEC	DSNBC
		JUMPE	XDZBE,FALSE		;All commands treated
	DO
		MDSRLB
	OD

	DUNSTK	XDZBE

	DRETUR
	EPROC
	SUBTTL	DSPB, SIMDDT subroutine
	Comment/
	Purpose:	Reconstruct breakpoint command in output buffer

	Entries:	DSPBS	reconstruct upto first identifier
			DSPBT	reconstruct complete command

	Input arguments:XDZBE	 start of command ZBE entry
			-2(XDSTK) ZBR entry for command

	Normal exit:	DRETUR

	Error exit:	-

	Output arguments:
			X0	XDZBE given in call
			XDZBE	last referenced ZBE entry

	Used subroutines:
			DSPSKB,DSPL,DSOC,DSNBW,TXPI,DSPSC,DSFCV,DSPVNS

	/

	PROC

	IF

	THEN
DSPBS:
DSPB:
		SETOFA	YDSPBT

	ELSE
DSPBTS:
DSPBT:
		SETONA	YDSPBT

	FI

	DSTACK	XDZBE
	;Put stop in text
	LI	X1,LAB(ZKWSTOP)
	IFON	ZBESTO(XDZBE)
	DEXEC	DSPSKB
	;Put AT in text
	LI	X1,LAB(ZKWAT)
	DEXEC	DSPSKB

	LF	XDT2,ZBETYP(XDZBE)
	L	X1,-2(XDSTK)		;Fetch ZBR addresss
	ST	XDT2,LABB(YDSTIP)	;Save command type
	LF	XDZLN,ZBRZLN(X1)
	LF	XDSTA,ZLNADR(XDZLN)
	DEXEC	DSPL			;Put line identification in text
	DEXEC	DSOCB

	L	XDZBE,(XDSTK)

	IF
		IFOFF	ZBESTB(XDZBE)
		GOTO	FALSE
	THEN
		L	X1,LAB(<[POINT 7,(XDZBE),34]>)
		LI	X0,QTEXTQ
		OUTCHA

		WHILE
			ILDB	XDBYTE,X1
			TRNE	X1,2
			GOTO	FALSE		;All 5 characters moved
		DO

			OUTCHA
		OD

		LI	X0,QTEXTQ
		OUTCHA
		OUTCHB
		MDSNBW
	FI

	MDSNBW
	IF
		L	XDT2,LABB(YDSTIP)	;Fetch type
		CAIE	XDT2,QBEAT
		GOTO	FALSE
	THEN
		;Simple AT

		L	XDZBE,(XDSTK)
		LF	XWAC3,ZBENIN(XDZBE,2)
		CAIN	XWAC3,1
		GOTO	LAB(L1())		;Exit if default 1
		LI	X0,","
		OUTCHA
		MTXPI				;Output counter
		GOTO	LAB(L1())
	FI
	SETOFA	YDSCHG
	L	XDT2,LABB(YDSTIP)
	CAIN	XDT2,QBEATC
	SETONA	YDSCHG


	IFOFFA	YDSPBT
	GOTO	LAB(L1())			;Exit if not total
	LI	X1,LAB(ZKWIF)
	CAIN	XDT2,QBEATR
	DEXEC	DSPSKB
	LI	X1,LAB(ZKWIFC)
	IFONA	YDSCHG
	DEXEC	DSPSKB
	;Output identification

	LOOP
		MDSPI
		L	XDZBE,X0		;Last referenced ZBE entry
		LI	XDT3,QREF		;Assume THIS
		IF	;[41] THIS
			IFON	ZBETHI(X1)
			GOTO	FALSE
		THEN
			LF	X1,ZBEZSD(X1)	;Last referenced identifier entry
			LF	XDT3,ZSDTYP(X1)	;Fetch variable type
		FI				;[41] End
	AS
		IFOFFA	YDSLIST
		GOTO	FALSE
		LI	X0,","
		OUTCHA

		;Skip ZBE value entries if changed
		IF
			IFOFFA	YDSCHG
			GOTO	FALSE
		THEN
			MDSNBW
			CAIE	XDT3,QTEXT
			CAIN	XDT3,QLREAL
			MDSNBW
		FI

		MDSNBW
		GOTO	TRUE
	SA

	L	XDT2,LABB(YDSTIP)
	CAIE	XDT2,QBEATR
	GOTO	LAB(L1())		;Exit if not relational
	OUTCHB
	MDSNBW
	LF	X1,ZBEROP(XDZBE)
	ADDI	X1,(XDBAS)		;[102] Use relative address in ZBE
	DEXEC	DSPSKB			;Put relational operator

	LF	XDT2,ZKWCOD(X1)
	WLF	X1,ZBEROP(XDZBE)
	MDSNBW
	IF	;IS or IN class identifier follows
		CAIE	XDT2,QOOP
		GOTO	FALSE
	THEN
		L	XDT4,(XDZBE)
		MDSNBW
		L	XDT5,(XDZBE)	;Fetch class identifier
		LI	X1,XDT4-1
		DEXEC	DSPSC

	ELSE
	IF
		IFOFFA	ZBETCI(X1)
		GOTO	FALSE
	THEN	;Value follows
		L	XDTYP,XDT3
		DEXEC	DSFCV
		L	XDADR,XDARR
		SETOFA	YDSSTRING

		DEXEC	DSPVNS		;Put value in outtext
	ELSE	;Identification follows
		MDSPI
	FI	FI

L1():!	;EXIT

	DUNSTK
	DRETUR

	EPROC
	SUBTTL	DSLB, SIMDDT subroutine

	PROC
	Comment/
	Purpose:	Scan the ZBR records and match the entries
			against an input statement identification

	Entry:		DSLB


	Input argument:XDZLN	ZLN table entry

	Normal exit:	Skip DRETUR if match found

	Error	exit:	DRETUR if no match

	Output arguments:
			XDZBE	matching ZBR entry
			X1	last free ZBR entry if no match
				0 if no free ZBR entries

	Used subroutines:-
	/
DSLB:	;Locate breakpoint
	SETZ	X1,
	LI	XDT2,QBRN
	LI	XDZBE,LABB(DSZBRF)

	LOOP
		IF	;Unused
			LF	X0,ZBRZBE(XDZBE)
			JUMPN	X0,FALSE
		THEN
			L	X1,XDZBE	;Save unused entry
		ELSE
			IF	;This is it
				LF	X0,ZBRZLN(XDZBE)
				CAME	XDZLN,X0
				GOTO	FALSE
			THEN
				AOS,(XDSTK)
				DRETUR		;Skip return if entry found
			FI
		FI
	AS
		ADDI	XDZBE,2
		DECR	XDT2,TRUE
	SA

	DRETUR			;Not found exit
	EPROC
	SUBTTL	DSRAT, DSRAF, DSFAT and DSFAR, SIMDDT subroutines
	Comment/
	Purpose:	Reserve or release elements in YDSREF or YDSTXT

	Entries:	DSRAF	reserve any free element in array YDSREF
			DSRAT	reserve any free element in array YDSTXT
			DSFAR	release element in YDSREF array
			DSFAT	release element in YDSTXT array

	Input arguments:
			X1	contains element to be released if DSFAR or DSFAT

	Normal exit:	DRETUR

	Error	exit	-

	Output arguments:
			X1	element number if DSRAF or DSRAT entries
				0 if none available

	Used subroutines:DSBPRA,DSBPTA
	/
	PROC
DSRAF:	;Reserve any free ref array element
	MOVNI	X1,QDSRN
	LI	X3,LABB(YDSRRA)
	LI	XDARR,LAB(DSBPRA)	;Address of get address of element
					;routine
					;Used to initialize element
	GOTO	LAB(DSRAC)

DSRAT:	;Reserve any free text array element
	MOVNI	X1,QDSTN
	LI	X3,LABB(YDSTRA)
	LI	XDARR,LAB(DSBPTA)	;See above

DSRAC:	;Common part
	LI	X0,1
	ROT	X0,(X1)
	MOVN	X1,X1

	WHILE
		JUMPE	X0,LAB(L1())
		TDNN	X0,(X3)
		GOTO	FALSE		;Free element found
	DO
		SOJ	X1,
		LSH	X0,1
	OD

	IORM	X0,(X3)			;Reserve element
	SKIPA
L1():!
	LI	XDMN,QMRANE
					;X1=0 if no free found
					;Otherwise X1 is element number
	DRETUR

	EPROC
	PROC
DSFAR:	;Free ref array element
	LI	XDT3,LABB(YDSRRA)
	SKIPA
DSFAT:	;Free text array element
	LI	XDT3,LABB(YDSTRA)

	;Common part, X1 contains array element number

	IF
		JUMPE	X1,FALSE
	THEN
		LI	X0,1
		MOVN	X1,X1
		ROT	X0,(X1)
		IORM	X0,(X3)
		XORM	X0,(X3)
	FI

	DRETUR

	EPROC
	SUBTTL	DSFCV, SIMDDT subroutine
	PROC
	Comment/
	Purpose:	Load address of constant to accumulator

	Entry:		DSFCV

	Input argument:	XDZBE	ZBE entry to constant value
			XDTYP	type of constant

	Normal exit:	DRETUR

	Error	exit:	-

	Output arguments:XDARR address of constant value

	Used subroutines:DSNBW,DSBPTAE
	/
DSFCV:

	;Find address of constant
	;XDARR contains address of constant value at exit

	L	XDARR,XDZBE

	IF
		CAIE	XDTYP,QLREAL
		GOTO	FALSE
	THEN
		;Handle real
		L	X0,(XDARR)
		MDSNBW
		L	X1,(XDZBE)
		STD	X0,LABB(YDST1)
		LI	XDARR,LABB(YDST1)
	FI
	CAIN	XDTYP,QTEXT
	DEXEC	DSBPTAE

	DRETUR

	EPROC