Trailing-Edge
-
PDP-10 Archives
-
CFS_TSU04_19910205_1of1
-
update/ftnosr/forop.mac
There are 11 other files named forop.mac in the archive. Click here to see a list.
SEARCH MTHPRM,FORPRM
TV FOROP MISC FUNCTIONS FOR LIBRARY ROUTINES,11(5007)
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;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 *****
***** Begin Version 11 *****
5007 TGS 1-Feb-86
Modify FO$ERR to return a 3rd error number for RERSNS
***** 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]
EXTERN %ERNM3 ;[5007]
;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
MOVE T0,%ERNM3 ;[5007] GET ERR3
MOVEM T0,2(T1) ;[5007]
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