Trailing-Edge
-
PDP-10 Archives
-
fortv11
-
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 ,11(5016)
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SALL
;REVISION HISTORY
COMMENT \
***** Begin Revision History *****
1267 EGM 15-Feb-81 Q10-04519
Clean up FORPRM, add checks for feature test conflicts, and
rework byte definition such that macro GLBS references and
macro BYTPTS defines byte pointers for ALL bytes defined in
the DDB.
1271 EGM 18-Feb-81 --------
Allow DEFSTR storage macros to use previously defined DDB byte
pointer when indexing using (d), and allow the other cases to
work correctly also.
1276 DAW 20-Feb-81
Copy useful field/mask macros from MACSYM:
FLD, POINTR.
1277 JLC 23-Feb-81
Created new DDB entry for rounded record size (RSIZR) plus
added bytes/word entry (BPW) to -10 (removed it from -20-only).
1301 JLC 24-Feb-81
Created new DDB entry for line sequence number.
1310 DAW 26-Feb-81
Change half-words to full-words in the DDB: ERR=, END=, IOST=, AVAR=
that are addresses in the user's program or data.
1314 EDS 4-Mar-81
Add feature test switch FTNLC1 to allow skipping of column 1
of NAMELIST input data.
1316 JLC 5-Mar-81
Separated flag D%LIO (last I/O direction) into 2 flags, D%LIN
and D%LOUT.
1320 DAW 6-Mar-81
New feature test switches for type of global byte pointer
to use, when indexed byte pointers are not appropriate.
1334 DAW 19-Mar-81
Define macros for dealing with the different flavors of byte
pointers: $BLDBP, $LODBP, $STRBP.
1337 JLC 12-Mar-81
Moved MAXARG definition from FOROTS.MAC to here, and increased
it to 128.
1365 JLC 25-Mar-81
Typo in renaming of IBPTR/OBPTR to IPTR/OPTR.
1377 JLC 01-Apr-81
Changed FLGS from a 36-bit byte to a word (FLAGS).
1404 EGM 6-Apr-81 --------
Add feature test FTGFL for checking GFLOAT args in complex double
precision library routines.
1411 DAW 8-Apr-81
Replace JFN field in the DDB with IJFN and OJFN.
1416 JLC 10-Apr-81
Separate record buffer parameters for input and output.
1417 DAW 10-Apr-81
Added F%EDM, so FOROTS knows it should type traceback info
before throwing the user into DIALOG mode, when the reason
for the DIALOG mode is because of an OPEN error.
1427 JLC 15-Apr-81
Changed RSIZ from a halfword to a full word (RSIZE) so
we can eliminate flag D%RSIZ.
1441 JLC 17-Apr-81
Removed D%RSIZ, replaced with D%OPEN for future use in CLOSE.
1456 PY/JLC 27-Apr-81
Remove extra angle brackets from POINTR macro, was causing
MACRO to create Polish string in pass 2 after pooling literals
in pass 1, so hiseg break was incorrect.
1463 JLC 7-May-81
Add new words to -20 file database (WADR,WSIZ) plus
places to store P1-P4 for %GETIO.
1464 DAW 12-May-81
Error message cleanup, also get rid of $2HAK.
1465 JLC 15-May-81
Added data words to the -20 disk database for major I/O
changes, mostly to magtape operations.
1532 DAW 14-Jul-81
OPEN rewrite: Base level 1
1535 JLC 14-Jul-81
Added word for virtual output record size for T format.
1540 DAW 17-Jul-81
Delete IS from DDB, use IOSTAT variable directly.
Set IOSTAT variable to zero at the start of each IO statement.
Set D%ERR if "?" error in IOERR.
1542 JLC 17-Jul-81
Removed D%EOF, hopefully forever.
1543 DAW 17-Jul-81
Allow SCRATCH files to devices besides DSK.
1551 DAW 20-Jul-81
Fix structure macros so "MOVE" of a quantity that's not full-word
produces a "Q" error.
1560 DAW 28-Jul-81
OPEN rewrite, base level 2
1570 DAW 30-Jul-81
Add flag F%NION.
1615 DAW 19-Aug-81
Get rid of two word BP options.
1622 JLC 21-Aug-81
Make ORLEN a full word.
1625 DAW 21-Aug-81
Get rid of "DF".
1643 JLC 25-Aug-81
Make IRBUF & ORBUF full word byte pntrs.
1656 DAW 2-Sep-81
Define error table entries symbolically to get rid
of some magic numbers all over FOROTS.
1657 DAW 2-Sep-81
Delete 7.01 definitions.
1663 JLC 8-Sep-81
Added TPAGE(D) to record top page written in a file,
so CLOSE can unmap unused pages.
1712 JLC 15-Sep-81
Added IRVIR, the position in the input record.
Eliminated D%ERR forevermore.
1716 JLC 16-Sep-81
Changed the names of IRVIR/ORVIR to IRPOS/ORPOS.
1717 DAW 16-Sep-81
New flag D%NCLS
1725 DAW 18-Sep-81
New error flag I%TCH.
1745 JLC 24-Sep-81
Made IRBLN, ORBLN, and IRLEN full words. Removed the silly %
from the TV macro.
1747 DAW 28-Sep-81
Added defs for more FOROP. functions.
1752 DAW 29-Sep-81
Add flag F%INDST.
1775 JLC 9-Oct-81
Change parity options to be non-zero, so we can tellif program
gave one.
2005 JLC 15-Oct-81
Added new FOROP call, removed OPDEF of PJRST.
2011 DAW 19-Oct-81
Got rid of FSTAT on the -10.
***** Begin Version 7 *****
3035 JLC 5-Feb-82
Parameters to support rework of binary I/O. Make KL the
default processor, as KI's are no longer supported.
Do away with D%BIN, D%UNF and D%EOR, as code in FORIO
and FOROPN no longer needs them.
3036 BL 10-Feb-82
Inserted NLBFLN, initial buffer length for list-directed
character string input buffer.
3037 JLC 11-Feb-82
Removed ERRN from DDB; it was useless.
3050 BL 25-Feb-82
Changed NLBFLN TO NLDIBF (See #3036).
3053 AHM 4-Mar-82
Defined TWOSEG and RELOC macros under an FTXLIB feature test
that expand to .PSECT and .ENDPS pseudo ops for psects .CODE.
and .DATA. They will be used during extended addressing
development.
3056 JLC 23-Mar-82
Changed the defs of IOERR and ERR to remove literal def.
3060 JLC 25-Mar-81
Remove RELEA. entry vector. Replace it with EXIT1.
3062 JLC 25-Mar-82
Make the error entry in the FOROTS vector table point
to the AC save-type routine.
3073 JLC 31-Mar-82
Undo edit 3062. The error routine saves the ACs locally, and
should continue doing so.
3122 JLC 28-May-82
Changed error macros, made FORPRM a module added to MTHPRM.
3125 JLC 3-Jun-82
Moved the error character in the error macros.
3127 AHM 8-Jun-82
Remove temporary TWOSEG and RELOC macros created by edit 3053
from FORPRM because edit 3122 put SEGMENT macros in FORLIB.
3136 JLC 26-Jun-82
Install new DDB entries for performance improvement.
3161 JLC 16-Aug-82
Change NREC(U) to CREC(D). Increase size of FOROTS stack
to a page.
3165 JLC 28-Aug-82
Add a DDB entry for handling large files on TOPS-10.
3176 JLC 9-Sep-82
Added some FUNCT. codes for use within FOROTS.
3202 JLC 26-Oct-82
Added new DDB entries for ANSI magtapes.
Added SPCWD, a word of spaces, to the DDB.
3203 AHM 1-Nov-82
Define a lot more FUNCT. codes for use outside of FOROTS.
3212 JLC 11-Nov-82
Removed special binary SINR pointer and byte ratio and added
flag to signal whether to do formatted or 36-bit SINRs/SOUTRs.
3215 JLC 15-Nov-82
Change name of DMBS (data mode and byte size) to DMABS.
3225 JLC 24-Nov-82
Install new call ($FJCAL) for JSYS errors from FORLIB.
3231 JLC 14-Dec-82
Add new FOROTS entry macro FENTRY, for use with DBMS
interface, and allows changing the lowseg/hiseg interface
easily for V8.
3245 JLC 5-Jan-83
Fixed value of ENDP for DBMS.
3252 JLC 12-Jan-83
Created FORPRG macro to purge global symbols created by MONSYM
which do not have "%" or "." in them.
***** End V7 Development *****
3276 TGS 22-Mar-83 SPR:NONE
Fixed value of ENDP for UDDT
3300 TGS 1-Apr-83 SPR:NONE
Delete FTGFL flag as it is also defined in MTHPRM. Move ARGKWD,
ARGTYP and ARGADR from FORPRM to MTHPRM (MTHLIB edit 3242).
***** Begin Version 10 *****
4000 JLC 22-Feb-83
Remove D%IO and D%RAN, as they are used no more.
4005 JLC 28-Feb-83
Added DDB entry for FIN address.
4006 JLC 1-Mar-83
V7 becomes v10.
4010 JLC 19-Apr-83
Add IOKWD, for I/O keywords in IOLST calls.
4014 JLC 14-Jun-83
Changed names of some DDB variables so they wouldn't conflict
with definitions in MACSYM and MONSYM. Expand CC for CC.TRN.
Add definitions for INQUIRE and RMS/tape support.
4023 JLC 29-Jun-83
Remove FTSHR, D%SP, and D%BZ. Search MTHPRM.
4036 JLC 3-Aug-83
Add a word flag for ASCII-only device.
4040 JLC 6-Sep-83
Add FB%FOR temporarily until it is defined in MONSYM.
4044 JLC 19-Sep-83
Added new FOROP functions for memory manager debugger, and
left room for the SORT functions for V7A patch.
4045 JLC 30-Sep-83
Removed UBSZ from DDB. Added a new device type - RMS file.
4052 JLC 12-Oct-83
Add word for saving DEVCHR bits so we can know
whether magtape is assigned.
4055 JLC 28-Oct-83
Added synonym for IJFN/OJFN in TOPS-10 FILOP block.
4060 JLC 2-Nov-83
Fix TOPS-10 tapemode values, had one missing.
4064 JLC 14-Nov-83
Add new RMS keywords for OPEN.
4065 JLC 6-Dec-83
Add new entries in DDB for RMS.
4066 JLC 11-Jan-84
Yet more entries in the DDB for the RMS preparations.
4071 JLC 18-Jan-84
Fixed BLANK= values for new code in FOROPN.
4072 JLC 24-Jan-84
Add new DDB variables for user id, account string, and password
for RMS remote file access.
4101 CDM 16-Feb-84
Create and expand the character stack differently when running
in extended addressing. Give the stack its own section(s) so
that it has plenty of room. Also add user subroutine ALCCHR.
4102 JLC 17-Feb-84
Add yet more DDB variables for RMS, plus some flags for
compatibility flagging, and a MACRO to call the compatibility error
entry point.
4104 JLC 23-Feb-84
Remove $CERR, as it is not needed after all.
4105 JLC 28-Feb-84
Modify the calling sequence for error calls.
4111 JLC 16-Mar-84
Modify the calling sequence for error calls again.
4112 JLC 19-Mar-84
Remove FDBMS from FORVEC, as it is no longer necessary.
4114 JLC 28-Mar-84
Remove I%TCH on TOPS-10, as it is almost useless
and didn't work anyhow.
4116 JLC 6-Apr-84
Add DT.NUL for TOPS-10, same as DT.DSK.
4122 JLC 2-May-84
A whole raft of changes to make the TOPS-10 and TOPS-20
DDB databases the same.
4123 JLC 5-May-84
Add some MONSYM symbols to the TOPS-10 parameters for TABLK.
4124 JLC 8-May-84
Fix some AC definitions.
4127 JLC 15-May-84
Add some TOPS-10 UUOSYM definitions.
4131 JLC 12-Jun-84
Remove some F flags.
4132 JLC 15-Jun-84
Increased size of IOKWD to 17 from 7.
4135 JLC 10-Jul-84
Add TMPFIL for temporary files on TOPS-20. Add PPNSTR for TOPS-10
style PPNs for TOPS-20.
4144 JLC 29-Aug-84
Add keyword and table values for DISPOSE='PLOT'.
4152 JLC 24-Sep-84
Add symbols for symbol vectors in PDVs.
4153 JLC 27-Sep-84
Add a new offset (FSTAD) for the initialization arg block.
4155 JLC 4-Oct-84
Change FO$SBA to FO$GBA, since it now gets the break address
rather than setting anything. Move $DCALL and $DJCAL here
from MTHPRM.
4161 JLC 1-Nov-84
Change ASCFLG to IMGFLG, indicating that the device in question is
an image-mode device which cannot have LSCWs. This will then include
the ASCII-only devices. Remove all tests of MODE(D)=MD.IMG, since
this test is not general enough; instead just check IMGFLG.
Widen CNSL1 and CNSL2 in DDB to full-word addresses.
4171 JLC 29-Nov-84
Add some 7.03 parameters and set .RBMAX to its 7.03 value so
that CARRIAGECONTROL='FORTRAN' will work when the customers
receive 7.03.
4174 JLC 9-Jan-85
Remove private definition of .RBMAX, since the TOPS-10 monitor
group wedged the carriage control bits into the current RIB.
4200 TGS 28-Jan-85
Implement V7 edit 3442: Initialize ENDP/%ENDP to 777. In section
0, set %ENDP for MINILP to 763 if DDT is in core; if not, leave
at 777. For non-zero sections, simply set page 777 as unavailable.
(Modules FORPRM, FORMEM)
4203 JLC 13-Mar-85
Add user-supplied bytesize (UBSIZ) to DDB, to differentiate it
from the actual bytesize of the file.
***** End V10 Development *****
4233 RJD 18-Nov-85
Add MAXSEC for maximum section number.
***** Begin Version 11 *****
5000 TGS 18-Mar-85
Implement RMS OPEN. Define constants and DDB fields.
5011 MRB 7-APR-86
Allow long symbol names in namelist names. (Added defs for them)
5014 MRB 6-JUN-86
Implement RMS UNLOCK statement. Added symbol UNLOC to FORVEC.
5016 MRB 16-Jun-86
Implement MAXREC keyword in open statements.
***** End Revision History *****
\
SEARCH MTHPRM
IF10,< SEARCH UUOSYM>
IF20,< SEARCH MONSYM>
;INSTALLATION-DEPENDENT PARAMETERS
;FT10 ;TOP10 (NONZERO=YES)
;FT20 ;TOPS-20 (NONZERO=YES)
;FTKL ;KL/KS PROCESSOR (NONZERO=YES)
;FTEXT ;[5000] PROCESSOR SUPPORTS EXT ADDR. (NONZERO=YES)
;FTPSCT ;PSECTED FOROTS (NONZERO=YES)
;FTVAX ;ALL UNITS ARE DSK: EXCEPT 5, WHICH IS TTY (NONZERO=YES)
;FTDSK ;ALL UNITS DEFAULT TO DSK: (NONZERO=YES)
;FTAST ;ASTERISK FILL; FIELD WIDTH OVERFLOW (NONZERO=YES)
;STARTP ;PAGE TO START LOOKING FOR MEMORY
;FTNLC1 ;IGNORE DATA IN COL 1 OF NAMELIST INPUT (NONZERO=YES)
;FTGGL ;GFLOATING DOUBLE PRECISION LIBRARY CHECKS
;WRNCNT ;*UNSUPPORTED* NUMBER OF WARNINGS OF A SPECIFIC
; ; TYPE THAT GET PRINTED. FOROTS's default is 2.
;DEFAULTS:
;FT20: NO
;FT10: NO
;FTKL: YES IF NO PROCESSOR SPECIFIED
;FTEXT NO ;[5000]
;FTPSCT: NO
;FTVAX: NO
;FTDSK: NO
;FTAST: YES
;STARTP: 577
;FTNLC1: NO
IFNDEF FTMATH,<?PRINTX MODULE MUST BE ASSEMBLED WITH MTHPRM.MAC
END>
IFNDEF FTVAX,<FTVAX==0> ;UNITS DON'T DEFAULT TO VAX DEVICE TABLE
IFNDEF FTDSK,<FTDSK==0> ;ALL UNITS DON'T DEFAULT TO DEVICE DSK
IFNDEF FTAST,<FTAST==-1> ;ASTERISK FILL
IFNDEF STARTP,<STARTP==577> ;600 UP ARE LAST USED BY FOROTS MEMORY MGR
IFNDEF FTNLC1,<FTNLC1==0> ;DO NOT SKIP COLUMN 1 ON NAMELIST INPUT
IFNDEF WRNCNT,<WRNCNT==2> ;Number of warnings of a specific type
; that get printed.
;FOROTS AC DEFINITIONS
D==S1 ;POINTER TO CURRENT DDB
U==S2 ;THE UNIT BLOCK POINTER
F==S3 ;LOCAL FLAGS
FREEAC==S4 ;FOR NOW, IT'S THE "FREE AC"
;BYTE POINTER AND BYTE SIZE DEFINITIONS
IBPW==5 ;CURRENTLY 5 BYTES/WORD INTERNALLY IN FOROTS
IBSZ==7 ;BYTE SIZE = 7
IFBYT==<POINT 7> ;ONE-WORD LOCAL FIRST BYTE POINTER
IFOWG==<610000,,0> ;ONE-WORD GLOBAL FIRST BYTE POINTER
;$BLDBP - build byte ptr from address, when you want a 7-bit or 6-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
>
DEFINE $BLBP6 (AC),< ;[5011]New for sixbit strings
TLNE AC,-1 ;Skip if local address
TXOA AC,B1WBP6 ;Global address, make BP and skip
HRLI AC,(POINT 6,) ;Local address, make BP
>
;OTHER DEFS
RWKWD==17B8 ;READ, WRITE KEYWORDS GO FROM 0 TO 17 ONLY
IOKWD==17B8 ;I/O KEYWORDS GO FROM 0 TO 17 ONLY
MOSBSZ==6 ;MTOPR STATUS BLOCK SIZE
BUFNM==4 ;DEFAULT BUFFER COUNT - NUMBER OF PAGES/FILE
CHMSIZ==200 ;MINIMUM SIZE TO ADD TO FN%GAD CHAR STACK CALLS
ETBSIZ==^D30 ;ERROR TABLE SIZE FOR ERRSET, ETC.
IFMTSZ==200 ;INITIAL FORMAT ENCODING AREA SIZE
LPDL==1000 ;LENGTH OF STACK
LRECBF==^D80 ;INITIAL LENGTH OF RECORD BUFFER, BYTES
LTEXTW==100 ;LENGTH OF BUFFER FOR FULL FILESPEC
LTEXTC==LTEXTW*5 ;# CHARACTERS IN FILESPEC BUFFER
LATOMW==40 ;ATOM BUFFER LENGTH
LATOMC==LATOMW*5 ;AND IN CHARS
NLDIBF==^D140 ;List-directed input character string buffer
;byte length
FLSIZE==20 ;INITIAL SIZE OF LS FREE LIST
PLEN==1 ;LENGTH OF PAGE. ARG BLOCK
;*** DO NOT SET ABOVE 1 UNTIL MONITOR FIXED
FMTN==^D47 ;POINTERS TO ENCODED FORMAT STATEMENTS
INQUNT==-^D12 ;INQUIRE
IFIUNI==-^D11 ;INTERNAL FILE INPUT
IFOUNI==-^D10 ;INTERNAL FILE OUTPUT
ENCUNI==-^D9 ;ENCODE
DECUNI==-^D8 ;DECODE
MINUNIT==-7 ;MIN LEGAL UNIT NUMBER
RRUNIT==-6 ;REREAD UNIT
MAXUNIT==^D99 ;MAX LEGAL UNIT NUMBER
MAXPDV==5 ;MAX PDVS TO SCAN AT ONCE
MAXSEC==37 ;[4233] MAX SECTION NUMBER
MAXARG==^D128 ;MAX # ARGS IN AN I/O LIST
;[5000] DEFINE RMS CONSTANTS
IF20,<
CACHSR==^D20 ;RMS CACHESIZE (RECORDS)
CACHSZ==CACHSR*2 ;RMS CACHESIZE (WORDS)
MAXKEY==^D255 ;MAX # RMS KEY= INDEXES
KSPLEN==3 ;KEY SPEC ARGLIST ENTRY LENGTH
LBO==0 ;OFFSET FOR LOWER BOUND
UBO==1 ;OFFSET FOR UPPER BOUND
DTO==2 ;OFFSET FOR KEY DATA TYPE
> ; End IF20
;[5000] END RMS CONSTANTS
VFOROTS==11 ;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.
B1WBP6==<45>B5 ;Bits to TXO when you want a one-word
;global byte pointer with 6-bits.
;Character stack
ICHRSZ==1000 ;Create 1 page non-extended character stack
ECHSIZ==1 ;Minimum words for extended char stack
;COMPATIBILITY FLAGGING INDICES
VAXIDX==1 ;INDICATES VAX FLAGGING
ANSIDX==2 ;INDICATES ANSI-77 FLAGGING
;PROCESSOR-DEPENDENT DEFAULTS
IF20,<
ENDP==777 ;[3276][4200] TOP OF CORE ON -20 (LEAVE UDDT)
PRTDIG==6 ;6 DIGITS IN PROTECTION
> ;END IF20
IF10,<
ENDP==775 ;TOP OF CORE ON -10 (LEAVE PFH)
PRTDIG==3 ;3 DIGITS IN PROTECTION
> ;END IF10
;CHARACTER CONSTANTS
.CHLAB==74 ;Left angle bracket "<"
.CHRAB==76 ;Right angle bracket ">"
;MISCELLANEOUS DEFINITIONS
IF10,<
;TOPS-10 DEFINITIONS NOT IN RELEASE 7.01 UUOSYM
ERDAJ%==52 ;UNIT ASSIGNED TO ANOTHER JOB
ERNFC%==57 ;NOT ENOUGH CHANNELS
;PAGE. UUO FUNCTIONS
.PAGSC==12 ;SECTION MANIPULATION
PG.GSF==1B0 ;FOR .PAGSC, 1=DESTROY, 0=CREATE SECTION
PG.GMS==1B1 ;FOR .PAGSC, MAP SECTIONS TOGETHER
;FOROTS-10 DEFINITIONS FOR TOPS-20 SYMBOLS
CM%FW==1B7 ;FLAG WORD IN TABLK TABLE
CM%ABR==1B33 ;THIS IS AN ABBREVIATION STRING
CM%INV==1B35 ;INVISIBLE (NOT ACTUALLY USED BY FOROTS-10)
;FOROTS DEFINITION OF .RBTYP (AND OTHER 7.03 PARAMETERS)
;SO FORTRAN CARRIAGE CONTROL
;WILL WORK WHEN THE CUSTOMER PUTS UP 7.03
.RBTYP==22 ;FILE TYPE WORD
RB.DEC==1B0 ;TELLS TOPS-10 TO PAY ATTENTION TO .RBTYP
RB.DCC==77B35 ;CARRIAGE CONTROL
.RBCFO==1 ;FORTRAN CARRIAGE CONTROL
> ;END IF10
IF20,<
GT%ARG==1B22 ;Arg block supplied for GET
GT%BAS==1B2 ;BASE-address word supplied in arg block
FB%FOR==100000 ;NOT DEFINED IN FIELD IMAGE MONSYM
JS%NOD==400000,,0 ;NOT DEFINED IN 5.1 MONSYM
OPDEF XGVEC% [JSYS 606] ;[3156] Get extended entry vector info
OPDEF XSVEC% [JSYS 607] ;[3156] Set extended entry vector info
OPDEF PDVOP% [JSYS 603] ;[4120] MANIPULATES PROGRAM DATA VECTORS
;FUNCTION CODES ACCEPTED IN AC1:
.POGET==:0 ;GET A SET OF PDVAS
;(PROGRAM DATA VECTOR ADDRESSES)
;ARG BLOCK OFFSETS FOR BLOCK ADDRESSED BY AC2
.POCT1==:0 ;SIZE OF ARG BLOCK INCLUDING THIS WORD
.POPHD==:1 ;PROCESS HANDLE
.POCT2==:2 ;SIZE OF DATA BLOCK (AND SIZE OF RETURNED DATA)
.PODAT==:3 ;ADDRESS OF DATA BLOCK
.POADR==:4 ;SMALL ADDRESS OF DATA VECTOR
.POADE==:5 ;LARGE ADDRESS OF DATA VECTOR ADDRESS RANGE
;OFFSETS DEFINED WITHIN PROGRAM DATA VECTORS
.PVCNT==:0 ;Length of vector
.PVNAM==:1 ;Address of a word-aligned ASCIZ program name
.PVMEM==:5 ;Address of a block describing program memory
.PVSYM==:6 ;Address of the program symbol table
;[4120] PVMEM BLOCK (NOT YET IN MONSYM)
.PMCNT==:0 ;COUNT OF ALL WORDS IN BLOCK
.PMDAT==:0 ;HEADER FOR SUB-TABLE (BITS,,LENGTH)
.PMLOW==:1 ;XFIW FOR BLOCK LO ADDRESS
.PMHI==:2 ;XFIW FOR BLOCK HI ADDRESS
.PMRES==:3 ;RESERVED TO DEC
;SYMBOL VECTOR DEFINITIONS
.STLEN==0 ;SYMBOL VECTOR LENGTH
.STDAT==0 ;TYPE AND SYMBOL TABLE LENGTH WORD
ST%TYP==77B5 ;SYMBOL TABLE TYPE
ST%LEN==7777777777B35 ;SYMBOL TABLE LENGTH
.STPTR==1 ;SYMBOL TABLE POINTER WORD
.R50D==1
> ;END IF20
;FOROTS INITIALIZATION ARG BLOCK PARAMETERS
FDBS==0 ;ADDRESS OF DBSTP$
FLAL==1 ;ADDRESS OF USER FIXUP ARG BLOCK
FLGVX==2 ;VALUE OF VAX FLAGGER
FLG77==3 ;VALUE OF ANSI FLAGGER
FSTAD==4 ;ADDRESS OF LOCATION CONTAINING START ADDRESS
;FOROP FUNCTIONS
FO$APR==0 ;READ APR TABLE ADDRESSES
FO$ILL==1 ;READ ILL FLAG ADDRESS
FO$ERR==2 ;READ ERRSNS INFO
FO$DIV==3 ;Set DIVERT unit
FO$HSP==4 ;READ HIGH SEG SYMBOL POINTER
FO$FSV==5 ;ENCODE A FORMAT
FO$FCL==6 ;DELETE IT
FO$GLN==7 ;GET THE CURRENT LSA LINE NUMBER
FO$MEM==10 ;RETURN VARIOUS MEMORY PARAMETERS
FO$CHN==11 ;RETURN ADDR OF CHANNEL WORD
FO$QIT==12 ;QUIET EXIT FROM FORTRAN
FO$GDV==13 ;Get DIVERT unit
FO$CLS==14 ;CLOSE ALL FILES
FO$GCH==15 ;GET CHANNEL # (-10) OR JFN (-20)
FO$GFB==16 ;GET FILOP BLK ADDR (-10) OR 0 (-20)
FO$GFU==17 ;GET FIRST FREE UNIT NUMBER
FO$GBA==20 ;GET FORDDT BREAK ADDRESS FOR FOROTS ERRORS
FO$NOS==21 ;SET FOROTS FOR NO SORT IN FOROTS' SECTION
FO$SRT==22 ;PREMARK SORT SPACE IN FOROTS' SECTION
FO$UDB==23 ;[3432] GET ADDRESS OF %UDBAD
FO$PAT==24 ;GET AND ALLOW PA1050
FO$SVF==25 ;SET FOROTS TO SAVE ENCODED FORMATS
FO$NSF==26 ;SET FOROTS TO NOT SAVE ENCODED FORMATS
FO$DEF==27 ;DEALLOCATE ENCODED FORMATS
FO$DMM==30 ;SET DEBUG SWITCH FOR MEMORY MANAGER
.ETMAX==^D100 ;Maximum FOROTS error msg # is 99
;MNEMONICS FOR OPEN/CLOSE KEYWORD NUMBERS
OK.IGN==0 ;OMITTED ARG, IGNORED
OK.DIA==1 ;DIALOG
OK.ACC==2 ;ACCESS
OK.DEV==3 ;DEVICE
OK.BFC==4 ;BUFFER COUNT
OK.BLK==5 ;BLOCK SIZE
OK.FIL==6 ;FILE
OK.PRO==7 ;PROTECTION
OK.DIR==10 ;DIRECTORY
OK.LIM==11 ;LIMIT
OK.MOD==12 ;MODE
OK.FLS==13 ;FILE SIZE
OK.REC==14 ;RECORD SIZE
OK.DISP==15 ;DISPOSE
OK.VER==16 ;VERSION
OK.ORG==17 ;ORGANIZATION
OK.SHR==20 ;SHARED
OK.IOS==21 ;IOSTAT
OK.ASV==22 ;ASSOCIATE VARIABLE
OK.PAR==23 ;PARITY
OK.DEN==24 ;DENSITY
OK.BLNK==25 ;BLANK
OK.CC==26 ;CARRIAGE CONTROL
OK.FORM==27 ;FORM
OK.BYT==30 ;LABELS
OK.PAD==31 ;PADCHAR
OK.RTP==32 ;RECTYPE
OK.STAT==33 ;STATUS
OK.TAPM==34 ;TAPE MODE
OK.RO==35 ;READONLY
OK.UNIT==36 ;UNIT
OK.ERR==37 ;ERR
OK.XST==40 ;EXIST
OK.FRM==41 ;FORMATTED
OK.NMD==42 ;NAMED
OK.NRC==43 ;NEXTREC
OK.NBR==44 ;NUMBER
OK.OPN==45 ;OPENED
OK.SEQ==46 ;SEQUENTIAL
OK.UNF==47 ;UNFORMATTED
OK.NAM==50 ;NAME
OK.KEY==51 ;KEY [5000]
OK.UOP==52 ;USEROPEN [5000]
OK.DEQ==53 ;DIALOG= [5000]
OK.DFT==54 ;DEFAULTFILE [5000]
OK.KYD==55 ;KEYED [5000]
OK.SPN==56 ;NOSPANBLOCKS [5000]
OK.MRN==57 ;MAXREC [5016]
;MNEMONICS FOR READ/WRITE/BACKSPACE (& FRIENDS) KEYWORD NUMBERS
IK.IGN==0 ;OMITTED ARG, IGNORED
IK.UNIT==1 ;UNIT
IK.FMT==2 ;FMT
IK.FMS==3 ;FORMAT SIZE
IK.END==4 ;END
IK.ERR==5 ;ERR
IK.IOS==6 ;IOSTAT
IK.REC==7 ;REC
IK.NML==10 ;NAMELIST ADDRESS
IK.MTOP==11 ;MTA OP CODE
IK.HSA==12 ;HOLLERITH STRING (ENCODE/DECODE) ADDRESS
IK.HSL==13 ;HOLLERITH STRING LENGTH, CHARS
;ORTHOGONAL DISPOSE/STATUS INDEX VALUES
SD.ILL==-1 ;ILLEGAL
SD.NOU==0 ;NOTHING, UNKNOWN
SD.NOS==1 ;NOTHING, SAVE
SD.NOD==2 ;NOTHING, DELETE
SD.NOX==3 ;NOTHING, EXPUNGE
SD.PRU==4 ;PRINT, UNKNOWN
SD.PRS==5 ;PRINT, SAVE
SD.PRD==6 ;PRINT, DELETE
SD.PRX==7 ;PRINT, EXPUNGE
SD.PUU==10 ;PUNCH, UNKNOWN
SD.PUS==11 ;PUNCH, SAVE
SD.PUD==12 ;PUNCH, DELETE
SD.PUX==13 ;PUNCH, EXPUNGE
SD.SUU==14 ;SUBMIT, UNKNOWN
SD.SUS==15 ;SUBMIT, SAVE
SD.SUD==16 ;SUBMIT, DELETE
SD.SUX==17 ;SUBMIT, EXPUNGE
SD.PLU==20 ;PLOT, UNKNOWN
SD.PLS==21 ;PLOT, SAVE
SD.PLD==22 ;PLOT, DELETE
SD.PLX==23 ;PLOT, EXPUNGE
;FLAG BITS
DEFINE FLG (F) <
%F==%F_-1
F==%F_1>
;F: LOCAL FLAGS
; Set to initial value at start of each I-O statement
%F==1B0
FLG F%ETP ;TYPE "E" FOR SCIENTIFIC NOTATION
FLG F%DTP ;TYPE "D" FOR SCIENTIFIC NOTATION
FLG F%GTP ;G FORMAT
;PERMANENT FLAGS, LEFT UNTIL EXPLICITLY CLEARED
%F==1B0
FLG D%WRT ;WE HAVE WRITE ACCESS TO FILE
FLG D%SEOL ;SUPPRESS NEXT END OF LINE SEQUENCE
FLG D%PDOL ;DOLLAR FORMAT IN PREVIOUS RECORD
FLG D%END ;EOF REACHED IN FILE
FLG D%MOD ;(20) DISK FILE MODIFIED, MUST UPDATE FDB
FLG D%IN ;FILE IS OPEN FOR INPUT
FLG D%OUT ;FILE IS OPEN FOR OUTPUT
FLG D%OPEN ;Explicit OPEN statement has been done
;TEMP FLAGS, CLEARED AT START OF EACH I/O STATEMENT
FLG D%STCR ;$ FORMAT IN THIS RECORD
FLG D%NML ;NAMELIST I/O
FLG D%LSD ;LIST-DIRECTED I/O
FLG D%RWI ;[5000] REWRITE IN PROGRESS
;Here are the flags to clear
D%CLR== D%STCR+D%NML+D%LSD ;[5000] DO NOT ADD D%RWI!
;FLAGS FOR USE IN IOERR MACRO
%F==1B0
FLG I%REC ;TYPE ERRONEOUS RECORD WITH ARROW UNDER IT
FLG I%REC1 ;SAME AS ABOVE BUT MOVE ARROW LEFT 1 CHAR
FLG I%FMT ;TYPE FORMAT STATEMENT WITH ARROW UNDER IT
FLG I%JERR ;ERROR CONTAINS $J, MUST GET ERROR # IN T1
FLG I%UOF ;[5000] USEROPEN ERROR
PURGE %F
;MACRO DEFINITIONS
;FOROTS ENTRY VECTOR
DEFINE FORVEC <
X INIT ;FOROTS INITIALIZATION
X FORER ;ERROR PROCESSOR
X OPEN ;DEVICE OPEN
X CLOSE ;DEVICE CLOSE
X EXIT1 ;CLOSE ALL FILES
X IN ;FORMATTED INPUT
X OUT ;FORMATTED OUTPUT
X RTB ;UNFORMATTED BINARY INPUT
X WTB ;UNFORMATTED BINARY OUTPUT
X ENC ;ENCODE
X DEC ;DECODE
X NLI ;NAMELIST INPUT
X NLO ;NAMELIST OUTPUT
X IOLST ;INPUT/OUTPUT LIST ITEM PROCESSING
X FIN ;INPUT/OUTPUT LIST TERMINATION
X MTOP ;DEVICE POSITIONING/UTILITY FUNCTIONS
X FIND ;RANDOM ACCESS RECORD FIND
X EXIT ;PROGRAM TERMINATION
X ALCOR ;DYNAMIC CORE ALLOCATION
X DECOR ;DYNAMIC CORE DEALLOCATION
X ALCHN ;ALLOCATE AN I/O CHANNEL
X DECHN ;DEALLOCATE AN I/O CHANNEL
X TRACE ;TRACEBACK OF ROUTINE CALLS
X FUNCT ;GENERAL OTS INTERFACE
X INQU ;INQUIRE BY UNIT
X FOROP ;MISCELLANEOUS LIBRARY UTILITIES
X IFI ;INTERNAL FILE INPUT
X IFO ;INTERNAL FILE OUTPUT
X MTHER ;MATH LIBRARY ERROR
X ABORT ;ABORT WITH TRACE
X INQF ;INQUIRE BY FILE
IF20,<
X DELTR ;DELETE [5000]
X REWRF ;REWRITE (FORMATTED) [5000]
X REWRU ;REWRITE (UNFORMATTED) [5000]
X UNLOC ;UNLOCK [5014]
> ;End IF20
> ;END FORVEC
DEFINE FENTRY (NAME1,NAME2)
< ENTRY NAME1'.
SIXBIT /NAME1'./
NAME1'.:
IFNB <NAME2>,
< ENTRY NAME2'.
NAME2'.:
> ;END IFNB NAME2
> ;END FENTRY
;FATAL JSYS ERROR REPORTING
; E.IJE (AND ERRIJE) LIVE IN FOROTS, AND WHEN INVOKED WILL
; TELL WHERE THE ERROR OCCURED AND HALT.
IF20,<
DEFINE JSHALT <
IF2,<IFNDEF E.IJE,<EXTERN E.IJE>>
ERCAL E.IJE
> ;END JSHALT
> ;END IF20
;STACK VARIABLE MACROS
;ALLOCATE ROOM FOR VARIABLES ON THE STACK
; GIVEN THE LIST OF VARIABLES 'L', COUNT
; THE NUMBER OF ITEMS, DEFINE THEM USING THE
; NAME GIVEN IN THE LIST 'L', ADJUST THE STACK
; UP FOR ALLOCATION, AND DEFINE THE UNSTK MACRO
; TO ADJUST THE STACK SIZE BACK DOWN
DEFINE STKVAR (L) <
.L==0
IRP L,<.L==.L+1> ;COUNT ARGS
.N==0
IRP L,<
IFNB <L>,<
STKDEF (L,\<.L-.N-1>) ;DEFINE NAMED ARG
> ;END IFNB
.N==.N+1
> ;END IRP
ADJSP P,.L ;ALLOCATE STACK SPACE
DEFINE UNSTK < ADJSP P,-.L > ;DEFINE DEALLOCATOR
PURGE .N
> ;END STKVAR
;DEFINE STACK VARIABLE
; NAME 'E', DEFINED AS OFFSET -'V'
DEFINE STKDEF (E,V) <DEFINE E <-V(P)>>
;CONVENIENT DOUBLE WORD CLEAR, LOCATION 'E'AND 'E+1'
DEFINE DSETZM (E) <
SETZM E
SETZM 1+E>
;Macros for field masks
;These are the standard TOPS-20 macros taken from MACSYM.
;CONSTRUCT BYTE POINTER TO MASK
DEFINE POINTR(LOC,MASK)<POINT WID(MASK),LOC,POS(MASK)>
;PUT RIGHT-JUSTIFIED VALUE INTO FIELD SPECIFIED BY MASK
DEFINE FLD(VAL,MSK)<<VAL>B<POS(MSK)>>
;ERROR MACROS
; FERR (CHR,COD,N1,N2,MSG,ARGS,FLGS) ;FORLIB ERROR
; TERR (CHR,COD,N1,N2,MSG,ARGS,FLGS) ;APR TRAP CALL
;
;CHR INITIAL CHAR FOR ERROR MESSAGE ([, %, ?)
; IF [, MESSAGE IS TERMINATED WITH ]
; IF ?, TYPEAHEAD CLEARED AFTER MESSAGE
; IF NULL, 3-CHAR PREFIX ISN'T TYPED
; IF $, FIRST ARG IS INITIAL CHAR
;COD 3-CHARACTER PREFIX
;N1 ERROR CLASS NUMBER
;N2 2ND ERROR NUMBER
;MSG TEXT OF ERROR MESSAGE
; $ INDICATES AN ARG TO BE SUBSTITUTED INTO THE MESSAGE
; THE CHAR AFTER THE $ GIVES THE FORMAT OF THE SUBSTITUTION
;ARGS LIST OF ARGUMENT ADDRESSES, ONE-TO-ONE CORRESPONDENCE WITH $S
; IN MESSAGE TEXT
;FLGS ERROR FLAGS
;
;THE ERROR MACROS GENERATE 1 WORD IN LINE, SO CAN BE SKIPPED OVER.
;THEY DO NOT ALTER ANY ACS.
;
; MSG CAN INCLUDE FORMAT DESCRIPTORS OF THE FORM '$X'
; EACH FORMAT DESCRIPTOR TAKES AN ARGUMENT FROM THE LIST 'ARGS'
; THE CURRENT FORMATTING AVAILABLE IS:
;
; $$ ;TYPE $
; $[ ;TYPE LEFT ANGLE BRACKET
; $O ;OCTAL NUMBER
; $D ;DECIMAL NUMBER
; $A ;ASCIZ STRING
; $C ;ASCII CHAR, RIGHT-JUSTIFIED
; $S ;SIXBIT WORD
; $X ;XWD FORMAT, OCTAL
; $5 ;RADIX50 WORD
; $L ;ADDRESS AS LABEL+OFFSET
; $T ;SPACES TO GET TO COL N
; $J ;JSYS ERROR MESSAGE [NO ARG] (FT20)
; $Y ;MS TIME AS HH:MM:SS.S
; $P ;ERROR PC, OCTAL [NO ARG]
; $E ;LOOKUP/ENTER/RENAME ERROR STRING (FT10)
; $I ;IO ERROR BITS CONVERTED TO ASCII [USES (D)] (FT10)
; $F ;FILESPEC FROM DDB [NO ARG, USES (D)] (FT10)
; $Z ;SIXBIZ OR ASCIZ STRING (FT10)
; $Z ;SIXBIZ OR ASCIZ STRING (FT20)
;
; EACH CALL GENERATES 1 WORD OF CODE IN LINE, AND CAN BE SKIPPED
%EOFF==1 ;OFFSET TO ERROR BLOCK
DEFINE EMSG (CHR,PFX,N1,N2,MSG,ARGS,FLAGS) <
ENTRY E.'PFX
E.'PFX: ;DEFINE THE ERROR IF NOT NULL
"CHR" ;ERROR CHARACTER
SIXBIT /PFX/ ;ERROR PREFIX
EXP N1,N2 ;ERROR NUMBERS
POINT 7,[ASCIZ \MSG\] ;POINTER TO MESSAGE
EXP FLAGS ;ATTRIBUTE FLAGS
IRP ARGS, <ARGS> ;ARGUMENTS, IF ANY
> ;END EMSG
;SPECIAL ERRORS
;$SNH - generate "SHOULD NOT HAPPEN" error
DEFINE $SNH,<
$ECALL SNH
>;END DEFINE $SNH
;$IOERR TYPES A ONE-LINE PREFIX IDENTIFYING THE
; STATEMENT CONTAINING THE ERROR AND THE NAME OF THE CURRENT FILE.
; EXAMPLES:
; $IOERR (ILF,,,?,ILLEGAL CHARACTER IN FORMAT)
; $IOERR (RBR,39,310,?,REREAD NOT PROCEEDED BY READ)
DEFINE $IOERR (CHR,PFX,N1,N2,MSG,ARGS,FLAGS) <
INTERN E.'PFX
E.'PFX:
IF2,<IFNDEF %IOERR,<EXTERN %IOERR>>
PUSHJ P,%IOERR
"CHR" ;ERROR CHARACTER
SIXBIT /PFX/ ;ERROR PREFIX
EXP N1,N2 ;ERROR NUMBERS
POINT 7,[ASCIZ \MSG\] ;POINTER TO MESSAGE
EXP FLAGS ;ATTRIBUTE FLAGS
IRP ARGS, <ARGS> ;ARGUMENTS, IF ANY
> ;END $IOERR
;$FERR IS FOR USE BY FORLIB
; IT CALLS FORER.
; EXAMPLE:
; FERR (DNO,21,125,?,DIVERT: UNIT $D IS NOT OPEN,<@(L)>)
DEFINE $FERR (CHR,PFX,N1,N2,MSG,ARGS,FLAGS) <
ENTRY F.'PFX
F.'PFX:
PUSHJ P,FORER.##
"CHR" ;ERROR CHARACTER
SIXBIT /PFX/ ;ERROR PREFIX
EXP N1,N2 ;ERROR NUMBERS
POINT 7,[ASCIZ \MSG\] ;POINTER TO MESSAGE
EXP FLAGS ;ATTRIBUTE FLAGS
IRP ARGS, <ARGS> ;ARGUMENTS, IF ANY
>; END $FERR
;$DCALL CALLS AN ERROR ROUTINE DEFINED SOMEWHERE BY AN $DERR MACRO
DEFINE $DCALL (PFX,CONT) <
IFNB <CONT>,<PRINTX ?DCALL CONTINUATION ADDRESS SPECIFIED - IGNORED>
EXTERN D.'PFX
JRST D.'PFX
> ;END $DCALL
;$DJCAL CALLS AN ERROR ROUTINE DEFINED SOMEWHERE BY AN $DERR MACRO
;WITH AN ERJMP
DEFINE $DJCAL (PFX,CONT) <
IFNB <CONT>,<PRINTX ?DJCAL CONTINUATION ADDRESS SPECIFIED - IGNORED>
EXTERN D.'PFX
ERJMP D.'PFX
> ;END $DJCAL
;$FCALL CALLS AN ERROR ROUTINE DEFINED SOMEWHERE BY A FERR MACRO
DEFINE $FCALL (PFX,CONT) <
EXTERN F.'PFX
IFB <CONT>,< PUSHJ P,F.'PFX >
IFNB <CONT>,<JRST [PUSHJ P,F.'PFX
JRST CONT] >
> ;END $FCALL
;$FJCAL CALLS AN ERROR ROUTINE DEFINED SOMEWHERE BY A FERR MACRO
DEFINE $FJCAL (PFX,CONT) <
EXTERN F.'PFX
IFB <CONT>,< ERCAL F.'PFX >
IFNB <CONT>,<ERJMP [PUSHJ P,F.'PFX
JRST CONT] >
> ;END $FJCAL
;STORAGE/STRUCTURE DEFINITION MACROS
; NAME is defined to be a small offset, starting at 0.
; or'ed with a bit in the left half that indicates special cases
; (and causes a "U" MACRO error if used incorrectly!)
; %'NAME is defined to be RH= the rightmost bit used.
; LH(%'NAME) = 0 unless it is a byte ptr (not a halfword).
; then LH (%'NAME) = size of byte.
;Macro to start a structure definition
DEFINE DEFST,<
$LOC==0
$P==-1
>
;Macro to define a name as a number and make sure
; that it had not been previously defined.
DEFINE DFN(NAME,LOC),<
IF1,<
IFDEF NAME, PRINTX ?NAME ALREADY DEFINED
>;END IF1
NAME==LOC
>;END DFN
;Macro to define N words.
DEFINE DEFWD (NAME,N<1>),<
IFGE $P,<
$P==-1
$LOC==$LOC+1 ;Jump to next word
>
DFN (NAME,$LOC)
%'NAME==^D35
$LOC==$LOC+N
>;END DEFWD
;Macro to define a random byte
DEFINE DEFBYT (NAME,S),<
IFG <$P+^D<S>-^D35>,<
$P==-1
$LOC==$LOC+1
>
$P==$P+^D<S> ;Find end position in word
DFN (NAME,$LOC) ;Plain name is offset
%'NAME==$P ;RH (%NAME) = rightmost bit
%%DONE==0
IFE <S - ^D18>,< ;Halfword
IFE <$P - ^D35>,< ;Right halfword
NAME==NAME+1B0
%%DONE==1
>
IFE <$P - ^D17>,< ;Left halfword
NAME==NAME+1B1
%%DONE==1
>
>
IFE %%DONE,< ;Not a halfword
NAME==NAME+1B2
%'NAME==%'NAME+ <<S>_^D30> ;Byte size in LH
>
>;END DEFBYT
;Macro to define a DEFBYT or DEFWD such that
; B simply renames A.
DEFINE DEFSNN (NEWNAM, OLDNAM),<
DFN NEWNAM,OLDNAM ;Check for name conflict
; and define it the same
%'NEWNAM==%'OLDNAM
>;END DEFSNN
;Macro to load a field
DEFINE LOAD (AC,NAME,THIRD),<
IFNB <THIRD>,< PRINTX ?LOAD used with more than 2 args - AC, NAME >
%%BTS==<NAME> & 7B2
%%IDX==<<NAME>_-^D18> & ^O77 ;Get index field if any
%%LFT==<NAME> & ^O777777
IFE <%%IDX>,<PRINTX %Index is zero for LOAD AC,NAME >
IFE %%BTS,<
MOVE AC,NAME
>
IFN <%%BTS & 1B0>,<
HRRZ AC,%%LFT(%%IDX)
>
IFN <%%BTS & 1B1>,<
HLRZ AC,%%LFT(%%IDX)
>
IFN <%%BTS & 1B2>,<
%%%S==<%'NAME>_-^D30 ;Size of field
%%%P==<%'NAME> & ^O77 ;"P"
LDB AC,[POINT %%%S,%%LFT(%%IDX),%%%P]
>
>;END DEFINE LOAD
;Macro to store a field
DEFINE STORE (AC,NAME,THIRD),<
IFNB <THIRD>,<PRINTX ?STORE with more than 2 args - AC, NAME >
%%BTS==<NAME> & 7B2
%%IDX==<<NAME>_-^D18> & 77 ;Get index field if any
%%LFT==<NAME> & ^O777777
IFE <%%IDX>,<PRINTX %Index is zero for STORE AC,NAME >
IFE %%BTS,<
MOVEM AC,NAME
>
IFN <%%BTS & 1B0>,<
HRRM AC,%%LFT(%%IDX)
>
IFN <%%BTS & 1B1>,<
HRLM AC,%%LFT(%%IDX)
>
IFN <%%BTS & 1B2>,<
%%%S==<%'NAME>_-^D30 ;Size of field
%%%P==<%'NAME> & ^O77 ;"P"
DPB AC,[POINT %%%S,%%LFT(%%IDX),%%%P]
>
>;END DEFINE STORE
;Macro to generate a "HRRE" or "HLRE"
;Gives error if the field is not a halfword.
DEFINE HXRE (AC,NAME,THIRD),<
IFNB <THIRD>,< PRINTX ?HXRE used with more than 2 args - AC, NAME >
%%BTS==<NAME> & 7B2
%%IDX==<<NAME>_-^D18> & 77 ;Get index field if any
%%LFT==<NAME> & ^O777777
IFE <%%IDX>,<PRINTX %Index is zero for HXRE AC,NAME >
IFE <%%BTS & 3B1>,<
PRINTX ?HXRE ERROR - NAME
>
IFN <%%BTS & 1B0>,<
HRRE AC,%%LFT(%%IDX)
>
IFN <%%BTS & 1B1>,<
HLRE AC,%%LFT(%%IDX)
>
>;END DEFINE HXRE
;Macro to generate a "HRL" or a "HLL"
; Prints error if the field is not a halfword
DEFINE HXL (AC,NAME,THIRD),<
IFNB <THIRD>,< PRINTX ?HXL used with more than 2 args - AC, NAME >
%%BTS==<NAME> & 7B2
%%IDX==<<NAME>_-^D18> & 77 ;Get index field if any
%%LFT==<NAME> & ^O777777
IFE <%%IDX>,<PRINTX %Index is zero for HXL AC,NAME >
IFE <%%BTS & 3B1>,<
PRINTX ?HXL ERROR - NAME
>
IFN <%%BTS & 1B0>,<
HRL AC,%%LFT(%%IDX)
>
IFN <%%BTS & 1B1>,<
HLL AC,%%LFT(%%IDX)
>
>;END DEFINE HXL
;Macro to generate a "HRLZ" or a "HLLZ"
; Prints error if the field is not a halfword
DEFINE HXLZ (AC,NAME,THIRD),<
IFNB <THIRD>,< PRINTX ?HXLZ used with more than 2 args - AC, NAME >
%%BTS==<NAME> & 7B2
%%IDX==<<NAME>_-^D18> & 77 ;Get index field if any
%%LFT==<NAME> & ^O777777
IFE <%%IDX>,<PRINTX %Index is zero for HXLZ AC,NAME >
IFE <%%BTS & 3B1>,<
PRINTX ?HXLZ ERROR - NAME
>
IFN <%%BTS & 1B0>,<
HRLZ AC,%%LFT(%%IDX)
>
IFN <%%BTS & 1B1>,<
HLLZ AC,%%LFT(%%IDX)
>
>;END DEFINE HXLZ
;Macro to generate a "HRR" or a "HLR"
; Prints error if the field is not a halfword
DEFINE HXR (AC,NAME,THIRD),<
IFNB <THIRD>,< PRINTX ?HXR used with more than 2 args - AC, NAME >
%%BTS==<NAME> & 7B2
%%IDX==<<NAME>_-^D18> & 77 ;Get index field if any
%%LFT==<NAME> & ^O777777
IFE <%%IDX>,<PRINTX %Index is zero for HXR AC,NAME >
IFE <%%BTS & 3B1>,<
PRINTX ?HXR ERROR - NAME
>
IFN <%%BTS & 1B0>,<
HRR AC,%%LFT(%%IDX)
>
IFN <%%BTS & 1B1>,<
HLR AC,%%LFT(%%IDX)
>
>;END DEFINE HXR
SUBTTL UDB - Unit Data Block
;+
; Structure Definition For Unit Data Block
;
; Pointed to by AC U
;-
DEFST ;Start the structure UDB
DEFWD DDBAD ;DDB address
DEFWD CNSL1 ;Link to next unit block marked for
; consolidation
DEFWD CNSL2 ;Link to previous unit block marked for
; consolidation
DEFBYT UNUM,^D18 ;Unit number
DEFBYT BLNK,1 ;/BLANK=
BL.NULL==0 ;NULL (DEFAULT FOR OPEN STATEMENT)
BL.ZERO==1 ;ZERO (DEFAULT FOR NO OPEN STATEMENT)
DEFBYT CC,3 ;/CARRIAGECONTROL=
CC.DEV==0 ;DEVICE (DEFAULT)
CC.FOR==1 ;FORTRAN (SET FDB FORTRAN BIT)
CC.LST==2 ;LIST (ADD CRLF WHEN PRINTING EACH RECORD)
CC.NON==3 ;NONE (ADD NOTHING WHEN PRINTING FILE)
CC.TRN==4 ;TRANSLATED (DO IMMEDIATE CC TRANSLATION)
DEFBYT PADCH,9 ;/PADCHAR
DEFBYT PADSP,1 ;PADCHAR SPECIFIED FLAG
DEFWD ULEN,0 ;Length of UDB
SUBTTL DDB - Device Data Block
;+
; Device Data Block (DDB) Offsets. There is only one DDB per open unit,
; however, there may be multiple units per DDB.
;
; Pointed to by AC D
;-
DEFST ;Start the structure definition
DEFWD USCNT ;How many unit blocks point to this DDB
DEFWD DVICE ;TOPS-10: Physical device name
;TOPS-20: Device number
DEFWD IRPTR ;Current input record byte pointer
DEFWD IRCNT ;Current input record byte count
DEFWD ORPTR ;Current output record byte ptr
DEFWD ORCNT ;Current output record byte count
DEFWD IRBUF ;INPUT RECORD BUFFER PNTR
DEFWD ORBUF ;OUTPUT RECORD BUFFER PNTR
DEFWD IRBEG ;PNTRS TO BEG OF DATA
DEFWD ORBEG
DEFWD IRLEN ;INPUT RECORD LENGTH
DEFWD ORLEN ;Current output record length
DEFWD IRBLN ;INPUT RECORD BUFFER LENGTH
DEFWD ORBLN ;OUTPUT RECORD BUFFER LENGTH
DEFWD IRSIZ ;ROOM FOR DATA IN RECORD BUFFER
DEFWD ORSIZ
DEFWD ROFSET ;OFFSET FROM REC BUFFER TO DATA
DEFWD BOFSET ;OFFSET FROM BLOCK BUFFER TO DATA
;[5000] DEFINE RMS DDB FIELDS
IF20,<
DEFWD FAB ;ADDRESS OF FAB
DEFWD RAB ;ADDRESS OF RAB
DEFWD XAB ;ADDRESS OF XAB
DEFWD STS ;CURRENT STS VALUE
DEFWD STV ;CURRENT STV VALUE
DEFWD RFA ;RFA FROM LAST READ/WRITE
DEFWD OSTYPE ;OPERATING SYSTEM TYPE FROM CONFIG XAB
DEFWD CACHE ;ADDRESS OF RECORD/RFA CACHE
DEFWD CACHPT ;CACHE POINTER
DEFWD UOPN ;ADDRESS OF USEROPEN ROUTINE
DEFWD STGFLG ;XAB CHAIN HAS CHARACTER DATATYPE
> ;End IF20
;[5000] END RMS DDB FIELDS
DEFWD WTAB ;Address of in-core page table
DEFWD PFTAB ;Address of page flag table (-1=modified)
DEFWD WPTR ;Core page address of file pages
DEFWD WSIZ ;Size of window in bytes
DEFWD WADR ;Sequential - Local (18-BIT) Address of window
;Random - Offset into WTAB of least used page
IF20,<
DEFSNN BUFADR,WADR ;BUFFER ADDRESS SAME AS WINDOW ADDRESS
DEFWD IPTR ;Byte ptr to next byte from file
DEFWD ICNT ;Free byte count
DEFWD IJFN ;JFN
DEFWD OJFN ;Output JFN
;Note: Always the same except if
; .PRIIN, .PRIOU
DEFWD TMPFIL ;-1=TEMPORARY FILE
DEFWD PPNSTR ;PPN STRING FOR TOPS-10 PROGRAMS
> ;END IF20
DEFWD BYTN ;Current byte number in file
DEFWD BLKN ;Block number
DEFWD AVAR ;/ASSOCIATE variable address
DEFWD CREC ;Number of current record
DEFWD FUMXD ;-1=FORMATTED/UNFORMATTED MIXED MODE FILE
DEFWD IOREC ;ROUTINE TO CALL TO READ OR WRITE A RECORD
DEFWD IOSUB ;ROUTINE TO CALL FOR IOLST.
DEFWD IOFIN ;ROUTINE TO CALL FOR FIN.
DEFWD LSNUM ;Line seq. number for this channel
DEFWD FLAGS ;DDB control flags (From DF)
DEFWD RSIZE ;Record size, in bytes or words
DEFWD MRSIZE ;MAXIMUM RECORD SIZE
DEFWD FRSIZW ;FORMATTED RECORD SIZE IN WORDS
DEFWD FRSIZB ;FORMATTED RECORD SIZE IN BYTES
DEFWD URSIZW ;UNFORMATTED RECORD SIZE IN WORDS
DEFWD URSIZB ;UNFORMATTED RECORD SIZE IN BYTES
DEFWD BPW ;BYTES PER WORD
DEFWD SPCWD ;A WORD OF SPACES FOR THIS FILE
DEFWD ORPOS ;VIRTUAL OUTPUT RECORD POSITION
DEFWD B36FLG ;FILE OPENED IN 36-BIT MODE
DEFWD IMGFLG ;IMAGE MODE - NO LSCW'S IN THIS FILE
DEFWD FILPRS ;FILESPEC HAS BEEN PARSED
DEFWD RECTP ;/RECORDTYPE
RT.UNS==0 ; UNSPECIFIED [5000]
RT.UND==1 ; UNDEFINED (STREAM) [5000]
RT.FIX==2 ; FIXED [5000]
RT.DEL==3 ; DELIMITED (VARIABLE) [5000]
RT.SEG==4 ; SEGMENTED [5000]
RT.SCR==5 ; STREAM_CR [5000]
RT.SLF==6 ; STREAM_LF [5000]
DEFBYT QNSWT,9 ;For /DISP:QUEUE, number of extra switches
DEFBYT QCNT,9 ;LENGTH OF EXTRA SWITCHES, WORDS
DEFBYT QASWT,^D18 ;ADDRESS OF BLOCK OF EXTRA SWITCHES
DEFBYT BLKSZ,^D18 ;/BLOCK SIZE
DEFBYT LIMIT,^D18 ;/LIMIT
DEFBYT BYTPT,^D18 ;BYTE POINTER TO LAST BYTE OF WORD
DEFBYT TTYW,9 ;LINE WIDTH, CHARACTERS
DEFBYT LTYP,6 ;(MTA) LABEL TYPE
IF20,< LT.UNL==.LTUNL ;0 - UNLABELED>
IF10,< LT.UNL==0 ;0 - UNLABELED>
DEFBYT ACC,4 ;/ACCESS
AC.SIO==0 ; SEQUINOUT (SEQUENTIAL)
AC.SIN==1 ; SEQIN
AC.SOU==2 ; SEQOUT
AC.RIN==3 ; RANDIN
AC.RIO==4 ; RANDOM
AC.APP==5 ; APPEND
AC.KEY==6 ; KEYED [5000]
AC.NUM==7 ; NUMBER OF TYPES OF ACCESS (FOR SAIDX) [5000]
DEFBYT SAIDX,4 ;STATUS/ACCESS INDEX
SA.ILL==-1 ; ILLEGAL COMBINATION OF STATUS/ACCESS
SA.UR==0 ; UNKNOWN, READ (MUST BE ZERO!)
SA.UW==1 ; UNKNOWN, WRITE
SA.URW==2 ; UNKNOWN, READ, WRITE
SA.UA==3 ; UNKNOWN, APPEND
SA.OR==4 ; OLD, READ
SA.OW==5 ; OLD, WRITE
SA.ORW==6 ; OLD, READ, WRITE
SA.OA==7 ; OLD, APPEND
SA.NW==10 ; NEW, WRITE
SA.SW==11 ; SCRATCH, WRITE
SA.UK==12 ; UNKNOWN, KEYED [5000]
SA.OK==13 ; OLD, KEYED [5000]
SA.NK==14 ; NEW, KEYED [5000]
SA.SK==15 ; SCRATCH, KEYED [5000]
DEFBYT RENAM,1 ;RENAME SPECIFIED IN CLOSE
IF10,< ;[5000] NO NEED FOR UBUFCT ON -10
DEFSNN BUFCT,UBUFCT ;[5000]
> ;End IF10
DEFBYT BUFCT,6 ;/BUFFER COUNT (0-63)
DEFBYT UBUFCT,6 ;[5000] USER'S BUFFERCOUNT
DEFBYT DEN,3 ;/DENSITY
DN.DEF==0 ; DEFAULT (UNIT DEFAULT)
DN.200==1 ; 200
DN.556==2 ; 556
DN.800==3 ; 800
DN.1600==4 ; 1600
DN.6250==5 ; 6250
DN.SYS==0 ; SYSTEM
DEFBYT UBSIZ,6 ;/BYTESIZE (USER-SUPPLIED)
DEFBYT DISP,4 ;/DISPOSE
DS.NOT==0 ; NOTHING (ALSO RENAME - IGNORED)
DS.SAVE==1 ; SAVE
DS.DEL==2 ; DELETE
DS.EXP==3 ; EXPUNGE
DS.PRNT==4 ; PRINT
DS.LIST==5 ; LIST
DS.PNCH==6 ; PUNCH
DS.SUB==7 ; SUBMIT
DS.PLT==10 ; PLOT
DEFBYT ODISP,2 ;ORTHOGONAL DISPOSE VALUE
OD.NOT==0 ; NOTHING
OD.PRI==1 ; PRINT
OD.PUN==2 ; PUNCH
OD.SUB==3 ; SUBMIT
OD.PLT==4 ; PLOT
DEFBYT FORM,2 ;/FORM
FM.FORM==1 ; FORMATTED
FM.UNF==2 ; UNFORMATTED
DEFBYT MODE,4 ;/MODE
MD.IMG==1 ; IMAGE
MD.BIN==2 ; BINARY
MD.DMP==3 ; DUMP
MD.ASC==4 ; ASCII 7-BIT
MD.ASL==5 ; LINED
MD.AS9==6 ; ASCII 9-BIT
IF20,< DEFBYT ORGAN,2 ;/ORGANIZATION
OR.UNK==0 ; NONE [5000]
OR.SEQ==1 ; SEQUENTIAL [5000]
OR.REL==2 ; RELATIVE (DIRECT) [5000]
OR.IDX==3 ; INDEXED (ISAM) [5000]
> ;End IF20
DEFBYT PAR,2 ;/PARITY
PR.ODD==1 ; ODD (DEFAULT)
PR.EVEN==2 ; EVEN
DEFBYT RO,1 ;/READONLY
IF20,< DEFBYT SHARE,1 ;/SHARED [5000]
DEFBYT SPAN,1 ;/NOSPANBLOCKS [5000]
DEFWD MAXREC ;/MAXREC [5016]
> ;End IF20
DEFBYT STAT,4 ;/STATUS
ST.UNK==0 ; UNKNOWN
ST.OLD==1 ; OLD
ST.NEW==2 ; NEW
ST.SCR==3 ; SCRATCH
ST.DISP==4 ; F-77 CLOSE STATUS WHICH IS REALLY
; DISPOSITION
ST.SAV==4 ; SAVE
ST.DEL==5 ; DELETE
ST.EXP==6 ; EXPUNGE
ST.NUM==7 ; NUMBER OF STATUS VALUES (FOR DSIDX)
DEFBYT OSTAT,2 ;ORTHOGONAL CLOSE STATUS VALUE
OS.UNK==0 ; UNKNOWN
OS.SAV==1 ; SAVE
OS.DEL==2 ; DELETE
OS.EXP==3 ; EXPUNGE
DEFBYT TAPM,3 ;/TAPEMODE
IF20,<
TM.SYS==.SJDDM ; (0) SYSTEM DEFAULT
TM.DMP==.SJDMC ; (1) CORE-DUMP (36-BIT BYTES)
TM.SIX==.SJDM6 ; (2) SIXBIT (7-TRACK)
TM.ANS==.SJDMA ; (3) ANSI-ASCII
TM.IND==.SJDM8 ; (4) INDUSTRY COMPATIBLE
TM.HDN==.SJDMH ; (5) HIGH-DENSITY
> ;END IF20
IF10,<
TM.SYS==.TFMDD ; (0) SYSTEM DEFAULT
TM.DMP==.TFMID ; (1) 9-TRACK CORE-DUMP
TM.SX9==.TFM6B ; (3) 9-TRACK SIXBIT
TM.IND==.TFM8B ; (2) INDUSTRY-COMPATIBLE
TM.ANS==.TFM7B ; (4) ANSI-ASCII
TM.SIX==.TFM7T ; (5) SIXBIT (7-TRACK)
> ;END IF10
DEFWD DVBTS,0 ;DEVCHR BITS
IF20,<
DEFBYT DVIO,2 ;INPUT/OUTPUT LEGAL
DEFBYT DRDVF,1 ;1= "this is a directory device"
DEFBYT DVAS,1 ;ASSIGNABLE
DEFBYT DVMDD,1 ;MULTIPLE DIRECTORIES
DEFBYT DVAV,1 ;AVAILABLE
DEFBYT DVASN,1 ;ASSIGNED
DEFBYT DVJNK,1 ;NOT USED
DEFBYT DVMNT,1 ;MOUNTED
DEFBYT DVTYP,9 ;DEVTYP CODE
DT.DSK==.DVDSK ;DISK
DT.MTA==.DVMTA ;MTA
DT.DTA==.DVDTA ;DTA
DT.NUL==.DVNUL ;NULL DEVICE
DT.TTY==.DVTTY ;TTY
DT.PTY==.DVPTY ;PTY
DT.LPT==.DVLPT ;LPT
DT.PLT==.DVPLT ;PLOTTER
> ;END IF20
IF10,<
DEFBYT DFILL,16 ;DEVCHR FIELDS WE DON'T USE
DEFBYT DVIO,2 ;DEVICE CAN DO INPUT, OUTPUT
DV%IN==DV.IN ;DEVICE CAN DO INPUT
DV%OUT==DV.OUT ;DEVICE CAN DO OUTPUT
DEFWD DVTW,0 ;DEVTYP WORD
DEFBYT DFIL2,30 ;DEVTYP FIELDS WE DON'T USE
DEFBYT DVTYP,6 ;DEVICE TYPE
DT.NUL==.TYDSK ;NULL DEVICE
DT.DSK==.TYDSK ;DISK
DT.DTA==.TYDTA ;DTA
DT.MTA==.TYMTA ;MTA
DT.PTY==.TYPTY ;PTY
DT.LPT==.TYLPT ;LPT
DT.PLT==.TYPLT ;PLOTTER
DT.TTY==.TYTTY ;TTY
> ;END IF10
DEFBYT LGLM,^D16 ;LEGAL DATA MODES
DEFBYT INDX,3 ;DEVICE INDEX (FOR SPECIAL-CASE CODE)
DI.TTY==0 ;TTY
DI.DSK==1 ;DISK
DI.MTA==2 ;MTA
DI.OTHR==3 ;OTHER
DI.RSF==4 ;REMOTE STREAM FILE [5000]
DI.RMS==5 ;RMS FILE [5000]
DEFWD EOFN ;(Disk) Number of bytes in file
DEFWD FILSPC,0 ;BEGINNING OF FILESPEC PART OF DDB
LFILW==20 ;LENGTH OF FILENAME
LFILC==LFILW*5 ;AND IN CHARS
LEXTW==20 ;LENGTH OF EXTENSION
LEXTC==LEXTW*5 ;AND IN CHARS
LDEVW==20 ;LENGTH OF DEVICE
LDEVC==LDEVW*5 ;AND IN CHARS
LDIRW==20 ;LENGTH OF DIRECTORY
LDIRC==LDIRW*5 ;AND IN CHARS
LNODW==2 ;LENGTH OF NODENAME
LNODC==LNODW*5 ;AND IN CHARS
LPROTW==2 ;LENGTH OF PROTECTION CODE
LPROTC==LPROTW*5 ;AND IN CHARS
LGENW==2 ;LENGTH OF GENERATION
LGENC==LGENW*5 ;AND IN CHARS
LPWDW==8 ;[5000] LENGTH OF PASSWORD
LPWDC==LPWDW*5 ;[5000] AND IN CHARS
LACTW==8 ;[5000] LENGTH OF ACCOUNT
LACTC==LACTW*5 ;[5000] AND IN CHARS
LUIDW==8 ;[5000] LENGTH OF USERID
LUIDC==LUIDW*5 ;[5000] AND IN CHARS
DEFWD NODNAM,LNODW ;Node name
DEFWD DEV,LDEVW ;Device name (1-39 chars, ASCIZ)
DEFWD DIRNAM,LDIRW ;Directory name (can include ^V's)
DEFWD FILNAM,LFILW ;File name
DEFWD EXT,LEXTW ;Extension
DEFWD PROT,LPROTW ;Protection (0-6 chars, ASCIZ)
DEFWD GEN,LGENW ;Generation number (0-6 chars, ASCIZ)
IF20,< DEFWD PASWRD,LPWDW ;[5000] REMOTE ACCESS PASSWORD
DEFWD ACCNT,LACTW ;[5000] ACCOUNT STRING
DEFWD USERID,LUIDW ;[5000] USER ID
> ;End IF20
.FSSLN==$LOC-FILSPC-1 ;Length of filespec stuff
IF20,<
DEFWD DMABS,0 ;Data mode & byte size
DEFBYT BSIZ,6 ;Byte size
DEFBYT DMODE,4 ;Data mode
DEFWD VERN ;Version number (ignored)
> ;END IF20
IF10,<
DEFWD BSIZ ;BYTE SIZE
DEFWD FBLK,.FOMAX ;FILOP block.
DEFSNN CHAN,FBLK ;Channel,,FN
DEFSNN IJFN,FBLK ;MORE FOR COMPATIBILITY
DEFSNN OJFN,FBLK ;DITTO
DEFWD LKPB,.RBMAX ;LOOKUP/ENTER block
VERN==LKPB+.RBVER ;VERSION NUMBER
DEFWD PTHB,.PTMAX ;PATH. block. Set by FILOP to the real
; true path to the file.
DEFWD BUFADR ;BUFFER ADDRESS
DEFWD IBCB ;Input buffer control block
DEFWD IPTR,0 ;Byte pointer.
DEFBYT FILL2,6 ;FILLER
DEFBYT IBSIZ,6 ;Byte size
DEFWD ICNT ;Count
DEFWD TBCB ;Output buffer control block
DEFWD TPTR,0 ;Byte ptr.
DEFBYT FILL3,6 ;FILLER
DEFBYT TBSIZ,6 ;Byte size
DEFWD TCNT ;Count
> ;END IF10
DEFWD DLEN,0 ;Length of DDB
; CLEAN UP AFTER DDB DEFINITION
PURGE $P,$LOC,%%DONE
SUBTTL FORPRG - Purge Global Symbols
;+
; Purge global symbols created by MONSYM which do not have "%"
; or "." in them. Also to purge JS%DEV, which changed its value between
; Release 5.1 and Release 6 of the monitor.
;-
DEFINE FORPRG<
PURGE ERJMP,ERCAL,GJFX3,GJFX18,GJFX19,GJFX24,GJFX27
PURGE IOX4
PURGE IPCFX6,IPCFX8
PURGE LNGFX1
PURGE NPXAMB,NPXNC,NPXNOM
PURGE OPNX2,OPNX9
PURGE JS%DEV
> ;END FORPRG
END