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

	UNIVERSAL FORPRM	UNIVERSAL FILE FOR FOROTS ,10(4203)

;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.


	SALL

;REVISION HISTORY


COMMENT \

***** Begin Revision History *****

1267	EGM	15-Feb-81	Q10-04519
	Clean up FORPRM, add checks for feature test conflicts, and
	rework byte definition such that macro GLBS references and
	macro BYTPTS defines byte pointers for ALL bytes defined in
	the DDB.

1271	EGM	18-Feb-81	--------
	Allow DEFSTR storage macros to use previously defined DDB byte
	pointer when indexing using (d), and allow the other cases to
	work correctly also.

1276	DAW	20-Feb-81
	Copy useful field/mask macros from MACSYM:
	FLD, POINTR.

1277	JLC	23-Feb-81
	Created new DDB entry for rounded record size (RSIZR) plus
	added bytes/word entry (BPW) to -10 (removed it from -20-only).

1301	JLC	24-Feb-81
	Created new DDB entry for line sequence number.

1310	DAW	26-Feb-81
	Change half-words to full-words in the DDB: ERR=, END=, IOST=, AVAR=
	that are addresses in the user's program or data.

1314	EDS	4-Mar-81
	Add feature test switch FTNLC1 to allow skipping of column 1
	of NAMELIST input data.

1316	JLC	5-Mar-81
	Separated flag D%LIO (last I/O direction) into 2 flags, D%LIN
	and D%LOUT.

1320	DAW	6-Mar-81
	New feature test switches for type of global byte pointer
	to use, when indexed byte pointers are not appropriate.

1334	DAW	19-Mar-81
	Define macros for dealing with the different flavors of byte
	pointers:  $BLDBP, $LODBP, $STRBP.

1337	JLC	12-Mar-81
	Moved MAXARG definition from FOROTS.MAC to here, and increased
	it to 128.

1365	JLC	25-Mar-81
	Typo in renaming of IBPTR/OBPTR to IPTR/OPTR.

1377	JLC	01-Apr-81
	Changed FLGS from a 36-bit byte to a word (FLAGS).

1404	EGM	6-Apr-81	--------
	Add feature test FTGFL for checking GFLOAT args in complex double
	precision library routines.

1411	DAW	8-Apr-81
	Replace JFN field in the DDB with IJFN and OJFN.

1416	JLC	10-Apr-81
	Separate record buffer parameters for input and output.

1417	DAW	10-Apr-81
	Added F%EDM, so FOROTS knows it should type traceback info
	before throwing the user into DIALOG mode, when the reason
	for the DIALOG mode is because of an OPEN error.

1427	JLC	15-Apr-81
	Changed RSIZ from a halfword to a full word (RSIZE) so
	we can eliminate flag D%RSIZ.

1441	JLC	17-Apr-81
	Removed D%RSIZ, replaced with D%OPEN for future use in CLOSE.

1456	PY/JLC	27-Apr-81
	Remove extra angle brackets from POINTR macro, was causing
	MACRO to create Polish string in pass 2 after pooling literals
	in pass 1, so hiseg break was incorrect.

1463	JLC	7-May-81
	Add new words to -20 file database (WADR,WSIZ) plus
	places to store P1-P4 for %GETIO.

1464	DAW	12-May-81
	Error message cleanup, also get rid of $2HAK.

1465	JLC	15-May-81
	Added data words to the -20 disk database for major I/O
	changes, mostly to magtape operations.

1532	DAW	14-Jul-81
	OPEN rewrite: Base level 1

1535	JLC	14-Jul-81
	Added word for virtual output record size for T format.

1540	DAW	17-Jul-81
	Delete IS from DDB, use IOSTAT variable directly.
	Set IOSTAT variable to zero at the start of each IO statement.
	Set D%ERR if "?" error in IOERR.

1542	JLC	17-Jul-81
	Removed D%EOF, hopefully forever.

1543	DAW	17-Jul-81
	Allow SCRATCH files to devices besides DSK.

1551	DAW	20-Jul-81
	Fix structure macros so "MOVE" of a quantity that's not full-word
	produces a "Q" error.

1560	DAW	28-Jul-81
	OPEN rewrite, base level 2

1570	DAW	30-Jul-81
	Add flag F%NION.

1615	DAW	19-Aug-81
	Get rid of two word BP options.

1622	JLC	21-Aug-81
	Make ORLEN a full word.

1625	DAW	21-Aug-81
	Get rid of "DF".

1643	JLC	25-Aug-81
	Make IRBUF & ORBUF full word byte pntrs.

1656	DAW	2-Sep-81
	Define error table entries symbolically to get rid
	of some magic numbers all over FOROTS.

1657	DAW	2-Sep-81
	Delete 7.01 definitions.

1663	JLC	8-Sep-81
	Added TPAGE(D) to record top page written in a file,
	so CLOSE can unmap unused pages.

1712	JLC	15-Sep-81
	Added IRVIR, the position in the input record.
	Eliminated D%ERR forevermore.

1716	JLC	16-Sep-81
	Changed the names of IRVIR/ORVIR to IRPOS/ORPOS.

1717	DAW	16-Sep-81
	New flag D%NCLS

1725	DAW	18-Sep-81
	New error flag I%TCH.

1745	JLC	24-Sep-81
	Made IRBLN, ORBLN, and IRLEN full words. Removed the silly %
	from the TV macro.

1747	DAW	28-Sep-81
	Added defs for more FOROP. functions.

1752	DAW	29-Sep-81
	Add flag F%INDST.

1775	JLC	9-Oct-81
	Change parity options to be non-zero, so we can tellif program
	gave one.

2005	JLC	15-Oct-81
	Added new FOROP call, removed OPDEF of PJRST.

2011	DAW	19-Oct-81
	Got rid of FSTAT on the -10.

***** Begin Version 7 *****

3035	JLC	5-Feb-82
	Parameters to support rework of binary I/O. Make KL the
	default processor, as KI's are no longer supported.
	Do away with D%BIN, D%UNF and D%EOR, as code in FORIO
	and FOROPN no longer needs them.

3036	BL	10-Feb-82
	Inserted NLBFLN, initial buffer length for list-directed
	character string input buffer.

3037	JLC	11-Feb-82
	Removed ERRN from DDB; it was useless.

