SUBTTL	OCEP     Overall SIMULA program control

Comment;

Written Feb 1974 by Lars Enderin, revised Nov 1974
Updated at Acadia University for KA10

Purpose
-------
The OCEP module contains routines to handle monitor interface,
program initialization and exit, interface with SIMDDT, traps and errors.

Global routines							      page
---------------
.FORER	Entry point called on errors in FORTRAN library subroutines .... 4
.OCEI	Entered via a branch at end of OCIN. Finishes initialization ... 6
.OCEP	Exit from SIMULA program. Called at end of SIMULA program or ... 7
	via  EXIT command in SIMDDT.
.OCLD	Makes sure SIMDDT is available ................................. 9
.OCRD	Reads SIMDDn.ABS ...............................................10
.OCTR	Gets control on traps, e g overflow, illegal memory reference ..11
.OCUU	Handles UUO's for error messages, breakpoints etc ..............18

Local routines
--------------
OCCAD	Finds code address corresponding to interrupt address .......... 8
.OCTT	(TYPTIM) Types a time from X0 (millisecs) in form HH.MM.SS:hh .. 5

Updates: [20,41,61,62,122,123,141,241,253,271]
;

	SEARCH	SIMMAC,SIMMCR,SIMRPA
	SALL
	RTITLE	OCEP
	TWOSEG
	RELOC	400K
	MACINIT
			edit(61)
	PROCINIT(OCEP)	;[61]
EXTERN	.JBDDT,.JBFF,.JBUUO,.JB41,.JBOPC,.JBSA,.JBREN
EXTERN	.JBAPR,.JBCNI,.JBTPC,.JBREL,.JBHRL
EXTERN	.IOCL,.IOCLA,.IOOP,.SACL,.SAGC

	ERRMAC(OC)

INTERN	.OCEI	;End of initialisation
ENTRY	.OCEP	;End of SIMULA program
INTERN	.OCLD	;Loads SIMDDT
INTERN	.OCTR	;Trap handler
INTERN	.OCUU	;UUO handler

DEFINE	TYP(T)<OUTSTR	[ASCIZ/T/]>
DEFINE	RTYP(T)<TYP<
T>>
DEFINE	TYPR(T)<TYP<T
>>
DEFINE	RTYPR(T)<TYP<
T
>>

;Instruction format definition
 DF ACF,0,4,12		;AC FIELD
 DF INDEX,0,4,17	;INDEX FIELD
 DF OPCODE,0,9,8	;OPCODE FIELD
 DF ADDRESS,0,18,35	;Address field

OPDEF	XEC	[PUSHJ	XPDP,]
OPDEF	TYPTIM	[XEC	.OCTT]	;Type a time (ms) from X0 as HH:MM:SS.hh
OPDEF	TYPSIX	[TYPENAME]	;Type X0 as SIXBIT characters


;Special error codes to be matched with error message file

			edit(41)
	QOCOOP=QOCENO+4	;[41] open files at exit
	QOCOBN=QOCENO+5	;Object NONE
	QOCILM=QOCENO+6	;Illegal memory reference
	QOCIOV=QOCENO+7	;Integer overflow
	QOCIDV=QOCIOV	;Integer division by zero
	QOCFOV=QOCENO+10;Floating point overflow
	QOCFDV=QOCFOV	;Floating division by zero
	QOCFXU=0	;Floating exponent underflow (not trapped in SIMULA)
	SUBTTL	Exits from FORTRAN subroutines

Comment;

.FORER is called via FORER.  in OCSP and  FORER  in  SIMRTS.
It  is  called  by  routines  from  FORLIB,    such as SQRT,
on errors.  The form of that call is as follows:
	XCT	errorclass, FORER.
	CAI	type,return(severity code)
where errorclass is either ER%LIB or  ER%APR.   For  ER%LIB,
return  normally  points to an ASCII message string.  .FORER
types that string as part of a %ZYQFLE message,  then  fakes
an RTSERR QFORER, transferring control to OCUU.  For ER%APR,
return is the address to where FOROTS would  return  if  the
error  should be recovered from, or zero.  The error type is
translated to the corresponding SIMULA APR error number, e g
QOCIOV  for  integer  overflow.   An RTS error is then faked
with that error number as if the  real  trap  had  occurred.
This is similar to how FOROTS handles those errors.  For all
errors handled by .FORER, a ZYQEIR message gives the name of
the routine, found in SIXBIT in the word preceding the entry
point.


.FOREX is called if an external FORTRAN procedure executes a
STOP or CALL EXIT  statement.       Control  is  transferred
directly to OCEP after typing the ZYQSFS message.
;
	SETLOW		;Set standard XLOW

.FORER::PROC
	EXCH	.JBUUO	;Save X0
	N=0	;Keep track of stack
	STACK	X1
	STACK	X2
			edit(141)
	STACK	X3	;[141]
	STACK	XLOW
	N=N+4		;[141]
	SETZ	X3,	;[141]
	LOWADR
	LI	X2,-N(XPDP)	;Point to likely return address
	;Find name of subroutine
	LOOP	;Down to stack bottom
		HRRZ	X1,(X2)	;Return address
		IF	LEGAL
			GOTO	FALSE
		THEN	;Check for PUSHJ, then find name
			L	X1,-1(X1)
			HLRZ	X1
			IF
				CAIE	(PUSHJ	XPDP,)
				GOTO	FALSE
			THEN
				L	X3,-1(X1)	;[141]
				GOTO	L8
		FI	FI
	AS	CAILE	X2,YOBJRT(XLOW)
		SOJA	X2,TRUE
	SA
L8():!	HRRZ	X1,-N(XPDP)	;Address of CAI instr
	LF	X2,ACF(X1,-1)	;[141] Error class
	IF	;Faked APR
		CAIE	X2,ER%APR
		GOTO	FALSE
	THEN	;Find correct error code number
		HRRZ	(X1)
		IF	;[141] Non-zero recovery address
			JUMPE	FALSE
		THEN	;Replace return address in stack
			HRRM	-N(XPDP)
		FI	;[141]
		LF	X2,ACF(X1)
		IF	;[141] Underflow
			CAIE	X2,7	;[141]
			GOTO	FALSE
		THEN	;Return to code via stack
			AOS	YOCUFL(XLOW)	;Count the underflow
			JSP	X1,L9
			UNSTK	X1
			POPJ	XPDP,
		FI	;[141]
		EXEC	L7	;[141] Name of routine
				edit(122)
		L	FORERR	;[122]
		CAIG	X2,7	;[122]
		L	APRERR(X2)	;[41] [122]
	ELSE
		EXEC	L7	;[141] Name of routine
		IF	;Library error (with inline message)
			CAIE	X2,ER%LIB
			GOTO	FALSE
		THEN	;Find the message text
			HRRZ	X1,(X1)	;Message address
			IF	;The message is at a reasonable place
				LEGAL
				GOTO	FALSE
				CAIG	X1,140
				GOTO	FALSE
			THEN	;Type it, prefixed by %ZYQFLE
				TYP	(%ZYQFLE )
				OUTSTR	(X1)
				TYPR	( )
		FI	FI
		L	FORERR	;[41]
	FI
	JSP	X1,L9	;[141]
	UNSTK	X1	;[141]
	BRANCH	.OCUU	;[141]

		edit(141)
