Google
 

Trailing-Edge - PDP-10 Archives - BB-D480F-SB_FORTRAN10_V10 - fordbm.mac
There are 11 other files named fordbm.mac in the archive. Click here to see a list.
	SEARCH	MTHPRM
	TV	FORDBM	CALL DBMS,10(4113)

;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1981, 1985
;ALL RIGHTS RESERVED.
;
;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 *****

3125	JLC	3-Jun-82
	Save the ACs for DBMS calls.

3160	BL	9-Aug-82
	Separated module FORDST from FORDBM to make building OTS
	more straightforward

3202	JLC	26-Oct-82
	Mark pages used by DBMS so that FOROTS won't use them.

3207	BL	8-Nov-82
	Bring DBASE & %DBMAD outside of IF20, so FORDBM will compile on TOPS10.

3222	JLC	19-Nov-82
	Restore all ACs after FUNCT. call.

3226	JLC	29-Nov-82
	Fix page marking code.

3231	JLC	14-Dec-82
	Use new entry macro FENTRY. Allows use of new interface for DBMS.

3245	JLC	4-Dec-82
	Removed this module from the hiseg and from FORLIB. It only
	appears now in DBMSF.REL, built by the DBMS build procedure.
	Removed all FOROTS-specific symbols.

3252	JLC	12-Jan-83
	Design review patches.

3253	JLC	13-Jan-83
	Code review changes: change name of %DBSNONSHARE to %DBSNS.


***** Begin V10 *****

4111	JLC	16-Mar-84
	Changed "FDBMS%" to "FDBMS.".

4112	JLC	19-Mar-84
	Removed "FDBMS.", as it is no longer necessary.

4113	JLC	23-Mar-84
	Fix DBMS-10 interface.

***** End V10 Development *****

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

;THIS MODULE RESOLVES THE SYMBOL DBMS. AS THE ROUTINE TO
;GET SYS:DBMSF.EXE AND JUMP TO IT. THIS IS THE DEFAULT ACTION
;IF THE LINK COMMAND DOES NOT DEFINE %DBSNS.

	ENTRY	%DBSNS

	EXTERN	%DBMAD,ABORT.,FUNCT.

	INTERN	DBMS.

	SEGMENT	CODE

%DBSNS==0

DBMS.:	SKIPE	%DBMAD		;DBMS LOADED?
	  PJRST	@DBASE		;YES, JUMP TO IT

	MOVEM	0,SAVE0		;SAVE 0
	MOVE	0,[1,,SAVE1]	;SETUP TO SAVE 1-17
	BLT	0,SAVE0+17	;SAVE THEM

	PUSHJ	P,GDBMS		;GET DBMS

	MOVE	T1,%DBMAD	;GET BASE OF SEG AGAIN
	HLRZ	T2,.JBHRN(T1)	;GET SEGMENT LENGTH
	ADDI	T2,777		;ROUND UP TO PAGES
	LSH	T2,-9
	MOVEM	T2,FARG2	;SAVE FOR FUNCT. CALL
	LSH	T1,-9		;GET PAGE #
	MOVEM	T1,FARG1	;SAVE FOR FUNCT.
	MOVEI	T1,FN%MPG
	MOVEM	T1,FCODE	;MARK PAGES USED
	XMOVEI	L,FBLOCK	;SETUP ARG BLOCK
	PUSHJ	P,FUNCT.
	SKIPE	FSTAT		;OK?
	 $LCALL	NRD,ABORT.	;NO ROOM FOR DBMS

	MOVSI	16,SAVE0	;RESTORE ACS
	BLT	16,16
	JRST	@DBASE


;FUNCT. CALL BLOCK
	-5,,0
FBLOCK:	IFIW	TP%INT,FCODE
	IFIW	TP%LIT,[ASCIZ /FRS/]
	IFIW	TP%INT,FSTAT
	IFIW	TP%INT,FARG1
	IFIW	TP%INT,FARG2
	IFIW	TP%INT,FARG3

	$LERR	(?,DNF,-1,0,GTJFN failure on file SYS:DBMSF.EXE)
	$LERR	(?,CGD,-1,0,Cannot GET SYS:DBMSF.EXE)
	$LERR	(?,NRD,-1,0,No room for DBMSF.EXE)

	SEGMENT DATA

SAVE0:	BLOCK	20		;SAVED ACS
SAVE1==SAVE0+1

