Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

	SEARCH	MTHPRM,FORPRM
	TV	FOROP	MISC FUNCTIONS FOR LIBRARY ROUTINES,10(4202)

;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 *****

1100	CKS
	NEW

1256	DAW
	New calling sequence for FOROP. Also do not smash AC2.

1302	JLC
	Change FO$GLN  (LSNGET) to use channel number as argument.

1464	DAW
	Error messages.

1523	JLC	03-Jul-81
	Added calls for getting memory interface parameters,
	-10 channel parameters, and setting quiet exit.

1532	DAW	14-Jul-81
	OPEN rewrite: Base level 1

1561	DAW	28-Jul-81
	LSNGET always returned -1

1747	DAW	28-Sep-81
	Change FO$DIV to actually do the diversion, return status
	codes for errors. Added FO$GDV to return the diverted unit number.

1775	JLC	9-Oct-81
	Fix LSNGET (i.e. FOGLN) to return -1 for non-open units.

2005	JLC	15-Oct-81
	Added new entry (close all files) for use by REENTER code.

2033	DAW	19-Nov-81
	Reset "F" at start of "Close all files" routine.

***** Begin Version 7 *****

3035	JLC	Add FOROPs FOGCH and FOGFB.

3056	JLC	23-Mar-82
	Removed obnoxious POP P,T1 for new lowseg/hiseg dispatch.

3122	JLC	28-May-82
	Changed some global refs.

3136	JLC	26-Jun-82
	Added a new function to return the number of the
	first free FORTRAN logical unit.

3161	JLC	19-Aug-82
	Modified return of ERRSNS message so it can be set to
	"No error" if no error has been detected.

3165	JLC	28-Aug-82
	Add FORDDT error break entry.

3250	JLC	7-Jan-83
	Remove obsolete FOROP before release of product.

3252	JLC	12-Jan-82
	Add FENTRY.

***** End V7 Development *****

3362	TGS	28-Oct-83	SPR:20-19293
	New FOROP. calls FONOS and FOSRT to control memory allocation
	via STARTP and ENDP.  These routines are called from TOPMEM(FO$NOS)
	and SRTINI(FO$SRT) in FORMSC with a user-supplied page number argument
	in T1.

3412	RJD	1-Feb-84	SPR:10-34491
	In FOGFB, correct the index register used to obtain the
	FILOP. block address.

3432	TGS	7-Jun-84	SPR:NONE
	New FO$UDB FOROP call to return the contents of %UDBAD.  Used by
	FORDDT to check for "I/O within I/O" conditions when calling
	the OTS.

3464	MRB	18-FEB-85	SPR:10-35107
	Garbage returned when asking for Chanel of an unused logical 
	unit number.


***** Begin Version 10 *****

4014	JLC	5-12-83
	Fix fencepost error in getting high segment symbol table
	pointer which resulted in wrong page reference.

4044	JLC	19-Sep-83
	Add new functions for setting FOROTS for not saving encoded
	formats, saving them again, and deallocating all of them.

4061	JLC	4-Nov-83
	Fix ERRSNS so it only returns non-zero error numbers if
	there has been a fatal I/O error.

4065	JLC	6-Dec-83
	Add FOROP call for allowing PA1050.

4066	JLC	11-Jan-84
	Add one more channel to those turned off by PA1050 call.

4070	JLC	16-Jan-84
	Fix bug in autopatch fix.

4072	JLC	24-Jan-84
	Remove an unnecessary IF10.

4077	JLC	6-Feb-84
	Fix FOHSP so it deals with a .JBHRL correctly.

4111	JLC	16-Mar-84
	Changed "FUNCT%" to "FUNCT.". Removed extraneous ENTRY statement.

4144	JLC	29-Aug-84
	Changed MMDEB entry so it can be turned off as well as on.

4155	JLC	4-Oct-84
	Change FOSBA to FOGBA; make it get the address of %ERRBK rather then
	setting a break address, thus giving the ability to turn it off.

