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