Google
 

Trailing-Edge - PDP-10 Archives - cuspjul86upd_bb-jf24a-bb - 10,7/galaxy/glxlib/glxfun.mac
There are 3 other files named glxfun.mac in the archive. Click here to see a list.
TITLE	GLXFUN  --  FUNCT. Interface to GLXLIB
SUBTTL	T. Litt 23-Feb-85

;
;
;        COPYRIGHT (c) 1985,1986 DIGITAL EQUIPMENT CORPORATION
;			 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.

	SEARCH	GLXMAC			;SUBSYSTEMS SYMBOLS
	PROLOG(GLXFUN,FUN)		;PRODUCE PROLOG CODE



	FUNEDT==1			;MODULE EDIT LEVEL
SUBTTL Entry Points found in GLXFUN



ENTRY	FUNCT.	;Entry point to the GALAXY "OTS"
SUBTTL Table of contents

SUBTTL Revision History

COMMENT \

Edit	SPR/QAR			Explanation
----    -------	   -----------------------------------------------------
0001	GCO10174   Invent GLXFUN to support use of RMS with GLXLIB
\
SUBTTL	Global Storage

SUBTTL FUNCT. - Perform "OTS" function translation

; FUNCT. IS AN INTERFACE MODULE DESIGNED TO ALLOW ROUTINES THAT THINK THEY
; ARE RUNNING UNDER A LANGUAGE'S OTS TO RUN UNDER GLXLIB.  NO PARTICULAR CALIM
; IS MADE THAT THIS INTERFACE IS COMPLETE - IT WILL BE EXTENDED AS THE NEED
; ARISES.

; CALL IS:	ACCORDING TO THE LINK MANUAL
;

	Q=16		;THE USUAL NAME FOR THE FORTRAN LINKAGE REGISTER
	Q.CNT==-1			;ARGUMENT COUNT WORD
	Q.FCN==0			;FUNCTION CODE
	Q.ERR==1			;ERROR CODE
	Q.STS==2			;STATUS CODE
	Q.ARG==3			;FIRST ARG WORD

F$FUNC::
FUNCT.::
	$SAVE	<TF,S1,S2>
	HLRE	TF,Q.CNT(Q)		;GET THE ARGUMENT COUNT SUPPLIED
	MOVM	TF,TF			;MAKE IT POSITIVE
	CAIGE	TF,3			;BETTER BE FUNCTION, ERROR, AND STATUS
IALSTP:	 $STOP	(IAL)			;INVALID ARG LIST
	PUSH	P,[ASCII /GLX/]		;OUR ERROR CODE
	POP	P,@Q.ERR(Q)		;TELL CALLER
	SKIPLE	S2,@Q.FCN(Q)		;GET FUNCTION CODE REQUESTED
	 CAILE	S2,MAXFNC		;WE'D BETTER UNDERSTAND
	SETZ	S2,			;WE DON'T, CALL IT AN ILLEGAL FUNCTION
	JRST	@FCTTBL(S2)		;DISPATCH

FCTTBL:	IFIW	ILLFNC			;(0) ILLEGAL
	IFIW	GADFNC			;(1) GET FROM SPECIFIC ADDRESS
	IFIW	CORFNC			;(2) GET FROM ANY OVL ADDRESS
	IFIW	RADFNC			;(3) RETURN FROM SPECIFIED ADDRESS
	IFIW	GCHFNC			;(4) GET IO CHANNEL
	IFIW	RCHFNC			;(5) RETURN IO CHANNEL
	IFIW	GOTFNC			;(6) GET OTS CORE
	IFIW	ROTFNC			;(7) RETURN OTS CORE
	IFIW	RNTFNC			;(10) RETURN INITIAL RUNTIME
	IFIW	IFSFNC			;(11) RETURN INITIAL FILE SPEC
	IFIW	CBCFNC			;(12) CUT BACK CORE
	IFIW	RRSFNC			;(13) READ RETAIN STATUS
	IFIW	WRSFNC			;(14) WRITE RETAIN STATUS
	IFIW	GPGFNC			;(15) GET PAGES
	IFIW	RPGFNC			;(16) RETURN PAGES
	IFIW	GPSFNC			;(17) GET TOPS-20 PSI CHAN
	IFIW	RPSFNC			;(20) RETURN TOPS-20 PSI CHAN
	MAXFNC==<.-FCTTBL>-1
