Google
 

Trailing-Edge - PDP-10 Archives - FORTRAN-10_V7wLink_Feb83 - forprm.mac
There are 13 other files named forprm.mac in the archive. Click here to see a list.

;	UNIVERSAL FORPRM	UNIVERSAL FILE FOR FOROTS ,7(3252)

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


	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 Revision History *****

\

;INSTALLATION-DEPENDENT PARAMETERS

;FT10			;TOP10 (NONZERO=YES)
;FT20			;TOPS-20 (NONZERO=YES)
;FTKL			;KL/KS PROCESSOR (NONZERO=YES)
;FTPSCT			;PSECTED FOROTS (NONZERO=YES)
;FTSHR			;SHARABLE FOROTS (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
;FT20UUO		;*UNSUPPORTED* SWITCH TO ALLOW UUOS ON TOPS-20
;			; NEITHER FOROTS NOR PA1050 IS DESIGNED TO
;			; ALLOW THIS!
;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
;FTSHR:		YES
;FTDSK:		NO
;FTAST:		YES
;STARTP:	577
;FTNLC1:	NO
;FTGFL		NO
;FT20UUO:	NO

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

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 FTGFL,<FTGFL==0>		;NO GFLOATING DOUBLE PRECISION CHECKS
IFNDEF FT20UUO,<FT20UUO==0>	;NO PA1050
IFNDEF WRNCNT,<WRNCNT==2>	;Number of warnings of a specific type
				; that get printed.

IF20,<IFNDEF ENDP,<ENDP==765>>	;TOP OF CORE ON -20 (LEAVE UDDT)
IF10,<IFNDEF ENDP,<ENDP==775>>	;TOP OF CORE ON -10 (LEAVE PFH)


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

	MOSBSZ==6		;MTOPR STATUS BLOCK SIZE
	ICHRSZ==1000		;START CHARACTER STACK AT 1 PAGE
	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
	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

	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

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

	VFOROTS==7		;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 CONSTANTS

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

;MISCELLANEOUS DEFINITIONS

IF10, ERNFC%==57		;Not defined in STD 7.01 UUOSYM !!

;ARG LISTS

;BYTES IN ARG POINTERS

ARGKWD==177000000000		;KEYWORD INDEX, WHERE APPROPRIATE
ARGTYP==000740000000		;ARG TYPE, SEE BELOW
ARGADR==000037777777		;I, X, Y OF INSTRUCTION-FORMAT 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$SBA==20			;SET FORDDT BREAK ON FOROTS ERRORS

.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.REEL==17			;REELS
OK.MNT==20			;MOUNT
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.LBL==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
;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

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

ERDAJ%==52			;Error code from FILOP. that means
				; ?Assigned to another job.
>;END IF10

;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%DIALOG	;DIALOG MODE NEEDED (MUST BE SIGN)
	FLG	F%DSTRG		;DIALOG IS FROM STRING, NOT TTY
	FLG	F%EXT		;EXPLICIT EXTENSION SPECIFIED
	FLG	F%PPN		;(20) DIALOG=PPN, NOT DIRECTORY NAME
	FLG	F%ETP		;TYPE "E" FOR SCIENTIFIC NOTATION
	FLG	F%DTP		;TYPE "D" FOR SCIENTIFIC NOTATION
	FLG	F%GTP		;G FORMAT
	FLG	F%CLS		;CLOSE IN PROGRESS
	FLG	F%CTTY		;OPEN IS OF CONTROLLING TTY
	FLG	F%DRE		;Set if we have to go into DIALOG mode
				; because of an error (as opposed to /DIALOG).
	FLG	F%DCU		;Deallocate U and D if IOERR called
				; and does not return (ERR= branch taken)
	FLG	F%DSS		;DEVICE INFO SPECIFIED in OPEN or CLOSE
	FLG	F%FSS		;Filespec info specified in OPEN or CLOSE
	FLG	F%INDST		;In DIALOG='string' processor.

;DF: DDB-SPECIFIC FLAGS

;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%END		;EOF REACHED IN FILE
	FLG	D%RAN		;1=RANDOM, 0=SEQUENTIAL
	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%APP		;APPEND MODE
	FLG	D%INT		;INTERACTIVE DEVICE
	FLG	D%OPEN		;Explicit OPEN statement has been done
	FLG	D%RJN		;(TOPS-20) Real JFN in IJFN(D)
				; (no more GTJFN's need to be done)
	FLG	D%NCLS		;Don't try to CLOSE this file, we already
				; got a "CLOSE" error.

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

	FLG	D%BZ		;BZ FORMAT
	FLG	D%SP		;SP FORMAT
	FLG	D%STCR		;SUPPRESS TRAILING CR ($ FORMAT IN THIS LINE)
	FLG	D%IO		;1 = OUTPUT, 0 = INPUT
	FLG	D%NML		;NAMELIST I/O
	FLG	D%LSD		;LIST-DIRECTED I/O

;Here are the flags to clear
	D%CLR== D%BZ+D%SP+D%STCR+D%IO+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%TCH		;Type erroreous string with arrow under it.


	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	FDBMS		;DBMS ENTRY
X	INQ		;DEVICE/FILE INQUIRE
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

> ;END FORVEC

	DEFINE	FENTRY	(NAME1,NAME2)

<	ENTRY	NAME1'%
	SIXBIT	/NAME1'./
NAME1'%:
IFN FTSHR,<
	ENTRY	NAME1'.
NAME1'.:
> ;END IFN FTSHR

IFNB <NAME2>,<
	ENTRY	NAME2'%
NAME2'%:
IFN FTSHR,<
	ENTRY	NAME2'.
NAME2'.:
> ;END IFN FTSHR
> ;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.
; REQUIRES D POINTING TO A DDB SO IT CAN IDENTIFY 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) <

	ENTRY	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



;$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 "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

;UNIT BLOCK OFFSETS

;Pointed to by AC U

	DEFST			;Start the structure

	DEFWD	DDBAD		;DDB address
	DEFBYT	CNSL1,^D18	;Link to next unit block marked for
				; consolidation
	DEFBYT	CNSL2,^D18	;Link to previous unit block marked for
				; consolidation
	DEFBYT	UNUM,^D18	;Unit number
	DEFBYT	NOU,^D18	;Link to next non-disk open unit (block)
				;0 if no more opened disk units
	DEFBYT	BLNK,2		;/BLANK=
	  BL.NULL==1		;NULL
	  BL.ZERO==2		;ZERO

	DEFBYT	CC,2		;/CARRIAGECONTROL=
	  CC.DEV==0		;DEVICE (DEFAULT)
	  CC.FORT==1		;FORTRAN
	  CC.LIST==2		;LIST
	  CC.NONE==3		;NONE (NO LINE DELIMITERS AT ALL)

	DEFBYT	PADCH,9		;/PADCHAR

	DEFBYT	PADSP,1		;PADCHAR SPECIFIED FLAG

	DEFWD	ULEN,0		;Length of UDB

;DEVICE DATA BLOCK (DDB) OFFSETS

	DEFST			;Start the structure definition

;THERE IS ONLY ONE DDB PER OPEN UNIT, HOWEVER
; THERE MAY BE MULTIPLE UNITS PER DDB
;POINTED TO BY AC D


	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

IF20,<
	DEFWD	IPTR		;Byte ptr to next byte from file
	DEFSNN	OPTR,IPTR	; . .
	DEFWD	ICNT		;Free byte count
	DEFSNN	OCNT,ICNT
> ;END IF20

	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
	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	IOSUB		;ROUTINE TO CALL FOR IOLST.
	DEFWD	LSNUM		;Line seq. number for this channel
	DEFWD	FLAGS		;DDB control flags (From DF)
	DEFWD	RSIZE		;Record size, in bytes or words
	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

	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	LIM,^D18	;/LIMIT

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

IF20,<
	DEFBYT	IJFN,9		;JFN
	DEFBYT	OJFN,9		;Output JFN
				;Note: Always the same except if
				;     .PRIIN, .PRIOU
> ;END IF20

	DEFBYT	TTYW,9		;LINE WIDTH, CHARACTERS
	DEFBYT	LTYP,6		;(MTA) LABEL TYPE

	DEFBYT	ACC,4		;/ACCESS
	  AC.SIN==1		    ;  SEQIN
	  AC.SOU==2		    ;  SEQOUT
	  AC.SIO==3		    ;  SEQINOUT
	  AC.RIN==4		    ;  RANDIN
	  AC.RIO==5		    ;  RANDOM
	  AC.APP==6		    ;  APPEND

	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	DISP,4		;/DISPOSE
	  DS.SAVE==1		    ;  SAVE
	  DS.DEL==2		    ;  DELETE
	  DS.EXP==3		    ;  EXPUNGE
	  DS.REN==4		    ;  RENAME
	DS.QUEUE==5		    ;HERE DOWN MEANS QUEUE FILE
	  DS.PRNT==5		    ;  PRINT
	  DS.PNCH==6		    ;  PUNCH
	  DS.LIST==7		    ;  LIST
	  DS.SUB==10		    ;  SUBMIT

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

	DEFBYT	LBL,3		;/LABELS
	  LB.NONE==0		    ;  NONE (DEFAULT)
	  LB.ANSI==1		    ;  ANSI
	  LB.DEC==2		    ;  DEC
	  LB.IBM==3		    ;  EBCDIC

	DEFBYT	MODE,4		;/MODE
	  MD.IMG==1		    ;  IMAGE
	  MD.BIN==2		    ;  BINARY  [BINARY THRU ASCII IMPLY FORM=U]
	  MD.DMP==3		    ;  DUMP
	  MD.ASC==4		    ;  ASCII   [ASCII ON UP IMPLY FORM=F]
	  MD.ASL==5		    ;  LINED
	  MD.EBC==6		    ;  EBCDIC

	DEFBYT	XMODE,1		;IF ON - /MODE NOT SEEN IN OPEN, SO MODE IN
				;  DDB IS FROM DEFAULT ALGORITHM (DFMODE)

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

	DEFBYT	RO,1		;/READONLY

	DEFBYT	RECFM,2		;/RECORD TYPE
	  RT.FIX==1		    ;  FIXED
	  RT.VAR==2		    ;  VARIABLE
	  RT.SPN==3		    ;  SPANNED
	DEFBYT	STAT,4		;/STATUS
	  ST.OLD==1		    ;  OLD
	  ST.NEW==2		    ;  NEW
	  ST.SCR==3		    ;  SCRATCH
	  ST.UNK==4		    ;  UNKNOWN
	  ST.DISP==5		    ;  F-77 CLOSE STATUS WHICH IS REALLY
				    ;  DISPOSITION
				    ;  VALUE STORED IS ST.DISP+DS.XXX

	DEFBYT	TAPM,2		;/TAPE MODE
	  TM.SYS==0		    ;  SYSTEM DEFAULT
	  TM.IND==1		    ;  INDUSTRY COMPATIBLE
	  TM.DMP==2		    ;  COREDUMP (UNBUFFERED)
	  TM.ANS==3		    ;  ANSI-ASCII

				;DEVCHR & DEVTYP BITS
	DEFBYT IO,2		;INPUT/OUTPUT LEGAL
	DEFBYT DRDVF,1		;1= "this is a directory device"
	DEFBYT DVTYP,9		;DEVTYP CODE
	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.ENC==4		    ;ENCODE/DECODE
	  DI.INT==5		    ;INTERNAL FILE

	DEFWD	EOFN		;(Disk) Number of bytes in file
	DEFWD	TPAGE		;TOP PAGE WRITTEN IN FILE

IF20,<

	DEFWD	DEV,20		;Device name (1-39 chars, ASCIZ)
	DEFWD	DIR,20		;Directory name (can include ^V's)
	DEFWD	FILE,20		;File name
	DEFWD	EXT,20		;Extension
	DEFWD	PROT,2		;Protection (0-6 chars, ASCIZ)
	DEFWD	XGEN		;Generation number (binary)
.FSSLN==$LOC-DEV-1		;Length of filespec stuff

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

	DEFWD	VERN		;Version number (ignored)
	DEFWD	EST		;File size (ignored)
> ;END IF20
IF10,<
	DEFWD	FBLK		;FILOP block.
	DEFSNN	CHAN,FBLK	;Channel,,FN

	DEFWD	DMOD,0		;STATUS & DATA MODE
	DEFBYT	FILL1,^D32	;FILLER
	DEFBYT	DMODE,4		;Data mode

	DEFWD	DEV		;Device name, SIXBIT
	DEFWD	BUFH		;Buffer header pointers
	DEFWD	NBUF		;Number of buffers
	DEFWD	LKBP		;Pointer to LOOKUP block
	DEFWD	PTHP		;Pointer to PATH block

FLEN==$LOC-FBLK		;Length of FILOP block

	DEFWD	LKPB		;LOOKUP/ENTER block
	DEFSNN	CNT,LKPB	;Count word
	DEFWD	PPN		;Path pointer or PPN
	DEFWD	FILE		;Filename, SIXBIT
	DEFWD	EXT		;Extension, SIXBIT
	DEFWD	PROT		;Protection, mode, creation date/time
	DEFWD	SIZ		;File size, words
	DEFWD	VERN		;Version number
	DEFWD	SPL		;Label for output spooling
	DEFWD	EST		;Estimated file size, blocks
	DEFWD	ALC,5		;ALC, POS, FT1, NCA, MTA
	DEFWD	RDEV		;Returned as unit containing file
	DEFWD	RBST		;RIB status block
LLEN==$LOC-LKPB-1	;Size of LOOKUP block

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

	DEFWD	IBCB		;Input buffer control block

;Byte pointer
	DEFWD	IPTR,0		;Byte pointer.
	DEFBYT	FILL2,6		;FILLER
	DEFBYT	IBSIZ,6		;Byte size

	DEFWD	ICNT		;Count

	DEFWD	OBCB		;Output buffer control block
	DEFWD	OPTR,0		;Byte ptr.
	DEFBYT	FILL3,6		;FILLER
	DEFBYT	OBSIZ,6		;Byte size

	DEFWD	OCNT		;Count

> ;END IF10

	DEFWD	DLEN,0		;Length of DDB

;CLEAN UP AFTER DDB DEFINITION

	PURGE $P,$LOC,%%DONE

	DEFINE	FORPRG<

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

> ;END FORPRG

	END