L7():!	IF	;[141] Any name to type
		JUMPE	X3,FALSE
	THEN
		RTYP	([ZYQEIR Error in routine: )
		L	X3	;[141]
		TYPSIX
		TYPR	(])
	FI	;[141]
	POPJ	XPDP,


L9():!	UNSTK	XLOW
	UNSTK	X3	;[141]
	UNSTK	X2
	EXCH	.JBUUO
	GOTO	(X1)	;[141]
	EPROC

.FOREX::CLEARO
	TYP	(%ZYQSFS STOP statement executed or EXIT called in FORTRAN subprogram)

	BRANCH	.OCEP

FORERR:
APRERR:	;[41]
	RTSERR	QFORER
	RTSERR	QDSCON,QOCIOV
	RTSERR	QDSCON,QOCIDV
	RTSERR	QFORER
	RTSERR	QFORER
	RTSERR	QDSCON,QOCFOV
	RTSERR	QDSCON,QOCFDV
	RTSERR	QDSCON,QOCFXU
	SUBTTL	TYPTIM [61]

.OCTT:	PROC	;Type X0 (ms) as HH:MM:SS.hh
	SAVE	<X1>
	ADDI	5	;Round off hundredths
	IDIVI	^D1000	;Secs
	STACK	X1	;Save thousandths
	IDIVI	^D60	;Minutes
	STACK	X1	;Save the seconds
	IF	;Any full minute
		JUMPE	FALSE
	THEN	;Save minutes, get hours
		IDIVI	^D60
		STACK	X1
		IF	;Any full hour
			JUMPE	FALSE
		THEN	;Type hours
			TYPDEC
			TYP	(:)
		FI
		UNSTK		;Minutes
		TYPDEC
		TYP	(:)
	FI
	UNSTK		;Seconds
	TYPDEC
	TYP	(.)
	UNSTK		;Thousandths
	IDIVI	^D10
	IDIVI	^D10	;1st digit in X0, second in X1
	IORI	"0"	;Tenths digit to ASCII
	OUTCHR
	LI	"0"(X1)	;2nd digit to ASCII
	OUTCHR
	RETURN
	EPROC
	SUBTTL	.OCEI	(End of initialisation)

Comment;

Purpose:	To finish initialisation for a SIMULA program.
		Opens SYSOUT, restores XCB, loads and
		starts SIMDDT if requested, sets up YDSLOAD(XLOW)
		and standard .JBREN, then returns to main prog.
		The max hiseg address, YSAHSZ(XLOW), is updated.

Entry:		From OCIN via a branch instruction.
		XCB :- SYSOUT object.
		XWAC1 & XWAC2 == SYSOUT.IMAGE, to be passed via open.
		Stack top points back to SIMULA code.

Exit:		To main program where OCSP was called.
;

.OCEI:
	;Open sysout
	L	XWAC3,XWAC2
	L	XWAC2,XWAC1
	L	XWAC1,XCB
	EXEC	.IOOP

	HRRZ	.JBHRL			;Find max hiseg size for garb. coll. purposes
	SUBI	377776
	CAML	YSAHSZ(XLOW)
	ST	YSAHSZ(XLOW)
					edit(242)
	L	XCB,YOCXCB(XLOW)	;[242] Restore XCB
					edit(300)
	LI	OCLD			;[300]
	ST	YDSLOAD(XLOW)
	IF	;Space was reserved for SIMDDT
		SKIPN	XDBAS,YDSBA1(XLOW)	;[242]
		GOTO	FALSE
	THEN	;Initialize SIMDDT
		IF	;SIMDDT was not in core
			JUMPG	XDBAS,FALSE
			SKIPE	(XDBAS)
			GOTO	FALSE
		THEN	;Get it
			HRRZS	XDBAS
			EXEC	.OCRD
		FI
		EXEC	QDSINI(XDBAS)
	FI
	;Set up standard reenter point
	HRRZ	X1,.JBREN
	XCT	1(X1)
	ST	.JBREN
	RETURN
	SUBTTL	.OCEP	(End of SIMULA program)

Comment;

Purpose:	To finish a SIMULA program execution.
		Types job statistics, closes files, etc.

Entry:		Called at end of a main SIMULA program,
		or when a terminal error has occurred. In case
		of an error exit, as many files as possible are closed, etc.

Exit:		Returns to monitor level by MONRT. (EXIT 1,).
		A CONTINUE command gets and starts SIMDDT.
;

.OCEP:	PROC
	LOWADR
	
	edit(41)
	;[41] TEST IF FILES OPEN AND CREATE ERROR FIRST TIME
	IF
		IFON	SDSCLO(XLOW)
		GOTO	FALSE
	THEN
		IF
			EXEC	.IOCLA		;TEST IF OPEN FILES EXIST
			JUMPE	X0,FALSE	;NO FILES OPEN
		THEN
			SETON	SDSCLO(XLOW)	;inhibit loop
			OCERR 4,some files open at exit
						;CREATE ERROR GOTO SIMDDT
		FI
		SETON	SDSCLO(XLOW)	;Indicate first check done
	FI
	EXEC	.SACL			;Let garbage collector finish
	EXEC	.IOCLA			;Close all files, also SYSIN and SYSOUT [41]
L9():!	L	X1,.JBREN
	IF	;Non-zero REENTER address
		JUMPE	X1,FALSE
	THEN	;Restore initial .JBREN
		L	X1,1(X1)	;Ordinary .JBREN
		L	X1,-1(X1)	;Initial .JBREN
		HRRZ	.JBSA
		IF	JUMPN	FALSE
		THEN	SETZ	X1,	;If no START, no REENTER either!
		FI
		ST	X1,.JBREN
	FI
	CLEARO
	RTYPR	(End of SIMULA program execution.)
	LOWADR
	IF	;Any edit overflow
		L	YEDOFL(XLOW)
		JUMPE	FALSE
	THEN	;Tell the user
		TYP	(%ZYQEDO )
		TYPDEC
		TYPR	( EDIT OVERFLOW(S))
	FI
		edit(61)
	IF	;[61] Any underflow
		L	YOCUFL(XLOW)
		JUMPE	FALSE
	THEN	;Tell the user
		TYP	(%ZYQUFL )
		TYPDEC
		TYPR	( UNDERFLOW(S))
	FI
	TYP	(CPU time: )
	SETZ
	RUNTIME	;(millisecs)
	SUB	YRUNTM(XLOW)
	TYPTIM
	TYP	(	Elapsed time: )
	MSTIME
	SUB	YDAYTM(XLOW)
	IF	;Midnight was passed
		JUMPGE	FALSE
	THEN
		LOOP
			ADD	[^D1000*^D3600*^D24] ;ms per day
		AS	;Until positive
			JUMPL	TRUE
		SA
	FI
	TYPTIM
	TYPR	( )
	EXIT	1,		;.CONTINUE will bring in SIMDDT
	L	X2,YOCXCB(XLOW)	;Main block address
	IF	;Known
		JUMPE	X2,FALSE
	THEN	;Check if any reduced subblock inside
		LF	X3,ZBIZPR(X2)
		LF	,ZPRBLE(X3)	;Block length
		IF	;Block length GT ZBI%S
			CAIG	ZBI%S
			GOTO	FALSE
		THEN	;Set bnm to 1
			LI	1
			SF	,ZBIBNM(X2)	;Make global variables accessible
	FI	FI
	LI	L9	;Fake ^C-REENTER for CONTINUE
	HRRM	.JBOPC
	BRANCH	@1(X1)	;GOTO ordinary reentry point
	EPROC
	SUBTTL	OCCAD

