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