Google
 

Trailing-Edge - PDP-10 Archives - BB-4157E-BM - fortran-ots-debugger/forini.mac
There are 13 other files named forini.mac in the archive. Click here to see a list.
	SEARCH FORPRM
	TITLE	FORINI	GETSEG FOROTS, 6(2033)

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

COMMENT \

***** Begin Revision History *****

BEGIN V6

1262	DAW	 9-Feb-81
	Allow FORINI to run in a non-zero section. (Assumes
	that all code is in the same section).

1530	JLC	10-Jul-81
	FOROTS becomes FOROT6.

1623	DAW	21-Aug-81
	Entry point RESET$ to test extended addressing in FOROTS.

2005	JLC	15-Oct-81
	Added REENTER code. Make DDT-20 understand symbol tables
	at other than 400000.

2007	JLC	16-Oct-81
	Fixed temp stack to be larger for reenter code.

2033	DAW	19-Nov-81
	Fixed problems in REENTER code.

***** End Revision History *****

\

	ENTRY	RESET.
	TWOSEG	400000
	FSRCH

IF20,	ENTRY	RESET$		;Map section 0 and 1 together
	EXTERN	FOROT%

;RESET. WILL GETSEG FOROTS IF IT WAS NOT LOADED WITH THE PROGRAM.
;THE SYMBOL FOROT% IS USED TO DECIDE IF FOROTS HAS BEEN LOADED.
;IF FOROTS COMES FROM FOROTS.REL (OR FORLIB.REL), FOROT% IS
;1B0+DISPATCH VECTOR ADDRESS.  IF LINK WANTS FOROTS TO BE LOADED
;AT RUNTIME, IT DEFINES FOROT%=400010.
;
;CALL:
;	JSP	16,RESET.
;	 0			;ARG, IGNORED
;
;RETURNS WITH FOROTS PRESENT AND INITIALIZED.  SETS UP P.
;CAN DESTROY ALL ACS

RESET.:
RESET0:				;Another label (used by RESET$)
IF10,<	PORTAL	.+1  >		;ALLOW CALL FROM PUBLIC PAGE

	MOVEM	17,INIACS+17	;SAVE INITIAL RUN ACS
	MOVEI	17,INIACS
	BLT	17,INIACS+16
	MOVEI	P1,INIACS	;SEND ADDRESS OF INITIAL ACS TO FOROTS
IF20,<	XMOVEI	15,DBSTP$## >	;Old P4: =  lowseg symbol where DBSTP$ is
				; called from

;(All during field test we have been setting the Old P4 to -1,
; so if programs compiled during field test are not relinked, they
; will be passing -1 in AC15 to FOROT6).

	MOVE	P,[IOWD IPDLSZ,INIPDL] ;SET UP VERY TEMP STACK


IF20,<
	MOVEI	T1,.FHSLF	;THIS FORK
	GEVEC%			;GET ENTRY VECTOR LOC
	MOVEM	T2,SAVET	;SAVE, SINCE GET WRECKS IT
	HLRZ	T1,T2		;GET JUST THE LEFT HALF	
	CAIE	T1,(JRST)	;REAL ENTRY VECTOR?
	 CAIG	T1,1		;YES. BIG ENOUGH?
	  JRST	NOENTV		;NO. JUST STORE ADDR IN .JBREN
	XMOVEI	T2,(T2)		;GET ENTRY VECTOR BASE
	SKIPN	T1,1(T2)	;GET REENTER INST
	 MOVE	T1,[JRST EXICAL];USE OURS IF NONE
	CAMN	T1,[JRST CLSFIL] ;Already setup? (Program re-started?)
	 JRST	FOROK		;Yes, skip this.
	TLNN	T1,-1		;ANY OPCODE?
	 HRLI	T1,(JRST)	;NO. PUT IN A JRST
	MOVEM	T1,USEREN	;TO EXECUTE AFTER %EXIT1
	MOVE	T1,[JRST CLSFIL];USED TO CLOSE ALL FILES
	MOVEM	T1,1(T2)	;WHEN USER TYPES "REENTER"
>;END IF20

NOENTV:	SKIPN	T1,.JBREN	;DOES USER HAVE .JBREN ADDR?
	 MOVEI	T1,EXICAL	;NO. USE AN EXIT CALL
	HRRZ	T2,T1		;Did we already do this?
	CAIN	T2,CLSFIL
	 JRST	FOROK		;Yes, don't do it again.
	HRLI	T1,(JRST)	;MAKE IT A LOCAL INSTRUCTION
	MOVEM	T1,USEREN	;TO EXECUTE AFTER %EXIT1
	XMOVEI	T1,CLSFIL	;USED TO CLOSE ALL FILES
	MOVEM	T1,.JBREN	;WHEN USER TYPES "REENTER"