Comment;

Purpose:	To find the most likely SIMULA code address
		corresponding to the current push-down stack.

Input:		X0 holds stack top address at interrupt

Output:		X1 will be address in SIMULA code on normal return,
		otherwise skip return.
;
OCCAD:	PROC
	IF	;We were not at object code level
		CAIGE	YOBJRT(XLOW)
		GOTO	FALSE
	THEN	;Try to find a PUSHJ nearby
		HRRZ	X1,YOBJRT(XLOW)
		SUBI	X1,1
		IF	LEGAL
			GOTO	FALSE
		THEN	;Try up to 3 instructions back from return address
			HRLI	X1,-3
			LOOP
				HLRZ	(X1)
				CAIN	(PUSHJ	X17,)
				GOTO	L9
			AS
				SUBI	X1,2
				AOBJN	X1,TRUE
			SA
			HLRZ	3(X1)	;Try JSP (used in thunks)
			CAIN	(JSP	X0,)
	FI	FI
	AOS	(X17)
L9():!	HRRZS	X1
	RETURN
	EPROC
	SUBTTL	.OCLD - LOAD SIMDDT

Comment;

Purpose:	To get SIMDDT dynamically.

Entry:		EXEC	.OCLD
		All registers have been saved in YUUOAC(XLOW)

Exit:		Normal return if SIMDDT could be loaded,
		skip return if not.

Function:	If already loaded, immediate return.
		If enough core is left in the pool, use that area.
		If the pool is too small, ask for more core.
		If enough core available, read SIMDDn.ABS and place
		its address in YDSBAS(XLOW), otherwise skip return.
;
OPDEF	IOOP	[HRLI	(X1)]	;Used to put channel and opcode in an ac (left half)
OPDEF	IOOPZ	[HRLZI	(X1)]	;Same as IOOP, but right half zero


.OCLD:	PROC
	IF	;Call was from .OCRE (REENTER)
		SKIPL	YDSCAD(XLOW)
		GOTO	FALSE
	THEN	;Try to find code address
		HRRZ	X1,.JBOPC
		ST	X1,YDSCAD(XLOW)
		LI	-1(X17)
		EXEC	OCCAD
		ST	X1,YDSCAD(XLOW)
	FI
	SKIPE	XDBAS,YDSBAS(XLOW)
	RETURN		;If it was already loaded

	CLEARO

				edit(20)
	LI	X3,1		;[20] Allow at most one GC

L1():!	LI	QDSLG+QDSLGA
	ADD	YSATOP(XLOW)
	SUB	YSALIM(XLOW)
	IF	;Not enough space left
		JUMPLE	FALSE
	THEN	;Try to get more core
		L	X1,.JBFF
		ADD	X1,
		IF	;We can get enough core
			CORE	X1,
			GOTO	FALSE
		THEN	;Get it, update GC variables
			L	X1,.JBREL
			ADDI	X1,1
			HRRM	X1,.JBFF
			SUBI	X1,QSALIM
			ST	X1,YSALIM(XLOW)
			SUB	X1,YSABOT(XLOW)
			ST	X1,YSAL(XLOW)
		ELSE	;Collecting garbage might do the trick
		IF	;Allowed to collect garbage
			SOJL	X3,FALSE	;Only once!
			IFON	SWNOGC(XLOW)
			GOTO	FALSE
		THEN	SETZ	;We do not want an error
						edit(41)
			HRRZS	YDSENR(XLOW)	;[41] Cannot continue after GC
			EXEC	.SAGC
			GOTO	L1
		ELSE
			RTYP	(%ZYQNEC Not enough core)
			GOTO	OCLDER
	FI	FI	FI
	L	XDBAS,YSATOP(XLOW)
	IF	;SIMDDT can be read in
		EXEC	.OCRD	;Read SIMDDT
		GOTO	TRUE
		GOTO	FALSE
	THEN	;Update YSATOP, return normally
		LI	X2,QDSLG
		ADDB	X2,YSATOP(XLOW)
		IFN QSADEA,<	;UPDATE YSADEA IN DEALLOCATE VERSION
			ST	X2,YSADEA(XLOW)
			>
	ELSE
		AOS	(XPDP)
	FI
	RETURN
	EPROC
	SUBTTL	.OCRD- Read SIMDDT

Comment;

Purpose:	To read SIMDDT into low core.

Input:		XDBAS = start of area to put SIMDDT in

Exit:		Normal return if SIMDDT could be read,
		skip return otherwise.

Function:	Find a free channel from YIOCHTB(XLOW).
		Reads SIMMDT.ABS in dump mode to the given area.

Error exits:	%ZYQOUF, %ZYQLUF, %ZYQIUF messages may appear,
		then skip return.
;
.OCRD:	PROC	;;Use any free channel to read SIMDDT ;;

	LI	X2,YIOCHTB(XLOW)
	HRLI	X2,-20
	LOOP
		SKIPN	(X2)
		GOTO	L3
	AS	AOBJN	X2,TRUE
	SA
	OUTSTR	[ASCIZ"
%ZYQNIO No free I/O channel"]
;;; NOTE! Use channel 0 in that case - implement later ;;;
	GOTO	OCLDER

L3():!	SUBI	X2,YIOCHTB(XLOW)
	LI	X1,(X2)
	LSH	X1,5	;Channel number into AC position + 18
			;To be used for IOOP and IOOPZ
	LI	X2,16	;OPEN args to X2-X4, dump mode I/O
	L	X3,YOCDEV(XLOW)
	SETZ	X4,	;No buffer headers needed
	IOOP	X10,(OPEN)
	HRRI	X10,X2
	XCT	X10		;OPEN
		GOTO	OCOFAIL

	SETZ	X5,	;Try own ppn first
	LI	X7,1	;First try
					edit(253)
L5():!	L	X2,[SIXBIT/SIMDD4/]	;[253] LOOKUP args to X2-X5
	MOVSI	X3,'ABS'
	SETZ	X4,
	IOOP	X10,(LOOKUP)
	HRRI	X10,X2
	XCT	X10	;LOOKUP
		GOTO	OCLFAIL	;On LOOKUP failure

;; Now try to read SIMDDT ;;

	;Make an IOWD list in X3, X4
	MOVSI	X3,-QDSLG
	HRRI	X3,-1(XDBAS)
	SETZ	X4,
	IOOP	X10,(IN)
	HRRI	X10,X3
	IF	;IN UUO fails
		XCT	X10
		GOTO	FALSE
	THEN
		RTYP	(%ZYQIUF IN UUO failed)
		GOTO	OCLDER
	FI
	IOOPZ	X10,(RELEASE)
	XCT	X10
	RETURN

OCOFAIL:RTYP	(%ZYQOUF OPEN UUO failed)
	GOTO	OCLDER

OCLFAIL:;LOOKUP failure, have another try?
	L	X5,YDEPPN(XLOW)
	SOJGE	X7,L5
	RTYP	(%ZYQLUF LOOKUP UUO failed)
	GOTO	OCLDER

OCLDER:	TYP	(. Cannot load SIMDDT)
	AOS	(XPDP)
	RETURN
	EPROC
         SUBTTL  OCTR - Trap handler for SIMULA programs

Comment;

Purpose
-------
Gets control when one of the traps enabled by .OCTI  occurs.
Analyzes  the  trap  and gives an appropriate error message.
Special case: Erroneous references to  NONE  are  caught  as
addressing  exceptions  (non-existent  memory).   Since  the
hardware  does  not  automatically  clear  the   result   on
underflow,  special  code  must do this instead.  Also, some
routines taken from FORLIB and the text editing routines may
want to get control back on overflow or divide check.

Entry conditions
----------------
.JBTPC  has  address  of  trapped  instruction  or  the  one
following.   .JBCNI  contains  trap  bits to be analyzed.  A
JFCL  instruction  placed  after  the  trapped   instruction
signals special actions.

Function
--------
At all points in the code of OCTR, the assembly  variable  N
indicates  how  many quantities are saved on the stack.  The
SWNOGC switch is set  so  that  a  subsequent  execution  of
SIMDDT  cannot  lead  to  garbage  collection.  By examining
.JBCNI and .JBTPC, the trap is classified into four classes:
1) Illegal memory reference (OCTR.M is entered)
2) Floating point exponent underflow (OCTR.U)
3) Floating point overflow or divide check (OCTR.F)
4) Arithmetic overflow (TJFCL1 entered).

