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