SUBTTL	GADFNC - (1) GET FROM SPECIFIC ADDRESS


GADFNC:	JRST	ILLFNC			;NO IDEA HOW TO GET GLXLIB TO DO THIS

SUBTTL	CORFNC - (2) GET FROM ANY OVL ADDRESS


CORFNC:	JRST	GOTFNC			;THIS IS THE SAME AS GET FROM OTS
SUBTTL	RADFNC - (3) RETURN FROM SPECIFIED ADDRESS


RADFNC:	JRST	ROTFNC			;THIS IS THE SAME AS RETURN TO OTS
SUBTTL	GCHFNC - (4) GET IO CHANNEL


GCHFNC:	CAIGE	TF,Q.ARG+1		;WAS AT LEAST ONE ARG SPECIFIED?
	 PUSHJ	P,IALSTP		;++ NO
	$CALL	F%FCHN			;ASK GLXFIL FOR A CHANNEL
	JUMPF	RETONE			;FAILED, RETURN ERROR
	MOVEM	S1,@Q.ARG+0(Q)		;RETURN CHANNEL IN ARG 1
	JRST	SUCRTN			;RETURN SUCCESS
SUBTTL	RCHFNC - (5) RETURN IO CHANNEL


RCHFNC:	CAIGE	TF,Q.ARG+1		;BETTER BE A CHANNEL THERE
	 PUSHJ	P,IALSTP		;++ SIGH
	 SKIPL	S1,@Q.ARG+0(Q)		;GET CHANNEL
	CAILE	S1,17			;MAX WE GIVE OUT THIS WAY
	 JRST	RETONE			;INVALID CHANNEL TO RETURN
	JRST	SUCRTN			;WE'RE HAPPY, GLXFIL WILL NOTICE
SUBTTL	GOTFNC - (6) GET OTS CORE


GOTFNC:	CAIGE	TF,Q.ARG+2		;NEED TWO ARGS
	 PUSHJ	P,IALSTP		;++ NO
	$CALL	M%FPGS			;SEE WHAT'S FREE
	PG2ADR	S1			;TURN PAGES INTO WORDS
	CAMGE	S1,@Q.ARG+1(Q)		;ENOUGH?
	 JRST	RETONE			;NO, RETURN NOT ENF CORE STATUS
	MOVE	S1,@Q.ARG+1(Q)		;GET THE AMOUNT OF THE REQUEST
	$CALL	M%GMEM			;ASK FOR THE CORE
	JUMPF	RETONE			;IF FAIL, ERROR STATUS NOT ENF CORE
	MOVEM	S2,@Q.ARG+0(Q)		;WHERE WE GOT IT
	JRST	SUCRTN			;SUCCESS
SUBTTL	ROTFNC - (7) RETURN OTS CORE


ROTFNC:	CAIGE	TF,Q.ARG+2		;NEED TWO ARGS
	 PUSHJ	P,IALSTP		;++ NO
	MOVE	S1,@Q.ARG+1(Q)		;GET SIZE
	MOVE	S2,@Q.ARG+0(Q)		;AND ADDRESS
	$CALL	M%RMEM			;RETURN IT TO GLXMEM
	JUMPF	RETONE			;ERROR: CORE CAN'T BE DEALLOCATED
	JRST	SUCRTN			;OK, DONE
SUBTTL	RNTFNC - (10) RETURN INITIAL RUNTIME


RNTFNC:	CAIGE	TF,Q.ARG+1		;ENOUGH ARGS?
	 PUSHJ	P,IALSTP		;++ SIGH
	MSTIME	S1,			;NO IDEA, NOW WILL HAVE TO DO.
	MOVEM	S1,@Q.ARG+0(Q)		;STORE IT
	JRST	SUCRTN			;OK
SUBTTL	IFSFNC - (11) RETURN INITIAL FILE SPEC