Illegal memory reference

The instruction pointed to by .JBTPC and the one before  are
checked  to  find  out  if the index register contains  NONE
or NONE + d, where d is in the range [1,1023].
Failing that, the instruction code is  checked  for  DPB  or
LDB,  which  are used in certain cases.  The byte pointer is
then checked for NONE in its index register.  If  the  value
NONE  is  found  in this way, OCUU is entered with the faked
error  message  "Object  NONE",  otherwise  "Illegal  memory
reference" will be issued.

Floating point exponent underflow

Underflow is signalled by a bit  in  .JBTPC.   Since  SIMULA
treats  underflow as zero, the result must be cleared.  This
is not trivial because of the several possible  combinations
of indexing and indirect addressing and the different result
modes possible (to ac(s), to memory, to self, or to both  ac
and  memory).   First  the instruction class and result mode
must be determined, then a substitute  instruction  must  be
created  which,  when  executed,  will  place  zeros  in the
appropriate result location(s).   Some  FORTRAN  subroutines
may  require  special actions on underflow by placing a JFCL
instruction after the instruction which may give  underflow.
A  JFCL (2) instruction specifies that the result should not
be  zeroed  but  unnormalized  instead,  and  a   JFCL   (4)
instruction  placed  after  a FSC instruction specifies that
two registers should be cleared on underflow, i e  a  double
precision result is expected.

Floating point overflow or divide check

The instruction class is determined and an "infinite" result
is  computed.  An instruction designed to put this result in
the correct  location(s)  is  built  up  in  the  stack  and
executed.  Control is then transferred to TJFCL1.

Arithmetic overflow

TJFCL1 checks if the  error  should  be  reported  or  if  a
recovery   should   be   attempted.    Underflow  is  always
recovered.  In other cases, a  JFCL  instruction  after  the
interrupted  instruction specifies that the error should not
be reported. If the JFCL has an address specified, OCTR will
return  to  that address, otherwise to the next instruction.
If no JFCL was given, or if the overflow bit or an X1  index
field  was set, an error message will be issued via OCUU and
SIMDDT.

Exit conditions
---------------
If recovery was successful, zero  or  +-"infinity"  will  be
placed in the result location.  In some cases, the underflow
result stands as computed (not in SIMULA  code).   Execution
continues.   Otherwise,  OCUU gets a faked error UUO and the
appropriate error number.  The trap  PC  is  stacked  (X17).
The  trap  bits  from  .JBCNI are cleared.  The interrupt is
dismissed by a JRSTF to .OCUU with .JBUUO and X17 stack  set
up   as   if   the  error  message  came  from  the  trapped
instruction.
;
;Trap bits in PC word:
FXU=	1B11	;Floating exponent underflow mask
FOV=	1B3	;Floating overflow mask
NDV=	1B12	;No divide mask

;Offsets for saved quantities on the stack
X1SAVE=	1
ACFLD=	2	;Normally ac field of interrupted inst
INST=	3	;Normally interrupted instruction
ACDATA=	4	;The result of the trapping instruction
FIXUP1=	5
FIXUP2=	6
N=	0	;Number of quantities on the stack

OPDEF	OOP	[777B8]	;All ones in opcode field
INLINE==QDEBUG
DEFINE	TEXT(T)<IFN INLINE,<OUTSTR [ASCIZ/T/]>>
DEFINE	RTEXT(T)<TEXT <
T>>
DEFINE	RTEXTR(T)<TEXT <
T
>>
DEFINE	TEXTR(T)<TEXT <T
>>

.OCTR:	PROC
	CLEARO			;Clear control-O
	STACK	X1
	N=1			;One quantity saved now
	L	X1,.JBCNI

	TRNE	X1,AP.NXM!AP.ILM
	BRANCH	OCTR.M		;Illegal memory reference

	SOS	X1,.JBTPC	;Make X1 and .JBTPC point to the interrupted instr.
	TLNE	X1,(FXU)
	BRANCH	OCTR.U		;Underflow

	TLNE	X1,(FOV)
	BRANCH	OCTR.F		;Floating point overflow or divide check

	GOTO	TJFCL1		;Arithmetic overflow

TJFCL:	N=1
	ST	X1,X1SAVE-N(XPDP);Save X1 again (possibly affected by fixup action)
TJFCL1:	AOS	X1,.JBTPC	;Let .JBTPC point to next instr
	STACK	X1		;Save its address
	N=N+1
	TLNE	X1,(FXU)	;Always recover on underflow
	GOTO	RECOVER
	IF	;Next instr is a JFCL
		L	X1,(X1)
		TLC	X1,(JFCL)
		TLNE	X1,(OOP)
		GOTO	FALSE
	THEN	;We may recover
		IF
			TLNE	X1,(Z 10,(1))	;Give error message also if
			GOTO	FALSE		;overflow bit or XR1 is set
		THEN
			TRNE	X1,-1		;Any address specified ?
			HRRM	X1,(XPDP)	;Use it as return address
RECOVER:		MOVSI	X1,337600	;Mask out the flags but leave
			AND	X1,.JBTPC	;CRY0, CRY1, and user's IOT set
			JRSTF	.+1(X1)
			UNSTK	X1
			EXCH	X1,(XPDP)	;Restore X1, put return addr on stack
			POPJ	XPDP,	;RETURN TO USER
		FI
	FI
	TEXT	(Program trap: )
	L	X1,.JBCNI
	IF	TRNN	X1,AP.FOV
		GOTO	FALSE
	THEN	LI	X1,QOCFOV
		TEXTR	(Floating point overflow or div by zero)
	ELSE
		LI	X1,QOCIOV
		TEXTR	(Integer overflow or div by zero)
	FI
					edit(41)
	TLOA	X1,(RTSERR QDSCON,)	;[41]

OCTR.E:	;Fake an error UUO
	HRLI	X1,(RTSERR)
	ST	X1,.JBUUO
	LOWADR	X1
	SETON	SWNOGC(X1)	;Cannot allow garbage collection
	MOVSI	X1,337600	;Mask out the flags but leave
	AND	X1,.JBTPC	;CRY0, CRY1, and user's IOT set
	JRSTF	.+1(X1)
	UNSTK	X1		;Return address for .OCUU
	EXCH	X1,(XPDP)	;Stack return address, restoring X1
	BRANCH	.OCUU		;Let .OCUU do the rest
	EPROC
	SUBTTL	Illegal memory reference (check for NONE)

	N=1