4173	MRB	4-Dec-84
	Change the FOROP FO$UDB to return the address of %UDBAD
	insead of the contents of it. FOROP

4202	JLC	15-Feb-85
	SPR fix to FO$GCH, was getting DDBAD from trash address if
	unit was not in use.

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

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

	SEGMENT	CODE
	FSRCH

	EXTERN	%ERRLM,%ERRSB,%ERRCT,%ERRSZ,%POPJ,%FMTSV,%FMTCL,%ERNM1,%ERNM2
	EXTERN	%LPAGE,%JBFPT,%DESHG,%EXPNT,%PTAB,%QUIET,G.ERBF,%ERRBK,%SVFMT
	EXTERN	%MMDEB,%DEFMT,%ERIOS,%PSINI,%CHNTAB,%SRBLK,%ENDP,%STRTP
	EXTERN	%CHMSK
	EXTERN	%UDBAD		;[3432]

;CALL:	T0 = 0,,function-code
;	T1 = Arg
;Since this routine is called by functions, it preserves
;all ACs except T0 and T1.

	FENTRY	(FOROP)
	ADDI	T0,DISPTB	;Get address to jump to
	CAIG	T0,DISPTB+DSPMAX ;Range check
	 JRST	FORO11		;Dispatch
;	ERR	(FFX,,,?,FOROP function code exceeds range,,%POPJ)
FOFFX:	$ECALL	FFX,%POPJ	;"?FOROP function code exceeds range"

FORO11:	TXO	T0,@IFIW	;Indirect, local section address
	JRST	@T0		;Dispatch

DISPTB:	IFIW	FOAPR		;(0) READ APR TABLE ADDRESSES
	IFIW	FOILL		;(1) READ ILL FLAG ADDRESS
	IFIW	FOERR		;(2) READ ERRSNS INFO
	IFIW	FODIV		;(3) SET DIVERT TO ERROR UNIT
	IFIW	FOHSP		;(4) READ HIGH SEG SYMBOL POINTER
	IFIW	FOFSV		;(5) SAVE FORMAT
	IFIW	FOFCL		;(6) DELETE FORMAT
	IFIW	FOGLN		;(7) GET THE LINE NUMBER OF LAST LINE
	IFIW	FOMEM		;(10) RETURN VARIOUS MEMORY PARAMETERS
	IFIW	FOCHN		;(11) RETURN ADDR OF CHANNEL WORD
	IFIW	FOQIT		;(12) QUIET EXIT FROM FORTRAN
	IFIW	FOGDV		;(13) GET DIVERTED UNIT NUMBER
	IFIW	FOFFX		;(14) OBSOLETE FUNCTION
	IFIW	FOGCH		;(15) GET CHANNEL # (-10) OR JFN (-20)
	IFIW	FOGFB		;(16) GET FILOP BLK ADDR (-10) OR 0 (-20)
	IFIW	FOGFU		;(17) GET 1ST FREE FORTRAN UNIT NUMBER
	IFIW	FOGBA		;(20) GET FORDDT BREAK ADDRESS
	IFIW	FONOS		;(21) ALLOCATE MEMORY TOP DOWN, NO SORT
	IFIW	FOSRT		;(22) ALLOCATE TOP DOWN, PREALLOCATE SORT
	IFIW	FOUDB		;(23) RETURN UDB ADDRESS [3432]
	IFIW	FOPAT		;(24) ALLOW PA1050 IN CORE
	IFIW	FOSVF		;(25) SET FOROTS TO SAVE FORMATS AGAIN
	IFIW	FONSF		;(26) SET FOROTS TO NOT SAVE ENCODED FORMATS
	IFIW	FODEF		;(27) DEALLOCATE ENCODED FORMATS
	IFIW	FODMM		;(30) SET DEBUG SWITCH FOR MEMORY MANAGER

DSPMAX==.-DISPTB-1

;READ APR TABLE ADDRESSES

