Trailing-Edge
-
PDP-10 Archives
-
BB-4157F-BM_1983
-
fortran/compiler/cmnd20.mac
There are 12 other files named cmnd20.mac in the archive. Click here to see a list.
TITLE CMND20 - The FORTRAN-20 Command Scanner
SUBTTL Randall Meyers/PLB/CDM/SRM/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 1982, 1983
;AUTHOR: Randall Meyers
INTERN COMMAV
COMMAV= BYTE (3)0(9)7(6)0(18)1711 ; Version Date: 7-Jan-83
SUBTTL Revision History
Comment \
***** Begin Revision History *****
***** Begin Version 7 *****
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 and,
EXITUUO routine to simulate CALLI 12
1600 PLB 9-Jul-82
TOPS-20 Native hacks. Supplies routine CORUUO, and PSI support
1602 RVM 14-Jul-82
Implement the TOPS-20 Native Scanner.
1603 RVM 16-Jul-82
Make .DEBUG preserve T2 so that a switch may follow /DEBUG. Remove
square brackets around the CCL "FORTRAN: etc." message. Disable
CONTROL/H recovery under batch, so that an error in a command
will not effect the next command line (otherwise, the next command
tries to hang, waiting for a CONTROL/H).
1611 RVM 6-Aug-82
Many command scanner changes to fix bugs, incorporate suggestions,
and to add features. Major changes: Exit compiler after processing
PRARG block. Rewrite /RUN code. Add /HELP. Rename /OBJECT and
/NOOBJECT to be /BINARY and /NOBINARY. Improve error message maker.
Add /DFLOATING.
1612 PLB 13-August-82
Trap code cleanup for edit 1600
1613 CDM 13-Aug-82
Change /DEBUG:PARAMETERS to /DEBUG:ARGUMENTS
1623 RVM 26-Aug-82
TOPS-20 command scanner: Do a CLZFF% before each command read
from the primary input stream in order close all files and
release all JFNs. This fixes the problem of unreleased JFNs
when a command or compile is aborted due to a catastrophic
error. A consequence of this edit is that the compiler cannot
keep a JFN on SWITCH.INI across compiles.
1631 RVM 1-Sep-82 Q20-03013
If the PRARG block overflows, the EXEC writes out TMP files to
disk. The TOPS-20 command scanner didn't look on disk for its
arguments if it found a null PRARG block.
1632 RVM 1-Sep-82
The TOPS-20 compiler does not reclaim its data area after a
compile. The locations .JBFF and .JBREL were only being set
once when the compiler started, rather than after each compile.
1636 RVM 28-Sep-82
Make /EXTEND and /NOEXTEND invisible, as they are not supported
aspects of the FORTRAN product.
1643 RVM 11-Oct-82
If the EXEC's arguments to the compiler do not exist in a PRARG
block or on disk, then do not complain, just accept commands from
the terminal. Also, add the ;T(emporary) attribute to the filespec
for the disk file which holds the EXEC arguments.
1645 RVM 15-Oct-82
Add the /NOECHO switch to the TOPS-20 command scanner, and change
a nested /TAKE which does not specify /ECHO or /NOECHO to use the
current value of the echo flag.
1652 CDM 20-Oct-82
Add RIM to NOWARN switch.
1654 SRM 21-Oct-82
Increased PDLLEN from 2100 to 2200 to allow FM045.FOR in the
validation tests to work.
1656 CKS 25-Oct-82
Change PLP warning to TSI.
1657 RVM 27-Oct-82
Improve the "Error occured while processing ..." message from
the TOPS-20 command scanner.
1671 RVM 11-Nov-82
The TOPS-20 command scanner had problems when the compiler was
reSTARTed because the COMND% JSYS state block was not being
reset.
1672 RVM 11-Nov-82
The TOPS-20 command scanner complained overmuch if the user's
SWITCH.INI file was offline. The scanner no longer complains
if the switch file is offline. I/O errors while reading the
switch file now produce warning instead of error messages,
and the warnings are now followed by a message stating that
the problem occurred while reading the switch file.
1673 RVM 11-Nov-82
Make the error message about nesting /TAKE commands too deep
a warning message and recover from the error by just ignoring
the errant command and continuing to process the nested /TAKEs
already in process. This has the nice property that the user
can recover by issuing the ignored /TAKE command when prompted
again by the compiler.
1701 RVM 13-Dec-82 Q20-06057
Remove the abbreviation for the /NOOBEJCT switch since
that swich will disappear as soon as the EXEC no longer
needs it.
1705 PLB 21-Dec-82
Fix BLT word in CORUUO to zero more than one word.
1711 RVM 7-Jan-83
Make /O mean /OPTIMIZE, just as advertised. Also, have
the compiler to exit if the primary input designator is
invalid (this lets the compiler run as a background fork).
***** End Revision History *****
\
SEARCH JOBDAT,MONSYM,MACSYM
SEARCH GFOPDF ;Define GFLOATING instructions
EXTERN PHAZCONTROL
EXTERN CLOSUP ;Close everything
ENTRY NXTFIL ;Opens next source file for compiler
ENTRY OPNICL ;Open the include file for the compiler
INTERN NWBITS ;The flags of warnings have been suppressed
INTERN NWKTBC ;The number of warning message mnemonics
INTERN NWKTB ;The table of sixbit warning message mnemonics
INTERN MRP0 ;Execute-only entry
INTERN FORTRA ;Start address of FORTRA
EXTERN .HIGH. ;Start of compiler's high segment (Defined by
; a /SET switch to LINK)
EXTERN ISN ;Statement number of line being compiled
EXTERN ICLPTR ;Points to INCLUDE filespec
EXTERN CCLSW ;Contains 0 or 1, the start address offset used
; to start FORTRA
EXTERN STACK ;The stack used by BLISS
EXTERN CTIME ;The current time of day
EXTERN RTIME ;The runtime of this fork
EXTERN DEBGSW ;Holds the debug switches
EXTERN BUGOUT ;Holds BUGOUT mask for debugging the compiler
EXTERN FLAGS2 ;A flag word
EXTERN F2 ;A flag word
EXTERN CHNLTBL ;Holds filenames and JFNs for the compiler
EXTERN SEGINCORE ;Argument to PHAZCONTROL
SALL
DEBUG==0 ;Turn on tracing
FTUS==0 ;Turn on DEC in-house features
BUFSIZ==^D96 ;Length (words) of command line buffer
ATMBLN==^D34 ;Length (words) of atom buffer
MAXFILES==^D20 ;Maximum number of sources files in one command
TMPLEN==200 ;Length of the PRARG block
PDLLEN==^D2200+^D600 ;[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.
TWOSEG 400000
;AC'S USED BY COMMAND SCANNER
F==0 ;Known as FLGREG by the compiler.
T1==1 ;TEMP
T2==2 ; ..
T3==3 ; ..
T4==4 ; ..
T5==5 ; ..
T6==6 ; ..
P1==7 ;PRESERVED AC
P2==10 ; ..
P3==11 ; ..
P4==12 ;
P5==13 ;
P6==14 ;
VREG=15 ;BLIS10 VALUE RETURN REG
FREG=16 ;BLIS10 FRAME POINTER
SREG=17 ;BLIS10 STACK POINTER
OPDEF PJRST [JRST] ;PUSHJ and POPJ
OPDEF NOOP [TRN] ;Fastest No-op in machine
.NODDT PJRST,NOOP
FRMTTY==0 ;Command input comes from terminal
FRMPRA==1 ;Command input comes from PRARGs
FRMTAK==2 ;Command input comes from /TAKE file
FRMSWI==3 ;Command input comes from SWITCH.INI
FRMTEN==4 ;Command input is under TOPS-10 compatibility
SUBTTL Low Segment Data Area
RELOC 0
RUNCOD: ;[1611] This code rewritten
RUNJFN: XWD .FHSLF,.-. ; 0- .-. gets JFN of file to run
EXP -1 ; 1-Throw away pages
XWD .FHSLF,0 ; 2-Of this fork starting at page zero
EXP PM%CNT+1000 ; 3-and going through to the last page
PMAP% ; 4-Throw away pages
MOVE 1,0 ; 5-Get JFN of file to run
GET% ; 6-Map its pages
RESET% ; 7-Reset the world
RUNSTO: MOVEM 15,.JBERR ;10-Store old value of .JBERR
MOVEI 1,.FHSLF ;11-This fork
MOVE 2,14 ;12-Get value of start address offset
SFRKV% ;13-Start this fork
RUNOFF: EXP .-. ;14- .-. gets start address offset
RUNERR: EXP .-. ;15- .-. gets old value of .JBERR
ICLEST: BLOCK 24 ;STORE AREA FOR INCLUDE FILE ERROR MESSAGE
APRSV1: BLOCK 1
APRSV2: BLOCK 1
APRSV3: BLOCK 1
; DEFAULT TABLE FOR INCLUDE INPUT
ICLTAB: GJ%OLD ;FLAGS,VERSION DEFAULT
XWD .NULIO,.NULIO ;NO JFN'S
0 ;DEV
0 ;DIRECTORY
0 ;FILE NAME
XWD -1,[ASCIZ \FOR\] ;EXTENSION
0 ;PROTECTION
0 ;ACCOUNT
;State block for COMND% JSYS
STATE: XWD 0,0 ;Flags,,Reparse address
XWD .PRIIN,.PRIOU ;Input JFN,,Output JFN
EXP 0 ;Pointer to Command Prompt
POINT 7,BUFF ;Pointer to command buffer
POINT 7,BUFF ;Pointer to next text to parse
EXP 5*BUFSIZ ;# of Chars unused in buffer
EXP 0 ;# of Chars unparsed in buffer
POINT 7,ATMBUF ;Pointer to atom buffer
EXP 5*ATMBLN ;# of chars in atom buffer
EXP CJFNBK ;Pointer to GTJFN% block
BUFF: BLOCK BUFSIZ ;Command buffer for COMND% JSYS
ATMBUF: BLOCK ATMBLN ;Atom buffer for COMND% JSYS
DEFFIL: BLOCK ATMBLN ;Holds default filename for /LIST & /OBJECT
LSTTYP: BLOCK ATMBLN ;Holds user's typescript if he gives value to
;/LIST
INIFIL: BLOCK ^D19 ;Holds filename of SWITCH.INI file
CMDSOU: BLOCK 1 ;Source code,,Optional JFN of COMND% input
ERRPFX: BLOCK 1 ;Pointer to prefix of error message line
OLDSTK: BLOCK 1 ;Used to restore the stack pointer
CJFNBK: BLOCK .GJATR+1 ;Block for GTJFN%
PRAFIL: ASCIZ \/TAKE:000NFO.TMP;T
\ ;[1643] Used to read EXEC args if PRARG fails
$F==0 ;Offset into ONFLG/OFFFLG for F switch word
$F2==1 ;Offset into ONFLG/OFFFLG for F2 switch word
$FLAGS2==2 ;Offset into ONFLG/OFFFLG for FLAGS2 switch wd
$DEBGSW==3 ;Offset into ONFLG/OFFFLG for DEBGSW switch wd
$BUGOUT==4 ;Offset into ONFLG/OFFFLG for BUGOUT switch wd
NUMFLGS==5 ;Number of flags
DEFFLG: EXP RELFLG ;Default for F switch word
EXP SW.F77 ;Default for F2 switch word
EXP 0 ;Default for FLAG2 switch word
EXP 0 ;Default for DEBGSW switch word
EXP 0 ;Default for BUGOUT switch word
ONFLG: BLOCK NUMFLGS ;The flags that must be turned on
OFFFLG: BLOCK NUMFLGS ;The flags that must be turned off
SONFLG: BLOCK NUMFLGS ;Holds ON flags from command line
;during SWITCH.INI processing.
SOFFLG: BLOCK NUMFLGS ;Holds OFF flags from command line
;during SWITCH.INI processing.
INCFIL: BLOCK 1 ;JFN of include file
RELFIL: BLOCK 1 ;JFN of object file
LSTFIL: BLOCK 1 ;JFN of list file
CNTIDX: BLOCK 1 ;Index in FORFIL to currently open source file
FORIDX: BLOCK 1 ;Index to get last source file JFN in FORFIL
FORFIL: BLOCK MAXFILES ;JFN's of source files
JOBNUM: BLOCK 1 ;[1631] Job number
XJBFF: BLOCK 1 ;[1632] Holds .JBFF across compiles
XJBREL: BLOCK 1 ;[1632] Holds .JBREL across compiles
BATCH: BLOCK 1 ;Flag: Is this a batch job?
TDEPTH: BLOCK 1 ;Level of nesting of /TAKE: files
ECHOFLG:BLOCK 1 ;Flag: Is command to be echoed?
OPTECHO:BLOCK 1 ;Flag: Are option lines from SWITCH.INI echoed?
NOPTION:BLOCK 1 ;Flag: Has /NOOPTION been seen?
OPTION: BLOCK 10 ;Storage for option string--stores 39 chars
ARGBLK: BLOCK TMPLEN ;Area to hold Process Args
DEFINE TRACE(S)<
IFN DEBUG,<
PUSH SREG,T1
HRROI T1,[ASCIZ \
Got to 'S
\]
PSOUT%
POP SREG,T1>
>
SUBTTL Compiler Initialization
RELOC 400000
MRP0: ;Label used by PHAZCONTROL, becomes starts address
FORTRA: TDZA VREG,VREG ;Flag as normal entry
MOVEI VREG,1 ;Flag as CCL entry
MOVEM VREG,CCLSW ;Save the CCL switch
RESET%
GETNM% ;[1612] Get the name of the program
MOVE T2,T1 ;[1612] Private name is name returned by GETNM%
MOVE T1,[SIXBIT \FTN 7\] ;System name
SETSN% ;Let's tell the Monitor!
NOOP ;Failure return, we don't care!
MOVEI T1,.FHSLF ;This process's compatibility vector
SETO T2, ;Do not allow UUOs
SCVEC%
HLRZ T1,.JBSA ;Get first free low-segment start address
HRRM T1,.JBFF ;"Deallocate" core
HRRM T1,.JBREL ;"Deallocate" core
MOVE SREG,[IOWD PDLLEN,STACK] ;Set up the stack
HRRZI FREG,(SREG) ;LIFE IS BLISS
PUSHJ SREG,APRINI ;Initialize interrupt system
SETZM ECHOFLG ;[1645] Assume that commands are not echoed
SETZM STATE+.CMFLG ;[1671] No reparse address or flags
MOVE T1,[XWD .PRIIN,.PRIOU] ;[1671] JFNs for command input, output
MOVEM T1,STATE+.CMIOJ ;[1671] Restore JFNs
MOVE T1,[POINT 7,BUFF] ;[1671] Pointer to command buffer
MOVEM T1,STATE+.CMBFP ;[1671]
MOVEM T1,STATE+.CMPTR ;[1671]
MOVX T1,5*BUFSIZ ;[1671] # Chars unused in buffer
MOVEM T1,STATE+.CMCNT ;[1671]
SETZM STATE+.CMINC ;[1671] # Chars unparsed in buffer
;**********************************************************************
;
; Test for the presence of the gfloating microcode. This code will
; turn on or off the GFMCOK flag in the default word for FLAGS2.
;
;**********************************************************************
SETZB T2,T3 ;Clear T2 & T3 so we can do a GFAD on it
SETZ T4, ;Clear T4 to assume don't have gfloating ucode
GFAD T2,T2 ;Do a typical gfloating instruction
ERJMP INTDON ;Oh, no! No gfloating microcode!
MOVX T4,GFMCOK ;Yes, we have the gfloating microcode
INTDON: IORM T4,DEFFLG+$FLAGS2 ;Set GFMCOK flag in the defaults for FLAGS2
SUBTTL Get Name of SWITCH.INI file
;**********************************************************************
;
; Get name of the user's SWITCH.INI file.
;
;**********************************************************************
;Rewritten edit 1623
SETO T1, ;Get info about this job
MOVE T2,[XWD -<.JILNO+1>,BUFF] ;-Length,,address
MOVEI T3,.JIJNO ;First thing that we are interested in
GETJI%
ERCAL UNXERR ;Failure return
MOVE T1,BUFF+.JIJNO ;[1631] Get job number
MOVEM T1,JOBNUM ;[1631] Store
MOVE T1,BUFF+.JIBAT ;Get batch flag
MOVEM T1,BATCH ;Store
HRROI T1,INIFIL ;Area to receive name of switch file
MOVE T2,BUFF+.JILNO ;Get number of logged-in directory
DIRST%
ERCAL UNXERR ;Failure return
MOVEI P1,^D11 ;Source is ten characters
MOVE P2,[POINT 7,[ASCIZ \SWITCH.INI\]] ;Source byte pointer
SETZB P3,P6 ;No second word in byte pointers
MOVEI P4,^D11 ;Destination to receive ten characters
MOVE P5,T1 ;Destination Byte pointer
EXTEND P1,[MOVSLJ ;Copy the string
0]
NOOP
SUBTTL Process Fork Argument from the EXEC
;**********************************************************************
;
; Read and process the proccess arguments set up by the EXEC. The
; EXEC sets up the process arguments when it calls FORTRA to do
; a COMPILE, EXECUTE, etc. EXEC command.
;
;**********************************************************************
SKIPN CCLSW ;Was FORTRA started at the CCL entry point?
JRST MAIN ;No--Don't try to get process arguments
MOVE T1,[XWD .PRARD,.FHSLF] ;Read arguments for this fork
MOVEI T2,ARGBLK ;Area in which to get arguments
MOVEI T3,TMPLEN ;Length of area to hold text
PRARG%
SKIPG T1,ARGBLK ;Get number of "files" in TMPCOR
JRST DSKTMP ;[1631] Get arguments from file on disk
LOOP: MOVE T2,ARGBLK(T1) ;Get displacement of file in TMPCOR
HLRZ T3,ARGBLK(T2) ;Get header of first file
CAIN T3,(SIXBIT \NFO\) ;Have we got the file we want?
JRST FOUND ;Yes--process it
SOJG T1,LOOP
JRST MAIN
FOUND: HRRZ P1,ARGBLK(T2) ;Get length (in words) of TMP file
IMULI P1,5 ;Get length (in characters) of TMP file
MOVEI P2,ARGBLK+1(T2) ;Get address of string in TMP file
HRLI P2,(POINT 7,0,-1) ;Make into a byte pointer
SL2: HRLZI T1,FRMPRA ;The command stream is the process arguments
MOVE T2,[XWD .NULIO,.NULIO] ;COMND% will not have to do I/O
HRROI T3,[ASCIZ \FORTRAN>\] ;Prompt pointer
PUSHJ SREG,CMDINI ;Init COMND% JSYS and its state block
MOVE P3,STATE+.CMCNT ;Get length of receiving area
MOVE T1,STATE+.CMPTR ;Get byte pointer to command buffer
L2: ILDB T2,P2 ;Get a character from TMP file
IDPB T2,T1 ;Deposit in command buffer
SOJE P1,GOTSTR ;Jump if no more text in TMP file
CAIN T2,.CHLFD ;Was character linefeed?
SOJA P3,GOTSTR ;Yes--Got the command string
SOJGE P3,L2 ;If room still in command buffer, loop
HRROI T1,[ASCIZ \FTNCMD Command passed by EXEC is too long
\]
ESOUT%
JRST MAIN
GOTSTR: SETZM TDEPTH ;No take files nested here!
EXCH P3,STATE+.CMCNT ;Move into memory the length of unused buffer
SUB P3,STATE+.CMCNT ;Get the number of unparsed characters
MOVEM P3,STATE+.CMINC ;Store number of unparsed chars in state block
PUSHJ SREG,SCAN20 ;Scan the command line
MOVE T1,P2 ;Get copy of pointer to text in TMP file
ILDB T2,T1 ;Get next character
JUMPE T2,PFAHLT ;[1611]If char is null, then got end of command
JUMPN P1,SL2 ;Continue processing if more text
PFAHLT: HALTF% ;[1611] Through processing fork arguments
JRST MAIN ;[1631] User typed "CONTINUE" ...
SUBTTL Process TMP file on DSK:
;[1631] This routine added by RVM
DSKTMP: HRLZI T1,FRMPRA ;The command stream is the process arguments
MOVE T2,[XWD .NULIO,.NULIO] ;COMND% will not have to do I/O
HRROI T3,[ASCIZ \FORTRAN>\] ;Prompt pointer
PUSHJ SREG,CMDINI ;Init COMND% JSYS and its state block
MOVE T1,JOBNUM ;Get job number
IDIVI T1,^D100 ;Get hundreds digit
MOVE T3,T1 ;Store hundreds digit
MOVE T1,T2 ;Get remainder of job number
IDIVI T1,^D10 ;Get tens and ones digits
LSH T3,7 ;Make room for tens digit
ADD T3,T1 ;Add in tens digit
LSH T3,7 ;Make room for ones digit
ADD T3,T2 ;Add in ones digit
LSH T3,^D8 ;Position in order to form filename
ADDM T3,PRAFIL+1 ;Form filename of TMP file
MOVX T1,GJ%SHT+GJ%OLD+GJ%TMP ;[1643] An existing TMP file
MOVE T2,[POINT 7,PRAFIL+1,6] ;[1643] Filename is in PRAFIL
GTJFN% ;[1643] Get a JFN to see if file exists
ERJMP MAIN ;[1643] Can't read file--get commands from tty
MOVE T1,[XWD PRAFIL,BUFF] ;From PRAFIL to BUFF
BLT T1,BUFF+4 ;[1643] Move the command string+null byte
SETZM TDEPTH ;No take files nested here (yet)!
MOVEI T1,^D20 ;[1643] Number of characters in command
MOVEM T1,STATE+.CMINC ;Store number of unparsed chars in state block
SUB T1,STATE+.CMCNT ;Get - number of unparsed characters
MOVNM T1,STATE+.CMCNT ;Store number of unparsed characters
PUSHJ SREG,SCAN20 ;Scan the command line
MOVX T1,.FHSLF+CZ%NIF+CZ%ABT ;Abort I/O for this process
CLZFF% ;Close open files and release all JFNs
MOVX T1,GJ%SHT+GJ%OLD+GJ%TMP ;[1643] Get a JFN on an old TMP file
MOVE T2,[POINT 7,PRAFIL+1,6] ;Filename pointer
GTJFN%
ERCAL UNXERR ;Unexpected error
HRRZ T1,T1 ;Zero left half of T1
DELF% ;Delete the TMP file
ERCAL UNXERR ;Unexpected error
HALTF% ;Done
SUBTTL Main Command Loop of the Compiler
;**********************************************************************
;
; This is the main command loop of the compiler. It is responsable
; for calling SCAN20 or SCAN10 to process a command line input from
; the terminal.
;
;**********************************************************************
MAIN:
SKIPE BATCH ;Are we running under batch?
JRST GOTBAT ;Yes--Might have to do -10 compatability stuff
NOTBAT: MOVX T1,.FHSLF+CZ%NIF+CZ%ABT ;[1623] Abort I/O for this process
CLZFF% ;[1623] Close open files and release all JFNs
SETZM TDEPTH ;No take files are nested here!
HRLZI T1,FRMTTY ;COMND% input comes from terminal
MOVE T2,[XWD .PRIIN,.PRIOU] ;Input from terminal,,ouput to terminal
HRROI T3,[ASCIZ \FORTRAN>\] ;Prompt pointer
PUSHJ SREG,CMDINI ;Init COMND% JSYS and its state block
PUSHJ SREG,SCAN20 ;Scan a TOPS-20 command line
JRST NOTBAT
GOTBAT: MOVX T1,.FHSLF+CZ%NIF+CZ%ABT ;[1623] Abort I/O for this process
CLZFF% ;[1623] Close open files and release all JFNs
MOVEI T1,"*" ;The batch prompt
PBOUT%
SETZM TDEPTH ;No take files are nested here!
MOVE T2,STATE+.CMBFP ;[1603] Disable CONTROL/H feature under batch
MOVEM T2,STATE+.CMPTR ;[1603] Disable CONTROL/H feature under batch
MOVE T2,[POINT 7,BUFF] ;This is the COMND% JSYS buffer
SETZ P1, ;No charaters read Yet
BATLP: PBIN% ;Get a character
AOJ P1, ;Got another character
CAILE P1,BUFSIZ*5 ;Have we exceeded the size of the buffer?
JRST CMDOVL ;Yes--Buffer overflowed!
IDPB T1,T2 ;Store character in COMND%'s buffer
CAIE T1,"," ;Is this character a comma?
CAIN T1,"=" ;Is this character an equal sign?
JRST TOPS10 ;Yes--Got a TOPS-10 command
CAIE T1,"+" ;Is this character an plus sign?
CAIN T1,"?" ;Is this character a question mark?
JRST TOPS20 ;Yes--Got a TOPS-20 command
CAIE T1,.CHCNF ;Is this character a CONTROL/F?
CAIN T1,.CHESC ;Is this character an escape?
JRST TOPS20 ;Yes--Got a TOPS-20 command
CAIE T1,.CHCNV ;Is this character a CONTROL/V?
CAIN T1,.CHLFD ;Is this character a linefeed?
JRST TOPS20 ;Yes--Got a TOPS-20 command
CAIE T1,.CHFFD ;Is this character a form feed?
JRST BATLP ;No--Go get another character
TOPS20: HRLZI T1,FRMTTY ;COMND% input comes from terminal
MOVE T2,[XWD .PRIIN,.NULIO] ;Input from terminal,,ouput to nowhere
HRROI T3,[ASCIZ \FORTRAN>\] ;Prompt pointer
PUSHJ SREG,CMDINI ;Init COMND% JSYS and its state block
MOVEM P1,STATE+.CMINC ;Store number of unparsed characters
MOVN P1,P1 ;Get ready to subtract from free buffer space
ADDM P1,STATE+.CMCNT ;Decrease the amount of free buffer space
PUSHJ SREG,SCAN20 ;Scan a TOPS-20 command line
JRST GOTBAT
TOPS10: MOVSI T1,FRMTEN ;COMND% input processed under -10 compatibility
MOVE T2,[XWD .PRIIN,.NULIO] ;Input from terminal,,ouput to nowhere
HRROI T3,[ASCIZ \*\] ;Prompt pointer
PUSHJ SREG,CMDINI ;Init COMND% JSYS and its state block
MOVEM P1,STATE+.CMINC ;Store number of unparsed characters
MOVN P1,P1 ;Get ready to subtract from free buffer space
ADDM P1,STATE+.CMCNT ;Decrease the amount of free buffer space
PUSHJ SREG,SCAN10 ;Scan a TOPS-10 command line
JRST GOTBAT
CMDOVL: HRROI T1,[ASCIZ \FTNCMD Command too big for internal buffer
\]
ESOUT%
JRST GOTBAT
SUBTTL UNXERR -- Unexpected JSYS error
;************************************************************************
; This rouine is used when an unexpected JSYS error occurs
; Added by edit 1623.
;************************************************************************
UNXERR: HRROI T1,[ASCIZ \FTNCMD Unexpected JSYS error at PC \]
ESOUT%
MOVEI T1,.PRIOU ;Output to primary output stream
HRRZ T2,(SREG) ;Get the return address from the PC
SOJ T2, ;Back the PC over the call
MOVX T3,NO%ZRO+FLD(6,NO%COL)+FLD(^D8,NO%RDX) ;6 col. octal #
NOUT% ;Output number
NOOP ;Pretty bad if this fails
HRROI T1,[ASCIZ \
\]
PSOUT%
HALTF% ;Halt this fork
POPJ SREG, ;Brave person typed "CONTINUE"--so return
SUBTTL NXTFIL -- Open Next Source File
;***********************************************************************
; This routine is called by the compiler to open the next source file.
;***********************************************************************
NXTFIL:
AOS T4,CNTIDX ;Get index into FORFIL of source file to open
CAMLE T4,FORIDX ;Have all the files been opened?
POPJ SREG, ;Yes--Take failure return
PUSH SREG,P1 ;Save P1
PUSH SREG,P2 ;Save P2
MOVE P1,FORFIL(T4) ;Get JFN of list file
MOVE T1,P1 ;Get JFN of list file
DVCHR% ;Get characteristics of source file
LDB T1,[POINTR(T1,DV%TYP)] ;Get device type
MOVX T3,TTYINP ;Get bit that indicates TTY input
CAIE T1,.DVTTY ;Is it a terminal?
JRST NOTTTY ;No--Don't need to do anything
IORM T3,FLAGS2 ;Set TTY input flag
MOVX T2,FLD(7,OF%BSZ)+OF%RD+OF%WR ;Byte size is 7, allow read&write
JRST OPNSOU ;Open the source file
NOTTTY: ANDCAM T3,FLAGS2 ;Clear TTY input bit
MOVX T2,OF%RD ;Open file for writing, ASCII 36 bit bytes
OPNSOU: MOVE T1,P1 ;Get JFN of next source file
OPENF%
ERJMP [MOVE T1,XJBFF ;[1632] Restore value of .JBFF
MOVEM T1,.JBFF ;[1632]
MOVE T1,XJBREL ;[1632] Restore value of .JBREL
MOVEM T1,.JBREL ;[1632]
JRST MONERR]
MOVEI P2,CHNLTBL+^D20 ;Get address of the source file CHNLTBL entry
PUSHJ SREG,LDCHNL ;Load CHNLTBL entry of object file
TXZ F,EOCS ;Clear end of command string flag
POP SREG,P2 ;Restore P2
POP SREG,P1 ;Restore P1
AOS (SREG)
POPJ SREG, ;Take success return
SUBTTL TRAP handling routines
;
; Subroutine to initialize for 'APR' trapping
;
; SET UP TRAPS 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:
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
MOVE T2, .JBREL ;[1600] END OF CORE (REFERENCES PG 0)
ORI T2, 777 ;[1612] END OF PAGE-IFY
MOVEI T3, 1777 ;[1600] START AT END OF PAGE 1
APR.1: CAMLE T3, T2 ;[1612] DONE YET?
JRST APR.2 ;[1612] YES, ACTIVATE INTERUPTS
SKIP (T3) ;[1612] NO, REFERENCE THIS PAGE
ADDI T3, 1000 ;[1612] BUMP UP 1 PAGE
JRST APR.1
APR.2: MOVE T2,[CHNMSK] ;[1600] ARM PROPER CHANNELS
AIC% ;[1600] ENABLE INTERUPT CHANNELS
POPJ SREG, ;[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-EXISTENT PAGE
BLOCK ^D35-. ;[1600] (23-35)
DEPHASE ;[1600] *** END OF PHASE 0 ***
SUBTTL CORE UUO Simulation Routines
; NEW [1600] /PLB
; Simulate CORE UUO for Twenex
CORUUO::
PUSH SREG, T1
PUSH SREG, T2
MOVEI T1, .HIGH. ;GET HI-SEGMENT ORIGIN
CAMG T1, -3(P) ;LARGER THEN REQUESTED CORE BREAK?
PUSHJ SREG, CORERR ;'FRAID SO
MOVEI T1, .FHSLF ;THIS PROCESS
MOVEI T2, 1B<.ICNXP> ;NON-EXISTENT PAGE TRAP
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 OLD CORE
SETZM (T1) ;ZERO FIRST WORD
HRL T1, T1 ;PREPARE FOR BLT
AOJ T1, ;[1705] BUMP RIGHT HALF FOR SMEAR
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 SREG, T2
POP SREG, T1
POPJ SREG,
SUBTTL Misc. Error Utility Routines
; 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
MOVEM T3,APRSV3 ;[1612] STORE T3
SOS T1,0(P) ;WHERE WERE WE CALLED FROM
HRRZM T1,.JBTPC ;STORE ADDRESS
HRROI T2,[ASCIZ \?FTNUCE User Core Exceeded\] ;LOCATE MESSAGE
JRST APRTR4 ;FINISH MESSAGE
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, [ASCIZ \Illegal Memory Reference\] ;[1600] GENERIC NXM
TLNE T1, (PF%WRT) ;[1600] PAGE FAIL ON WRITE?
HRROI T2, [ASCIZ \Non-existent memory write\]
TRNA
IRDTRP: HRROI T2, [ASCIZ \Illegal memory read\]
TRNA
IWRTRP: HRROI T2, [ASCIZ \Illegal memory write\]
TRNA
POVTRP: HRROI T2,[ASCIZ \Stack exhausted\] ;PDL OVERFLOW
HRROI T1,[ASCIZ \
?Internal Compiler Error
?\]
PSOUT%
APRTR4: HRRO T1,T2 ;GET ERROR STRING
PSOUT%
HRROI T1,[ASCIZ \ at location \]
PSOUT%
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,[ASCIZ \ in Phase \]
PSOUT%
MOVE T2,[POINT 6,GETSBL##+1] ;TYPE SEGMENT NAME
APRTR3: ILDB T1,T2 ;LOAD BYTE
MOVEI T1," "(T1) ;TO ASCII
PBOUT% ;[1600] TYPE BYTE
TLNE T2,770000 ;TYPE 6 CHARACTERS
JRST APRTR3
APRTR2: HRROI T1,[ASCIZ \
?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
DMOVE T1,APRSV1 ;[1612] RESTORE REGS
MOVE T3,APRSV3 ;[1612] FOR CRASH
HALTF%
JRST .-1
SUBTTL OPNICL -- Open the INCLUDE File for the Compiler
;SUBROUTINE TO OPEN INCLUDE FILES
;CHECK TO SEE THAT THEY ARE DISK
;CALL WITH
; ICLPTR = ASCIII FILE SPEC POINTER
; PUSHJ SREG,OPNICL
; RETURN HERE
; VREG = 0 - OK
; OR
; VREG = ASCII ERROR STRING MESSAGE POINTER
ICLJFN=CHNLTBL+^D30
OPNICL::
PUSH SREG,T1
PUSH SREG,T2
PUSH SREG,T3
HRRZI T1,ICLTAB ;LONG GTJFN% INCLUDE FILE TABLE
MOVE T2,ICLPTR ;SPEC POINTER
GTJFN%
JRST ICLNUL ;TRY WITHOUT DEFAULT "FOR"
NULX: HRRZM T1,ICLJFN ;SAVE JFN
MOVEM T2,ICLPTR ;SAVE POINTER TO LOOK FOR SWITCHES
;CHECK FOR DSK:
HRRZ T1,T1 ;ZERO LEFT
DVCHR%
LDB T1,[POINTR(T1,DV%TYP)] ;Get device type
CAIE T1,.DVDSK ;Is it a disk?
JRST NOTDSK ;NO
HRRZ T1,ICLJFN ;GET JFN AGAIN
MOVX T2,OF%RD ;Read, ASCII, 36 bit bytes
OPENF%
JRST ICLERR ;PROBLEMS
MOVEI VREG,0 ;GOOD RETURN
ICLRET: POP SREG,T3
POP SREG,T2
POP SREG,T1
POPJ SREG,
;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,.FHSLF ;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,[ASCIZ \Unknown file error\]] ;UNKNOWN ERROR
JRST ICLRET
;ROUTINE TO CLOSE THE ICL FILE
;CALL WITH
; PUSHJ SREG,CLOICL
; RETURN HERE
CLOICL::
PUSH SREG,T1
HRRZ T1,ICLJFN ;GET JFN
CLOSF%
JFCL 0,0
POP SREG,T1
POPJ SREG,
SUBTTL Misc. Utility Routines
;SUBROUTINE TO PSOUT% A STRING FROM BLISS
; [1563] /PLB
TTYSTR::
PUSH SREG,T1 ;SAVE AC 1
HRRO T1,-2(P) ;GET -1,,ADDR
PSOUT% ;OUTPUT
POP SREG,T1 ;RESTORE
POPJ SREG,
;SUBROUTINE TO SIMULATE AN EXIT UUO
; [1563] /PLB
EXITUUO::
PUSH SREG,T1 ;SAVE AC 1
HRROI T1, [ASCIZ \
Exit\] ;BE LIKE TOP-10 (ALMOST)
PSOUT% ;STUFF IT
POP SREG,T1 ;RESTORE
HALTF%
JRST .-1
SUBTTL Initialize the Flag Areas
INIT:
SETZM ONFLG ;Clear first word of flags
MOVE T1,[XWD ONFLG,ONFLG+1] ;Clear "must be ON or OFF" flags
BLT T1,ONFLG+2*NUMFLGS-1
SETZM NWON ;Clear first word of nowarn bits
MOVE T1,[XWD NWON,NWON+1] ;Clear nowarn "must be ON or OFF" bits
BLT T1,NWON+2*NWWDCT-1
POPJ SREG,
SUBTTL DOCOMPILE -- Call the FORTRAN Compiler
DOCOMPILE:
PUSH SREG,P1 ;Save old value of P1
PUSH SREG,P2 ;Save old value of P2
MOVE T1,[XWD ONFLG,SONFLG] ;Move command line flags to save area
BLT T1,SONFLG+2*NUMFLGS-1 ;Move flags
MOVE T1,[XWD NWON,SNWON] ;Move command line nowarn bits to save area
BLT T1,SNWON+2*NWWDCT-1 ;Move bits
PUSHJ SREG,INIT ;Zero flag areas
PUSHJ SREG,SCANSW ;Get switches for SWITCH.INI
MOVE F,DEFFLG+$F ;Get the default value of switch word F
ANDCM F,OFFFLG+$F ;Turn off flags that must be off
IOR F,ONFLG+$F ;Turn on flags that must be on
ANDCM F,SOFFLG+$F ;Turn off flags that must be off
IOR F,SONFLG+$F ;Turn on flags that must be on
MOVE T1,DEFFLG+$F2 ;Get the default value of switch word F2
ANDCM T1,OFFFLG+$F2 ;Turn off flags that must be off
IOR T1,ONFLG+$F2 ;Turn on flags that must be on
ANDCM T1,SOFFLG+$F2 ;Turn off flags that must be off
IOR T1,SONFLG+$F2 ;Turn on flags that must be on
MOVEM T1,F2 ;Store flag word
MOVE T1,DEFFLG+$FLAGS2 ;Get the default value of switch word FLAG2
ANDCM T1,OFFFLG+$FLAGS2 ;Turn off flags that must be off
IOR T1,ONFLG+$FLAGS2 ;Turn on flags that must be on
ANDCM T1,SOFFLG+$FLAGS2 ;Turn off flags that must be off
IOR T1,SONFLG+$FLAGS2 ;Turn on flags that must be on
MOVEM T1,FLAGS2 ;Store flag word
MOVE T1,DEFFLG+$DEBGSW ;Get the default value of switch wd DEBGSW
ANDCM T1,OFFFLG+$DEBGSW ;Turn off flags that must be off
IOR T1,ONFLG+$DEBGSW ;Turn on flags that must be on
ANDCM T1,SOFFLG+$DEBGSW ;Turn off flags that must be off
IOR T1,SONFLG+$DEBGSW ;Turn on flags that must be on
MOVEM T1,DEBGSW ;Store switch word
MOVE T1,DEFFLG+$BUGOUT ;Get the default value of switch wd BUGOUT
ANDCM T1,OFFFLG+$BUGOUT ;Turn off flags that must be off
IOR T1,ONFLG+$BUGOUT ;Turn on flags that must be on
ANDCM T1,SOFFLG+$BUGOUT ;Turn off flags that must be off
IOR T1,SONFLG+$BUGOUT ;Turn on flags that must be on
MOVEM T1,BUGOUT ;Store switch word
;Note that since there is no default mechanism for the
;nowarning bits, and that all the bits are by default
;zero, there is no need to turn off any bits that were
;explicitly turned off by SWITCH.INI.
MOVEI T2,NWWDCT-1 ;Get maximum index into nowarn tables
MRGNW: MOVE T1,NWON(T2) ;Turn on flags that must be on
ANDCM T1,SNWOFF(T2) ;Turn off flags that must be off
IOR T1,SNWON(T2) ;Turn on flags that must be on
MOVEM T1,NWBITS(T2) ;Store nowarning bits
SOJGE T2,MRGNW ;If more nowarn bits, then merge flags
;The following table is used by the compiler to hold
;the names and JFNs of active files. Let's clear it
;out for now.
SETZM CHNLTBL ;Zap first word
MOVE T1,[XWD CHNLTBL,CHNLTBL+1] ;Set up for BLT
BLT T1,CHNLTBL+^D40-1 ;Zap the table
TXNN F,SW.GFL ;Did the user specify /GFLOATING?
JRST GETOBJ ;No--Everything is OK
MOVE T1,FLAGS2 ;Get flag word
TXNE T1,GFMCOK ;Does the machine have gfloating microcode?
JRST GETOBJ ;Yes--Everything is OK
HRROI T1,[ASCIZ \FTNGFL /GFLOATING requires GFLOATING microcode.
\]
ESOUT% ;Give error message
JRST RET.ERR ;Take error return
GETOBJ: TXNE F,SW.OCS ;Is /SYNTAX specified?
TXZA F,RELFLG ;Yes--Turn off /OBJECT flag
TXNN F,RELFLG ;Is a object file required?
JRST RELOBJ ;No--See if an object file JFN must be released
SKIPL T1,RELFIL ;Do we have an object file JFN?
JRST OPNOBJ ;Yes--Now ready to open file
SETZM CJFNBK ;Zero first word of GTJFN block
MOVE T1,[XWD CJFNBK,CJFNBK+1] ;Source,,destination
BLT T1,CJFNBK+.GJATR ;Zero GTJFN block
MOVX T1,GJ%FOU
MOVEM T1,CJFNBK+.GJGEN ;Set default flags
MOVE T1,[XWD .NULIO,.NULIO] ;Do no I/O
MOVEM T1,CJFNBK+.GJSRC ;Set up I/O JFNs for GTJFN
HRROI T1,[ASCIZ \DSK\]
MOVEM T1,CJFNBK+.GJDEV ;Set default device
HRROI T1,[ASCIZ \REL\]
MOVEM T1,CJFNBK+.GJEXT ;Set default extension
HRRZI T1,CJFNBK ;Get pointer to arg block for GTJFN
HRROI T2,DEFFIL ;The default name block will be the filespec
GTJFN% ;Get a JFN on the object file
ERJMP MONERR ;
HRRZM T1,RELFIL ;Store JFN of object file
OPNOBJ: MOVX T2,OF%WR ;Open file for writing, ASCII 36 bit bytes
OPENF%
ERJMP MONERR ;Problems
MOVE P1,RELFIL ;Get the object file JFN
MOVEI P2,CHNLTBL+^D0 ;Get address of the object file CHNLTBL entry
PUSHJ SREG,LDCHNL ;Load CHNLTBL entry of object file
JRST GETLST
RELOBJ: SKIPGE T1,RELFIL ;Get JFN of object file
JRST GETLST ;No JFN of object file
RLJFN% ;Release JFN
ERJMP MONERR
SETOM RELFIL ;Mark JFN as released
GETLST: TXNN F,SW.CRF ;Is cref specified?
TXNN F,LSTFLG ;Is any list file specified?
SKIPGE T1,LSTFIL ;Get JFN of list file
JRST GETL2 ;No JFN for list file
RLJFN% ;Release JFN
ERJMP MONERR
SETOM LSTFIL ;Mark list file as having no JFN
GETL2: TXNE F,SW.CRF!SW.MAP!SW.MAC!SW.EXP ;Are any flags set that imply /LIST?
TXO F,LSTFLG ;Yes--Make sure list flag is set
TXNN F,LSTFLG ;Is list flag set?
JRST LDSOU ;No--Don't have to get a list file JFN
SKIPL T1,LSTFIL ;Do we have an listing file JFN?
JRST OPNLST ;Yes--Now ready to open list file
SETZM CJFNBK ;Zero first word of GTJFN block
MOVE T1,[XWD CJFNBK,CJFNBK+1] ;Source,,destination
BLT T1,CJFNBK+.GJATR ;Zero GTJFN block
MOVX T1,GJ%FOU
MOVEM T1,CJFNBK+.GJGEN ;Set default flags
MOVE T1,[XWD .NULIO,.NULIO] ;Do no I/O
MOVEM T1,CJFNBK+.GJSRC ;Set up I/O JFNs for GTJFN
HRROI T1,[ASCIZ \DSK\]
MOVEM T1,CJFNBK+.GJDEV ;Set default device
TXNE F,SW.CRF ;Has /CREF been specified?
SKIPA T1,[POINT 7,[ASCIZ \CRF\]] ;Yes--default extension is .CRF
HRROI T1,[ASCIZ \LST\] ;No--default extension is .LST
MOVEM T1,CJFNBK+.GJEXT ;Set default extension
HRRZI T1,CJFNBK ;Set up for GTJFN%
SKIPE LSTTYP ;Does the original typescript from /LIST exist?
SKIPA T2,[POINT 7,LSTTYP] ;Yes--Use it as filespec
HRROI T2,DEFFIL ;No--Use default file as filespec
GTJFN% ;Get list file JFN
ERJMP MONERR
HRRZM T1,LSTFIL ;Store list file JFN
OPNLST: MOVX T2,FLD(7,OF%BSZ)+OF%WR ;Open file for writing, 7 bit bytes
OPENF%
ERJMP MONERR ;Problems
MOVE P1,LSTFIL ;Get the list file JFN
MOVEI P2,CHNLTBL+^D10 ;Get address of the list file CHNLTBL entry
PUSHJ SREG,LDCHNL ;Load CHNLTBL entry of list file
MOVE T1,LSTFIL ;Get JFN of list file
DVCHR% ;Get characteristics of listing file
LDB T1,[POINTR(T1,DV%TYP)] ;Get device type
CAIE T1,.DVTTY ;Is it a terminal?
JRST LDSOU ;No--Don't need to do anything
HRRZ P1,T3 ;Save number of job that owns the terminal
GJINF% ;Get this job's job number
CAMN P1,T4 ;Are the job numbers the same?
TXO F,TTYDEV ;Yes--Set the list file goes to our TTY flag
LDSOU:
SETOM CNTIDX ;No source file is currently open
PUSHJ SREG,NXTFIL ;Open the first source file
HALTF% ;Error return--can not happen!
SKIPN CCLSW ;Was FORTRAN entered at CCL start address
JRST CALLFTN ;No--Load list file entry in CHNLTBL
HRROI T1,[ASCIZ \FORTRAN: \] ;[1603] No square bracket
PSOUT% ;Tell the user who we are
HRROI T1,ATMBUF
PSOUT% ;Print name of first source file
HRROI T1,[ASCIZ \
\] ;[1603] No square bracket
PSOUT%
CALLFTN:
MOVEI T1,.FHSLF ;Get runtime for this fork
RUNTM% ;Get runtime and current time
MOVEM T1,RTIME ;Save runtime
MOVEM T3,CTIME ;Save current time
MOVE T1,.JBFF ;[1632] Save value of .JBFF across compile
MOVEM T1,XJBFF ;[1632]
MOVE T1,.JBREL ;[1632] Save value of .JBREL across compile
MOVEM T1,XJBREL ;[1632]
SETZM SEGINCORE ;Argument to PHASE CONTROL
PUSHJ SREG,PHAZCONTROL ;Get the next phase
PUSHJ SREG,CLOSUP ;Close all files
MOVE T1,XJBFF ;[1632] Restore value of .JBFF
MOVEM T1,.JBFF ;[1632]
MOVE T1,XJBREL ;[1632] Restore value of .JBREL
MOVEM T1,.JBREL ;[1632]
MOVE T1,FLAGS2 ;Get word of flags
TXNE T1,SW.ABO ;Was /ABORT specified?
TXNN F,SW.ERR ;Was there fatal errors during compile?
JRST RETCOM ;No--Return from this compilation
HRROI T1,[ASCIZ \[Exit due to /ABORT]
\]
PSOUT%
HALTF%
RETCOM: POP SREG,P2 ;Restore P2
POP SREG,P1 ;Restore P1
POPJ SREG, ;Return
;Set up an entry in CHNLTBL for the compiler.
;Arguments:
; P1 JFN
; P2 Pointer to CHNLTBL entry for this file
;Note that when this file returns, the name of the file in
;the atom buffer.
CHNJFN==0 ;Offset in a CHNLTBL entry for JFN
CHNDEV==1 ;Offset in a CHNLTBL entry for device
CHNNAM==6 ;Offset in a CHNLTBL entry for name
CHNEXT==7 ;Offset in a CHNLTBL entry for extension
LDCHNL: HRRM P1,CHNJFN(P2) ;Store JFN
HRROI T1,ATMBUF ;Get string in atom buffer
MOVE T2,P1 ;Get the JFN
MOVX T3,FLD(.JSAOF,JS%DEV) ;We want the device field
JFNS% ;Get the device name
PUSHJ SREG,CVT76 ;Convert atom buffer to sixbit
MOVEM VREG,CHNDEV(P2) ;Store device in channel table
HRROI T1,ATMBUF ;Get string in atom buffer
MOVE T2,P1 ;Get the JFN
MOVX T3,FLD(.JSAOF,JS%TYP) ;We want the extension field
JFNS% ;Get the extension
PUSHJ SREG,CVT76 ;Convert atom buffer to sixbit
HLLM VREG,CHNEXT(P2) ;Store in channel table
HRROI T1,ATMBUF ;Get string in atom buffer
MOVE T2,P1 ;Get the JFN
MOVX T3,FLD(.JSAOF,JS%NAM) ;We want the name field
JFNS% ;Get the name
PUSHJ SREG,CVT76 ;Convert atom buffer to sixbit
MOVEM VREG,CHNNAM(P2) ;Store in channel table
POPJ SREG, ;Return
;Convert a 7 bit ASICZ string to 6 bit.
;The 7 bit string is assumed to be in the atom buff. Up to the
;first 6 characters will be converted and stored in VREG left
;justified.
CVT76:
SETZ VREG, ;Clear VREG so it can get 6 bit string
MOVE T1,[POINT 7,ATMBUF] ;7 bit string comes from the atom buffer
MOVE T2,[POINT 6,VREG] ;6 bits string goes into VREG
MOVEI T4,6 ;Process up to 6 characters
C76LP: ILDB T3,T1 ;Get a seven bit character
JUMPE T3,C76RET ;Return if null encountered
SUBI T3," "-' ' ;Convert 7 bit to sixbit
IDPB T3,T2 ;Store sixbit character
SOJG T4,C76LP ;Process up to 6 characters
C76RET: POPJ SREG, ;Return
SUBTTL SCAN20 -- Scan a TOPS-20 Command Line
;**********************************************************************
;
; SCAN20: scan and process a TOPS-20 compiler command line.
;
;**********************************************************************
SCAN20:
TRACE <SCAN20:>
PUSH SREG,P1 ;Save P1
PUSH SREG,P2 ;Save P2
PUSH SREG,P3 ;Save P3
PUSH SREG,P4 ;Save P4
PUSH SREG,P5 ;Save P5
PUSH SREG,P6 ;Save P6
PUSH SREG,STATE+.CMFLG ;Save the Reparse address of the COMND% JSYS
PUSH SREG,OLDSTK ;Save old "old stack pointer"
MOVEM SREG,OLDSTK ;Save stack pointer so we can abort
MOVEI T1,REPARSE ;Get address of code to handle a reparse
HRRM T1,STATE+.CMFLG ;Store in state block
JRST GETCOMM
REPARSE:
TRACE <REPARSE>
MOVE SREG,OLDSTK ;Restore the stack pointer
SKIPL T1,RELFIL ;Get JFN of object file (-1 means no JFN)
RLJFN% ;Release JFN
ERJMP MONERR
SKIPL T1,LSTFIL ;Get JFN of list file (-1 means no JFN)
RLJFN% ;Release JFN
ERJMP MONERR
SKIPGE T5,FORIDX ;Get index to JFN of last source file
JRST GETCOMM ;No source file JFN's
RL: MOVE T1,FORFIL(T5) ;Get JFN of next source file
RLJFN% ;Release JFN
ERJMP MONERR
SOJGE T5,RL ;Loop to release rest of source file JFN's
GETCOMM:
TRACE <GETCOMMAND>
PUSHJ SREG,INIT ;Clear flags
SETOM LSTFIL ;Clear JFN of list file
SETOM RELFIL ;Clear JFN of object file
SETOM FORIDX ;No source files have JFN's
SETZM LSTTYP ;Throw away typescript from /LIST:
SETZM OPTECHO ;Don't echo options from SWITCH.INI
SETZM NOPTION ;/NOOPTION has not been seen--read SWITCH.INI
SETZM OPTION ;No option string has been given
HRROI T1,[ASCIZ \FTNCMD \] ;Get pointer to prefix of error messages
MOVEM T1,ERRPFX ;Store error message prefix
MOVX T1,GJ%OLD!GJ%XTN
MOVEM T1,CJFNBK+.GJGEN ;Set default flags
HRROI T1,[ASCIZ \DSK\]
MOVEM T1,CJFNBK+.GJDEV ;Set default device
SETZM CJFNBK+.GJNAM ;Set default name
MOVEI T2,CMFIL1 ;Look for filespec or action switch
PUSHJ SREG,FCMD ;Do COMND% JSYS
JRST RET.EOF ;EOF return--take eof return to caller
CAIN T3,CMFIL1 ;Was a filename found?
JRST GOTSOU ;Yes--process a compile command
CAIN T3,CONFIRM ;Was a carriage return found?
JRST RET.OK ;Yes--Return
HRRZ T2,(T2) ;Get action code
JRST (T2) ;Other alternative, handle action switch
.EXIT:
TRACE <.EXIT>
MOVEI T2,CONFIRM ;Wait for confirmation
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
HALTF% ;All done
JRST RET.OK ;[1611] Continue the compiler
.HELP: ;[1611] Routine added
TRACE <.HELP>
MOVEI T2,CONFIRM ;Wait for confirmation
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
MOVX T1,GJ%OLD+GJ%SHT ;Try logical HLP:
HRROI T2,[ASCIZ \HLP:FORTRA.HLP\]
GTJFN%
TRNA ;Failure return, try next source
JRST HLPOPN ;Success return, Open the file
MOVX T1,GJ%OLD+GJ%SHT+GJ%PHY ;Try physical HLP:
HRROI T2,[ASCIZ \HLP:FORTRA.HLP\]
GTJFN%
TRNA ;Failure return, try next source
JRST HLPOPN ;Success return, Open the file
MOVX T1,GJ%OLD+GJ%SHT ;Try logical SYS:
HRROI T2,[ASCIZ \SYS:FORTRA.HLP\]
GTJFN%
TRNA ;Failure return, try next source
JRST HLPOPN ;Success return, Open the file
MOVX T1,GJ%OLD+GJ%SHT+GJ%PHY ;Try physical SYS:
HRROI T2,[ASCIZ \SYS:FORTRA.HLP\]
GTJFN%
JRST HLPERR ;Failure return, Cannot open the file
HLPOPN: HRRZ T5,T1 ;Save JFN of help file
MOVX T2,FLD(7,OF%BSZ)+OF%RD ;Read the file
OPENF%
JRST HLPERR ;Failure return, tell user
HLPLP: MOVE T1,T5 ;Get JFN of help file
HRROI T2,BUFF ;Area in which to put string
MOVNI T3,BUFSIZ*5 ;Size of string buffer
SIN
ERJMP HLPEOF ;Failure, maybe EOF
SETZ T3, ;Need a zero byte
IDPB T3,T2 ;Mark end of buffer with zero byte
HRROI T1,BUFF ;Point to string in buff
PSOUT%
JRST HLPLP ;Type rest of help file
HLPEOF:
SETZ T3, ;Need a zero byte
IDPB T3,T2 ;Mark end of buffer with zero byte
HRROI T1,BUFF ;Point to string in buff
PSOUT%
MOVE T1,T5 ;Get JFN of help file
CLOSF% ;Close file
NOOP ;Not likely
JRST RET.OK ;Return to caller
HLPERR: HRROI T1,[ASCIZ \%FTNCMD Can't open help file; I'm sorry but I can't help you.
\]
PSOUT%
JRST RET.OK ;Nothing really bad occured, take normal return
;Register Usage:
; P1 JFN of file to run
; P2 Offset to be added to its start address
; P3 Program name in SIXBIT
.RUN: TRACE <.RUN>
MOVX T1,GJ%OLD!GJ%XTN
MOVEM T1,CJFNBK+.GJGEN ;Set default flags
HRROI T1,[ASCIZ \SYS\]
MOVEM T1,CJFNBK+.GJDEV ;Set default device
SETZM CJFNBK+.GJNAM ;Clear default name
HRROI T1,[ASCIZ \EXE\]
MOVEM T1,CJFNBK+.GJEXT ;Set default extension
MOVEI T2,RUNFIL ;Look for a filename
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
MOVE P1,T2 ;Save JFN of file to run
SETZ P2, ;Assume an offset of zero
MOVEI T2,OFFSET ;Look for /OFFSET or confirmation
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
CAIN T3,CONFIRM ;Was command confirmed?
JRST DORUN ;Yes--Run the program
MOVEI P2,1 ;Assume an offset of 1
MOVEI T2,RUNNUM ;Look for a number or confirmation
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
CAIN T3,CONFIRM ;Was command confirmed?
JRST DORUN ;Yes--Run the program
MOVE P2,T2 ;Get new value of offset
MOVEI T2,CONFIRM ;Wait for confirmation
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
DORUN: JUMPL P2,BIGOFF ;Is the offset too small?
CAILE P2,1 ;Is the offset too big?
JRST BIGOFF ;Yes--Complain
;Get name of program in SIXBIT
HRROI T1,ATMBUF ;Get string in atom buffer
MOVE T2,P1 ;Get the JFN
MOVX T3,FLD(.JSAOF,JS%NAM) ;We want the name field
JFNS% ;Get the name
PUSHJ SREG,CVT76 ;Convert atom buffer to sixbit
MOVE P3,VREG ;Store the sixbit program name
;Get the directory of the program file if the file is on disk
MOVE T1,P1 ;Get JFN of file to run
DVCHR%
TXNN T2,DV%MDD ;Does device have multiple directories?
JRST NOTSYS ;No, not disk, so program has no system name
HRROI T1,ATMBUF ;Get string in atom buffer
MOVE T2,P1 ;Get the JFN
MOVX T3,FLD(.JSAOF,JS%DIR) ;We want the directory of file
JFNS% ;Get the directory
;Compare the directory of the program with the system's directory
; of SUBSYS. If the directories are equal, then assume that this
; program has comes from PS:<SUBSYS>.
MOVEI T1,7 ;Number of characters in ASCIZ 'SUBSYS'
MOVE T2,[POINT 7,[ASCIZ \SUBSYS\]]
MOVEI T4,7 ;May not have 7 characters, but who cares
MOVE T5,[POINT 7,ATMBUF] ;Directory of file
EXTEND T1,[CMPSN] ;Is the directory of the file SUBSYS?
SKIPA T1,P3 ;Yes--System name is name of program
NOTSYS: MOVE T1,[SIXBIT \(PRIV)\] ;System name is "(PRIV)"
MOVE T2,P3 ;Private name is name of file
SETSN% ;Tell the monitor
NOOP ;Error return is never taken
MOVEI T1,.FHSLF ;This process
SETZ T2, ;Allow UUOs
SCVEC%
HRRM P1,RUNJFN ;[1611] Store JFN of file to run
HRLZM P2,RUNOFF ;[1611] Store the start address offset
MOVE P3,.JBERR ;[1611] Get this fork's error count
MOVEM P3,RUNERR ;[1611] Store error count for run code
SKIPE .JBERR ;[1611] Is .JBERR zero?
JRST NOFIX ;[1611] Yes--Don't need to patch run code
HRLI T1,(NOOP) ;[1611] Get a No-op instruction
MOVEM T1,RUNSTO ;[1611] Don't save old value of .JBERR
NOFIX: MOVE 17,[XWD RUNCOD,0] ;[1611] Load Run code into the registers
BLT 17,15 ;[1611] Move the code into the registers
JRST 4 ;[1611] .JBERR was zero, just do the run code
BIGOFF: HRROI T1,[ASCIZ \FTNCMD Value of /OFFSET: can not be greater than 1
\]
ESOUT%
JRST RET.ERR ;Take Error return
RUNFIL:
FLDDB. (.CMFIL,CM%SDH,,<filespec of .EXE file to run>)
RUNNUM:
FLDDB. (.CMNUM,CM%SDH,^D8,<offset from start address, must be 0 or 1>,1,CONFIRM)
;Register usage:
; P1 JFN of indirect command file
; P2 Past value of echo switch
.TAKE:
TRACE <.TAKE>
MOVX T1,GJ%OLD+GJ%XTN
MOVEM T1,CJFNBK+.GJGEN ;Set default flags
HRROI T1,[ASCIZ \DSK\]
MOVEM T1,CJFNBK+.GJDEV ;Set default device
SETZ CJFNBK+.GJNAM ;Set default name
HRROI T1,[ASCIZ \CMD\]
MOVEM T1,CJFNBK+.GJEXT ;Set default extension
MOVEI T2,TAKEFIL ;Look for a filename
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
HRRZ P1,T2 ;Save JFN of indirect command file
MOVE P2,ECHOFLG ;[1645] Assume current value of the echo switch
MOVEI T2,ECHO ;Look for echo switch or confirmation
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
CAIN T3,CONFIRM ;Was command confirmed?
JRST TAKLVL ;[1673] Yes--Check that this /TAKE is not
; too many levels deep
HRRZ P2,(T2) ;[1645] /ECHO or /NOECHO was given--get new
; value of ECHOFLG from table entry
MOVEI T2,CONFIRM ;Wait for confirmation
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
TAKLVL: AOS T1,TDEPTH ;About to nest another level
CAIG T1,^D10 ;Have we nested more than 10 levels deep?
JRST READF ;[1673] No--It is OK to do the /TAKE
SOS TDEPTH ;[1673] Since we didn't really nest
HRROI T1,[ASCIZ \%FTNCMD /TAKE: commands may not be nested more than ten levels deep
%FTNCMD /TAKE:\] ;[1673]
PSOUT% ;[1673]
MOVEI T1,.PRIOU ;[1673] Output goes to terminal
HRRZ T2,P1 ;[1673] Get optional JFN of source
MOVE T3,[FLD(.JSSSD,JS%DEV)+FLD(.JSSSD,JS%DIR)+FLD(.JSSSD,JS%NAM)+FLD(.JSAOF,JS%TYP)+JS%PAF] ;[1673]
JFNS% ;[1673]
HRROI T1,[ASCIZ \ is ignored
\] ;[1673]
PSOUT% ;[1673]
JRST RET.OK ;[1673] Not an error, since we can recover
READF: EXCH P2,ECHOFLG ;Exchange new and old values of echo flag
MOVE T1,P1 ;JFN of take file
MOVX T2,FLD(7,OF%BSZ)+.GSNRM+OF%RD ;Ascii Chars, normal read access
OPENF%
ERJMP TAKERR
TAKLOOP:
MOVE T1,P1 ;Get JFN of /TAKE file
HRLI T1,FRMTAK ;The input is coming from a take file
HRL T2,P1 ;Input from take file
HRRI T2,.NULIO ;Throw away output
HRROI T3,[ASCIZ \FORTRAN>\] ;Prompt pointer
PUSHJ SREG,CMDINI ;Init COMND% JSYS and its state block
PUSHJ SREG,SCAN20
JUMPE VREG,TAKLOOP ;If no error and not EOF, then loop
MOVEM P2,ECHOFLG ;Restore echo flag to its old value
SOS TDEPTH ;We've come up one level of nesting
HRRZ T1,P1 ;Get JFN of indirect command file
CLOSF% ;Close file
JRST MONERR ;Failure return
JUMPL VREG,RET.OK ;If end of file, then do a normal return
JRST RET.ERR ;Otherwise, pass back that we got an error
TAKERR: HRROI T1,[ASCIZ \?FTNCMD Cannot open /TAKE file \]
PSOUT%
MOVEI T1,.PRIOU ;Output goes to terminal
MOVE T2,P1 ;JFN of /TAKE file
MOVE T3,[FLD(.JSSSD,JS%DEV)+FLD(.JSSSD,JS%DIR)+FLD(.JSSSD,JS%NAM)+FLD(.JSAOF,JS%TYP)+JS%PAF]
JFNS%
HRROI T1,[ASCIZ \ -- \]
PSOUT%
MOVX T1,.PRIOU ;Primary output stream
HRLOI T2,.FHSLF ;This process' most recent error
SETZ T3, ;Write all of message
ERSTR%
JRST UNKERR ;Unknown error return
JRST BADCALL ;Bad call to ERSTR% return
HRROI T1,[ASCIZ \
\]
PSOUT%
JRST RET.ERR ;Take the error return
TAKEFILE:
FLDDB. (.CMFIL,CM%SDH,,<filespec of indirect command file>)
GETSOU:
TRACE <GETSOU>
MOVEI T2,CMFIL2 ;Look for a filespec
PUSHJ SREG,FCMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
GOTSOU:
TRACE <GOTSOU>
AOS T1,FORIDX ;Get index to use to store new source file JFN
CAIL T1,MAXFILES ;Does index still fit in table
JRST TOOMANY ;No--give an error message
HRRZM T2,FORFIL(T1) ;Store JFN of source file
HRROI T4,[ASCIZ \FTNCMD "+", switch, or confirm required -- \]
MOVEM T4,ERRPFX ;Store error message prefix
MOVEI T2,CMPLUS ;Look for a plus or action switch
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
HRROI T4,[ASCIZ \FTNCMD \]
MOVEM T4,ERRPFX ;Store message error prefix
CAIN T3,CMPLUS ;Was a plus found?
JRST GETSOU ;Yes--Get next filename
DMOVE T4,T2 ;Save T2 & T3 for later use
HRROI T1,DEFFIL ;Get pointer to where to store default file
MOVE T2,FORIDX ;Get index to last source file
MOVE T2,FORFIL(T2) ;Get JFN of last source file
MOVX T3,FLD(.JSAOF,JS%NAM) ;Write only the name of the source file
JFNS% ;Convert source JFN to a string
LDB T1,[POINT 7,DEFFIL,6] ;Get first character of file name
JUMPN T1,NOTNUL ;Everything is fine if filename isn't null
MOVE T1,[XWD [ASCIZ \FORTRAN-OUTPUT\],DEFFIL]
BLT T1,DEFFIL+3-1 ;Move in the 3 word default string
NOTNUL: MOVE T2,T4 ;Restore T2
CAIN T5,COMPSW ;Was a switch found?
PUSHJ SREG,DOSWITCH ;Yes--go process switches
PUSHJ SREG,DOCOMPILE ;Compile this program
JRST RET.OK ;Return from SCAN20
TOOMANY:
HRROI T1,[ASCIZ \FTNCMD Too many source files
\]
ESOUT%
JRST RET.OK
GETSWITCH:
TRACE <GETSWITCH:>
MOVEI T2,COMPSW ;Look for compile switches
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
CAIN T3,CONFIRM ;Was command confirmed?
POPJ SREG, ;Yes--Return
DOSWITCH:
TRACE <DOSWITCH:>
HRRZ T2,(T2) ;Get action code
PUSHJ SREG,@(T2) ;Other alternative, handle action switch
JUMPE VREG,GETSWITCH ;Need to get a new switch
JUMPL VREG,DOSWITCH ;Next switch already read--process it
POPJ SREG, ;Got confirm--return to caller
; T2 contains base of argument vector
; T3 contains mask
; T4 Contains index into flag table to set proper flag word
CLRFLG:
TRACE <CLRFLG>
DMOVE T3,1(T2) ;Get into T3 flag mask
;Get into T4 index into ONFLG to pick flag word
ANDCAM T3,ONFLG(T4) ;Turn off bit that might say that flag is true
IORM T3,OFFFLG(T4) ;Turn on bit that says that flag must be false
SETZ VREG, ;Next switch not yet scanned
POPJ SREG, ;Get next switch
; T2 contains base of argument vector
; T3 contains mask
; T4 Contains index into flag table to set proper flag word
SETFLG:
TRACE <SETFLG>
DMOVE T3,1(T2) ;Get into T3 flag mask
;Get into T4 index into ONFLG to pick flag word
IORM T3,ONFLG(T4) ;Turn on bit that says that flag must be true
ANDCAM T3,OFFFLG(T4) ;Turn off bit that might say that flag is false
SETZ VREG, ;Next switch not yet scanned
POPJ SREG, ;Get next switch
.BUGOUT:
TRACE <.BUGOUT:>
MOVEI T2,[FLDDB.(.CMNUM,CM%SDH,^D8,<octal mask>)] ;Look for a number
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
MOVEM T2,ONFLG+$BUGOUT ;Will need to turn on these bits
SETCAM T2,OFFFLG+$BUGOUT ;Will need to turn off these bits
SETZ VREG, ;Next switch not yet scanned
POPJ SREG, ;Get next switch
.DEBUG:
TRACE <.DEBUG:>
MOVEI T2,DB.K1 ;Look for a keyword, "(", or confirm
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
SETZ VREG, ;Assume that nothing unusual happens
CAIN T3,DB.K1 ;Was a keyword found?
PJRST PRSK1 ;Yes--go process keyword
CAIN T3,DB.K3 ;Was a open paren found?
JRST GETK1 ;Yes--go get a list of keywords
MOVEI T1,DB.ALL ;[1603] Use default of /DEBUG:ALL
IORM T1,ONFLG+$DEBGSW ;[1603] Turn on flags that must be on
ANDCAM T1,OFFFLG+$DEBGSW ;[1603] Turn off flags that must be off
CAIN T3,COMPSW ;Was a switch found?
SKIPA VREG,[-1] ;Yes--Signal that next switch has been scanned
MOVEI VREG,1 ;Must have a carriage return--signal confirm
POPJ SREG, ;Return
GETK1:
MOVEI T2,DB.K2 ;Look for only a keyword
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
PUSHJ SREG,PRSK1 ;Process this keyword
HRROI T4,[ASCIZ \FTNCMD Comma or ")" required -- \]
MOVEM T4,ERRPFX ;Store error message prefix
MOVEI T2,COMMA ;Look for a "," or a ")"
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
HRROI T4,[ASCIZ \FTNCMD \]
MOVEM T4,ERRPFX ;Store error message prefix
CAIN T3,COMMA ;Was a comma found?
JRST GETK1 ;Yes--get next keyword
SETZ VREG, ;Signal that next switch was not scanned
POPJ SREG, ;Return
PRSK1: HRRZ T2,(T2) ;Get keyword mask
TRNE T2,400000 ;Was this a NO form of a keyword
JRST PRNO ;Yes--Process no keyword
IORM T2,ONFLG+$DEBGSW ;Turn on flags that must be on
ANDCAM T2,OFFFLG+$DEBGSW ;Turn off flags that must be off
POPJ SREG, ;Return
PRNO: MOVE T2,ONFLG+$DEBGSW ;Turn off any on bits that were not selected
SETCAM T2,OFFFLG+$DEBGSW ;Turn off bits that must be off
POPJ SREG, ;Return
.ECHOOP:
TRACE <.ECHO-OPTION>
SETOM OPTECHO ;Echo the switches read from SWITCH.INI
SETZ VREG, ;Signal that next switch has not been scanned
POPJ SREG, ;Get next switch
.EXTEND:
TRACE <.EXTEND:>
MOVX T3,SW.EXT ;Get flag bit
IORM T3,ONFLG+$F2 ;Turn on bit that says that flag must be true
ANDCAM T3,OFFFLG+$F2 ;Turn off bit that might say that flag is false
SETZ VREG, ;Signal that next switch has not been scanned
POPJ SREG, ;Get next switch
.LIST:
TRACE <.LIST:>
MOVX T1,LSTFLG ;Get flag that says a list file is being made
IORM T1,ONFLG+$F ;Turn on flag that says a list file is made
ANDCAM T1,OFFFLG+$F ;Turn off the no list file flag
HLRZ T1,CMDSOU ;Get source code from which this switch came
CAIN T1,FRMSWI ;Did this switch come from SWITCH.INI
JRST LSTRET ;Yes--Return since /LIST in SWITCH.INI can
;not take a value.
SKIPGE T1,LSTFIL ;Get the possibly old listing file JFN
JRST NEWLST ;If no old JFN, then try and get new JFN
RLJFN% ;Release old JFN
ERJMP MONERR
SETOM LSTFIL ;Mark JFN as unused
NEWLST: MOVX T1,GJ%FOU+GJ%XTN
MOVEM T1,CJFNBK+.GJGEN ;Set default flags
HRROI T1,[ASCIZ \DSK\]
MOVEM T1,CJFNBK+.GJDEV ;Set default device
HRROI T1,DEFFIL
MOVEM T1,CJFNBK+.GJNAM ;Set default name
MOVE T2,ONFLG+$F ;Get flags that have been turned on
TXNE T2,SW.CRF ;Has /CREF been specified?
SKIPA T1,[POINT 7,[ASCIZ \CRF\]] ;Yes--default extension is .CRF
HRROI T1,[ASCIZ \LST\] ;No--default extension is .LST
MOVEM T1,CJFNBK+.GJEXT ;Set default extension
MOVEI T2,LFIL ;Look for a filename
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
CAIN T3,COMPSW ;Was a switch found?
JRST [SETO VREG, ;Yes--Signal that next switch has been scanned
POPJ SREG,]
CAIN T3,CONFIRM ;Was a carriage return found?
JRST [MOVEI VREG,1 ;Yes--Signal that command was confirmed
POPJ SREG,]
HRRZM T2,LSTFIL ;Store the new listing file JFN
LSTCPY: MOVE T1,[POINT 7,ATMBUF]
MOVE T2,[POINT 7,LSTTYP]
LSTLP: ILDB T3,T1 ;Copy what the user typed . . .
IDPB T3,T2 ;. . . into the area to hold his typescript
JUMPN T3,LSTLP ;Copy until null byte is found
LSTRET: SETZ VREG, ;Signal that next switch has not been scanned
POPJ SREG, ;Get next switch
LFIL: FLDDB. (.CMFIL,CM%SDH,,<filespec of list file>,,COMPSW)
.NODEBUG:
TRACE <.NODEBUG:>
HRRZI T2,^-DB.ALL ;Turn off all debugging options
MOVE T2,ONFLG+$DEBGSW ;Turn off any on bits that were not selected
SETCAM T2,OFFFLG+$DEBGSW ;Turn off bits that must be off
SETZ VREG, ;Signal that next switch has not been scanned
POPJ SREG, ;Go get next switch
.NOEXTEND:
TRACE <.NOEXTEND>
MOVX T3,SW.EXT ;Get flag bit
ANDCAM T3,ONFLG(T2) ;Turn off bit that might say that flag is true
IORM T3,OFFFLG(T2) ;Turn on bit that says that flag must be false
SETZ VREG, ;Signal that next switch has not been scanned
POPJ SREG, ;Go get next switch
.NOLIST:
TRACE <.NOLIST>
;Load T3 with /LIST, /CREF, /LNMAP, /MACHINE-CODE, and /EXPAND bits
MOVX T3,LSTFLG+SW.CRF+SW.MAP+SW.MAC+SW.EXP
ANDCAM T3,ONFLG+$F ;Turn off bits that might say flags are true
IORM T3,OFFFLG+$F ;Turn on bits that say that flags must be false
SETZ VREG, ;Signal that next switch has not been scanned
POPJ SREG, ;Go get next switch
.NOOPTION:
TRACE <NOOPTION>
SETOM NOPTION ;Do not read SWITCH.INI
SETZ VREG, ;Signal that next switch has not been scanned
POPJ SREG, ;Go get next switch
.NOWARN:
TRACE <.NOWARN:>
MOVX T3,SW.NOW ;Get bit to turn of
IORM T3,ONFLG+$F ;Turn on bit that says that flag must be true
ANDCAM T3,OFFFLG+$F ;Turn off bit that might say that flag is false
MOVEI T2,WN.K1 ;Look for a keyword, "(", or confirm
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
SETZ VREG, ;Assume everything is normal
CAIN T3,WN.K1 ;Was a keyword found?
PJRST PRSK3 ;Yes--go process keyword
CAIN T3,WN.K3 ;Was a right paren found?
JRST GETK3 ;Yes--go get list of key words
PUSHJ SREG,NWALL ;Use defualt of /NOWARN:ALL
CAIN T3,COMPSW ;Was a switch found?
SKIPA VREG,[-1] ;Yes--Signal that next switch has been scanned
MOVEI VREG,1 ;Must have got carriage return--Signal confirm
POPJ SREG, ;Return
GETK3:
MOVEI T2,WN.K2 ;Look for only a keyword
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
PUSHJ SREG,PRSK3 ;Process this keyword
HRROI T4,[ASCIZ \FTNCMD Comma or ")" required -- \]
MOVEM T4,ERRPFX ;Store error message prefix
MOVEI T2,COMMA ;Look for a "," or a ")"
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
HRROI T4,[ASCIZ \FTNCMD \]
MOVEM T4,ERRPFX ;Store error message prefix
CAIN T3,COMMA ;Was a comma found?
JRST GETK3 ;Yes--get next keyword
SETZ VREG, ;Signal that next switch has not been scanned
POPJ SREG, ;Go get next switch
PRSK3:
HRRZ T2,(T2) ;Get keyword's code
CAIN T2,1 ;Is this keyword ALL?
JRST NWALL ;Yes--Set all flags
CAIN T2,2 ;Is this keyword NONE?
PJRST .WARN ;Yes--Let .WARN clear all the flags
;Must have got a normal keyword
MOVEI T3,-1(T2) ;Determine correct word ...
IDIVI T3,^D36 ; ... and position to set
MOVEI T1,1 ;Get bit to shift
LSH T1,(T4) ;Shift to proper position
IORM T1,NWON(T3) ;Turn on bit that says that flag must be true
ANDCAM T1,NWOFF(T3) ;Turn off bit that might say that flag is false
POPJ SREG,
NWALL: SETOM NWON ;Set first word of nowarn bits
MOVE T1,[XWD NWON,NWON+1] ;Set nowarn "must be ON" bits
BLT T1,NWON+NWWDCT-1 ;Set rest of must be on bits
SETZM NWOFF ;Clear first word of nowarn bits
MOVE T1,[XWD NWOFF,NWOFF+1] ;Clear nowarn "must be OFF" bits
BLT T1,NWOFF+NWWDCT-1 ;Set rest of must be on bits
POPJ SREG,
.OBJECT:
TRACE <.OBJECT:>
MOVX T1,RELFLG ;Get flag that says a .REL file is being made
IORM T1,ONFLG+$F ;Turn on flag that says a .REL file is made
ANDCAM T1,OFFFLG+$F ;Turn off the no .REL file flag
MOVX T3,SW.OCS ;Get the /SYNTAX switch
ANDCAM T3,ONFLG+$F ;Turn off bit that might say that flag is true
IORM T3,OFFFLG+$F ;Turn on bit that says that flag must be false
HLRZ T1,CMDSOU ;Get source from which this switch came
CAIN T1,FRMSWI ;Did this switch come from SWITCH.INI
JRST OBJRET ;Yes--Return since /OBJECT doesn't take a
;value in SWITCH.INI
SKIPGE T1,RELFIL ;Get the possibly old object file JFN
JRST NEWOBJ ;If no old JFN, then try and get new object JFN
RLJFN% ;Release old JFN
ERJMP MONERR
SETOM RELFIL
NEWOBJ: MOVX T1,GJ%FOU+GJ%XTN
MOVEM T1,CJFNBK+.GJGEN ;Set default flags
HRROI T1,[ASCIZ \DSK\]
MOVEM T1,CJFNBK+.GJDEV ;Set default device
HRROI T1,DEFFIL
MOVEM T1,CJFNBK+.GJNAM ;Set default name
HRROI T1,[ASCIZ \REL\]
MOVEM T1,CJFNBK+.GJEXT ;Set default extension
MOVEI T2,OBFIL ;Look for a filename
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
CAIN T3,COMPSW ;Was a switch found?
JRST [SETO VREG, ;Yes--Signal that next switch has been scanned
POPJ SREG,]
CAIN T3,CONFIRM ;Was a carriage return found?
JRST [MOVEI VREG,1 ;Yes--Signal that command was confirmed
POPJ SREG,]
HRRZM T2,RELFIL ;Store the new object file JFN
OBJRET: SETZ VREG, ;Signal that next switch has not been scanned
POPJ SREG, ;Get next switch
OBFIL: FLDDB. (.CMFIL,CM%SDH,,<filespec of object file>,,COMPSW)
.OPTION:
TRACE <.OPTION>
MOVEI T2,[FLDDB.(.CMFLD,CM%SDH,,<option name>)]
PUSHJ SREG,CMD ;Try and get option string
JRST RET.ERR ;EOF return--error command not completed
MOVE T1,[POINT 7,ATMBUF] ;Get pointer to option string
MOVE T2,[POINT 7,OPTION] ;Get pointer to where to store it
MOVEI T3,^D40 ;Get max. number characters allowed (including
;null character that ends string)
OPTLP: SOJL T3,OPTLNG ;Jump if option becomes too long
ILDB T4,T1 ;Get a character of the option string
CAILE T4,140 ;Is character lower case?
SUBI T4,40 ;Yes--Convert to upper case
IDPB T4,T2 ;Store in its new home
JUMPN T4,OPTLP ;Loop until null is copied
CAIN T3,^D39 ;Was option string null
JRST OPTSHT ;Jump if option is too short
SETZ VREG, ;Signal that next switch has not been scanned
POPJ SREG,
OPTLNG: SKIPA T1,[POINT 7,[ASCIZ \FTNCMD Option name may not exceed 39 characters
\]]
OPTSHT: HRROI T1,[ASCIZ \FTNCMD Option name was not specified
\]
ESOUT%
JRST RET.ERR
.WARN:
TRACE <.WARN>
SETZM NWON ;Clear first word of nowarn bits
MOVE T1,[XWD NWON,NWON+1] ;Clear nowarn "must be ON" bits
BLT T1,NWON+NWWDCT-1
SETOM NWOFF ;Set first word of nowarn bits
MOVE T1,[XWD NWOFF,NWOFF+1] ;Set nowarn "must be OFF" bits
BLT T1,NWOFF+NWWDCT-1
MOVX T3,SW.NOW ;Get /NOWARN flag
ANDCAM T3,ONFLG+$F ;Turn off bit that might say that flag is true
IORM T3,OFFFLG+$F ;Turn on bit that says that flag must be false
SETZ VREG, ;Signal that next switch has not been scanned
POPJ SREG,
SUBTTL CMDINI -- Initilize the COMND% JSYS
;Call to this routine:
; T1 CMDSOU designator
; T2 INPUT,,OUTPUT JFN's for command
; T3 Byte pointer to ASCIZ prompt
CMDINI:
MOVEM T1,CMDSOU ;Tell error routine from where commands come
MOVEM T2,STATE+.CMIOJ ;Store I/O JFNs in COMND% state block
MOVEM T3,STATE+.CMRTY ;Store prompt pointer for COMND%
MOVEI T1,STATE ;Point at COMND% state block
MOVEI T2,[FLDDB. (.CMINI)] ;Do COMND% initialize function
COMND%
ERJMP MONERR ;This should never happen!
POPJ SREG, ;Return
SUBTTL CMD -- Do a COMND% JSYS
;Call to this routine:
; MOVEI T2,descriptor ;Get address of function descriptor
; PUSHJ SREG,CMD ;Do COMND% JSYS
; End of file return
; Normal return
;
;
;Registers, on normal return:
; T1 COMND% state Flags,,Pointer to COMND% state block
; T2 Data returned by COMND%
; T3 Address for function descriptor used (the alternative found)
CMD:
MOVEI T1,STATE ;Point at COMND% state block
COMND%
ERJMP CMERR ;Maybe end of file?
TXNE T1,CM%NOP ;Was something found?
PJRST USRERR ;Nope--a user error
CFOUND: AOS (SREG) ;Assume a normal return
HRRZ T3,T3 ;Get address of function descriptor used
CAIN T3,CONFIRM ;Was a carriage return found?
SKIPN ECHOFLG ;Is this command supposted to be echoed?
POPJ SREG, ;Take normal return
PUSH SREG,T1 ;Save value returned by COMND% JSYS
MOVE T1,STATE+.CMRTY ;Get pointer to prompt string
PSOUT% ;Echo on terminal
HRROI T1,BUFF ;Get pointer to command buffer
PSOUT% ;Echo on terminal
POP SREG,T1 ;Restore value returned by COMND% JSYS
POPJ SREG, ;Return
CMERR:
MOVX T1,.FHSLF ;This process's last error
GETER% ;Get last error in T2
HRRZ T2,T2 ;Throw away fork handle
CAIE T2,COMNX9 ;Was "error" really end of file?
CAIN T2,IOX4 ;Was "error" really end of file?
POPJ SREG, ;Yes--Take failure return
CAIE T2,COMNX2 ;Was field too long for internal buffer?
CAIN T2,COMNX3 ;Was command too long for internal buffer?
PJRST USRERR ;Yes--Show user where his command went wrong
CAIE T2,DESX1 ;[1711] Was error "invalid source designator"?
PJRST MONERR ;[1711] No--Some strange error happened
HLRZ T2,CMDSOU ;[1711] Get source of command
CAIE T2,FRMTTY ;[1711] Was source designator the terminal?
PJRST MONERR ;[1711] No--Some strange error happened
;[1711] The "error" was that the primary input JFN is illegal. This
;[1711] means that the compiler is being run as a background fork.
;[1711] Since the compiler cannot get another command string, simply
;[1711] exit.
HALTF% ;[1711]
JRST RET.OK ;[1711] Try and get a new command ...
SUBTTL FCMD -- Do a COMND% JSYS to get Source File
;Call to this routine:
; MOVEI T2,descriptor ;Get address of function descriptor
; PUSHJ SREG,FCMD ;Do COMND% JSYS
; End of file return
; Normal return
;
;
;Registers, on normal return:
; T1 COMND% state Flags,,Pointer to COMND% state block
; T2 Data returned by COMND%
; T3 Address for function descriptor used (the alternative found)
FCMD:
HRROI T4,[ASCIZ \FOR\] ;Get pointer to possible extension
MOVEM T4,CJFNBK+.GJEXT ;Store in GTJFN% block
MOVEI T1,STATE ;Point at COMND% state block
COMND%
ERJMP CMERR ;Maybe end of file?
TXNN T1,CM%NOP ;Was something found?
PJRST CFOUND ;Yes--process
IFN FTUS,< ;A DEC In-house feature
HRROI T4,[ASCIZ \FTP\] ;Get pointer to possible extension
MOVEM T4,CJFNBK+.GJEXT ;Store in GTJFN% block
HLRO T2,T3 ;Get back address of descriptor block for call
MOVEI T1,STATE ;Point at COMND% state block
COMND%
ERJMP CMERR ;Maybe end of file?
TXNN T1,CM%NOP ;Was something found?
PJRST CFOUND ;Yes--process
> ;A DEC in-house feature
SETZM CJFNBK+.GJEXT ;Try null extension
HLRO T2,T3 ;Get back address of descriptor block for call
MOVEI T1,STATE ;Point at COMND% state block
COMND%
ERJMP CMERR ;Maybe end of file?
TXNN T1,CM%NOP ;Was something found?
PJRST CFOUND ;Yes--process
PJRST USRERR ;No--Must have been a user error
SUBTTL SCANSW -- Scan SWITCH.INI
;Register usage:
; P1 Stores the first character of the switch line
; P2 Stores the old value of the /ECHO flag
; P3 Flag: True iff at least one line selected from SWITCH.INI
; P4 JFN of SWITCH.INI file
SCANSW:
TRACE <SCANSW:>
SKIPGE NOPTION ;Was /NOOPTION specified?
POPJ SREG, ;Yes--just return
PUSH SREG,P1 ;Save P1
PUSH SREG,P2 ;Save P2
PUSH SREG,P3 ;Save P3
PUSH SREG,P4 ;Save P4
PUSH SREG,P5 ;Save P5
PUSH SREG,P6 ;Save P6
PUSH SREG,STATE+.CMFLG ;Save the Reparse address of the COMND% JSYS
PUSH SREG,OLDSTK ;Save old "old stack pointer"
MOVEM SREG,OLDSTK ;Save stack pointer so we can abort
MOVX T1,GJ%SHT+GJ%OLD ;[1623] Short arg block, File must exist
HRROI T2,INIFIL ;[1623] Filename of SWITCH.INI is in INIFIL
GTJFN% ;[1623]
JRST NOINI ;[1623] Failure return--maybe no file at all?
HRRZ P4,T1 ;Save JFN of switch file for later use
SETZ P3, ;[1611] No lines yet selected from SWITCH.INI
MOVE P2,ECHOFLG ;Save the value of the /ECHO flag
MOVE T1,OPTECHO ;Get the value of the SWITCH.INI echo flag
MOVEM T1,ECHOFLG ;Store in new value of the echo flag
MOVE T1,P4 ;Get JFN of switch file
MOVX T2,FLD(7,OF%BSZ)+.GSNRM+OF%RD ;ASCII chars, normal read access
OPENF%
JRST [CAIN T1,OPNX31 ;[1672] Did open fail because file was offline?
JRST RET.OK ;[1672] Yes--Not an error, just return
JRST IOERR] ;[1672] No--We have a real I/O error
NEWLINE:
TRACE <NEWLINE:>
MOVE T1,P4 ;Get JFN of SWITCH.INI for BIN% JSYS
MOVE T3,[POINT 7,[ASCIZ \FORTRA\]] ;Look for line starting with ...
FNDPFX: BIN%
ERJMP EOF
CAILE T2,140 ;Is character lower case?
SUBI T2,40 ;Yes--Convert to upper case
ILDB T4,T3 ;Get character from pattern
CAMN T4,T2 ;Is this the character we are looking for?
JUMPN T4,FNDPFX ;Yes--but let's not be fooled by null
JUMPN T4,REJECT ;Reject this line, if ending char wasn't null
CAIE T2,"N" ;[1611] Is character the optional "N"
JRST DIFFER ;[1611]No--make sure char doesn't differentiate
;[1611] FORTRAN from some other program
BIN% ;[1611] Get character following the "N"
ERJMP EOF ;[1611]
CAILE T2,140 ;[1611] Is character lower case?
SUBI T2,40 ;[1611] Yes--Convert to upper case
DIFFER: CAIN T2,"-" ;Is character a hyphen
JRST REJECT ;Yes--Reject this line
CAIGE T2,"0" ;Is character outside the range of digits?
JRST GETOPT ;Yes--Try and get the option string
CAIG T2,"9" ;Is character outside the range of digits?
JRST REJECT ;No--Reject this line
CAIGE T2,"A" ;Is character outside the range of letters?
JRST GETOPT ;Yes--Try and get the option string
CAIG T2,"Z" ;Is character outside the range of letters?
JRST REJECT ;No--Reject this line
GETOPT: SKIPN OPTION ;Is the option string from /OPTION null?
JRST NOCOLON ;Yes--A selected line if it doesn't have colon
CAIE T2,":" ;Is this character a colon?
JRST REJECT ;No--Scan line for continuation
MOVE T3,[POINT 7,OPTION] ;Look for the option
FNDOPT: BIN%
ERJMP EOF
CAILE T2,140 ;Is character lower case?
SUBI T2,40 ;Yes--Convert to upper case
ILDB T4,T3 ;Get character from option pattern
CAMN T4,T2 ;Is this the character we are looking for?
JUMPN T4,FNDOPT ;Yes--but let's not be fooled by null
JUMPN T4,REJECT ;Reject this line, if ending char wasn't null
CAIN T2,"-" ;Is character a hyphen
JRST REJECT ;Yes-Reject this line
CAIGE T2,"0" ;Is character outside the range of digits?
JRST SELECT ;Yes--Select this line
CAIG T2,"9" ;Is character outside the range of digits?
JRST REJECT ;No--Reject this line
CAIGE T2,"A" ;Is character outside the range of letters?
JRST SELECT ;Yes--Select this line
CAIG T2,"Z" ;Is character outside the range of letters?
JRST REJECT ;No--Reject this line
SELECT:
TRACE <SELECT:>
SETO P3, ;[1611] At least one line has been selected
MOVE P1,T2 ;Save the unparsed character
MOVE T1,P4 ;Get JFN of COMND% input
HRLI T1,FRMSWI ;Input is coming for SWITCH.INI
HRL T2,P4 ;COMND% JSYS input comes from SWITCH.INI
HRRI T2,.NULIO ;COMND% JSYS output goes to NUL:
HRROI T3,[ASCIZ \Option: \] ;Prompt pointer
PUSHJ SREG,CMDINI ;Init COMND% JSYS and its state block
AOS STATE+.CMINC ;We have one unparsed character already
SOS STATE+.CMCNT ;Which means there is one less space in buffer
DPB P1,[POINT 7,BUFF,6] ;Store the character in COMND%'s buffer
PUSHJ SREG,SSWITCH ;Scan the switch line
JUMPE VREG,NEWLINE ;If all is OK, then look for more lines
JUMPG VREG,REJECT ;If an error occured, reject rest of line
JRST CLOSE ;If EOF, then close files
NOCOLON:
CAIE T2,":" ;Is character a colon?
JRST SELECT ;Yes--This line has been selected
REJECT:
TRACE <REJECT:>
BIN%
ERJMP EOF
CAIN T2,"!" ;Is character a exclamation point?
JRST EXCL ;Yes--look for end of comment
CAIN T2,";" ;Is character a semicolon?
JRST SEMI ;Yes--find end of line
CAIN T2,"-" ;Is character a minus sign?
JRST MINUS ;Yes--see if this line is continued
CAIE T2,.CHCRT ;Is character a carriage return?
JRST REJECT ;No--Get another character
EATLF:
BIN%
ERJMP EOF
JRST NEWLINE ;See if we want this line
EXCL: BIN%
ERJMP EOF
CAIN T2,"!" ;Is character an exclamation point?
JRST REJECT ;Yes--comment closed
CAIE T2,.CHCRT ;Is character a carriage return?
JRST EXCL ;No--get another character
JRST EATLF
SEMI:
BIN%
ERJMP EOF
CAIE T2,.CHCRT ;Is character a carriage return?
JRST SEMI ;No--get another character
JRST EATLF
MINUS:
BIN%
ERJMP EOF
CAIE T2,.CHCRT ;Is character a carriage return?
JRST REJECT ;Nope--continue scanning line
BIN% ;Eat a linefeed
ERJMP EOF
JRST REJECT ;Scan this line as a continuation of the first
EOF:
TRACE <EOF>
MOVE T1,P4 ;Get JFN of SWITCH.INI
GTSTS% ;Get status of that JFN
TXNE T2,GS%EOF ;Did end of file occur?
JRST CLOSE ;Yes--Close up and go home (to get some sleep)
IOERR: MOVEM P2,ECHOFLG ;[1645] Restore the /ECHO flag
MOVX T1,.FHSLF ;This process
GETER% ;Get last error in T2
HRRZ T2,T2 ;Throw away fork handle
HRROI T1,[ASCIZ \%FTNCMD \] ;[1672]
PSOUT% ;[1672]
MOVX T1,.PRIOU ;Primary output stream
HRLOI T2,.FHSLF ;This process' most recent error
SETZ T3, ;Write all of message
ERSTR%
JRST UNKERR ;Unknown error return
JRST BADCALL ;Bad call to ERSTR% return
HRROI T1,[ASCIZ \
Error occurred while processing file SWITCH.INI from your logged-in directory
\] ;[1672]
PSOUT% ;[1672]
JRST RET.ERR ;[1672] Return and signal error
CLOSE: MOVEM P2,ECHOFLG ;[1645] Restore the /ECHO flag
MOVE T1,P4 ;Get JFN of SWITCH.INI
CLOSF% ;Close file
ERJMP IOERR
JUMPN P3,RET.OK ;[1611] If at least one line was select, all OK
SKIPN OPTION ;[1611]If the user didn't give a /OPTION switch
JRST RET.OK ;[1611] then all is OK
;The user gave a /OPTION switch but no line from SWITCH.INI martched.
;Warn user that the option string was probably mistyped.
HRROI T1,[ ASCIZ \%FTNCMD No lines from SWITCH.INI matched the /OPTION: specified.
\]
PSOUT ;[1611]
JRST RET.OK ;Return to caller
NOINI: CAIE T1,GJFX24 ;[1623] Was file not found?
CAIN T1,GJFX18 ;[1623] Was there no such filename?
JRST RET.OK ;[1623] Yes--no switch file exits, just return
CAIN T1,GJFX19 ;[1623] Was there no such filetype?
JRST RET.OK ;[1623] Yes--no switch file exits, just return
HRROI T1,[ASCIZ \%FTNCMD Can't read SWITCH.INI -- \] ;[1623]
PSOUT% ;[1623]
MOVX T1,.PRIOU ;[1623] Primary output stream
HRLOI T2,.FHSLF ;[1623] This process' most recent error
SETZ T3, ;[1623] Write all of message
ERSTR% ;[1623]
NOOP ;[1623] Unknown error return
NOOP ;[1623] Bad call to ERSTR% return
HRROI T1,[ASCIZ \
\] ;[1623]
PSOUT% ;[1623]
JRST RET.OK ;[1623]
SSWITCH:
PUSH SREG,P1 ;Save P1
PUSH SREG,P2 ;Save P2
PUSH SREG,P3 ;Save P3
PUSH SREG,P4 ;Save P4
PUSH SREG,P5 ;Save P5
PUSH SREG,P6 ;Save P6
PUSH SREG,STATE+.CMFLG ;Save the Reparse address of the COMND% JSYS
PUSH SREG,OLDSTK ;Save old "old stack pointer"
MOVEM SREG,OLDSTK ;Save stack pointer so we can abort
PUSHJ SREG,GETSWITCH ;Scan Switches
JRST RET.OK ;Take normal return.
;Note that this routine may abort. If it aborts,
;VREG will have the value:
; -1 if a EOF occured
; 1 if an error occured
;If nothing when wrong, this routine will return and
;VREG will have the value zero.
SUBTTL Command Line Error Routines
USRERR:
TRACE <USRERR>
SKIPN ECHOFLG ;Is this command supposted to be echoed?
JRST NOECHO ;No--skip over echoing
MOVE T1,STATE+.CMRTY ;Get pointer to prompt string
PSOUT% ;Echo on terminal
HRROI T1,BUFF ;Get pointer to command buffer
PSOUT% ;Echo on terminal
NOECHO:
MOVE T1,ERRPFX ;Get prefix string of error message
ESOUT%
MOVX T1,.PRIOU ;Primary output stream
HRLOI T2,.FHSLF ;This process' most recent error
SETZ T3, ;Write all of message
ERSTR%
JRST UNKERR ;Unknown error return
JRST BADCALL ;Bad call to ERSTR% return
; This section of code determines the number of unparsed characters
; that are in the command buffer minus the number of characters
; that terminated the command. The number of terminating chars
; is one except in the case of line-feed, which may be preceded
; by a carriage return. Register P1 will hold the result.
MOVE P1,STATE+.CMINC ;Get number of unparsed chars in buffer
MOVE T1,P1 ;Copy set up for ADJBP
SOJ P1, ;Last char is terminator--don't count it
ADJBP T1,STATE+.CMPTR ;Get ptr to last char of text unparsed
LDB T3,T1 ;Get last char
CAIE T3,.CHLFD ;Was character a linefeed?
JRST OUT ;No, we now know length of unparsed string
SETO T2, ;T2 gets minus one
ADJBP T2,T1 ;Backup byte pointer, put it in T2
LDB T3,T2 ;Get new last char
CAIN T3,.CHCRT ;Is character a carriage return?
SOJ P1, ;Yes, don't count it
OUT:
HRROI T1,[ASCIZ \ -- "\]
PSOUT%
MOVX T1,.PRIOU ;Type on terminal
MOVE T2,STATE+.CMPTR ;Get ptr to text left unparsed
MOVN T3,P1 ;Get negative count
CAIE T3,0 ;If there is some error text
SOUT% ; then write it out
HRROI T1,[ASCIZ \"
\]
PSOUT%
HLRZ T4,CMDSOU ;Get source of command
CAIN T4,FRMTTY ;Did the command come from the terminal?
JRST RET.ERR ;Yes--Don't tell user where command came from
HRROI T1,[ASCIZ \Error occurred while processing \]
PSOUT%
MOVE T1,FRMTAB-1(T4) ;Get source message
PSOUT%
HRRZ T2,CMDSOU ;Get optional JFN of source
JUMPE T2,WRIRET ;If no JFN, then write final return-linefeed
MOVEI T1,.PRIOU ;Output goes to terminal
MOVE T3,[FLD(.JSSSD,JS%DEV)+FLD(.JSSSD,JS%DIR)+FLD(.JSSSD,JS%NAM)+FLD(.JSAOF,JS%TYP)+JS%PAF]
JFNS%
WRIRET: HRROI T1,[ASCIZ \
\]
PSOUT%
JRST RET.ERR ;Return and signal error
FRMTAB: POINT 7,[ASCIZ \arguments from the EXEC\]
POINT 7,[ASCIZ \command file \] ;[1657]
POINT 7,[ASCIZ \switch file \]
POINT 7,[ASCIZ \a TOPS-10 command line\]
MONERR:
HRROI T1,[ASCIZ \FTNCMD \]
ESOUT%
MOVX T1,.PRIOU ;Primary output stream
HRLOI T2,.FHSLF ;This process' most recent error
SETZ T3, ;Write all of message
ERSTR%
JRST UNKERR ;Unknown error return
JRST BADCALL ;Bad call to ERSTR% return
PJRST WRIRET ;Write final CR/LF and return
UNKERR:
TRACE <UNKERR>
HRROI T1,[ASCIZ \Unknown error
\]
PSOUT%
JRST RET.ERR ;Return and signal error
BADCALL:
TRACE <BADCALL>
HRROI T1,[ASCIZ \Bad call to ERSTR%
\]
PSOUT%
JRST RET.ERR ;Return and signal error
SUBTTL Return Code
RET.ERR: MOVEI VREG,1 ;Return value of 1 means error encountered
JRST RESTOR
RET.OK: TDZA VREG,VREG ;RETURN value of 0 means that all is OK
RET.EOF: SETO VREG, ;Return value of -1 means EOF was encountered
RESTOR: MOVE SREG,OLDSTK ;Recover the original stack pointer
POP SREG,OLDSTK
POP SREG,STATE+.CMFLG ;Restore the Reparse address for COMND% JSYS
POP SREG,P6 ;Restore P6
POP SREG,P5 ;Restore P5
POP SREG,P4 ;Restore P4
POP SREG,P3 ;Restore P3
POP SREG,P2 ;Restore P2
POP SREG,P1 ;Restore P1
POPJ SREG, ;Return
SUBTTL SCAN10 - The TOP-10 Compatibility Command Scanner
;Register Usage:
; P1 Location to return to after processing a switch
; P2 Flag--Has an object file been specified?
; P3 Flag--Has a list file been specified?
SCAN10:
PUSH SREG,P1 ;Save P1
PUSH SREG,P2 ;Save P2
PUSH SREG,P3 ;Save P3
PUSH SREG,P4 ;Save P4
PUSH SREG,P5 ;Save P5
PUSH SREG,P6 ;Save P6
PUSH SREG,STATE+.CMFLG ;Save the Reparse address of the COMND% JSYS
PUSH SREG,OLDSTK ;Save old "old stack pointer"
MOVEM SREG,OLDSTK ;Save stack pointer so we can abort
MOVEI T1,XREP10 ;Get address of code to handle a reparse
HRRM T1,STATE+.CMFLG ;Store in state block
JRST OBJ10
XREP10:
TRACE <XREP10>
MOVE SREG,OLDSTK ;Restore the stack pointer
SKIPL T1,RELFIL ;Get JFN of object file
RLJFN% ;Release JFN
ERJMP MONERR
SKIPL T1,LSTFIL ;Get JFN of list file
RLJFN% ;Release JFN
ERJMP MONERR
SKIPGE T5,FORIDX ;Get index to JFN of last source file
JRST OBJ10 ;No source file JFN's
XRL: MOVE T1,FORFIL(T5) ;Get JFN of next source file
RLJFN% ;Release JFN
ERJMP MONERR
SOJGE T5,XRL ;Loop to release rest of source file JFN's
OBJ10:
PUSHJ SREG,INIT ;Clear flags
SETOM LSTFIL ;Clear JFN of list file
SETOM RELFIL ;Clear JFN of object file
SETOM FORIDX ;No source files have JFN's
SETZM LSTTYP ;Throw away typescript from /LIST:
SETZM OPTECHO ;Don't echo options from SWITCH.INI
SETZM NOPTION ;/NOOPTION has not been seen--read SWITCH.INI
SETZM OPTION ;No option string has been given
HRROI T4,[ASCIZ \FTNCMD \]
MOVEM T4,ERRPFX ;Store error message prefix
SETZB P2,P3 ;Assume /NOOBJECT and /NOLIST
MOVEI P1,. ;Location to return to if a switch is found
MOVX T1,GJ%FOU+GJ%XTN
MOVEM T1,CJFNBK+.GJGEN ;Set default flags for object file
HRROI T1,[ASCIZ \DSK\]
MOVEM T1,CJFNBK+.GJDEV ;Set default device for object file
SETZM CJFNBK+.GJNAM ;No default name for object file
HRROI T1,[ASCIZ \REL\]
MOVEM T1,CJFNBK+.GJEXT ;Set default extension for object file
MOVEI T2,OFILE ;Look for a filename
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
CAIN T3,COMPSW ;Was a switch found?
JRST DOSW ;Yes--Process the switch
CAIN T3,CONFIRM ;Was a carriage return found?
JRST ERR1 ;Yes--Give error message
CAIN T3,EQUAL ;Was an equal sign found?
JRST SOU10 ;Yes--Get source files
CAIN T3,COMMA1 ;Was a comma found?
JRST LIST10 ;Yes--Get listing file
SETO P2, ;Got a object file
HRRZM T2,RELFIL ;Store its JFN
MOVX T1,RELFLG ;Get flag that says a .REL file is being made
IORM T1,ONFLG+$F ;Turn on flag that says a .REL file is made
ANDCAM T1,OFFFLG+$F ;Turn off the no .REL file flag
MOVEI P1,. ;Come back here if switch is found
MOVEI T2,COMMA1 ;Look for a comma, switch, equals
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
CAIN T3,COMPSW ;Was a switch found?
JRST DOSW ;Yes--Process the switch
CAIN T3,CONFIRM ;Was a carriage return found?
JRST ERR1 ;Yes--Give error message
CAIN T3,EQUAL ;Was an equal sign found?
JRST SOU10 ;Yes--Get source file
LIST10:
MOVX T1,GJ%FOU+GJ%XTN
MOVEM T1,CJFNBK+.GJGEN ;Set default flags of list file
HRROI T1,[ASCIZ \DSK\]
MOVEM T1,CJFNBK+.GJDEV ;Set default device of list file
SETZM CJFNBK+.GJNAM ;No default name of list file
HRROI T1,[ASCIZ \LST\]
MOVEM T1,CJFNBK+.GJEXT ;Set default extension of list file
MOVEI T2,LFILE ;Look for a comma, switch, equals
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
CAIN T3,COMPSW ;Was a switch found?
JRST DOSW ;Yes--Process the switch
CAIN T3,CONFIRM ;Was a carriage return found?
JRST ERR1 ;Yes--Give error message
CAIN T3,EQUAL ;Was a equal sign found?
JRST SOU10 ;Yes--Get source file
SETO P3, ;Got a listing file
HRRZM T2,LSTFIL ;Store its JFN
MOVX T1,LSTFLG ;Get flag that says a list file is being made
IORM T1,ONFLG+$F ;Turn on flag that says a list file is made
ANDCAM T1,OFFFLG+$F ;Turn off the no list file flag
MOVE T1,[POINT 7,ATMBUF]
MOVE T2,[POINT 7,LSTTYP]
L10CPY: ILDB T3,T1 ;Copy what the user typed . . .
IDPB T3,T2 ;. . . into the area to hold his typescript
JUMPN T3,L10CPY ;Copy until null byte is found
MOVEI P1,. ;Come back here if a switch is found
MOVEI T2,EQUAL ;Look for a equal sign or switch
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
CAIN T3,COMPSW ;Was a switch found?
JRST DOSW ;Yes--Process the switch
CAIN T3,CONFIRM ;Was a carriage return found?
JRST ERR1 ;Yes--Give error message
SOU10:
MOVEI P1,. ;Come back here is a switch is found
MOVX T1,GJ%OLD!GJ%XTN
MOVEM T1,CJFNBK+.GJGEN ;Set default flags for source file
HRROI T1,[ASCIZ \DSK\]
MOVEM T1,CJFNBK+.GJDEV ;Set default device for source file
SETZM CJFNBK+.GJNAM ;No default name for source file
LOOP10:
MOVEI T2,SFILE ;Look for a source file or switch
PUSHJ SREG,FCMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
CAIN T3,COMPSW ;Was a switch found?
JRST DOSW ;Yes--Process the switch
CAIN T3,CONFIRM ;Was a carriage return found?
JRST EOC ;Yes--Give error message
AOS T1,FORIDX ;Get index to use to store new source file JFN
CAIL T1,MAXFILES ;Does index still fit in table
JRST TOOMANY ;No--give an error message
HRRZM T2,FORFIL(T1) ;Store JFN of source file
MOVEI P1,. ;Come back here if a switch is found
MOVEI T2,COMMA2 ;Look for a comma, switch, or confirm
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST EOC ;EOF return--Command is done, call compiler
CAIN T3,CONFIRM ;Was a carriage return found?
JRST EOC ;Yes--Call compiler
CAIE T3,COMPSW ;Was a switch found?
JRST LOOP10 ;No--Loop to get source file
DOSW:
HRRZ T2,(T2) ;Get action code
PUSHJ SREG,@(T2) ;Other alternative, handle action switch
JUMPE VREG,(P1) ;Return to processing command line
JUMPL VREG,DOSW ;Next switch already read--process it
EOC:
SETZM DEFFIL ;The default filename shouldn't be used
JUMPN P2,CHKLST ;Was an object file specified?
MOVX T3,RELFLG ;No-Get flag object file flag
ANDCAM T3,ONFLG+$F ;Turn off bit that might say that flag is true
IORM T3,OFFFLG+$F ;Turn on bit that says that flag must be false
CHKLST: SKIPN P3 ;Was a list file specified?
PUSHJ SREG,.NOLIST ;No--Make sure list flags are turned off
PUSHJ SREG,DOCOMPILE ;Compile this program
JRST RET.OK
ERR1: HRROI T1,[ASCIZ \FTNCMD You may not end a TOPS-10 style command at this point
\]
ESOUT%
JRST RET.OK
OFILE: FLDDB. (.CMFIL,,,,,COMMA1)
LFILE: FLDDB. (.CMFIL,,,,,EQUAL)
SFILE: FLDDB. (.CMFIL,,,,,COMPSW)
EQUAL: FLDDB. (.CMTOK,,<POINT 7,[ASCIZ \=\]>,,,COMPSW)
COMMA1: FLDDB. (.CMCMA,,,,,EQUAL)
COMMA2: FLDDB. (.CMCMA,,,,,PLUS)
PLUS: FLDDB. (.CMTOK,,<POINT 7,[ASCIZ \+\]>,,,COMPSW)
SUBTTL Flag Mask Definitions
SALL
;FLAG BITS IN F (SEE IOFLG.BLI and COMMAN.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:
;FLAG BITS IN F2 (SEE IOFLG.BLI and COMMAN.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
;FLAG BITS IN FLAGS2 (SEE IOFLG.BLI and COMMAN.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 ;Abort (exit) on fatal errors
SUBTTL Function block for the COMND% JSYS
ABBRIV==CM%FW ! CM%INV ! CM%ABR
INVIS==CM%FW ! CM%INV
DEFINE TBL(STRING,FLAGS,ACTION)<
IFE FLAGS, <XWD [ASCIZ \'STRING\],ACTION>
IFN FLAGS, <XWD [EXP FLAGS
ASCIZ \'STRING\],ACTION>
>
CMFIL1: FLDDB. (.CMFIL,CM%SDH,,<filespec of source file>,,ACTNSW)
CMPLUS: FLDDB. (.CMTOK,CM%SDH,<POINT 7,[ASCIZ \+\]>,a "+" followed by filespec of the next source file,+,COMPSW)
CMFIL2: FLDDB. (.CMFIL,CM%SDH,,<filespec of source file>)
COMPSW: FLDDB. (.CMSWI,0,COMSW,<a compilation switch,>,,CONFIRM)
ACTNSW: FLDDB. (.CMSWI,0,ACTSW,<an action switch,>)
CONFIRM:
FLDDB. (.CMCFM)
OFFSET: FLDDB. (.CMSWI,0,OFFSX,,,CONFIRM)
OFFSX: XWD 2,2
TBL <OFFSET:>,,0
TBL <RUNOFFSET:>,INVIS,0
ECHO:
FLDDB. (.CMSWI,0,ECHOX,,,CONFIRM)
ECHOX:
XWD 2,2 ;[1645]
TBL <ECHO>,,1
TBL <NOECHO>,,0 ;[1645]
DB.K1: FLDDB. (.CMKEY,0,DT,<a debugging option,>,,DB.K3)
DB.K2: FLDDB. (.CMKEY,0,DT)
DB.K3: FLDDB. (.CMTOK,CM%SDH,<POINT 7,[ASCIZ \(\]>,<"(" followed by a list of debugging options>,,COMPSW)
WN.K1: FLDDB. (.CMKEY,0,WT,<warning message mnemonic,>,,WN.K3)
WN.K2: FLDDB. (.CMKEY,0,WT)
WN.K3: FLDDB. (.CMTOK,CM%SDH,<POINT 7,[ASCIZ \(\]>,<"(" followed by a list of warning mnemonics>,,COMPSW)
COMMA: FLDDB. (.CMCMA,CM%SDH,,<"," or ")">,,LEFTP)
LEFTP: FLDDB. (.CMTOK,CM%SDH,<POINT 7,[ASCIZ \)\]>)
ACTSW: XWD ACTSWL,ACTSWL ;Count of number of entries
TBL <EXIT>,,.EXIT
TBL <HELP>,,.HELP
TBL <RUN:>,,.RUN
TBL <TAKE:>,,.TAKE
ACTSWL==.-ACTSW-1
SUBTTL Compilation Switch Table
COMSW: XWD COMSWL,COMSWL ;Count of number of entries
TBL <A>,ABBRIV,XXA
XXA: TBL <ABORT>,,[EXP SETFLG,SW.ABO,$FLAGS2]
TBL <B>,ABBRIV,XXB
XXB: TBL <BINARY:>,,[.OBJECT]
TBL <BUGOUT:>,INVIS,[.BUGOUT]
TBL <C>,ABBRIV,XXC
TBL <CR>,ABBRIV,XXC
TBL <CREF>,INVIS,[EXP SETFLG,SW.CRF,$F]
TBL <CRO>,ABBRIV,XXC
TBL <CROS>,ABBRIV,XXC
TBL <CROSS>,ABBRIV,XXC
XXC: TBL <CROSS-REFERENCE>,,[EXP SETFLG,SW.CRF,$F]
TBL <CROSSREFERENCE>,INVIS,[EXP SETFLG,SW.CRF,$F]
TBL <D>,ABBRIV,XXD
XXD: TBL <DEBUG:>,,[.DEBUG]
TBL <DFLOATING>,,[EXP CLRFLG,SW.GFL,$F2] ;[1611]
TBL <ECHO-OPTION>,,[.ECHOOP]
TBL <ERRORS>,,[EXP CLRFLG,SW.NET,$F]
TBL <EXPAND>,,[EXP SETFLG,SW.EXP,$F]
$EXTEN: TBL <EXTEND>,INVIS,[.EXTEND] ;[1636]
TBL <F66>,,[EXP CLRFLG,SW.F77,$F2]
TBL <F77>,,[EXP SETFLG,SW.F77,$F2]
TBL <GFLOATING>,,[EXP SETFLG,SW.GFL,$F2]
TBL <INCLUDE>,,[EXP SETFLG,SW.IDS,$F]
TBL <L>,ABBRIV,XXL
XXL: TBL <LISTING:>,,[.LIST]
TBL <LNMAP>,,[EXP SETFLG,SW.MAP,$F]
TBL <M>,ABBRIV,XXM
TBL <MA>,ABBRIV,XXM
TBL <MAC>,ABBRIV,XXM
XXM: TBL <MACHINE-CODE>,,[EXP SETFLG,SW.MAC,$F]
TBL <MACRO>,INVIS,[EXP SETFLG,SW.MAC,$F]
TBL <NOABORT>,,[EXP CLRFLG,SW.ABO,$FLAGS2]
TBL <NOBINARY>,,[EXP CLRFLG,RELFLG,$F]
TBL <NOC>,ABBRIV,XXNOC
TBL <NOCR>,ABBRIV,XXNOC
TBL <NOCREF>,INVIS,[EXP CLRFLG,SW.CRF,$F]
TBL <NOCRO>,ABBRIV,XXNOC
TBL <NOCROS>,ABBRIV,XXNOC
TBL <NOCROSS>,ABBRIV,XXNOC
XXNOC: TBL <NOCROSS-REFERENCE>,,[EXP CLRFLG,SW.CRF,$F]
TBL <NOCROSSREFERENCE>,INVIS,[EXP CLRFLG,SW.CRF,$F]
TBL <NOD>,ABBRIV,XXNOD
XXNOD: TBL <NODEBUG>,,[.NODEBUG]
TBL <NOERRORS>,,[EXP SETFLG,SW.NET,$F]
TBL <NOEXPAND>,,[EXP CLRFLG,SW.EXP,$F]
$NOEXT: TBL <NOEXTEND>,INVIS,[.NOEXTEND] ;[1636]
TBL <NOF77>,,[EXP CLRFLG,SW.F77,$F2]
TBL <NOINCLUDE>,,[EXP CLRFLG,SW.IDS,$F]
TBL <NOL>,ABBRIV,XXNOL
XXNOL: TBL <NOLISTING>,,[.NOLIST]
TBL <NOLNMAP>,,[EXP CLRFLG,SW.MAP,$F]
TBL <NOM>,ABBRIV,XXNOM
TBL <NOMA>,ABBRIV,XXNOM
TBL <NOMAC>,ABBRIV,XXNOM
XXNOM: TBL <NOMACHINE-CODE>,,[EXP CLRFLG,SW.MAC,$F]
TBL <NOMACRO>,INVIS,[EXP CLRFLG,SW.MAC,$F]
TBL <NOOBJECT>,INVIS,[EXP CLRFLG,RELFLG,$F]
TBL <NOOPT>,ABBRIV,XXNOOPT ;[1611]
TBL <NOOPTIMIZE>,,[EXP CLRFLG,SW.OPT,$F]
XXNOOPT:TBL <NOOPTION>,,[.NOOPTION]
TBL <NOS>,ABBRIV,XXNOS
TBL <NOSTATISTICS>,INVIS,[EXP CLRFLG,SW.STA,$F2]
XXNOS: TBL <NOSYNTAX>,,[EXP CLRFLG,SW.OCS,$F]
TBL <NOW>,ABBRIV,XXNOW
XXNOW: TBL <NOWARNINGS:>,,[.NOWARN]
TBL <O>,ABBRIV,XXO ;[1711]
TBL <OBJECT:>,INVIS,[.OBJECT]
TBL <OP>,ABBRIV,XXO
TBL <OPT>,ABBRIV,XXO
XXO: TBL <OPTIMIZE>,,[EXP SETFLG,SW.OPT,$F]
TBL <OPTION:>,,[.OPTION]
TBL <S>,ABBRIV,XXS
TBL <STATISTICS>,INVIS,[EXP SETFLG,SW.STA,$F2]
XXS: TBL <SYNTAX>,,[EXP SETFLG,SW.OCS,$F]
TBL <W>,ABBRIV,XXW
XXW: TBL <WARNINGS>,,[.WARN]
COMSWL==.-COMSW-1
SUBTTL Warning Message Mnemonic Table
;To add a new warning message mnemonic to the compiler:
; 1) Add it to the end of the list labeled with NWKTB
; 2) Add to the table labeled with WT an entry of the form:
; TBL <XXX>,,NW.XXX
; where XXX is the three letter mnemonic for the warning.
; 3) Make sure all the entires to WT are in alphabetical
; order!
DEFINE SIXTAB(L)<
NWKTBC==0
IRP L,< SIXBIT \'L\
NW.'L==.-NWKTB
NWKTBC==NWKTBC+1>
>
; /NOWARN: pnuemonic tables. The three character pnuemonics must be
; added to both of the below tables.
NWKTB: SIXTAB <
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]
; Below table must be in alphabetical order!
WT:
XWD NWKTBC,NWKTBC
TBL <ACB>,,NW.ACB ;[1535]
TBL <AGA>,,NW.AGA
TBL <AIL>,,NW.AIL ;[1535]
TBL <ALL>,,NW.ALL
TBL <CAI>,,NW.CAI
TBL <CAO>,,NW.CAO
TBL <CHO>,,NW.CHO
TBL <CNM>,,NW.CNM
TBL <CTR>,,NW.CTR
TBL <CUO>,,NW.CUO
TBL <DGI>,,NW.DGI
TBL <DIM>,,NW.DIM
TBL <DIS>,,NW.DIS
TBL <DXB>,,NW.DXB
TBL <FMR>,,NW.FMR
TBL <FNA>,,NW.FNA
TBL <IAT>,,NW.IAT
TBL <ICC>,,NW.ICC
TBL <ICD>,,NW.ICD
TBL <ICS>,,NW.ICS
TBL <IDN>,,NW.IDN
TBL <IFL>,,NW.IFL
TBL <IUA>,,NW.IUA
TBL <LID>,,NW.LID
TBL <MVC>,,NW.MVC
TBL <NED>,,NW.NED
TBL <NOD>,,NW.NOD
TBL <NONE>,,NW.NONE
TBL <PAV>,,NW.PAV
TBL <PPS>,,NW.PPS
TBL <RDI>,,NW.RDI
TBL <RIM>,,NW.RIM ;[1652]
TBL <SBR>,,NW.SBR
TBL <SID>,,NW.SID
TBL <SNO>,,NW.SNO
TBL <SOD>,,NW.SOD
TBL <TSI>,,NW.TSI
TBL <VAI>,,NW.VAI
TBL <VND>,,NW.VND
TBL <VNI>,,NW.VNI
TBL <WNA>,,NW.WNA
TBL <WOP>,,NW.WOP
TBL <XCR>,,NW.XCR
TBL <ZMT>,,NW.ZMT
RELOC ;Back to low segment
NWWDCT==<<NWKTBC-1>/^D36>+1 ;Words needed for bits
NWBITS: BLOCK NWWDCT ;Holds nowarning bits
NWON: BLOCK NWWDCT ;Holds nowarning bits that must be on
NWOFF: BLOCK NWWDCT ;Holds nowarning bits that must be off
SNWON: BLOCK NWWDCT ;Holds nowarning ON bits from command line
;during SWITCH.INI processing.
SNWOFF: BLOCK NWWDCT ;Holds nowarning OFF bits from command line
;during SWITCH.INI processing.
RELOC ;Back to high segment
SUBTTL /DEBUG Option Masks
; Note that bit 400000 (1_^D17) is reserved for signaling that a
; mask comes from a NO option. This implementation allows at most
; 17 debugging options (exclusive of ALL, NONE, and the NO forms
; of the options).
DB.ALL==377777
DB.DIM==1_0
DB.LBL==1_1
DB.IDX==1_2
DB.TRA==1_3
DB.BOU==1_4
DB.ARG==1_5 ;[1613]
DT: XWD DTL,DTL ;Count of number of entries
TBL <ALL>,,DB.ALL
TBL <ARGUMENTS>,,DB.ARG ;[1613]
TBL <BOUNDS>,,DB.BOU
TBL <DIMENSIONS>,,DB.DIM
TBL <INDEX>,,DB.IDX
TBL <LABELS>,,DB.LBL
TBL <NOARGUMENTS>,,^-DB.ARG ;[1613]
TBL <NOBOUNDS>,,^-DB.BOU
TBL <NODIMENSIONS>,,^-DB.DIM
TBL <NOINDEX>,,^-DB.IDX
TBL <NOLABELS>,,^-DB.LBL
TBL <NONE>,,^-DB.ALL
TBL <NOTRACE>,,^-DB.TRA
TBL <TRACE>,,DB.TRA
DTL==.-DT-1
XLIST ;Don't list literals
LIT
LIST
END FORTRA