OCTR.M:	SOS	X1,.JBTPC
	STACK	X2
	STACK	X3
	N=N+2
				edit(271)
	HRRZ	X1,.JBTPC	;[271]
	LEGAL
	 GOTO	OCTRIL	;Ill mem ref if address not usable (may be JRST illeg..)
	L	X1,.JBTPC
	IF	;Any used register is NONE
		JSP	X3,OCNONE
		AOSA	X1,.JBTPC
		GOTO	TRUE
		JSP	X3,OCNONE
		GOTO	FALSE
	THEN
		TEXTR	( Object NONE)
		LI	X1,QOCOBN
	ELSE	;Was not NONE, apparently
OCTRIL:		TEXTR	(Program trap: Illegal memory reference)
		LI	X1,QOCILM
	FI
	UNSTK	X3
	UNSTK	X2
	STACK	.JBTPC
	BRANCH	OCTR.E


OCNONE:	LF	X2,INDEX(X1)	;See which AC
	IF	;Nonzero index field
		JUMPE	X2,FALSE
	THEN	;Check that ac for NONE+d, with d in [0,1023]
		IF	;Still untouched
			CAIGE	X2,X4
			GOTO	FALSE
		THEN	;Get its value directly
			HRRZ	X2,(X2)
		ELSE	;Take from save area
			ADDI	X2,(XPDP)
			HRRZ	X2,X1SAVE-1-N(X2)
		FI
		SUBI	X2,NONE
		JUMPL	X2,(X3)
		CAIGE	X2,^D1024
		BRANCH	1(X3)	;Skip return if NONE found
		BRANCH	(X3)
	FI
	LF	X2,OPCODE(X1)
	IF	;Byte instruction
		CAIE	X2,(<LDB>_-9)
		CAIN	X2,(<DPB>_-9)
		GOTO	TRUE
		GOTO	FALSE
	THEN	;Get byte pointer and check its index register
		STACK	X1
		N=N+1
		LI	X1,@(X1)
		LEGAL
		BRANCH	[UNSTK X1
				edit(241)
		BRANCH	(X3)]	;[241]
		LF	X2,INDEX(X1)
		JUMPE	X2,(X3)
		IF	;Still untouched
			CAIGE	X2,X4
			GOTO	FALSE
		THEN
			HRRZ	X2,(X2)
		ELSE	;Take from save area
			ADDI	X2,(XPDP)
			HRRZ	X2,X1SAVE-1-N(X2)
		FI
		UNSTK	X1
		N=N-1
		CAIN	X2,NONE
		BRANCH	1(X3)	;Skip return if NONE found
	FI
	BRANCH	(X3)
	SUBTTL	Floating point overflow or floating point divide check

	N=1
OCTR.F:	LF	X1,ACF(X1)
	STACK	X1			;Save ac field
	N=N+1
	STACK	@.JBTPC			;Save instruction
	N=N+1
	L	X1,X1SAVE-N(XPDP)
	LI	X1,@INST-N(XPDP)	;Get effective address
	EXCH	X1,INST-N(XPDP)		;and save it, picking up instr
	TLC	X1,(042B8)		;Change mode "2" to mode "0"
					;and 140-177 to 100-137
	HLR	X1,.JBTPC		;Get flags to right half
	TDNE	X1,[643B8+<NDV_-^D18>]	;Skip for "to memory" and no NDV
					;No skip for instructions outside 140-177
					;(e.g. FSC,XCT,UFA,DFAD,DFMP,DFDV)
	SKIPA	X1,ACFLD-N(XPDP)	;Get correct sign from ac
	L	X1,INST-N(XPDP)		;or from memory
	STACK	X1			;Save address for correct sign as "acdata"
	N=N+1
	L	X1,.JBTPC		;Is this an underflow that
	IF
		TLNN	X1,(FXU)	;needs to be unnormalized?
		GOTO	FALSE
	THEN
		L	X1,X1SAVE-N(XPDP)
		L	X1,@ACDATA-N(XPDP) ;Get answer to unnormalise
		STACK	X2
		N=N+1
		HLRE	X2,X1		;Exponent with extended sign to X2
		ASH	X2,-9
		TSCE	X2,X2		;For neg arg, get 1-s complement of exp
		TLOA	X1,777000	;and do not skip, set exp to all ones
		TLZ	X1,777000	;Set exp=0 for pos arg
		CAMGE	X2,[346,,346]	;Set fraction to zero if it will be
		TDZA	X1,X1		;shifted out entirely
		ASH	X1,400000(X2)	;Unnormalise fraction to bring exp into range
		UNSTK	X2
		N=N-1
	ELSE
		L	X1,X1SAVE-N(XPDP)
		SKIPGE	@ACDATA-N(XPDP)
		SKIPA	X1,[400000,,1]	;Neg result = -pos result,
		HRLOI	X1,377777	;which is max pos value
	FI
	STACK	X1	;SAVE AS "FIXUP1"
	N=N+1
	HRRZ	X1,.JBTPC
	LF	X1,OPCODE(X1)
	IF	;Ordinary f.p. instruction
		CAIG	X1,177
		CAIGE	X1,140
		GOTO	FALSE
	THEN	;Extract destination mode bits and act on them
		ANDI	X1,7
		BRANCH	OCTBL(X1)	;Branch on result mode (destination)
	ELSE
		CAIN	X1,(<FSC>_-9)
		GOTO	OVFSC
		CAIN	X1,(<UFA>_-9)
		GOTO	AC1
		TRZ	X1,003		;Change all KI10 d. p. arithm to DFAD
		CAIN	X1,(<DFAD>_-9)
		GOTO	ACDOUB		;DFAD,DFSB,DFMP, or DFDV
		SUB	[N-1,,N-1]	;Leave one item on the stack
		BRANCH	TJFCL1		;Probably an XCT
	FI
	SUBTTL	Overflows, divide check, unnormalising underflows

OCTBL:	GOTO	AC
	GOTO	ACLONG
	GOTO	MEMORY
	GOTO	BOTH
	GOTO	AC
	GOTO	AC
	GOTO	MEMORY
	;GOTO	BOTH

BOTH:	STACK	(XPDP)			;Save another copy
BOTH1:	N=6
	L	X1,X1SAVE-N(XPDP)
	UNSTK	@ACFLD-N(XPDP)		;Load ac (with hi part if d.p.)
	N=N-1

	UNSTK	@INST-N(XPDP)
	N=N-1
	SUB	XPDP,[N-1,,N-1]		;Leave one item on stack
	BRANCH	TJFCL

OVFSC:
	L	X1,.JBTPC
	L	X1,1(X1)		;Get following instruction
	TLC	X1,(JFCL (4))
	TLNN	X1,(OOP (4))		;Was FSC followed by JFCL (4)?
	GOTO	ACDOUB			;Yes
	GOTO	AC

AC1:	N=5
	AOS	X1,ACFLD-N(XPDP)
	ANDI	X1,17			;AC1=AC+1 MOD 20
	ST	X1,ACFLD-N(XPDP)
AC:	L	X1,X1SAVE-N(XPDP)
	UNSTK	@ACFLD-N(XPDP)		;Load the AC (with fixup value)
	N=N-1
	SUB	XPDP,[N-1,,N-1]		;Leave only X1SAVE on the stack
	BRANCH	TJFCL

