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

	SALL



;AUTHOR:		 ELIASBETH $LUND
;			 UPDATED AT ACADIA UNIVERSITY FOR KA10
;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

;***AUBEG
;THIS CODE HAS BEEN CONVERTED FOR KA10.
;THE FLTR AND FIXR OPCODES ARE IMPLEMENTED AS UUOS IN KAUUO2.
;	ASSERT	<IFN	QKA10,<CFAIL KI10 DEPENDENT CODE>>
;***AUEND
	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
;***AUBEG
;USE LD FOR DMOVE AND AVOID INDIRECTION IN LD MACRO
;NOTE X4 CAN BE USED AS INTERMEDIATE, SINCE IT IS LOADED BY
;THE SECOND MOVE GENERATED BY THE LD MACRO.
		LI	X4,@1(XL1)		;LOAD LONG REAL CONSTANT
		LD	X3,(X4)
;***AUEND
   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>
;***AUBEG
;IF KA10, LONG REAL VALUE HAS EXPONENT IN BITS 1-8 OF SECOND WORD,
;SO SECOND WORD MANTISSA MUST BE SHIFTED LEFT 8 BITS TO CONVERT
;TO KI10 LONG REAL FORMAT, FOR REST OF THIS CODE TO WORK.
IFN QKA10,<LSH	X4,^D8>
;***AUEND
		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
;***AUBEG
;SPECIFY X0 AND
;AVOID INDIRECTION IN STD MACRO.
;NOTE THAT X3 IS FREE FOR USE AS AN
;INTERMEDIATE SINCE IT IS LOADED BY THE HRRZ
;FOLLOWING THE STD MACRO.
	LD	X0,(XL1)
	LI	X3,@YEXPP
	STD	X0,(X3)
;***AUEND
	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

;***AUBEG
;THIS ROUTINE HAS NOT BEEN UPDATED FOR KA10 SINCE IT IS NOT IN
;USE IN THE PRESENT VERSION OF SIMULA. IF CONVERSION IS UNDERTAKEN
;IN A FUTURE VERSION, IT WILL BE NECESSARY TO RECODE THE LD AND STD
;MACRO CALLS WHICH USE INDIRECTION AND CHANGE THE CAIE INSTRUCTION
;PRECEDING THE LD MACRO CALL.
;***AUEND

;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