SEARCH MTHPRM,FORPRM TV FOROTS Fortran object time system,10(4174) ;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1981, 1985 ;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 ***** FOROTS revision history moved to FORHST ***** Begin Version 7 ***** 3005 AHM 28-Oct-81 Make %SAVE relocate arg block AC references properly by changing "1,,ACn" produced by XMOVEI 0,@[IFIW ACn] into plain old "ACn". 3012 JLC 4-Nov-81 Total rework of I/O argument copier. Resolves all AC, immediate, and indexed args. New list looks like the one that will hopefully eventually come from the compiler. 3016 JLC 9-Nov-81 Modified new copied list so it's not quite like it will be - immediate-mode zeroes now transformed to pointers to zero words, no type bits turned on. 3026 JLC 24-Nov-81 In %FSAVE, leave the arg pntr alone so that FUNCT calls, which now call it instead of %SAVE, will not have a junk copied arg pntr. 3033 AHM 14-Dec-81 Check for indexing and indirection in %SAVE when checking for AC references so that an address field in an argument of the form () is not relocated to U.ACS 3035 JLC 5-Feb-82 Rework arg copier again. Install more locs at BEGZER which must be cleared on RESET. Set reread unit to point to itself, as 0 is a legal unit number. 3056 JLC 23-Mar-82 Implement new lowseg/hiseg dispatch. Remove %FSAVE and AC copying in %SAVE, as AC copying is done in the lowseg. 3101 JLC 5-Apr-82 Fix passing of address of user's ACs, was being deposited (ill mem ref) before data pages were created. Now passed in F instead of T1. 3102 JLC 7-Apr-82 Slightly modify passing of return address of RESET. call - PDL is now in the lowseg. 3103 JLC 8-Apr-82 More minor changes to lowseg/hiseg interface. Setup of stack is now done totally in FORINI. 3105 JLC 9-Apr-82 Fix to get correct start address for TRACE. 3107 JLC 12-Apr-82 Fix FOROTS not to allow PA1050, RESET% was in the wrong place (after SCVEC%), so it reset the monitor to allow PA1050. 3110 JLC 14-Apr-82 Undo edit 3107 - it was a release 5 monitor bug. 3122 JLC 28-May-82 Added some new globals for errors. Initialize error tables. 3124 AHM 1-Jun-82 Added a .ORG to the place that initializes the version number for Tops-10 in order to remove a RELOC that might confuse MACRO when assembling with psects. 3125 JLC 3-Jun-82 Moved the AC save routine back to the hiseg. 3131 JLC 11-Jun-82 Make elapsed time calc more accurate. 3136 JLC 26-Jun-82 Support work for performance improvement. Moved %OVNUM to here. 3140 JLC 2-Jul-82 Remove edit 3124, as it was making FOROTS.MAC not assemble. Instead, put LOC 137 and RELOC in IFE FTPSCT. 3146 AHM 8-Jul-82 Put the RESET% following the call to %MEMINI under IF20 so that we can build on the -10. 3150 JLC 13-Jul-82 Move clearing of BEGZER variables, so they won't be cleared after they are set up. 3161 JLC 18-Jul-82 Get initial CCOC words for .PRIIN so we can avoid using incorrect ones later. Eliminate DIFACS, as the user's ACs are stored in FOROTS' section forevermore. 3165 JLC 28-Aug-82 Added a new trap table for FORDDT breaks on FOROTS errors. 3167 JLC 31-Aug-82 Removed %SPEOL, as it accomplished nothing. 3176 JLC 9-Sep-82 Install disk quota exceeded trap. Fix CCOC words yet again. 3200 JLC 24-Sep-82 Install the hooks (%DBMAD and %SRTAD) for marking the pages used by SORT and DBMS in the FORMEM page table. 3202 JLC 26-Oct-82 Move %SRTAD and %DBMAD to their respective own modules. 3212 JLC 11-Nov-82 Fix CCOC handling logic - only change CCOC words when we are about to do TTY output, then restore them to just previous to the output. 3216 JLC 16-Nov-82 Fix XSIR JSYS so it's pointing to a block of 30-bit addresses, rather than using a literal (which are, of course, 18-bit addresses). Also, always use XSIR whether or not we are in section 0. 3221 JLC 18-Nov-82 Create the block for edit 3216... 3223 JLC 22-Nov-82 Fix code for large I/O lists. 3225 JLC 24-Nov-82 Install new entry point for AC saves for IOLST and FIN only. Change the standard one (%SAVAC) to check for I/O within I/O. Change the CCOC words to output nulls as nulls. 3226 JLC 29-Nov-82 Clear existence of DBMS in init code (only relevant on -20). 3231 JLC 14-Dec-82 Remove customer warning about transfer-table mismatch. 3240 JLC 20-Dec-82 Fix TOOMNY call to POPT, was causing arg pntr skew. 3245 JLC 5-Jan-83 Remove %DBMAD. 3246 JLC 5-Jan-83 Change name of FOROT% to %FRSLOAD. 3253 JLC 13-Jan-83 Change %FRSLOAD to %FRSLO. ***** End V7 Development ***** 3267 JLC 11-Feb-83 Change test so that an I/O list which contains more than 128 elements and one or more of them are subscripted array references, retrieves or stores the data correctly. 3354 TGS 3-Oct-83 SPR:NONE Move setup of DBMS entry vector from FORINI to here. Store FUNCT address in .JBBLT+2 as well as .JBBLT. 3360 TGS 17-Oct-83 SPR:20-19540 Since both FORLIB and LIBOL define DBSTP. as a global symbol for DBMS calls, producing a LNKMDS error, change it to D.BSTP. ***** Begin Version 10 ***** 4000 JLC 22-Feb-83 Autopatch for the big arg copier. Performance enhancements. 4006 JLC 28-Feb-83 FOROT7 becomes FORO10. 4014 JLC 20-Jun-83 Add new CCOC words for image-mode TTY I/O. 4023 JLC 29-Jun-83 Remove all traces of FTSHR. Use [F.TOP] as a flag whether using /OTS:NONSHARE. 4025 JLC 1-Jul-83 Add passing of user subroutine address for library traps. 4044 JLC 19-Sep-83 Added global variables for memory manager debugger, and made the FUNCT. arg block global. 4045 JLC 3-Oct-83 Removed unnecessary code from arg copier. 4052 JLC 12-Oct-83 Removed unnecessary instructions from arg copier. 4053 JLC 18-Oct-83 Removed setup of AOBJN arg pointer. 4061 JLC 4-Nov-83 Create new variable %ERIOS for deferred setup of IOSTAT variable. 4062 JLC 7-Nov-83 Reinsert "extraneous" code in arg copier - it was not extraneous. 4064 JLC 14-Nov-83 Fix %OVNUM so that if format is not contained in overlay structure it will get zero for the overlay number, rather than the largest overlay number which happens to be in core at the time. 4065 JLC 6-Dec-83 Setup variables %STRTP and %ENDP for memory allocation. Eliminate FT20UUO code, which is replaced by PA1050 subroutine in FORMSC, since it didn't work very well. Eliminate setup of TT.DES, as it was incorrect to do it here. 4066 JLC 11-Jan-84 Move code to set up error handing system, as some errors could happen before it was initialized. Move some code around to make it more maintainable. 4072 JLC 24-Jan-84 New lowseg/hiseg value-passing mechanism. 4073 JLC 26-Jan-84 Create a new flag %FLGB which is the logical .AND. of %FLGVX and %FLG77. 4102 JLC 17-Feb-84 Change the compatibility flags. 4106 JLC 2-Mar-84 Fix compatibility index calculation. 4111 JLC 16-Mar-84 Move the transfer vector table to FORBOT, so that it does not appear in /OTS:NONSHARE. 4122 JLC 2-May-84 A whole raft of changes to make the TOPS-10 and TOPS-20 DDB databases the same. 4123 JLC 5-May-84 Fix JOBSTR UUO call. 4126 CDM 11-May-84 Update copyright notice for ots image in FOROTS.MAC. 4131 JLC 12-Jun-84 Add an non-skip memory full return for %GTBLK. 4152 JLC 24-Sep-84 Add %SVCNV, a routine to translate IOWD or symbol vector into address and length, as a separate module at the end of this file. 4153 JLC 27-Sep-84 Fix start-address recording problem introduced by edit 4152, by adding the address of a location containing the start address to the initialization argument block, along with an arg count. Avoid breaking old (alpha site) V10 EXE files by checking for the existence of an arg count, and doing it the old way if none. 4155 JLC 2-Oct-84 Removed %SVCNV from this module, as it has to be after all of its references. 4156 JLC 23-Oct-84 Set %UDBAD to -1 in %SAVAC so that it is really a flag of whether I/O is in progress. 4174 JLC 9-Jan-85 Move code so that %LEVTB does not get cleared after it is set up. ***** End V10 Development ***** ***** End Revision History ***** \ INTERN D.BSTP,%LALAD,%FLIDX INTERN %ISAVE,%SAVAC,%CPARG,%SAVIO,%PSINI INTERN %CRLF,%HALT,%MSLJ,%MSPAD,%OVNUM INTERN %STADD,%MSLVL,%NARGN,%FTAST,%FTSLB,%TRFLG,%SPFLG,%BZFLG INTERN %DDBTAB,%EDDB,U.RERD,%UDBAD,%QUIET,%ABFLG,%FAREA,%FSECT INTERN AU.ACS,%ERRCT,%ERRLM,%ERRSB,%ERRSZ,%ERRBK,%NAMLN,%EXCHN INTERN %OCCOC,%OCLIT,%CCMSK,%OVPRG,%BLCNT,%PGCNT,%CPBLK,%SVFMT INTERN %MMDEB,ILLEG. INTERN %FNBLK,%FCODE,%FSTAT,%FARG1,%FARG2,%FARG3 INTERN %JIBLK,%CHMSK EXTERN %MEMINI,%ERINI,%TRPINI,%VER,%DFERR,%FUNCX,FUNCT. EXTERN %ABORT,%IONAM EXTERN %GTBLK,%FREBLK,%ERNM1,%ERNM2,%ERIOS,%PUSHT,%POPT,%POPJ1 EXTERN F.BOT,F.TOP,F.BHS EXTERN %STRTP,%ENDP SEGMENT CODE SUBTTL INIT. INITIALIZATION FENTRY (INIT) IF10,< RESET ;RESET I/O, RESET .JBFF > ;IF10 IF20,< RESET% ;RESET I/O HLRZ T1,.JBSA ;RESET .JBFF MOVEM T1,.JBFF > PUSHJ P,MAKDP ;CREATE DATA PAGES MOVE T1,[JRST FUNCT.] ;[3354] SETUP JUMP TO FUNCT. MOVEM T1,.JBBLT ;[3354] WHERE DBMS CAN USE IT MOVEM T1,.JBBLT+2 ;[3354] HERE ALSO IF PA1050 BLAMS .JBBLT XMOVEI T1,@FDBS(L) ;GET ADDRESS OF DBSTP$ MOVEM T1,D.BSTP ;SAVE IT XMOVEI T1,@FLAL(L) ;GET ADDR OF LIBRARY ERROR ARG LIST MOVEM T1,%LALAD ;SAVE IT SETZ T1, ;SET NO COMPATIBILITY FLAGGING SKIPE @FLGVX(L) ;VAX FLAGGING? ADDI T1,VAXIDX ;YES. ADD IN VAX INCOMP INDEX SKIPE @FLG77(L) ;ANSI-77 FLAGGING? ADDI T1,ANSIDX ;SET. ADD IN ANSI-77 FLAG MOVEM T1,%FLIDX ;SAVE IN INCOMP FLAGGING INDEX MOVE T1,-1(L) ;[4153] GET ARG COUNT TRNN T1,-1 ;[4153] IS IT AN ARG COUNT? JRST GOSTAD ;[4153] YES. GO GET START ADDRESS' ADDRESS XMOVEI T1,@(P) ;[4153] GET ADDRESS+1 OF JSP SUBI T1,2 ;[4153] POINT TO RESET CALL MOVEM T1,INDSTA ;[4153] SAVE IT FOR TRACEBACK XMOVEI T1,INDSTA ;[4153] NOW GET ITS ADDRESS MOVEM T1,%STADD ;[4153] SAVE IT JRST GFSEC ;[4153] JOIN COMMON CODE GOSTAD: XMOVEI T1,@FSTAD(L) ;[4153] GET ADDRESS OF START ADDRESS MOVEM T1,%STADD ;[4153] SAVE IT GFSEC: SETZM BEGZER ;[4174] CLEAR DATA THAT MUST BE ZERO ON RESTART MOVE T1,[BEGZER,,BEGZER+1] ;[4174] BLT T1,ENDZER ;[4174] XMOVEI T1,. ;GET EXTENDED ADDR HLLZM T1,%FSECT ;STORE FOROTS' SECTION NUMBER XMOVEI T1,UACS ;FROM NOW ON MOVEM T1,AU.ACS ;USER'S ACS ARE IN FOROTS DATA AREA MOVEI T1,STARTP ;SETUP START AND TOP PAGE NUMBERS MOVEM T1,%STRTP MOVEI T1,ENDP MOVEM T1,%ENDP PUSHJ P,%PSINI ;INITIALIZE PSI SYSTEM PUSHJ P,%TRPINI ;INITIALIZE TRAP HANDLER PUSHJ P,%ERINI ;INITIALIZE ERROR SYSTEM PUSHJ P,INIT1 ;GET RUN TIME AND TIME OF DAY PUSHJ P,%MEMINI ;INITIALIZE CORE MANAGER MOVX T1,FTAST ;GET DEFAULT SETTING OF ASTERISK ON OVERFLOW MOVEM T1,%FTAST ;SET FOR FORCNV HRROI T1,RRUNIT ;GET REREAD UNIT # MOVEM T1,U.RERD ;SO IT POINTS TO ITSELF MOVE T1,[MOVSLJ] ;FOR PADCHAR FILLING OF FIXED-LENGTH RECORDS MOVEM T1,%MSLJ SETOM %SVFMT ;SET FOROTS TO SAVE ENCODED FORMATS MOVSI T1,-%ERRSZ ;GET AOBJN POINTER FOR ERROR TABLE MOVEI T2,WRNCNT ;SET ALL ERROR LIMITS TO WRNCNT MOVEM T2,%ERRLM(T1) AOBJN T1,.-1 PUSHJ P,INIT2 ;DO SOME MORE INITIALIZATION JRST %POPJ1 ;RETURN FROM RESET., SKIP ARG %FNBLK: IFIW TP%INT,%FCODE ;GET A PSI CHANNEL IFIW TP%INT,[ASCIZ /FRS/] ;FOROTS IS CALLING ITSELF IFIW TP%INT,%FSTAT ;STATUS IFIW TP%INT,%FARG1 ;ARG 1 IFIW TP%INT,%FARG2 ;ARG 2 IFIW TP%INT,%FARG3 ;ARG 3 ;ROUTINE TO INIT PSI SYSTEM IF10,< %PSINI: POPJ P, ;NO PSI SETUP INIT1: SETZ T1, ;GET RUNTIME FOR THIS JOB RUNTIM T1, MOVEM T1,I.RUNTM ;SAVE MOVE T1,[%CNSUP] ;GET UPTIME IN JIFFIES GETTAB T1, SETZ T1, MOVEM T1,I.DAYTM ;SAVE HRROI T1,.GTWCH ;GET ERR MESSAGE CONTROL BITS GETTAB T1, ;IN WATCH TABLE SETZ T1, TLNN T1,(JW.WMS) ;IF NOT SET, TLO T1,(JW.WPR+JW.WFL) ;DEFAULT IS PREFIX+FIRST TLNE T1,(JW.WCN) ;CONTINUATION? TLO T1,(JW.WFL) ;YES, IMPLIES FIRST MOVEM T1,%MSLVL ;SAVE FOR FORERR ;GET RUN FILESPEC FOR OVERLAY HANDLER HRROI T1,.GTRDV ;GET DEVICE WE WERE RUN FROM GETTAB T1, SETZ T1, MOVEM T1,I.DEV ;SAVE FOR FUNCT. HRROI T1,.GTRFN ;FILE NAME GETTAB T1, SETZ T1, MOVEM T1,I.FILE HRROI T1,.GTRDI ;PPN GETTAB T1, SETZ T1, MOVEM T1,I.PPN MOVEM T1,I.PATH+2 ;ALSO PPN PART OF FULL PATH MOVSI T2,-5 ;GET AOBJN WORD FOR SFD GETTABS INISFD: HRROI T1,.GTRS0(T2) ;GET AN SFD NAME GETTAB T1, AOJA T2,INISF1 ;FAILED, NO SFDS JUMPE T1,.-1 ;END OF SFDS, QUIT MOVEM T1,I.PATH+3(T2) ;STORE SFD NAME IN PATH BLOCK AOBJN T2,INISFD ;GET ALL SFDS INISF1: SETZM I.PATH+2(T2) ;PUT ZERO AT END OF LIST MOVEI T1,I.PATH ;GET PATH POINTER IN CASE OF SFDS SKIPE I.PATH+3 ;ANY SFDS? MOVEM T1,I.PPN ;YES, CHANGE PPN TO SFD POINTER SETZM %JIBLK MOVE T1,[%JIBLK,,%JIBLK+1] ;CLEAR PATH BLOCK BLT T1,%JIBLK+.PTMAX MOVEI T1,.PTFRD ;GET DEFAULT DIRECTORY PATH MOVEM T1,%JIBLK+.PTFCN MOVE T1,[.PTMAX,,%JIBLK] PATH. T1, $SNH MOVE T1,[1,,T2] ;GET JUST A STRUCTURE NAME SETO T2, ;RETURN FIRST STRUCTURE IN SEARCH LIST JOBSTR T1, $SNH MOVEM T2,%JIBLK+.PTSTR ;SAVE IT POPJ P, INIT2: MOVSI T1,377774 ;MARK ALL I/O CHANNELS AVAILABLE MOVEM T1,%CHMSK HRROI T1,.GTLIM ;GET BATCH STATUS GETTAB T1, SETZ T1, TXNN T1,JB.LBT TDZA T1,T1 SETO T1, MOVEM T1,I.BAT PJOB T1, ;[2064] Get job number MOVEM T1,I.JOB ;SAVE IT POPJ P, %HALT: ;ERROR HALT, DON'T TOUCH ANYTHING EXIT 1, JRST .-1 ;IF TOPS-10 SHARABLE FOROTS, MAKE DATA PAGES MAKDP: SKIPN [F.TOP] ;SHARABLE FOROTS? POPJ P, ;NO. DON'T CREATE PAGES MOVEI T2,1 ;SET LENGTH OF PAGE. ARG BLOCK MOVEI T3,F.BOT/1000 ;GET FIRST PAGE TO CREATE MOVEI T4,/1000 ;GET NUMBER OF PAGES TO CREATE INILP: MOVE T1,[.PAGCD,,T2] ;SET TO CREATE PAGE PAGE. T1, ;DO IT JRST INIHLT ;CAN'T INILP1: ADDI T3,1 ;BUMP TO NEXT PAGE SOJG T4,INILP ;CREATE ALL PAGES POPJ P, INIHLT: CAIN T1,PAGCE% ;PAGE EXISTS? JRST INILP1 ; YES, OK TXO T3,PA.GCD ;NO. TRY CREATING ON DISK MOVE T1,[.PAGCD,,T2] PAGE. T1, JRST FATMEM ;REALLY CAN'T JRST INILP1 ;AND CONTINUE ON DISK FATMEM: OUTSTR [ASCIZ /? Insufficient memory for initialization /] JRST %HALT > ;END IF10 IF20,< %PSINI: XMOVEI T1,%PC1 ;SET UP LEVTAB MOVEM T1,%LEVTAB XMOVEI T1,%PC2 MOVEM T1,%LEVTAB+1 XMOVEI T1,%PC3 MOVEM T1,%LEVTAB+2 ;ASSUME EXTENDED MACHINE. IF XSIR FAILS, USE SIR. MOVEI T1,3 ;3-WORD BLOCK MOVEM T1,%SRBLK XMOVEI T1,%LEVTAB ;SETUP LEVEL TABLE ADDR MOVEM T1,%SRBLK+1 XMOVEI T1,%CHNTAB ;SETUP CHANNEL TABLE ADDR MOVEM T1,%SRBLK+2 MOVEI T1,.FHSLF ;THIS FORK XMOVEI T2,%SRBLK ;POINT TO 3-WORD BLOCK XSIR% ;SET INTERRUPT TABLE ADDRESSES ERJMP NOXSIR ;XSIR DIDN'T WORK SETOM I.XSIR ;REMEMBER WE ARE USING XSIR-FORMAT TABLES JRST PIINI1 ;JOIN COMMON CODE NOXSIR: SETZM I.XSIR ;NOT USING XSIR-FORMAT TABLES MOVEI T1,.FHSLF ;THIS FORK MOVE T2,[%LEVTAB,,%CHNTAB] ;SET LEVTAB AND CHNTAB SIR% ;SET INTERRUPT TABLES PIINI1: EIR% ;ENABLE INTERRUPT SYSTEM POPJ P, ;DONE INIT1: MOVEI T1,.FHSLF ;GET RUNTIME FOR THIS FORK RUNTM% MOVEM T1,I.RUNTM ;SAVE FOR END-OF-JOB STATISTICS TIME% ;GET SYSTEM UP-TIME MOVEM T1,I.DAYTM ;SAVE FOR END OF JOB SETZM %MSLVL ;DEFAULT ON 20 IS FIRST MOVEI T1,.FHSLF ;SET NO UUO SIMULATION SETO T2, SCVEC% POPJ P, INIT2: SETO T1, ;CLOSE ALL FILES UNMAPPED BY %MEMINI CLOSF% JSHALT MOVEI T1,FN%GPS ;GET PSI CHANNEL FUNCTION MOVEM T1,%FCODE MOVEI T1,.ICQTA ;SETUP FOR DISK QUOTA EXCEEDED MOVEM T1,%FARG1 MOVEI T1,1 ;LEVEL 1 MOVEM T1,%FARG2 XMOVEI T1,%DFERR ;SET THE ADDRESS MOVEM T1,%FARG3 XMOVEI L,%FNBLK ;SET INTERRUPT FOR DISK FULL PUSHJ P,%FUNCX ;CALL FUNCT. ENTRY POINT MOVE T1,%CHNTAB+.ICQTA ;AND COPY CHANNEL WORD IN FOROTS MOVEM T1,%FCHTB+.ICQTA ;SO FUNCT WILL KNOW IT'S FOROTS MOVEI T1,.FHSLF ;ACTIVATE CHANNEL MOVSI T2,(1B<.ICQTA>) ;FOR DISK FULL OR QUOTA EXCEEDED AIC% SETO T1, ;GET ALL JOB INFO MOVEI T2,%JIBLK HRLI T2,-JIBSZ MOVEI T3,.JIJNO ;STARTING WITH THE 0TH WORD GETJI% ERCAL ERRIJE MOVE T1,%JIBLK+.JIBAT ;GET BATCH STATUS MOVEM T1,I.BAT ;SAVE IT POPJ P, ERRIJE: ;ERR (IJE,?,"Impossible" JSYS error at $P - $J,,%HALT) $ECALL IJE,%HALT %HALT: ;ERROR HALT, DON'T TOUCH ANYTHING HALTF% JRST .-1 ;ON TOPS-20, CREATING DATA PAGES IS RELATIVELY EASY MAKDP: POPJ P, > ;END IF20 SEGMENT DATA ;FUNCT. BLOCK ARGS %FCODE: BLOCK 1 ;FUNCTION CODE %FSTAT: BLOCK 1 ;STATUS %FARG1: BLOCK 1 ;ARGUMENT 1 %FARG2: BLOCK 1 ;ARGUMENT 2 %FARG3: BLOCK 1 ;ARGUMENT 3 %SRBLK:: BLOCK 3 ;THE XSIR SETUP BLOCK I.RUNTM:: BLOCK 1 ;INITIAL RUNTIME I.DAYTM:: BLOCK 1 ;INITIAL TIME AND DATE U.RERD: BLOCK 1 ;UNIT NUMBER FOR REREAD OPERATIONS %MSLJ: BLOCK 1 ;MOVSLJ INST %MSPAD: BLOCK 1 ;THE PAD CHARACTER %CHMSK: BLOCK 1 ;TOPS-10 CHANNEL MASK %FTAST: BLOCK 1 ;ASTERISKS ON FIELD WIDTH OVERFLOW INDSTA: BLOCK 1 ;[4153] ACTUAL START ADDRESS IF OLD V10 PROG %STADD: BLOCK 1 ;ADDRESS OFSTART ADDRESS I.BAT:: BLOCK 1 ;BATCH STATUS, -1 IF BATCH JOB %MSLVL: BLOCK 1 ;ERR MESSAGE VERBOSITY I.XSIR:: BLOCK 1 ;MONITOR ALLOWS XSIR/XRIR FORMS OF PSI JSYSES D.BSTP: BLOCK 1 ;[3360] Address of DBPST$, or 0 %LALAD: BLOCK 1 ;LIBRARY ERROR ARG LIST ADDRESS %FLIDX: BLOCK 1 ;COMPATIBILITY FLAGGING INDEX AU.ACS: BLOCK 1 ;ADDRESS OF USER'S ACS UACS: BLOCK 20 ;USERS ACS IF20,< JIBSZ==.JILLO+1 %JIBLK: BLOCK JIBSZ ;JOB INFORMATION BLOCK >;END IF20 IF10,< %JIBLK: BLOCK .PTMAX ;PATH BLOCK I.DEV:: BLOCK 1 ;DEVICE WE WERE RUN FROM I.FILE:: BLOCK 1 ;FILENAME I.PPN:: BLOCK 1 ;PPN (EITHER STRAIGHT PPN OR POINTER TO I.PATH) I.PATH: BLOCK .PTMAX ;WHOLE PATH I.JOB:: BLOCK 1 ;JOB NUMBER > ;END IF10 BEGZER:! ;FOLLOWING DATA IS ZEROED ON RESTART BLOCK -MINUNIT ;DDB ADDRESSES OF NEGATIVE UNITS %DDBTAB: BLOCK 1+MAXUNIT ; POSITIVE UNITS %BLCNT: BLOCK 1 ;COUNT OF MEMORY BLOCKS ALLOCATED %PGCNT: BLOCK 1 ;COUNT OF PAGES ALLOCATED %BZFLG: BLOCK 1 ;BLANK=ZERO %SPFLG: BLOCK 1 ;FORCE PLUS SIGN ON NUMERIC OUTPUT %FTSLB: BLOCK 1 ;SUPPRESS LEADING BLANKS ON NUMERIC OUTPUT %NAMLN: BLOCK 1 ;0=IONAM LINE NOT OUT YET %TRFLG: BLOCK 1 ;NONZERO=WE ARE IN A TRAP %FAREA: BLOCK 1 ;FORMAT DECODING AREA %EXCHN: BLOCK 1 ;EXTENDED CHANNELS ALLOWED %ABFLG: BLOCK 1 ;ABORT FLAG - PREVENTS I/O %QUIET: BLOCK 1 ;FLAG FOR QUIET EXIT %SVFMT: BLOCK 1 ;NON-ZERO = SAVE ENCODED FORMATS %MMDEB: BLOCK 1 ;MEMORY MANAGER DEBUG FLAG %UDBAD: BLOCK 1 ;DDB ADDRESS %CPBLK: BLOCK 1 ;POINTER TO ALLOCATED ARGLST CPYSIZ: BLOCK 1 ;SIZE OF ALLOCATED ARGLST %EDDB: BLOCK 1 ;ENCODE/DECODE DDB ADDRESS ILLEG.: BLOCK 1 ;ILLEGAL INPUT FLAG U.ERR:: BLOCK 1 ;UNIT BLOCK ADDR. OF ERROR-MESSAGE UNIT, IF SET D.TTY:: BLOCK 1 ;DDB OF CONTROLLING TTY, IF OPEN U.TTY:: BLOCK 1 ;UDB OF CONTROLLING TTY, IF OPEN %ERRSZ==ETBSIZ ;SET THE SIZE OF THE TABLE GLOBALLY %ERRCT: BLOCK ETBSIZ ;COUNT OF APR ERRORS, BY TYPE %ERRLM: BLOCK ETBSIZ ;LIMIT OF ERROR BEFORE ERR MSG SUPPRESSED %ERRSB: BLOCK ETBSIZ ;ROUTINE TO CALL ON APR TRAP %ERRBK: BLOCK 1 ;FORDDT BREAK ADDR TO CALL ON ERROR FMT.LS:: BLOCK FMTN ;ENCODED FORMAT POINTERS I.PID:: BLOCK 1 ;MYPID %FCHTB:: BLOCK ^D36 ;FOROTS-OWNED CHANNELS %LEVTAB:: BLOCK 3 ;PSI TABLES: LEVTAB %CHNTAB:: BLOCK ^D36 ; CHNTAB %PC1:: BLOCK 2 ;LEVEL 1 PC, FLAGS %PC2:: BLOCK 2 ;LEVEL 2 PC, FLAGS %PC3:: BLOCK 2 ;LEVEL 3 PC, FLAGS G.PRP:: BLOCK 1 ;PROMPT STRING BYTE POINTER ENDZER==.-1 SUBTTL OVNUM SEGMENT CODE ;ROUTINE TO FIND LINK NUMBER GIVEN AN ADDRESS ;ARGS: T1 = ADDR ;RETURN: T1 = LINK NUMBER,,ADDR ; Unless extended addressing: Then, T1 will not be changed. ;ASSUMPTIONS: ;THE CONTROL SECTION IS THE LAST THING IN EACH LINK. ;LINKS ARE DISJOINT AND ARE STRUNG TOGETHER IN INCREASING ORDER OF ADDRESS. ;CODE AND DATA ARE LOADED CONTIGUOUSLY WITHIN A LINK, SEPARATE FROM OTHER ;LINKS. ;CONTROL SECTION OFFSETS (FROM OVRLAY.MAC) CS.NUM==2 ;LINK NUMBER CS.FPT==4 ;FORWARD POINTER TO NEXT CONTROL SECTION %OVPRG==.JBOVL ;IF OVERLAY PROGRAM, .JBOVL NON-ZERO ;Note: At this point, we can assume that FOROTS is running in section 0 %OVNUM: MOVE T3,.JBOVL ;GET ROOT LINK CONTROL SECTION ADDRESS OVLP: HRRZ T2,CS.NUM(T3) ;GET LINK NUMBER OF THIS LINK CAML T3,T1 ;IS SEARCH ADDRESS WITHIN THIS LINK? POPJ P, ;YES. RETURN WITH LINK NUMBER IN T2 HRRZ T3,CS.FPT(T3) ;GET POINTER TO FOLLOWING LINK JUMPN T3,OVLP ;IF ANOTHER, SEARCH ON SETZ T2, ;NONE. ADDRESS IS NOT IN AN OVERLAY POPJ P, ;ROUTINE TO SAVE THE USER'S AC'S %SAVAC: SKIPE %UDBAD ;I/O IN PROGRESS? $ACALL IWI ;YES. DON'T WANT TO TRASH THE CURRENT ACS SETZM %NAMLN ;TELL ERROR PROCESSOR NEW STATEMENT SETZM %ERNM1 ;CLEAR THE ERROR NUMBERS SETZM %ERNM2 SETZM %ERIOS ;CLEAR THE ONE USED FOR IOSTAT SETOM %UDBAD ;[4156] I/O IS IN PROGRESS! %SAVIO: POP P,RETADR ;SAVE THE RETURN ADDR MOVEM 0,UACS ;SAVE AC 0 MOVE 0,[1,,UACS+1] ;SAVE THE REST BLT 0,UACS+17 PUSHJ P,@RETADR ;RETURN TO FOROTS, LEAVE RESTORE RETURN ADDR HRLZI 16,UACS ;RESTORE THE ACS BLT 16,16 ;WITH A BLT POPJ P, ;RETURN TO USER'S PROGRAM ;ROUTINE TO COPY ARG ADDRESSES ;COPIES THE ARG LIST, RESOLVING INDEXING AND INDIRECTION. %CPARG: MOVEM P,SAVEP ;SAVE P MOVE P,-1(L) ;Get arg count (-n) ;Here with P = -number of args,,0 SAVEX: MOVEM P,%NARGN ;Store in local area SETZM DIFSEC ;CLEAR "DIFFERENT SECTION" FLAG HLLZ 0,L ;GET SECTION # OF ARG LIST CAME 0,%FSECT ;SAME AS FOROTS? SETOM DIFSEC ;NO. SET FLAG JUMPGE P,NOARGX ;Jump if no args for this FN CAMGE P,[-MAXARG,,0] ;See if all will fit in our block JRST TOOMNY ;NO, GO ALLOCATE A BLOCK FOR THEM ;Here with L = 30-bit address of user's arg list. ;Copy from the user's arglist to ours. ARGXFR: MOVE 0,(L) ;GET AN ARG WORD TXNN 0,ARGTYP ;TYPE BITS? JRST IMMED ;NO. GO RESOLVE IMMED ARG TLNE 0,37 ;INDEXED OR INDIRECTED? JRST IND ;YES. GO RESOLVE IT TRNN 0,777760 ;ARG IN AC? JRST ACS ;YES. GO RESOLVE SKIPE DIFSEC ;ARG BLOCK SECTION DIFFERENT THAN FOROTS' JRST IND ;YES. GO RESOLVE MOVEM 0,ARGLST(P) ;AND SAVE IT ADDI L,1 ;INCR USER ARG PNTR AOBJN P,ARGXFR ;BACK FOR MORE JRST ARGDON IND: HRRI 0,ARGLS2(P) ;GET THE SUBSTITUTE ADDR TLO 0,(IFIW @) ;TURN ON LOCAL INDIRECT TLZ 0,17 ;TURN OFF OTHERS MOVEM 0,ARGLST(P) ;SAVE LOCAL PNTR XMOVEI 0,@(L) ;GET 30-BIT ADDR MOVEM 0,ARGLS2(P) ;SAVE IT ADDI L,1 ;INCR USER ARG PNTR AOBJN P,ARGXFR JRST ARGDON IMMED: JUMPE 0,IMMED0 ;JUST STORE 0 IF ALL ZERO HRRZM 0,ARGLS2(P) ;SAVE THE IMMED ARG LOCALLY HRRI 0,ARGLS2(P) ;POINT TO IT TLO 0,(IFIW) ;LOCAL ADDR IMMED0: MOVEM 0,ARGLST(P) ;SAVE THE REF ADDI L,1 ;INCR USER ARG PNTR AOBJN P,ARGXFR ;BACK FOR MORE JRST ARGDON ACS: HRRZ 0,AU.ACS ;POINT TO USER'S ACS ADD 0,(L) TLO 0,(IFIW) ;LOCAL ADDR MOVEM 0,ARGLST(P) ;SAVE THE REF ADDI L,1 ;INCR USER ARG PNTR AOBJN P,ARGXFR ARGDON: XMOVEI L,ARGLST ;POINT TO COPIED ARG LIST NOARGX: SETZ F, ;INIT FLAG AC MOVE P,SAVEP ;GET STACK PNTR AGAIN POPJ P, ;RETURN ;HERE WHEN THE PROGRAM SENDS MORE THAN MAXARG ARGUMENTS. ALLOCATE A ;BLOCK FOR THEM, COPY THEM INTO IT, RESOLVING INDEXING AND INDIRECTION, ;AND POINT L AT THE COPIED ARG LIST. ;0= -# args ;L= ptr to user's arg list TOOMNY: MOVE P,SAVEP ;GET THE USER'S PDP AGAIN PUSHJ P,%PUSHT ;SAVE T ACS HLRE T1,-1(L) ;GET SIZE NEEDED MOVM T1,T1 LSH T1,1 ;FOR 2 TABLES ADDI T1,1 ;PLUS THE COUNT WORD CAMG T1,CPYSIZ ;BIGGER THAN THE ONE WE HAVE? JRST GOTBLK ;NO. USE IT MOVEM T1,CPYSIZ ;YES. SAVE NEEDED SIZE SKIPE T1,%CPBLK ;GET OLD BLOCK ADDR PUSHJ P,%FREBLK ;FREE IT IF ANY MOVE T1,CPYSIZ ;GET SIZE NEEDED PUSHJ P,%GTBLK ;ALLOCATE A BIG ENOUGH BLOCK $ECALL MFU,%ABORT ;CAN'T MOVEM T1,%CPBLK ;SAVE ADDRESS GOTBLK: PUSHJ P,%POPT ;RESTORE T ACS (DON'T USE T1 AFTER HERE!) MOVE P,-1(L) ;GET ARG COUNT MOVEM P,@%CPBLK ;SAVE IT HRR P,%CPBLK ;PUT ADDR IN ARG PNTR ADDI P,1 ;POINT PAST ARG COUNT HLRE 0,-1(L) ;GET -COUNT MOVM 0,0 ;GET POSITIVE ADD 0,%CPBLK ;POINT TO 2ND ARG BLOCK-1 ADDI 0,1 ;POINT TO 2ND ARG BLOCK MOVEM 0,AFALAD ;SAVE ITS ADDRESS BARGXF: MOVE 0,(L) ;GET AN ARG WORD TXNN 0,ARGTYP ;TYPE BITS? JRST BIMMED ;NO. GO RESOLVE IMMED ARG TLNE 0,37 ;INDEXED OR INDIRECTED? JRST BIND ;YES. GO RESOLVE IT TRNN 0,777760 ;ARG IN AC? JRST BACS ;YES. GO RESOLVE SKIPE DIFSEC ;ARG BLOCK DIFFERENT THAN FOROTS' JRST BIND ;YES. GO RESOLVE MOVEM 0,(P) ;AND SAVE IT ADDI L,1 ;INCR USER ARG PNTR AOBJN P,BARGXF ;BACK FOR MORE JRST BARGDN BIND: HRR 0,AFALAD ;GET THE SUBSTITUTE ADDR TLO 0,(IFIW @) ;TURN ON LOCAL INDIRECT TLZ 0,17 ;TURN OFF OTHERS MOVEM 0,(P) ;SAVE LOCAL PNTR XMOVEI 0,@(L) ;GET 30-BIT ADDR MOVEM 0,@AFALAD ;SAVE IT ADDI L,1 ;INCR USER ARG PNTR AOS AFALAD ;INCR ADDR PNTR AOBJN P,BARGXF JRST BARGDN BIMMED: JUMPE 0,BIMED0 ;JUST STORE 0 IF ALL ZERO HRRZM 0,@AFALAD ;SAVE THE CONSTANT LOCALLY HRR 0,AFALAD ;POINT TO IT TLO 0,(IFIW) ;LOCAL ADDR BIMED0: MOVEM 0,(P) ;SAVE THE REF ADDI L,1 ;INCR USER ARG PNTR AOS AFALAD ;INCR ADDR PNTR AOBJN P,BARGXF ;BACK FOR MORE JRST BARGDN BACS: HRRZ 0,AU.ACS ;POINT TO USER'S ACS ADD 0,(L) TLO 0,(IFIW) ;LOCAL ADDR MOVEM 0,(P) ;SAVE THE REF ADDI L,1 ;INCR USER ARG PNTR AOBJN P,BARGXF ;BACK FOR MORE BARGDN: MOVE L,%CPBLK ;POINT TO COPIED LIST AOJA L,NOARGX ;POINT TO ARGS, NOT COUNT SEGMENT DATA ;*** DO NOT SEPARATE THE COUNT FROM THE LIST *** %NARGN: BLOCK 1 ;ARG COUNT ARGLST: BLOCK MAXARG ;COPY OF ARG LIST WITHOUT INDEX OR INDIRECT BITS ARGLS2: BLOCK MAXARG ;EXTENDED ADDRESS OF ARG %FSECT: BLOCK 1 ;FOROTS' SECTION NUMBER DIFSEC: BLOCK 1 ;0 = ARG LIST IN SAME SECTION AS FOROTS AFALAD: BLOCK 1 ;EXTENDED ADDRESS OF ARG SAVEP: BLOCK 1 ;STACK POINTER FOR ERRORS RETADR: BLOCK 1 ;TEMP FOR RETURN ADDRESS SEGMENT CODE ;ROUTINE TO COPY ARGS FOR IOLST. ;ALMOST IDENTICAL, BUT COMPILER DOES NOT PROVIDE ARG COUNT FOR IOLST, SO ;MUST GO THROUGH FIRST AND COUNT ARG LIST %ISAVE: MOVEM P,SAVEP ;SAVE P MOVE P,-1(L) ;GET ARG COUNT, IF THE COMPILER PROVIDED ONE JUMPL P,SAVEX ;IT DID, GO USE IT SETO P, ;Count args ISAVEL: SKIPN 1,(L) ;GET AN ARG JRST ISAVEE ;ZERO MEANS END OF LIST CAMN 1,[004000000000] ;End of IO arg list (FIN)? JRST ISAVEE ;Yes SUBI P,1 ;Count args (0= -number of args) AOJA L,ISAVEL ;Bump arg pointer and loop ISAVEE: HRLZ P,P ;GET NEG COUNT IN LEFT HALF MOVE L,AU.ACS ;GET ADDR OF USER'S SAVED ACS MOVE 1,1(L) ;RESTORE AC 1 MOVE L,L(L) ;RESTORE THE ORIGINAL LIST PNTR JRST SAVEX ;GO PROCEED LIKE NORMAL LIST SUBTTL GLOBAL CONSTANTS %CPYRT: ASCIZ/COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1984/ ;[4126] ;FORTRAN CCOC WORDS AND MASK ; @ A B C D E F G H I J K L M N O P Q R S T U V W X Y Z [ \ ] ^ _ %OCCOC: BYTE (2)2,2,2,2,2,2,2,2,2,0,2,2,0,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2 %CCMSK: BYTE (2)0,0,0,0,0,0,0,0,0,3,0,0,3,0,0,0,0,0 %OCLIT: BYTE (2)2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2 %CRLF: ASCIZ / / END