Trailing-Edge
-
PDP-10 Archives
-
FORTRAN-10_V7wLink_Feb83
-
forots.mac
There are 27 other files named forots.mac in the archive. Click here to see a list.
SEARCH FORPRM
TV FOROTS Fortran object time system,7(3253)
;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1981, 1983
;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
<small_integer>(<index_register>) 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 Revision History *****
\
ENTRY %FRSLO,INIT%
INTERN %POPJ,%POPJ1,%POPJ2,%OVNUM
INTERN %SAVE1,%SAVE2,%SAVE3,%SAVE4,%ISAVE,%SAVAC,%CPARG,%SAVIO
INTERN %PUSHT,%POPT,%JPOPT,%CRLF,%HALT,%MSLJ,%MSPAD
INTERN %STADD,%MSLVL,%NARGN,%FTAST,%FTSLB,%TRFLG
INTERN %DDBTAB,%EDDB,U.RERD,%UDBAD,%QUIET,%ABFLG,%FAREA,%FSECT
INTERN AU.ACS,%ERRCT,%ERRLM,%ERRSB,%ERRSZ,%ERRBK,%NAMLN,%EXCHN
INTERN %OCCOC,%CCMSK,%ICCOC
EXTERN %MEMINI,%ERINI,%TRPINI,%VER,%DFERR,%FUNCX
IF10,< EXTERN %CHMSK >
EXTERN %ABORT
EXTERN %GTBLK,%FREBLK,%ERNM1,%ERNM2,G.ERBF
EXTERN Z.DATA
SUBTTL VESTIGIAL JOBDAT
SEGMENT CODE
;HIGH SEG JOBDAT. INCLUDED IN TOPS-20 BECAUSE DDT KNOWS ABOUT SYMBOL
;TABLE POINTER, AND TOPS-10 PROGRAMS MIGHT NEED SOME OF THE DATA. MUST
;START ON A PAGE BOUNDARY AND MUST BE FIRST THING LOADED IN SHARABLE
;FOROTS.
F.HSO::! ;HIGH SEG ORIGIN
F.HSA:: EXP 0 ;NO START ADDRESS
F.H41:: HALT ;NO UUOS
F.HCR:: XWD 137,0 ;NO LOW SEGMENT
F.HRN:: EXP 0 ;FILLED IN BY FORHAK INITIALIZATION
F.HVR:: %VER ;VERSION NUMBER
F.HNM:: SIXBIT 'FOROT7' ;PROGRAM NAME
F.HSM:: EXP 0 ;SYMBOL PTR, MOVED FROM 116 BY FORHAK
F.HGA:: XWD F.HSO/1000,0 ;HIGH SEG STARTING PAGE NUMBER
SUBTTL DISPATCH VECTOR
DEFINE X (E) <
IF2,<IFNDEF E'%,<EXTERN E'%>>
SIXBIT /E'./
PORTAL E'%
> ;END X
DEFINE Y (E) <
IF2,<IFNDEF E'%,<EXTERN E'%>>
SIXBIT /E'./
PORTAL E'%
> ;END Y
%FRSLO=FOROT ;DEFINE IT NON-ZERO HERE
;TO TELL FORINI FOROTS IS LOADED
FOROT: FORVEC
;TOPS-20 ENTRY VECTOR
IF20,<
%EVEC:: FOROT ;START ADDRESS OF DISPATCH VECTOR
0 ;REENTER ADDRESS
%VER ;VERSION NUMBER
>
;TOPS-10 VERSION NUMBER
IF10,<
LOC 137
%VER
RELOC
> ;END IF10
SUBTTL INIT% INITIALIZATION
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
MOVEM D,DBSTP. ;SAVE ADDR OF DBMS STOP ADDR
SETZ F, ;CLEAR FLAG AC
XMOVEI T1,. ;GET EXTENDED ADDR
HLLZM T1,%FSECT ;STORE FOROTS' SECTION NUMBER
TLNE T1,-1 ;NON-ZERO SECTION?
SKIPA T1,(P) ;YES. GET WHOLE RETURN ADDR
HRRZ T1,(P) ;NO. GET LOCAL RETURN ADDR
SUBI T1,2 ;POINT TO RESET CALL
MOVEM T1,%STADD ;SAVE IT FOR TRACEBACK
XMOVEI T1,UACS ;FROM NOW ON
MOVEM T1,AU.ACS ;USER'S ACS ARE IN FOROTS DATA AREA
;GET INITIAL RUNTIME AND TIME OF DAY
IF20,<
MOVX T1,.PRIIN ;SAVE CURRENT CCOC WORDS FOR TTY
RFCOC%
DMOVEM T2,%ICCOC
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
>
IF10,<
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
>
IF10,<
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
MOVE T1,[%CNVER] ;GET MONITOR VERSION NUMBER
GETTAB T1, ; (ONLY KNOWN WAY TO DECIDE WHETHER
SETZ T1, ; USE-OPEN-CHANNEL FILOP IS IMPLEMENTED)
MOVEM T1,I.MVER
>
IF20,<
SETZM %MSLVL ;DEFAULT ON 20 IS FIRST
>
;GET RUN FILESPEC FOR OVERLAY HANDLER
IF10,<
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
GETPPN T1, ;GET PPN
JFCL
MOVEM T1,G.PPN
> ;IF10
;SET NO COMPATIBILITY PACKAGE
;FOROTS MEMORY MANAGER AND PA1050 DO NOT GET ALONG
IFN FT20UUO,<
IFN FTSHR,<
MOVE T1,[677777,,377777] ;READ IN PA1050 AND DISABLE MEM
CORE T1, ; BOUNDS CHECKING
JFCL ;WELL, WE TRIED
MOVE T1,[277777,,677777] ;SET .JBHRL CORRECTLY, PA1050 DOESN'T
MOVEM T1,.JBHRL
> ;IFN FTSHR
IFE FTSHR,<
MOVE T1,.JBHRL ;CHECK FOR HIGH SEG
JUMPE T1,NOHS ;NONE
TDO T1,[777,,777] ;ROUND UP TO PAGE BOUNDARY
HLRZ T2,T1 ;GET START ADDRESS OF HS
SUBI T1,(T2)
MOVEI T2,677777 ;GET 700000-ORIGIN-1 = LENGTH OF BIG HS
SUBI T2,(T1)
PUSH P,T2 ;SAVE IT
MOVEI T1,-1(T1) ;GET 677777,,ORIGIN-1
HRLI T1,677777
CORE T1, ;MAKE LOWSEG+HIGHSEG GO FROM 0 TO 677777
JFCL ; (WELL, MAYBE NOT)
POP P,T1 ;SET .JBHRL TO 700000-ORG-1,,677777
HRLI T1,677777
MOVSM T1,.JBHRL
JRST HSSKP
NOHS: MOVEI T1,677777 ;IF NO HIGH SEG, GROW LOW SEG TO ALL
CORE T1, ; MEMORY UP TO PA1050
JFCL
HSSKP:
> ;IFE FTSHR
> ;IFN FT20UUO
IF20,<
IFE FT20UUO,<
MOVEI T1,.FHSLF ;SET NO UUO SIMULATION
SETO T2,
SCVEC%
>
>
PUSHJ P,%MEMINI ;INITIALIZE CORE MANAGER
;RELEASE 5 WILL QUIETLY CLOSE ANY
;FILES UNMAPPED BY MEMINI AS A RESULT
;OF RESET% JSYS DONE AT INIT%.
IF20,< ;[3146] Only clobber files on Tops-20
RESET% ;HOWEVER, 5.1 STILL DOES NOT SEEM
;TO BE DOING THIS RIGHT...
> ;[3146] End of IF20
SETZM BEGZER ;CLEAR DATA THAT MUST BE ZERO ON RESTART
MOVE T1,[BEGZER,,BEGZER+1]
BLT T1,ENDZER
IF10,<
MOVSI T1,377774 ;MARK ALL I/O CHANNELS AVAILABLE
MOVEM T1,%CHMSK
MOVE T1,[%CNHXC] ;GET MAX EXTENDED CHANNEL
GETTAB T1,
SETZ T1, ;NONE
CAILE T1,17 ;ARE THERE ANY?
SETOM %EXCHN ;YES. REMEMBER TO USE THEM
> ;IF10
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
PUSHJ P,PSIINI ;INITIALIZE PSI SYSTEM
PUSHJ P,%TRPINI ;INITIALIZE TRAP HANDLER
PUSHJ P,%ERINI ;INITIALIZE ERROR SYSTEM
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
IF10,<
MOVSI T1,'TTY' ;GET IO INDEX OF CONTROLLING TERM
IONDX. T1,UU.PHY
SETZ T1,
MOVEM T1,TT.DES
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
MOVEI T4,3 ;[2064] Want three digits
INIJBN: IDIVI T1,12 ;[2064] Convert job number to SIXBIT
ADDI T2,20 ;[2064]
LSHC T2,-6 ;[2064]
SOJG T4,INIJBN ;[2064]
HLRZM T3,I.JOB ;[2064] Store SIXBIT job number
> ;IF10
IF20,<
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%
HRROI T1,DEVTMP ;CONVERT TTY: DESIGNATOR TO STRING
MOVEI T2,.CTTRM
DEVST%
ERCAL ERRIJE
MOVEI T2,":" ;END WITH COLON FOR GTJFN
IDPB T2,T1
SETZ T2, ;[2036] AND A NULL
IDPB T2,T1
MOVX T1,GJ%PHY+GJ%SHT ;NOW A PHYSICAL-ONLY GTJFN
HRROI T2,DEVTMP
GTJFN%
ERCAL ERRIJE
PUSH P,T1
DVCHR% ;AND CONVERT THAT TO A REAL DEV DESIGNATOR
ERCAL ERRIJE
MOVEM T1,TT.DES ;STORE DEV DESIGNATOR OF WHERE ERRORS GO
POP P,T1 ;RELEASE THE JFN
RLJFN%
ERCAL ERRIJE
SETO T1, ;GET BATCH STATUS
HRROI T2,I.BAT ;INTO I.BAT
MOVEI T3,.JIBAT
GETJI%
ERCAL ERRIJE
> ;IF20
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,<
PSIINI: POPJ P, ;NO PSI SETUP
>
IF20,<
PSIINI:
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,SIRBLK
XMOVEI T1,%LEVTAB ;SETUP LEVEL TABLE ADDR
MOVEM T1,SIRBLK+1
XMOVEI T1,%CHNTAB ;SETUP CHANNEL TABLE ADDR
MOVEM T1,SIRBLK+2
MOVEI T1,.FHSLF ;THIS FORK
XMOVEI T2,SIRBLK ;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
> ;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
SIRBLK: BLOCK 3 ;THE XSIR SETUP BLOCK
I.RUNTM:: BLOCK 1 ;INITIAL RUNTIME
I.DAYTM:: BLOCK 1 ;INITIAL TIME AND DATE
%ICCOC: BLOCK 2 ;INITIAL CCOC WORDS FOR .PRIIN
U.RERD: BLOCK 1 ;UNIT NUMBER FOR REREAD OPERATIONS
%MSLJ: BLOCK 1 ;MOVSLJ INST
%MSPAD: BLOCK 1 ;THE PAD CHARACTER
%FTAST: BLOCK 1 ;ASTERISKS ON FIELD WIDTH OVERFLOW
%STADD: BLOCK 1 ;START 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
DBSTP.:: BLOCK 1 ;Address of DBPST$, or 0
AU.ACS:: BLOCK 1 ;ADDRESS OF USER'S ACS
UACS: BLOCK 20 ;USERS ACS
IF20,<
DEVTMP: BLOCK 5 ;TEMP FOR DEVICE NAME OF CONTROLLING TTY
>;END IF20
IF10,<
G.PPN:: BLOCK 1 ;MY PPN
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 9 ;WHOLE PATH
I.MVER:: BLOCK 1 ;MONITOR VERSION NUMBER
I.JOB:: BLOCK 1 ;[2064] SIXBIT job number in RH
>
BEGZER:! ;FOLLOWING DATA IS ZEROED ON RESTART
BLOCK -MINUNIT ;DDB ADDRESSES OF NEGATIVE UNITS
%DDBTAB: BLOCK 1+MAXUNIT ; POSITIVE UNITS
%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
%UDBAD: BLOCK 1 ;DDB ADDRESS
CPYBLK: BLOCK 1 ;POINTER TO ALLOCATED ARGLST
CPYSIZ: BLOCK 1 ;SIZE OF ALLOCATED ARGLST
%EDDB: BLOCK 1 ;ENCODE/DECODE DDB ADDRESS
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
TT.DES:: BLOCK 1 ;DESIGNATOR OF CONTROLLING TTY
%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
%OVNUM: SETZ T2, ;NO OVERLAY, TO START
SKIPN T3,.JBOVL ;GET ROOT LINK CONTROL SECTION ADDRESS
POPJ P, ;NONE, LINK NUMBER IS 0
;Note: At this point, we can assume that FOROTS is running in section 0
; because LINK is not supposed to allow overlays in extended sections.
; Thus the address in T1 is only 18 bits.
OVLP: HRRZ T2,CS.NUM(T3) ;PC IS IN THIS LINK OR SOME FOLLOWING ONE
CAIE T3,0 ;IF NO FOLLOWING LINK, DONE
CAML T3,T1 ;DOES LINK START BEFORE SEARCH ADDRESS?
POPJ P, ;YES. LINK NUMBER IS IN T2
HRRZ T3,CS.FPT(T3) ;GET POINTER TO FOLLOWING LINK
JRST OVLP ;SEARCH ON
SUBTTL AC SAVE ROUTINES
SEGMENT CODE
;ROUTINES TO SAVE P1-P4
%SAVE1: EXCH P1,0(P) ;Save P1, get return addr
PUSHJ P,JRET1 ;STUFF RESTORE ROUTINE ADDR
JRST RET1 ;WHICH IS HERE
JRST RET11 ;SKIP RETURN
JRST RET12 ;DOUBLE SKIP RETURN
JRET1: PUSH P,P1 ;STUFF CURRENT RETURN ADDR
MOVE P1,-2(P) ;GET P1 BACK
POPJ P,
%SAVE2: EXCH P1,0(P) ;Save p1, get return addr
PUSH P,P2 ;Save p2
PUSHJ P,JRET2 ;STUFF RESTORE RETURN ADDR
JRST RET2 ;WHICH IS HERE
JRST RET21 ;SKIP RETURN
JRST RET22 ;DOUBLE SKIP RETURN
JRET2: PUSH P,P1 ;STUFF CURRENT RETURN ADDR
MOVE P1,-3(P) ;GET P1 BACK
POPJ P,
%SAVE3: EXCH P1,0(P) ;Save P1, get return addr
PUSH P,P2 ;Save P2
PUSH P,P3 ;Save P3
PUSHJ P,JRET3 ;STUFF RESTORE RETURN ADDR
JRST RET3 ;WHICH IS HERE
JRST RET31 ;SKIP RETURN
JRST RET32 ;DOUBLE SKIP RETURN
JRET3: PUSH P,P1 ;STUFF CURRENT RETURN ADDR
MOVE P1,-4(P) ;GET P1 BACK
POPJ P,
%SAVE4: EXCH P1,0(P) ;Save P1, get return addr
PUSH P,P2
PUSH P,P3
PUSH P,P4
PUSHJ P,JRET4 ;STUFF RESTORE RETURN ADDR
JRST RET4 ;WHICH IS HERE
JRST RET41 ;SKIP RETURN
JRST RET42 ;DOUBLE SKIP RETURN
JRET4: PUSH P,P1 ;STUFF CURRENT RETURN ADDR
MOVE P1,-5(P) ;GET P1 BACK
POPJ P,
RET4: POP P,P4
RET3: POP P,P3
RET2: POP P,P2
RET1: POP P,P1
POPJ P, ;Return to caller's caller.
;SKIP RETURNS
RET41: POP P,P4
RET31: POP P,P3
RET21: POP P,P2
RET11: POP P,P1
AOS (P) ;SKIP RETURN
POPJ P,
;DOUBLE SKIP RETURNS
RET42: POP P,P4
RET32: POP P,P3
RET22: POP P,P2
RET12: POP P,P1
%POPJ2: AOS (P) ;DOUBLE SKIP RETURN
%POPJ1: AOS (P) ;SINGLE SKIP
%POPJ: POPJ P, ;NONSKIP
;ROUTINES TO PUSH AND POP ALL T ACS
;Called by PUSHJ P,%PUSHT
%PUSHT: PUSH P,T1 ;SAVE T1-T5
PUSH P,T2
PUSH P,T3
PUSH P,T4
PUSH P,T5
EXCH T0,-5(P) ;SAVE T0, GET RETURN ADDRESS
PUSH P,T0 ;SAVE RETURN ADDRESS
MOVE T0,-6(P) ;RESTORE T0
POPJ P, ;RETURN
;Called by PUSHJ P,%POPT
%POPT: POP P,T0 ;GET RETURN ADDRESS
POP P,T5 ;RESTORE T5-T1
POP P,T4
POP P,T3
POP P,T2
POP P,T1
EXCH T0,(P) ;RESTORE T0
POPJ P, ;RETURN
;Called by PJRST %JPOPT
%JPOPT: POP P,T5 ;RESTORE T5-T0
POP P,T4
POP P,T3
POP P,T2
POP P,T1
POP P,T0
POPJ P, ;RETURN
;ROUTINE TO SAVE THE USER'S AC'S
%SAVAC: SKIPE %UDBAD ;I/O IN PROGRESS?
$ECALL IWI,%ABORT ;YES. DON'T WANT TO TRASH THE CURRENT ACS
%SAVIO: SETZM %ERNM1 ;CLEAR THE ERROR NUMBERS
SETZM %ERNM2
SETZM G.ERBF ;GET ERRSNS TO RETURN "NO ERROR"
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
HLRE P,-1(L) ;Get arg count (-n)
;Here with P = -number of args
SAVEX: HRLZM 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] ;See if all will fit in our block
JRST TOOMNY ;NO, GO ALLOCATE A BLOCK FOR THEM
HRLZI P,(P) ;GET COUNT IN LEFT HALF
;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) ;IFIW WITH NO TYPE
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: MOVEI L,ARGLST ;POINT TO COPIED ARG LIST
HLL L,ARGLST-1 ;PUT COUNT IN LH
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,CPYBLK ;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
MOVEM T1,CPYBLK ;SAVE ADDRESS
GOTBLK: PUSHJ P,%POPT ;RESTORE T ACS (DON'T USE T1 AFTER HERE!)
MOVE P,-1(L) ;GET ARG COUNT
MOVEM P,@CPYBLK ;SAVE IT
HRR P,CPYBLK ;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,CPYBLK ;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
TLNN 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 IND ;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) ;IFIW WITH NO TYPE
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,%NARGN ;GET COUNT
HRR L,CPYBLK ;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
HLRE 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: 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 1983/
;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
%CRLF: ASCIZ /
/
IF20,<
ERRIJE: ;ERR (IJE,?,"Impossible" JSYS error at $P - $J,,%HALT)
$ECALL IJE,%HALT
>
%HALT: ;ERROR HALT, DON'T TOUCH ANYTHING
IF10,<
EXIT 1,
>
IF20,<
HALTF%
>
JRST .-1
;IF TOPS-20, CREATING DATA PAGES IS RELATIVELY EASY
IF20,<
MAKDP: POPJ P,
>;END IF20
;IF TOPS-10 AND NON-SHARE, ALSO EASY
IF10,<
IFE FTSHR,<
MAKDP: POPJ P,
>>;END IF10 & IFE FTSHR
;IF TOPS-10 SHARABLE FOROTS, MAKE DATA PAGES
IF10,<
IFN FTSHR,<
MAKDP: MOVEI T2,1 ;SET LENGTH OF PAGE. ARG BLOCK
MOVEI T3,.DATA./1000 ;GET FIRST PAGE TO CREATE
MOVEI T4,<Z.DATA-.DATA.+777>/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 & IFN FTSHR
END