ACLONG:	N=5
	L	X1,ACFLD-N(XPDP)	;Get the ac number
	ADDI	X1,1
	ANDI	X1,17
	ST	X1,INST-N(XPDP)		;Put AC+1 into memory address
	UNSTK	ACDATA-N(XPDP)		;Get sign of answer into better place
	N=N-1
	STACK	[344777,,-1]		;Save a positive low word
	N=N+1
	HRLOI	X1,377777		;Assume a positive high word
	SKIPGE	ACDATA-N(XPDP)		;Should result be positive?
	DFN	X1,FIXUP1-N(XPDP)	;No, negate with DFN
	STACK	X1			;Put FIXUP2 on PDL
	N=N+1
	GOTO	BOTH1

MEMORY:	N=5
	L	X1,X1SAVE-N(XPDP)
	UNSTK	@INST-N(XPDP)
	N=N-1
	SUB	XPDP,[N-1,,N-1]
	BRANCH	TJFCL

ACDOUB:	N=5
	MOVSI	X1,(Z	17,)
	AND	X1,@.JBTPC
;***AUBEG
;USE KA10 LONG REAL FORMAT
IFN QKI10,<	IOR	X1,[DMOVE 0,[EXP <377777,,-1>,<377777,,-1>]]>
IFN QKA10,<	IOR	X1,[DMOVE 0,[EXP <377777,,-1>,<344777,,-1>]]>
;***AUEND
	SKIPGE	ACDATA-N(XPDP)
	TLC	X1,1000		;DMOVN if neg result
	SUB	XPDP,[N-1,,N-1]
	BRANCH	UAC2
	SUBTTL	Underflow handling

				edit(62)
OCTR.U:	EXCH	X1,.JBOPS	;[62]
	AOS	YOCUFL(X1)	;[62] Count the underflow
	EXCH	X1,.JBOPS	;[62]
	HLL	X1,1(X1)	;Next instruction
	TLC	X1,(JFCL (2))	;JFCL (2) ?
	TLNN	X1,(OOP (2))
	GOTO	OCTR.F

	LF	X1,OPCODE(X1)
	IF	CAILE	X1,177
	THEN	BRANCH	TJFCL1	;Possibly XCT
	FI
	IF	CAIL	X1,140
		GOTO	FALSE
	THEN	;FSC or KI10 d. p. instr
		CAIN	X1,(<FSC>_-9)
		BRANCH	UFSC
		TRZ	X1,003		;Change all KI10 d. p. instr to DFAD
		CAIN	X1,(<DFAD>_-9)	;Was it DFAD,DFSB,DFMP, or DFDV?
		BRANCH	UACLNG
		BRANCH	TJFCL1
	FI

	;Here, the instruction range is reduced to 140-177:
	; (FAD**, FSB**, FMP**, FDV**)
	ANDI	X1,7		;Isolate destination mode bits
	BRANCH	OCUTBL(X1)	;Dispatch on destination
OCUTBL:	N=1
	GOTO	UAC
	GOTO	UACLNG
	GOTO	UMEMRY
	GOTO	UBOTH
	GOTO	UAC
	GOTO	UAC
	GOTO	UMEMRY
	;GOTO	UBOTH

UBOTH:	L	X1,@.JBTPC	;Get offending instr
	TLZ	X1,(OOP)	;Change opcode
	TLO	X1,(SETZB)
	GOTO	UAC2

UMEMRY:	L	X1,@.JBTPC
	TLZ	X1,(OOP 17,)	;Change opcode, clear ac field
	TLO	X1,(SETZM)
	GOTO	UAC2

UACLNG:	MOVSI	X1,(Z 17,)	;Keep ac field, change rest to clear two ac's
	AND	X1,@.JBTPC
	IOR	X1,[DMOVE 0,[EXP 0,0]]
	GOTO	UAC2

UFSC:	L	X1,.JBTPC
	L	X1,1(X1)	;Get next instr
	TLC	X1,(JFCL (4))
	TLNN	X1,(OOP (4))
	GOTO	UACLNG
UAC:	HLLZ	X1,@.JBTPC	;Get offending instr
	TLZ	X1,(OOP @(17))	;Zero op code, index, @, leave ac
	TLO	X1,(SETZ)	;(SETZ AC,)
UAC2:	EXCH	X1,X1SAVE-N(XPDP);Save instr, restore X1
	XCT	X1SAVE-N(XPDP)	;Clear register(s) or memory
	BRANCH	TJFCL
         SUBTTL  OCUU - UUO handler for SIMULA programs

Comment;

Purpose
-------
Handles local UUO's issued for  error  messages  and  SIMDDT
breakpoints.   The  trap handler, OCTR, fakes error messages
and sends control to OCUU, and so  does  the  FORTRAN  error
handler,  FORER.   OCUU  calls  SIMDDT after determining the
location of the error  or  breakpoint.   Illegal  UUO's  are
handled as special error messages.

Entry conditions: .JBUUO contains the UUO instruction,  with
the  effective  address  in  bits  18-35  and  the index and
indirect fields reset to zero.  .JB41 has  been  set  up  to
contain  PUSHJ  XPDP,OCUU.   The  top of the XPDP stack thus
points to the instruction after the  UUO,  since  .JB41  was
effectively   XCT'ed   by  the  monitor  UUO  routine.   All
registers are as they were at the interrupt.

Function
--------
All ac's are saved in the YUUOAC area of the low segment.
1) For a BREAK UUO, SIMDDT  is  called  (entry  DSINB).   If
SIMDDT  was  not present, however, an "Illegal UUO executed"
error message will be issued.
2) For the RTSERR UUO, the error number is placed in  YDSENR
and  the code address in YDSEAD before invoking SIMDDT.  The
error number is taken from the UUO  instruction  in  .JBUUO.
The  error address is taken from the stack if only one level
exists.  In that case the error occurred at code  level  and
the  address  is  that  after  the  error UUO.  If the error
occurred inside the RTS, more than one level should exist on
the  stack.   OCCAD looks for a PUSHJ within a few locations
before the address found at the stack bottom.   This  is  to
take  care  of  any  inline parameters.  If SIMDDT is not in
core already, it is brought in by OCLD,  provided  space  in
the  storage  pool  (possibly  after garbage collection or a
CORE request).  If space could not be obtained  for  SIMDDT,
the  error  number is given in an inline message to the TTY,
otherwise SIMDDT is called to give  the  message  and  allow
examination   of  storage.   SIMDDT  returns  via  the  EXIT
command.  After handling the  error,  program  exit  is  via
OCEP.
3) The RFAI UUO may be issued if the RTS finds itself  in  a
state  which  should not be possible.  This is recorded as a
special error message.
4) If OCUU does not  recognize  the  UUO  opcode,  an  error
message  stating  that an illegal UUO has been executed will
be issued.
;

	X17==17
;***AUBEG
	RETADR=0
	X1SAVE=1
	X2SAVE=2
	X3SAVE=3
	X4SAVE=4
	X5SAVE=5
	QDFAD=<<DFAD>_<-^D27>>

	%N=0	;Number of items on stack

.OCUU:	PROC
	IFN	QKA10,< ;Insert code to handle KA10 UUO's

	STACK	X1
	%N=%N+1
	LDB	X1,[POINT  9,.JBUUO,8]
	IF	;Independent UUO
		CAIN	X1,033		;This code isn't assigned
		GOTO	TRUE
		CAIL	X1,QDFAD
		GOTO	FALSE
	THEN
		UNSTK	X1
	> 	;END IF KA10