IFSFNC:	CAIGE	TF,Q.ARG+3		;ENOUGH ARGS?
	 PUSHJ	P,IALSTP		;++ NYET
	HRROI	S1,.GTRDV		;RUN DEVICE
	GETTAB	S1,			;GET DEVICE
	 SETZ	S1,
	MOVEM	S1,@Q.ARG+0(Q)		;STORE DEVICE

	HRROI	S1,.GTRFN		;RUN FILE NAME
	GETTAB	S1,			;GET FILE NAME
	 SETZ	S1,
	MOVEM	S1,@Q.ARG+1(Q)		;STORE FILE NAME

	HRROI	S1,.GTRDI		;RUN DIRECTORY
	GETTAB	S1,			;GET DIRECTORY
	 SETZ	S1,
	MOVEM	S1,@Q.ARG+2(Q)		;STORE DIRECTORY
	JRST	SUCRTN			;SUCCESS
SUBTTL	CBCFNC - (12) CUT BACK CORE


CBCFNC:	$CALL	M%CLNC			;TRY TO REDUCE CORE
	JRST	SUCRTN			;THIS REALLY MUST HAVE WON
SUBTTL	RRSFNC - (13) READ RETAIN STATUS


RRSFNC:	JRST	ILLFNC
SUBTTL	WRSFNC - (14) WRITE RETAIN STATUS


WRSFNC:	JRST	ILLFNC
SUBTTL	GPGFNC - (15) GET PAGES


GPGFNC:	CAIGE	TF,Q.ARG+2		;GOT BOTH ARGUMENTS?
	 PUSHJ	P,IALSTP		;++ NO
	$CALL	M%FPGS			;SEE WHAT'S FREE
	MOVE	S2,S1			;MAKE A COPY
	MOVE	S1,@Q.ARG+1(Q)		;GET WORDS WANTED.
	TRNE	S1,777			;ONE WOULD HOPE, A PAGE OR TWO?
	 PUSHJ	P,IALSTP		;CONFUSION.
	ADR2PG	S1			;MAKE A PAGE COUNT
	CAMLE	S1,S2			;IS ENOUGH FREE FOR WHAT WE WANT?
	 JRST	RETONE			;NO
	$CALL	M%AQNP			;GET WHAT WE NEED
	JUMPF	RETONE			;NOT ENOUGH MEMORY
	PG2ADR	S1			;MAKE AN ADDRESS
	MOVEM	S1,@Q.ARG+0(Q)		;STORE IT
	JRST	SUCRTN			;SUCCESS
SUBTTL	RPGFNC - (16) RETURN PAGES


RPGFNC:	CAIGE	TF,Q.ARG+2		;GOT BOTH ARGUMENTS?
	 PUSHJ	P,IALSTP		;++ NO
	MOVE	S1,@Q.ARG+1(Q)		;GET NUMBER OF WORDS BEING RETURNED.
	MOVE	S2,@Q.ARG+0(Q)		;ADDRESS BEING RETURNED
	 TRNN	S2,777			;BETTER BE A PAGE ADDRESS
	TRNE	S1,777			;ONE WOULD HOPE, A PAGE OR TWO?
	 PUSHJ	P,IALSTP		;CONFUSION.
	ADR2PG	S1			;MAKE A PAGE COUNT
	ADR2PG	S2			;MAKE ADDRESS A PAGE #
	$CALL	M%RLNP			;GIVE THEM UP
	JUMPF	RETONE			;DEALLOCATION FAILED
	JRST	SUCRTN			;SUCCESS
SUBTTL	GPSFNC - (17) GET TOPS-20 PSI CHAN


GPSFNC:	JRST	ILLFNC
SUBTTL	RPSFNC - (20) RETURN TOPS-20 PSI CHAN


RPSFNC:	JRST	ILLFNC
SUBTTL RTNVAL - Return 


ILLFNC:	SETOM	@Q.STS(Q)		;RETURN ILLEGAL FUNCTION
	$RET

SUCRTN:	SETZM	@Q.STS(Q)		;RETURN SUCCESS
	$RET

RETONE:	MOVEI	S1,1			;RETURN STATUS = 1
ERRRTN:	MOVEM	S1,@Q.STS(Q)		;RETURN ERROR CODE
	$RET
SUBTTL	End


FUN%L:

	END