Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

	SALL



;AUTHOR:		 ELIASBETH $LUND
;SUBROUTINES:		 ORCN
			; ORCA HAS BEEN REMOVED


	SEARCH SIMMAC,SIMMC2
	CTITLE OREA
	TWOSEG
	RELOC	400K
	MACINIT


	EXTERN YSTEPP, YEXPP, YFOP, YOPSTP, YCALID, YORLID
	INTERN ORCN


	SUBTTL	ORCN


;PURPOSE:		 CONVERT AN OPERAND TO SPECIFIED TYPE QUALIFICATION
;ENTRY:			 ORCN
;INPUT ARGUMENTS:	 REG X0 CONTAINING TYPE CODE,
;			 REG XL1 OPERAND NODE ADDR
;			XREG X1 ZQUPOINTER OF QUALIFICATION OR ZERO
;NORMAL EXIT:		 RETURN
;ERROR EXIT
;OUTPUT ARGUMENT:	 NODE IN EXPRESSION TREE
;CALL FORMAT:		 EXEC ORCN




ORCN:	PROC

	ASSERT	<IFN	QKA10,<CFAIL KI10 DEPENDENT CODE>>
	SAVE	<X2,X3,X4,X5>
	LF	(X2) ZNSTYP(XL1)
	L X5,X0					;CERTAIN MACROS DESTROY REG X0
IF	CAME	X2,X5			;JUMP IF TYPES UNEQUAL
	GOTO	FALSE
	CAIE	X2,QREF
	GOTO	ORCN1			;RETURN IF NOT REF
	LF	(X2) ZNSZQU(XL1)
	CAMN	X1,X2
	GOTO	ORCN1			;RETURN IF SAME QUALIFICATION
	JUMPE	X1,ORCN1	; RESUME, CALL OR INCORRECT PARAMETER
	WHEN	XL1,ZCN
	GOTO	ORCN1		;RETURN IF NONE
	JUMPE	X2,ORCN1
	LF	,ZQULID(X1)
	ST	YCALID
	LF	,ZQULID(X2)
	ST	YORLID
	LF	X1,ZQUZB(X1)
	LF	X1,ZHBZQU(X1)
	LF	(X3) ZQUZB(X2)
	LF	X2,ZHBZQU(X3)
	CAMN	X1,X2
	GOTO	ORCN1
WHILE	LF	(X3) ZHBZHB(X3)			;CHECK IF X2 SUBCLASS TO X1
	JUMPE	X3,FALSE
DO	LF	(X4) ZHBZQU(X3)
	CAMN	X4,X1
	GOTO	ORCN1
OD
THEN
	LF	(X3) ZQUZB(X1)
WHILE	LF	(X3) ZHBZHB(X3)			;CHECK IF X1 SUBCLAS TO X2
	JUMPN	X3,TRUE
ORCNE:	IF
		CAIE	XCUR,%RP
		GOTO	FALSE
	THEN
		LF	X1,ZQULID(XP1)
		LF	X2,ZIDZQU(XP2)
		LF	X2,ZQULID(X2)
		ERRI2	QE,<Q2.ERR+^D42>
		ASSERT<	JFCL	[ASCIZ/INCOMPATIBLE QUAL. OF PARAMETERS/]
		>
	ELSE
		L	X1,YCALID
		L	X2,YORLID
		L	X3,XCUR
		ERRI3	QE,<Q2.ERR+^D27>
		ASSERT<	JFCL	[ASCIZ/INCOMPATIBLE QUALIFICATIONS/]
		>
	FI
	GOTO	ORCN1
DO	LF	(X4) ZHBZQU(X3)
	CAME	X4,X2
OD	EXEC	ORCNNT			;MOVE NODE INTO EXPRESSION TREE
	SF	(X1) ZNSZQU(XL1)
	SETF (%QUAL) ZNSGEN(XL1)
ELSE
 IF
	CAIE	X5,QUNDEF
	CAIN	X2,QUNDEF
	GOTO	ORCN1
	CAILE	X2,QLREAL			;CHECK FOR VALIDITY OF TYPES
	GOTO	TRUE
	CAIG	X5,QLREAL
	GOTO	FALSE
 THEN	ERROR1 	23,XCUR,INCOMPATIBLE TYPES
	GOTO	ORCN1
 FI
 IF
	IFEQF	(XL1,ZNOTYP,QZCN)		;JUMP IF CONST
	GOTO	FALSE
 THEN	EXEC	ORCNNT
	SF	X5,ZNSTYP(XL1)
	SETF	(%CONVERT) ZNSGEN(XL1)
 ELSE
	;TRANSFORM CONSTANT TO TYPE IN REG (X5) 
	;WARNING IF LOSS OF SIGNIFICANCE

	LI	X4,0
  IF	CAIE	X2,QINTEGER
	GOTO	FALSE				;JUMP IF CONV FROM REAL OR LREAL
  THEN	FLTR	X3,1(XL1)			;IMPLEMENTED ONLY IN KI10
  ELSE
   IF	CAIE	X2,QREAL
	GOTO	FALSE				
   THEN	L	X3,1(XL1)			;LOAD REAL CONST
   ELSE
		DMOVE	X3,@1(XL1)			;LOAD LONG REAL CONST
   FI
   IF	CAIE X5,QINTEGER
	GOTO	FALSE				;JUMP IF NOT CONV TO INTEGER
	JFCL	17,.+1
	IF	CAIN	X2,QLREAL
		GOTO	FALSE
	THEN
		FIXR	X3,X3			;IMPLEMENTED ONLY IN KI10
	ELSE	; CONVERT FROM LONG REAL
		LDB	X1,[POINT	9,X3,8]
		TLZ	X3,777000
		SUBI	X1,<200+^D27>
		ASHC	X3,(X1)
		SKIPGE	@1(XL1)	; CHECK IF LONG REAL NUMBER WAS NEGATIVE
		MOVN	X3,X3	; NEGATE IF SO
	FI
	JFCL	11,TRUE
	GOTO	FALSE
   THEN	ERROR2	22,RESULT OVERFLOW OR DIVISION BY ZERO IN CONSTANT EXPRESSION
   FI
  FI
 IF	CAIN	X5,QLREAL
	GOTO	FALSE
 THEN	ST	X3,1(XL1)
