Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/16/ocep.mac
There are 2 other files named ocep.mac in the archive. Click here to see a list.
SUBTTL OCEP Overall SIMULA program control
Comment;
Written Feb 1974 by Lars Enderin, revised Nov 1974
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
RET
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]
RET
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
edit(303)
SKIPE X1,.JBREN ;[303] Leave zero in .JBREN
LI X1,@1(X1) ;[303]
ST X1,.JBREN ;[303]
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)
RET ;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
RET ;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
IOR X1,[DMOVE 0,[EXP <377777,,-1>,<377777,,-1>]]
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)
CAILE X1,177
BRANCH TJFCL1 ;Possibly XCT
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
.OCUU: PROC
SETLOW (X16)
SAVEALLACS
CLEARO
HLRZ .JBUUO ;Get UUO code
edit(41)
TRZ X0,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
>
EPROC
LIT
END