FOAPR:	XMOVEI	T0,%ERRCT
	MOVEM	T0,(T1)
	XMOVEI	T0,%ERRLM
	MOVEM	T0,1(T1)
	XMOVEI	T0,%ERRSB
	MOVEM	T0,2(T1)
	MOVEI	T0,%ERRSZ	;RETURN SIZE IN T0
	POPJ	P,		;DONE

;GET ADDRESS OF FORDDT (OR OTHER DEBUGGER) BREAK
FOGBA:	XMOVEI	T0,%ERRBK	;GET BREAK ADDRESS IN T0
	POPJ	P,

;[3362] SET STARTP AND ENDP TO FORCE MEMORY ALLOCATION TO START FROM
;[3362] <arg> PAGE NUMBER DOWN [<arg> in T1].  ASSUME SORT WILL NOT BE CALLED.
FONOS:	MOVEM	T1,%STRTP	;[3362] SAVE NEW VALUES
	MOVEM	T1,%ENDP	;[3362]
	POPJ	P,		;[3362]

;[3362] SET STARTP AND ENDP TO FORCE MEMORY ALLOCATION TO START FROM
;[3362] <arg> PAGE NUMBER DOWN AND PREALLOCATE PAGES FOR SORT [<arg> in T1].
FOSRT:	MOVEM	T1,%STRTP	;[3362] SETUP STARTP AND ENDP
	MOVEM	T1,%ENDP	;[3362] AND ALLOCATE FOR SORT
	FUNCT	(FUNCT.,<[FN%MPG],[ASCIZ\SRT\],STATUS,[600],[100]>) ;[3362]
	SKIPE	STATUS		;[3362] DID WE ALLOCATE?
	 JRST	RETM1		;[3362] NO, RETURN -1
	POPJ	P,		;[3362] PAGES PREALLOCATED. RETURN

	SEGMENT	DATA		;[3362]

STATUS:	BLOCK	1		;[3362] FN%MPG RETURN VALUE

	SEGMENT	CODE		;[3362]

;HERE FOR ALLOWING PA1050 IN CORE. MUST SET %ENDP TO 677, BELOW
;PA1050, AND TURN OFF PA1050'S INTERRUPTS FOR NON-EXISTENT
;PAGE, ILL MEM READ, AND ILL MEM WRITE. NXPAGE MUST BE OFF
;BECAUSE FOROTS-20 CREATES PAGES BY TOUCHING THEM. ILL MEM
;READ MUST BE OFF BECAUSE WE MUST TAKE AN ERJMP ON AN
;ILL MEM READ OF AN INPUT-ONLY FILE WITH HOLES, AND OTHERWISE
;IT'S A BUG. ILL MEM WRITE SHOULD BE OFF SO IT ACTS LIKE
;FOROTS-20 NORMALLY ACTS WHEN THIS BUG IS ENCOUNTERED.
;WE ALSO DISABLE THE ARITHMETIC TRAPS OF THE PSI SYSTEM, SINCE
;THEY ARE ENABLED VIA SWTRP. WE ALSO DISABLE DISK QUOTA EXCEEDED
;BECAUSE PA1050 HAS A STUPID, OBNOXIOUS WAY OF HANDLING
;THIS INTERRUPT. IT WOULD BE EVEN BETTER IF WE COULD ACTUALLY
;GET THE INTERRUPT AND HANDLE IT IN FORTRAN, BUT PA1050'S
;INTERRUPT TABLE IS NOT IN A DATA PAGE, SO WE CAN'T (OR SHOULDN'T)
;MODIFY IT.

IF20,<
FOPAT:
	MOVEI	T1,.FHSLF	;THIS FORK
	SETZ	T2,		;USE STANDARD PA1050
	SCVEC%			;ALLOW PA1050
	 JSHALT			;SHOULD NOT FAIL

	CALLI	30		;GET JOB NUMBER - INNOCUOUS UUO
				;TO BRING IN PA1050

