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, ;MAKE SURE ALL ARE DEFINED IFNDEF FT20, IFNDEF FTKL, IFNDEF FTKI, IFE FT20!FT10, ;SELECT AN OPERATING SYSTEM IFE FTKI,> IFN FT10,> ;SELECT A PROCESSOR IFN FT20, ;CHECK USER SUPPLIED PARAMETERS IFN FT10&FT20, END> IFN FTKL&FTKI, END> ;SET OTHER PARAMETER DEFAULTS IFNDEF FTSHR, ;SHARABLE FOROTS IFNDEF FTDSK, ;ALL UNITS DON'T DEFAULT TO DEVICE DSK IFNDEF FTAST, ;ASTERISK FILL IFNDEF STARTP, ;600 UP ARE OFF LIMITS TO FOROTS MEMORY MGR IFNDEF FTNLC1, ;DO NOT SKIP COLUMN 1 ON NAMELIST INPUT IFNDEF FTGFL, ;NO GFLOATING DOUBLE PRECISION CHECKS IFNDEF FT20UUO, ;NO PA1050 IFNDEF WRNCNT, ;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, ;(Version 6 default). ;Define feature test switches: FTOLDBP==0 ;Reset to 0 FT1WBP==0 IFE , ;Only use old-style one-word BP's. IFE ,< 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 ;SIMPLIFIED PROCESSOR MACROS DEFINE IF20 ;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,> IFGE E, IFL 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,> 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 <&777777000000>, ;>  IFE <&000000777777>,  TD'Y'Z AC,[E] > ;END TXYZ > ;END IRP Z > ;END IRP Y > ;END DEFTX ;CREATE THE VARIOUS FLAVORS OF TXYY DEFTX (,) ;PSUEDO INSTRUCTIONS MOVX ; CREATE THE VARIOUS FLAVORS DEFINE MOVX (AC,E) < IFE <&777777000000>, ;>  IFE <&000000777777>,  IFE <_-22 - 777777>,&777777> ;>  IFE <&777777-777777>,_-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 ,< 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) > ;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) <> ;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 ,< IFN $SEG$,< RELOC $SEG$==0>> IFDIF ,< 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,> .ARGN.=0 IRP ARGS,<.ARGN.=.ARGN.+1> PUSH P,L XMOVEI L,1+[-.ARGN.,,0 IRP 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) ;PUT RIGHT-JUSTIFIED VALUE INTO FIELD SPECIFIED BY MASK DEFINE FLD(VAL,MSK)<B> ;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 ,< IFDIF <.>,< ENTRY ENT SIXBIT /NAME/ ENT: > ;END IFDIF IFIDN <.>,< ENTRY ENT'. SIXBIT /ENT'./ ENT'.: > ;END IFIDN > ;END IFNB IFB ,< 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==>> %VWHO==0 IRPC V,< IFLE <"V"-"A">*<"V"-"Z">, IFLE <"V"-"0">*<"V"-"9">, IFIDN <(>,<%VMAJOR==VMAJOR VMAJOR==0> IFIDN <)>, IFIDN <->,<%VMAJOR==VMAJOR VMAJOR==0 %VWHO==-1> > ;END IRPC IFN %VWHO, 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,,%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,> ;ARG STACK IFNB ,< MOVEI T0,%ERARG-1 ;STACK IF ANY IRP ARGS,< IFE <<_-^D18>-P>,< PUSH T0,-1+ARGS > ;FIXUP FOR STKVAR IFN <<_-^D18>-P>,< PUSH T0,ARGS > >; END IRP > ;END IFNB IF2,> 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, 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 , ;DEFINE ERROR NUMBER ;(LINK CATCHES MULT DEF ERROR NUMBERS) IF2,> IFNB ,< MOVEI T0,%ERARG-1 IRP ARGS,< PUSH T0,ARGS > >; END IFNB IF2,> 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,%,) ; 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 ,< 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 ,< PUSHJ P,E..'PFX > IFNB ,< 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-^D35>,< $P==-1 $LOC==$LOC+1 > $P==$P+^D ;Find end position in word DFN (NAME,$LOC) ;Plain name is offset %'NAME==$P ;RH (%NAME) = rightmost bit %%DONE==0 IFE ,< ;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+ <_^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 ,< PRINTX ?LOAD used with more than 2 args - AC, NAME > %%BTS== & 7B2 %%IDX==<_-^D18> & ^O77 ;Get index field if any %%LFT== & ^O777777 IFE <%%IDX>, 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 , %%BTS== & 7B2 %%IDX==<_-^D18> & 77 ;Get index field if any %%LFT== & ^O777777 IFE <%%IDX>, 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 ,< PRINTX ?HXRE used with more than 2 args - AC, NAME > %%BTS== & 7B2 %%IDX==<_-^D18> & 77 ;Get index field if any %%LFT== & ^O777777 IFE <%%IDX>, 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 ,< PRINTX ?HXL used with more than 2 args - AC, NAME > %%BTS== & 7B2 %%IDX==<_-^D18> & 77 ;Get index field if any %%LFT== & ^O777777 IFE <%%IDX>, 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 ,< PRINTX ?HXR used with more than 2 args - AC, NAME > %%BTS== & 7B2 %%IDX==<_-^D18> & 77 ;Get index field if any %%LFT== & ^O777777 IFE <%%IDX>, 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