FOROK:	SKIPN	T1,FBASE	;FOROTS ALREADY GETED?
	SKIPGE	T1,[FOROT%]	;NO, GET BASE ADDRESS
	  JRST	[HRRZM T1,FBASE	;BASE ADDRESS KNOWN, SAVE FOR LATER
		 JRST INIT.]	;JUMP TO FOROTS

IF10,<
	JS.XO==2000		;JBTSTS BIT, JOB IS EXECUTE ONLY

	HRROI	T1,.GTSTS	;GET JOB STATUS
	GETTAB	T1,
	  SETZ	T1,		;CAN'T, ASSUME NOT EXECUTE ONLY
	TRNN	T1,JS.XO	;EXECUTE ONLY?
	  TDZA	T2,T2		;NO
	MOVEI	T2,UU.PHY	;YES, SET FOR PHYS-ONLY GETSEG

	MOVEI	T1,['SYS   '	;GETSEG FOROTS
		    'FOROT6'
		    EXP 0,0,0,0]
	GETSEG	T1,(T2)
	  HALT			;FAILED, TYPE MONITOR ERROR MESSAGE

	MOVE	16,INIACS+16	;GETSEG WRECKED ACS, PUT THEM BACK
	SETO	15,
	MOVE	P,[IOWD IPDLSZ,INIPDL]

	MOVE	T1,[-2,,.GTUPM]	;GET BASE ADDRESS OF HIGH SEG (FOROTS)
	GETTAB	T1,
	  MOVSI	T1,FOROT%##	;FAILED, USE LINK'S VALUE
	HLRZ	T1,T1		;PUT IN RIGHT HALF
	TRZ	T1,777		;CLEAR EXTRA BITS
	TRO	T1,10		;START ADDRESS IS XXX010
	MOVEM	T1,FBASE	;STORE FOR LATER

	JRST	INIT.		;START UP FOROTS
> ;IF10
IF20,<
	MOVX	T1,RF%LNG+.FHSLF ;FUNNY CALL,,THIS FORK
	MOVEI	T2,STBLK	;POINT TO FORK STATUS BLOCK
	RFSTS%			;READ FORK STATUS
	SKIPL	STBLK+.RFSFL	;SEE IF WE ARE EXECUTE ONLY
	  SKIPA	T1,[GJ%SHT+GJ%OLD] ;NO, SET UP FOR REGULAR GTJFN
	MOVX	T1,GJ%SHT+GJ%OLD+GJ%PHY	;YES, SET UP FOR PHYSICAL-ONLY GTJFN
	HRROI	T2,[ASCIZ /SYS:FOROT6.EXE/]
	GTJFN%
	  ERJMP	RERR

	HRLI	T1,.FHSLF	;THIS FORK
	TRO	T1,GT%NOV	;ERROR IF PAGES ALREADY EXIST
	XMOVEI	T2,GARGBL	;Point to GET arg block
	TLNE	T2,-1		; Needed?
	 PUSHJ	P,GTFRS1	;SETUP FOR SECTION 1 GET%
	GET%			;GET FOROTS
	  ERJMP	RERR

	MOVEI	T1,.FHSLF	;THIS FORK
	GEVEC%			;GET FOROTS ENTRY VECTOR

	HRRZI	T2,(T2)		;LOCAL ADDR ONLY
	MOVE	T1,(T2)		;GET "START" ADDRESS
	MOVEM	T1,FBASE	;SAVE BASE ADDRESS OF DISPATCH VECTOR
	HLRZ	T2,.JBHRN-.JBHDA(T1) ;ADD HIGH SEGMENT LENGTH
	ADDI	T2,-.JBHDA-1(T1) ;TO HISEG ORIGIN-1
	HLL	T2,.JBHRN-.JBHDA(T1) ;MAKE .JBHRL LOOK LIKE ON THE -10
	SKIPN	.JBHRL		;AND IF THE USER DIDN'T HAVE ONE
	 MOVEM	T2,.JBHRL	;SAVE FOR DDT
	LSH	T1,-9		;CREATE PAGE ADDR
	SKIPN	.JBHSO		;AND IF THE USER DOESN'T HAVE ONE
	 MOVEM	T1,.JBHSO	;SAVE THE FOROTS HIGH SEG ORIGIN FOR DDT

	MOVEI	T1,.FHSLF	;THIS FORK
	MOVE	T2,SAVET	;PUT REAL ENTRY VECTOR BACK
	SEVEC%			; SO ^C, START WORKS

	JRST	INIT.		;GO DO FOROTS INITIALIZATION