ELSE
	HRROI	X1,-2
	ADDB	X1,YEXPP
	ST	X1,1(XL1)
	STD	X3,(X1)
 FI	SF	(X5) ZCNTYP(XL1)
FI
FI

ORCN1:	RETURN
	EPROC

ORCNNT:		;MOVE NODE INTO EXPRESSION TREE
		; X1 SAVED,X3 POINTS TO DESTINATION
	STACK	X1
	MOVSI	ZID%S
	ADDM	YOPSTP
	HRROI	-ZID%S
	ADDM	YEXPP
	LD	(XL1)
	STD	@YEXPP
	HRRZ	X3,YEXPP
	SETF	(QZNS)ZNOTYP(XL1)
	SETOFF	ZNOTER(XL1)
	SETON	ZNOLST(X3)
	SF	X3,ZNSZNO(XL1)
	UNSTK	X1
	RETURN

	SUBTTL ORCA
REPEAT 0,<; CONSTANT ARITHMETIC WAS REMOVED BECAUSE IT GAVE LOW RETURNS


;PURPOSE:		 COMPILE TIME ARITHMETIC ONLY FOR KI10
;ENTRY:			 ORCA
;INPUT ARGUMENT:	 REG XCUR CONTAINIG CURRENT OPERATOR
;NORMAL EXIT:		 RETURN
;ERROR EXIT:		 RETURN AND SKIP

ORCA:
	ASSERT	<IFN	QKA10,<CFAIL KI10 DEPENDENT CODE>>
 	SAVE	<X2,X3,X4,X5,X6>
	JFCL	17,.+1
	L	X1,YFOP
	LF	(X0) ZCNTYP(X1)		;CONSTANT VALUE OR ADDR
	ST	X0,X6
	SUBI	X6,QINTEGER
IF	CAIN	X0,QLREAL
	GOTO	FALSE
THEN	LF	(X2) ZCNVAL(X1)
	LF	(X4) ZCNVAL(X1,ZCN%S)
ELSE	LD	X2,@1(X1)
	CAIE	XCUR,%UNMIN
	LD	X4,@3(X1)
FI

IF	CAIE	XCUR,%UNMIN
	GOTO	FALSE
THEN	XCT	ORCAUM(X6)
ELSE
 IF	CAIE	XCUR,%PLUS
	GOTO	FALSE
 THEN	XCT	ORCAAD(X6)
 ELSE
  IF	CAIE	XCUR,%MINUS
	GOTO	FALSE
  THEN	XCT	ORCASU(X6)
  ELSE
   IF	CAIE	XCUR,%MULT
	GOTO	FALSE
   THEN	XCT	ORCAMU(X6)
   ELSE	XCT	ORCADI(X6)
   FI
  FI
 FI
FI
IF	JFCL	11,TRUE
	GOTO	FALSE
THEN	ERROR2	22,RESULT OVERFLOW OR DIVISION BY ZERO IN CONSTANT EXPRESSION
	RESTORE
	AOS	(XPDP)
	SETF	(QUNDEF) ZCNTYP(X1)
	POPJ	XPDP,
ELSE	
 IF	CAIN	X0,QLREAL
	GOTO	FALSE
 THEN	ST	X2,1(X1)
 ELSE	STD	X2,@1(X1)
 FI
 IF	CAIN	XCUR,%UNMIN
	GOTO	FALSE
 THEN	L	[-ZCN%S,,-ZCN%S]
	ADDM	X0,YOPSTP
 FI
FI
RETURN

ORCAAD:	ADD	X2,X4
	FADR	X2,X4
	DFAD	X2,X4				;IMPLEMENTED ONLY IN KI10
ORCASU:	SUB	X2,X4
	FSBR	X2,X4
	DFSB	X2,X4				;IMPLEMENTED ONLY IN KI10
ORCAMU:	IMUL	X2,X4
	FMPR	X2,X4
	DFMP	X2,X4				;IMPLEMENTED ONLY IN KI10
ORCADI:	IDIV	X2,X4
	FDVR	X2,X4
	DFDV	X2,X4				;IMPLEMENTED ONLY IN KI10
ORCAUM:	MOVN	X2,X2
	MOVN	X2,X2
	DMOVN	X2,X2				;IMPLEMENTED ONLY IN KI10
YORENO=20
YORWNO=40
>
	END