Trailing-Edge
-
PDP-10 Archives
-
bb-jr93e-bb
-
7,6/ap016/glxfun.x16
There are 2 other files named glxfun.x16 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,1987 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==2 ;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
0002 GCO10462 Convert $STOP to STOPCD.
\
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: STOPCD (IAL,HALT,,<Invalid argument 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