Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0078/rts/ocsp.old
There are no other files named ocsp.old in the archive.
00100 SUBTTL OCSP - Start a SIMULA program
00200 SUBTTL Lars Enderin /LE/ 11-Oct-1972
00300
00400 X17=17
00500 .JBREN=124
00600 .JBOPS=135
00700 SEARCH SIMMAC,SIMMCR,SIMRPA
00800
00900 SALL
01000 RTITLE OCSP
01100
01200 INTERN OCSPVR
01300
01400
01500 edit(303)
01600 OCSPVR==VERRTS ;[303]
01700
01800 EXTERN .JBFF,.JBOPC,.JBREL,.JBSA
01900 EXTERN .MAIN,.MAINL
02000
02100
02200
02300 LOC .JBOPS
02400 BYTE (6)1(12)VSIMRT(18)0
02500
02600 LOC .JBREN
02700 Z .OCRE0
02800
02900 MACINIT
03000
03100 IF1,<
03200 IFNDEF QNHGH,<;[225]
03300 IFN QDEC20,<QNHGH==1>
03400 IFE QDEC20,<QNHGH==2>
03500 >
03600 IFE QNHGH,<QNHGH==1>
03700 QRTHGH==SIXBIT/SIMR00/+VSIMRT_6
03800 IFE <QNHGH-2>,<QRTHGH==QRTHGH+2>
03900 >
00010 Comment;
00020
00100 .OCSP (start program)
00200
00300 Purpose
00400 -------
00500 To set up the environment for a SIMULA program. Called by a SIMULA
00510 main program at its entry point.
00700
00800 Input conditions
00900 ----------------
01000 XCB = outermost program block address. X1 = 0 or address of area
01010 where SIMDDT is (to be) loaded. According to the calling sequence:
01300 JSP XFP,.OCSP
01400 JFCL runswitches address
01500 the address of a file specification string is passed as an inline
01510 parameter following a JSP.
01700
01800 Function
01900 --------
02000 If X1 = 0, load X1 from YOCDDT, which is non-zero if SIMDDT
02100 was loaded at a previous program start or reenter after GET
02200 or LOAD. If X1 was non-zero, save it in YOCDDT for future
02300 use. To guard against any breakpoint UUO's being left
02400 around from a possible call on SIMDDT in the previous
02500 execution, call OCSPDR, which makes sure there are no
02600 breakpoints left. Save all accumulators in dynamic core.
02700 GETSEG SIMRTS, if it was not loaded together with the object
02800 code from the SIMULA compilation. If .OCSP was loaded, but
02900 not SIMRTS, .JBOPS left half will be non-zero as a result of
03000 a direct assignment in the OCSP module. SIMRTS, which must
03100 be loaded after .OCSP, sets .JBOPS to zero at load time. At
03200 load time, define the reentry point (.JBREN) as the address
03300 of the code used to load SIMDDT.
03400 Clear the static area. Initialize lookup and GETSEG info for
03500 SIMDDT and the high segments. Set X2 to the address of
03600 .YXAC (first pseudo ac), X3 = address (.MAINL) of the main
03700 program line number table. When the selected run time
03800 system is safely in core, pass control to .OCIN in SIMRTS by
03900 a JRST instruction. .OCIN will finish the initialization
04000 needed to start a SIMULA program.
04100
04200 Exit conditions
04300 ---------------
04400 All registers are saved in YACSAV[0-17](XLOW) as they were
04500 on entry to OCSP. X2 contains the address of the first
04600 pseudo ac location. X3 = .MAINL, the address of the main
04700 program line number table.
04800 X4 = address of .OCGS. The saved X16 value gives the
04900 return to object code after RTS initialization, and the
05000 saved value of X1 indicates where SIMDDT is (to be) loaded,
05100 if it was requested by REENTER or the DEBUG command. The
05200 cell .JBOPS has the address of the low segment STATIC area,
05300 which is to be addressed via the register XLOW designated by
05400 the LOWADR and SETLOW macros. Exit from OCSP is via a
05500 branch to OCIN, which will eventually branch to OCEI, that
05600 returns to object code.
05700
05800 Error exits
05900 -----------
06000 If GETSEG of the high segment fails, return to monitor level
06100 with monitor message Cannot GET SIMR??. If CORE
06200 is scarce, EXIT 1, after ZYQNEC message. If the core limits
06300 can be increased, CONTINUE will cause the core request to be
06400 re-issued.
06410 ;
00100 SUBTTL .OCSP - Routine to get the SIMULA RTS high segment
00200
00300 RELOC 0
00400 ENTRY .OCSP ;Main entry from a SIMULA main program to initialize RTS
00500
00600 edit(242)
00700 .OCSP: L X10,XFP ;[242] Save return for OCIN
00800 SKIPN X1
00900 SKIPN X1,YOCDDT
01000 ST X1,YOCDDT ;Save SIMDDT base or zero
01100 JSR OCSPDR ;Reset any breakpoints in code
01200 LI .OCRE1 ;Change reentry point
01300 edit(303)
01400 SKIPE .JBREN ;[303] If it was not set, leave it
01500 ST .JBREN ; undefined
01600 RESET ;Reset all software channels
01700 ;and set .JBFF = .JBSA<LH>
01800 HRRZ X17,.JBFF ;Get first free lowseg location
01900 HRRM X17,.JBOPS ;Save as a base for STATIC area
02000 LI X17,YLOW ;Space at least for STATIC area
02100 ADDB X17,.JBFF ;Update .JBFF
02200 ADDI X17,QPOLMI+1000
02300 IF ;Additional core is needed
02400 CAMG X17,.JBREL
02500 GOTO FALSE
02600 THEN ;try to get it
02700 CORE X17,
02800 GOTO RESERR ;Hard luck, must quit
02900 FI
03000 SETLOW ;Standard base reg XLOW
03100 L XLOW,.JBOPS ;Get base of STATIC area and left flags
03200 ; - Clear STATIC area -
03300 HRRI X2,YACSAV+21(XLOW)
03400 HRLI X2,-1(X2)
03500 SETZM YACSAV+20(XLOW)
03600 BLT X2,@.JBREL
03700 ST X1,YDSBA1(XLOW) ;[242]
03800 ST XCB,YOCXCB(XLOW) ;[242]
03900 ;Initialize GETSEG-LOOKUP info
04000 edit(225)
04100 TOPS10,<;[225]
04200 L [QDEPPN]
04300 ST YDEPPN(XLOW)
04400 L [QHEPPN]
04500 ST YHEPPN(XLOW)
04600 L [QRTPPN]
04700 ST YRTPPN(XLOW)
04800 >
04900 L [QSYSDEV]
05000 ST YOCDEV(XLOW)
05100 edit(277)
05200 IF ;[277] No hiseg or not correct initial hiseg
05300 L [-2,,.GTPRG] ;[277] Get hiseg name
05400 GETTAB
05500 GOTO TRUE ;No hiseg
05600 JUMPE FALSE ;Hiseg from same file as lowseg
05700 CAMN [QRTHGH]
05800 GOTO FALSE ;Correct hiseg already
05900 HRROI X1,.GTPRG ;Lowseg name
06000 GETTAB X1,
06100 GOTO TRUE
06200 CAMN X1 ;Load if not same as hiseg
06300 GOTO FALSE
06400 THEN ;GETSEG initial hiseg
06500 L X1,[QRTHGH]
06600 ST X1,YRTHGH(XLOW)
06700 ST X10,YACSAV+X10(XLOW) ;[242]
06800 JSR .OCGS
06900 L X10,YACSAV+X10(XLOW) ;[242]
07000 ELSE ;[277] May have to use SETUWP to avoid store traps
07100 edit(277)
07200 LI X2,.MAIN
07300 IF ;Main prog in hiseg
07400 CAIG X2,400K
07500 GOTO FALSE
07600 THEN ;Remove write protection
07700 SETZ X2,
07800 SETUWP X2,
07900 CAI ;Ignore error ret (take a chance)
08000 FI FI
08100 HRRZS XLOW,.JBOPS ;[242] Clear .JBOPS<LH> to show hiseg loaded
08200 LI X2,.YXAC ;First pseudo ac location
08300 LI X3,.MAINL ;Line number table for SIMDDT
08400 LI X4,.OCGS
08500 IFN QDEBUG,<
08600 OCINIT::
08700 >
08800 BRANCH OCIN ;Do rest of initialization
08900
09000 RESERR: CLEARO
09100 OUTSTR [ASCIZ/
09200 ?ZYQNCA No core available - can not proceed
09300 /]
09400 EXIT 1,
09500 GOTO .OCSP ;Try again if CONTINUE command given
00100 SUBTTL OCGS - Get a high segment; [1C]
00200
00300 Comment;
00400
00500 Purpose: To GETSEG a high segment initially or at segment swap
00600
00700 Entry conditions:
00800 X1 = SIXBIT name of wanted hiseg. Standard XLOW loaded.
00900
01000 Call: By JSR .OCGS or JSR @YOCGS(XLOW)
01100
01200 Function: Prevent REENTER by changing .JBREN.
01300 Clear any previously loaded hiseg by CORE.
01400 Try to GETSEG the high segment from YOCDEV(XLOW) with ppn=0.
01500 If that fails, try same device with ppn=YOCPPN(XLOW).
01600 On failure, the monitor gives an error message because of
01700 the HALT placed after the last GETSEG.
01800
01900 Exit: To saved return address with new high segment loaded.
02000
02100 Error exit: To monitor on final GETSEG failure.
02200
02300 ;
02400
02500 SETLOW ;Use standard XLOW
02600 .OCGS:: BEGIN
02700 Z ;Call by JSR
02800 ST X1,YOCHNM(XLOW) ;Hiseg name
02900 LI .OCRE1 ;Save and change .JBREN
03000 EXCH .JBREN
03100 ST YOCREN(XLOW)
03200 MOVSI X1,1 ;Set flag to clear any previously loaded hiseg
03300 CORE X1,
03400 NOP ;Ignore errors
03500 SETZM YOCPPN(XLOW) ;Try own area or sys first
03600 LI X1,YOCGSB(XLOW)
03700 GETSEG X1, ;Get the high segment
03800 SKIPA
03900 GOTO L9 ;Found first time
04000 LOWADR
04100 L X1,YRTPPN(XLOW);Try standard ppn if not found on own area
04200 ST X1,YOCPPN(XLOW)
04300 LI X1,YOCGSB(XLOW)
04400 GETSEG X1,
04500 HALT ;Give up, cannot find requested hiseg
04600 L9():! LOWADR
04700 L YOCREN(XLOW) ;Restore .JBREN
04800 EXCH .JBREN
04900 BRANCH @.OCGS
05000 ENDD
00100 SUBTTL OCSPDR - CALL SIMDDT TO REMOVE BREAKPOINTS
00200
00300 Comment;
00400
00500 This routine is called at start of a SIMULA program to ensure
00600 that no old breakpoint instructions are left in the compiled
00700 code from an earlier (dynamic) invocation of SIMDDT. This is
00800 possible if this is a START or REENTER of a program which was
00900 started once before since the last LOAD or GET (etc.) command.
01000 ;
01100
01200 OCSPDR: Z ;NOTE! called by JSR!
01300 HRRZ .JBOPS
01400 IF ;Non-zero address
01500 JUMPE FALSE
01600 THEN ;RTS initialized already (restart implied)
01700 STACK XLOW
01800 LOWADR
01900 SKIPE XDBAS,YDSBAS(XLOW)
02000 EXEC QDSINS(XDBAS) ;remove breakpoints
02100 ; (and perhaps other things)
02200 L X1,YOCDDT
02300 UNSTK XLOW
02400 FI
02500 BRANCH @OCSPDR ;RETURN
00100 SUBTTL REENTRY POINTS
00200
00300 Comment;
00400
00500 The reentry point entries are arranged as is seen below because
00600 the standard reentry point (.OCRE) or the initial reentry point
00700 (.OCRE0) may be manipulated from the high segment. No matter
00800 which reentry point is in effect, and even if the RTS is not at
00900 all initialized, the standard reentry point can always be found
01000 via the current .JBREN contents + 1 . The initial reentry point
01100 can then be found at the address before the standard reentry
01200 point.
01300 ;
01400
01500 Z .OCRE0 ;Initial reenter address
01600 .OCRE: GOTO OCRE ;Standard reenter address
01700 LI .OCRE
01800 .OCRE0::GOTO OCRE0
01900 LI .OCRE
02000 .OCRE1::GOTO OCRE1
02100 LI .OCRE
02200 .OCRE2::GOTO OCRE2
02300 LI .OCRE
00100 SUBTTL OCRE - main routine for REENTER
00200
00300 Comment;
00400
00500 Purpose: At REENTER, to load and call SIMDDT when allowed
00600 (YDSCSW=0), to prepare for deferred REENTER
00700 (YDSCSW>0), or write a message (YDSCSW<0).
00800
00900 Entry conditions:
01000 .JBOPC is assumed to contain the interrupt
01100 address from a ^C (may be faked via OCRET).
01200 YDSCSW governs the action. .JBOPS right half
01300 contains the address of the STATIC low segment
01400 area. No assumptions are made about the contents
01500 of accumulators, but the RTS is assumed to be
01600 active.
01700
01800 Exit conditions:
01900 Depending on the value of YDSCSW at entry, the
02000 following conditions hold on exit:
02100 YDSCSW = 0 - SIMDDT was loaded if necessary and
02200 called. Apart from the space occupied by SIMDDT
02300 if loaded dynamically, the storage pool is not
02400 changed. Values of some variables may have been
02500 changed via SIMDDT commands. The registers are
02600 restored as they were on entry.
02700 YDSCSW > 0 - YOBJRT (stack bottom) is changed
02800 so that instead of returning to compiled code,
02900 the final return from the RTS routine called
03000 from the program is to OCRET. YDSCAD has the
03100 old value of YOBJRT. YDSCSW < 0 on exit, i e
03200 interruptions are prevented until OCRET is
03300 reached. Other storage cells and the ac's are
03400 preserved as on entry.
03500 YDSCSW < 0 - no change in registers or data.
03600
03700 Function: Save all ac's in the area starting at offset
03800 YUUOAC of the STATIC area. Stack .JBOPC as
03900 return address. Change .JBREN to prevent OCRE
04000 to be entered when active. If YDSLOAD is zero,
04100 the RTS is not yet equipped to handle SIMDDT
04200 dynamically. Just continue with a message in
04300 this case.
04400 If REENTER is forbidden (YDSCSW < 0), type a
04500 message and continue with restored registers.
04600 If REENTER is deferred (YDSCSW > 0), change
04700 stack bottom to point to OCRET, save old stack
04800 bottom in YDSCAD, copy any inline parameter to
04900 OCRET-1, forbid REENTER and continue with the
05000 ac's restored.
05100 If YDSCSW is zero, set switch to prevent
05200 garbage collection in SIMDDT, load SIMDDT, call
05300 the DSINR entry, reset the g c switch, restore
05400 ac's and return.
05500 ;
00100 OCRE: PROC
00200 SAVEALLACS
00300 LOWADR
00400 STACK .JBOPC ;Fake return
00500 EXCH .JBREN ;Divert REENTER to another entry point
00600 LI .OCRE2
00700 EXCH .JBREN
00800 IF ;RTS set up to handle SIMDDT dynamically
00900 SKIPN YDSLOAD(XLOW)
01000 GOTO FALSE
01100 THEN ;See if SIMDDT can be called
01200 edit(41)
01300 SETON YDSSUP(XLOW) ;[41] suppress current SIMDDT command if possible
01400 IF ;Inhibiting switch is zero
01500 SKIPE YDSCSW(XLOW)
01600 GOTO FALSE
01700 THEN ;We may stop right now and call SIMDDT
01800 HRROS YDSCAD(XLOW) ;Mark .OCRE entry
01900 SETON SWNOGC(XLOW) ;Prevent garbage collection
02000 EXEC @YDSLOAD(XLOW) ;Load SIMDDT
02100 SETOFF SWNOGC(XLOW) ;[41]
02200 EXEC QDSINR(XDBAS) ;Call DSINR entry
02300 edit(242)
02400 SETOFF SWNOGC(XLOW) ;[242] [41]
02500 ELSE
02600 IF ;REENTER should be deferred
02700 SKIPG YDSCSW(XLOW)
02800 GOTO FALSE
02900 THEN ;Prepare for call to SIMDDT at return point
03000 LI OCRET
03100 ;Check for inline param - must be copied
03200 HRRZ X2,X17 ;Current stack location
03300 CAIG X2,YOBJRT(XLOW) ;If at code level, cannot stop
03400 RFAIL YDSCSW inconsistent
03500 HRRZ X2,YOBJRT(XLOW) ;Code return address
03600 MOVM X1,(X2)
03700 IF ;left half was a small neg or pos number
03800 TLNE X1,(777B8)
03900 GOTO FALSE
04000 THEN ;Copy inline param
04100 L X1,(X2)
04200 AOS X2 ;Account for the parameter
04300 ST X1,OCRET-1
04400 LI OCRET-1
04500 FI
04600 ST YOBJRT(XLOW)
04700 ST X2,YDSCAD(XLOW)
04800 edit(124)
04900 IF ;[124] Stopped in input wait
05000 L X2,@.JBOPC
05100 CAME X2,[XCT 1]
05200 GOTO FALSE
05300 MOVSI (777B8)
05400 AND YUUOAC+X1(XLOW)
05500 CAME [IN]
05600 GOTO FALSE
05700 THEN ;Tell the user to input a line
05800 OUTSTR [ASCIZ/
05900 [ZYQPID Please input a line of data so SIMDDT can be entered]
06000 /]
06100 FI ;[124]
06200 HRROS YDSCSW(XLOW) ;Inhibit ^C-REENTER
06300 GOTO L9
06400 ELSE
06500 OUTSTR [ASCIZ/
06600 [ZYQCSH Cannot stop here]/]
06700 FI FI FI
06800 OUTSTR [ASCIZ/ ... continuing ...
06900 /]
07000 L9():! LI .OCRE ;Reinstate ordinary REENTER
07100 ST .JBREN
07200 MOVSI X16,YUUOAC(XLOW) ;Restore all registers before returning
07300 BLT X16,X16
07400 RETURN
07500 EPROC
00100 Comment; This routine is in effect interposed between the SIMULA
00200 program and the RTS when a ^C-REENTER sequence is issued
00300 inside a RTS routine which cannot be interrupted just anywhere,
00400 but which has a definite return point to compiled code.
00500 This return point was found at the stack bottom (YOBJRT), which
00600 was modified to point to OCRET or to the cell before, which
00700 has a copy of any inline parameter. The original contents of
00800 YOBJRT was saved in YDSCAD(XLOW). OCRET fakes a
00900 ^C-REENTER sequence issued at the return point.
01000 ;
01100
01200 NOP ;Copy of inline param if any
01300 OCRET: SETLOW
01400 EXCH XLOW,.JBOPS ;Provide addressing for STATIC area
01500 ST .JBOPC ;Save X0
01600 L YDSCAD(XLOW) ;Where to return from SIMDDT
01700 EXCH .JBOPC ;Restore X0, fake ^C address
01800 SETZM YDSCSW(XLOW) ;Allow ^C-REENTER
01900 EXCH XLOW,.JBOPS ;Restore XLOW and .JBOPS
02000 BRANCH .OCRE ;Fake REENTER
00100 SUBTTL OCRE0 - initial reentry point
00200
00300 Comment;
00400
00500 Entry conditions:
00600 OCRE0 is entered via REENTER or directly
00700 from LINK-10 after loading. The SIMULA
00800 program either has not yet been started or
00900 has completed execution via OCEP.
01000
01100 Function: Change .JBREN to .OCRE1. If YOCDDT is
01200 non-zero, SIMDDT is assumed to be in core
01300 at the address given there. X1 is loaded
01400 with the address and the SIMULA program is
01500 entered at its secondary entry point
01600 (.MAIn+2). If YOCDDT was zero, call OCSPDR
01700 to remove any breakpoints which may be left
01800 around since a previous dynamic invocation
01900 of SIMDDT. RESET channels and .JBFF to
02000 start over with fresh core. Reserve space
02100 for SIMDDT (CORE UUO if necessary) and
02200 record its address in X1, setting the left
02300 half to -1 to signal deferred SIMDDT load.
02400 Clear the first word reserved to show that
02500 SIMDDT is not yet in. Change .JBFF and
02600 .JBSA(LH) so that a subsequent RESET does
02700 not free the space set aside for SIMDDT.
02800
02900 Exit: To start of compiled main program (.MAIN+2)
03000 with X1 = SIMDDT address.
03100
03200 Error exit: To .MAIN (primary entry for main program)
03300 with error message.
03400 ;
00100 OCRE0: PROC ;Used before start of program
00200 LI .OCRE1 ;Provisional reentry point until RTS ready
00300 ST .JBREN
00400 LI .MAIN
00500 HRRM .JBSA
00600 SKIPE X1,YOCDDT ;If SIMDDT is in core, just get its address
00700 BRANCH .MAIN+2
00800 JSR OCSPDR ;Remove any old breakpoints
00900 RESET
01000 ;Reserve space for SIMDDT now, read it in OCEI
01100 HLRO X1,.JBSA ;SIMDDT base in right half, neg left half
01200 ;signals deferred load
01300 LI X2,QDSLG
01400 ADDB X2,.JBFF
01500 IF ;No room
01600 CAMG X2,.JBREL
01700 GOTO FALSE
01800 THEN
01900 CORE X2,
02000 GOTO L9
02100 FI
02200 SETZM (X1) ;Flag SIMDDT not yet in
02300 L X2,.JBFF
02400 HRLM X2,.JBSA ;Reserve the space over start command
02500 BRANCH .MAIN+2
02600 L9():! OUTSTR [ASCIZ/
02700 %ZYQNEC Not enough core. Cannot load SIMDDT
02800 /]
02900 BRANCH .MAIN ;Ignore SIMDDT request
03000 EPROC
00100 SUBTTL OCRE1, OCRE2 - intermediate reentry points
00200
00300 OCRE1: ;Used before memory setup
00400 OUTSTR [ASCIZ/
00500 [ZYQNYI RTS not yet initialized, continuing ...]
00600 /]
00700 JRSTF @.JBOPC
00800
00900
01000 OCRE2: ;Used when SIMDDT cannot be called
01100 edit(41)
01200 OUTSTR [ASCIZ/
01300 [ZYQCCS Current SIMDDT command suppressed] /] ;[41]
01400 EXCH XLOW,.JBOPS ;[41]
01500 SETON YDSSUP(XLOW) ;[41] suppress current SIMDDT command if possible
01600 EXCH XLOW,.JBOPS ;[41]
01700 JRSTF @.JBOPC
00100 SUBTTL GLOBAL VARIABLES AND TABLES
00200
00300 YOCDDT: Z ;Base of SIMDDT, or zero
00400
00500 ;;DEFINE EXTENDED (PSEUDO) AC LOCATIONS OF THE FORM .YXAn
00600 ;
00700 DEFINE X(N)<.YXA'N':: Z>
00800 Q==0
00900 XALL
01000 .YXAC:: ;first pseudo ac location
01100 REPEAT <QNAC>,<
01200 Q==Q+1
01300 X(\Q)
01400 >
01500 SALL
01600
01700 ;Define interface to FORTRAN standard functions
01800
01900 .YFADR:: EXP .YFARG,.YFAR2 ;Address list
02000 .YFARG:: BLOCK 2 ;First parameter
02100 .YFAR2:: BLOCK 2 ;Second parameter
02200
02300 ; Definitions for FORTRAN library subroutine exits
02400
02500 EXIT.=: FOREX
02600 edit(21)
02700 STOP.=: FOREX ;[21]
02800 FORER.::EXEC FORER
02900
03000 INTERN CONT
03100 OPDEF CONT[JRSTF @130]
00100 LIT
00200 END