;Definitions in R5 MONSYM
GT%ARG==1B22			;Arg block supplied for GET
GT%BAS==1B2			;BASE-address word supplied in arg block

;Call here to do setup for GET% into section 1 only
GTFRS1:	HLRZM	T2,GARGBL+3	;Save section number to GET into
	MOVX	T3,GT%BAS	;Tell monitor which word to use
	MOVEM	T3,GARGBL
	TXO	T1,GT%ARG	;Remember we have an arg block
	POPJ	P,		;Back to main code

RERR:	HRROI	T1,RERRBF	;POINT TO MESSAGE BUFFER
	HRLOI	T2,.FHSLF	;THIS FORK,,LAST ERROR
	MOVSI	T3,-^D80	;LIMIT OF 80 CHARS
	ERSTR%			;GET ERROR STRING
	 JRST	[HRROI T1,[ASCIZ /Undefined error number/]
		 JRST RQUIT]
	  SKIPA	T1,[-1,,[ASCIZ /Error in ERSTR/]]
	HRROI	T1,RERRBF

RQUIT:	MOVEM	T1,SAVET	;SAVE T1 FOR A WHILE
	HRROI	T1,[ASCIZ /Can't get FOROT6.EXE/]
	ESOUT%			;TYPE EXPLANATION
	MOVE	T1,SAVET	;GET POINTER BACK
	ESOUT%			;TYPE ERROR STRING
	HALTF%			;QUIT AND DON'T CONTINUE
	JRST	.-1
> ;IF20

CLSFIL:

IF10,<
	OUTSTR	CLSMSG		;GIVE USER A MSG
	INCHWL	T1		;GET THE FIRST CHAR
	CLRBFI			;CLEAR TYPE-AHEADS
>;END IF10

IF20,<
	MOVE	T1,[POINT 7,CLSMSG] ;GIVE USER A MSG
	PSOUT%
	MOVE	T1,[TXIBLB,,TXIBLK] ;Copy args to TXIBLK
	BLT	T1,TXIBLK+.TXLEN-1
	XMOVEI	T1,TXIBLK	;SETUP FOR TEXTI
	TEXTI%
	 JFCL			;?Failed

;Clear input buffer.

	MOVEI	T1,.PRIIN	;Get terminal designator
	CFIBF%			;Clear input buffer
	 ERJMP	.+1		;Ignore error

	LDB	T1,[POINT 7,YESWRD,6] ;GET THE 1ST CHAR
>;END IF20

;Here with first char of response in T1.

	CAIE	T1,"Y"		;IS IT YES
	 CAIN	T1,"y"
	  JRST	DOCLS		;YES, IT'S YES
	JRST	NDOCLS		;NO. IT'S NOT

DOCLS:	MOVEM	17,INIACS+17	;SAVE INITIAL RUN ACS
	MOVEI	17,INIACS
	BLT	17,INIACS+16
	MOVE	P,[IOWD IPDLSZ,INIPDL] ;SET UP VERY TEMP STACK
	MOVEI	T0,FO$CLS	;FOROP CALL TO CLOSE ALL FILES
	PUSHJ	P,FOROP.
	MOVSI	17,INIACS	;RESTORE INITIAL ACS
	BLT	17,16
	MOVE	17,INIACS+17
NDOCLS:	XCT	USEREN		;EXECUTE REENTER INST

IF20,<
EXICAL:	HALTF%			;STOP FOROTS
	JRST	.-1		;AND STAY THAT WAY
>

IF10,<
EXICAL:	EXIT			;HALT FOROTS
>

IF20,<
TXIBLB:	4			;LENGTH FOLLOWING
	RD%TOP!RD%JFN		;STOP ON TOPS-10 STYLE CODES
	.PRIIN,,.PRIOU		;INPUT,,OUTPUT
	POINT 7,YESWRD		;THE ANSWER POINTER
	5			;5 BYTES MAX
.TXLEN==.-TXIBLB		;Length of block

TXIBLK:	BLOCK	.TXLEN		;Real TEXTI block.
>;END IF20

CLSMSG:	ASCIZ /Do you want to close all files? (Y or N):/
	SUBTTL	RESET$ - MAP SECTION 0 AND 1 TOGETHER

;This is a temporary entry point to test extended addressing FOROTS
;RESET$ maps sections 0 and 1 together, then returns to RESET0

IF20,<
RESET$:	PORTAL	.+1		;Allow call from public page
	DMOVEM	0,INIACS	;Save a few acs
	DMOVEM	2,INIACS+2

	SETZ	T1,		;Create private section
	MOVE	T2,[.FHSLF,,1]	;Section 1
	MOVX	T3,PM%RD!PM%WR+1 ;Read Write and one section
	SMAP%			;** Create section 1 **
	 ERJMP	NOSC1		;Can't

	MOVE	T1,[.FHSLF,,0]	;Want to map section 0
	MOVE	T2,[.FHSLF,,1000] ;Into other section
	SKIPGE	[FOROT%]	;Is FOROTS loaded?
	 JRST	RSTFLD		;Yes

	MOVX	T3,PM%RWX!PM%CNT+400 ;All lowseg
	PMAP%			;Make the two sections the same
	 ERJMP	CNTMP1		;Can't map pages to section 1
	MOVE	T1,[.FHSLF,,765] ;Also copy DDT if present
	MOVE	T2,[.FHSLF,,1765]
	MOVX	T3,PM%RWX!PM%CNT+13
	PMAP%
	 ERJMP	CNTMP1

	XJRSTF	[EXP 0,<1,,.+1>] ;Enter extended addressing
	JRST	RSTGO		;Go do FOROTS initialization

NOSC1:	HRROI	T1,[ASCIZ/?FRSNS1 Can't put myself in section 1, reason:
 Can't create section 1 with SMAP%
/]
	PSOUT%
	JRST	RSTGO		;Go anyway

CNTMP1:	HRROI	T1,[ASCIZ/?FRSCM1 Can't put myself in section 1, reason:
 Can't PMAP section 0 to section 1
/]
	PSOUT%
	JRST	RSTGO		;Go do regular RESET.

;HERE IF FOROTS LOADED AND WE WANT TO GO TO SECTION 1.
;Setup T3 for PMAP% and do it.

RSTFLD:	MOVX	T3,PM%RWX!PM%CNT+1000 ; The whole section
	PMAP%
	 ERJMP	CNTMP1
	XJRSTF	[EXP 0,<1,,.+1>] ;Enter extended addressing
;	JRST	RSTGO		;Go do FOROTS initialization


RSTGO:	DMOVE	0,INIACS	;Restore acs
	DMOVE	2,INIACS+2
	XMOVEI	16,(16)		;Get section # in LH(16)
	JRST	RESET0		;Entry at RESET0
>;END IF20
	RELOC			;TO LOW SEG

FBASE:	BLOCK	1		;FOROTS BASE ADDRESS

INIACS:	BLOCK	20		;INITIAL ACS
IPDLSZ==100			;INITIAL (TEMPORARY) STACK
INIPDL:	BLOCK	IPDLSZ		;TEMP PDL UNTIL REAL ONE IS SET UP
USEREN:	BLOCK	1		;USER REENTER ADDR
YESWRD:	BLOCK	1		;WORD FOR USER RESPONSE

IF20,<

STBLK:	5			;LENGTH OF RFSTS BLOCK
	BLOCK	4		;RFSTS BLOCK
GARGBL:	BLOCK	4		;"GET" arg block

RERRBF: BLOCK	^D80/5		;BUFFER FOR ERROR MESSAGE
SAVET:	BLOCK	1		;RANDOM TEMP (NO STACK YET)

>

	RELOC			;BACK TO HIGH SEG
;REAL DISPATCH VECTOR.  JUMP TO APPROPRIATE PLACE IN FOROTS DISPATCH VECTOR

DEFINE	X (E) <
	ENTRY	E'.
E'.:	PUSHJ	P,RDISP
>

	XALL
RVEC:	FORVEC
	SALL

;This code is known by the traceback routine's PC finder.  It walks through
;these instructions to find the sixbit name of a FOROTS routine from the
;address of its entry point.  If any change is made here, fix TRACE too.

RDISP:	EXCH	1,(P)
	ADD	1,FBASE		;RELOCATE TO FOROTS ENTRY POINT

;This is OK only as long as FOROTS must be in the same section as
; the user's code. If it can be a different section, change "TLZ" to
; put FOROTS's section number in the LH.
	TLZ	1,-1		;Make local section address
	JRST	-RVEC-1(1)	;SUBTRACT JSP, JUMP TO FOROTS

	END