;HERE WE MUST DETERMINE IF PA1050 IS IN SECTION 0. IF IT IS,
;WE MUST SET THE TOP OF FOROTS' MEMORY BELOW IT. FOR NOW,
;PA1050 IS ALWAYS IN SECTION 0, STARTING AT PAGE 700

	MOVEI	T1,677		;SET TOP OF MEMORY BELOW PA1050
	MOVEM	T1,%ENDP	;SO FOROTS WON'T WRITE OVER IT

	MOVEI	T1,3		;3 WORDS FOR  XRIR
	MOVEM	T1,%SRBLK
	MOVEI	T1,.FHSLF
	XMOVEI	T2,%SRBLK
	XRIR%			;GET INTERRUPT TABLE ADDRESSES
	 JSHALT			;SHOULD NOT FAIL

	MOVE	T1,%SRBLK+2	;GET CHANNEL TABLE ADDRESS
	XMOVEI	T2,%CHNTAB	;GET OUR CHANNEL TABLE ADDRESS
	CAMN	T1,T2		;DID PA1050 USURP OUR CONTROL?
	 POPJ	P,		;NO

	MOVEI	T1,.FHSLF
	MOVX	T2,1B<.ICNXP>!1B<.ICAOV>!1B<.ICFOV>!1B<.ICIRD>!1B<.ICIWR>!1B<.ICQTA>!1B<.ICILI>
	DIC%

	POPJ	P,
> ;END IF20

IF10,<
FOPAT:	POPJ	P,		;TOPS-10 DOESN'T HAVE A PA1050!
>

;SET FOROTS TO SAVE ENCODED FORMATS
FOSVF:	SETOM	%SVFMT		;SET FLAG TO SAVE ENCODED FORMATS
	POPJ	P,

;SET FOROTS NOT TO SAVE ENCODED FORMATS
FONSF:	SETZM	%SVFMT		;CLEAR FLAG TO SAVE ENCODED FORMATS
	POPJ	P,

;DEALLOCATE ENCODED FORMATS AND FORMAT ENCODING AREA
FODEF:	PJRST	%DEFMT

;SET FLAG FOR FOROTS TO CHECK ON ITS MEMORY MANAGER.
;DEALLOCATES ENCODED FORMATS AND (POSSIBLY) AN ARG-COPIER
;BLOCK, THEN CHECKS THE ALLOCATION COUNT FOR BLOCKS AND PAGES.
FODMM:	MOVEM	T1,%MMDEB	;SET MEMORY MANAGER DEBUG FLAG
	POPJ	P,

;PICK UP ADDRESS OF ILLEG FLAG

FOILL:	XMOVEI	T0,ILLEG.##	;GET ADDRESS OF FLAG WORD
	MOVEM	T0,(T1)		;STORE ADDRESS IN CALLER'S DATA AREA
	POPJ	P,


;READ ERRSNS INFO

FOERR:	HRLZ	T0,%ERNM1	;GET ERR1,,ERR2
	HRR	T0,%ERNM2
	SKIPN	%ERIOS		;ANY HARD ERROR?
	 SETZ	T0,		;NO. RETURN 0,,0
	MOVEM	T0,0(T1)	;STORE
	XMOVEI	T0,G.ERBF	;GET ADDRESS OF ERR MSG BUFFER
	SKIPN	%ERIOS		;ANY MSG THERE?
	 XMOVEI	T0,[ASCIZ /No error/] ;NO. USE NO ERROR MESSAGE
	$BLDBP	T0		;CREATE A BYTE POINTER
	MOVEM	T0,1(T1)	;STORE
	POPJ	P,		;DONE


;SET ERR-MESSAGE DIVERT UNIT
;Call:
;T1/ Unit number
;Returns:
;T1/ Status:
;	0= ok
;	1= ?Illegal unit number
;	2= ?Unit not open
;	3= ?Unit not open for FORMATTED IO
;	4= ?Can't write to unit

