Google
 

Trailing-Edge - PDP-10 Archives - BB-4157E-BM - fortran-ots-debugger/forop.mac
There are 11 other files named forop.mac in the archive. Click here to see a list.
	SEARCH	FORPRM
	TV	FOROP	MISC FUNCTIONS FOR LIBRARY ROUTINES,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 *****

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.

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

\

	SEGMENT	CODE
	FSRCH

	ENTRY	FOROP%
	EXTERN	%APRLM,%APRSB,%APRCT,%POPJ,%FMTSV,%FMTCL
	EXTERN	%LPAGE,%JBFPT,%DESHG,%EXPNT,%PTAB,%QUIET,%EXIT1
	EXTERN	I.FLAGS
IF10,<	EXTERN	%CHMSK>
;CALL:	T0 = 0,,function-code
;	T1 = Arg
;Since this routine is called by functions, it preserves
;all ACs except T0 and T1.

FOROP%:	POP	P,T1		;GET T1 BACK FROM WHERE FORINI PUT IT
	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)
	$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	FOCLS		;(14) CLOSE ALL FILES AND RETURN
DSPMAX=.-DISPTB-1

;READ APR TABLE ADDRESSES

FOAPR:	XMOVEI	T0,%APRCT
	MOVEM	T0,(T1)
	XMOVEI	T0,%APRLM
	MOVEM	T0,1(T1)
	XMOVEI	T0,%APRSB
	MOVEM	T0,2(T1)

	POPJ	P,		;DONE

;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:	MOVE	T0,G.IS##	;GET ERR1,,ERR2
	MOVEM	T0,0(T1)	;STORE
	XMOVEI	T0,G.ERBF##	;GET ADDRESS OF ERR MSG BUFFER
	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	T1,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,

FOCLS:	MOVE	F,I.FLAGS	;Reset "F".
	PJRST	%EXIT1		;GO CLOSE THE FILES

;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
	MOVE	T2,.JBHRL	;FIND HIGH SEG
	JUMPE	T2,NOHSP	;ZERO .JBHRL MEANS NONE
	PUSH	P,T3		;Save T3
	HLRZ	T3,T2
	SUBI	T2,(T3)
	POP	P,T3		;Restore T3
	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 ac T2
	POPJ	P,
> ;IF20


	PURGE	$SEG$
	END