Trailing-Edge
-
PDP-10 Archives
-
FORTRAN-10_V7wLink_Feb83
-
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
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1972, 1983
;AUTHOR: Dave Eklund
INTERN COMMAV
COMMAV= BYTE (3)0(9)7(6)0(18)1656 ; Version Date: 25-Oct-82
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.
***** End Revision History *****
\
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
;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
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 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+^D600 ;[1445,1654] 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
; 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>>>
DEFINE RESETUUO <CALLI 0>
DEFINE RESETJSYS <JSYS 147>
DEFINE RESET <PRINTX ?DO NOT USE RESET - USE RESETUUO OR RESETJSYS>
PAGE
SUBTTL Compiler Switches
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
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
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.
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> ;[1652]
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]
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
MOVE T1,F2 ;GET SWITCHES
TXNN T1,SW.GFL ;WAS /GFL REQUESTED?
JRST GFLOK ;NO, WE ARE ALL SET TO GO!
JRST GFLSUP ;[1621] GFLOATING not yet supported
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 DEFAULT NOWARN DATA ANSWERS
NOWCLR: SETZM NWBITS ;[1115] CLEAR THE KEYWORD DATA
MOVE T1,[NWBITS,,NWBITS+1] ;[1115] AND THE MASKS
BLT T1,<NWMASK+NWWDCT-1> ;[1115]
POPJ P, ;[1115] DONE
;[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
;[1115] SUBROUTINE TO SETUP FOR SWITCH.INI PROCESSING
NOWSAV: MOVE T1,[NWBITS,,NWSAVB] ;[1115] MOVE COMMAND LINE DATA AND
BLT T1,<NWSAVM+NWWDCT-1> ;[1115] MASKS TO SAVE AREA
PUSHJ P,NOWCLR ;[1115] DEFAULT NOWARN ANSWERS
POPJ P, ;[1115] RETURN TO PROCESS SWITCH.INI
;[1115] SUBROUTINE TO MERGE COMMAND LINE/SWITCH.INI NOWARN ANSWERS
NOWMRG: 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
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
;[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