FODIV:	JUMPL	T1,FODIV1	;Negative unit number
	CAILE	T1,MAXUNIT
	 JRST	DIVIUN		;?illegal unit number
	PUSH	P,T2		;save a couple acs
	PUSH	P,T3
	MOVE	T1,%DDBTAB##(T1) ;Get UDB
	JUMPE	T1,DIVUNO	;?Unit not open
	MOVE	T2,DDBAD(T1)	;T2= DDB addr.
	LOAD	T3,FORM(T2)	;See if open for FORMATTED IO
	CAIE	T3,FM.FORM	;If not FORMATTED,
	 JRST	DIVNOF		; return error
	LOAD	T3,ACC(T2)	;Get ACCESS
	CAIE	T3,AC.SIN	;SEQIN
	CAIN	T3,AC.RIN	;RANDIN
	 JRST	DIVCWU		;Yes, can't write to unit

	MOVEM	T1,U.ERR##	;Store divert unit
	JRST	DIVOK		;All ok

FODIV1:	AOJN	T1,DIVIUN	;If not -1, illegal unit number

;Unit -1: Clear diversion

	SETZM	U.ERR##
	SETZ	T1,		;Return status 0
	POPJ	P,

DIVIUN:	MOVEI	T1,1		;(1) Illegal unit number
	POPJ	P,		;Return

DIVUNO:	MOVEI	T1,2		;(2) Unit not open
	JRST	FODIVR

DIVNOF:	MOVEI	T1,3		;(3) Unit not open for FORMATTED IO
	JRST	FODIVR

DIVCWU:	MOVEI	T1,4		;(4) Can't write to unit
	JRST	FODIVR

DIVOK:	SETZ	T1,		;(0) OK STATUS

FODIVR:	POP	P,T3		;Restore acs
	POP	P,T2
	POPJ	P,		;Return


;FO$GDV - Get DIVERT unit number
;
;Returns:
;	T1/ unit number, -1 if no diversion

FOGDV:	SKIPN	T1,U.ERR##	;Any diverted unit?
	 SOJA	T1,FOGDV1	;No, return -1
	LOAD	T1,UNUM(T1)	;Yes, return unit #
FOGDV1:	POPJ	P,

;ENCODE A FORMAT IN AN ARRAY

FOFSV:	PJRST	%FMTSV		;GO TO IT

;THROW IT AWAY

FOFCL:	PJRST	%FMTCL		;GO DO IT

;GET THE LINE NUMBER OF THE PRESENT LINE
FOGLN:	MOVE	T1,%DDBTAB##(T1) ;GET THE DDB ADDR
	JUMPE	T1,RETM1	;NO U, RETURN -1
	MOVE	T1,DDBAD(T1)
	JUMPE	T1,RETM1	;NO D, RETURN -1
	MOVE	T0,LSNUM(T1)	;GET THE SEQUENCE NUMBER
	POPJ	P,

RETM1:	MOVNI	T0,1		;RETURN -1
	POPJ	P,

FOMEM:	XMOVEI	T0,%EXPNT	;ADDR OF "CORE UUO" SIMULATOR
	MOVEM	T0,(T1)
	XMOVEI	T0,%JBFPT	;ADDR OF .JBFF PNTR
	MOVEM	T0,1(T1)
	XMOVEI	T0,%LPAGE	;ADDR OF BOTTOM PAGE MARKER
	MOVEM	T0,2(T1)
	XMOVEI	T0,%DESHG	;ADDR OF DESIRED HIGH ADDR
	MOVEM	T0,3(T1)
	XMOVEI	T0,%PTAB	;ADDR OF MEMORY BITMAP
	MOVEM	T0,4(T1)
	POPJ	P,

FOCHN:
IF10,<	XMOVEI	T0,%CHMSK	;RETURN ADDR OF CHANNEL WORD>
IF20,<	SETZ	T0,		;NO CHANNELS ON -20>
	POPJ	P,

FOQIT:	SETOM	%QUIET		;SET THE QUIET EXIT FLAG
	POPJ	P,

FOGCH:
	CAIG	T1,MAXUNIT	;SEE IF IN RANGE
	CAMGE	T1,[MINUNIT]
	 JRST	RETM1		;NO GOOD
	SKIPN	T1,%DDBTAB(T1)	;GET UDB
	 JRST	RETM1		;UNIT NOT IN USE
	MOVE	T1,DDBAD(T1)	;GET DDB ADDR