;***AUEND

		SETLOW	(X16)
		SAVEALLACS

		CLEARO
		HLRZ	.JBUUO		;Get UUO code
					edit(41)
		TRZ	777		;[41] Zero continuation code
		IF	;BREAKPOINT UUO
			CAIE	(BREAK)
			GOTO	FALSE
		THEN
			SKIPN	XDBAS,YDSBAS(XLOW)
			GOTO	FALSE	;Let error occur if SIMDDT not present
			EXEC	QDSINB(XDBAS)
			BRANCH	OCEX
		FI
		L	X1,(X17)	;Address of next instr
		IF	;RTS ERROR UUO
			CAIE	(RTSERR)
			GOTO	FALSE
		THEN	;It probably was a proper error
			L	.JBUUO		;Error number [41] and cont. code
			TLZ	X0,777000	;[41] Zero op code
L1():!			ST	YDSENR(XLOW)
			HRRZM	X1,YDSEAD(XLOW)
	
			IFN	INLINE,<
			RTEXT	(SIMULA RTS Error ZYQ)
			OUTOCT
			L	X1
			TEXT	( at PC = )
			ROT	-9	;First 3 digits of address
			OUTOCT
			ROT	9	;Last 3 digits
			OUTOCT
			TEXTR	( )
			HLRZ	(X1)	;Instruction after UUO
			IF	;A message may exist
				CAIN	(NOP)
				CAIE	(RFAI)
				GOTO	FALSE
			THEN	;Type it to TTY
				EXEC	TYPMSG
				TYPR	( )
			FI
			>
			LI	-1(X17)
			EXEC	OCCAD	;Skip if code address not found
			ST	X1,YDSEAD(XLOW)
	
			;;*** CALL SIMDDT HERE ***;;
			IF	;SIMDDT can be found
				EXEC	.OCLD
				GOTO	TRUE
				GOTO	FALSE
			THEN
				IF	;[41] Skip return for continuation after error
					EXEC	QDSINE(XDBAS)
					GOTO	FALSE
				THEN
								edit(241)
					LOWADR	X1		;[241]
								edit(123)
					SETOFF	SWNOGC(XLOW)	;[123]
							edit(41)
					GOTO	OCEX	;[41] Return to continue
				FI
	
			ELSE	;Write message number inline
				IFE	INLINE,<
						edit(241)
				LOWADR	X1	;[241]
				RTYP	(?ZYQREZ SIMULA RTS Error ZYQ)
				L	YDSENR(XLOW)
				OUTOCT
				TYPR	( )
				>
			FI
		ELSE
			IF	CAIE	(RFAI)
				GOTO	FALSE
			THEN
				RTEXT	(RTS logic error: )
				LI	QRFAIL
				SOJA	X1,L1
			ELSE
				TEXT	( Illegal UUO executed)
				LI	QILLUUO
				GOTO	L1
		FI	FI
		PUSH	X17,[.OCEP]	;Will exit as normally as possible
OCEX:		LOWADR	X1		;[241]
		MOVSI	X14,YUUOAC(XLOW);[241] XCB, XIAC restored by SIMDDT
		BLT	X14,X14		;[241]
		RETURN
		IFN	INLINE,<
L2():!		CLEARO
			TEXTR	<
type C to continue, U to take a dump and exit directly, E to exit directly,
F to close files and exit from program, S to enter SIMDDT, T to enter DDT>
		INCHRW	X0
		TRZ	40
		IF	CAIN	X0,"C"
			GOTO	FALSE
		THEN
		IF
			CAIE	X0,"D"
			GOTO	FALSE
		THEN	;Take a core dump
			L	[XWD 6,DCOREL]
			DAEMON
		ELSE
		IF	CAIE	X0,"F"
			GOTO	FALSE
		THEN	PUSH	X17,[.OCEP]
		ELSE
		IF	CAIE	X0,"S"
			GOTO	FALSE
		THEN	EXEC	.OCLD
			EXEC	QDSINE(XDBAS)
		ELSE
		IF	CAIE	X0,"T"
			GOTO	FALSE
		THEN	HRRZ	.JBDDT
			IF	JUMPE	FALSE
			THEN
				RTEXTR	(DDT entered)
				PUSH	X17,
			ELSE
				RTEXTR	(DDT not available)
				GOTO	L3
			FI
		ELSE
L3():!			PUSHJ	X17,OCEX
			EXIT	1,
			GOTO	L2
		FI	FI	FI	FI	FI
DCOREL:		1
		EXP	0,0,0,0,0
	

TYPMSG:		HRRZ	X1,(X1)
		IF	;X1 has a usable address
			LEGAL
			GOTO	FALSE
			CAIGE	X1,140	;Should not be in JOBDAT area or in ac's
			GOTO	FALSE
		THEN	;Go ahead and type it
			OUTSTR	(X1)
		FI
		RETURN
		>
;***AUBEG
	IFN	QKI10,<
	EPROC

	LIT
	END
	>	;END OCEP IF KI10
	IFN	QKA10,<

	ELSE	;It is a KA10 only UUO

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

	AUTHOR:		DAVID MARTIN, THE UNIVERSITY OF WESTERN ONTARIO
			UPDATED AT ACADIA UNIVERSITY FOR KA10

	PURPOSE:	TO SIMULATE EXECUTION TIME OCCURRENCES OF
			FIX, FIXR, FLTR, DMOVxx, DFAD,DFSB,DFMP,DFDV
			INSTRUCTIONS IN SIMULA PROGRAMS AND RUNTIME
			ROUTINES.

			FOR DOUBLE PRECISION OPERANDS, KA-10 SOFTWARE
			FORMAT IS USED.

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

	SUBTTL	KA UUO MAIN ROUTINE


		STACK	X2
		%N=%N+1
		STACK	X3
		%N=%N+1
		STACK	X4
		%N=%N+1
		STACK	X5
		%N=%N+1
		NN=%N+1
		HRRZ	X4,.JBUUO
		EXEC	UUOTAB-QDFAD(X1)
		UNSTK	X5
		UNSTK	X4
		UNSTK	X3
		UNSTK	X2
		UNSTK	X1
		RETURN
	FI
	EPROC

	SUBTTL	UTILITY ROUTINES TO ACCESS UUO'S AC AND MEMORY LOCATION

COMMENT ;
	THESE ROUTINES ARE DEPENDENT ON THE NUMBER OF ITEMS ON THE  XPDP
	STACK.  IN PARTICULAR, THE SAVED COPIES OF THE USER'S AC'S
	X1 THROUGH X5 ARE EXPECTED TO BE IN PARTICULAR LOCATIONS WITH
	RESPECT TO THE TOP OF THE STACK.
	;

GET.AC:	; GET USER'S AC DATA ITEM INTO X1
	LDB	X1,P.AC40	; GET AC IN UUO
	L	X1,@ACTAB(X1)	; GET THE DATA
	RETURN


GET.E:	; GET THE MEMORY OPERAND INTO X1
	; EFFECTIVE ADDRESS OF UUO IS IN X4 ON ENTRY
	CAIG	X4,17		; IS IT AN AC?
	SKIPA	X1,@ACTAB(X4)	; YES
	L	X1,(X4)		; NO
	RETURN


GT2.AC:	; GET DOUBLE LENGTH AC OPERAND TO X1-X2
	LDB	X2,P.AC40
	LD	X1,@ACTAB(X2)
	RETURN


