Google
 

Trailing-Edge - PDP-10 Archives - BB-4157E-BM - fortran-ots-debugger/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 ,6(2031)

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

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


	.DIRECT	.NOBIN
	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 tell if 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.

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

\
;INSTALLATION-DEPENDENT PARAMETERS

;FT10			;TOP10 (NON 0=YES)
;FT20			;TOPS-20 (NON 0=YES)
;FTKL			;KL/KS PROCESSOR (NON 0=YES)
;FTKI			:KI10 (NON 0=YES)
;FTSHR			;SHARABLE FOROTS (NON 0=YES)
;FTDSK			;ALL UNITS DEFAULT TO DSK: (NON 0=YES)
;FTAST			;ASTERISK FILL; FIELD WIDTH OVERFLOW (NON 0=YES)
;STARTP			;HIGHEST PAGE AVAILABLE TO FOROTS MEMORY MGR.
;FTNLC1			;IGNORE DATA IN COLUMN 1 OF NAMELIST INPUT (NON 0=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:		YES IF NO OPERATING SYSTEM SPECIFIED
;FT10:		NO UNLESS FTKI SPECIFIED
;FTKL:		YES IF NO PROCESSOR SPECIFIED
;FTKI:		NO
;FTSHR:		YES
;FTDSK:		NO
;FTAST:		YES
;STARTP:	577
;FTNLC1:	NO
;FTGFL		NO
;FT20UUO:	NO
;SET OPERATING SYSTEM/PROCESSOR DEFAULTS

IFNDEF FT10,<FT10==0>			;MAKE SURE ALL ARE DEFINED
IFNDEF FT20,<FT20==0>
IFNDEF FTKL,<FTKL==0>
IFNDEF FTKI,<FTKI==0>
IFE FT20!FT10,<IFN FTKI,<FT10==-1>	;SELECT AN OPERATING SYSTEM
	       IFE FTKI,<FT20==-1>>
IFN FT10,<IFE FTKI,<FTKL==-1>>		;SELECT A PROCESSOR
IFN FT20,<FTKL==-1>

;CHECK USER SUPPLIED PARAMETERS

IFN FT10&FT20,<IF1,<PRINTX ? Illegal to select both TOPS-10 and TOPS-20>
		    END>
IFN FTKL&FTKI,<IF1,<PRINTX ? Illegal to select KL and KI10 processors>
		    END>


;SET OTHER PARAMETER DEFAULTS

IFNDEF FTSHR,<FTSHR==-1>	;SHARABLE FOROTS
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 OFF LIMITS TO 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.
;Byte pointer formats
%%BOLD==0	;Always assume local byte pointers.
%%B1W==1	;1-word global byte pointers when needed.

IFNDEF FTTYPBP,<FTTYPBP==%%BOLD>	;(Version 6 default).

;Define feature test switches:

FTOLDBP==0			;Reset to 0
FT1WBP==0

IFE <FTTYPBP-%%BOLD>,<FTOLDBP==1> ;Only use old-style one-word BP's.
IFE <FTTYPBP-%%B1W>,< FT1WBP==1>  ;Use 1-word global BP's when needed.


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

IFN FT1WBP,<
	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
	>
>;END IFN FT1WBP

IFN FTOLDBP,<
	DEFINE $BLDBP (AC),<
		HRLI	AC,(POINT 7,) ;Always assume local BP
	>
>;END IFN FTOLDBP
;INDICATE WHICH ASSEMBLY IS BEING DONE

IF2,<
IFN FTKI,<%C=='KI'>
IFN FTKL,<%C=='KL'>
IFN FT10,<%M=='10'>
IFN FT20,<%M=='20'>
IFN FTSHR,<%X1=="shar"
	   %X2==0>
IFE FTSHR,<%X1=="reloc"
	   %X2=="at">

DEFINE	TELL (CPU,MON,X1,X2) <
	PRINTX	[CPU-MON X1'X2'able version]>

	TELL	\'%C,\'%M,\"%X1,\"%X2

	PURGE	%C,%M,%X1,%X2,TELL
> ;END IF2

DEFINE	IF10 <IFN FT10>		;SIMPLIFIED PROCESSOR MACROS
DEFINE	IF20 <IFN FT20>
;AC DEFINITIONS

	T0=0			;TEMP ACS
	T1=1			;MAY BY DESTROYED BY ANY ROUTINE UNLESS IT
	T2=2			;IS EXPLICITLY DOCUMENTED TO SAVE THEM
	T3=3
	T4=4
	T5=5

	P1=6			;PRESERVED ACS
	P2=7			;MUST BE PRESERVED BY ANY ROUTINE UNLESS IT
	P3=10			;IS EXPLICITLY DOCUMENTED THAT IT DESTROYS THEM
	P4=11

	G1==P1			;ALTERNATE DEFINITIONS FOR OLD CODE, DO NOT USE
	G2==P2
	G3==P3
	G4==P4

	D=12			;POINTER TO CURRENT DDB
	FREEAC=13		;FOROTS's free AC.
				;Beware: Some routines may define their
				; own AC to be this. So before making a
				; use for it, you may have to save this
				; AC in some routines.
	F=14			;LOCAL FLAGS
	U=15			;Pointer to current unit block

	L=16			;ARG LIST POINTER
	P=17			;STACK POINTER
;OTHER DEFS

	LPDL==200		;LENGTH OF STACK
	LRECBF==15		;LENGTH OF RECORD BUFFER, WORDS
	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

	MINUNIT==-7		;MIN LEGAL UNIT NUMBER
	MAXUNIT==^D99		;MAX LEGAL UNIT NUMBER

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

	VFOROTS==6		;FOROTS MAJOR VERSION
				;FOROTS.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.

	SYN OCT,DOUBLE		;PSUEDO-OP FOR DP CONSTANTS

;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



;ARG TYPE CODES


TP%UDF==0			;NOT SPECIFIED
TP%LOG==1			;LOGICAL
TP%INT==2			;INTEGER
;	3
TP%SPR==4			;SINGLE REAL
;	5			;CHARACTER
TP%SPO==6			;SINGLE OCTAL
TP%LBL==7			;STATEMENT LABEL
TP%DPR==10			;DOUBLE REAL
TP%DPI==11			;DOUBLE INTEGER
TP%DPO==12			;DOUBLE OCTAL
TP%DPX==13			;EXTENDED-EXPONENT DOUBLE REAL ("G" FORMAT)
TP%CPX==14			;COMPLEX
TP%CHR==15			;CHARACTER
;	16
TP%LIT==17			;QUOTED LITERAL (ASCIZ)




;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
;ERROR TABLE ENTRIES

;0 thru 7 are various arithmetic traps
;0-7 entry numbers are determined by 3 flag bits in combination
;   and their values are fixed.

.ETIOV==0			;Integer overflow
.ETIDC==1			;Integer divide check
.ETFU1==2			;Floating underflow (impossible)
.ETFC1==3			;Floating divide check (impossible)
.ETFO1==4			;Floating overflow
.ETFC2==5			;Floating divide check
.ETFU2==6			;Floating underflow
.ETFC3==7			;Floating divide check (impossible)

.ETLRE==10			;Library routine errors
.ETOFW==11			;Output field width too small

.ETLST==.ETOFW			; Last error index defined
.ETNUM==.ETLST+1		;Total number of error table entries
;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
;OPDEFS & PSEUDO-INSTRUCTIONS


OPDEF PJRST  [JUMPA 17,]	;JUMP TO A ROUTINE THAT RETURNS
OPDEF HALT   [HALT]		;REAL HALT
OPDEF XMOVEI [SETMI]		;EXTENDED MOVE IMMEDIATE
OPDEF	XBLT	[020B8]		;Extended BLT opcode
OPDEF IFIW   [1B0]		;INSTRUCTION FORMAT INDIRECT WORD
.NODDT IFIW			;NO USE FOR DDT


;EXTENDED PRECISION ('G' FLOATING) OP CODES

OPDEF	GFAD	[102B8]		;GFLOAT ADD
OPDEF	GFSB	[103B8]		;GFLOAT SUBTRACT
OPDEF	GFMP	[106B8]		;GFLOAT MULTIPLY
OPDEF	GFDV	[107B8]		;GFLOAT DIVIDE

OPDEF	GSNGL	[021B8]		;GFLOAT TO SINGLE PRECISION
OPDEF	GDBLE	[022B8]		;SINGLE PRECISION TO GFLOAT
OPDEF	DGFIX	[023B8]		;GFLOAT TO DOUBLE PRECISION INTEGER, TRUNC.
OPDEF	GFIX	[024B8]		;GFLOAT TO SINGLE PRECISION INTEGER, TRUNC.
OPDEF	DGFIXR	[025B8]		;GFLOAT TO DOUBLE PRECISION INTEGER, ROUND
OPDEF	GFIXR	[026B8]		;GFLOAT TO SINGLE PRECISION INTEGER, ROUND
OPDEF	DGFLTR	[027B8]		;DOUBLE PRECISION INTEGER TO GFLOAT
OPDEF	GFLTR	[030B8]		;SINGLE PRECISION INTEGER TO GFLOAT
OPDEF	GFSC	[031B8]		;GFLOAT FLOATING SCALE

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%XCHAN		;EXTENDED-CHANNEL FILOPS AVAILABLE IN MONITOR
IF10,<	FLG	F%ADDR	>	;DO NEXT FILOP WITH ADDRESS
	FLG	F%CLS		;CLOSE IN PROGRESS
	FLG	F%NINP		;REREAD
	FLG	F%ERR		;IO ERROR IN THIS STATEMENT
	FLG	F%LAST		;IN LAST RECORD WRITTEN BY THIS STATEMENT
	FLG	F%CTTY		;OPEN IS OF CONTROLLING TTY
	FLG	F%SUP		;SUPRESS IO ERROR MESSAGE TYPEOUT
	FLG	F%REW		;OPEN FOR REWIND
	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%CLA		;CLOSE args given besides UNIT, ERR, IOSTAT
	FLG	F%NION		;Error already printed in this statement
				; (don't say name of statement again)
	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%SILF		;SUPPRESS INITIAL LF (OUTPUT CARRAIGE CONTROL)
	FLG	D%SICR		;SUPPRESS INITIAL CR ($ FMT IN PREVIOUS LINE)
	FLG	D%EOI		;END OF IO LIST
	FLG	D%END		;INTERNAL EOF, MEANS SET F%EOF AT END OF RECORD
	FLG	D%RAN		;1=RANDOM, 0=SEQUENTIAL
	FLG	D%UNF		;1=UNFORMATTED, 0=FORMATTED
	FLG	D%BIN		;1=BINARY FILE (WITH LSCWS)
	FLG	D%MOD		;(20) DISK FILE MODIFIED, MUST UPDATE FDB
	FLG	D%IN		;INPUT OK
	FLG	D%OUT		;OUTPUT OK
	FLG	D%APP		;APPEND MODE
	FLG	D%TRNC		;OUTPUT TRUNCATION WARNING GIVEN ONCE
	FLG	D%INT		;INTERACTIVE DEVICE
	FLG	D%LIN		;LAST I/O DIRECTION WAS INPUT
	FLG	D%LOUT		;LAST I/O DIRECTION WAS OUTPUT
	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
	FLG	D%ENC		;ENCODE/DECODE
	FLG	D%EOR		;END OF RECORD

;Here are the flags to clear
	D%CLR== D%BZ+D%SP+D%STCR+D%IO+D%NML+D%LSD+D%ENC+D%EOR

;FLAGS FOR USE IN IOERR MACRO

%F==1B27
	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%UNI		;Unit error -- no "D" and "U"
	FLG	I%TCH		;Type erroreous string with arrow under it.

	;Up to 4 more can be defined

	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	RELEA		;DEVICE RELEASE
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	DBMS		;DBMS ENTRY
X	INQ		;DEVICE/FILE INQUIRE
X	FOROP		;MISCELLANEOUS LIBRARY UTILITIES

> ;END FORVEC
;SIMULATED ADJUST STACK POINTER FOR KI PROCESSORS
; WITH BUILT IN STACK OVERFLOW TRAPPING
; ADJUST STACK 'AC' BY 'E'

IFE FTKL,<
 DEFINE	ADJSP (AC,E) <
  IF2,<IFNDEF %STKOV,<EXTERN %STKOV>>
  IFGE E,<ADD AC,[E,,E]
	  JUMPGE AC,%STKOV>
  IFL  E,<SUB AC,[-E,,-E]>
 > ;END ADJSP
> ;END IFE FTKL



;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
;UNIVERSAL FILE SEARCHER
; ALLOWS RETRIEVAL OF OPERATING SYSTEM SPECIFIC SYMBOLS

DEFINE	FSRCH <
	SALL
IF10,<	SEARCH	UUOSYM,MACTEN>

IF20,<	SEARCH	MONSYM,MACSYM
	EXTERN	.JBAPR,.JBDDT,.JBFF,.JBHGH,.JBHRL,.JBHSA,.JBHSM,.JBOPS
	EXTERN	.JBOVL,.JBPFH,.JBREL,.JBSA,.JBSYM,.JBTPC,.JBVER
	EXTERN	.JBHDA,.JBHRN,.JBREN
> ;END IF20

	.DIRECT	FLBLST
> ;END FSRCH
;PSUEDO INSTRUCTIONS TXYY
; DEFINE THE VARIOUS FLAVORS

DEFINE DEFTX (Y,Z) <
 IRP Y,<
  IRP Z,<
   DEFINE TX'Y'Z (AC,E) <
    IFE <<E>&777777000000>,<TR'Y'Z AC,<E> ;> 
    IFE <<E>&000000777777>,<TL'Y'Z AC,(E) ;> 
			    TD'Y'Z AC,[E]
   > ;END TXYZ
  > ;END IRP Z
 > ;END IRP Y
> ;END DEFTX

;CREATE THE VARIOUS FLAVORS OF TXYY

DEFTX (<N,Z,O,C>,<N,E,A,>)


;PSUEDO INSTRUCTIONS MOVX
; CREATE THE VARIOUS FLAVORS

DEFINE MOVX (AC,E) <
 IFE <<E>&777777000000>,<MOVEI AC,<E> ;> 
 IFE <<E>&000000777777>,<MOVSI AC,(E) ;> 
 IFE <<E>_-22 - 777777>,<HRROI AC,<<E>&777777> ;> 
 IFE <<E>&777777-777777>,<HRLOI AC,<<E>_-22> ;> 
			 MOVE AC,[E]
> ;END MOVX

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



;PRODUCE RADIX50 REPRESENTATION FOR 'CHR'

DEFINE	R50 (CHR) <<RADIX50 0,CHR>>

;SEGMENT MACRO
; DEFINES SEGMENTS IN TERMS OF PSECTS (FTSHR==-1)
; OR LOW/HIGH RELOCS (FTSHR==0)
; .PSECTS TO SEGMENT 'S', WITH ATTRIBUTE SWITCHS 'ATR'
;  CURRENT SEGMENTS ARE CODE, DATA, AND ERR

IFN FTSHR,<
 DEFINE SEGMENT (S,ATR) <
  IFDEF $SEG$,<.ENDPS>
	$SEG$==1
	.PSECT	F.'S'ATR
	$NAME$==''S''
 > ;END SEGMENT
> ;END IFN FTSHR

IFE FTSHR,<
 DEFINE SEGMENT (S,ATR) <
  IFNDEF $SEG$,<
	TWOSEG	400000
	$SEG$==1>

  IFIDN <S><DATA>,<
   IFN $SEG$,<
	RELOC
	$SEG$==0>>

  IFDIF <S><DATA>,<
   IFE $SEG$,<
	RELOC
	$SEG$==1>>
 > ;END SEGMENT
> ;END IFN FTSHR




;GENERALIZED LIBRARY FUNCTION CALL
; CALL 'SUB', USING ARGLIST 'ARGS'
; GENERATES STANDARD ARGUMENT LIST
; AND SETS UP L PRIOR TO THE CALL

DEFINE FUNCT (SUB,ARGS) <
 IF2,<IFNDEF SUB,<EXTERN SUB>>
 .ARGN.=0
 IRP ARGS,<.ARGN.=.ARGN.+1>
	PUSH	P,L
	XMOVEI	L,1+[-.ARGN.,,0
		     IRP ARGS,<ARGS>]
	PUSHJ	P,SUB
	POP	P,L
 PURGE	.ARGN.
> ;END FUNCT
;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)>>

;LIBRARY ROUTINE ENTRY DEFINITIONS
; SETS UP APPROPRIATE INFORMATION FOR TRACEBACK
; 1. ASCIZ STRING: 'NAME', 'ENT', OR 'ENT.'
; 2. ENTRY LABEL: 'ENT', OR 'ENT.'
; 3. START LABEL: SAME AS 2.
; DOTTED ROUTINE NAMES INDICATE FORTRAN DEFINED
; INTRINSIC FUNCTIONS
; NAME IS USUALLY FULL NAME WITHOUT THE DOT

DEFINE	HELLO (ENT,NAME) <
 IFNB <NAME>,<
  IFDIF <NAME><.>,<
	ENTRY ENT
	SIXBIT /NAME/
ENT:
  > ;END IFDIF

  IFIDN <NAME><.>,<
	ENTRY ENT'.
	SIXBIT /ENT'./
ENT'.:
  > ;END IFIDN
 > ;END IFNB

 IFB <NAME>,<
	ENTRY ENT
	SIXBIT /ENT/
ENT:
 > ;END IFB
> ;END HELLO




;LIBRARY ROUTINE STANDARD EXIT
; ARGUMENT 'N' IS NOT USED

DEFINE GOODBY (N) <
	POPJ	P,
> ;END GOODBY

;TITLE & VERSION MACRO

;DEFINES VMAJOR, VMINOR, VEDIT, VWHO FROM STANDARD VERSION NUMBER STRING
; ROUTINE IS ENTITLED 'T', WITH VERSION NUMBER 'V'
; 'V' IS TAKEN APPART TO PRODUCE THE VERSION NUMBER ITEMS

DEFINE TV (T,V) <

 TITLE T'  'V
 FSRCH

 VMAJOR==<VMINOR==<VEDIT==<VWHO==0>>>
 %VWHO==0

 IRPC V,<

  IFLE <"V"-"A">*<"V"-"Z">,<VMINOR==VMINOR*^D26 + "V" - "A" + 1>

  IFLE <"V"-"0">*<"V"-"9">,<VMAJOR==VMAJOR*^D8 + "V" - "0">

  IFIDN <V><(>,<%VMAJOR==VMAJOR
		VMAJOR==0>

  IFIDN <V><)>,<VEDIT==VMAJOR
		VMAJOR==%VMAJOR>

  IFIDN <V><->,<%VMAJOR==VMAJOR
		VMAJOR==0
		%VWHO==-1>
 > ;END IRPC

 IFN %VWHO,<VWHO==VMAJOR
	    VMAJOR==%VMAJOR>

 DEFINE VER <
	BYTE	(3)VWHO(9)VMAJOR(6)VMINOR(18)VEDIT
 > ;END VER

 PURGE %VMAJOR,%VWHO
> ;END TV

;ERROR MACROS

;THE NEXT THREE MACROS USES THE FOLLOWING ARGS:
;PFX  = UNIQUE 3-CHARACTER ERROR PREFIX
;N1   = FIRST ARBITRARY VALUE RETURNED BY ERRSNS
;N2   = SECOND ARBITRARY VALUE RETURNED BY ERRSNS
;CHR  = ?, %, OR [ ... DEFINES PUNCTUATION OF MESSAGE
;	IF NULL, NO PREFIX IS TYPED
;	IF ?, A CLRBFI IS DONE
;	IF $, FIRST IN LIST OF ARGS IS ACTUAL CHR
;MSG  = TEXT OF MESSAGE
;ARGS = LIST OF ARGUMENT ADDRESSES (ANYWHERE BUT T0)
;	MAY BE ON THE STACK FOR MACRO ERR ONLY
;CONT = OPTIONAL CONTINUE ADDRESS.  IF OMITTED, JOB IS ABORTED
;       (? ERROR) OR CONTINUES AFTER ERR CALL (NON-? ERROR)
;
; 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
; ERR AND IOERR USE %ERARG DIRECTLY, LERR USES IT INDIRECTLY
;  IN ALL CASES, %ERARG (DEFINED IN FORERR) CAN ONLY CONTAIN 8 ARGUMENTS
; BOTH ERR AND IOERR DESTROY T0
; %FORER AND FORER. ARE DEFINED IN FORERR, %IOERR IN FOROPN
; EXAMPLES:
;  ERR (IUN,?,ILLEGAL UNIT NUMBER $D,<T2>,%ABORT)
;  ERR (FFX,?,FOROP FUNCTION CODE EXCEEDS RANGE,,%POPJ)

DEFINE ERR (PFX,CHR,MSG,ARGS) <

 IFN FTSHR,<
  IFN $NAME$-'ERR',<			;SHARABLE FOROTS IN WRONG PSECT
	PUSHJ	P,E..'PFX
	XLIST
	.PSECT	F.ERR
  > ;END IFN NAME-ERR

  IFE $NAME$-'ERR',<			;SHARABLE BUT CORRECT PSECT
	PUSHJ	P,[
  > ;END IFE NAME-ERR
 > ;END IFN FTSHR

 IFE FTSHR,<				;NONSHARABLE IS ALWAYS CORRECT
	PUSHJ	P, [
 > ;END IFE FTSHR

E..'PFX::				;DEFINE THE ERROR


 IF2,<IFNDEF %ERARG,<EXTERN %ERARG>>	;ARG STACK
 IFNB <ARGS>,<		MOVEI	T0,%ERARG-1	;STACK IF ANY
  IRP ARGS,<
   IFE <<<Z ARGS>_-^D18>-P>,< PUSH T0,-1+ARGS >	;FIXUP FOR STKVAR
   IFN <<<Z ARGS>_-^D18>-P>,< PUSH T0,ARGS    >
  >; END IRP
 > ;END IFNB

 IF2,<IFNDEF %FORER,<EXTERN %FORER>>
		PUSHJ	P,%FORER			;ERROR CALL
		BYTE	(7)"CHR"(19)0			;'ERROR ARG BLOCK'
		XWD	''PFX'',0
		ASCIZ	\MSG\


 IFE FTSHR,<			]	>	;FINISH LITERAL

 IFN FTSHR,<
  IFN $NAME$-'ERR',<
	.ENDPS
	LIST
  > ;END IFN NAME-ERR

  IFE $NAME$-'ERR',<		]	>	;FINISH FOR OTHER CASES
 > ;END IFN FTSHR
> ;END ERR
;SPECIAL ERRORS

;$SNH - generate "SHOULD NOT HAPPEN" error
DEFINE $SNH,<
	IF2,<IFNDEF E..SNH, EXTERN E..SNH
	   IFNDEF %HALT, EXTERN %HALT>
	PUSHJ	P,[PUSH P,[-1,,%HALT]
		   JRST E..SNH]
>;END DEFINE $SNH

;IOERR IS THE SAME AS ERR BUT 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 (PFX,N1<0>,N2<0>,CHR,MSG,ARGS,FLGS<0>) <

 IFN FTSHR,<
  IFN $NAME$-'ERR',<
	PUSHJ	P,E..'PFX
	XLIST
	.PSECT	F.ERR
  > ;END IFN NAME-ERR

  IFE $NAME$-'ERR',<
	PUSHJ	P,[
  > ;END IFE NAME-ERR
 > ;END IFN FTSHR

 IFE FTSHR,<
	PUSHJ	P, [
 > ;END IFE FTSHR

E..'PFX::

	IFG <N2>,<N..'N2==:''PFX'' >	;DEFINE ERROR NUMBER 
					;(LINK CATCHES MULT DEF ERROR NUMBERS)	


 IF2,<IFNDEF %ERARG,<EXTERN %ERARG>>
 IFNB <ARGS>,<	MOVEI	T0,%ERARG-1
  IRP ARGS,<	PUSH	T0,ARGS		>
 >; END IFNB
 IF2,<IFNDEF %IOERR,<EXTERN %IOERR>>
		PUSHJ	P,%IOERR
		BYTE	(7)"CHR"(10)^D'N1,^D'N2(9)'FLGS'
		XWD	''PFX'',0
		ASCIZ	\MSG\


 IFE FTSHR,<			]	>
 IFN FTSHR,<
  IFN $NAME$-'ERR',<
	.ENDPS
	LIST
  > ; END IFN NAME-ERR

  IFE $NAME$-'ERR',<		]	>
 > ;END IFN FTSHR
> ;END IOERR

;LERR IS THE SAME AS ERR, BUT IS FOR USE OUTSIDE FOROTS
; (USUALLY LIBRARY ERRORS)
; IT CALLS FORER. INSTEAD OF %FORER
; ARGS GO ONTO THE STACK INSTEAD OF DIRECTLY ONTO
;  THE %ERARG LIST
; EXAMPLES:
;  LERR (LIB,%,<ENTRY SQRT; NEGATIVE ARG; RESULT=SQRT(-ARG)>)
;  LERR (LIB,?,DIVERT: UNIT $D IS NOT OPEN,<@(L)>,DIVERT)


DEFINE LERR (PFX,CHR,MSG,ARGS,CONT) <

 .ARGN.==0
 IRP ARGS,<.ARGN.==.ARGN.+1>

	PUSHJ	P, [
	 IFNB <CONT>,<	PUSH	P,[-1,,CONT]  >
	 IRP ARGS,<	PUSH	P,ARGS   >
			PUSH	P,[.ARGN.]
			PUSHJ	P,FORER.##
			BYTE	(7)"CHR"(19)0		;'ERROR ARG BLOCK'
			XWD	''PFX'',0
			ASCIZ	\MSG\
		  ]
 PURGE .ARGN.
>; END LERR



;$ECALL CALLS AN ERROR ROUTINE DEFINED SOMEWHERE BY AN ERR (OR IOERR) MACRO


DEFINE	$ECALL (PFX,CONT) <
	EXTERN E..'PFX
IFB <CONT>,<	PUSHJ	P,E..'PFX >
IFNB <CONT>,<	PUSHJ	P,[PUSH P,[-1,,CONT]
			JRST E..'PFX] >
>
;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
	DEFWD	ERRAD		;ERR= address
	DEFWD	IOSAD		;IOSTAT= address
	DEFWD	ENDAD		;END= address
	DEFWD	AVAR		;/ASSOCIATE variable address
	DEFWD	NREC		;Number of current record
	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
	DEFBYT	PADCH,9		;/PADCHAR

	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

;******* DO NOT SPLIT NEXT TWO WORDS ********
	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	IRLEN		;INPUT RECORD LENGTH
	DEFWD	ORLEN		;Current output record length

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

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		;(Disk) AOBJN ptr to table of windows
				; or starting page address (SEQ IO)
	DEFWD	WPTR		;Ptr into WTAB, gives least recently
				; used page, more or less
	DEFWD	WSIZ		;Size of window in words
	DEFWD	WCNT		;Count of active bytes in buffer
	DEFWD	WADR		;Local (18-BIT) Address of window
	DEFWD	BYTN		;Current byte number in file
	DEFWD	BLKN		;Block number

	DEFWD	SAVP1		;P1-P4 for I/O calls
	DEFWD	SAVP2
	DEFWD	SAVP3
	DEFWD	SAVP4

	DEFWD	IOSUB		;LH= input subroutine, RH= output subroutine
	DEFWD	LSNUM		;Line seq. number for this channel
	DEFWD	FLAGS		;DDB control flags (From DF)
	DEFWD	RSIZE		;Record size, in bytes
	DEFWD	ORPOS		;VIRTUAL OUTPUT RECORD POSITION

	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	RSIZW,^D18	;/RECORD SIZE, WORDS
	DEFBYT	LIM,^D18	;/LIMIT

IF10,<	DEFBYT	BUFAD,^D18  >	;ADDRESS OF BUFFERS
IF20,<
	DEFBYT	IJFN,9		;JFN
	DEFBYT	OJFN,9		;Output JFN
				;Note: Always the same except if
				;     .PRIIN, .PRIOU
> ;END IF20

	DEFBYT	BPW,6		;(DISK) NUMBER OF BYTES IN WORD
	DEFBYT	TTYW,9		;LINE WIDTH, CHARACTERS
IF20,<
	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.INT==4		    ;INTERNAL FILE (OR ENCODE/DECODE)

	DEFWD	ERRN		;Number of I/O errors
	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	DMBS,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)
	DEFWD	CCOC,2		;(TTY) CCOC words for input
> ;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
	END