IF10,<
	SKIPN	T1,CHAN(T1)	;FILE OPEN YET?
	 JRST	RETM1		;NO. NO CHANNEL #
	LDB	T0,[POINTR T1,FO.CHN] ;GET CHANNEL #
	POPJ	P,
>;END IF10

IF20,<
	LOAD	T0,IJFN(T1)	;GET JFN
	JUMPE	T0,RETM1	;ZERO MEANS NO JFN
	POPJ	P,
>;END IF20


FOGFB:
IF10,<
	CAIG	T1,MAXUNIT	;SEE IF IN RANGE
	CAMGE	T1,[MINUNIT]
	 JRST	RETM1		;NO GOOD
	MOVE	T1,%DDBTAB(T1)	;GET UDB
	MOVE	T1,DDBAD(T1)	;GET DDB ADDR
	XMOVEI	T0,FBLK(T1)	;[3412] GET FILOP BLOCK ADDR
	POPJ	P,
>;END IF10

IF20,<
	JRST	RETM1
>;END IF20

;GET A FREE UNIT - FIND THE FIRST EMPTY DDB TABLE ENTRY
FOGFU:	MOVSI	T1,-MAXUNIT	;GET NEG # POSITIVE UNITS
FUNLP:	SKIPN	%DDBTA(T1)	;FREE ONE?
	 JRST	GOTFUN		;YES. RETURN IT
	AOBJN	T1,FUNLP	;LOOK AT ALL OF THEM IF NECESSARY
	JRST	RETM1		;RETURN -1 IF NONE

GOTFUN:	MOVEI	T0,(T1)		;RETURN UNIT #
	POPJ	P,

;READ HIGH SEG SYMBOL POINTER

FOHSP:
IF10,<
	PUSH	P,T2		;Save T2
	MOVE	T2,[-2,,.GTUPM]	;GET BASE ADDRESS OF HIGH SEGMENT
	GETTAB	T2,
	  SETZ	T2,		;FAILED, ASSUME NO HIGH SEG
	JUMPE	T2,NOHSP	;RETURN 0 IF NO HIGH SEG
	HLRZ	T2,T2		;MOVE TO RIGHT HALF
	TRZ	T2,777		;TRUNCATE TO PAGE BOUNDARY, JUST IN CASE
	MOVE	T2,.JBHSM(T2)	;GET POINTER
NOHSP:	MOVEM	T2,(T1)		;RETURN IT
	POP	P,T2		;Restore T2
	POPJ	P,
> ;IF10

IF20,<
	PUSH	P,T2		;Save ac T2
	PUSH	P,T3		;Save T3
	HRRZ	T2,.JBHRL	;FIND HIGH SEG
	JUMPE	T2,NOHSP	;ZERO .JBHRL MEANS NONE
	HLRZ	T3,.JBHRL	;GET HIGH SEGMENT LENGTH
	SUBI	T2,-1(T3)	;CALC HIGH SEGMENT ORIGIN
	TRZ	T2,777		;TRUNCATE TO PAGE BOUNDARY
	MOVE	T2,.JBHSM(T2)	;GET POINTER
NOHSP:	MOVEM	T2,(T1)		;RETURN IT
	POP	P,T3		;Restore T3
	POP	P,T2		;Restore ac T2
	POPJ	P,
> ;IF20

;FO$UDB - Return address of %UDBAD.

;New FO$UDB FOROP call to return the address of %UDBAD,
;if it is non-zero {else return zero}. Used to check 
;for "I/O within I/O" conditions.

;[3432] Create routine

FOUDB:	MOVE	T0,%UDBAD	;[4173]Get the contents
	SKIPE	T0		;[4173]Skip if it's ZERO
	XMOVEI	T0,%UDBAD	;[4173]Get the address of it,
	MOVEM	T0,(T1)		;[3432]And return it.
	POPJ	P,		;[3432]

	PURGE	$SEG$
	END