COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

AUTHOR:		CLAES WIHLBORG
UPDATE:		6
PURPOSE:	MISC. SUBROUTINES USED BY SR
CONTENT:
		SMERR
		SMLINE
		SMLIND
		SMUID

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


	SALL
	SEARCH	SIMMC1,SIMMAC
	CTITLE	SM
	SUBTTL	PROLOGUE

	INTERN	SMERR,SMLINE,SMLIND,SMUID

	EXTERN	O1IC1,T1AB
	EXTERN	YELIN1,YELIN2,YESEM
	EXTERN	YSMLIN,YSMSEM

	MACINIT
	TWOSEG
	RELOC	400000
	SUBTTL	SMERR

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	SMERR IS CALLED WHENEVER SR HAS FOUND AN ERROR.
		IT CREATES AN ERROR MESSAGE AND TAKE SOME OTHER
		ACTIONS IMPLIED BY THE ERROR.


ENTRY CONDITIONS: THE CALLING ARGUMENT HAS THE FORMAT:

			BIT 0-17	SYMBOL TO BE EDITED INTO MESSAGE
			BIT 18-26	SWITCHES
			BIT 27-35	ERROR NUMBER


EXIT CONDITIONS:  IF TERMINATION ERROR BRANCH TO T1AB.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;DEFINE SWITCHES IN ARGUMENT

DEFINE	X(A)<
	DEFINE	Y(B,C)<RADIX 8
		DSW(Z1SE'B,0,C,SLASK)>
	IRPC A,<RADIX 10
		Y(A,\QSRE'A)>
>
	X	GEPCASTW

DEFINE	ERRM(N)<
	IFB<N>,<ADD XUUO,[ERR]>
	IFNB<N>,<ADD XUUO,[ERRI'N]>
	XCT	XUUO
>


	D1=1
	D2=2
	ENR=12
	SLASK=5
	XUUO=10



SMERR:
IFG QDEBUG,< PROC	<TXT,ARG>>
IFE QDEBUG,< PROC	ARG>
	SAVE	<D1,D2,ENR,SLASK,XUUO>

	L	ENR,ARG
	L	SLASK,ENR
	ANDI	ENR,777

;OUTPUT SYMBOLS TO IC1

	IF	IFOFFA	Z1SEP
		GOTO	FALSE
	THEN
		LI	X1SR0,%PURGE
		PUTIC1	X1SR0
	FI
	IF	IFOFFA	Z1SEE
		GOTO	FALSE
	THEN
		LI	X1SR0,%ERROR
		PUTIC1	X1SR0
	FI

;CREATE ERROR MESSAGE

;IFN QDEBUG,<OUTSTR @TXT
;	OUTSTR	[ASCIZ/
;/]>

IFN QERIMP,<
	L	XUUO,[Z QE,0(ENR)]
	IFONA	Z1SET
	L	XUUO,[Z QT,0(ENR)]
	IFONA	Z1SEW
	L	XUUO,[Z QW,0(ENR)]
	L	YSMLIN
	ST	YELIN1
	L	YSMSEM
	ST	YESEM
	SETZM	YELIN2

	IF	IFOFFA	Z1SEC
		GOTO	FALSE
	THEN
		L	D1,X1CUR
		IF	IFOFFA	Z1SEA
			GOTO	FALSE
		THEN
			HLRZ	D2,SLASK
			ERRM(2)
		ELSE
			ERRM(1)
		FI
	ELSE
		IF	IFOFFA	Z1SEA
			GOTO	FALSE
		THEN
			HLRZ	D1,SLASK
			ERRM(1)
		ELSE
			ERRM
		FI
	FI
>

	IFONA	Z1SET
	BRANCH	T1AB	;IF TERMINATION ERROR

	IFONA	Z1SEG
	SETONA	YERNC	;IF NO CODE GENERATION

	IFONA	Z1SES
	SETONA	YERNP2	;IF NO PASS 2 PROCESSING

	RETURN
	EPROC
	SUBTTL	SMLINE

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	PERFORM ACTIONS IMPLIED BY THE START OF A STATEMENT

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


SMLINE:	PROC

;OUTPUT LINE SYMBOL TO IC1

	LF	X1SR0,YLSCLIN
	ST	X1SR0,YSMLIN
	TRO	X1SR0,400K	;SET FLG LINE SYMBOL
	PUTIC1	X1SR0
	LF	X1SR0,YLSCSEM
	ST	X1SR0,YSMSEM
	PUTIC1	X1SR0
	LF	X1SR0,YLSLLIN
	PUTIC1	X1SR0

;FILL END-LINE OF GENERATED ERROR MESSAGES

IFG QERIMP,<
	EXTERN	YECHDM
	SKIPGE	YECHDM
	RETURN
	ST	X1SR0,YELIN2
	ERRLI
>

	RETURN
	EPROC
	SUBTTL	SMLIND

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	PERFORM ACTIONS IMPLIED BY THE START OF A DECLARATION

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


SMLIND:	PROC

;OUTPUT LINE SYMBOL TO IC1

	LF	X1SR0,YLSCLIN
	ST	X1SR0,YSMLIN
	TRO	X1SR0,400K	;SET FLG LINE SYMBOL
	PUTIC1	X1SR0
	LF	X1SR0,YLSCSEM
	ST	X1SR0,YSMSEM
	TRO	X1SR0,400K	;SET FLG DECLARATION
	PUTIC1	X1SR0
	LF	X1SR0,YLSLLIN
	PUTIC1	X1SR0

;FILL END-LINE OF GENERATED ERROR MESSAGES

IFG QERIMP,<
	EXTERN	YECHDM
	SKIPGE	YECHDM
	RETURN
	ST	X1SR0,YELIN2
	ERRLI
>

	RETURN
	EPROC
	SUBTTL	SMUID

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	PERFORM ACTIONS IMPLIED BY A USED IDENTIFIER

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

	EXTERN	O1XR,LS

SMUID:	PROC

;OUTPUT IDENTIFIER TO IC1

	PUTIC1	X1CUR

;OUTPUT IDENTIFIER TO XRF

	IFONA	YSWC
	EXEC	O1XR

;SCAN NEXT SYMBOL

	GOTO	LS	;NOT PROGRAMMING STANDARD BUT SAVES INSTRUCTIONS
	EPROC
	LIT
	END