Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

	SEARCH	MTHPRM,FORPRM
	TV	FOROTS	Fortran object time system,10(4174)

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1986
;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
	<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 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,<F.BHS-F.BOT>/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