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