3050	BL	25-Feb-82
	Changed NLBFLN TO NLDIBF (See #3036).

3053	AHM	4-Mar-82
	Defined TWOSEG and RELOC macros  under an FTXLIB feature  test
	that expand to .PSECT and .ENDPS pseudo ops for psects  .CODE.
	and .DATA.   They  will  be used  during  extended  addressing
	development.

3056	JLC	23-Mar-82
	Changed the defs of IOERR and ERR to remove literal def.

3060	JLC	25-Mar-81
	Remove RELEA. entry vector. Replace it with EXIT1.

3062	JLC	25-Mar-82
	Make the error entry in the FOROTS vector table point
	to the AC save-type routine.

3073	JLC	31-Mar-82
	Undo edit 3062. The error routine saves the ACs locally, and
	should continue doing so.

3122	JLC	28-May-82
	Changed error macros, made FORPRM a module added to MTHPRM.

3125	JLC	3-Jun-82
	Moved the error character in the error macros.

3127	AHM	8-Jun-82
	Remove temporary TWOSEG and RELOC macros created by edit  3053
	from FORPRM because edit 3122 put SEGMENT macros in FORLIB.

3136	JLC	26-Jun-82
	Install new DDB entries for performance improvement.

3161	JLC	16-Aug-82
	Change NREC(U) to CREC(D). Increase size of FOROTS stack
	to a page.

3165	JLC	28-Aug-82
	Add a DDB entry for handling large files on TOPS-10.

3176	JLC	9-Sep-82
	Added some FUNCT. codes for use within FOROTS.

3202	JLC	26-Oct-82
	Added new DDB entries for ANSI magtapes.
	Added SPCWD, a word of spaces, to the DDB.

3203	AHM	1-Nov-82
	Define a lot more FUNCT. codes for use outside of FOROTS.

3212	JLC	11-Nov-82
	Removed special binary SINR pointer and byte ratio and added
	flag to signal whether to do formatted or 36-bit SINRs/SOUTRs.

3215	JLC	15-Nov-82
	Change name of DMBS (data mode and byte size) to DMABS.

3225	JLC	24-Nov-82
	Install new call ($FJCAL) for JSYS errors from FORLIB.

3231	JLC	14-Dec-82
	Add new FOROTS entry macro FENTRY, for use with DBMS
	interface, and allows changing the lowseg/hiseg interface
	easily for V8.

3245	JLC	5-Jan-83
	Fixed value of ENDP for DBMS.

3252	JLC	12-Jan-83
	Created FORPRG macro to purge global symbols created by MONSYM
	which do not have "%" or "." in them.

***** End V7 Development *****

3276	TGS	22-Mar-83	SPR:NONE
	Fixed value of ENDP for UDDT

3300	TGS	1-Apr-83	SPR:NONE
	Delete FTGFL flag as it is also defined in MTHPRM.  Move ARGKWD,
	ARGTYP and ARGADR from FORPRM to MTHPRM (MTHLIB edit 3242).

***** Begin Version 10 *****

4000	JLC	22-Feb-83
	Remove D%IO and D%RAN, as they are used no more.

4005	JLC	28-Feb-83
	Added DDB entry for FIN address.

4006	JLC	1-Mar-83
	V7 becomes v10.

4010	JLC	19-Apr-83
	Add IOKWD, for I/O keywords in IOLST calls.

4014	JLC	14-Jun-83
	Changed names of some DDB variables so they wouldn't conflict
	with definitions in MACSYM and MONSYM. Expand CC for CC.TRN.
	Add definitions for INQUIRE and RMS/tape support.

4023	JLC	29-Jun-83
	Remove FTSHR, D%SP, and D%BZ. Search MTHPRM.

4036	JLC	3-Aug-83
	Add a word flag for ASCII-only device.

4040	JLC	6-Sep-83
	Add FB%FOR temporarily until it is defined in MONSYM.

4044	JLC	19-Sep-83
	Added new FOROP functions for memory manager debugger, and
	left room for the SORT functions for V7A patch.

4045	JLC	30-Sep-83
	Removed UBSZ from DDB. Added a new device type - RMS file.

4052	JLC	12-Oct-83
	Add word for saving DEVCHR bits so we can know
	whether magtape is assigned.

4055	JLC	28-Oct-83
	Added synonym for IJFN/OJFN in TOPS-10 FILOP block.

4060	JLC	2-Nov-83
	Fix TOPS-10 tapemode values, had one missing.

4064	JLC	14-Nov-83
	Add new RMS keywords for OPEN.

4065	JLC	6-Dec-83
	Add new entries in DDB for RMS.

4066	JLC	11-Jan-84
	Yet more entries in the DDB for the RMS preparations.

4071	JLC	18-Jan-84
	Fixed BLANK= values for new code in FOROPN.

4072	JLC	24-Jan-84
	Add new DDB variables for user id, account string, and password
	for RMS remote file access.

4101	CDM	16-Feb-84
	Create and expand the  character stack differently when  running
	in extended addressing.   Give the stack  its own section(s)  so
	that it has plenty of room.  Also add user subroutine ALCCHR.

4102	JLC	17-Feb-84
	Add yet more DDB variables for RMS, plus some flags for
	compatibility flagging, and a MACRO to call the compatibility error
	entry point.

4104	JLC	23-Feb-84
	Remove $CERR, as it is not needed after all.

4105	JLC	28-Feb-84
	Modify the calling sequence for error calls.

4111	JLC	16-Mar-84
	Modify the calling sequence for error calls again.

4112	JLC	19-Mar-84
	Remove FDBMS from FORVEC, as it is no longer necessary.

4114	JLC	28-Mar-84
	Remove I%TCH on TOPS-10, as it is almost useless
	and didn't work anyhow.

4116	JLC	6-Apr-84
	Add DT.NUL for TOPS-10, same as DT.DSK.

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
	Add some MONSYM symbols to the TOPS-10 parameters for TABLK.

4124	JLC	8-May-84
	Fix some AC definitions.

4127	JLC	15-May-84
	Add some TOPS-10 UUOSYM definitions.

4131	JLC	12-Jun-84
	Remove some F flags.

4132	JLC	15-Jun-84
	Increased size of IOKWD to 17 from 7.

4135	JLC	10-Jul-84
	Add TMPFIL for temporary files on TOPS-20. Add PPNSTR for TOPS-10
	style PPNs for TOPS-20.

4144	JLC	29-Aug-84
	Add keyword and table values for DISPOSE='PLOT'.

4152	JLC	24-Sep-84
	Add symbols for symbol vectors in PDVs.

4153	JLC	27-Sep-84
	Add a new offset (FSTAD) for the initialization arg block.

4155	JLC	4-Oct-84
	Change FO$SBA to FO$GBA, since it now gets the break address
	rather than setting anything. Move $DCALL and $DJCAL here
	from MTHPRM.

4161	JLC	1-Nov-84
	Change ASCFLG to IMGFLG, indicating that the device in question is
	an image-mode device which cannot have LSCWs. This will then include
	the ASCII-only devices. Remove all tests of MODE(D)=MD.IMG, since
	this test is not general enough; instead just check IMGFLG.
	Widen CNSL1 and CNSL2 in DDB to full-word addresses.

4171	JLC	29-Nov-84
	Add some 7.03 parameters and set .RBMAX to its 7.03 value so
	that CARRIAGECONTROL='FORTRAN' will work when the customers
	receive 7.03.

4174	JLC	9-Jan-85
	Remove private definition of .RBMAX, since the TOPS-10 monitor
	group wedged the carriage control bits into the current RIB.

4200	TGS	28-Jan-85
	Implement V7 edit 3442: Initialize ENDP/%ENDP to 777. In section
	0, set %ENDP for MINILP to 763 if DDT is in core; if not, leave
	at 777. For non-zero sections, simply set page 777 as unavailable.
	(Modules FORPRM, FORMEM)

4203	JLC	13-Mar-85
	Add user-supplied bytesize (UBSIZ) to DDB, to differentiate it
	from the actual bytesize of the file.

***** End V10 Development *****

***** End Revision History *****
\

	SEARCH	MTHPRM
IF10,<	SEARCH	UUOSYM>
IF20,<	SEARCH	MONSYM>

;INSTALLATION-DEPENDENT PARAMETERS

;FT10			;TOP10 (NONZERO=YES)
;FT20			;TOPS-20 (NONZERO=YES)
;FTKL			;KL/KS PROCESSOR (NONZERO=YES)
;FTPSCT			;PSECTED FOROTS (NONZERO=YES)
;FTVAX			;ALL UNITS ARE DSK: EXCEPT 5, WHICH IS TTY (NONZERO=YES)
;FTDSK			;ALL UNITS DEFAULT TO DSK: (NONZERO=YES)
;FTAST			;ASTERISK FILL; FIELD WIDTH OVERFLOW (NONZERO=YES)
;STARTP			;PAGE TO START LOOKING FOR MEMORY
;FTNLC1			;IGNORE DATA IN COL 1 OF NAMELIST INPUT (NONZERO=YES)
;FTGGL			;GFLOATING DOUBLE PRECISION LIBRARY CHECKS
;WRNCNT			;*UNSUPPORTED* NUMBER OF WARNINGS OF A SPECIFIC
;			; TYPE THAT GET PRINTED. FOROTS's default is 2.

;DEFAULTS:
;FT20:		NO
;FT10:		NO
;FTKL:		YES IF NO PROCESSOR SPECIFIED
;FTPSCT:	NO
;FTVAX:	NO
;FTDSK:		NO
;FTAST:		YES
;STARTP:	577
;FTNLC1:	NO

IFNDEF FTMATH,<?PRINTX MODULE MUST BE ASSEMBLED WITH MTHPRM.MAC
		END>

IFNDEF FTVAX,<FTVAX==0>		;UNITS DON'T DEFAULT TO VAX DEVICE TABLE
IFNDEF FTDSK,<FTDSK==0>		;ALL UNITS DON'T DEFAULT TO DEVICE DSK
IFNDEF FTAST,<FTAST==-1>	;ASTERISK FILL
IFNDEF STARTP,<STARTP==577>	;600 UP ARE LAST USED BY FOROTS MEMORY MGR
IFNDEF FTNLC1,<FTNLC1==0>	;DO NOT SKIP COLUMN 1 ON NAMELIST INPUT
IFNDEF WRNCNT,<WRNCNT==2>	;Number of warnings of a specific type
				; that get printed.

;FOROTS AC DEFINITIONS

	D==S1			;POINTER TO CURRENT DDB
	U==S2			;THE UNIT BLOCK POINTER
	F==S3			;LOCAL FLAGS
	FREEAC==S4		;FOR NOW, IT'S THE "FREE AC"

;BYTE POINTER AND BYTE SIZE DEFINITIONS

	IBPW==5			;CURRENTLY 5 BYTES/WORD INTERNALLY IN FOROTS
	IBSZ==7			;BYTE SIZE = 7
	IFBYT==<POINT 7>	;ONE-WORD LOCAL FIRST BYTE POINTER
	IFOWG==<610000,,0>	;ONE-WORD GLOBAL FIRST BYTE POINTER

;$BLDBP - build byte ptr from address, when you want a 7-bit
;	byte pointer that will give you first byte at the address
;	when you ILDB.

	DEFINE $BLDBP (AC),<
		TLNE	AC,-1	;Skip if local address
		 TXOA	AC,B1WBP7 ;Global address, make BP and skip
		HRLI	AC,(POINT 7,) ;Local address, make BP
	>

;OTHER DEFS

	RWKWD==17B8		;READ, WRITE KEYWORDS GO FROM 0 TO 17 ONLY
	IOKWD==17B8		;I/O KEYWORDS GO FROM 0 TO 17 ONLY
	MOSBSZ==6		;MTOPR STATUS BLOCK SIZE
	BUFNM==4		;DEFAULT BUFFER COUNT - NUMBER OF PAGES/FILE
	CHMSIZ==200		;MINIMUM SIZE TO ADD TO FN%GAD CHAR STACK CALLS
	ETBSIZ==^D30		;ERROR TABLE SIZE FOR ERRSET, ETC.
	IFMTSZ==200		;INITIAL FORMAT ENCODING AREA SIZE
	LPDL==1000		;LENGTH OF STACK
	LRECBF==^D80		;INITIAL LENGTH OF RECORD BUFFER, BYTES
	LTEXTW==100		;LENGTH OF BUFFER FOR FULL FILESPEC
	LTEXTC==LTEXTW*5		;# CHARACTERS IN FILESPEC BUFFER
	LATOMW==40		;ATOM BUFFER LENGTH
	LATOMC==LATOMW*5	;AND IN CHARS
	NLDIBF==^D140		;List-directed input character string buffer
				;byte length
	FLSIZE==20		;INITIAL SIZE OF LS FREE LIST
	PLEN==1			;LENGTH OF PAGE. ARG BLOCK
				;*** DO NOT SET ABOVE 1 UNTIL MONITOR FIXED
	FMTN==^D47		;POINTERS TO ENCODED FORMAT STATEMENTS

	INQUNT==-^D12		;INQUIRE
	IFIUNI==-^D11		;INTERNAL FILE INPUT
	IFOUNI==-^D10		;INTERNAL FILE OUTPUT
	ENCUNI==-^D9		;ENCODE
	DECUNI==-^D8		;DECODE
	MINUNIT==-7		;MIN LEGAL UNIT NUMBER
	RRUNIT==-6		;REREAD UNIT
	MAXUNIT==^D99		;MAX LEGAL UNIT NUMBER
	MAXPDV==5		;MAX PDVS TO SCAN AT ONCE

	MAXARG==^D128		;MAX # ARGS IN AN I/O LIST

	VFOROTS==10		;FOROTS MAJOR VERSION
				;FORHST.MAC DEFINES WHOLE VERSION NUMBER

	B1WBP7==<61>B5		;Bits to TXO when you want a one-word
				;global byte pointer, 7-bits, such that
				;ILDB gets first byte in the word.

;Character stack

	ICHRSZ==1000	;Create 1 page non-extended character stack
	ECHSIZ==1	;Minimum words for extended char stack

;COMPATIBILITY FLAGGING INDICES

	VAXIDX==1		;INDICATES VAX FLAGGING
	ANSIDX==2		;INDICATES ANSI-77 FLAGGING

;PROCESSOR-DEPENDENT DEFAULTS
IF20,<
	ENDP==777		;[3276][4200] TOP OF CORE ON -20 (LEAVE UDDT)
	PRTDIG==6		;6 DIGITS IN PROTECTION

> ;END IF20

IF10,<
	ENDP==775		;TOP OF CORE ON -10 (LEAVE PFH)
	PRTDIG==3		;3 DIGITS IN PROTECTION

> ;END IF10


;CHARACTER CONSTANTS

	.CHLAB==74		;Left angle bracket "<"
	.CHRAB==76		;Right angle bracket ">"

;MISCELLANEOUS DEFINITIONS

IF10,<
;TOPS-10 DEFINITIONS NOT IN RELEASE 7.01 UUOSYM

	ERDAJ%==52		;UNIT ASSIGNED TO ANOTHER JOB
	ERNFC%==57		;NOT ENOUGH CHANNELS

;PAGE. UUO FUNCTIONS

	.PAGSC==12		;SECTION MANIPULATION
	PG.GSF==1B0		;FOR .PAGSC, 1=DESTROY, 0=CREATE SECTION
	PG.GMS==1B1		;FOR .PAGSC, MAP SECTIONS TOGETHER

;FOROTS-10 DEFINITIONS FOR TOPS-20 SYMBOLS

	CM%FW==1B7		;FLAG WORD IN TABLK TABLE
	CM%ABR==1B33		;THIS IS AN ABBREVIATION STRING
	CM%INV==1B35		;INVISIBLE (NOT ACTUALLY USED BY FOROTS-10)

;FOROTS DEFINITION OF .RBTYP (AND OTHER 7.03 PARAMETERS)
;SO FORTRAN CARRIAGE CONTROL
;WILL WORK WHEN THE CUSTOMER PUTS UP 7.03

	.RBTYP==22		;FILE TYPE WORD
	  RB.DEC==1B0		;TELLS TOPS-10 TO PAY ATTENTION TO .RBTYP
	  RB.DCC==77B35		;CARRIAGE CONTROL
	    .RBCFO==1		;FORTRAN CARRIAGE CONTROL

> ;END IF10

IF20,<

	GT%ARG==1B22		;Arg block supplied for GET
	GT%BAS==1B2		;BASE-address word supplied in arg block
	FB%FOR==100000		;NOT DEFINED IN FIELD IMAGE MONSYM
	JS%NOD==400000,,0	;NOT DEFINED IN 5.1 MONSYM

	OPDEF	XGVEC%	[JSYS 606] ;[3156] Get extended entry vector info
	OPDEF	XSVEC%	[JSYS 607] ;[3156] Set extended entry vector info
	OPDEF	PDVOP%	[JSYS 603] ;[4120] MANIPULATES PROGRAM DATA VECTORS

;FUNCTION CODES ACCEPTED IN AC1:

.POGET==:0			;GET A SET OF PDVAS
				;(PROGRAM DATA VECTOR ADDRESSES)

;ARG BLOCK OFFSETS FOR BLOCK ADDRESSED BY AC2

.POCT1==:0			;SIZE OF ARG BLOCK INCLUDING THIS WORD
.POPHD==:1			;PROCESS HANDLE
.POCT2==:2			;SIZE OF DATA BLOCK (AND SIZE OF RETURNED DATA)
.PODAT==:3			;ADDRESS OF DATA BLOCK
.POADR==:4			;SMALL ADDRESS OF DATA VECTOR
.POADE==:5			;LARGE ADDRESS OF DATA VECTOR ADDRESS RANGE

;OFFSETS DEFINED WITHIN PROGRAM DATA VECTORS

.PVCNT==:0			;Length of vector
.PVNAM==:1			;Address of a word-aligned ASCIZ program name
.PVMEM==:5			;Address of a block describing program memory
.PVSYM==:6			;Address of the program symbol table

;[4120] PVMEM BLOCK (NOT YET IN MONSYM)
.PMCNT==:0			;COUNT OF ALL WORDS IN BLOCK
.PMDAT==:0			;HEADER FOR SUB-TABLE (BITS,,LENGTH)
.PMLOW==:1			;XFIW FOR BLOCK LO ADDRESS
.PMHI==:2			;XFIW FOR BLOCK HI ADDRESS
.PMRES==:3			;RESERVED TO DEC

;SYMBOL VECTOR DEFINITIONS
.STLEN==0			;SYMBOL VECTOR LENGTH
.STDAT==0			;TYPE AND SYMBOL TABLE LENGTH WORD
ST%TYP==77B5			;SYMBOL TABLE TYPE
ST%LEN==7777777777B35		;SYMBOL TABLE LENGTH
.STPTR==1			;SYMBOL TABLE POINTER WORD
.R50D==1

> ;END IF20


;FOROTS INITIALIZATION ARG BLOCK PARAMETERS

FDBS==0				;ADDRESS OF DBSTP$
FLAL==1				;ADDRESS OF USER FIXUP ARG BLOCK
FLGVX==2			;VALUE OF VAX FLAGGER
FLG77==3			;VALUE OF ANSI FLAGGER
FSTAD==4			;ADDRESS OF LOCATION CONTAINING START ADDRESS


;FOROP FUNCTIONS

FO$APR==0			;READ APR TABLE ADDRESSES
FO$ILL==1			;READ ILL FLAG ADDRESS
FO$ERR==2			;READ ERRSNS INFO
FO$DIV==3			;Set DIVERT unit
FO$HSP==4			;READ HIGH SEG SYMBOL POINTER
FO$FSV==5			;ENCODE A FORMAT
FO$FCL==6			;DELETE IT
FO$GLN==7			;GET THE CURRENT LSA LINE NUMBER
FO$MEM==10			;RETURN VARIOUS MEMORY PARAMETERS
FO$CHN==11			;RETURN ADDR OF CHANNEL WORD
FO$QIT==12			;QUIET EXIT FROM FORTRAN
FO$GDV==13			;Get DIVERT unit
FO$CLS==14			;CLOSE ALL FILES
FO$GCH==15			;GET CHANNEL # (-10) OR JFN (-20)
FO$GFB==16			;GET FILOP BLK ADDR (-10) OR 0 (-20)
FO$GFU==17			;GET FIRST FREE UNIT NUMBER
FO$GBA==20			;GET FORDDT BREAK ADDRESS FOR FOROTS ERRORS
FO$NOS==21			;SET FOROTS FOR NO SORT IN FOROTS' SECTION
FO$SRT==22			;PREMARK SORT SPACE IN FOROTS' SECTION
FO$UDB==23			;[3432] GET ADDRESS OF %UDBAD
FO$PAT==24			;GET AND ALLOW PA1050
FO$SVF==25			;SET FOROTS TO SAVE ENCODED FORMATS
FO$NSF==26			;SET FOROTS TO NOT SAVE ENCODED FORMATS
FO$DEF==27			;DEALLOCATE ENCODED FORMATS
FO$DMM==30			;SET DEBUG SWITCH FOR MEMORY MANAGER

.ETMAX==^D100			;Maximum FOROTS error msg # is 99

;MNEMONICS FOR OPEN/CLOSE KEYWORD NUMBERS


OK.IGN==0			;OMITTED ARG, IGNORED
OK.DIA==1			;DIALOG
OK.ACC==2			;ACCESS
OK.DEV==3			;DEVICE
OK.BFC==4			;BUFFER COUNT
OK.BLK==5			;BLOCK SIZE
OK.FIL==6			;FILE
OK.PRO==7			;PROTECTION
OK.DIR==10			;DIRECTORY
OK.LIM==11			;LIMIT
OK.MOD==12			;MODE
OK.FLS==13			;FILE SIZE
OK.REC==14			;RECORD SIZE
OK.DISP==15			;DISPOSE
OK.VER==16			;VERSION
OK.ORG==17			;ORGANIZATION
OK.SHR==20			;SHARED
OK.IOS==21			;IOSTAT
OK.ASV==22			;ASSOCIATE VARIABLE
OK.PAR==23			;PARITY
OK.DEN==24			;DENSITY
OK.BLNK==25			;BLANK
OK.CC==26			;CARRIAGE CONTROL
OK.FORM==27			;FORM
OK.BYT==30			;LABELS
OK.PAD==31			;PADCHAR
OK.RTP==32			;RECTYPE
OK.STAT==33			;STATUS
OK.TAPM==34			;TAPE MODE
OK.RO==35			;READONLY
OK.UNIT==36			;UNIT
OK.ERR==37			;ERR
OK.XST==40			;EXIST
OK.FRM==41			;FORMATTED
OK.NMD==42			;NAMED
OK.NRC==43			;NEXTREC
OK.NBR==44			;NUMBER
OK.OPN==45			;OPENED
OK.SEQ==46			;SEQUENTIAL
OK.UNF==47			;UNFORMATTED
OK.NAM==50			;NAME
OK.KEY==51			;KEY

;MNEMONICS FOR READ/WRITE/BACKSPACE (& FRIENDS) KEYWORD NUMBERS

IK.IGN==0			;OMITTED ARG, IGNORED
IK.UNIT==1			;UNIT
IK.FMT==2			;FMT
IK.FMS==3			;FORMAT SIZE
IK.END==4			;END
IK.ERR==5			;ERR
IK.IOS==6			;IOSTAT
IK.REC==7			;REC
IK.NML==10			;NAMELIST ADDRESS
IK.MTOP==11			;MTA OP CODE
IK.HSA==12			;HOLLERITH STRING (ENCODE/DECODE) ADDRESS
IK.HSL==13			;HOLLERITH STRING LENGTH, CHARS

;ORTHOGONAL DISPOSE/STATUS INDEX VALUES

SD.ILL==-1		;ILLEGAL
SD.NOU==0		;NOTHING, UNKNOWN
SD.NOS==1		;NOTHING, SAVE
SD.NOD==2		;NOTHING, DELETE
SD.NOX==3		;NOTHING, EXPUNGE
SD.PRU==4		;PRINT, UNKNOWN
SD.PRS==5		;PRINT, SAVE
SD.PRD==6		;PRINT, DELETE
SD.PRX==7		;PRINT, EXPUNGE
SD.PUU==10		;PUNCH, UNKNOWN
SD.PUS==11		;PUNCH, SAVE
SD.PUD==12		;PUNCH, DELETE
SD.PUX==13		;PUNCH, EXPUNGE
SD.SUU==14		;SUBMIT, UNKNOWN
SD.SUS==15		;SUBMIT, SAVE
SD.SUD==16		;SUBMIT, DELETE
SD.SUX==17		;SUBMIT, EXPUNGE
SD.PLU==20		;PLOT, UNKNOWN
SD.PLS==21		;PLOT, SAVE
SD.PLD==22		;PLOT, DELETE
SD.PLX==23		;PLOT, EXPUNGE

;FLAG BITS


	DEFINE	FLG (F) <
 %F==%F_-1
 F==%F_1>


;F: LOCAL FLAGS
;  Set to initial value at start of each I-O statement

%F==1B0
	FLG	F%ETP		;TYPE "E" FOR SCIENTIFIC NOTATION
	FLG	F%DTP		;TYPE "D" FOR SCIENTIFIC NOTATION
	FLG	F%GTP		;G FORMAT


;PERMANENT FLAGS, LEFT UNTIL EXPLICITLY CLEARED

%F==1B0
	FLG	D%WRT		;WE HAVE WRITE ACCESS TO FILE
	FLG	D%SEOL		;SUPPRESS NEXT END OF LINE SEQUENCE
	FLG	D%PDOL		;DOLLAR FORMAT IN PREVIOUS RECORD
	FLG	D%END		;EOF REACHED IN FILE
	FLG	D%MOD		;(20) DISK FILE MODIFIED, MUST UPDATE FDB
	FLG	D%IN		;FILE IS OPEN FOR INPUT
	FLG	D%OUT		;FILE IS OPEN FOR OUTPUT
	FLG	D%OPEN		;Explicit OPEN statement has been done

;TEMP FLAGS, CLEARED AT START OF EACH I/O STATEMENT

	FLG	D%STCR		;$ FORMAT IN THIS RECORD
	FLG	D%NML		;NAMELIST I/O
	FLG	D%LSD		;LIST-DIRECTED I/O

;Here are the flags to clear
	D%CLR== D%STCR+D%NML+D%LSD

;FLAGS FOR USE IN IOERR MACRO

%F==1B0
	FLG	I%REC		;TYPE ERRONEOUS RECORD WITH ARROW UNDER IT
	FLG	I%REC1		;SAME AS ABOVE BUT MOVE ARROW LEFT 1 CHAR
	FLG	I%FMT		;TYPE FORMAT STATEMENT WITH ARROW UNDER IT
	FLG	I%JERR		;ERROR CONTAINS $J, MUST GET ERROR # IN T1


	PURGE %F

;MACRO DEFINITIONS



;FOROTS ENTRY VECTOR

	DEFINE	FORVEC <

X	INIT		;FOROTS INITIALIZATION
X	FORER		;ERROR PROCESSOR
X	OPEN		;DEVICE OPEN
X	CLOSE		;DEVICE CLOSE
X	EXIT1		;CLOSE ALL FILES
X	IN		;FORMATTED INPUT
X	OUT		;FORMATTED OUTPUT
X	RTB		;UNFORMATTED BINARY INPUT
X	WTB		;UNFORMATTED BINARY OUTPUT
X	ENC		;ENCODE
X	DEC		;DECODE
X	NLI		;NAMELIST INPUT
X	NLO		;NAMELIST OUTPUT
X	IOLST		;INPUT/OUTPUT LIST ITEM PROCESSING
X	FIN		;INPUT/OUTPUT LIST TERMINATION
X	MTOP		;DEVICE POSITIONING/UTILITY FUNCTIONS
X	FIND		;RANDOM ACCESS RECORD FIND
X	EXIT		;PROGRAM TERMINATION
X	ALCOR		;DYNAMIC CORE ALLOCATION
X	DECOR		;DYNAMIC CORE DEALLOCATION
X	ALCHN		;ALLOCATE AN I/O CHANNEL
X	DECHN		;DEALLOCATE AN I/O CHANNEL
X	TRACE		;TRACEBACK OF ROUTINE CALLS
X	FUNCT		;GENERAL OTS INTERFACE
X	INQU		;INQUIRE BY UNIT
X	FOROP		;MISCELLANEOUS LIBRARY UTILITIES
X	IFI		;INTERNAL FILE INPUT
X	IFO		;INTERNAL FILE OUTPUT
X	MTHER		;MATH LIBRARY ERROR
X	ABORT		;ABORT WITH TRACE
X	INQF		;INQUIRE BY FILE

> ;END FORVEC

	DEFINE	FENTRY	(NAME1,NAME2)

<	ENTRY	NAME1'.
	SIXBIT	/NAME1'./
NAME1'.:

IFNB <NAME2>,
<	ENTRY	NAME2'.
NAME2'.:
> ;END IFNB NAME2

> ;END FENTRY

;FATAL JSYS ERROR REPORTING
; E.IJE (AND ERRIJE) LIVE IN FOROTS, AND WHEN INVOKED WILL
; TELL WHERE THE ERROR OCCURED AND HALT.

IF20,<
	DEFINE	JSHALT <
  IF2,<IFNDEF E.IJE,<EXTERN E.IJE>>
	ERCAL	E.IJE
 > ;END JSHALT
> ;END IF20

;STACK VARIABLE MACROS

;ALLOCATE ROOM FOR VARIABLES ON THE STACK
; GIVEN THE LIST OF VARIABLES 'L', COUNT
; THE NUMBER OF ITEMS, DEFINE THEM USING THE
; NAME GIVEN IN THE LIST 'L', ADJUST THE STACK
; UP FOR ALLOCATION, AND DEFINE THE UNSTK MACRO
; TO ADJUST THE STACK SIZE BACK DOWN

	DEFINE	STKVAR (L) <
 .L==0
 IRP L,<.L==.L+1>		;COUNT ARGS
 .N==0

 IRP L,<
  IFNB <L>,<
   STKDEF (L,\<.L-.N-1>)	;DEFINE NAMED ARG
  > ;END IFNB
  .N==.N+1
 > ;END IRP

	ADJSP	P,.L		;ALLOCATE STACK SPACE
	DEFINE	UNSTK <	ADJSP P,-.L >	;DEFINE DEALLOCATOR
 PURGE .N
> ;END STKVAR


;DEFINE STACK VARIABLE
; NAME 'E', DEFINED AS OFFSET -'V'

	DEFINE	STKDEF (E,V) <DEFINE E <-V(P)>>



;CONVENIENT DOUBLE WORD CLEAR, LOCATION 'E'AND 'E+1'

	DEFINE	DSETZM (E) <
	SETZM	E
	SETZM	1+E>

;Macros for field masks

;These are the standard TOPS-20 macros taken from MACSYM.

;CONSTRUCT BYTE POINTER TO MASK

	DEFINE	POINTR(LOC,MASK)<POINT WID(MASK),LOC,POS(MASK)>

;PUT RIGHT-JUSTIFIED VALUE INTO FIELD SPECIFIED BY MASK

	DEFINE	FLD(VAL,MSK)<<VAL>B<POS(MSK)>>

;ERROR MACROS

;	FERR	(CHR,COD,N1,N2,MSG,ARGS,FLGS)	;FORLIB ERROR
;	TERR	(CHR,COD,N1,N2,MSG,ARGS,FLGS)	;APR TRAP CALL
;
;CHR	INITIAL CHAR FOR ERROR MESSAGE ([, %, ?)
;	IF [, MESSAGE IS TERMINATED WITH ]
;	IF ?, TYPEAHEAD CLEARED AFTER MESSAGE
;	IF NULL, 3-CHAR PREFIX ISN'T TYPED
;	IF $, FIRST ARG IS INITIAL CHAR
;COD	3-CHARACTER PREFIX
;N1	ERROR CLASS NUMBER
;N2	2ND ERROR NUMBER
;MSG	TEXT OF ERROR MESSAGE
;	$ INDICATES AN ARG TO BE SUBSTITUTED INTO THE MESSAGE
;	THE CHAR AFTER THE $ GIVES THE FORMAT OF THE SUBSTITUTION
;ARGS	LIST OF ARGUMENT ADDRESSES, ONE-TO-ONE CORRESPONDENCE WITH $S
;	IN MESSAGE TEXT
;FLGS	ERROR FLAGS
;
;THE ERROR MACROS GENERATE 1 WORD IN LINE, SO CAN BE SKIPPED OVER.
;THEY DO NOT ALTER ANY ACS.

;
; MSG CAN INCLUDE FORMAT DESCRIPTORS OF THE FORM '$X'
; EACH FORMAT DESCRIPTOR TAKES AN ARGUMENT FROM THE LIST 'ARGS'
; THE CURRENT FORMATTING AVAILABLE IS:
;
;	$$		;TYPE $
;	$[		;TYPE LEFT ANGLE BRACKET
;	$O		;OCTAL NUMBER
;	$D		;DECIMAL NUMBER
;	$A		;ASCIZ STRING
;	$C		;ASCII CHAR, RIGHT-JUSTIFIED
;	$S		;SIXBIT WORD
;	$X		;XWD FORMAT, OCTAL
;	$5		;RADIX50 WORD
;	$L		;ADDRESS AS LABEL+OFFSET
;	$T		;SPACES TO GET TO COL N
;	$J		;JSYS ERROR MESSAGE [NO ARG] (FT20)
;	$Y		;MS TIME AS HH:MM:SS.S
;	$P		;ERROR PC, OCTAL [NO ARG]
;	$E		;LOOKUP/ENTER/RENAME ERROR STRING (FT10)
;	$I		;IO ERROR BITS CONVERTED TO ASCII [USES (D)] (FT10)
;	$F		;FILESPEC FROM DDB [NO ARG, USES (D)] (FT10)
;	$Z		;SIXBIZ OR ASCIZ STRING (FT10)
;	$Z		;SIXBIZ OR ASCIZ STRING (FT20)
;
; EACH CALL GENERATES 1 WORD OF CODE IN LINE, AND CAN BE SKIPPED

%EOFF==1			;OFFSET TO ERROR BLOCK

	DEFINE	EMSG (CHR,PFX,N1,N2,MSG,ARGS,FLAGS) <

	ENTRY	E.'PFX
E.'PFX:				;DEFINE THE ERROR IF NOT NULL
		"CHR"			;ERROR CHARACTER
		SIXBIT	/PFX/		;ERROR PREFIX
		EXP	N1,N2		;ERROR NUMBERS
		POINT 7,[ASCIZ \MSG\]	;POINTER TO MESSAGE
		EXP	FLAGS		;ATTRIBUTE FLAGS
IRP ARGS,	<ARGS>			;ARGUMENTS, IF ANY

> ;END EMSG

;SPECIAL ERRORS

;$SNH - generate "SHOULD NOT HAPPEN" error
	DEFINE	$SNH,<
	$ECALL	SNH
>;END DEFINE $SNH

;$IOERR TYPES A ONE-LINE PREFIX IDENTIFYING THE
; STATEMENT CONTAINING THE ERROR AND THE NAME OF THE CURRENT FILE.
; EXAMPLES:
;  $IOERR (ILF,,,?,ILLEGAL CHARACTER IN FORMAT)
;  $IOERR (RBR,39,310,?,REREAD NOT PROCEEDED BY READ)



	DEFINE	$IOERR (CHR,PFX,N1,N2,MSG,ARGS,FLAGS) <

	INTERN	E.'PFX
E.'PFX:

 IF2,<IFNDEF %IOERR,<EXTERN %IOERR>>
		PUSHJ	P,%IOERR
		"CHR"			;ERROR CHARACTER
		SIXBIT	/PFX/		;ERROR PREFIX
		EXP	N1,N2		;ERROR NUMBERS
		POINT 7,[ASCIZ \MSG\]	;POINTER TO MESSAGE
		EXP	FLAGS		;ATTRIBUTE FLAGS
IRP ARGS,	<ARGS>			;ARGUMENTS, IF ANY

> ;END $IOERR

;$FERR IS FOR USE BY FORLIB
; IT CALLS FORER.
; EXAMPLE:
;  FERR (DNO,21,125,?,DIVERT: UNIT $D IS NOT OPEN,<@(L)>)

	DEFINE	$FERR (CHR,PFX,N1,N2,MSG,ARGS,FLAGS) <

	ENTRY	F.'PFX
F.'PFX:
		PUSHJ	P,FORER.##
		"CHR"			;ERROR CHARACTER
		SIXBIT	/PFX/		;ERROR PREFIX
		EXP	N1,N2		;ERROR NUMBERS
		POINT 7,[ASCIZ \MSG\]	;POINTER TO MESSAGE
		EXP	FLAGS		;ATTRIBUTE FLAGS
IRP ARGS,	<ARGS>			;ARGUMENTS, IF ANY

>; END $FERR

;$DCALL CALLS AN ERROR ROUTINE DEFINED SOMEWHERE BY AN $DERR MACRO

	DEFINE	$DCALL (PFX,CONT) <
IFNB <CONT>,<PRINTX ?DCALL CONTINUATION ADDRESS SPECIFIED - IGNORED>
	EXTERN	D.'PFX
	JRST	D.'PFX
> ;END $DCALL

;$DJCAL CALLS AN ERROR ROUTINE DEFINED SOMEWHERE BY AN $DERR MACRO
;WITH AN ERJMP

	DEFINE	$DJCAL (PFX,CONT) <
IFNB <CONT>,<PRINTX ?DJCAL CONTINUATION ADDRESS SPECIFIED - IGNORED>
	EXTERN	D.'PFX
	ERJMP	D.'PFX
> ;END $DJCAL

;$FCALL CALLS AN ERROR ROUTINE DEFINED SOMEWHERE BY A FERR MACRO

	DEFINE	$FCALL (PFX,CONT) <
	EXTERN	F.'PFX
IFB <CONT>,<	PUSHJ	P,F.'PFX >
IFNB <CONT>,<JRST	[PUSHJ P,F.'PFX
			JRST CONT] >
> ;END $FCALL

;$FJCAL CALLS AN ERROR ROUTINE DEFINED SOMEWHERE BY A FERR MACRO

	DEFINE	$FJCAL (PFX,CONT) <
	EXTERN	F.'PFX
IFB <CONT>,<	ERCAL	F.'PFX >
IFNB <CONT>,<ERJMP	[PUSHJ P,F.'PFX
			JRST CONT] >
> ;END $FJCAL

;STORAGE/STRUCTURE DEFINITION MACROS
; NAME is defined to be a small offset, starting at 0.
;	or'ed with a bit in the left half that indicates special cases
;	(and causes a "U" MACRO error if used incorrectly!)
; %'NAME is defined to be RH= the rightmost bit used.
; LH(%'NAME) = 0 unless it is a byte ptr (not a halfword).
;    	then LH (%'NAME) = size of byte.

;Macro to start a structure definition

	DEFINE	DEFST,<
	$LOC==0
	$P==-1
	>

;Macro to define a name as a number and make sure
; that it had not been previously defined.
	DEFINE	DFN(NAME,LOC),<

	IF1,<
	IFDEF NAME, PRINTX ?NAME ALREADY DEFINED
	>;END IF1

	NAME==LOC

>;END DFN


;Macro to define N words.

	DEFINE	DEFWD (NAME,N<1>),<

IFGE $P,<
	$P==-1
	$LOC==$LOC+1	;Jump to next word
	>

	DFN (NAME,$LOC)
	%'NAME==^D35

	$LOC==$LOC+N
>;END DEFWD

;Macro to define a random byte

	DEFINE	DEFBYT (NAME,S),<

  IFG <$P+^D<S>-^D35>,<
	$P==-1
	$LOC==$LOC+1
	>
  $P==$P+^D<S>		;Find end position in word

	DFN (NAME,$LOC)	;Plain name is offset
	%'NAME==$P	;RH (%NAME) = rightmost bit

  %%DONE==0
  IFE <S - ^D18>,<	;Halfword
	IFE <$P - ^D35>,<	;Right halfword

		NAME==NAME+1B0
		%%DONE==1
	>
	IFE <$P - ^D17>,<	;Left halfword

		NAME==NAME+1B1
		%%DONE==1
	>
  >
  IFE %%DONE,<			;Not a halfword

		NAME==NAME+1B2
		%'NAME==%'NAME+ <<S>_^D30>	;Byte size in LH
  >
>;END DEFBYT



;Macro to define a DEFBYT or DEFWD such that
;  B simply renames A.
	DEFINE	DEFSNN (NEWNAM, OLDNAM),<

	DFN	NEWNAM,OLDNAM	;Check for name conflict
				; and define it the same
	%'NEWNAM==%'OLDNAM

>;END DEFSNN

;Macro to load a field

	DEFINE	LOAD (AC,NAME,THIRD),<
	IFNB <THIRD>,< PRINTX ?LOAD used with more than 2 args - AC, NAME >

	%%BTS==<NAME> & 7B2
	%%IDX==<<NAME>_-^D18> & ^O77	;Get index field if any
	%%LFT==<NAME> & ^O777777
	IFE <%%IDX>,<PRINTX %Index is zero for LOAD AC,NAME >

  IFE %%BTS,<
	MOVE	AC,NAME
  >
 IFN <%%BTS & 1B0>,<
	HRRZ	AC,%%LFT(%%IDX)
  >
  IFN <%%BTS & 1B1>,<
	HLRZ	AC,%%LFT(%%IDX)
  >
  IFN <%%BTS & 1B2>,<
	%%%S==<%'NAME>_-^D30	;Size of field
	%%%P==<%'NAME> & ^O77	;"P"
	LDB	AC,[POINT %%%S,%%LFT(%%IDX),%%%P]
  >
>;END DEFINE LOAD

;Macro to store a field

	DEFINE	STORE (AC,NAME,THIRD),<
	IFNB <THIRD>,<PRINTX ?STORE with more than 2 args - AC, NAME >

	%%BTS==<NAME> & 7B2
	%%IDX==<<NAME>_-^D18> & 77	;Get index field if any
	%%LFT==<NAME> & ^O777777
	IFE <%%IDX>,<PRINTX %Index is zero for STORE AC,NAME >

  IFE %%BTS,<
	MOVEM	AC,NAME
  >
 IFN <%%BTS & 1B0>,<
	HRRM	AC,%%LFT(%%IDX)
  >
  IFN <%%BTS & 1B1>,<
	HRLM	AC,%%LFT(%%IDX)
  >
  IFN <%%BTS & 1B2>,<
	%%%S==<%'NAME>_-^D30	;Size of field
	%%%P==<%'NAME> & ^O77	;"P"
	DPB	AC,[POINT %%%S,%%LFT(%%IDX),%%%P]
  >
>;END DEFINE STORE

;Macro to generate a "HRRE" or "HLRE"
;Gives error if the field is not a halfword.
	DEFINE	HXRE (AC,NAME,THIRD),<

	IFNB <THIRD>,< PRINTX ?HXRE used with more than 2 args - AC, NAME >

	%%BTS==<NAME> & 7B2
	%%IDX==<<NAME>_-^D18> & 77	;Get index field if any
	%%LFT==<NAME> & ^O777777
	IFE <%%IDX>,<PRINTX %Index is zero for HXRE AC,NAME >

  IFE <%%BTS & 3B1>,<
	PRINTX ?HXRE ERROR - NAME
  >
  IFN <%%BTS & 1B0>,<
	HRRE	AC,%%LFT(%%IDX)
  >
  IFN <%%BTS & 1B1>,<
	HLRE	AC,%%LFT(%%IDX)
  >
>;END DEFINE HXRE


;Macro to generate a "HRL" or a "HLL"
;  Prints error if the field is not a halfword
	DEFINE	HXL (AC,NAME,THIRD),<

	IFNB <THIRD>,< PRINTX ?HXL used with more than 2 args - AC, NAME >

	%%BTS==<NAME> & 7B2
	%%IDX==<<NAME>_-^D18> & 77	;Get index field if any
	%%LFT==<NAME> & ^O777777
	IFE <%%IDX>,<PRINTX %Index is zero for HXL AC,NAME >

  IFE <%%BTS & 3B1>,<
	PRINTX ?HXL ERROR - NAME
  >
  IFN <%%BTS & 1B0>,<
	HRL	AC,%%LFT(%%IDX)
  >
  IFN <%%BTS & 1B1>,<
	HLL	AC,%%LFT(%%IDX)
  >
>;END DEFINE HXL

;Macro to generate a "HRLZ" or a "HLLZ"
;  Prints error if the field is not a halfword
	DEFINE	HXLZ (AC,NAME,THIRD),<

	IFNB <THIRD>,< PRINTX ?HXLZ used with more than 2 args - AC, NAME >

	%%BTS==<NAME> & 7B2
	%%IDX==<<NAME>_-^D18> & 77	;Get index field if any
	%%LFT==<NAME> & ^O777777
	IFE <%%IDX>,<PRINTX %Index is zero for HXLZ AC,NAME >

  IFE <%%BTS & 3B1>,<
	PRINTX ?HXLZ ERROR - NAME
  >
  IFN <%%BTS & 1B0>,<
	HRLZ	AC,%%LFT(%%IDX)
  >
  IFN <%%BTS & 1B1>,<
	HLLZ	AC,%%LFT(%%IDX)
  >
>;END DEFINE HXLZ

;Macro to generate a "HRR" or a "HLR"
;  Prints error if the field is not a halfword
	DEFINE	HXR (AC,NAME,THIRD),<

	IFNB <THIRD>,< PRINTX ?HXR used with more than 2 args - AC, NAME >

	%%BTS==<NAME> & 7B2
	%%IDX==<<NAME>_-^D18> & 77	;Get index field if any
	%%LFT==<NAME> & ^O777777
	IFE <%%IDX>,<PRINTX %Index is zero for HXR AC,NAME >

  IFE <%%BTS & 3B1>,<
	PRINTX ?HXR ERROR - NAME
  >
  IFN <%%BTS & 1B0>,<
	HRR	AC,%%LFT(%%IDX)
  >
  IFN <%%BTS & 1B1>,<
	HLR	AC,%%LFT(%%IDX)
  >
>;END DEFINE HXR

	SUBTTL	UDB - Unit Data Block
;+
;  Structure Definition For Unit Data Block 
;
;  Pointed to by AC U
;-

	DEFST			;Start the structure UDB

	DEFWD	DDBAD		;DDB address
	DEFWD	CNSL1		;Link to next unit block marked for
				; consolidation
	DEFWD	CNSL2		;Link to previous unit block marked for
				; consolidation
	DEFBYT	UNUM,^D18	;Unit number
	DEFBYT	BLNK,1		;/BLANK=
	  BL.NULL==0		;NULL (DEFAULT FOR OPEN STATEMENT)
	  BL.ZERO==1		;ZERO (DEFAULT FOR NO OPEN STATEMENT)

	DEFBYT	CC,3		;/CARRIAGECONTROL=
	  CC.DEV==0		;DEVICE (DEFAULT)
	  CC.FOR==1		;FORTRAN (SET FDB FORTRAN BIT)
	  CC.LST==2		;LIST (ADD CRLF WHEN PRINTING EACH RECORD)
	  CC.NON==3		;NONE (ADD NOTHING WHEN PRINTING FILE)
	  CC.TRN==4		;TRANSLATED (DO IMMEDIATE CC TRANSLATION)

	DEFBYT	PADCH,9		;/PADCHAR

	DEFBYT	PADSP,1		;PADCHAR SPECIFIED FLAG

	DEFWD	ULEN,0		;Length of UDB

	SUBTTL	DDB - Device Data Block
;+
;  Device Data Block (DDB) Offsets. There is only one DDB per open unit, 
;  however, there may be multiple units per DDB.
;
;  Pointed to by AC D
;-

	DEFST			;Start the structure definition

	DEFWD	USCNT		;How many unit blocks point to this DDB
	DEFWD	DVICE		;TOPS-10: Physical device name
				;TOPS-20: Device number

	DEFWD	IRPTR		;Current input record byte pointer
	DEFWD	IRCNT		;Current input record byte count

	DEFWD	ORPTR		;Current output record byte ptr
	DEFWD	ORCNT		;Current output record byte count

	DEFWD	IRBUF		;INPUT RECORD BUFFER PNTR
	DEFWD	ORBUF		;OUTPUT RECORD BUFFER PNTR

	DEFWD	IRBEG		;PNTRS TO BEG OF DATA
	DEFWD	ORBEG

	DEFWD	IRLEN		;INPUT RECORD LENGTH
	DEFWD	ORLEN		;Current output record length

	DEFWD	IRBLN		;INPUT RECORD BUFFER LENGTH
	DEFWD	ORBLN		;OUTPUT RECORD BUFFER LENGTH

	DEFWD	IRSIZ		;ROOM FOR DATA IN RECORD BUFFER
	DEFWD	ORSIZ

	DEFWD	ROFSET		;OFFSET FROM REC BUFFER TO DATA
	DEFWD	BOFSET		;OFFSET FROM BLOCK BUFFER TO DATA

	DEFWD	FAB		;ADDRESS OF RMS FAB
	DEFWD	RAB		;ADDRESS OF RMS RAB
	DEFWD	XAB		;ADDRESS OF RMS XAB

	DEFWD	WTAB		;Address of in-core page table
	DEFWD	PFTAB		;Address of page flag table (-1=modified)
	DEFWD	WPTR		;Core page address of file pages
	DEFWD	WSIZ		;Size of window in bytes
	DEFWD	WADR		;Sequential - Local (18-BIT) Address of window
				;Random - Offset into WTAB of least used page

IF20,<
	DEFSNN	BUFADR,WADR	;BUFFER ADDRESS SAME AS WINDOW ADDRESS

	DEFWD	IPTR		;Byte ptr to next byte from file
	DEFWD	ICNT		;Free byte count
	DEFWD	IJFN		;JFN
	DEFWD	OJFN		;Output JFN
				;Note: Always the same except if
				;     .PRIIN, .PRIOU
	DEFWD	TMPFIL		;-1=TEMPORARY FILE
	DEFWD	PPNSTR		;PPN STRING FOR TOPS-10 PROGRAMS
> ;END IF20

	DEFWD	BYTN		;Current byte number in file
	DEFWD	BLKN		;Block number
	DEFWD	AVAR		;/ASSOCIATE variable address
	DEFWD	CREC		;Number of current record

	DEFWD	FUMXD		;-1=FORMATTED/UNFORMATTED MIXED MODE FILE
	DEFWD	IOREC		;ROUTINE TO CALL TO READ OR WRITE A RECORD
	DEFWD	IOSUB		;ROUTINE TO CALL FOR IOLST.
	DEFWD	IOFIN		;ROUTINE TO CALL FOR FIN.
	DEFWD	LSNUM		;Line seq. number for this channel
	DEFWD	FLAGS		;DDB control flags (From DF)
	DEFWD	RSIZE		;Record size, in bytes or words
	DEFWD	MRSIZE		;MAXIMUM RECORD SIZE
	DEFWD	FRSIZW		;FORMATTED RECORD SIZE IN WORDS
	DEFWD	FRSIZB		;FORMATTED RECORD SIZE IN BYTES
	DEFWD	URSIZW		;UNFORMATTED RECORD SIZE IN WORDS
	DEFWD	URSIZB		;UNFORMATTED RECORD SIZE IN BYTES
	DEFWD	BPW		;BYTES PER WORD
	DEFWD	SPCWD		;A WORD OF SPACES FOR THIS FILE
	DEFWD	ORPOS		;VIRTUAL OUTPUT RECORD POSITION
	DEFWD	B36FLG		;FILE OPENED IN 36-BIT MODE
	DEFWD	IMGFLG		;IMAGE MODE - NO LSCW'S IN THIS FILE
	DEFWD	FILPRS		;FILESPEC HAS BEEN PARSED

	DEFWD	RECTP		;/RECORDTYPE
	  RT.UND==0		    ;  UNDEFINED (STREAM)
	  RT.FIX==1		    ;  FIXED
	  RT.DEL==2		    ;  DELIMITED (VARIABLE)
	  RT.SEG==3		    ;  SEGMENTED

	DEFBYT	QNSWT,9		;For /DISP:QUEUE, number of extra switches
	DEFBYT	QCNT,9		;LENGTH OF EXTRA SWITCHES, WORDS
	DEFBYT	QASWT,^D18	;ADDRESS OF BLOCK OF EXTRA SWITCHES

	DEFBYT	BLKSZ,^D18	;/BLOCK SIZE
	DEFBYT	LIMIT,^D18	;/LIMIT

	DEFBYT	BYTPT,^D18	;BYTE POINTER TO LAST BYTE OF WORD


	DEFBYT	TTYW,9		;LINE WIDTH, CHARACTERS

	DEFBYT	LTYP,6		;(MTA) LABEL TYPE
IF20,<	  LT.UNL==.LTUNL	    ;0 - UNLABELED>
IF10,<	  LT.UNL==0		    ;0 - UNLABELED>

	DEFBYT	ACC,4		;/ACCESS
	  AC.SIO==0		    ;  SEQUINOUT (SEQUENTIAL)
	  AC.SIN==1		    ;  SEQIN
	  AC.SOU==2		    ;  SEQOUT
	  AC.RIN==3		    ;  RANDIN
	  AC.RIO==4		    ;  RANDOM
	  AC.APP==5		    ;  APPEND
	  AC.NUM==6		    ;  NUMBER OF TYPES OF ACCESS (FOR SAIDX)

	DEFBYT	SAIDX,4		;STATUS/ACCESS INDEX
	  SA.ILL==-1		    ;  ILLEGAL COMBINATION OF STATUS/ACCESS
	  SA.UR==0		    ;  UNKNOWN, READ (MUST BE ZERO!)
	  SA.UW==1		    ;  UNKNOWN, WRITE
	  SA.URW==2		    ;  UNKNOWN, READ, WRITE
	  SA.UA==3		    ;  UNKNOWN, APPEND
	  SA.OR==4		    ;  OLD, READ
	  SA.OW==5		    ;  OLD, WRITE
	  SA.ORW==6		    ;  OLD, READ, WRITE
	  SA.OA==7		    ;  OLD, APPEND
	  SA.NW==10		    ;  NEW, WRITE
	  SA.SW==11		    ;  SCRATCH, WRITE

	DEFBYT	RENAM,1		;RENAME SPECIFIED IN CLOSE

	DEFBYT	BUFCT,6		;/BUFFER COUNT (0-63)

	DEFBYT	DEN,3		;/DENSITY
	  DN.DEF==0		    ;  DEFAULT (UNIT DEFAULT)
	  DN.200==1		    ;  200
	  DN.556==2		    ;  556
	  DN.800==3		    ;  800
	  DN.1600==4		    ;  1600
	  DN.6250==5		    ;  6250
	  DN.SYS==0		    ;  SYSTEM

	DEFBYT	UBSIZ,6		;/BYTESIZE (USER-SUPPLIED)

	DEFBYT	DISP,4		;/DISPOSE
	  DS.NOT==0		    ;  NOTHING (ALSO RENAME - IGNORED)
	  DS.SAVE==1		    ;  SAVE
	  DS.DEL==2		    ;  DELETE
	  DS.EXP==3		    ;  EXPUNGE
	  DS.PRNT==4		    ;  PRINT
	  DS.LIST==5		    ;  LIST
	  DS.PNCH==6		    ;  PUNCH
	  DS.SUB==7		    ;  SUBMIT
	  DS.PLT==10		    ;  PLOT

	DEFBYT	ODISP,2		;ORTHOGONAL DISPOSE VALUE
	  OD.NOT==0		    ;  NOTHING
	  OD.PRI==1		    ;  PRINT
	  OD.PUN==2		    ;  PUNCH
	  OD.SUB==3		    ;  SUBMIT
	  OD.PLT==4		    ;  PLOT

	DEFBYT	FORM,2		;/FORM
	  FM.FORM==1		    ;  FORMATTED
	  FM.UNF==2		    ;  UNFORMATTED

	DEFBYT	MODE,4		;/MODE
	  MD.IMG==1		    ;  IMAGE
	  MD.BIN==2		    ;  BINARY
	  MD.DMP==3		    ;  DUMP
	  MD.ASC==4		    ;  ASCII 7-BIT
	  MD.ASL==5		    ;  LINED
	  MD.AS9==6		    ;  ASCII 9-BIT

	DEFBYT	ORGAN,2		;/ORGANIZATION
	  OR.SEQ==0		    ;  SEQUENTIAL
	  OR.REL==1		    ;  RELATIVE (DIRECT)
	  OR.IDX==2		    ;  INDEXED (ISAM)

	DEFBYT	PAR,2		;/PARITY
	  PR.ODD==1		    ;  ODD (DEFAULT)
	  PR.EVEN==2		    ;  EVEN

	DEFBYT	RO,1		;/READONLY

	DEFBYT	SHARE,1		;/SHARED

	DEFBYT	STAT,4		;/STATUS
	  ST.UNK==0		    ;  UNKNOWN
	  ST.OLD==1		    ;  OLD
	  ST.NEW==2		    ;  NEW
	  ST.SCR==3		    ;  SCRATCH
	  ST.DISP==4		    ;  F-77 CLOSE STATUS WHICH IS REALLY
				    ;  DISPOSITION
	  ST.SAV==4		    ;  SAVE
	  ST.DEL==5		    ;  DELETE
	  ST.EXP==6		    ;  EXPUNGE
	  ST.NUM==7		    ;  NUMBER OF STATUS VALUES (FOR DSIDX)

	DEFBYT	OSTAT,2		;ORTHOGONAL CLOSE STATUS VALUE
	  OS.UNK==0		    ;  UNKNOWN
	  OS.SAV==1		    ;  SAVE
	  OS.DEL==2		    ;  DELETE
	  OS.EXP==3		    ;  EXPUNGE

	DEFBYT	TAPM,3		;/TAPEMODE
IF20,<
	  TM.SYS==.SJDDM 	   ;  (0) SYSTEM DEFAULT 
	  TM.DMP==.SJDMC 	   ;  (1) CORE-DUMP (36-BIT BYTES)
	  TM.SIX==.SJDM6 	   ;  (2) SIXBIT (7-TRACK)
	  TM.ANS==.SJDMA 	   ;  (3) ANSI-ASCII
	  TM.IND==.SJDM8 	   ;  (4) INDUSTRY COMPATIBLE
	  TM.HDN==.SJDMH 	   ;  (5) HIGH-DENSITY
> ;END IF20

IF10,<
	  TM.SYS==.TFMDD	   ;  (0) SYSTEM DEFAULT
	  TM.DMP==.TFMID	   ;  (1) 9-TRACK CORE-DUMP
	  TM.SX9==.TFM6B	   ;  (3) 9-TRACK SIXBIT
	  TM.IND==.TFM8B	   ;  (2) INDUSTRY-COMPATIBLE
	  TM.ANS==.TFM7B	   ;  (4) ANSI-ASCII
	  TM.SIX==.TFM7T	   ;  (5) SIXBIT (7-TRACK)
> ;END IF10

	DEFWD	DVBTS,0		;DEVCHR BITS

IF20,<
	DEFBYT	DVIO,2		;INPUT/OUTPUT LEGAL
	DEFBYT	DRDVF,1		;1= "this is a directory device"
	DEFBYT	DVAS,1		;ASSIGNABLE
	DEFBYT	DVMDD,1		;MULTIPLE DIRECTORIES
	DEFBYT	DVAV,1		;AVAILABLE
	DEFBYT	DVASN,1		;ASSIGNED
	DEFBYT	DVJNK,1		;NOT USED
	DEFBYT	DVMNT,1		;MOUNTED
	DEFBYT	DVTYP,9		;DEVTYP CODE

	  DT.DSK==.DVDSK	    ;DISK
	  DT.MTA==.DVMTA	    ;MTA
	  DT.DTA==.DVDTA	    ;DTA
	  DT.NUL==.DVNUL	    ;NULL DEVICE
	  DT.TTY==.DVTTY	    ;TTY
	  DT.PTY==.DVPTY	    ;PTY
	  DT.LPT==.DVLPT	    ;LPT
	  DT.PLT==.DVPLT	    ;PLOTTER
> ;END IF20

IF10,<
	DEFBYT	DFILL,16	;DEVCHR FIELDS WE DON'T USE
	DEFBYT	DVIO,2		;DEVICE CAN DO INPUT, OUTPUT

	  DV%IN==DV.IN		;DEVICE CAN DO INPUT
	  DV%OUT==DV.OUT	;DEVICE CAN DO OUTPUT

	DEFWD	DVTW,0		;DEVTYP WORD
	DEFBYT	DFIL2,30	;DEVTYP FIELDS WE DON'T USE
	DEFBYT	DVTYP,6		;DEVICE TYPE

	  DT.NUL==.TYDSK	    ;NULL DEVICE
	  DT.DSK==.TYDSK	    ;DISK
	  DT.DTA==.TYDTA	    ;DTA
	  DT.MTA==.TYMTA	    ;MTA
	  DT.PTY==.TYPTY	    ;PTY
	  DT.LPT==.TYLPT	    ;LPT
	  DT.PLT==.TYPLT	    ;PLOTTER
	  DT.TTY==.TYTTY	    ;TTY
> ;END IF10

	DEFBYT LGLM,^D16	;LEGAL DATA MODES

	DEFBYT INDX,3		;DEVICE INDEX (FOR SPECIAL-CASE CODE)
	  DI.TTY==0		    ;TTY
	  DI.DSK==1		    ;DISK
	  DI.MTA==2		    ;MTA
	  DI.OTHR==3		    ;ANYTHING ELSE
	  DI.RMS==4		    ;RMS FILE

	DEFWD	EOFN		;(Disk) Number of bytes in file

	DEFWD	FILSPC,0	;BEGINNING OF FILESPEC PART OF DDB

	DEFWD	PASWRD,8	;REMOTE ACCESS PASSWORD
	DEFWD	ACCNT,8		;ACCOUNT STRING
	DEFWD	USERID,8	;USER ID

	LFILW==20		;LENGTH OF FILENAME
	LFILC==LFILW*5		;AND IN CHARS
	LEXTW==20		;LENGTH OF EXTENSION
	LEXTC==LEXTW*5		;AND IN CHARS
	LDEVW==20		;LENGTH OF DEVICE
	LDEVC==LDEVW*5		;AND IN CHARS
	LDIRW==20		;LENGTH OF DIRECTORY
	LDIRC==LDIRW*5		;AND IN CHARS
	LNODW==2		;LENGTH OF NODENAME
	LNODC==LNODW*5		;AND IN CHARS
	LPROTW==2		;LENGTH OF PROTECTION CODE
	LPROTC==LPROTW*5	;AND IN CHARS
	LGENW==2		;LENGTH OF GENERATION
	LGENC==LGENW*5		;AND IN CHARS

	DEFWD	NODNAM,LNODW	;Node name
	DEFWD	DEV,LDEVW	;Device name (1-39 chars, ASCIZ)
	DEFWD	DIRNAM,LDIRW	;Directory name (can include ^V's)
	DEFWD	FILNAM,LFILW	;File name
	DEFWD	EXT,LEXTW	;Extension
	DEFWD	PROT,LPROTW	;Protection (0-6 chars, ASCIZ)
	DEFWD	GEN,LGENW	;Generation number (0-6 chars, ASCIZ)
.FSSLN==$LOC-FILSPC-1		;Length of filespec stuff

IF20,<
	DEFWD	DMABS,0		;Data mode & byte size
	DEFBYT	BSIZ,6		;Byte size
	DEFBYT	DMODE,4		;Data mode

	DEFWD	VERN		;Version number (ignored)
> ;END IF20

IF10,<
	DEFWD	BSIZ		;BYTE SIZE

	DEFWD	FBLK,.FOMAX	;FILOP block.
	DEFSNN	CHAN,FBLK	;Channel,,FN
	DEFSNN	IJFN,FBLK	;MORE FOR COMPATIBILITY
	DEFSNN	OJFN,FBLK	;DITTO

	DEFWD	LKPB,.RBMAX	;LOOKUP/ENTER block
	VERN==LKPB+.RBVER	;VERSION NUMBER

	DEFWD	PTHB,.PTMAX	;PATH. block. Set by FILOP to the real
				; true path to the file.

	DEFWD	BUFADR		;BUFFER ADDRESS

	DEFWD	IBCB		;Input buffer control block
	DEFWD	IPTR,0		;Byte pointer.
	DEFBYT	FILL2,6		;FILLER
	DEFBYT	IBSIZ,6		;Byte size
	DEFWD	ICNT		;Count

	DEFWD	TBCB		;Output buffer control block
	DEFWD	TPTR,0		;Byte ptr.
	DEFBYT	FILL3,6		;FILLER
	DEFBYT	TBSIZ,6		;Byte size
	DEFWD	TCNT		;Count

> ;END IF10

	DEFWD	DLEN,0		;Length of DDB

;  CLEAN UP AFTER DDB DEFINITION

	PURGE $P,$LOC,%%DONE

	SUBTTL	FORPRG - Purge Global Symbols 
;+
;  Purge global symbols created by MONSYM which do not have "%" 
;  or "." in them. Also to purge JS%DEV, which changed its value between
;  Release 5.1 and Release 6 of the monitor.

;-

	DEFINE	FORPRG<

	PURGE	ERJMP,ERCAL,GJFX3,GJFX18,GJFX19,GJFX24,GJFX27
	PURGE	IOX4
	PURGE	IPCFX6,IPCFX8
	PURGE	LNGFX1
	PURGE	NPXAMB,NPXNC,NPXNOM
	PURGE	OPNX2,OPNX9
	PURGE	JS%DEV

> ;END FORPRG

	END