Trailing-Edge
-
PDP-10 Archives
-
fortv11
-
comman.mac
There are 8 other files named comman.mac in the archive. Click here to see a list.
TITLE FTNCMD - COMMAND SCANNER INTERFACE FOR FORTRAN COMPILER
SUBTTL /DCE/EGM/EDS/TFV/SRM/AHM/CDM/PLB/RVM/CKS/MRB/AlB/MEM/JB
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1972, 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.
;AUTHOR: Dave Eklund
INTERN COMMAV
COMMAV= BYTE (3)0(9)10(6)0(18)4553 ; Version Date: 15-Oct-86
TWOSEG
SUBTTL Revision History
Comment \
***** Begin Revision History *****
***** Begin Version 5B *****
-- 656 25246 PROTECTION FAILURES NOT REPORTED, (DCE)
-- 704 26390 FIX DEFAULT BUFFER SIZE (IF DEVSIZ FAILS)
-- 723 ----- ADD /NOWARN SELECTIVITY, (DCE)
***** Begin Version 6 *****
-- 760 TFV 1-Jan-80 -----
Make /KA and /KI switchs errors.
100 762 EGM 22-Apr-80 -----
Move Revision History to REVHST.MAC
101 767 DCE 20-May-80 -----
Rewrite the bulk of the Command Scanner module.
In particular, make feature testing cleaner.
Fix various problems with /GFL and add /F77 (future).
Merge as much of the TOPS-10 and TOPS-20 code as possible.
102 1001 EGM 30-Jun-80 -----
Replace SEARCH of C with UUOSYM,MACTEN. Replace LINK command file
references to SCAN, WILD, and HELPER with MACRO .REQUESTs.
103 1043 EGM 19-Jan-81 20-15466
Add CAO (Consecutive arith ops illegal) to nowarn keyword table
104 1047 EGM 22-Jan-81 Q10-05323
Add support for TOPS-10 execute only.
105 1053 EDS 11-Feb-81 -----
Make FORTRA a global symbol.
106 1061 DCE 9-Apr-81 -----
Add PSR (Pound sign in Random access illegal) to noward table
107 1065 EGM 7-May-81 Q10-05053
Replace M.XXXX SCAN macros with FORTRAN specific ones. Do not
attempt to handle all the cases, or 10 type message standard.
109 1115 EGM 31-Jul-81 --------
Rework /NOWARN for expandability, and efficiency.
110 1117 EGM 26-Aug-81
Add additional TOPS-10 EXO support code to allow lifting fixed high seg
origin restrictions.
111 1121 EGM 9-Sep-81 --------
Add code to get GETSEG parameters from GETTABs, and store path info.
Also update several comments concerning initialization.
113 1133 TFV 28-Sep-81 ------
Add /STATISTICS flag for in-house performance measurement. It is
disabled in the released V6.
***** Begin Version 6A *****
1160 EGM 14-Jun-82
Properly discard .REL file when fatal errors occur during current
compile command (correct edit 752). Also prevent 20 code from
producing a .REL file when doing systax only checking (same as
10 code).
***** Begin Version 7 *****
108 1205 DCE 20-Mar-81 -----
Turn on the F66 and F77 switches. Make F77 the default.
112 1261 CKS 25-Sep-81
Add CNM to warning messages
114 1270 CDM 6-Oct-81
Add DGI to warning messages.
115 1430 CKS 3-Dec-81
Add SBR to warning messages
116 1437 CDM 16-Dec-81
Add DEBUG:ARGUMENTS as a compiler switch for argument block
checking.
117 1445 SRM 20-Dec-81
Changed FORTB stack size from 500 to 2100 so that we could
compile the validation test FM045.FOR which has 57 nested
parens (note: Approximately 100 words of stack
are needed for each additional 3 levels of nesting. )
118 1460 SRM 12-Jan-82
Added CHO to list of warning abbreviations.
119 1465 CKS 1-Feb-82
Change PSR warning to PSN. (Pound sign used as REC= warning.)
The prefix is different so that old /NOWARNs will not suppress
the new message.
120 1466 CDM 4-Feb-82
Add IAT, WNA to /NOWARN table for statement function arg checking.
121 1467 CDM 4-Feb-82
Add SNO to /NOWARN table for SAVE statement.
1504 AHM 26-Feb-82
Implement /EXTEND and /NOEXTEND for extended addressing. Also
remove the leading "*" from the switch definitions of /F77 and
/STATISTICS because they shouldn't be there.
1535 CDM 29-July-82
Add ACB, AIL to /NOWARN switches.
1563 PLB 18-Jun-82
Implement TTYSTR routine to do a PSOUT from BLISS & EXITUUO to
simulate CALLI 12. Temporary since the native command scanner
will be a separate file.
1600 PLB 9-Jul-82
TOPS-20 Native hacks. Will never be used, but supplies
routine CORUUO, and PSI support, remove Address Break APR
trap.
1606 RVM 3-Aug-82
Reserve the SW.ABO flag so that COMMAN, IOFLG, and CMND20 all
agree about which bits are taken.
1613 CDM 13-Aug-82
Change /DEBUG:PARAMETERS to /DEBUG:ARGUMENTS.
1617 CKS 24-Aug-82
Add 'FORTRA' to .ISCAN call so that
.FORTRAN FILE=FILE
works, given the appropriate command definition.
1621 RVM 25-Aug-82
Add the /DFLOATING switch to the TOPS-10 command scanner. Reorder
switch table so that it is in alphabetical order. Give an error
message if the user specifies /GFLOAT.
1652 CDM 20-Oct-82
Add RIM to /NOWARN switch.
1654 SRM 22-Oct-82
Changed FORTB stack size from 2100 to 2200 so that we could
compile the validation test FM045.FOR which has 57 nested
parens (note: Approximately 100 words of stack
are needed for each additional 3 levels of nesting. )
1656 CKS 25-Oct-82
Change PLP warning to TSI.
1750 MRB 6-May-83
Add FOO warning to /NOWARNING.
***** Begin Version 10 *********
2246 AlB 20-Dec-83
Reserve bits in flag word F2 for Compatibility Flagging.
SW.CFS => CFLGANSI, SW.CFV => CFLGVAX
2265 TFV 12-Jan-84
Increase POOLSIZE to 6000 words so we can compile programs with
large blocks of comment lines. The standard allows unlimited
numbers of comment lines between initial and continuation lines.
2305 AlB 8-Feb-84
Added a slough of entries to the /NOWARN tables. All entries are
for the Compatibility Flagger warnings.
It is recognized that this module does not handle the /FLAG switch
yet, but it will someday. Meanwhile, The /NOWARN table is
compatible with CMND20.
2322 CDM 27-Apr-84
Fix array subscript calculations for /EXTEND to use a full word
to calculate arithmetic. In PROCEQUIV and BLDDIM, check an
array reference against the correct maximum size of an array
declaration /EXTEND. In BLDDIM, call CNSTCM for array
calculations to give underflow/overflow messages for illegal
declarations. Otherwise arrays that are too large may not be
detected since their size will overflow.
2353 AlB 30-Apr-84
Add the /FLAG and /NOFLAG switches to the Tops-10 command scanner.
/FLAG has the keywords ALL, ANSI, VAX, NONE, NOANSI, NOVAX.
/NOFLAG has no keywords.
Re-arranged the location of NOWCLR in order to improve the
readability of the source.
2367 RVM 14-Jun-84
Add the label "GFLPAT" in case we want to find the instruction to
No-op in order to turn on TOPS-10 gfloating support.
2422 RVM 12-Jul=84
Set BIGCONCAT in the -10 command scanner. See edit 2251.
2430 CDM 18-Jul-84
Have the compiler complain /FLAG for a variable mentioned more
than once in SAVE statements (SAVE A,B,A - A is mentioned
twice).
2442 RVM 4-Aug-84
Get a bit for /EXTEND:CODE
2454 RVM 28-Aug-84
Move the definition of DEFLON (the default value for LONAME)
and DEFHIN (the default value for HINAME) from CMND20 into
GLOBAL. Then make OUTMOD use DEFLON and DEFHIN where needed
in the twoseg redirection rel block. For kicks, make the -10
command scanner set up LONAME and HINAME.
2455 MEM 30-Aug-84
Replace all occurrences of VAX with VMS.
2471 RVM 25-Oct-84
Remove the instruction at GFLPAT. FORTRAN-10 will now support
gfloating!
2473 CDM 29-Oct-84
Add IMPLICIT NONE for the Military Standard MIL-STD-1753.
2524 JB 13-Mar-85
Add INC to the list of NOWARNs.
***** End V10 Development *****
***** End Revision History *****
***** Begin Version 11 *****
4543 JB 10-Jul-86
Add LDI to list of NOWARNs.
4544 MEM 7-Aug-86
Add ADV to list of NOWARNs.
4553 JB 15-OCT-86
Remove edit 4543.
ENDV11
\
PAGE
SUBTTL REQUIRED UNIVERSAL FILES
ENTRY NXTFIL ;ONLY USED IN MAIN.BLI
SEARCH FTTENX ;ASSEMBLY TIME SWITCHES
IFN FTTENX,< SEARCH MONSYM >
SEARCH UUOSYM,MACTEN,SCNMAC ;[1001]
SEARCH GFOPDF ;GFLOATING OPCODES
IFN FTTENX,< SEARCH MACSYM > ;[1600] SEARCH LAST
IFN FTTENX,< .REQUEST SYS:SCAN ;[1001]
.REQUEST SYS:HELPER> ;[1001]
IFE FTTENX,< .REQUEST REL:SCAN ;[1001]
.REQUEST REL:WILD ;[1001]
.REQUEST REL:HELPER> ;[1001]
IF2,<
IFE FTTENX, <PRINTX ASSEMBLING FORTRAN-10 COMMAN>
IFN FTTENX, <PRINTX ASSEMBLING FORTRAN-20 COMMAN>
>
PAGE
SUBTTL SYMBOLIC DEFINITIONS
RELOC 400000
;AC'S USED BY COMMAND SCANNER
F=0 ;FLAGS
T1=1 ;TEMP
T2=2 ; ..
T3=3 ; ..
T4=4 ; ..
P1=5 ;PRESERVED AC
P2=6 ; ..
N=7 ;NUMBER AC
C=10 ;CHARACTER AC
VREG=15 ;BLIS10 VALUE RETURN REG
FREG=16 ;STACK FRAME POINTER
P=17 ;PUSH DOWN POINTER
;I/O CHANNELS
BIN==1 ;REL FILE OUTPUT
LST==2 ;LISTING FILE OUTPUT
SRC==3 ;SOURCE FILE INPUT
ICL==4 ;INCLUDE FILE INPUT
;OFFSETS INTO CHNLTBL
TBLMAX==^D10
JFN==0
HDR==3
PNT==4
CNT==5
;LOCATIONS IN GLOBAL USED BY INOUT BUT SET UP HERE
;[1504] Definitions moved here from the lowseg definition region to
;[1504] avoid using the pass 1 definitions of these symbols. This
;[1504] prevents us from getting near a MACRO deficiency, which is
;[1504] that MACRO has no concept of polish expressions during pass 1,
;[1504] and that is what these macros generate.
DEFINE BUFHDR(A,B),<
IRP A,<
IRP B,<
A'B=CHNLTBL##+<<A-1>*TBLMAX>+B
>>>
IFE FTTENX < BUFHDR (<BIN,LST,SRC>,<HDR,PNT,CNT>) >
IFN FTTENX < BUFHDR (<BIN,LST,SRC,ICL>,<JFN,HDR,PNT,CNT>) >
;FLAG BITS IN F (SEE IOFLG.BLI & CMND20.MAC BEFORE CHANGING THESE BITS)
SW.OPT==1B35 ;GLOBAL OPTIMIZE
SW.NET==1B34 ;NO ERRORS ON TTY
SW.MAC==1B33 ;MACRO CODE
SW.IDS==1B32 ;INCLUDE DEBUG STATEMENTS
SW.EXP==1B31 ;EXPAND
SW.DEB==1B30 ;DEBUG
SW.CRF==1B29 ;CREF
EOCS==1B28 ;END OF COMMAND STRING
LSTFLG==1B25 ;LISTING FILE BEING MADE
SW.KAX==1B24 ;KA-10 FLAG
RELFLG==1B22 ;REL FILE BEING MADE
SW.MAP==1B16 ;LINE NUMBER/OCTAL LOCATION MAP
SW.ERR==1B14 ;FATAL ERRORS DURING COMPILE
SW.OCS==1B13 ;ONLY CHECK SYNTAX
COMKA==1B12 ;COMPILING ON A KA-10
SW.PHO==1B10 ;PEEP HOLE OPTIMIZE
SW.BOU==1B5 ;ARRAY BOUNDS CHECKING SWITCH
SW.NOW==1B2 ;DON'T PRINT WARNING MESSAGES
TTYDEV==1B1 ;LISTING ON TTY:
PAGE
EXTERN FLAGS2 ;SECONDARY FLAG REGISTER (TTYINP,GFMCOK, ETC.)
EXTERN F2 ;USER SETTABLE SWITCHES (GFL, F77, ETC.)
EXTERN DEBGSW
EXTERN VMSIZE ;[2322] Virtual memory size for this compilation.
EXTERN BIGCONCAT ;[2422] The size of the biggest
;[2422] concatenation to allow as a "fixed length"
;[2422] or "known maximum length". Maximum size of
;[2422] non dynamic concatenation.
EXTERN LONAME ;[2454] Name of the low (data) PSECT in SIXBIT
EXTERN HINAME ;[2454] Name of the high (code) PSECT in SIXBIT
EXTERN DEFLON ;[2454] Default for LONAME
EXTERN DEFHIN ;[2454] Default for HINAME
;FLAG BITS IN FLAGS2 (SEE IOFLG.BLI & CMND20.MAC BEFORE CHANGING THESE BITS)
TTYINP==1B0 ;INPUT DEVICE IS A TTY
GFMCOK==1B1 ;GFLOATING MICROCODE PRESENT
FTLCOM==1B2 ;[1160] Fatal errors during this compile command
SW.ABO==1B3 ;[1606] Abort (exit) on fatal errors
;FLAG BITS IN F2 (SEE IOFLG.BLI & CMND20.MAC BEFORE CHANGING THESE BITS)
;THIS FLAG WORD IS RESERVED FOR USER SETTABLE SWITCHES
SW.GFL==1B0 ;Switch for /GFLOATING DP
SW.F77==1B1 ;F77 SELECTED
SW.STA==1B2 ;[1113] /STATISTICS
SW.EXT==1B3 ;[1504] /EXTEND
SW.CFS==1B4 ;[2246] /FLAG:ANSI
SW.CFV==1B5 ;[2455] /FLAG:VMS
SW.EXC==1B6 ;[2442] /EXTEND:CODE
DBIGCON=[EXP ^D50000] ;[2422] Default for BIGCONCAT
IFN FTTENX,<
; OPENF BITS
INBYT==440000 ;NON-TTY INPUT BYTE SIZE
BINBYT==440000 ;BINARY BYTE SIZE
LSTBYT==070000 ;LISTING BYTE SIZE
TTYBYT==070000 ;TTY INPUT BYTE SIZE
READ==200000 ;READABLE
WRITEE==100000 ;WRITEABLE
TTCODE==600012 ;TTY: DEVICE CODE
DSKCOD==600000 ;DSK: DEVICE CODE
; DEFAULT GTJFN TABLE FOR LISTING
LSTTAB: GJ%FOU ;FLAGS,VERSION DEFAULT
XWD 377777,377777 ;NO JFN'S
0 ;DEVICE
0 ;DIRECTORY
0 ;FILENAME
XWD -1,[ASCIZ /LST/] ;EXTENSION
0 ;PROTECTION
0 ;ACCOUNT
; DEFAULT GTJFN TABLE FOR BINARY OUTPUT FILE
BINTAB: GJ%FOU ;FLAGS,DEFAULT VERSION
XWD 377777,377777 ;NO JFN'S
0 ;DEVICE
0 ;DIRECTORY
0 ;FILE NAME
XWD -1,[ASCIZ /REL/] ;EXTENSION
0 ;PROTECTION
0 ;ACCOUNT
; DEFAULT TABLE FOR SOURCE INPUT
SRCTAB: GJ%OLD!GJ%IFG ;FLAGS,VERSION DEFAULT
XWD 377777,377777 ;NO JFN'S
0 ;DEV
0 ;DIRECTORY
0 ;FILE NAME
XWD -1,[ASCIZ /FOR/] ;EXTENSION
0 ;PROTECTION
0 ;ACCOUNT
; DEFAULT TABLE FOR INCLUDE INPUT
ICLTAB: GJ%OLD ;FLAGS,VERSION DEFAULT
XWD 377777,377777 ;NO JFN'S
0 ;DEV
0 ;DIRECTORY
0 ;FILE NAME
XWD -1,[ASCIZ /FOR/] ;EXTENSION
0 ;PROTECTION
0 ;ACCOUNT
> ;END TOPS-20 ONLY
PAGE
SUBTTL Compiler Switch Definitions and Defaults
;DEFAULTS FOR SWITCH SETTINGS
; DM(NAM,MX,AD,PD) expands into definitions of MX.NAM, AD.NAM and
; PD.NAM with the values of the 2nd, 3rd and 4th arguments to the
; macro. These symbols get used as the MaXimum, Absent Default and
; Present Default later on.
DM ADV,1,0,1
DM BAK,1,0,1
DM BOU,1,0,1
DM BUG,377777,0,1
DM CFS,1,0,1 ;[2353] /FLAG:ANSI
DM CFV,1,0,1 ;[2455] /FLAG:VMS
DM CRF,1,0,1
DM DEB,1,0,1
DM EXP,1,0,1
DM EXT,1,0,1 ;[1504] /EXTEND
DM GFL,1,0,1
DM F77,1,1,1
DM INC,1,0,1
DM MAC,1,0,1
DM NOE,1,0,1
DM WEO,1,0,1
DM ZER,1,0,1
DM OPT,1,0,1
DM OCS,1,0,1
DM NOW,1,0,1
DM MAP,1,0,1
DM STA,1,0,1 ;[1133] statistics switch
ND PDLLEN,^D2200+^D6000 ;[2265] Length of PDL
;Note the addition of 600 words to PDLLEN!!! See the
;declaration of POOLSIZ in FIRST.BLI. This space will
;actually be occupied by the global vectors STK and
;POOL so that more space for the stack can be made
;available to highly recursive operations that may
;occur in the compiler.
;DEFAULT FLAG SETTINGS (FOR F)
INDADF: EXP <<AD.MAP>_<43-^L<SW.MAP>>> !
<<AD.CRF>_<43-^L<SW.CRF>>> !
<<AD.DEB>_<43-^L<SW.DEB>>> !
<<AD.EXP>_<43-^L<SW.EXP>>> !
<<AD.INC>_<43-^L<SW.IDS>>> !
<<AD.MAC>_<43-^L<SW.MAC>>> !
<<AD.NOE>_<43-^L<SW.NET>>>
;DEFAULT SWITCH SETTINGS FOR F2
;[1133] AD.STA for /STATISTICS
;[1504] AD.EXT for /EXTEND
;[2353] AD.CFS for /FLAG:ANSI
;[2455] AD.CFV for /FLAG:VMS
; Don't even think about moving the above comments onto the lines that
; they describe. You can't comment a line that is continued with ^_.
INDAD2: EXP <<AD.F77>_<43-^L<SW.F77>>> !
<<AD.GFL>_<43-^L<SW.GFL>>> !
<<AD.STA>_<43-^L<SW.STA>>> !
<<AD.EXT>_<43-^L<SW.EXT>>> !
<<AD.CFS>_<43-^L<SW.CFS>>> !
<<AD.CFV>_<43-^L<SW.CFV>>>
DEFINE RESETUUO <CALLI 0>
DEFINE RESETJSYS <JSYS 147>
DEFINE RESET <PRINTX ?DO NOT USE RESET - USE RESETUUO OR RESETJSYS>
PAGE
SUBTTL Compiler Switches
;[2353] The Tops-20 /FLAG-NON-STANDARD switch is implemented here as just
;[2353] /FLAG, because the Tops-10 scanner does not allow hyphens. It is
;[2353] expected that COMMAN.MAC will never again be assembled for Tops-20,
;[2353] but if it ever is then the Tops-20 switch will become /FLAG instead
;[2353] of /FLAG-NON-STANDARD.
DEFINE SWTCHS,<
SP ADVANCE,FAREA+F.ADV,.SWDEC##,ADV
SP BACKSPACE,FAREA+F.BACK,.SWDEC##,BAK
;SP BOUNDS,<POINTR(SAVEF,SW.BOU)>,.SWDEC##,BOU
SP BUGOUT,<POINT 18,BUGINT,35>,.SWOCT##,BUG
SP CROSSREF,<POINTR(SAVEF,SW.CRF)>,.SWDEC##,CRF
SL DEBUG,DEBGSD,BUGK,-1,FS.OBV
SS DFLOATING,<POINTR(SAVE2,SW.GFL)>,0 ;[1621]
SP EXPAND,<POINTR(SAVEF,SW.EXP)>,.SWDEC##,EXP
IFN FTTENX,<
SN *EXTEND,<POINTR(SAVE2,SW.EXT)> ;[1504] /[NO]EXTEND
>
SS *GFLOATING,<POINTR(SAVE2,SW.GFL)>,1 ;[1621]
SS F66,<POINTR(SAVE2,SW.F77)>,0 ;[1505] SAME AS /NOF77
SN F77,<POINTR(SAVE2,SW.F77)> ;[1205] ALLOW /NOF77
SL FLAG,<777700,,FLAG>,FLG,-1 ;[2353]
SP KA10,<POINTR(SAVEF,SW.KAX)>,KA10SW ;[760] /KA is fatal error
SP KI10,<POINTR(SAVEF,SW.KAX)>,KI10SW ;[760] /KI is obsolete
SP INCLUDE,<POINTR(SAVEF,SW.IDS)>,.SWDEC##,INC
SP *LNMAP,<POINTR(SAVEF,SW.MAP)>,.SWDEC##,MAP
SP *MACROCODE,<POINTR(SAVEF,SW.MAC)>,.SWDEC##,MAC
SP NOERRORS,<POINTR(SAVEF,SW.NET)>,.SWDEC##,NOE
SS NOFLAG,<POINTR(SAVE2,<SW.CFS!SW.CFV>)>,0 ;[2353]
SL NOWARNING,<777700,,NOWARN>,NOW,-1 ;[1115] NOWARN SWITCH AND PROCESSOR
SP *OPTIMIZE,<POINTR(SAVEF,SW.OPT)>,.SWDEC##,OPT
SN STATISTICS,<POINTR(SAVE2,SW.STA)> ;[1133] ALLOW /NOSTA
SP *SYNTAX,<POINTR(SAVEF,SW.OCS)>,.SWDEC##,OCS
SP TAPEND,FAREA+F.WEOF,.SWDEC##,WEO
SP ZERO,FAREA+F.DTZR,.SWDEC##,ZER
>
PAGE
;[1115]Keywords that can be used with the /NOWARN switch. Exclusive
;[1115] of ALL and NONE (must be keywords 1 and 2), the rest represent the
;[1115] 3 letter error message mnuemonics for errors defined in ERROUT.BLI.
;[1115] Always add new keywords to the end of the macro.
;[2305] Added keywords AIS through VNF.
RELOC ;[1115] Retain in low seg
NWKTB:: ;[1115] Global handle on the table
KEYS NOW,<
ALL,NONE,ZMT,FNA,DIS,MVC,AGA,CUO,NED,LID,DIM,WOP,
VNI,RDI,CTR,CAI,IFL,ICD,SOD,ICC,XCR,ICS,FMR,VND,
NOD,PPS,DXB,VAI,IDN,PAV,SID,IUA,CAO,CNM,DGI,SBR,CHO,
WNA,IAT,SNO,TSI,ACB,AIL,RIM,FOO,
AIS,CAP,CCC,CNS,COS,COV,CSM,DEB,DFN,DOW,DPE,DWE,DWL,
EDD,EDS,EDX,EOC,EXD,FAR,FIF,FIN,FMT,FNG,HCP,HCU,INS,
KWU,KWV,LNE,LOL,LSP,MLN,MSL,NAM,NDP,NEC,NIB,NIG,NIK,
NIS,NIX,NLK,NPC,NPP,NSC,OCU,OIO,PWS,RLC,SBC,SEP,SMD,
ANS,SNN,SPN,SRO,SVN,TLF,VFS,VGF,VIF,VNG,WDU,XEN,XOR,
RLX,LNC,NLC,CIS,SOR,FNS,VSD,VNS,VNF,ADS,IMN,MBD,INC,
ADV> ;[4553]
NWKTBC==:.-NWKTB ;[1115] Global keyword count
NWWDCT==<<NWKTBC-1>/^D36>+1 ;[1115] Words needed for bits
RELOC ;[1115] Back to high seg
KEYS BUGK,<DIMENSIONS,LABELS,INDEX,TRACE,BOUNDS,ARGUMENTS> ;[1613]
;[2353] The FLAG subroutine expects these keywords to be in this order
KEYS FLG,<ALL,NONE,ANSI,NOANSI,VMS,NOVMS> ;[2455]
XALL
DOSCAN(FORT)
SALL
PAGE
SUBTTL Error macros
; Miscellaneous error macros
; These parallel the macros used by SCAN to handle errors
; including the type ahead clearing and re-prompt.
; They use several SCAN typeout routines.
; General Fatal error - continues
; TEXT = Error message text, includes prefix
DEFINE F.FAIL (TEXT) ,<
SKPINL
JFCL
OUTSTR [ASCIZ \
?'TEXT
\]
CLRBFI
JRST FORTR2
>
; Fatal error with decimal value typeout - continues
; TEXT = Error message text
; NUM = Decimal number to append to text
DEFINE F.FAID (TEXT,NUM) ,<
SKPINL
JFCL
OUTSTR [ASCIZ \
?'TEXT\]
OUTSTR [ASCIZ / /]
PUSHJ P,.TDECW##
OUTSTR [ASCIZ /
/]
CLRBFI
JRST FORTR2
>
; Fatal error with octal value and filespec typeout - continues
; TEXT = Error message text
; NUM = Octal number to append to text
; FSPEC = Pointer to file spec to append to text
DEFINE F.FAIF (TEXT,NUM,FSPEC) ,<
SKPINL
JFCL
OUTSTR [ASCIZ \
?'TEXT\]
OUTSTR [ASCIZ / /]
MOVE T1,NUM
JUMPL T1,.+3
PUSHJ P,.TOCTW##
OUTSTR [ASCIZ / /]
MOVE T1,FSPEC
PUSHJ P,.TFBLK##
OUTSTR [ASCIZ /
/]
CLRBFI
JRST FORTR2
>
PAGE
SUBTTL TRAP handling routines
;
; Subroutine to initialize for APR trapping
;
; SET UP TRAP FOR
;
; TOPS-10 TOPS-20
; AP.POV .ICPOV PUSHDOWN OVERFLOW
; AP.NXM .ICNXP NON-EXISTENT MEMORY
; AP.ILM .ICIRD MEMORY PROTECTION VIOLATION
; .ICIWR (READ & WRITE)
;
APRINI:
IFE FTTENX,<
MOVEI T1,APRTRP ;LOCATE TRAP ROUTINE
MOVEM T1,.JBAPR## ;TELL THE MONITOR WHERE TRAP OCCURS
MOVEI T1,AP.POV!AP.ILM!AP.NXM ;SET CONDITIONS
APRENB T1, ;ENABLE TRAPS
POPJ P,
> ;TOPS-10
IFN FTTENX,< ;[1600] NEW
MOVEI T1,.FHSLF ;[1600] OWN FORK
CIS ;[1600] CLEAR INTERUPT SYSTEM
MOVE T2,[LEVTAB,,CHNTAB] ;[1600] ADDR OF LEVEL TAB & CHAN TAB
SIR ;[1600] SET INTERUPT ADDRESSES
EIR ;[1600] ENABLE INTERUPT SYSTEM
SETO T2, ;[1600] DISABLE ANY CHANS *** TEMP ***
DIC ;[1600] PA1050 MIGHT HAVE STARTED *** TEMP ***
MOVE T2,.JBREL ;[1600] END OF CORE (REFERENCES PG 0)
MOVE T3,[1777,,1777] ;[1600] END OF PAGE 1
BLT T3,(T2) ;[1600] REFERENCE PAGES TO THE END
MOVE T2,[CHNMSK] ;[1600] ARM PROPER CHANNELS
AIC ;[1600] ENABLE INTERUPT CHANNELS
POPJ P, ;[1600]
; [1600] Blocks for TOPS-20 interupt system
; [1600] Note: all interupts happen at level 1
LEVTAB: LEV1PC ;[1600] ADDR OF LEVEL 1 PC
LEV2PC ;[1600] ADDR OF LEVEL 2 PC
LEV3PC ;[1600] ADDR OF LEVEL 3 PC
RELOC ;[1600] TO THE LOWSEG
LEV1PC: BLOCK 1 ;[1600] LEVEL 1 PC
LEV2PC: BLOCK 1 ;[1600] LEVEL 2 PC
LEV3PC: BLOCK 1 ;[1600] LEVEL 3 PC
RELOC ;[1600] BACK TO PURE STORAGE
CHNMSK==1B<.ICPOV>!1B<.ICIRD>!1B<.ICIWR>!1B<.ICNXP> ;[1600] CHANNEL MASK
CHNTAB: PHASE 0 ;[1600] *** BEWARE! ***
;[1600] The value of "." is now the current offset into the table
;[1600] instead of .-CHNTAB so you are allways <n>-. words away from
;[1600] entry <n> instead of <n>-<.-CHNTAB>
BLOCK .ICPOV-. ;[1600] (0-8)
1,,POVTRP ;[1600] (9) PDL OVERFLOW
BLOCK .ICIRD-. ;[1600] (10-15)
1,,IRDTRP ;[1600] (11) ILL MEM READ
1,,IWRTRP ;[1600] (12) ILL MEM WRITE
BLOCK .ICNXP-. ;[1600] (13-21)
1,,NXPTRP ;[1600] (22) NON-EXISTANT PAGE
BLOCK ^D35-. ;[1600] (23-35)
DEPHASE ;[1600] *** END OF PHASE 0 ***
> ; [1600] TOPS-20
PAGE
SUBTTL GFLOATING Microcode test
;
; Subroutine to test for the presence of GFLOATING microcode
;
; Notice that the way that one tests for the microcode is quite
; different for the two different types of monitors.
; For TOPS-10, we need to set up an interrupt block to trap the
; error, while for TOPS-20 we basically need only to attempt
; a typical GFLOATING instruction and directly trap the error
; return which would indicate the microcode is not present.
; The result of this routine is that the bit GFMCOK will be
; set (or reset) to zero if the GFLOATING microcode is
; available and -1 if not.
;
GFLTST: SETZM T4 ;ASSUME MICROCODE NOT PRESENT
IFE FTTENX,<
MOVEI T1,INTBLK ;GET ADDRESS OF INTERRUPT BLOCK
EXCH T1,.JBINT ;SET UP FOR TRAPPING FAILURE OURSELVES
SETZM INTBLK+2 ;MUST ZERO THIS OLD PC
> ;ALL SET FOR TOPS-10 NOW
SETZB T2,T3 ;[1621] Make sure registers have safe value
GFAD T2,T2 ;TRY A TYPICAL GFLOATING INSTRUCTION
IFN FTTENX,< ERJMP INTDON > ;SIMPLE FOR TOPS-20!
MOVX T4,GFMCOK ;YES, THE MICROCODE IS PRESENT.
INTDON: IORM T4,FLAGS2 ;SET UP THE GFMCOK BIT
IFE FTTENX,< EXCH T1,.JBINT > ;PUT INTERRUPT TRAPPING BACK FOR TOPS-10
POPJ P, ;AND RETURN IN ANY CASE
IFE FTTENX,<
RELOC
INTBLK: XWD 4,INTDON ;LENGTH, NEW PC
EXP ER.MSG+ER.EIJ ;NO MESSAGE, TRAP FATAL ERRORS
EXP 0 ;OLD PC
EXP 0 ;ERROR BITS
RELOC
> ;HARDER FOR TOPS-10!
PAGE
SUBTTL Interface to SCAN
;
; Subroutine to initialize SCAN
;
SINIT: MOVE T1,[2,,[IOWD 1,['FORTRA'] ;[1617] Commands to RESCAN for
XWD CCLSW##,'FOR']]
PUSHJ P,.ISCAN## ; FIRE UP SCAN
POPJ P,
;
; Subroutine to process SWITCH.INI switches
;
PSWINI: MOVE T1,[4,,[IOWD FORTL,FORTN
XWD FORTD,FORTM
XWD 0,FORTP
EXP -1]]
PUSHJ P,.OSCAN## ;SCAN SWITCH.INI FILE
POPJ P,
;
; Subroutine to scan one command line
;
SLINE: MOVE T1,[11,,[IOWD FORTL,FORTN
XWD FORTD,FORTM
XWD 0,FORTP
EXP -1
XWD CLRALL,CLRFIL
XWD ALLIN,ALLOUT
XWD MEMSTK,APPSTK
XWD CLRSTK,1B18
XWD 0]] ;[1115] Let SCAN process switches
PUSHJ P,.TSCAN## ;SCAN ONE COMMAND LINE
POPJ P,
PAGE
SUBTTL Compiler Initialization
;Here is where it all begins. One enters the compiler at label
;FORTRA or one instruction down for CCL entry. At this point
;[1121]one cannot depend upon the stack being set up.
;[1121]For the TOPS-10 multi segment version, the full RUN
;[1121]directory path, and the high seg origin must be
;[1121]saved away for later use by the GETSEGs and high
;[1121]segment entry code.
MRP0:: PORTAL .+1 ;[1121] NORMAL Execute only entry
FORTRA:: ;[1053]
TDZA T1,T1 ;FLAG AS NORMAL ENTRY
MOVEI T1,1 ;FLAG AS CCL ENTRY
MOVEM T1,CCLSW## ;SAVE CCL SWITCH
IFE FTTENX,<
SKIPE T1,GETSBL## ;HAVE WE BEEN HERE BEFORE?
JRST FORTR1 ;YES MUST BE DOING ^C START
MOVEM 7,GETSBL##+4 ;[1121]Save old RUN PPN
MOVEM 11,GETSBL## ;[1121]And device
MOVSI T2,-5 ;[1121]Max of 5 SFDs
FOR.I1: HRROI T1,.GTRS0(T2) ;[1121]Get SFD name
GETTAB T1, ;[1121]
JRST FOR.I2 ;[1121]Failed - assume done
JUMPE T1,FOR.I2 ;[1121]End - really done
MOVEM T1,GETSPA##+3(T2) ;[1121]Save in PATH block
AOBJN T2,FOR.I1 ;[1121]Loop for all
FOR.I2: SETZM GETSPA##+3(T2) ;[1121]Terminate list
HRROI T1,.GTRDI ;[1121]Get RUN PPN
GETTAB T1, ;[1121]
JRST FOR.I3 ;[1121]Failed - use old value
JUMPE T1,FOR.I3 ;[1121]Also if not available
MOVEM T1,GETSPA##+2 ;[1121]Save in full path block
SKIPE GETSPA##+3 ;[1121]If any SFDs
MOVEI T1,GETSPA## ;[1121]Get PATH pointer
MOVEM T1,GETSBL##+4 ;[1121]Save PPN or path pointer
FOR.I3: HRROI T1,.GTRDV ;[1121]Get RUN device
GETTAB T1, ;[1121]
JRST FOR.I4 ;[1121]Failed - use old value
JUMPE T1,FOR.I4 ;[1121]Also if not available
MOVEM T1,GETSBL## ;[1121]Save in GETSEG block
FOR.I4: MOVE T1,[-2,,.GTUPM] ;[1121]Get high seg origin
GETTAB T1, ;[1117]From table
MOVSI T1,400000 ;[1117]Must have hiseg - use default origin
LSH T1,-^D18 ;[1117]Position
TRZ T1,777 ;[1117]No extra bits
MOVEM T1,HSGORG## ;[1117]And save
> ;End of TOPS-10 code
IFN FTTENX,< ;[1600] TOPS-20
MOVEI T1, .FHSLF ;[1600] OUR PROCESS
SETZ T2, ;[1600] ALLOW UUOS
SCVEC ;[1600] SET COMP VECTOR
> ;TOPS-20
FORTR1: JUMPPT (T1,CP166,KA10) ;CANNOT RUN ON PDP-6 OR KA10
MOVE P,[IOWD PDLLEN,STACK##] ;SET UP THE STACK
HRRZI FREG,(P) ;LIFE IS BLISS
PUSHJ P,GFLTST ;TEST FOR GFLOATING MICROCODE
PUSHJ P,SINIT ;INITIALIZE SCAN
FORTR2: MOVE T2,[FIRZER,,FIRZER+1] ;CLEAR LOCAL STORAGE
SETZM FIRZER ; ..
BLT T2,LASZER ; ..
RESETUUO ;RESET ACTIVE I/O
MOVE T1,.JBFF## ;START OF CORE
CORE T1, ;REMOVE CRUFT FROM PREVIOUS JOBS
JFCL ;DO NOT CARE IF IT FAILS
IFE FTTENX,< ;[1600] LET PA1050 DO IT FOR NOW
PUSHJ P,APRINI ;[1600] INITIALIZE APR TRAPPING
> ;TOPS-10
PAGE
SUBTTL Command Scanner
COMND:
PUSHJ P,SLINE ;PRINT "*" AND SCAN NEXT COMMAND LINE
PUSHJ P,NOWSAV ;[1115] SAVE COMMAND LINE NOWARN VALUES
PUSHJ P,PSWINI ;PROCESS SWITCH.INI FILE
PUSHJ P,NOWMRG ;[1115] MERGE COMMAND LINE/SWITCH.INI NOWARNS
PUSHJ P,ABSDEF ;FILL IN ABSENT DEFAULTS
; Switches local to this compilation have now been set up.
; Set up global variables the compiler needs.
HRLZI T1,1 ;[2322] Load 2**18
MOVEM T1,VMSIZE ;[2322] Store size of virtual memory
;[2422] The loading of BIGCONCAT is done this way so that it can
;[2422] be made an /EXTEND: switch at a later date if desired.
MOVE T1,DBIGCON ;[2422] Get default for BIGCONCAT
MOVEM T1,BIGCONCAT ;[2422] Store default
;[2454] Copy DEFLON to LONAME
MOVE T1,DEFLON ;[2454] Get size of default name for data psect
MOVE T2,[XWD DEFLON,LONAME] ;[2454] Source,,Destination
BLT T2,LONAME(T1) ;[2454] Copy DEFLON to LONAME
;[2454] Copy DEFHIN to HINAME
MOVE T1,DEFHIN ;[2454] Get size of default name for code psect
MOVE T2,[XWD DEFHIN,HINAME] ;[2454] Source,,Destination
BLT T2,HINAME(T1) ;[2454] Copy DEFHIN to HINAME
; Check if /GFLOAT
MOVE T1,F2 ;GET SWITCHES
TXNN T1,SW.GFL ;WAS /GFL REQUESTED?
JRST GFLOK ;NO, WE ARE ALL SET TO GO!
MOVE T1,FLAGS2 ;GET RESULT OF MICROCODE TEST
TXNN T1,GFMCOK ;IS GFL MICROCODE PRESENT?
JRST GFLBAD ;NO, TOO BAD - FATAL ERROR
GFLOK:
EXTERN RTIME ;[1133] runtime for this program unit
EXTERN CTIME ;[1133] time of day for connect time
IFE FTTENX,< ;[1133] TOPS-10 code
MOVEI T1,0 ;[1133] get time for this job
RUNTIM T1, ;[1133] get runtime
MOVEM T1,RTIME ;[1133] save it
MSTIME T1, ;[1133] get current time
MOVEM T1,CTIME ;[1133] save it
> ;[1133] end TOPS-10 code
IFN FTTENX,< ;[1133] TOPS-20 code
MOVEI T1,.FHSLF ;[1133] get time for this job
RUNTM ;[1133] get runtime, current time
MOVEM T1,RTIME ;[1133] save runtime
MOVEM T3,CTIME ;[1133] save current time
> ;[1133] end TOPS-20 code
MOVX T1,FTLCOM ;[1160] No fatal compile errors yet
ANDCAM T1,FLAGS2 ;[1160] for this command
IFE FTTENX,< ;TOPS-20 CODE IS ALL DIFFERENT...
SKIPN T1,FINPTR ;CHECK FOR NO INPUT FILES
JRST FORTR1 ;NO INPUT FILES
PUSHJ P,GETSIZ ;CALCULATE MAXIMUM BUFFER CORE REQUIREMENTS
PUSHJ P,NXTFIL ;GET THE NEXT FILE
JRST FORTR1 ;NO INPUT FILES GIVEN
MOVE T1,LBLOCK+.RBALC;GET THE NUMBER OF BLOCKS ALLOCATED
MOVEM T1,LBLOCK+.RBEST; AND ESTIMATE THAT AS THE SIZE OF
SETZM LBLOCK+.RBALC ; EACH OUTPUT FILE.
TXNN F,SW.OCS ;SYNTAX ONLY? IF SO LEAVE .REL ALONE
SKIPN T2,RELSPC+F.DEV ;IS THERE A REL DEVICE
JRST NOREL ;NONE TRY LISTING
MOVE T2,RELSPC+F.MOD ;CHECK FOR NUL DEVICE AND NAME
TXNN T2,FX.NDV ;NO SKIP MEANS DEVICE THERE
JRST ISREL
SKIPN RELSPC+F.NAME ;NO SKIP MEANS DEVICE THERE
JRST NOREL ;NO NAME SPECIFIED
ISREL:
MOVE T2,RELSPC+F.DEV ;SET UP OPEN BLK
TXO F,RELFLG ;LIGHT THE REL FILE BIT FOR OUTMOD
MOVEI P1,RELSPC ;POINTER TO FILESPEC
PUSHJ P,MTMODE ;SET UP MODE FOR MAG TAPE
ADDX T1,.IOBIN ;BINARY MODE
MOVSI T3,BINHDR ;HEADER POINTER
OPEN BIN,T1 ;OPEN THE DEVICE
JRST OPNERR ;CAN NOT DO IT!!!
PUSHJ P,SETENT ;SET UP FOR ENTER
JRST ERRST ;FILE NAME ERROR
MOVEI T1,BIN
DEVCHR T1,
TXNN T1,DV.DTA ;IS DEVICE A DECTAPE
JRST REL1 ;NO
ENTER BIN,LBLOCK+2
JRST UUOERR
JRST REL2
REL1:
ENTER BIN,LBLOCK ;ENTER IN UFD
JRST UUOERR
REL2:
OUTBUF BIN,0 ;SET UP O/P BUFFER
NOREL:
SKIPN T2,LSTSPC+F.DEV ;IS THERE A LISTING DEVICE
JRST NOLST ;NONE TODAY
MOVE T2,LSTSPC+F.MOD ;SAME AS FOR .REL FILE
TXNN T2,FX.NDV
JRST ISLST
SKIPN LSTSPC+F.NAME
JRST NOLST ;NO LISTING IF ZERO
ISLST:
MOVE T2,LSTSPC+F.DEV ;SET UP OPEN BLK
; MOVE T3,LSTSPC+F.MOD
; JRST NOLST
TXO F,LSTFLG ;FLAG THAT A LISTING IS NEEDED
MOVEI P1,LSTSPC ;LISTING SPEC POINTER
MOVE T3,LSTSPC+F.MOD ;GET MODIFIERS
TXNE F,SW.CRF ;CREF ?
TXNN T3,FX.NUL ;NUL EXTENSION?
JRST NOCREF ;NOT CREF OR EXTENSION ALREADY SPECIFIED
; MOVE T3,LSTSPC+F.EXT
; JUMPL T3,NOCREF ;SKIP IF EXPLICIT EXTENSION
MOVEI T3,'CRF'
HRLM T3,F.EXT(P1) ;STORE CRF EXTENSION IN FILESPEC AREA
NOCREF:
PUSHJ P,MTMODE ;SET T1 FOR MAG TAPE MODE
ADDX T1,.IOASC ;ASCII MODE
MOVSI T3,LSTHDR ;POINTER TO BUFFER HEADER
OPEN LST,T1 ;OPEN THE DEVICE
JRST OPNERR ;CAN NOT OPEN DEVICE
PUSHJ P,SETENT ;SET UP FOR ENTER
JRST ERRST ;FILE NAME ERROR
MOVEI T1,LST ;SKIP RETURN OK
DEVCHR T1,
TXNE T1,DV.TTA
TXO F,TTYDEV ;SET BIT ON IF LST DEVICE IS TTY
TXNN T1,DV.DTA ;IS DEVICE A DECTAPE
JRST LST1 ;NO
ENTER LST,LBLOCK+2
JRST UUOERR
JRST LST2
LST1:
ENTER LST,LBLOCK ;ENTER THE FILE
JRST UUOERR
LST2:
MOVE T1,F.NAME(P1) ;GET LISTING FILENAME
MOVEM T1,CHNLTB##+20 ;STORE FOR USE IN PHASE1
OUTBUF LST,0 ;SET UP O/P LST BUFFER
NOLST: MOVEI T1,[ASCIZ /%FTNNOF No output files given
/]
TXNN F,RELFLG!LSTFLG!SW.OCS ;ANY OUTPUT REQUESTED?
PUSHJ P,.TSTRG## ;NO--GIVE THE WARNING
> ;END TOPS-10 ONLY
PAGE
IFN FTTENX,< ;HERE IS THE TOPS-20 SPECIFIC CODE
SKIPN T1,FINPTR ;CHECK FOR NO INPUT FILES
JRST FORTR1 ;NO INPUT FILES
SUBI T1,F.LEN ;INITIALIZE CURRENT INPUT POINTER
MOVEM T1,CINPTR ;SAVE
PUSHJ P,NEWJFN ;GET THE NEXT FILE
JRST FORTR1 ;NO INPUT FILES GIVEN
TXNN F,SW.OCS ;[1160] SYNTAX ONLY? IF SO LEAVE .REL ALONE
SKIPN T2,RELSPC+F.DEV ;IS THERE A REL DEVICE
JRST NOREL ;NONE TRY LISTING
MOVE T2,RELSPC+F.MOD ;CHECK FOR NUL DEVICE AND NAME
TXNN T2,FX.NDV ;NO SKIP MEANS DEVICE THERE
JRST ISREL
SKIPN RELSPC+F.NAME ;NO SKIP MEANS DEVICE THERE
JRST NOREL ;NO NAME SPECIFIED
ISREL:
TXO F,RELFLG ;LIGHT THE REL FILE BIT FOR OUTMOD
MOVEI P1,RELSPC ;POINTER TO FILESPEC
PUSHJ P,MTMODE ;SET UP MODE FOR MAG TAPE
PUSHJ P,XFILCV ;CONVERT REL SPEC BACK TO ASCII
MOVE T2,[POINT 7,FILSPC] ;POINTER TO NEW SPEC
HRRZI T1,BINTAB ;LONG GTJFN FOR OUTPUT
GTJFN
JRST FILERR ;PROBLEMS
MOVEM T1,BINJFN ;OK - SAVE JFN
HRRZ T1,T1 ;ZERO LEFT
MOVE T2,[XWD BINBYT,WRITEE] ;OPEN FOR WRITE
OPENF
JRST FILERR ;PROBLEMS
NOREL:
SKIPN T2,LSTSPC+F.DEV ;IS THERE A LISTING DEVICE
JRST NOLST ;NONE TODAY
MOVE T2,LSTSPC+F.MOD ;SAME AS FOR .REL FILE
TXNN T2,FX.NDV
JRST ISLST
SKIPN LSTSPC+F.NAME
JRST NOLST ;NO LISTING IF ZERO
ISLST:
TXO F,LSTFLG ;FLAG THAT A LISTING IS NEEDED
MOVEI P1,LSTSPC ;LISTING SPEC POINTER
MOVE T3,LSTSPC+F.MOD ;GET MODIFIERS
TXNE F,SW.CRF ;CREF ?
TXNN T3,FX.NUL ;NUL EXTENSION?
JRST NOCREF ;NOT CREF OR EXTENSION ALREADY SPECIFIED
MOVEI T3,'CRF'
HRLM T3,F.EXT(P1) ;STORE CRF EXTENSION IN FILESPEC AREA
NOCREF:
PUSHJ P,MTMODE ;SET T1 FOR MAG TAPE MODE
PUSHJ P,XFILCV ;CONVERT LST SPEC BACK TO ASCII
MOVE T2,[POINT 7,FILSPC] ;POINTER TO NEW SPEC
HRRZI T1,LSTTAB ;LONG GTJFN FOR OUTPUT
GTJFN
JRST FILERR ;PROBLEMS
MOVEM T1,LSTJFN ;OK - SAVE JFN
HRRZ T1,T1 ;ZERO LEFT
MOVE T2,[XWD LSTBYT,WRITEE] ;OPEN FOR WRITE
OPENF
JRST FILERR ;PROBLEMS
;CONTROLLING TERMINAL?
HRRZ T1,LSTJFN ;GET JFN
DVCHR ;CHARACTERISTICS
HLRZ T1,T1 ;GET DEVICE TYPE
CAIE T1,TTCODE ;IS IT A TERMINAL
JRST NOTTY ;NO
HRRZ T3,T3 ;SAVE TERMINAL NUMBER
PUSH P,T3
GJINF ;CONTROLING INFORMATION
POP P,T3 ;GET TERMINAL NUMBER BACK
CAMN T4,T3 ;COMPARE TO CONROLLING TERMINAL NUMBER
TXO F,TTYDEV ;NOTE LST = CONTROLLING TTY:
NOTTY:
MOVE T1,F.NAME(P1) ;GET LISTING FILENAME
MOVEM T1,CHNLTB##+20 ;STORE FOR USE IN PHASE1
NOLST: MOVEI T1,[ASCIZ /%FTNNOF No output files given
/]
TXNN F,RELFLG!LSTFLG!SW.OCS ;ANY OUTPUT REQUESTED?
PUSHJ P,.TSTRG## ;NO--GIVE THE WARNING
> ;END TOPS-20 ONLY
;TOPS-10 AND TOPS-20 MERGE HERE
LOOP:
SKIPN T1,CCLSW
JRST BYNAM
MOVEI T1,[ASCIZ /FORTRAN: /]
PUSHJ P,.TSTRG##
SKIPE T1,CHNLTB##+32 ;GET FILE NAME IF ANY
PUSHJ P,.TSIXN## ;TYPE AS SIXBIT
PUSHJ P,.TCRLF## ;GIVE AN EOL
BYNAM:
IFN FTTENX,< ;[1600] *TEMP* SUICIDE CLOSES ALL CHANS
;; MOVE T1,[1,,[11]] ;[1600] PAT SUICIDE FUNCTION
;; COMPT. T1, ;[1600] CALL PA1050
;; HALT ;[1600] SIGH
PUSHJ P,APRINI ;[1600] START TOPS-20 PSI SYSTEM
MOVEI T1,.FHSLF ;[1600] HACK OUR PROCESS
SETO T2, ;[1600] MAKE UUO'S FATAL
SCVEC ;[1600] KILL PAT ENTRY VECTOR
> ;TOPS-20
MOVE T1,DEBGSD ;MOVE LOCAL TO GLOBAL - MACRO BUG
MOVEM T1,DEBGSW##
MOVE T1,BUGINT
MOVEM T1,BUGOUT## ;INTERMEDIATE OUTPUT REQUEST SWITCHWES
SETZM SEGINCORE## ;ARGUMENT TO PHASE CONTROL
PUSHJ P,PHAZCONTROL## ;GET THE NEXT PHASE
PORTAL .+1 ;[1047] Execute only re-entry
LOOPDN:
IFN FTTENX,<
MOVEI T1,.FHSLF ;[1600] HACK OUR PROCESS
SETZ T2, ;[1600] MAKE UUO'S LEGAL AGAIN
SCVEC ;[1600]
PUSHJ P,CLOSUP## > ;CLOSE EVERYTHING
IFE FTTENX,<
CLOSE LST, ;CLOSE LISTING FILE
CLOSE SRC, ;CLOSE SOURCE FILE
MOVE T1,FLAGS2 ;[1160] Any fatal compile errors seen
TXNE T1,FTLCOM ;[1160] during this command?
CLOSE BIN,40 ;YES - DISCARD .REL
RELEASE BIN, ;WILL DO CLOSE IF NEEDED
> ;END TOPS-10 ONLY
JRST FORTR2 ;INITIALIZE AND LOOK FOR NEXT COMMAND
PAGE
IFN FTTENX,<
; NEW [1600] /PLB
; Simulate CORE UUO for Twenex
CORUUO::
PUSH P, T1
PUSH P, T2
MOVEI T1, .HIGH.## ;GET HI-SEGMENT ORIGIN
CAMG T1, -3(P) ;LARGER THEN REQUESTED CORE BREAK?
PUSHJ P, CORERR ;'FRAID SO
MOVEI T1, .FHSLF ;THIS PROCESS
MOVEI T2, 1B<.ICNXP> ;NON-EXISTANT PAGE
DIC ;DEACTIVATE
MOVE T2, -3(P) ;GET DESIRED LOW SEGMENT BREAK
ORI T2, 777 ;END-OF-PAGE-IFY
MOVE T1, .JBREL## ;GET CURRENT END OF CORE
CAMG T2, T1 ;CUTTING BACK????
JRST CORE.1 ;YES
AOJ T1, ;BUMP UP FROM END OF LAST PAGE
SETZM (T1) ;ZERO FIRST WORD
HRL T1, T1 ;PREPARE FOR BLT
BLT T1, (T2) ;SMEAR THE ZEROS
CORE.1: MOVEM T2, .JBREL ;STORE AS NEW END
MOVEI T1, .FHSLF ;OUR FORK
MOVEI T2, 1B<.ICNXP> ;NXP INTERUPT CONDITION
AIC ;ACTIVATE CHANNEL
POP P, T2
POP P, T1
POPJ P,
> ;TOPS-20 CORUUO
PAGE
SUBTTL SUBROUTINES CALLED FROM .TSCAN
;SUBROUTINE TO CLEAR ALL ANSWERS
CLRALL: SETZM SAVEF ;ERASE OLD SWITCHES
SETZM SAVEFM ;MASK WORD TOO
SETZM SAVE2 ;MORE OF THE SAME
SETZM SAVE2M ;MASK WORD TOO
PUSHJ P,NOWCLR ;[1115] DEFAULT THE NOWARN DATA
SKIPA T2,[LSTCLR] ;THE WHOLE THING
;SUBROUTINE TO CLEAR FILE ANSWERS
CLRFIL: MOVEI T2,FAREA+F.LEN ;JUST CLEAR F AREA
MOVE T1,[FIRZER,,FIRZER+1] ;CLEAR FROM FIRZER
SETZM FIRZER ; ..
BLT T1,(T2) ; TO THE END
POPJ P, ; ..
;SUBROUTINE TO ALLOCATE AN OUTPUT AREA
ALLOUT: AOS T3,OUTCNT ;T3 = COUNT OF OUPUT FILES
MOVE T1,[EXP RELSPC,LSTSPC]-1(T3) ;T1 = ADDRESS OF SPEC
MOVEI T2,F.SLEN ;T2 = LENGTH OF SPEC
CAIG T3,2 ;TOO MANY SPECS?
POPJ P, ;NO--ALL DONE
F.FAIL (<FTNTOF More than 2 output files are not allowed>) ;[1065]
;SUBROUTINE TO ALLOCATE AN INPUT AREA
ALLIN: SKIPE T1,LINPTR ;ANY LAST INPUT SPEC?
JRST ALLIN1 ;YES--MAKE ANOTHER
MOVE T1,.JBFF## ;FIRST INPUT SPEC GOES HERE
MOVEM T1,FINPTR ;SAVE FOR LATER
SUBI T1,F.LEN ;FIX UP SO FIRST SPEC IS CORRECT
MOVEM T1,LINPTR ;SAVE AWAY
ALLIN1: MOVEI T2,<F.LEN*2>(T1);ADDRESS OF NEXT SPEC
CAMGE T2,.JBREL## ;WILL IT FIT?
JRST ALLIN2 ;YES--CONTINUE
CORE T2, ;NO--EXPAND CORE
JRST E.NCF ;NO CORE--YOU LOOSE
ALLIN2: MOVEI T1,F.LEN ;LENGTH OF SPEC
ADDM T1,.JBFF## ;UPDATE JOBFF
ADDB T1,LINPTR ;UPDATE T1 AND POINTER
MOVEI T2,F.SLEN ;AMOUNT SCAN KNOWS ABOUT
POPJ P, ;RETURN
;SUBROUTINE TO CLEAR STICKEY DEFAULTS
CLRSTK: SETZM PAREA ;ALL THE STICKEY DEFAULTS
MOVE T1,[PAREA,,PAREA+1] ; ..
BLT T1,PAREA+F.LEN-1; ARE IN THE PAREA
POPJ P,
;[1115] SUBROUTINE TO PROCESS THE NOWARN SWITCH KEYWORDS.
;[1115] OPTIONS ARE ALWAYS APPLIED, IN THE ORDER GIVEN
;[1115] EXACTLY AS SCAN OR-BIT-VALUES.
NOWARN: SKIPN N ;[1115] /NOWARN: OR /NOWARN:0?
MOVEI N,2 ;[1115] MAKE IT NONE
CAIE N,-1 ;[1115] WAS IT JUST /NOWARN
CAIN N,1 ;[1115] OR /NOWARN:ALL?
JRST NW.ALL ;[1115] YES - SET ALL BITS ON
CAIN N,2 ;[1115] /NOWARN:NONE?
JRST NW.NON ;[1115] YEP - CLEAR ALL BITS
MOVEI T1,-1(N) ;[1115] DETERMINE CORRECT WORD
IDIVI T1,^D36 ;[1115] AND POSITION TO SET
MOVEI T3,1 ;[1115] GET BIT TO SHIFT
LSH T3,(T2) ;[1115] SHIFT TO PROPER POSITION
IORM T3,NWBITS(T1) ;[1115] SET NOWARN OPTION
IORM T3,NWMASK(T1) ;[1115] AND MASK BIT
JRST NW.DON ;[1115] LEAVE
NW.NON: SETZ T1, ;[1115] CLEAR ALL BITS
SKIPA ;[1115] CHECK FURTHER
NW.ALL: SETO T1, ;[1115] SET ALL BITS
MOVSI T2,-NWWDCT ;[1115] SETUP FOR LOOP
NW.SET: MOVEM T1,NWBITS(T2) ;[1115] STORE VALUE
SETOM NWMASK(T2) ;[1115] SET MASK
AOBJN T2,NW.SET ;[1115] SET THEM ALL
NW.DON: AOS (P) ;[1115] WE STORED THE VALUE
POPJ P, ;[1115] BACK TO SCAN
;Subroutine to set up for SWITCH.INI processing
NOWSAV: MOVE T1,[NWBITS,,NWSAVB] ;[1115] MOVE /NOWARN DATA AND
BLT T1,<NWSAVM+NWWDCT-1> ;[1115] MASKS TO SAVE AREA
MOVX T1,SW.CFS!SW.CFV ;[2353] Move /FLAG bits
AND T1,SAVE2 ;[2353] to a
MOVEM T1,SAVBIT ;[2353] safe place
MOVX T1,SW.CFS!SW.CFV ;[2353] Move /FLAG mask
AND T1,SAVE2M ;[2353] to a
MOVEM T1,SAVMSK ;[2353] safe place
;Subroutine to clear /NOWARN and /FLAG bits
NOWCLR: SETZM NWBITS ;[1115] CLEAR THE KEYWORD DATA
MOVE T1,[NWBITS,,NWBITS+1] ;[1115] AND THE MASKS
BLT T1,<NWMASK+NWWDCT-1> ;[1115]
MOVX T1,SW.CFS!SW.CFV ;[2353] Clear the
ANDCAM T1,SAVE2 ;[2353] bits
ANDCAM T1,SAVE2M ;[2353] and the mask
POPJ P, ;[1115] DONE
;Subroutine to merge command line and SWITCH.INI for /NOWARN and /FLAG
NOWMRG: MOVE T1,SAVMSK ;[2353] Mask bits for /FLAG from command line
ANDCAM T1,SAVE2 ;[2353] cannot be overridden by SWITCH.INI
IORM T1,SAVE2M ;[2353] Merge with SWITCH.INI mask
MOVE T1,SAVBIT ;[2353] Switch setting for /FLAG from command
IORM T1,SAVE2 ;[2353] are merged with SWITCH.INI settings
MOVSI T1,-NWWDCT ;[1115] SETUP FOR LOOP
MOVE T3,[SW.NOW] ;[1115] GET NOWARN INDICATOR
NW.UPD: MOVE T2,NWSAVM(T1) ;[1115] GET MASK BITS FROM COMMAND LINE
ANDCAM T2,NWBITS(T1) ;[1115] CANNOT BE OVERRIDEN BY SWITCH.INI
IORM T2,NWMASK(T1) ;[1115] UPDATE MASK
MOVE T2,NWSAVB(T1) ;[1115] GET COMMAND LINE KEYWORDS
IORM T2,NWBITS(T1) ;[1115] UPDATE NOWARN KEYWORD SETTINGS
SKIPE NWBITS(T1) ;[1115] ANY OPTIONS REQUESTED?
IORM T3,SAVEF ;[1115] MAKE SURE NOWARN IS INDICATED
AOBJN T1,NW.UPD ;[1115] LOOP FOR ALL WORDS
POPJ P, ;[1115] DONE
;Subroutine to process the FLAG switch keywords. [2353] New by AlB
;This routine depends upon the keywords being in the following order:
; ALL, NONE, ANSI, NOANSI, VMS, NOVMS [2455]
FLAG: SKIPE N ;If /FLAG: or /FLAG:0
CAIN N,-1 ; or /FLAG (with no keyword)
MOVEI N,1 ; assume ALL
MOVX T1,SW.CFS!SW.CFV ;Assume ALL/NONE
CAILE N,2 ;Is it ALL/NONE?
MOVX T1,SW.CFS ;No--Assume ANSI/NOANSI
CAILE N,4 ;Is it VMS/NOVMS? [2455]
MOVX T1,SW.CFV ;It is VMS/NOVMS [2455]
TRNN N,1 ;Is it NOxxx?
JRST CF.OFF ;Yes--Turn off bits
IORM T1,SAVE2 ;Turn on bits
ANDCAM T1,SAVE2M ;Turn off bits in mask
AOS (P) ;Skip return
POPJ P, ;Back to scan
CF.OFF: ANDCAM T1,SAVE2 ;Turn off bits
IORM T1,SAVE2M ;Turn on bits in mask
AOS (P) ;Skip return
POPJ P, ;Back to scan
XALL
DEFINE MEM(A),<
IRP A,<
SKIPE T1,FAREA+F.'A ;IS A SPECIFIED?
MOVEM T1,PAREA+F.'A ;YES--REMEMBER A
>>
;SUBROUTINE TO MEMORIZE STICKEY DEFAULTS
MEMSTK: MEM (<ADV,BACK,WEOF,REW,DTZR>)
POPJ P,
DEFINE APPLY(A),<
IRP A,<
MOVE T1,PAREA+F.'A ;PICK UP STICKEY DEFAULT FOR A
SKIPN FAREA+F.'A ;IS A LOCAL OVER RIDE PRESENT
MOVEM T1,FAREA+F.'A ;NO--APPLY THE DEFAULT
>>
;SUBROUTINE TO APPLY STICKEY DEFAULTS
APPSTK: APPLY (<ADV,BACK,WEOF,REW,DTZR>)
POPJ P,
SALL
IFE FTTENX,<
PAGE
SUBTTL SUBROUTINES FOR COMMAND SCANNING
;SUBROUTINE TO APPLY ABSENT DEFAULTS
ABSDEF: SETCM F,SAVEFM ;T1 GETS A 1 BIT FOR EVERY BIT IN F
; WHICH WAS NOT EXPLICITLY SPECIFIED
; BY THE USER.
AND F,INDADF ;AND WITH THE DEFAULTS.
IORB F,SAVEF ;OR IN THE SELECTED BITS.
SETCM T1,SAVE2M ;GET THOSE SWITCHES NOT REQUESTED
AND T1,INDAD2 ;PICK UP DEFAULTS FOR THEM
IORB T1,SAVE2 ;OR IN THE SELECTED SWITCHES
MOVEM T1,F2 ;PUT OUT IN THE FLAG REGISTER
MOVEI T1,RELSPC ;POINT AT REL FILE
HRLOI T2,'REL' ;DEFAULT EXTENSION
PUSHJ P,DEFEXT ;FILL IN DEFAULT
MOVEI T1,LSTSPC ;POINT TO LISTING FILE SPEC
HRLOI T2,'LST' ;DEFAULT EXTENSION
PUSHJ P,DEFEXT ;FILL IN DEFAULT
MOVE T1,FINPTR ;POINT TO FIRST INPUT SPEC
ABSDF1: HRLOI T2,'FOR' ;DEFAULT EXTENSION
PUSHJ P,DEFEXT ;GO DEFAULT IT
MOVX T3,FX.PRT ;[656] BE SURE TO NOTICE
IORM T3,F.MODM(T1) ;[656] THE /OKPROT BIT
CAMN T1,LINPTR ;LAST INPUT POINTER
POPJ P, ;YES--ALL SET UP
ADDI T1,F.LEN ;POINT TO NEXT SPEC
JRST ABSDF1 ;LOOP FOR NEXT SPEC
;SUBROUTINE TO FILL IN A DEFAULT EXTENSION
;CALL WITH:
; T1 = FILE SPEC POINTER (PRESERVED)
; T2 = EXTENSION
; PUSHJ P,DEFEXT
; RETURN HERE
DEFEXT: HLRZ T3,F.EXT(T1) ;GET EXTENSION
JUMPN T3,.POPJ## ;ALL DONE IF IT WAS GIVEN
HRRE T3,F.EXT(T1) ;EXPLICITLY NULL
AOJE T3,.POPJ## ;JUMP IF YES
MOVEM T2,F.EXT(T1) ;NO--SET UP DEFAULT
POPJ P, ; RETURN
PAGE
SUBTTL LOOKUP/ENTER SUBROUTINES
;SUBROUTINE TO RETURN THE NEXT FILE TO BE READ BY FORTRAN.
;IT RETURNS WITH THE EOCS BIT SET IN F. IF THIS IS THE
; LAST SPEC IN THE COMMAND STRING. IT SKIP RETURNS IF A
; FILE SPEC HAS BEEN FOUND.
;CALL WITH:
; PUSHJ P,NXTFIL
; NOTHING FOUND
; SPEC POINTER IN P1
NXTFIL: PORTAL .+1 ;[1047] Execute only entry
MOVE T1,[4,,[XWD FINPTR,LINPTR ;[1047]
XWD OBLOCK,LBLOCK
XWD F.LEN,.RBALC
EXP 1B0+<SRC>B17+LKTEMP]]
PUSHJ P,.LKWLD## ;SCAN THE DISK OR TAPE
POPJ P, ;NON-SKIP WHEN DONE
MOVE P1,LKTEMP ;POINTER TO CURRENT SPEC
CAMN P1,LINPTR ;SAME AS LAST SPEC
SKIPE .WLDFL## ; AND NO WILD CARDS?
TXZA F,EOCS ;NO--MAY BE MORE
TXO F,EOCS ;YES--THIS IS THE LAST SPEC.
PUSHJ P,OPENIN ;OPEN THE INPUT FILE
MOVE T1,F.NAME(P1) ;GET SRC FILENAME
MOVEM T1,CHNLTBL##+32 ;PUT IN TABLE TO BE LOOKED
; AT BY LISTING HEADER
MOVE T1,F.EXT(P1) ;EXTENSION
MOVEM T1,CHNLTBL+33 ;EXTENSION FIELD FOR SRC
;ROUTINE IN CLASS
JRST .POPJ1## ;SKIP RETURN
;SUBROUTINE TO OPEN THE INPUT FILE
;CALL WITH:
; P1 = FILE SPEC POINTER
; PUSHJ P,OPENIN
; RETURN HERE
OPENIN: HRRZI T1,SRCHDR ;BUFFER HEADER
MOVEM T1,OBLOCK+2 ;STORE IN OPEN BLOCK
OPEN SRC,OBLOCK ;OPEN THE DEVICE
JRST OPNER1 ;OPEN ERROR
MOVEI T1,SRC
DEVCHR T1,
MOVE T2,FLAGS2## ;SECONDARY FLAG REGISTER
TXNE T1,DV.TTY ;IS DEVICE A TTY
TXOA T2,TTYINP ;YES
TXZ T2,TTYINP ;NO
MOVEM T2,FLAGS2## ;SAVE IT
PUSH P,LBLOCK+.RBPPN ;SAVE .RBPPN OVER LOOKUP
TXNN T1,DV.DTA ;IS DEVICE DECTAPE
JRST OPEN1 ;NO
LOOKUP SRC,LBLOCK+2 ;DO DIFFERENT LOOKUP
JRST OPNER2
JRST OPEN2
OPEN1:
LOOKUP SRC,LBLOCK ;LOOKUP THE FILE
JRST OPNER2 ;NO CAN DO
OPEN2:
POP P,LBLOCK+.RBPPN ;RESTORE .RBPPN TO WHAT USER SAID
MOVE T2,OBLOCK ;T2 GETS THE DEVICE NAME
PJRST MTAOP ;POSITION MAG TAPE
OPNER1:
PUSHJ P,E.DFO##
ERRST: ;ERROR ENTRY
SKIPE T1,CCLSW
JRST COMND
JRST FORTR1 ;LOOP BACK
OPNER2:
POP P,LBLOCK+.RBPPN ;RESTORE .RBPPN FROM LOOKUP ERROR
HRRZ T1,LBLOCK+.RBEXT
JUMPN T1,OPNE2A ;EXPLICIT EXTENSION FILE LOOKUP ERROR
MOVX T1,FX.NUL ;NULL EXT MASK
TDNN T1,F.MOD(P1) ;WAS NULL EXTENSION INPUT?
JRST OPNE2A ;NO
ANDCAM T1,F.MOD(P1) ;YES,TURN OFF THAT BIT TO AVOID ALOOP
HRRZS LBLOCK+.RBEXT ;ZERO THE EXTENSION FIELD IN LOOKUP BLOCK
JRST OPENIN ;TRY AGAIN WITH NULL EXTENSION
OPNE2A:
PUSHJ P,E.DFL## ;TRY AGAIN AFTER ERROR MESSAGE
SKIPE T1,CCLSW
JRST COMND
JRST FORTR1 ;LOOP BACK
; SUBROUTINE TO CALCULATE THE MAX CORE REQUIREMENTS FOR THE LIST
; OF INPUT FILES. CHECK THE
; LIST OF FILES AND SAVE THE REQUIREMENTS OF THE LARGEST.
; CALL WITH:
; PUSHJ GETSIZ
; RETURN HERE
GETSIZ:MOVE T1,FINPTR ;FIRST FILE AREA
SETZM BGSTBF## ;CLEAR LARGEST SAVE LOCATION
GETSI2: ;SET UP ARG BLOCK
MOVEI T2,0 ;STATUS
MOVE T3,F.DEV(T1) ;DEVICE NAME
MOVEI T4,T2 ;ARG BLOCK ADDRESS
DEVSIZ T4, ;GET DEFAULT NUMBER AND SIZE OF BUFFERS
MOVE T4,[2,,203] ;[704] ASSUME OLD MONITOR - 2 DSK BUFFERS
JUMPLE T4,GETSI1 ;IGNORE ANY ERRORS
;SOMEONE ELSE WILL CATCH THEM
HLRZ T3,T4 ;MOVE NUMBER OF BUFFERS
HRRZ T4,T4 ;ZERO T4<LEFT>
IMUL T4,T3 ;TOTAL SIZE
CAMLE T4,BGSTBF## ;IS THIS LARGEST SO FAR?
MOVEM T4,BGSTBF## ;YES - SAVE IT
GETSI1:
CAMN T1,LINPTR ;ARE WE DONE?
POPJ P, ;YES
ADDI T1,F.LEN ;NO - DO NEXT ONE
JRST GETSI2
;SUBROUTINE TO SET UP FOR AN ENTER
;CALL WITH:
; P1 = FILE SPEC POINTER
; PUSHJ P,SETENT
; RETURN HERE
SETENT: PUSHJ P,MTAOP ;POSITION THE TAPE
SETZM LBLOCK+.RBPPN
SETZM LBLOCK+.RBSIZ
SETZM LBLOCK+.RBVER
SETZM LBLOCK+.RBSPL
SETZM LBLOCK+.RBALC
MOVE T1,F.NAME(P1) ;PICK UP FILE NAME
MOVE T2,F.NAMM(P1) ;PICK UP FILE NAME MASK
AOJN T2,E.WILD ;CAN NOT BE WILD
MOVEM T1,LBLOCK+.RBNAM;STORE THE FILE NAME
HRRE T2,F.EXT(P1) ;GET THE EXTION MASK
AOJN T2,E.WILD ;MUST BE ALL SPECIFIED
HLLZ T2,F.EXT(P1) ;PICK UP THE EXTENSION
MOVEM T2,LBLOCK+.RBEXT;STORE FOR THE ENTER
LDB T1,[<POINTR(F.MOD(P1),FX.PRO)>] ;GET THE PROTECTION
ROT T1,-^D9 ;PUT IN THE LEFT 9 BITS
MOVEM T1,LBLOCK+.RBPRV;STORE FOR THE ENTER
MOVX T1,FX.DIR ;DIRECTORY SPECIFIED?
TDNN T1,.FXMOD(P1) ; ??
JRST .POPJ1## ;NO--ALL DONE
MOVE T2,F.DIRM(P1) ;IS PPN WILD?
AOJN T2,E.WILD ;YES == ERROR
MOVE T1,F.DIR(P1) ;PICK UP PPN
MOVEM T1,LBLOCK+.RBPPN;STORE FOR THE MOMENT
SKIPN F.DIR+2(P1) ;NEED ANY SFD'S TODAY
JRST .POPJ1## ;NO--ALL DONE
MOVEI T2,PATH ;YES--POINT ENTER TO PATH
MOVEM T2,LBLOCK+.RBPPN; ..
ADDI T2,2 ;SKIP PAST SWITCHES
MOVEM T1,(T2) ;STORE PPN
MOVEI T1,F.DIR+2(P1) ;POINT TO SFD LIST
SETEN1: MOVE T3,1(T1) ;IS SFD WILD?
AOJN T3,E.WILD ;YES == ERROR
MOVE T3,(T1) ;PICK UP SFD
MOVEM T3,1(T2) ;STORE IN PATH
ADDI T1,2 ;SKIP TO NEXT SFD
SKIPE (T1) ;IS IT THERE??
AOJA T2,SETEN1 ;YES--LOOP OVER IT
SETZM 2(T2) ;NO--END THE LIST
JRST .POPJ1##
;SUBROUTINE TO PERFORM MAG TAPE OPERATIONS
;CALL WITH:
; MOVEI P1,FILE-SPEC-POINTER
; PUSHJ P,MTAOP
; RETURN HERE WITH TAPE POSITIONED
MTAOP: POPJ P, ;NULL FOR NOW
;SUBROUTINE TO SET UP T1 AS A MODE WORD FOR MAG TAPES
;CALL WITH:
; MOVEI P1,FILE-SPEC-POINTER
; PUSHJ P,MTAOP
; RETURN HERE WITH T1 SET UP
MTMODE: SETZM T1 ;START WITH A CLEAN SLATE
POPJ P, ;RETURN
> ;End of TOPS-10 code
PAGE
SUBTTL ERROR CONDITIONS
CP166: OUTSTR [ASCIZ /?FTNPD6 FORTRAN will not run on a PDP-6
/]
CLRBFI
EXIT ;Totally fatal
KA10: OUTSTR [ASCIZ /?FTNKA FORTRAN will not run on a KA
/]
CLRBFI
EXIT ;Totally fatal
GFLSUP: OUTSTR [ASCIZ \?FTNGFS /GFLOATING is not yet supported
\] ;[1621]
CLRBFI ;[1621]
JRST FORTR2 ;[1621] TRY ANOTHER COMMAND LINE
GFLBAD: OUTSTR [ASCIZ \?FTNGFM /GFLOATING requires GFLOATING microcode
\]
CLRBFI
JRST FORTR2 ;TRY ANOTHER COMMAND LINE
KA10SW: OUTSTR [ASCIZ \?FTNKAS FORTRAN can not compile for a KA
\]
CLRBFI
JRST FORTR2 ;TRY ANOTHER COMMAND LINE
KI10SW: OUTSTR [ASCIZ \%FTNKIS Obsolete switch /KI
\]
POPJ P, ;Return to scan - ignore the stitch
E.NCF: MOVEI N,1(T2)
F.FAID (<FTNNCF Not enough core for file specs. Total K needed=>,N);[1065]
IFE FTTENX,<
UUOERR: HRRZ T2,LBLOCK+.RBEXT
HRRZ N,P1
SETZM LKTEMP ;CLEAR .LKWLD STATE
CAIN T2,2
JRST EER02
CAIN T2,6
JRST EER06
CAIN T2,14
JRST EER14
F.FAIF (<FTNETF ENTER failure>,T2,N) ;[1065]
EER02: F.FAIF (<FTNPRF Protection failure>,T2,N) ;[1065]
EER06: F.FAIF (<FTNRDE RIB or directory error>,T2,N) ;[1065]
EER14: F.FAIF (<FTNQEF Quota exceeded or disk full>,T2,N) ;[1065]
OPNERR: MOVEM T2,.WILDZ## ;COPY DEVICE NAME TO FSTR IN WILD
JRST OPNER1 ;GIVE ERROR MESSAGE
E.WILD: MOVE N,P1
MOVE T1,F.DEV(P1) ;GET DEVICE NAME
DEVTYP T1, ;GET THE DEVICE TYPE
HALT . ;CAN ONLY FAIL IF THERE IS A BUG IN FORTRAN
; SINCE FOROTS NEEDS THIS CALLI IT MUST EXIST
TXNN T1,TY.INT ;IF INTERACTIVE, ALWAYS OK
TXNN T1,TY.MAN ;LOOKUP/ENTER MANDATORY?
JRST .POPJ1## ;NO--IGNORE BAD FILE NAME
SETOM T2 ;YES--GIVE ERROR MESSAGE
SETZM LKTEMP ;CLEAR .LKWLD STATE
F.FAIF (<FTNNWD Incorrect use of * or ? in>,T2,N) ;[1065]
; FOR ERROR MESSAGES.
XLIST ;Literals
LIT:: LIT
> ;END TOPS-10 ONLY
LIST
PAGE
SUBTTL Resident low core routines and data
RELOC ;IMPURE CODE
; CORE UUO FAILURE ROUTINE IS LOW SEGMENT RESIDENT (CALLED FROM CORMAN AND GETCOR)
CORERR:: ;HERE WHEN CORE UUO FAILS
DMOVEM T1,APRSV1 ;STORE T1, T2
SOS T1,0(P) ;WHERE WERE WE CALLED FROM
HRRZM T1,.JBTPC## ;STORE ADDRESS
MOVEI T2,CORTXT ;LOCATE MESSAGE
JRST APRTR4 ;FINISH MESSAGE
CORTXT: ASCIZ \?FTNUCE User Core Exceeded\
; APR TRAP ROUTINE IS LOW-SEGMENT RESIDENT
; TEXT FOR APR TRAP ROUTINE
APRNXM: ASCIZ \Illegal Memory Reference\
APRPOV: ASCIZ \Stack exhausted\
APRILM: ASCIZ \Memory Protection Violation\
APRTX0: ASCIZ \
?Internal Compiler Error
?\
APRTX1: ASCIZ \ at location \
APRTX2: ASCIZ \ in Phase \
APRTX3: ASCIZ \
?while processing statement \
APRPN1: POINT 3,.JBTPC##,17 ;USEFUL BYTE POINTER
APRPN2: POINT 6,GETSBL##+1 ;[1047] USEFUL BYTE POINTER
APRIOR: ASCII \00000\ ;MAKE A NUMBER
IFN FTTENX,<
NXPTRP: DMOVEM T1, APRSV1 ;[1600] SAVE REGS
MOVEM T3, APRSV3 ;[1600] T1, T2 & T3
MOVEI T1, .FHSLF ;[1600] US
GTRPW ;[1600] GET TRAP WORD
JUMPE T1, NXP.1 ;[1600] NO ERROR ?
MOVE T2, .JBREL## ;[1600] HIGHEST ALLOWED LOCN
CAIGE T2, (T1) ;[1600] ABOVE TOP ?
JRST NXP.1 ;[1600] YES, INTERNAL ERROR TIME
DMOVE T1, APRSV1 ;[1600] GET REGS BACK
DEBRK ;[1600] RETURN FROM TRAP
;[1600] FALL THRU ON ERROR
NXP.1: HRROI T2, APRNXM ;[1600] GENERIC NON-EXISTANT MEMORY
TLNE T1, (PF%WRT) ;[1600] PAGE FAIL ON WRITE?
HRROI T2, [ASCIZ \Non-existant memory write\]
TRNA
IRDTRP: HRROI T2, [ASCIZ \Illegal memory read\]
TRNA
IWRTRP: HRROI T2, [ASCIZ \Illegal memory write\]
TRNA
POVTRP: HRROI T2,APRPOV ;PDL OVERFLOW
HRROI T1,APRTX0
PSOUT
APRTR4: MOVE T1,T2
PSOUT
HRROI T1,APRTX1
PSOUT ;CONTINUE..
MOVEI T1,.PRIOU ;TO TERMINAL
HRRZ T2,LEV1PC ;TRAP PC
MOVE T3,[NO%OOV!NO%LFL!NO%ZRO!FLD(6,NO%COL)!10] ;LPAD W/ ZERO , SIX OITS
NOUT
JFCL ;OVERFLOW?
SKIPN GETSBL##+1 ;IN A PHASE?
JRST APRTR2
HRROI T1,APRTX2
PSOUT
> ;TOPS-20
IFE FTTENX,< ;[1600] TOPS-10
APRTRP: JRSTF @.+1 ;CLEAR FIRST PART DONE
0,,.+1 ;CLEAR APR FLAGS
OUTSTR APRTX0 ;PREFACE MESSAGE
DMOVEM T1,APRSV1 ;SAVE REGISTERS
MOVEI T2,APRNXM ;ASSUME ILL MEM REF
MOVE T1,.JBCNI## ;TEST ERROR
TRNE T1,AP.POV ;PDL OVERFLOW?
MOVEI T2,APRPOV ;LOCATE MESSAGE
TRNE T1,AP.ILM ;MEMORY PROTECTION
MOVEI T2,APRILM ;LOCATE MESSAGE
APRTR4: OUTSTR (T2) ;TYPE MESSAGE
OUTSTR APRTX1 ;CONTINUE
MOVE T2,APRPN1 ;LOAD POINTER
APRTR1: ILDB T1,T2 ;TYPE ADDRESS
MOVEI T1,"0"(T1) ;TYPE ADDRESS
OUTCHR T1 ;TYPE DIGIT
TLNE T2,770000 ;TYPE 6 DIGITS
JRST APRTR1 ;TYPE 6 DIGITS
SKIPN .JBHRL## ;HIGH SEGMENT?
JRST APRTR2 ;NO
OUTSTR APRTX2 ;CONTINUE
> ;TOPS-10
MOVE T2,APRPN2 ;TYPE SEGMENT NAME
APRTR3: ILDB T1,T2 ;LOAD BYTE
MOVEI T1," "(T1) ;TO ASCII
IFE FTTENX,< OUTCHR T1 > ;[1600] TYPE BYTE
IFN FTTENX,< PBOUT > ;[1600] TYPE BYTE
TLNE T2,770000 ;TYPE 6 CHARACTERS
JRST APRTR3
APRTR2:
IFN FTTENX,< ;[1600] TOPS-20
HRROI T1,APRTX3 ;[1600] WHILE PROCESSING STATEMENT
PSOUT
MOVEI T1,.PRIOU
MOVE T2,ISN##
MOVE T3,[NO%OOV!NO%LFL!NO%ZRO!FLD(5,NO%COL)!^D10] ;LPAD W/ ZERO , 5 DIGITS
NOUT
JFCL
HALTF
JRST .-1
> ;TOPS-20
IFE FTTENX,<
OUTSTR APRTX3 ;[1600] WHILE PROCESSING...
MOVE T1,ISN## ;GET STATEMENT #
MOVEM T3,APRSV3 ;SAVE A REGISTER
IDIVI T1,^D10 ;BREAK DOWN
LSHC T2,-7 ;STORE
IDIVI T1,^D10 ;BREAK DOWN
LSHC T2,-7 ;STORE
IDIVI T1,^D10 ;BREAK DOWN
LSHC T2,-7 ;STORE
IDIVI T1,^D10 ;BREAK DOWN
LSHC T2,^D29 ;BUILD NUMBER
LSHC T1,^D29 ;BUILD NUMBER
IOR T1,APRIOR ;CONVERT TO ASCII
MOVSI T2,(BYTE (7)15,12) ;FINISH MESSAGE
OUTSTR T1 ;FINISH MESSAGE
MOVE T1,APRSV1 ;RESTORE AC
MOVE T2,APRSV2 ;RESTORE AC
MOVE T3,APRSV3 ;RESTORE AC
EXIT ;DONE
> ;TOPS-10
APRSV1: BLOCK 1
APRSV2: BLOCK 1
APRSV3: BLOCK 1
PAGE
SUBTTL File specification area definitions
;CCLSW: BLOCK 1 ;0 IF NORMAL START, 1 IF CCL START (NOW IN GLOBAL.BLI)
FIRZER:! ;FIRST LOCATION TO ZERO
FAREA: PHASE 0
F.DEV:! BLOCK 1 ;DEVICE NAME
F.NAME:!BLOCK 1 ;FILE NAME
F.NAMM:!BLOCK 1 ;FILE NAME MASK
F.EXT:! BLOCK 1 ;EXTENSION
F.MOD:! BLOCK 1 ;MOD WORD
F.MODM:!BLOCK 1 ;MOD MASKS
F.DIR:! BLOCK 1 ;PPN
F.DIRM:!BLOCK 1 ;DIRECTORY MASK
BLOCK 12 ;SPACE FOR SFD BIWORDS
F.SLEN==.-F.DEV ;SIZE OF THE BLOCK SCAN KNOWS ABOUT
F.ADV:! BLOCK 1 ;NUMBER OF FILES TO ADVANCE TAPE
F.BACK:!BLOCK 1 ;NUMBER OF FILES TO BACKSPACE TAPE
F.WEOF:!BLOCK 1 ;WRITE AN END OF FILE
F.REW:! BLOCK 1 ;REWIND THE TAPE
F.DTZR:!BLOCK 1 ;ZERO THE DTA DIRECTORY
DEPHASE
F.LEN=.-FAREA ;SIZE OF THE FAREA
;AREA TO REMEMBER STICKEY SWITCHES
PAREA: BLOCK F.LEN ;STICKEY SPEC BLOCK
;OTHER FILE SPECIFICATION STORAGE
RELSPC: BLOCK F.LEN ;AREA FOR REL FILE SPEC
LSTSPC: BLOCK F.LEN ;AREA FOR LIST FILE SPEC
FINPTR: BLOCK 1 ;POINTRER TO FIRST INPUT SPEC
LINPTR: BLOCK 1 ;POINTER TO LAST INPUT SPEC
CINPTR: BLOCK 1 ;CURRENT SPEC POINTER
OUTCNT: BLOCK 1 ;NUMBER OF OUTPUT FILE SPECS
LSTCLR==.-1 ;LAST WORD TO ZERO ON A *
; THE FOLLOWING FOUR WORDS ARE TO HOLD SETTABLE SWITCH VALUES
SAVEF: BLOCK 1 ;HOLDS F WHILE IN SCAN SO .SWDPB DOES NOT
; HARM T1.
SAVEFM: BLOCK 1 ;MASKS FOR STORED FLAGS
SAVE2: BLOCK 1 ;SECOND FLAG WORD FOR SWITCHES
SAVE2M: BLOCK 1 ;SECOND MASK WORD FOR STORED FLAGS
;[2353] Save the /FLAG settings from command line
SAVBIT: BLOCK 1 ;The switch settings
SAVMSK: BLOCK 1 ;The masks
;[1115] DATA FOR PROCESSING /NOWARN, AND RELATED KEYWORDS
NWBITS:: BLOCK NWWDCT ;[1115] NOWARN BITS
NWMASK: BLOCK NWWDCT ;[1115] NOWARN CONFLICT MASK BITS
NWSAVB: BLOCK NWWDCT ;[1115] NOWARN COMMAND BITS SAVE AREA
NWSAVM: BLOCK NWWDCT ;[1115] NOWARN COMMAND MASK SAVE AREA
DEBGSD: BLOCK 1 ;LOCAL HOLDER OF DEBUG SWITCHES
BUGINT: BLOCK 1 ;HOLDS INTERNAL OUTPUT SWITCHES
IFE FTTENX <
;UUO BLOCKS
LBLOCK: BLOCK .RBALC+1 ;FOR LOOKUPS
OBLOCK: BLOCK 3 ;FOR OPENS
LKTEMP: BLOCK 1 ;FOR WILD
PATH: BLOCK 1 ;FOR PATH. UUO
> ;END OF LOCAL TOPS10 STORAGE
IFN FTTENX <
FILSPC: BLOCK 10 ;BUILD AREA FOR FILE SPEC
ICLEST: BLOCK 24 ;STORE AREA FOR INCLUDE FILE ERROR MESSAGE
> ;END OF LOCAL TOPS20 STORAGE
LASZER==.-1
IFN FTTENX,<
PAGE
SUBTTL SUBROUTINES FOR COMMAND SCANNING
;SUBROUTINE TO APPLY ABSENT DEFAULTS
RELOC
ABSDEF: SETCM F,SAVEFM ;T1 GETS A 1 BIT FOR EVERY BIT IN F
; WHICH WAS NOT EXPLICITLY SPECIFIED
; BY THE USER.
AND F,INDADF ;AND WITH THE DEFAULTS.
IORB F,SAVEF ;OR IN THE SELECTED BITS.
SETCM T1,SAVE2M ;GET THOSE SWITCHES NOT REQUESTED
AND T1,INDAD2 ;PICK UP DEFAULTS FOR THEM
IORB T1,SAVE2 ;OR IN THE SELECTED SWITCHES
MOVEM T1,F2 ;PUT OUT IN THE FLAG REGISTER
POPJ P, ;--ALL SET UP
PAGE
SUBTTL LOOKUP/ENTER SUBROUTINES
;SUBROUTINE TO RETURN THE NEXT FILE TO BE READ BY FORTRAN.
;IT RETURNS WITH THE EOCS BIT SET IN F. IF THIS IS THE
; LAST SPEC IN THE COMMAND STRING. IT SKIP RETURNS IF A
; FILE SPEC HAS BEEN FOUND.
;CALL WITH:
; PUSHJ P,NXTFIL
; NOTHING FOUND
; SPEC POINTER IN P1
NXTFIL:
MOVE T1,SRCJFN ;GET JFN
GNJFN ;SEE IF THERE IS ANOTHER FILE HERE
JRST NEWJFN ;NO MORE
JRST OPNSRC ;GOT ONE
;GET 1ST JFN FOR FILE
NEWJFN:
MOVE P1,CINPTR ;GET CURRENT SPEC POINTER
CAMN P1,LINPTR ;ARE WE DONE
POPJ P, ;YES - NONSKIP RETURN
ADDI P1,F.LEN ;UPDATE POINTER
MOVEM P1,CINPTR ;SAVE IT
PUSHJ P,XFILCV ;CONVERT SPEC BACK TO ASCII
HRRZI T1,SRCTAB ;SRC LONG JFN TABLE
MOVE T2,[POINT 7,FILSPC] ;NEW FILE SPEC
GTJFN
JRST SRCNUL ;TRY WITHOUT DEFAULT OF "FOR"
NOTFOR:
MOVEM T1,SRCJFN ;SAVE JFN
;WHAT SORT OF DEVICE DO WE HAVE
OPNSRC:
HRRZ T1,T1 ;ZERO LEFT
DVCHR
MOVE T3,FLAGS2## ;PREPARE TO SET TTY BIT
HLRZ T1,T1 ;GET DEVICE CODE
CAIN T1,TTCODE ;IS IT TTY?
JRST TTYSRC ;YES
;SRC NOT TTY:
TXZ T3,TTYINP ;NOTE NOT TTY:
MOVE T2,[XWD INBYT,READ] ;SET UP FOR OPEN
JRST GOTSRC
;TTY:
TTYSRC:
TXO T3,TTYINP ;NOTE TTY:
MOVE T2,[XWD TTYBYT,READ!WRITEE] ;SET UP FOR OPEN
;OPEN THE FILE
GOTSRC:
MOVEM T3,FLAGS2## ;SAVE THOSE FLAGS
HRRZ T1,SRCJFN ;GET JFN
OPENF
JRST FILERR ;PROBLEMS
MOVE T1,F.NAME(P1) ;SAVE FILE NAME FOR
MOVEM T1,CHNLTBL##+32 ; THE COMPILER
MOVE T1,F.EXT(P1) ; AND EXTENSION
MOVEM T1,CHNLTBL##+33
TXZ F,EOCS ;CLEAR END INPUT BIT
JRST .POPJ1## ;GOT FILE - SKIP RETURN
;TRY SRC WITHOUT "FOR"
SRCNUL:
MOVE T1,[GJ%SHT!GJ%OLD!GJ%IFG] ;FLAGS
MOVE T2,[POINT 7,FILSPC] ;ASCII FILE SPEC
GTJFN
JRST FILERR ;GIVE IT UP
JRST NOTFOR ;GOT IT WITH "NUL"
;SUBROUTINE TO CONVERT FILE SPEC BLOCK
;POINTED TO BY P1 INTO AN ASCII STRING
; AND PUT IT IN FILSPC
;CALL WITH
; P1 - SPEC POINTER
; PUSHJ XFILCV
; RETURN HERE
XFILCV:
MOVE T1,[ASCIZ /DSK:/] ;DEFAULT DEVICE
MOVEM T1,FILSPC ; FOR PPNST
MOVE T3,[POINT 7,FILSPC,27] ;PTR TO AFTER DEFAULT DEV:
SKIPN T2,F.DEV(P1) ;GET DEVICE NAME
JRST NODEV ;NONE THERE
SETZM T1,FILSPC ;CLEAR DEFAULT DEVICE
MOVE T3,[POINT 7,FILSPC] ;INITIAL POINTER
PUSHJ P,X6.7CV ;CONVERT
MOVEI T1,":" ;PUT IN COLON
IDPB T1,T3
NODEV:
MOVX T2,FX.DIR ;
TDNN T2,.FXMOD(P1) ;IS THERE A PPN?
JRST NOPPN ;NO
MOVE T2,F.DIRM(P1) ;IS PPN WILD?
AOJN T2,E.WILD ;YES == ERROR
MOVE T1,[POINT 7,FILSPC] ;PUT ANSWER HERE
MOVE T2,F.DIR(P1) ;GET PPN
MOVE T4,T3 ;SAVE PTR TO AFTER DEV: FOR DIRST
MOVE T3,T1 ;POINT TO DEV:
PPNST ;PPN TO DIRECTORY
ERJMP CHK1B ;DIDN'T WORK: CHECK FOR 1B
PPNOK: ;
MOVE T3,T1 ;T3 IS OUR FILE SPEC PTR
NOPPN: ;
SKIPN T2,F.NAME(P1) ;FILE NAME
JRST NONAM ;NOPE
PUSHJ P,X6.7CV ;CONVERT IT
NONAM:
HLLZS F.EXT(P1) ;CLEAR RIGHT HALF
SKIPE T2,F.EXT(P1) ;EXTENSION
JRST DODOT ;YES
MOVX T1,FX.NUL ;NULL EXT MASK
TDNE T1,F.MOD(P1) ;EXPLICITLY NULL?
JRST NULEXT ;NO
DODOT: MOVEI T1,"." ;PUT DOT IN
IDPB T1,T3
CAIE T2, ;DID WE HAVE A NAME
PUSHJ P,X6.7CV ;YES CONVERT
NULEXT:
MOVEI T1,0 ;NULL TERMINATOR
IDPB T1,T3
POPJ P, ;RETURN
;PPNST FAILED: IF IT FAILED BECAUSE THE JSYS WAS UNDEFINED,
; THEN WE MUST BE RUNNING ON VERSION 1B MONITOR AND CAN USE
; DIRST TO CONVERT THE PPN TO A DIRECTORY
CHK1B: ;
HRRZI T1,400000 ;GET PROCESS HANDLE
GETER ;WHY DID PPNST FAIL?
HRRZ T2,T2 ;REMOVE PROCESS HANDLE
CAIE T2,ILINS2 ;IS PPNST JSYS DEFINED?
JRST FILERR ;YES == VERSION 2 ERROR
HLRZ T2,F.DIR(P1) ;CHECK PROJECT #
CAIE T2,4 ;IS PROJ # = 4?
JRST PPN4ER ;NO == ERROR
HRRZ T2,F.DIR(P1) ;GET PROG # = DIRECTORY #
MOVE T1,T4 ;GET PTR TO AFTER DEV: SAVED ABOVE
MOVEI T3,"<" ;
IDPB T3,T1 ;PUT IN PUNCTUATION
DIRST ;PROG # TO DIRECTORY
JRST FILERR ;PPN ERROR
MOVEI T3,">" ;
IDPB T3,T1 ;PUT IN PUNCTUATION
JRST PPNOK ;
;ROUTINE TO CONVERT 6BIT TO 7BIT
;CALL WITH
; T3 = BYTE POINTER OF DESTINATION
; T2 = 6BIT NAME
; PUSHJ P,X6.7CV
; RETURN HERE
X6.7CV:
SETZM T1 ;CLEAR CHARACTER REG
LSHC T1,6 ;GET CHAR
CAIN T1,
POPJ P, ;DONE
ADDI T1," " ; TO 7BIT
IDPB T1,T3 ;STORE IT
JRST X6.7CV ;DO MORE
;ROUTINE TO PROCESS FILE ERRORS
; JRST FILERR
FILERR:
MOVE T1,[-1,,FLEHDR] ;MESSAGE HEADER
PSOUT ;TYPE IT
HRRZI T1,101 ;PRIMARY OUTPUT JFN
HRLOI T2,400000 ;CURRENT FORK,CURRENT ERROR
SETZM T3
ERSTR
JRST ERRERR ;UNKNOWN ERROR
JRST ERRERR ;PROBLEM
MOVE T1,[-1,,CRLFST] ;ADD CRLF
PSOUT
JRST ERRST ;TAKE IT FROM THE TOP
;ERROR HANDLING ERROR
ERRERR:
MOVE T1,[POINT 7,UNKFLE]
PSOUT
JRST ERRST ;RESTART
UNKFLE: ASCIZ /FILE ERROR - UNKNOWN
/
CRLFST: ASCIZ /
/
FLEHDR: ASCIZ /?FTNFER / ;ERROR MESSAGE PREFIX
;ROUTINE TO PROCESS WILD PPN ERRORS
E.WILD: MOVE T1,[POINT 7,WLDERR] ;GET ERROR MESSAGE
PSOUT ;DISPLAY IT
JRST ERRST ;GET OUT
WLDERR: ASCIZ /?FTNNWD Incorrect use of * or % in ppn
/
;PROJECT # MUST = 4 FOR DIRST JSYS ON TOPS-20 V1B
PPN4ER: ;
MOVE T1,[POINT 7,PRJERR] ;GET ERROR MESSAGE
PSOUT ;DISPLAY IT
JRST ERRST ;GET OUT
PRJERR: ASCIZ /?FTNPN4 Project number must be 4 in ppn
/
ERRST: ;ERROR ENTRY
SKIPE T1,CCLSW
JRST COMND
JRST FORTR1 ;LOOP BACK
;SUBROUTINE TO OPEN INCLUDE FILES
;CHECK TO SEE THAT THEY ARE DISK
;CALL WITH
; ICLPTR = ASCIII FILE SPEC POINTER
; PUSHJ P,OPNICL
; RETURN HERE
; VREG = 0 - OK
; OR
; VREG = ASCII ERROR STRING MESSAGE POINTER
OPNICL::
PUSH P,T1
PUSH P,T2
PUSH P,T3
HRRZI T1,ICLTAB ;LONG GTJFN INCLUDE FILE TABLE
MOVE T2,ICLPTR ;SPEC POINTER
GTJFN
JRST ICLNUL ;TRY WITHOUT DEFAULT "FOR"
NULX: MOVEM T1,ICLJFN ;SAVE JFN
MOVEM T2,ICLPTR ;SAVE POINTER TO LOOK FOR SWITCHES
;CHECK FOR DSK:
HRRZ T1,T1 ;ZERO LEFT
DVCHR
HLRZ T1,T1 ;GET DEVICE CODE
CAIE T1,DSKCOD ;DSK:?
JRST NOTDSK ;NO
HRRZ T1,ICLJFN ;GET JFN AGAIN
MOVE T2,[XWD INBYT,READ] ;SETUP FOR OPEN
OPENF
JRST ICLERR ;PROBLEMS
MOVEI VREG,0 ;GOOD RETURN
ICLRET: POP P,T3
POP P,T2
POP P,T1
POPJ P,
;TRY WITHOUT DEFAULT "FOR"
ICLNUL: MOVE T1,[GJ%SHT!GJ%OLD] ;FLAGS
MOVE T2,ICLPTR## ;FILE SPEC POINTER
GTJFN
JRST ICLERR ;DIDN'T HELP
JRST NULX ;OK GOT IT
NOTDSK: MOVE VREG,[POINT 7,NODSK] ;NOT DSK MESSAGE
JRST ICLRET
NODSK: ASCIZ /DEVICE MUST BE DISK/
ICLERR:
MOVE T1,[POINT 7,ICLEST] ;MESSAGE STORE AREA
HRLOI T2,400000 ;CURRENT FORK,CURRENT ERROR
HRLZI T3,-^D100 ;MESSAGE LIMIT
ERSTR
JRST ICLERR ;UNKNOWN
JRST ICLERR ;PROBLEM
MOVE VREG,[POINT 7,ICLEST] ;MESSAGE POINTER
JRST ICLRET
ICLEER: MOVE VREG,[POINT 7,UNKFLE] ;UNKNOWN ERROR
JRST ICLRET
;ROUTINE TO CLOSE THE ICL FILE
;CALL WITH
; PUSHJ P,CLOICL
; RETURN HERE
CLOICL::
PUSH P,T1
HRRZ T1,ICLJFN ;GET JFN
CLOSF
JFCL 0,0
POP P,T1
POPJ P,
;SUBROUTINE TO PSOUT A STRING FROM BLISS
; [1563] /PLB
TTYSTR::
PUSH P,T1 ;SAVE AC 1
HRRO T1,-2(P) ;GET -1,,ADDR
PSOUT ;OUTPUT
POP P,T1 ;RESTORE
POPJ P,
;SUBROUTINE TO SIMULATE AN EXIT UUO
; [1563] /PLB
EXITUUO::
PUSH P,T1 ;SAVE AC 1
HRROI T1, [ASCIZ /
Exit/] ;BE LIKE TOP-10 (ALMOST)
PSOUT ;STUFF IT
POP P,T1 ;RESTORE
HALTF
JRST .-1
;SUBROUTINE TO PERFORM MAG TAPE OPERATIONS
;CALL WITH:
; MOVEI P1,FILE-SPEC-POINTER
; PUSHJ P,MTAOP
; RETURN HERE WITH TAPE POSITIONED
MTAOP: POPJ P, ;NULL FOR NOW
;SUBROUTINE TO SET UP T1 AS A MODE WORD FOR MAG TAPES
;CALL WITH:
; MOVEI P1,FILE-SPEC-POINTER
; PUSHJ P,MTAOP
; RETURN HERE WITH T1 SET UP
MTMODE: SETZM T1 ;START WITH A CLEAN SLATE
POPJ P, ;RETURN
XLIST ;Literals
LIT:: LIT
LIST
> ;END TOPS-20 COMMAND PROCESSOR
END FORTRAN