GT2.E:	; GET DOUBLE LENGTH MEMORY OPERAND TO X1-X2
	; ADDRESS IN X4 ON ENTRY
	IF
		CAIG	X4,17
		GOTO	FALSE
	THEN
		LD	X1,0(X4)
	ELSE
		LD	X1,@ACTAB(X4)
	FI
	RETURN


PUT.AC:	; PUT DATA IN X1 IN THE AC OF THE UUO
	LDB	X2,P.AC40
	ST	X1,@ACTAB(X2)
	RETURN


PT2.AC:	; PUT X1-X2 INTO USER'S AC'S
	LDB	X3,P.AC40
	STD	X1,@ACTAB(X3)
	RETURN


PT2.E:	; PUT DOUBLE LENGTH ITEM IN X1-X2 INTO USER'S MEMORY LOCATION
	HRRZ	X3,.JBUUO
	IF
		CAIG	X3,17
		GOTO	FALSE
	THEN
		STD	X1,0(X3)
	ELSE
		STD	X1,@ACTAB(X3)
	FI
	RETURN
	SUBTTL	SIMULATION OF INSTRUCTIONS

%%DFAD:	PROC
	%N=NN
	EXEC	GT2.E		; GET MEMORY OPERAND
DFAD.1:	LD	X4,X1		; COPY TO X4-X5
	EXEC	GT2.AC		; GET REGISTERS
	UFA	X2,X5
	JFCL	IFJFCL
	FADL	X1,X4
	JFCL	IFJFCL
	UFA	X2,X3
	FADL	X1,X3
	EXEC	PT2.AC
	RETURN
	EPROC


%%DFSB:	PROC
	%N=NN
	EXEC	GT2.E
	DFN	X1,X2
	JFCL	IFJFCL
	GOTO	DFAD.1
	EPROC


%%DFMP:	PROC
	%N=NN
	EXEC	GT2.E
	LD	X4,X1
	EXEC	GT2.AC
	L	X3,X1
	FMPR	X3,X5
	JFCL	(2)
	FMPR	X2,X4
	JFCL	(2)
	UFA	X2,X3
	JFCL	IFJFCL
	FMPL	X1,X4
	JFCL	IFJFCL
	UFA	X2,X3
	FADL	X1,X3
	JFCL	IFJFCL
	EXEC	PT2.AC
	RETURN
	EPROC


%%DFDV:	PROC
	%N=NN
	EXEC	GT2.E
	LD	X4,X1
	EXEC	GT2.AC
	FDVL	X1,X4
	JFCL	IFJFCL
	MOVN	X3,X1
	FMPR	X3,X5
	JFCL	(2)
	UFA	X2,X3
	FDVR	X3,X4
	FADL	X1,X3
	JFCL	IFJFCL
	EXEC	PT2.AC
	RETURN
	EPROC


%%DMVE:	PROC
	%N=NN
	EXEC	GT2.E
	EXEC	PT2.AC
	RETURN
	EPROC


%%DMVN:	PROC
	%N=NN
	EXEC	GT2.E
	DFN	X1,X2
	JFCL	IFJFCL
	EXEC	PT2.AC
	RETURN
	EPROC


%%FIX:	PROC
	%N=NN
	EXEC	GET.E
	MOVM	X2,X1
	JFCL	IFJFCL
	MULI	X2,400
	ASH	X3,-243(X2)
	JFCL	IFJFCL
	JUMPL	X1,.+2
	SKIPA	X1,X3
	MOVN	X1,X3
	EXEC	PUT.AC
	RETURN
	EPROC


%%ERR:	PROC
	; Could never get here
	EPROC


%%DMVM:	PROC
	%N=NN
	EXEC	GT2.AC
	EXEC	PT2.E
	RETURN
	EPROC


%%DMNM:	PROC
	%N=NN
	EXEC	GT2.AC
	DFN	X1,X2
	JFCL	IFJFCL
	EXEC	PT2.E
	RETURN
	EPROC


%%FIXR:	PROC
	%N=NN
	EXEC	GET.E
;***AUBEG
;A BUG WAS FOUND IN UWO'S FIXR ROUTINE SO
;WAS RECODED AS FOLLOWS:
	FAD	X1,[0.5]
	MULI	X1,400
	EXCH	X1,X2
	TSC	X2,X2
	ASH	X1,-243(X2)
	JFCL	IFJFCL
;***AUEND
	EXEC	PUT.AC
	RETURN
	EPROC


%%FLTR:	PROC
	%N=NN
	EXEC	GET.E
	IDIVI	X1,400000
	CAIE	X1,0
	TLC	X1,254000
	TLC	X2,233000
	FADR	X1,X2
	EXEC	PUT.AC
	RETURN
	EPROC
	SUBTTL	TRAP ROUTINE

COMMENT ;
	ALL ARITHMETIC TRAPS DURING KA UUO PROCESSING WILL COME HERE
	AFTER THE PROCESSING BY .OCTR.
	WE MUST SEE IF THE UUO WAS FOLLOWED BY A JFCL INSTRUCTION.  IF
	 THE JFCL HAD A NON-ZERO ADDRESS FIELD RETURN TO THAT ADDRESS,
	IF THE ADDRESS FIELD WAS ZERO, RETURN TO THE JFCL BUT IF NO JFCL
	WAS PRESENT THEN DUMMY UP TRAP TO .OCTR WITH NO JFCL FOLLOWING.
	;

IFJFCL:	PROC
	%N=NN
	HRRZ	X5,RETADR-%N(XPDP)	; GET ADDRESS OF UUO+1
	STACK	X1
	%N=%N+1
	LDB	X1,[POINT  9,0(X5),8 ]
	IF
		CAIN	X1,<<JFCL>_<-^D27>>
		GOTO	FALSE
	THEN
		HRRM	X5,.JBTPC
		BRANCH	@.JBAPR
	FI
	HRRZ	X1,(X5)		; GET ADDRESS IN JFCL
	JUMPE	X1,.+2		; IF NON-ZERO ...
	HRRM	X1,RETADR-%N(XPDP)	; RETURN TO THAT ADDRESS
	UNSTK	X1
	RETURN	; TO USER VIA UUO MAIN LINE
	EPROC
	SUBTTL	UUO DISPATCH TABLE AND AC ADDRESSING TABLE

UUOTAB:
	GOTO	%%DFAD	; 024
	GOTO	%%DFSB	; 025
	GOTO	%%DFMP	; 026
	GOTO	%%DFDV	; 027
	GOTO	%%DMVE	; 030
	GOTO	%%DMVN	; 031
	GOTO	%%FIX	; 032
	GOTO	%%ERR	; 033
	GOTO	%%DMVM	; 034
	GOTO	%%DMNM	; 035
	GOTO	%%FIXR	; 036
	GOTO	%%FLTR	; 037


	%N=NN+1
ACTAB:
	Z	X0
	Z	X1SAVE-%N(XPDP)
	Z	X2SAVE-%N(XPDP)
	Z	X3SAVE-%N(XPDP)
	Z	X4SAVE-%N(XPDP)
	Z	X5SAVE-%N(XPDP)
	Z	X6
	Z	X7
	Z	X10
	Z	X11
	Z	X12
	Z	X13
	Z	X14
	Z	X15
	Z	X16
	Z	XPDP
	Z	XPDP+1
	SUBTTL	LITERALS AND CONSTANTS

P.AC40:	POINT	4,.JBUUO,12

	LIT
	END
	>	;END OCEP IF KA10
;***AUEND