FCODE:	BLOCK	1		;FUNCT FUNCTION CODE
FSTAT:	BLOCK	1		;STATUS CODE
FARG1:	BLOCK	1		;ARG 1
FARG2:	BLOCK	1		;ARG 2
FARG3:	BLOCK	1		;ARG 3
SAVEC:	BLOCK	1		;SAVED ENTRY VECTOR
DBASE:	BLOCK	1

	SEGMENT	CODE

IF20,<
GDBMS:	MOVEI	T1,.FHSLF	;SAVE ENTRY VECTOR ADDRESS
	GEVEC%
	MOVEM	T2,SAVEC	;SAVE IT FOR LATER

	MOVX	T1,GJ%SHT+GJ%OLD ;GET DBMS
	HRROI	T2,[ASCIZ /SYS:DBMSF.EXE/]
	GTJFN%
	 $LJCAL	DNF,ABORT.	;DBMSF.EXE NOT FOUND
	HRLI	T1,.FHSLF
	TRO	T1,GT%NOV
	GET%
	 $LJCAL	CGD,ABORT.	;CAN'T GET IT

	MOVEI	T1,.FHSLF	;GET ENTRY VECTOR ADDRESS
	GEVEC%
	HLRZ	T1,T2		;GET LH
	CAIE	T1,254000	;CHECK FOR JRST-TYPE ENTRY VECTOR
	  MOVE	T2,(T2)		;NORMAL TYPE, GET START ADDRESS
	HRRZM	T2,DBASE	;SAVE IT
	MOVEI	T2,(T2)		;GET LOCAL ADDR
	SUBI	T2,.JBHDA	;POINT TO THE START OF THE SEG(?)
	MOVEM	T2,%DBMAD	;SAVE IT FOR FORMEM

	MOVEI	T1,.FHSLF	;PUT REAL ENTRY VECTOR BACK
	MOVE	T2,SAVEC	;GET THE OLD ONE
	SEVEC%
	POPJ	P,		;DONE
> ;END IF20

IF10,<

DBSADR==700000			;DBMSF.EXE LINKED AT 700000
DBSL==700
DBSH==775

	INTERN	DBSTP$

DBSTP$:	POPJ	P,

GDBMS:	MOVEM	P,SAVEC		;SAVE P, MERGE BLOWS IT AWAY
	MOVEI	T1,DBMS		;MERGE DBMS INTO CORE IMAGE
	MERGE.	T1,
	 $LCALL	CGD,ABORT.	;CAN'T FOR SOME REASON

	HRRZ	T1,DBSADR+.JBHSA ;GET START ADDRESS
	MOVEM	T1,DBASE	;SAVE IT
	MOVEI	T1,DBSADR	;AND SAVE DBMS ADDRESS
	MOVEM	T1,%DBMAD
	MOVE	P,SAVEC		;GET P BACK AGAIN
	POPJ	P,

DBMS:	SIXBIT	/SYS/
	SIXBIT	/DBMSF/
	SIXBIT	/EXE/
	0
	0
	DBSL,,DBSH

> ;END IF10

	PRGEND

	SEARCH	MTHPRM
	TV	FDBML

;THIS MODULE RESOLVES DBMS. AS THE REAL DBMS, WHICH FOR DBMS V6
;IS DBMS$., AND WHICH FOR DBMS V5 IS DBMS%.

IF20,<
	ENTRY	DBMS.

	EXTERN	DBMS$.,FUNCT.

	INTERN	DBFNAD,HOST$F

	DBMS.=DBMS$.
	HOST$F=FUNCT.
	DBFNAD==0

> ;END IF20

IF10,<

	ENTRY	DBMS.

	EXTERN	DBMS%

	INTERN	DBSTP$

	SEGMENT	CODE

DBMS.=DBMS%

DBSTP$:	POPJ	P,		;TELLS FORINI TO GETSEG FOROTS WITHOUT DBMS

> ;END IF10

	PRGEND

	SEARCH	MTHPRM
	TV	KDBMS	KILL VESTIGES OF DBMS

	ENTRY	KDBMS.

	INTERN	%DBMAD

	SEGMENT	CODE

KDBMS.:	SETZM	%DBMAD		;CLEAR DBMS ADDRESS
	POPJ	P,

	SEGMENT	DATA

%DBMAD:	BLOCK	2		;DBMS ADDRESS

	END