Trailing-Edge
-
PDP-10 Archives
-
-
There are no other files named in the archive.
COMMENT VALID 00017 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 TENX<TENEX COMMAND SCANNER
C00005 00003 DSCR COMND
C00009 00004 CMDSCN:
C00014 00005 GOSUB: IDPB A,CMDPTR SAVE WHATEVER CHAR IT WAS
C00017 00006 SUBCMD: SKIPE RPGSW
C00018 00007
C00020 00008 GETLST:
C00021 00009 PSWIT:
C00023 00010 DONE:
C00025 00011 DSCR Routines to print out info
C00027 00012
C00028 00013 DSCR Typing routines
C00030 00014 DSCR Long form GTJFN tables.
C00032 00015
C00037 00016
C00038 00017
C00039 ENDMK
C;
TENX<;TENEX COMMAND SCANNER
ZERODATA (TENEX COMMAND SCANNER)
?BINJFN: 0
?LISJFN: 0
BAIL<
?SM1JFN: 0 ;FOR DEBUGGER
?SM1PNT: 0
?SM1CNT: 0
SM1SIZ__200
?SM1BUF: BLOCK SM1SIZ
?SM1TMP: BLOCK 40
>;BAIL
;SRCJFN is in switched/cleared area, along with SRCFLN
?DEFFLN: BLOCK 11 ;DEFAULT FILE NAME FOR .LST, .REL FILES
SAIJFN: 0
NAMPTR: 0
SAVEP: 0
NXTPTR: 0
NAMES: BLOCK 50 ;ENOUGH FOR A LOT OF CHARS!
?XTBFIL: BLOCK 40 ;NAME OF THE XSAIL BINARY FILE
?XTSFIL: BLOCK 40 ;NAME OF THE XSAIL SM1 FILE (BAIL SYMBOLS)
?CMDLIN:BLOCK 100 ;COMMAND LINE
CMDPTR: 0 ;POINTS TO COMMAND LINE
CMDJFN: 0 ;JFN FOR COMMANDS
SWTTXT: BLOCK 10 ;TEXT FOR SWITCHES
SWTPTR: 0 ;POINTER TO ABOVE
RFMODB: 0 ;TEMPORARIES FOR TTY MODE SETTINGS
RFCOCB: 0
RFCOCC: 0
LODMOD: 0 ;SET TO TRUE IF LOADING
LODDDT: 0 ;LOADING WITH DDT
LODSDT: 0 ;LOADING WITH SDDT
ENDDATA
DATA
HRLDON: 0 ;TRUE IF WE HAVE PRINTED THE MESSAGE ONCE
pdlsav: 0 ;save pushdown stack pointer here
monf: 0 ; greater than 0 if tops-20
tmpcnt: 0 ; number of chars passed by EXEC
;-1 if doing RSCAN parse
ENDDATA
HERALD: BLOCK 25 ;PUT IN HIGH CORE SINCE WE WILL SET IT THEN
;SSAVE CORE IMAGE AFTER LOADING
DSCR COMND
CAL PUSHJ
RET +1 if unsuccessful
+2 if successful
;opdefs for TOPS-20
opdef erjmp[320700000000]
opdef ercal[320740000000]
COMND:
setzm monf ;assume not tops-20
move a,[%cnmnt,,.gtcnf] ;get monitor type from configuration table
gettab a, ; with universal gettab
ercal jshlt0 ;shouldnt fail
ldb a,[point 6,a,23] ;get type field
caie a,4 ;is it tops-20?
jrst nott20 ;no, use tenex parser
movem a,monf ;yes, + means tops-20
skipn rpgsw ;just did ccl entry?
skiple tmpcnt ;or still working on one?
jrst docc20 ;yes, go use tops-20 ccl command parser
pushj p,usr20 ;no, use tops-20 user interface
jrst skptnx ;skip the tenex command parser
docc20: pushj p,ccl20 ;parse command from exec
jrst skptnx ;skip the tenex command parser
nott20:
IMSSS<
SKIPN RPGSW ;CALLED IN RPGMODE?
JRST NORPG ;NO
SETO A,
MOVEI B,TMPCBF ;GET BUFFER
JSYS GTINF
JFCL
NOSUMEX,<
SKIPN TMPCBF+6
>;
SUMEX,<
SKIPN TMPCBF+21 ;SOMETHING THERE?
>;
JRST NORPG
IFN 0,<
HRROI A,[ASCIZ/
Tenex SAIL:
/]
JSYS PSOUT
>;IFN 0
SUMEX,<
MOVE A,[POINT 7,TMPCBF+21,-1] ;BP
>;SUMEX
NOSUMEX,<
MOVE A,[POINT 7,TMPCBF+6,-1] ;BP
>;NOSUMEX
MOVEM A,CMDJFN ;USE FOR THE COMMAND SOURCE
IFN 0,< JSYS PSOUT>
JRST NORPG1 ;SKIP OVER SETZM
>;IMSSS
NORPG:
NOIMSSS<
SETZM RPGSW
>;NOIMSSS
SETZM CMDJFN ;START WITH NOTHING
NORPG1: MOVEI A,101 ;SET TTY FOR COMMAND SCANNER
JSYS RFMOD
MOVEM B,RFMODB
TRO B,170000 ;WAKE UP ON EVERYTHING
JSYS SFMOD
MOVEI A,101
JSYS RFCOC
MOVEM B,RFCOCB
MOVEM C,RFCOCC
TRZ B,006000 ;NOTHING FOR ^L
TRZ C,600000 ;NOTHING FOR ^R
JSYS SFCOC
PUSHJ P,CMDSCN ;GET BIN AND LST JFN'S
MOVEI A,101 ;RESET TTY MODES
MOVE B,RFMODB
JSYS SFMOD
MOVEI A,101
MOVE B,RFCOCB
MOVE C,RFCOCC
JSYS SFCOC
skptnx: ;here's where tops-20 rejoins
TLZ FF,LISTNG+BINARY;ASSUME NEITHER
MOVE A,BINJFN
JUMPL A,TRYLST ;NO BIN FILE
MOVE B,[XWD 440000,100000] ;OPEN BINARY FILE
JSYS OPENF
JRST NOBIN ;CAN'T OPEN IT
TLO FF,BINARY ;MADE IT
BAIL<
SKIPLE BAILON
PUSHJ P,SM1INI ;INITIALIZE .SM1 FILE
>;BAIL
TRYLST: MOVE A,LISJFN
JUMPL A,GETSRC ;NO LISTING,GO ON TO SRC
MOVE B,[XWD 70000,100000]
JSYS OPENF
JRST NOLST2 ;NO CAN DO
TLO FF,LISTNG
BAIL<
SKIPLE BAILON
PUSHJ P,SM1LST ;ENTER LISTING FILE BLOCK INTO .SM1 FILE
>;BAIL
JRST GETSRC ;ACTUALLY READ THE SOURCE FILE NOW
NOBIN: ERR <Cannot OPENF binary file.[CR for TENX message]>,1
MOVEI D,.+2
JRST ERROR
JRST TRYLST
NOLST2: ERR <Cannot OPENF listing file.[CR for TENX message]>,1
MOVEI D,.+2
JRST ERROR
JRST GETSRC
EOLC __ 37
COMMA __ ","
ESCAPE __ 33
SWCH __ "@"
QRBOUT __ 177 ;abort command on rubout
CTRLU__"U"-100 ;also on control-U
QMARK__"?" ;for help
CTRLR__"R"-100 ;for .REL file
SLASH__"/" ;for switches
SPACE__" " ;SPACE
CTRLL__"L"-100 ;for .LST file
CTRLQ__"Q"-100 ;for halting
CTRLX__"X"-100
CTRLA__"A"-100
SRCBSZ__200 ;SIZE IN WRDS OF SRC FILE BUFFERS
DEFINE BACKUP <PUSHJ P,.BACKUP> ;BACK UP POINTER OR JFN
DEFINE NXTCHR <PUSHJ P,.NXTCHR> ;GET THE NEXT CHAR
CMDSCN:
skipg monf ;are we on tops-20?
jrst cmdsca ;no, use usual scanner
skipg tmpcnt ;are we doing rescanned input?
jrst usr20 ;no, use tops-20 user interface
jrst ccl20 ;yes, continue ccl file
cmdsca:
SKIPN XTFLAG ;EXTENDED COMPILATION?
JRST CMDSC1 ;NO
HRROI A,[ASCIZ/TENEX SAIL Extended compilation
/]
JSYS PSOUT
JRST NOHRLD ;AND DONT PRINT OUT OTHER HERALD
CMDSC1:
SKIPE HRLDON ;OR ALREADY PRINTED HERALD
JRST NOHRLD ;THEN DONT PRINT AGAIN
HRROI A,HERALD
SKIPE RPGSW
HRROI A,[ASCIZ/TENEX SAIL: /]
JSYS PSOUT
NOHRLD:
SETOM HRLDON
MOVEM P,SAVEP
GETSAI: MOVE A,[POINT 7,NAMES,-1]
MOVEM A,NAMPTR
MOVE A,[POINT 7,CMDLIN,-1]
MOVEM A,CMDPTR
SETZM LODDDT
SETZM LODMOD
SETZM LODSDT
SETZM DEFFLN ;MARK THAT WE DONT YET HAVE A DEFAULT NAME
SETOM LISJFN ;ASSUME NO LISTING FILE
SETZM BINJFN ;ASSUME WANT A BINARY
SKIPE RPGSW
JRST .+3
HRROI A,[ASCIZ/
*/]
JSYS PSOUT
GETSA1: MOVEI D,GETSAI ;FOR ERROR RETURN
NXTCHR ;PEEK AHEAD BEFORE GTJFN
CAIN A,QMARK ;A QUESTION MARK?
JRST QUERY ;AND RETURN TO GETSAI
BACKUP ;BUT DONT GET CARRIED AWAY WITH PEEKING!
GETSA2: MOVEI A,ESAI
MOVE B,CMDJFN ;START WITH INPUT FROM HERE
JSYS GTJFN
JRST .+2
JRST GOTSAI
MOVEM B,CMDJFN ;SAVE POINTER
MOVE B,A ;SAVE ERROR NUMBER
CAIN B,600104 ;"OLD FILE REQUIRED" ??
JRST ERROR ;YES, COMPLAIN
BACKUP
NXTCHR
CAIE A,"_" ;PERHAPS DOES NOT WANT A BINARY
CAIN A,"=" ;ALSO ALLOW "="
JRST GETSA3
JRST GETSA4
GETSA3: SETOM BINJFN ;INDICATE NO BINARY
IDPB A,CMDPTR
JRST GETSA1
GETSA4: CAIE A,QRBOUT
CAIN A,CTRLU
JRST CMDRES ;RESET COMMAND THING
CAIN A,CTRLQ
JRST DOHLT
CAIN B,600115 ;NULL COMMAND -- ALLOW IT
JRST GETSAI ;REPRINT "*" AND DO ANOTHER GTJFN
JRST ERROR ;SOMETHING ELSE IS WRONG -- TELL THE USER
GOTSAI: MOVEM A,SAIJFN ;SAVE THE JFN
MOVEM B,CMDJFN
MOVE A,NAMPTR
HRRZ B,SAIJFN
SETZ C,
JSYS JFNS
MOVEM A,NAMPTR
MOVE A,CMDPTR
HRRZ B,SAIJFN
MOVE C,[XWD 221100,1]
JSYS JFNS
MOVEM A,CMDPTR
SKIPE DEFFLN ;DO WE ALREADY HAVE A DEFAULT NAME?
JRST GTDFFN ;YES
HRROI A,DEFFLN ;GET THE DEFAULT FILENAME FOR OTHER THINGS
HRRZ B,SAIJFN
MOVSI C,2000 ;FILENAME ONLY
JSYS JFNS
SETZ C,0
IDPB C,A ;PUT A NULL BYTE ON THE END
GTDFFN: HRRZ A,SAIJFN ;GET RID OF SOURCE JFN FOR NOW
JSYS RLJFN
JFCL
BACKUP
NXTCHR
CAIN A,ESCAPE
NXTCHR
CAIN A,CTRLQ
JRST DOHLT
CAIN A,CTRLU
JRST CMDRES
CAIE A,"_" ;
CAIN A,"=" ;ALSO ALLOW "="
SKIPA
JRST NOWNLD
IDPB A,CMDPTR ;SAVE IT I GUESS
SETOM LODMOD ;
SETOM LODDDT
JRST DONE ;MUST BE DONE -- TYPED AN ARROW
NOWNLD:
CAIN A,EOLC ;DONE IF EOL
JRST DONE
CAIE A,COMMA ;IS IT A COMMA
JRST DUNCMA ;NO -- RANDOM FILE CHARACTER?
ISCMA: IDPB A,CMDPTR ;SAVE THE COMMA
NXTCHR
CAIE A,EOLC ;IF AN EOL
CAIN A,SPACE ;OR SPACE
JRST GOSUB ;THEN SUBCOMMAND
CAIE A,"_"
CAIN A,"="
JRST [SETOM LODMOD
SETOM LODDDT
JRST GOSUB]
DUNCMA: BACKUP ;MUST BE A FILE NAME -- PUT THE CHAR BACK
SETZ A,
IDPB A,NAMPTR ;SEPARATE THE NAMES WITH NULLS
JRST GETSA2 ;FOR GTJFN
GOSUB: IDPB A,CMDPTR ;SAVE WHATEVER CHAR IT WAS
SKIPE RPGSW
JRST SUBCMD
HRROI A,[ASCIZ/
/]
JSYS PSOUT
BAIL<
JRST SUBCMD ;GET AROUND THIS CRAP
SM1INI:
SKIPG BAILON ;HAS USER TURNED US OFF?
POPJ P, ;YES
MOVE A,SM1JFN ;INITIALIZE .SM1 FILE
MOVE B,[XWD 440000,100000]
JSYS OPENF
JRST NOSM1 ;ERROR EXIT
MOVEI TEMP,SM1SIZ ;BUFFER SIZE
MOVEM TEMP,SM1CNT
MOVE TEMP,[POINT 36,SM1BUF]
MOVEM TEMP,SM1PNT
POPJ P,
NOSM1: ERR <Cannot OPENF debugger's file.[CR for TENX message]>,1
MOVEI D,.+2 ;ALLOW CONTINUATION
JRST ERROR
SETOM BAILON
POPJ P, ;OH WELL
SM1LST: MOVE B,LISJFN ;GET FILE NAME CORRESPONDING TO JFN
;AND PUT OUT A FILE INFO BLOCK
;THERE ARE CALLS TO SM1LST+1
MOVE A,[POINT 7,SM1TMP] ;A NICE BIG TEMP AREA
;;#%%# ! JFR 4-23-75 TRY THIS FOR CHANGE
MOVE C,[111100000001] ;A NICE FORMAT (?)
JSYS JFNS ;JFN TO STRING CONVERSION
HRRZ PNT,A ;UPDATED BYTE POINTER
;;#%%# JFR 4-5-75 ZERO OUT THE REST OF THE LAST WORD
SETZ C,
IDPB C,A
IDPB C,A
IDPB C,A
IDPB C,A
;;#%%# ^
SUBI PNT,SM1TMP
ADDI PNT,1 ;# OF WORDS IN NAME
SETZ SBITS,
HLLM SBITS,BCORDN ;NO LONGER DOING COORDINATES
PUSHJ P,VALOUT ;END PREVIOUS TABLE
MOVEI SBITS,BAIFIL
PUSHJ P,VALOUT ;BEGIN FILE INFO TABLE
MOVE SBITS,PNT
HRL SBITS,BSRCFN ;FILE #,,# WORDS IN NAME
PUSHJ P,VALOUT
MOVN PNT,PNT
HRLZ PNT,PNT ;AOBJN POINTER
SM1LS1: MOVE SBITS,SM1TMP(PNT) ;PICK UP A WORD
PUSHJ P,VALOUT
AOBJN PNT,SM1LS1
POPJ P,
>;BAIL
SUBCMD: SKIPE RPGSW
JRST .+3
HRROI A,[ASCIZ/**/]
JSYS PSOUT
MOVEI D,SUBCMD ;SET TO RETURN TO SUBCMD
NXTCHR ;GET THE NEXT CHARACTER
CAIN A,QMARK ;QUERY
JRST SUBQRY
CAIN A,EOLC ;DONE?
JRST DONE ;YEP
CAIN A,CTRLL ;FOR LISTING?
JRST GETLST
CAIN A,CTRLR ;NON-STANDARD .REL FILE
JRST GETREL ;GET ONE FROM THE USER
CAIN A,SLASH ;SWITCH?
JRST PSWIT ;
CAIN A,CTRLQ
JRST DOHLT
CAIN A,CTRLU
JRST CMDRES
JRST SUBCMD ;KEEP LOOPING
GETREL:
SKIPE RPGSW
JRST .+3
HRROI A,[ASCIZ/REL file */]
JSYS PSOUT
MOVEI A,EREL ;addr. of tbl for long GTJFN
MOVE B,CMDJFN ;MAIN STRING POINTER IF ANY
JSYS GTJFN
JRST [MOVEM B,CMDJFN
JRST ERROR] ;NOTE THAT ERROR RETURNS TO SUBCOMMAND LEVEL IN THIS CASE
MOVEM A,BINJFN ;SAVE JFN
MOVEM B,CMDJFN ;possibly an updated BP
BAIL<
SKIPLE BAILON
PUSHJ P,SM1INI ;FOR DEBUGGER
>;BAIL
BACKUP
NXTCHR
CAIN A,ESCAPE ;GET ANOTHER CHAR IF TERM WITH ALTMODE
NXTCHR
MOVEI A,CTRLR ;MARK THE COMMAND
IDPB A,CMDPTR
HRRZ B,BINJFN ;ONLY RH BITS
MOVE A,CMDPTR ;SAVE THE JFN
MOVE C,[XWD 221100,000001] ;ITS ANYBODY'S GUESS IF THIS IS RIGHT!
JSYS JFNS ;PUT BINARY NAME INTO CMDLIN
MOVEI C,EOLC ;
IDPB C,A ;AN EOL
MOVEM A,CMDPTR
TLO FF,BINARY ;INDICATE BINARY FOR A BIT
JRST SUBCMD ;AND STAY IN SUBCOMMAND MODE
GETLST:
SKIPE RPGSW
JRST .+3
HRROI A,[ASCIZ/LST file */]
JSYS PSOUT
MOVEI A,ELST
MOVE B,CMDJFN
JSYS GTJFN
JRST [MOVEM B,CMDJFN
JRST ERROR]
MOVEM A,LISJFN
MOVEM B,CMDJFN
BAIL<
SKIPLE BAILON
PUSHJ P,SM1LST ;DEBUGGER NEEDS TO KNOW
>;BAIL
BACKUP
NXTCHR
CAIN A,ESCAPE ;IF TERMINATED WITH ESCAPE THEN
NXTCHR ;GET ANOTHER CHAR
MOVEI A,CTRLL
IDPB A,CMDPTR
HRRZ B,LISJFN
MOVE A,CMDPTR
MOVE C,[XWD 221100,000001]
JSYS JFNS
MOVEI C,EOLC ;PUT AN EOL
IDPB C,A ;AT THE END OF THE COMMAND BUFFER
MOVEM A,CMDPTR
TLO FF,LISTNG ;INDICATE LISTING FOR A BIT
JRST SUBCMD
PSWIT:
MOVE D,[POINT 7,SWTTXT,-1] ;BYTE POINTER TO STRING
SETZ 5, ;CHAR COUNT
PSWLUP: NXTCHR
CAIN A,CTRLQ ;QUIT?
JRST DOHLT
CAIN A,CTRLU ;RESET COMMAND
JRST CMDRES
CAIE A,CTRLR ;REPEAT LINE?
JRST NORPT
DOCTR: HRROI A,[ASCIZ!
/!]
JSYS PSOUT
JUMPE 5,PSWLUP
MOVEI A,101
MOVE B,[POINT 7,SWTTXT,-1]
MOVN C,5 ;COUNT
JSYS SOUT
JRST PSWLUP ;AND CONTINUE
NORPT: CAIE A,CTRLX ;RUBOUT (WHICH GOES TO SUBCOMMAND LEVEL)
JRST NOCTX
DOCTX: HRROI A,[ASCIZ/
/]
JSYS PSOUT
JRST SUBCMD
NOCTX: CAIE A,QRBOUT
CAIN A,CTRLA
JRST .+2
JRST NOCTA
JUMPLE 5,DOCTX
MOVEI A,"\"
JSYS PBOUT
LDB A,D ;LAST CHAR
JSYS PBOUT
MOVE A,D
JSYS BKJFN ;BACK UP THE BP
JFCL
MOVEM A,D
SOJA 5,PSWLUP ;DECREMENT COUNT AND CONTINUE
NOCTA: CAIE A,EOLC
CAIN A,ESCAPE
JRST PSWDUN
IDPB A,D
AOJA 5,PSWLUP ;LOOK FOR MORE
PSWDUN:
SETZ A,
IDPB A,D ;PUT A NULL BYTE
MOVEI A,SLASH
IDPB A,CMDPTR ;SAVE THE SWITCH
MOVE A,[POINT 7,SWTTXT,-1]
MOVE B,CMDPTR
SETZ C,
JSYS SIN
MOVEI C,EOLC
IDPB C,B
MOVEM B,CMDPTR
MOVE A,[POINT 7,SWTTXT,-1]
MOVEM A,SWTPTR
JSP PNT,SWTGET ;PROCESS THE SWITCH
;;#XN# ! JFR 9-18-76
SETZM SWTPTR
JRST SUBCMD ;MORE SUBCOMMANDS?
DONE:
hrroi a,[asciz \SAIL: \]
skipge xtflag
hrroi a,[asciz \XSAIL: \] ;special herald for extended
skipe tmpcnt ;if in ccl mode,
jsys psout ; output compiler name
MOVEI A,EOLC
IDPB A,CMDPTR
IDPB A,NAMPTR
HRROI A,NAMES
MOVEM A,NXTPTR
SKIPE BINJFN ;ALREADY DECIDED ABOUT BINARY
JRST DONE2 ;YES
MOVEI D,CMDSCN ;BE READY TO START OVER
MOVEI A,EREL1 ;NO EXTRA JFNS, NO CONFIRM
HRROI B,DEFFLN ;USE THE DEFAULT NAME
JSYS GTJFN
JRST ERROR ;SOMETHING IS WRONG
MOVEM A,BINJFN ;GOT IT
TLO FF,BINARY ;INDICATE BINARY FOR A BIT
done2:
BAIL<
skipge binjfn ;if no binary
setzm bailon ;then suppress bail
SKIPG BAILON ;GET .SM1 FILE ONLY IF BAIL ACTIVE
JRST DONE1 ;OTHERWISE QUIT
MOVEI D,CMDSCN
MOVEI A,ESM1
HRROI B,DEFFLN
JSYS GTJFN ;FOR DEBUGGER
JRST ERROR
MOVEM A,SM1JFN
>;BAIL
DONE1: POPJ P,
CMDRES: HRROI A,[ASCIZ/
Restarting ...
/]
JSYS PSOUT
JRST SAIL ;ALL OVER AGAIN
;HERE TO PRINT OUT LAST ERROR, RETURN ADDRESS IN D
ERROR: HRROI A,[ASCIZ/
/]
JSYS PSOUT
MOVEI A,101 ;PRIMARY OUTPUT
MOVE B,[XWD 400000,-1] ;THIS FORK, MOST RECENT ERROR
SETZ C,
JSYS ERSTR
JFCL
SKIPA A,[POINT 7,[ASCIZ/Cannot find TENEX error message.
/],-1]
HRROI A,[ASCIZ/
/]
JSYS PSOUT
JRST (D)
DOHLT: HRROI A,[ASCIZ/
Bye
/]
JSYS PSOUT
JSYS HALTF
JRST SAIL ;restart if continued
DSCR Routines to print out info
;
QUERY: HRROI A,[ASCIZ!
<filelist> ;compile file
_<filelist> ;compile with no binary
<filelist>, ;compile, subcommand mode
<filelist>_ ;compile, load with DDT
<filelist>,_ ;compile, load with DDT, subcommand
[Use "=" instead of "_" on TOPS20 in the above.]
^U start over
^Q quit
? this list
!]
JSYS PSOUT
JRST (D) ;RETURN
SUBQRY:
HRROI A,[ASCIZ!
Type one of the following characters:
^U start over
^Q quit
^R non-standard .REL file
^L listing file
/ switch specification
? this list
Legal switches include the following, where <num> is a number.
Edit switches with ^R, ^X, ^A or rubout.
G load after compilation
T load with DDT
R double parse stacks
C produce a cref listing
D double define PDL
P double PDL
Q double string PDL
H make sharable (default on TENEX)
I make non-sharable
K KOUNT feature
X Extended compilation
<num>S string space
<num>F listing format --
<num>B BAIL features
<num>A KI and KL numerical instructions
!]
JSYS PSOUT
JRST (D) ;RETURN
NXTJFN: MOVSI A,100001
MOVE B,NXTPTR
CAMN B,NAMPTR
JRST NXTDUN
JSYS GTJFN
CAIA ;ERROR RETURN
JRST NXTJF1
MOVEM B,NXTPTR ;SAVE NXTPTR
SYSERR: ERR <Confusion in command scanner>,1
JRST NXTJFN
NXTJF1: MOVEM B,NXTPTR
POPJ P,
NXTDUN: SETO A,
POPJ P,
DSCR Typing routines
;
.BACKUP:
SKIPE A,CMDJFN
JRST .BACK1
MOVEI A,100
JSYS BKJFN
JFCL
POPJ P,
.BACK1:
JSYS BKJFN
JFCL
MOVEM A,CMDJFN
POPJ P,
TYI:
;;#XN# JFR 9-18-76 for REQUIRE COMPILERSWITCHES
SKIPN SWTPTR ;COMMAND LINE?
JRST [SOSGE A,PNAME ;NO, REQUIRE
SETZM PNAME ;ALL DONE
ILDB A,PNAME+1
POPJ P,]
;;#XN# ^
ILDB A,SWTPTR
POPJ P,
.NXTCHR:
PUSH P,B
SKIPN A,CMDJFN
JRST .NXT1
JSYS BIN
CAIN B,15 ;IF A CARRIAGE RETURN
JRST .-2 ;THEN IGNORE
CAIN B,12 ;IF A LINE FEED
MOVEI B,EOLC ;THEN TRANSLITERATE TO AN EOL
MOVEM A,CMDJFN
.NXTRET:
MOVE A,B
POP P,B
POPJ P,
.NXT1:
MOVEI A,100 ;PRIMARY INPUT
JSYS BIN
CAIN B,15 ;IF A CARRIAGE RETURN
JRST .-2 ;THEN IGNORE
CAIN B,12 ;IF A LINE FEED
MOVEI B,EOLC ;THEN TRANSLITERATE TO AN EOL
JRST .NXTRET
DSCR Long form GTJFN tables.
;
EREL: XWD 400000,0 ;NEW VERSION
XWD 100,101
0
0
XWD -1,DEFFLN
XWD -1,[ASCIZ/REL/]
BLOCK 3
EREL1: XWD 400000,0
XWD 377777,377777
0
0
XWD -1,DEFFLN
XWD -1,[ASCIZ/REL/]
BLOCK 3
BAIL<
ESM1: XWD 400000,0
XWD 377777,377777
0
0
XWD -1,DEFFLN
XWD -1,[ASCIZ/SM1/]
BLOCK 3
>;BAIL
ELST: XWD 400000,0 ;NEW VERSION
XWD 100,101
0
0
XWD -1,DEFFLN
XWD -1,[ASCIZ/LST/]
BLOCK 3
ESAI: XWD 100000,0
XWD 100,101
0
0
0
XWD -1,[ASCIZ/SAI/]
BLOCK 3
;used by REQUIRE SOURCE!FILE
ESRC: XWD 100000,0
XWD 377777,377777
BLOCK 3
XWD -1,[ASCIZ/SAI/]
BLOCK 3
;when REQUIRE SOURCE!FILE fails, use this
ESRCT: XWD 100000,0
XWD 100,101
BLOCK 3
XWD -1,[ASCIZ/SAI/]
BLOCK 3
; ENTER HERE FROM SCAN WHEN EOF IS REACHED AND ANOTHER
; FILE IS NEEDED. IT IS AN ERROR IF NO MORE ARE LEFT
FILEIN:
MOVE TBITS2,SCNWRD
SKIPE SRCDLY ;IF ON, NOT END OF FILE, BUT SWITCH IN
JRST GETSR2
TLNE TBITS2,INSWT ;TIME TO SWITCH BACK TO PREV SOURCE FILE?
JRST UNSWT ;YES
GETSR2: SETZ A,
EXCH A,SRCDLY
JUMPN A,GETSWT
PUSHJ P,NXTJFN
JUMPG A,GETSR3
POPJ P, ;FAIL RETURN, NOSKIP
EXTERNAL TENXFI,CATCHR
GETSWT: EXCH SP,STPSAV
PUSH SP,PNAME ;CONVERT FILE NAME TO TENEX FORMAT
PUSH SP,PNAME+1
PUSHJ P,TENXFI
PUSH P,[0]
PUSHJ P,CATCHR ;AND PUT A NULL FOR GTJFN
POP SP,PNAME+1
POP SP,PNAME
EXCH SP,STPSAV
MOVE B,PNAME+1 ;BYTEPOINTER
MOVEI A,ESRC ;LONG FORM -- TABLE ABOVE
JSYS GTJFN
JRST GETSW1
JRST GETSR3 ;SWITCHING DATA AREAS ALREADY DONE.
GETSW1: ERR <Cannot GTJFN REQUIREd file, type RETURN to GTJFN from terminal>,1
HRROI A,[ASCIZ/
Filename */]
JSYS PSOUT
MOVEI A,ESRCT ;LONG FORM
SETZ B, ;GO TO TTY DIRECTLY
JSYS GTJFN
JRST GETSW1 ;ANOTHER ERROR!
JRST GETSR3
GETSRC:
GETSR1: PUSHJ P,NXTJFN
JUMPLE A,[ERR <Need a source file>]
GETSR3: MOVEM A,SRCJFN
JSYS DVCHR ;GET THE DEVICE CHARS
PUSH P,B ;SAVE THEM
PUSH P,C
MOVEI A,101 ;COMPARE TO THE CONTROLLING TERMINAL
JSYS DVCHR
SETO D, ;ASSUME THEY MATCH
CAMN B,-1(P) ;BUT DO THEY
CAME C,(P)
SETZ D, ;NO MATCH
MOVEM D,TTYSRC ;SAY WHETHER OR NOT IT IS THE CONTROLLING TERMINAL
SUB P,X22 ;ADJUST STACK
JUMPN D,OPNED ;DONT OPEN THE TTY -- WONT USE JFN ANYWAY
OPNUP: MOVE A,SRCJFN
MOVE B,[XWD 440000,200000] ;OPEN SOURCE - NOTE IS 36-BIT
JSYS OPENF
ERR <Can't open source file>
;NOW ALLOCATE INPUT BUFFER FOR SRCJFN, SET RELEVANT SWITCHED DATA
OPNED: HRRZI C,SRCBSZ+1 ;PLUS 1 FOR EOB NULL WORD
PUSHJ P,CORGET
ERR <DRYROT at CC: No core for allocation>
MOVEM B,BUFADR
ADD C,B
MOVE TEMP,B
HRLS TEMP
ADDI TEMP,1
SETZM -1(TEMP)
BLT TEMP,-1(C) ;CLEAR OUT BUFFER, SINCE CORGET DOESNT
SUBI B,1
HRLI B,700 ;MAKE THE KIND OF BP THAT POINTS A WORD EARLY
MOVEM B,SRCPNT
SETZM TNXBND ;CLEAR BUFFER END WORD FOR ADVBUF
BAIL<
SKIPG BAILON
JRST NBAI00
AOS TEMP,BNSRC ;INCR FILE COUNT
MOVEM TEMP,BSRCFN ;START OFF IN THE NEW FILE
SETZM BSRCFC ;AT BLOCK ZERO (FIRST READ WILL SET BLOCK TO 1)
MOVE B,SRCJFN
PUSHJ P,SM1LST+1 ;RE-USE PREVIOUS CODE
NBAI00:
>;BAIL
SETZM CRIND
HRROI 1,[ASCIZ/
/]
SKIPE SWTLNK
JSYS PSOUT ;PRINT CRLF TO TTY
MOVE 1,LININD
HRROI 1,INDTAB(1)
JSYS PSOUT
HRROI A,SRCFLN
HRRZ B,SRCJFN
SETZ C,
JSYS JFNS ;PRINT SRCFIL NAME TO TTY
IDPB C,A ;TERMINATING NULL CHAR
HRROI A,SRCFLN ;NOW PRINT THE NAME
JSYS PSOUT
SKIPN TTYSRC ;IS THE CONTROLLING TERMINAL THE SOURCE?
JRST .+3 ;NO
HRROI A,[ASCIZ/
Type ^Z for EOF, ^R, ^X, ^A to edit.
/]
JSYS PSOUT
AOS (P) ;SUCCESS -- SKIP RETURN FROM FILEIN
POPJ P,
INDTAB:0 ;INDENTING SPACES
ASCIZ / / ;LEVEL 1
ASCIZ / /;LEVEL 2
ASCIZ / /; L 3
ASCIZ / /;4
0 ;SAFETY
;definitions for TOPS-20
opdef jcomnd[104000000544]
opdef jprarg[104000000545]
opdef jrscan[104000000500]
.gtcnf__11 ;configuration table (on TOPS-10)
%cnmnt__112 ;monitor type offset in above
;comnd jsys function descriptor block offsets
.cmfnp__0 ;function code+flags,,link to next block
cm%po__125 ;parse field only
cm%hpp__124 ;help pointer provided
cm%dpp__123 ;default pointer provided
cm%sdh__122 ;suppress default help message
; .cmdat__1 ;data for function
.cmhlp__2 ;help text pointer
; .cmdef__3 ;default pointer
;comnd jsys command state block offsets
.cmflg__0 ;flag bits,,reparse dispatch address
.cmioj__1 ;I/O jfns
.cmrty__2 ;pointer to CTRL/R buffer
.cmbfp__3 ;pointer to start of text buffer
.cmptr__4 ;pointer to next input to be parsed
.cmcnt__5 ;count of space left in buffer
.cminc__6 ;count of characters left in buffer
; .cmabp__7 ;pointer to atom buffer
; .cmabc__10 ;size of atom buffer
; .cmgjb__11 ;address of GTJFN argument block
;comnd jsys function codes
.cmkey__0 ;keyword function
cm%fw__1b7 ;this is flag word (in keyword table)
cm%inv__1b35 ;suppress output of this keyword on ?
cm%nor__1b34 ;do not recognize this keyword
cm%abr__1b33 ;this is an abbreviation
.cmnum__1 ;number function
.cmnoi__2 ;guide word function
.cmswi__3 ;switch function
.cmifi__4 ;input file spec function
.cmofi__5 ;output file spec function
.cmfil__6 ;arbitrary file spec function
.cmfld__7 ;arbitrary field function
.cmcfm__10 ;confirm function
.cmdir__11 ;directory name function
.cmusr__12 ;user name function
.cmcma__13 ;comma function
.cmini__14 ;initialize function
.cmflt__15 ;floating-point number function
.cmdev__16 ;device name function
.cmtxt__17 ;text to carriage return function
.cmtad__20 ;date and time function
.cmqst__21 ;quoted string function
.cmuqs__22 ;unquoted string function
.cmtok__23 ;token function
.cmnux__24 ;number to non-numeric function
.cmact__25 ;account string function
.cmnod__26 ;network node name function
;bits returned on comnd call
cm%esc__1b0 ;ESC terminated this field
cm%nop__1b1 ;field could not be parsed
cm%eoc__1b2 ;CR terminated this field
cm%rpt__1b3 ;reparse needed due to editing of command
cm%swt__1b4 ;switch field terminated with a colon
cm%pfe__1b5 ;ESC terminated previous field
;gtjfn argument table offsets
.gjgen__0 ;flag bits,,generation number
gj%fou__1b0 ;new version to be created
gj%new__1b1 ;file must not exist
gj%old__1b2 ;file must exist
gj%msg__1b3 ;output message if user ends with esc
gj%cfm__1b4 ;confirmation is required
gj%tmp__1b5 ;file is temporary
gj%ns__1b6 ;search only first spec of multiple def
gj%acc__1b7 ;jfn can't be accessed by inferiors
gj%del__1b8 ;ignore deleted bit
gj%jfn__3b10 ;jfn is supplied
gj%ifg__1b11 ;wildcards allowed
gj%ofg__1b12 ;associate jfn with string, not file
gj%flg__1b13 ;return flags if successful
gj%phy__1b14 ;use physical device
gj%xtn__1b15 ;extended argument block
gj%fns__1b16 ;ignored in long form gtjfn
gj%sht__1b17 ;must be off for long form gtjfn
.gjsrc__1 ;i/o jfns
.gjdev__2 ;default device pointer
.gjdir__3 ;default directory pointer
.gjnam__4 ;default filename pointer
.gjext__5 ;default extension pointer
.gjpro__6 ;default protection pointer
.gjact__7 ;default account pointer
.gjjfn__10 ;jfn to associate with file
.gjf2__11 ;flags,,# words in extended block
.gjcpp__12 ;exact copy pointer
.gjcpc__13 ;number of bytes in above buffer
.gjrty__14 ;pointer to ^R buffer
.gjbfp__15 ;pointer to destination buffer
.gjatr__16 ;pointer to attribute block (reserved)
;function bits for rscan
.rsini__0 ;select rescan buffer
.rscnt__1 ;return number of characters remaining
;error codes
iox4__600220 ;"end of file reached"
npxnsw__602045 ;"Not a switch - does not begin with slash"
npxamb__602044 ;"Ambiguous switch"
;miscellany
df%nrj__1b0 ;don't release JFN on delf
.fhslf__400000 ;fork handle on self
no%lfl__1b2 ;nout flag meaning use leading fill chars
no%zro__1b3 ;nout flag meaning use 0's for fill chars
.nulio__377777 ;null I/O designator
.prard__1 ;read function for prarg
of%rd__1b19 ;allow read access flag for openf
.prast__2 ;set function for prarg
PM%CNT__1B0 ;REPEAT COUNT (FOR PMAP JSYS)
.priin__100 ;primary input device
.priou__101 ;primary output device
.gjf2__11 ;second flag word offset in extended
; gtjfn argument block
;***********************************************************
;* CCL20 is the scanner used to interface with the EXEC. *
;* Most of the subtlety is in getting the command in the *
;* first place. See USR20 for the scanner used when the *
;* user runs SAIL directly. *
;***********************************************************
;Note: we want to use the COMND jsys, but we do not always have
; a file to scan, since the argument may be in a PRARG block.
; Thus we put the text to be scanned where the COMND jsys would
; have put it had you typed it in, and then simulate a reparse.
;Note that COMND suppresses <cr>'s. So we must purge them.
;First get the commands from the EXEC
ccl20: skipe tmpcnt ;already got EXEC's commands?
jrst [ skipe costbl+.cminc ;yes, any left?
jrst reparc ;yes, go read them
haltf ;no, done
setzm tmpcnt
jrst sail] ;continue there
;Here we try to read a prarg block into TEXT and process it
move a,[.prard,,.fhslf] ;a/ function,,process handle
hrrzi b,text ;b/ address of block
hrrzi c,ltext ;c/ length of block
jsys prarg ;get program argument block
ercal jshlt0 ;handle errors
caile c,ltext ;if block too long for text area
jrst fousat ;fatal
jumpe c,trytmp ;if nothing there, try .TMP file
movn c,text ;minus number of lists to check
hrlzi c,(c) ;set up aobjn counter
aos c ; with 1 as first offset
finsai: move b,text(c) ;get offset of next list
hlrz a,text(b) ;get list name
cain a,'SAI' ;is it my list?
jrst fousai ;yes, go parse command
aobjn c,finsai ;no, check out next list
jrst trytmp ;didn't find it, try for .TMP file
;Here when we get the command in TEXT. B is an offset into TEXT,
;actually into TEXT+1 (i.e. B must be -1 to get TEXT).
fousai: move a,[point 7,text] ;here's where we'll put the commands
movei b,text+1(b) ;this is the string with the commands
hrli b,440700
movni c,5*ltext ;the count of bytes which can be written
hrlz c,c ;negative in LH (aobjn counter)
;Here we copy the string, purging <cr>'s. This is because we are
; simulating the COMND jsys's having set up the buffer by a previous
; input and now doing a rescan. COMND sets the flag to purge <cr>'s,
; and in fact demonstrably cannot handle <cr>'s in the buffer in
; certain cases. Note that we are copying from TEXT into TEXT. We
; are always moving backwards, so this is valid.
fousal: ildb d,b ;get one
cain d,15 ;if <cr>
jrst fousal ;ignore it
idpb d,a
jumpe d,fousan ;null - done
aobjn c,fousal ;loop if still room for null
fousat: hrroi a,[asciz \?Command string too big for COMND buffer\]
jsys psout
jrst jshlt1 ;fatal
;Now we have the commad string in TEXT - set up for COMND to read it
fousan: hrrz a,c ;RH of aobjn is count of char's, not
; including the null
push p,a ;save count of chars left to parse
movem a,tmpcnt ; and count of chars passed
move a,[.nulio,,.nulio] ;suppress prompt for ccl mode
movem a,costbl+.cmioj ; save jfns here
movei a,reparc ;where to go on reparse
movem a,costbl+.cmflg ; save output jfn here
move a,[point 7,cmpmt]
movem a,costbl+.cmrty
movei a,costbl ;a/ address of command state block
movei b,fdini ;b/ function decsriptor address
jsys comnd ;initialize command scanning
;Here we set things up to simulate a reparse
pop p,costbl+.cminc ;characters are still there
jrst reparc ;and go off to do actual parse
;Here to read from .TMP file
;make up file name in TEXT
trytmp: gjinf ;no info in prarg, try .tmp file
;build filename in core
move a,[point 7,text,-1] ;a/ destination designator
move b,c ;b/ number to be output (job number)
movei c,^d10 ;c/ radix in right half
hrli c,<(no%lfl+no%zro)>+3 ; flags (leading fill 0's) and number
; of digits
nout ;output the number
erjmp jshlt0 ;handle errors
hrroi b,[asciz \SAI.TMP\] ;b/ pointer to string
setz c, ;c/ number of bytes or zero
sout ;append that string
;open the file
hrlzi a,(gj%old+gj%sht) ;a/ flags (old file, short gtjfn)
move b,[point 7,text,-1] ;b/ source designator
gtjfn ;get jfn on file
erjmp [ hrroi a,[asciz \?Can't GTJFN .TMP file\] ;load up error msg
jsys psout ;explain problem
jrst jshlt1] ;then die
movei b,of%rd ;b/ flags in right half (read access)
hrli b,070000 ;b/ byte size in left half (bits 0-5)
openf ;open the file
erjmp [ hrroi a,[asciz \?Can't OPENF .TMP file\] ;error msg
jsys psout ;say what's happening
jrst jshlt1] ;die
;read it into TEXT
hrroi b,text ;where to put the commands
movni c,5*ltext-1 ;how many char's to read
sin
delf ;delete the file
jfcl
jumpe c,fousat ;file too long? - fatal
setz a, ;put null in for copy routine
idpb a,b
seto b, ;fake offset for copy routine
jrst fousai ;and go process text
;Now do the parse itself. Initialization.
;This code is just by prarg or .TMP commands. It is enterred from fousai.
reparc: pushj p,reinit ;reset all for reparse
;the following are defaults that are different for CCL commands
bail<
movei b,37 ;default to /bail:37
movem b,bailon
> ;bail
setom binjfn
;set up call to start off the finite-state machine
movsi b,(gj%ofg) ;set up for .REL file
movem b,gjblk+.gjgen
setzm gjblk+.gjnam ;no default name
hrroi b,[asciz \rel\]
movem b,gjblk+.gjext
movei b,lhs1 ;start with 1st LHS spec
;Main dispatch for the finite-state machine. The parsing is done
; by a set of tables for COMND. Each table is a list of 5-word
; blocks. The first 4 words are a COMND function descriptor.
; The 5th word is the dispatch address to use if COMND finds an
; argument described by that entry. These tables are linked together
; to form a simple finite-state machine.
;Since switches are legal anywhere, this always parses for switches
; before parsing for the specified argument. If the syntax changes,
; I propose using LH(B) as a flag for whether switches are allowed.
;Note that file names are a bit kludgey, since the arguments are not
; specified entirely in the function descriptor. So before using
; any table with a .CMFIL in it, we must set up GJBLK.
;Calling sequence:
; Initialize GJBLK if .CMFIL is to be used.
; MOVEI B,TABLE ;first entry in list of 5-word entries
; JRST PARDIS ;look for one and dispatch
;In order to parse switches in every case, we insert the table
;passed in B into the "next" field of CCLSWI (an FDB for switches)
;and then use CCLSWI. CCLSWI has a dispatch word pointing to
;PARDSW, the standard switch routine.
; PARDIS - main entry - use a new table
; PARDSL - entry after switch found - use same table as before
pardis: hrrm b,cclswi ;link block he asked for after switches
pardsl: movei a,costbl ;main comnd and dispatch
movei b,cclswi
jsys comnd ;look for what he wants
tlne a,(cm%nop) ;legal?
jrst nopars ;no - error and abort
jrst @4(c) ;routine to process what we found
pardsw: pushj p,usdosw ;process switch
jrst pardsl ;now go back for more
;COMND - MACRO FOR BUILDING FUNCTION DESCRIPTOR BLOCK
DEFINE FLDDB. (TYP,FLGS,DATA,HLPM,DEFM,LST) {
..xl__ typ11
ifdif {flgs} {} {..xl__..xl!<flgs-22>}
ifdif {hlpm} {} {..Xl__<cm%hpp-22>!..Xl}
ifdif {defm} {} {..Xl__<cm%dpp-22>!..Xl}
ifdif {lst} {} {xwd ..xl,lst}
ifidn {lst} {} {xwd ..xl,0}
ifdif {data} {} {data}
ifidn {data} {} {0}
ifdif {hlpm} {} {point 7,[asciz \hlpm\]}
ifidn {hlpm} {} {0}
ifdif {defm} {} {point 7,[asciz \defm\]}
ifidn {defm} {} {0}}
;Special macro for building the 5-word blocks. Includes
; simplified version of above.
; Dispatch is the routine to go to if something of this
; type is found.
; Next is a flag - non-empty is there is another entry
; following this one.
define field (typ,data,dispatch,next) {
ifdif {next} {} {xwd typ11,.+5}
ifidn {next} {} {xwd typ11,0}
ifdif {data} {} {data}
ifidn {data} {} {0}
0
0
xwd 0,dispatch}
define sym (str) {point 7,[asciz \str\]}
;Here are the tables that form the finite-state machine. LSH1 is
; the starting point.
;************************
;* LSH1 - .REL file *
;************************
lhs1: field (.cmtok,<sym(=)>,dorhs,x)
field (.cmtok,<sym(<,>)>,dolhs2,x)
field (.cmfil,,dolsh1)
;dolsh1 - may be either binary or run file
dolsh1: move a,b ;release dummy jfn
rljfn
erjmp jshlt0
move d,costbl+.cmptr ;point to next char
ildb d,d ;get next character
cain d,"!" ;is next character "!"?
jrst dorun ;yes, run the file
;now known to be binary
movei a,erel1 ;get the jfn for output .REL
hrroi b,atom ;and reparse what is in atom buffer
gtjfn
jrst nopars
movem a,binjfn ;save jfn
move b,a ;put where svdflt expects it
pushj p,svdflt ;and save as default
movei b,lhs2
jrst pardis ;now back to main dispatch
;here to process a file to be run
dorun: movei a,costbl
movei b,fdcfm ;yes, confirm run command
jsys comnd
tlne a,(cm%nop) ;parse successful?
jrst nopars ;no, complain
hrlzi a,(gj%old!gj%sht) ;old file, short gtjfn
hrroi B,atom ;pointer to string
jsys gtjfn
ercal jshlt0 ;handle errors
movem a,p ;save jfn
seto a, ;remove pages
movsi b,.fhslf ; from this fork
move c,[pm%cnt+1000] ; all 1000 pages
move d,[runcod,,7] ;move rest of code to
blt d,16 ; acs 7-16
jrst 7 ;do it there
runcod: pmap ;delete all pages from map
movsi a,.fhslf ;get into this fork
hrr a,17 ;from this file
get ;go get it
movei a,.fhslf ;our fork
gevec ;get forks entry vector
aos b ;use ccl entry
jrst (b) ;start fork
;************************
;* LHS2 - .LST file *
;************************
lhs2: field (.cmtok,<sym(=)>,dorhs,x)
field (.cmtok,<sym(<,>)>,dolhs2)
dolhs2: movsi b,(gj%fou) ;set up for output file
movem b,gjblk+.gjgen
hrroi b,[asciz \lst\] ;set up for default .lst
movem b,gjblk+.gjext
movei b,lhs2a
jrst pardis
lhs2a: field (.cmtok,<sym(=)>,dorhs,x)
field (.cmfil,,dlhs2a)
;dlhs2a - list file
dlhs2a: movem b,lisjfn ;save jfn
pushj p,svdflt ;save default file name, if none
movei b,rhs
jrst pardis ;now back for next field
;*********************************
;* RHS - = and then input files *
;*********************************
rhs: field (.cmtok,<sym(=)>,dorhs)
dorhs: move b,[point 7,names,-1] ;set up pointer
movem b,namptr ; for names of source files
movem b,nxtptr ; and for "next file" routine
inloop: pushj p,setsou ;set up fdfil for source parse
movei b,rhsfil ;parse for source file spec
jrst pardis
rhsfil: field (.cmfil,,dorhsf)
dorhsf: pushj p,svdflt ;save default file name, if none
pushj p,savsou ;save source filespec
movei b,rhsmor
jrst pardis
rhsmor: field (.cmtok,<sym(<,>)>,domore,x)
field (.cmcfm,,done)
domore: setz c, ;set up null byte
idpb c,namptr ; and separate filespecs with one
jrst inloop ;go get more input
;*******************************************************************
;* Common routines for the EXEC linkage and the user command *
;* interface, though not all of these routines are actually used *
;* by both *
;*******************************************************************
;subroutine to write filespec for jfn in b to namptr
; kills flags in lh of b, kills c, releases jfn
savsou: push p,a ;save comnd pointer
move a,namptr ;buffer for sources
tlz b,-1 ;don't need flag bits
setz c, ;default format
jsys jfns
movem a,namptr ;save source pointer
move a,b ;now, jfn in a
jsys rljfn ; to release the jfn for now
ercal jshlt0 ;handle errors nicely
pop p,a ;restore pointer
popj p,
;subroutine to set up fdfil to parse for source filespec
setsou: movsi b,(gj%old) ;old file flag
movem b,gjblk+.gjgen ; keep here
hrroi b,deffln ;default filename for source file
movem b,gjblk+.gjnam ; save it here
hrroi b,[asciz \sai\] ;default extension for source file
movem b,gjblk+.gjext ; goes here
hrroi b,[asciz \Source file name\] ;what ? says we want
movem b,fdfil+.cmhlp ; where that goes
popj p,
;subroutine to set up fdfil to parse for listing filespec
setlst: movsi b,(gj%fou) ;new version
movem b,gjblk+.gjgen ; save flags here
hrroi b,deffln ;default filename for listing file
movem b,gjblk+.gjnam ; save it here
hrroi b,[asciz \lst\] ;default extension for listing file
movem b,gjblk+.gjext ; save it here
hrroi b,[asciz \Listing file name\] ;say what we want
movem b,fdfil+.cmhlp ; if asked for help
popj p,
;subroutine to set up fdfil to parse for binary filespec
setbin: movsi b,(gj%fou) ;new version
movem b,gjblk+.gjgen ; save flags here
hrroi b,deffln ;default filename for binary file
movem b,gjblk+.gjnam ; save it here
hrroi b,[asciz \rel\] ;default extension for binary file
movem b,gjblk+.gjext ; save it here
hrroi b,[asciz \Binary file name\] ;say what we want
movem b,fdfil+.cmhlp ; if asked for help
popj p,
;subroutine to save sefault file name (from jfn in b)
svdflt: skipe deffln ;do we already have a default?
popj p, ;yes
push p,a ;save comnd pointer
hrroi a,deffln ;here's where we'll save default file name
movsi c,2000 ;just the file name
jsys jfns
pop p,a ;restore pointer
popj p,
;subroutine to reinitialize things
;basically undoes anything you could possibly do
; Note that this sets up defaults for the user scanner. Any defaults
; that are different for the EXEC linkage must be set up at REPARC.
reinit: skiple a,binjfn ;rel file specified?
jrst [ rljfn ;yes, get rid of it
erjmp jshlt0 ;handle errors
jrst .+1] ;continue
setzm binjfn ;no rel file yet
skiple a,lisjfn ;list file specified?
jrst [ rljfn ;yes, get rid of it
erjmp jshlt0 ;handle errors
jrst .+1] ;continue
setom lisjfn ;no list file either
hrlzi b,160000 ;reset scnwrd
movem b,scnwrd
setz ff, ; flags
setzm aswitc ;reset arithmetic switch
bail<
setzm bailon ;reset bail switch
>;bail
setzm deffln ;turn off default
movei b,50 ;reset definition pdl length
hrrm b,dfmax
movei b,20 ;reset string pdl length
hrrm b,spmax
movei b,100 ;reset parse stacks' lengths
hrrm b,ppmax
hrrm b,gpmax
hrrm b,pcmax
movei b,36 ;scwmax starts out differently
hrrm b,scwmax
movei b,100 ;reset regular pdl
hrrm b,pdlmax
movei b,7 ;now format switch
movem b,fmtwrd
hllzs xtflag ;extended flag
setzm lodmod ;no load after compiling
setzm lodddt ;no load ddt either
setom hisw ;generate two-seg code
setzm kount ;flag not doing profile
movei b,^D4500 ;[05] initial stmaxx, increased from
;[05] 3500 to 4500 to prevent increased
;[05] GC freq due to STRNG(SYM) fix.
hrrm b,stmaxx
popj p,
;routine to do comnd jsys, - no parse, no return
comndj: movei a,costbl ;a/ addr of command state block
jsys comnd ;do the actual jsys
tlne a,(cm%nop) ;parse failed?
jrst nopars ;yes, complain
popj p,
;general error printer for errors that should abort the current
; command. Since the EXEC interface is non-interactive, all
; errors are fatal there.
nopars: move p,pdlsav ;fix up pointer
hrroi a,[asciz \
?\] ;error somewhere
jsys psout ;start complaint
movei a,.priou ;output designator
hrli b,.fhslf ;fork handle in lh (error code already in rh)
setz c, ;character count
erstr ;output problem
jfcl
jfcl
hrroi a,[asciz \ - \] ;separate nicely
jsys psout
hrroi a,atom ;point to probable problem
jsys psout ;show user
hrrei b,-1 ;find last byte output
adjbp b,a
ldb b,b
movei a,"J"-100 ;output a linefeed
cain b,"M"-100 ; iff last char output was carriage return
jsys pbout
skipe tmpcnt ;and if doing ccl commands
jrst jshlt1 ; then die permanently
; otherwise, fall thru
;**************************************************************
;* Here is the command scanner for direct user interaction. *
;**************************************************************
usr20: skipe tmpcnt ;already done rscanned command?
jrst [jsys haltf ;yes - done
setzm tmpcnt ;if continue, normal restart
jrst sail]
;First we check to see if there is a command to be had from rscan
movei a,.rsini ;try to get command with rscan
jsys rscan
jrst norm20 ;failed, normal user interface
jumpe a,norscn ;nothing there, normal user interface
movei a,.priou ;set position to 0 to avoid extra crlf
rfpos ;get current tty position
hrri b,0 ;set column to 0
sfpos
move a,[.priin,,.priou] ;normal jfn's
movem a,costbl+.cmioj
movei a,reparu
movem a,costbl+.cmflg ;reparse addr
move a,[point 7,cmnpmt] ;null prompt
movem a,costbl+.cmrty
movei a,costbl ;do .cmini
movei b,fdini
jsys comnd ;initialize comnd
movem p,pdlsav ;save stack for reparse
movei a,costbl ;
movei b,fdrun ;see if RUN, R, or ERUN
jsys comnd
tlnn a,(cm%nop) ;if so
jrst norscn ;use normal interface
movsi a,(gj%ofg) ;parse only
movem a,gjblk
movei a,costbl
movei b,fdfil ;now skip the SYS:SAIL.EXE
jsys comnd
tlne a,(cm%nop) ;was it there?
jrst norscn ;no - use normal interface
move a,b ;release the jfn
jsys rljfn
jfcl
;We now do the initial field as at REPARU, except
;that we also allow CRLF. If the user types CRLF, we kill the CCL
;mode and give him a normal prompt.
pushj p,reinit ;reset everything nicely
move b,[point 7,names,-1] ;pointer
movem b,namptr ; for building list of names
movem b,nxtptr ; and for retrieving them
pushj p,setsou ;set up fdfil for source parsing
setzm gjblk+.gjnam ;no default filename for source file
movei b,rswsou ;get source file spec or switch
setom tmpcnt ;say CCL mode (prevents loop if error)
pushj p,comndj
hrli c,331100 ;byte ptr to ftn code
ldb c,c ;get ftn code
cain c,.cmcfm ;if <cr>
jrst norscn ;cancel CCL mode
jrst usinlr ;yes - continue rscan
;This reinitializes for normal user I/O in case no rescanned command
norscn: hrroi a,[0]
jsys rscan ;forget any rscanned stuff
jfcl
norm20: setzm tmpcnt ;not CCL mode (recycle if error)
move a,[.priin,,.priou] ;set up jfns for user interface
movem a,costbl+.cmioj ; save jfns here
movei a,reparu ;where to go on reparse
movem a,costbl+.cmflg ; save output jfn here
move a,[point 7,cmpmt] ;use real prompt
movem a,costbl+.cmrty
movei a,costbl ;a/ address of command state block
movei b,fdini ;b/ function decsriptor address
jsys comnd ;initialize command scanning
movem p,pdlsav ;save stack pointer
;This is the reparse entry
reparu: move p,pdlsav ;start with initial pointer
pushj p,reinit ;reset everything nicely
move b,[point 7,names,-1] ;pointer
movem b,namptr ; for building list of names
movem b,nxtptr ; and for retrieving them
usinlp: pushj p,setsou ;set up fdfil for source parsing
setzm gjblk+.gjnam ;no default filename for source file
movei b,swisou ;get source file spec or switch
pushj p,comndj
hrli c,331100 ;byte ptr to ftn code
ldb c,c ;c _ addr of ftn code
;Here the rescan code joins us
usinlr: cain c,.cmswi ;was it switch?
jrst usinla ;yes, go process switch
pushj p,svdflt ;save default filename if none already there
pushj p,savsou ;save source file spec
jrst usinl1 ;got filespec, go confirm
usinla: pushj p,usdosw ;go process switch
jrst usinlp ; and back for more filespecs
usinl1: movei b,swiccf ;parse for switch, comma or carriage return
pushj p,comndj
hrli c,331100 ;build byte pointer
ldb c,c ;get matching function
cain c,.cmswi ;switch?
jrst usinl2 ;yes, process switch
cain c,.cmcfm ;confirm?
jrst done20 ;yes, go process request
setz c, ;null byte
idpb c,namptr ; to separate filenames
jrst usinlp ;now back for more filespecs
usinl2: pushj p,usdosw ;process switch
jrst usinl1 ;and back for more switches
done20: skipe lisjfn ;if no listing file,
jrst done ; continue with processing
pushj p,setlst ;set up for listing file spec
push p,gjblk+.gjsrc ;save i/o jfns
move a,[.nulio,,.nulio] ;don't need any i/o
movem a,gjblk+.gjsrc ;set all to null
movei a,gjblk ;a/ address of block
hrroi b,deffln ;b/ pointer to string
gtjfn ;get listing filespec
erjmp jshlt0 ;handle errors
pop p,gjblk+.gjsrc ;restore i/o jfns
movem a,lisjfn ;save jfn
jrst done
;subroutine to process switches
usdosw: move b,(b) ;get entry from switch table
jrst (b) ;dispatch to switch routine
;arithmetic switch
ariswt: movei b,onopak ;parse for octal number, open parens,
; or arithmetic keyword
pushj p,comndj
hrli c,331100 ;build byte pointer
ldb c,c ;get matching function
cain c,.cmnum ;get an octal number?
jrst arionm ;yes, just stuff it
caie c,.cmkey ;single keyword?
pushj p,ari2kw ;no, go process more than one
pushj p,onekw ;yes, just process one keyword
move b,d ;put switch(es) in b
arionm: movem b,aswitc ;save specified switch here
popj p,
ari2kw: setz d, ;start with zero word
ari2k1: movei b,fdakw ;parse for keyword
pushj p,comndj
hrrz b,(b) ;get address of switch value/noise
hlrz c,(b) ;get switch value
ior d,c ;save with other switches
hrrz b,(b) ;address of noise word in b
pushj p,comndj
movei b,cmacpn ;then parse comma or close parens
pushj p,comndj
hrli c,331100 ;build byte pointer
ldb c,c ;get function which matched
cain c,.cmcma ;comma?
jrst ari2k1 ;yes, go get another switch
move b,d ;return switches in b
aos (p) ; and give skip return
popj p,
;bail switch
bail<
baiswt: movei b,onopbk ;parse for octal number, open parens,
; or bail keyword
pushj p,comndj
hrli c,331100 ;build byte pointer
ldb c,c ;get matching function
cain c,.cmnum ;get an octal number?
jrst baionm ;yes, just stuff it
caie c,.cmkey ;single keyword?
pushj p,bai2kw ;no, go process more than one
pushj p,onekw ;yes, just process one keyword
move b,d ;put switch(es) in b
baionm: movem b,bailon ;save specified switch here
popj p,
bai2kw: setz d, ;start with zero word
bai2k1: movei b,fdbkw ;parse for keyword
pushj p,comndj
hrrz b,(b) ;get address of switch value/noise
hlrz c,(b) ;get switch value
ior d,c ;save with other switches
hrrz b,(b) ;address of noise word in b
pushj p,comndj
movei b,cmacpn ;then parse comma or close parens
pushj p,comndj
hrli c,331100 ;build byte pointer
ldb c,c ;get function which matched
cain c,.cmcma ;comma?
jrst bai2k1 ;yes, go get another switch
move b,d ;return switches in b
aos (p) ; and give skip return
popj p,
>;bail
;routine to output noise, return switch value
onekw: hrrz b,(b) ;get address of switch value/noise
hlrz d,(b) ;save switch value in d
hrrz b,(b) ;address of noise word in b
pushj p,comndj
popj p, ;yes, return with that
;binary switch
binswt: pushj p,nbinsw ;kill all old info about binary file
setzm binjfn ;but remember we want one
tlnn a,(cm%swt) ;field ended with a colon?
popj p, ;no, don't ask for filespec
pushj p,setbin ;set up fdfil to parse for binary file
movei b,fdfil ;parse for listing file
pushj p,comndj
movem b,binjfn ;save jfn
popj p,
;cref switch
; cclcrf is for CCL's /CREF, which doesn't take argument
cclcrf: skipge lisjfn ;compiler gets confused if /CREF
popj p, ;and no listing, so ignore if none
jrst cclcr1
crfswt: pushj p,lstswt ;get listing filespec
cclcr1: movsi b,crefit ;get cref switch
iorm b,scnwrd ; turn on here
tlo ff,crefsw ; and here
popj p,
;definition-pdl switch
dpdswt: tlnn a,(cm%swt) ;field ended with a colon?
jrst dpddbl ;no, just double stack
movei b,fddsl ;parse for decimal stack length
pushj p,comndj
jumpe b,dpddbl ;if zero, double stack
jrst dpddnm ;have number, go save that
dpddbl: hrrz b,dfmax ;get old stack value
lsh b,1 ;double it
dpddnm: hrrm b,dfmax ;save new value
popj p,
;extended switch
extswt: movei b,extnoi ;noise
pushj p,comndj
hllos xtflag
popj p,
;format switch
fmtswt: movei b,onopfk ;parse for octal number, open parens,
; or format keyword
pushj p,comndj
hrli c,331100 ;build byte pointer
ldb c,c ;get matching function
cain c,.cmnum ;get an octal number?
jrst fmtonm ;yes, just stuff it
caie c,.cmkey ;single keyword?
pushj p,fmt2kw ;no, go process more than one
pushj p,onekw ;yes, just process one keyword
move b,d ;put switch(es) in b
fmtonm: movem b,fmtwrd ;save specified switch here
move c,[760000,,1] ;make mask
andcam c,scnwrd ;turn off user-controlled bits
andi b,77 ;only six bits to change
rot b,-5 ;put them where they're found in scnwrd
iorm b,scnwrd ; and or them in
popj p,
fmt2kw: setz d, ;start with zero word
fmt2k1: movei b,fdfkw ;parse for keyword
pushj p,comndj
hrrz b,(b) ;get address of switch value/noise
hlrz c,(b) ;get switch value
ior d,c ;save with other switches
hrrz b,(b) ;address of noise word in b
pushj p,comndj
movei b,cmacpn ;then parse comma or close parens
pushj p,comndj
hrli c,331100 ;build byte pointer
ldb c,c ;get function which matched
cain c,.cmcma ;comma?
jrst fmt2k1 ;yes, go get another switch
move b,d ;return switches in b
aos (p) ; and give skip return
popj p,
;go switch
goswt: movei b,gonoi ;noise
pushj p,comndj
setom lodmod
popj p,
;list switch
lstswt: pushj p,ncrfsw ;kill all old info about listing file
setzm lisjfn ;but remember we want one
tlnn a,(cm%swt) ;field ended with a colon?
popj p, ;no, don't ask for filespec
pushj p,setlst ;set up fdfil to parse for listing file
movei b,fdfil ;parse for listing file
pushj p,comndj
movem b,lisjfn ;save jfn
popj p,
;mode-for-debugging switch
modswt: movei b,fddnm ;decimal number
pushj p,comndj
setzm multp ;for mode 5
setzm plinsw
caie b,4
setzm .dbg. ;to get all switches initialized
jumpl b,moddon ;no negatives
hrloi temp,400000 ;xwd 400000,-1 for scan break
caig b,6 ;must be 6 or less
xct dbmd(b)
moddon: popj p,
;no binary switch
nbinsw: PUSH P,A ;SAVE AC
skiple A,binjfn ;if binary file specified,
jrst [ rljfn ;yes, get rid of it
erjmp jshlt0 ;handle errors
jrst .+1] ;continue
POP P,A ;RESTORE
setom binjfn ;no binary file yet
popj p,
;no cref (or listing) switch
ncrfsw: PUSH P,A ;SAVE A
skiple A,lisjfn ;if listing file specified,
jrst [ rljfn ;yes, get rid of it
erjmp jshlt0 ;handle errors
jrst .+1] ;continue
POP P,A ;RESTORE
setom lisjfn ;no listing file yet
movsi b,crefit ;get cref switch
andcam b,scnwrd ; turn off here
tlz ff,crefsw ; and here
popj p,
;offset switch
offswt: tlnn a,(cm%swt) ;field ended with a colon?
jrst offddt ;no, use -1 as default
movei b,offnoi ;noise
pushj p,comndj
movei b,fdonm ;octal number
pushj p,comndj
camn b,[-1] ;ddt?
offddt: movei b,lpserr-1 ;length of ddt with sail low seg
camn b,[-2]
jrst [ movei b,12237 ;length of raid with sail low seg
skipe jobddt ; here is a better number
movei b,lpserr-1 ;end of ddt
jrst .+1]
movem b,lststrt ;set it up
popj p,
;one-segment switch
oneswt: movei b,codnoi ;noise
pushj p,comndj
setzm hisw
popj p,
;pdl switch
pdlswt: tlnn a,(cm%swt) ;field ended with a colon?
jrst pdldbl ;no, just double stack
movei b,fddsl ;parse for decimal stack length
pushj p,comndj
jumpe b,pdldbl ;if zero, double stack
jrst pdldnm ;have number, go save that
pdldbl: hrrz b,pdlmax ;get old stack value
lsh b,1 ;double it
pdldnm: hrrm b,pdlmax ;save new value
popj p,
;parse-stacks switch
ppdswt: tlnn a,(cm%swt) ;field ended with a colon?
jrst ppddbl ;no, just double stack
movei b,fddsl ;parse for decimal stack lencth
pushj p,comndj
jumpe b,ppddbl ;if zero, double stack
jrst ppddnm ;have number, go save that
ppddbl: hrrz b,ppmax ;get old stack value
lsh b,1 ;double it
ppddnm: hrrm b,ppmax ;save new value in lots of stacks
hrrm b,gpmax
hrrm b,pcmax
hrrm b,scwmax
popj p,
;profile switch
proswt: movei b,pronoi ;noise
pushj p,comndj
skipge lisjfn ;make sure we're listing
jrst [ hrroi a,[asciz \
%PROFILE counters inserted only when listing - counters not inserted
\]
psout
popj p,]
movsi b,crefit ;get cref flag
tdne b,scnwrd ;are we creffing?
jrst [ hrroi a,[asciz \
%PROFILE counters and CREF are presently incompatible - counters not inserted
\]
psout
popj p,]
movei b,macexp ;get format for
hrlm b,scnwrd ; listing file
lsh b,-=13 ;move it there
movem b,fmtwrd ; and save it there
setom kount ;flag we're inserting counters
popj p,
;string-pdl switch
spdswt: tlnn a,(cm%swt) ;field ended with a colon?
jrst spddbl ;no, just double stack
movei b,fddsl ;parse for decimal stack length
pushj p,comndj
jumpe b,spddbl ;if zero, double stack
jrst spddnm ;have number, go save that
spddbl: hrrz b,spmax ;get old stack value
lsh b,1 ;double it
spddnm: hrrm b,spmax ;save new value
popj p,
;string-space switch
stsswt: movei b,fddnm ;parse for a decimal number
pushj p,comndj
hrrm b,stmaxx ;save new string space
popj p,
;test switch
tstswt: movei b,tstnoi ;noise
pushj p,comndj
setom lodmod ;load after compiling
setom lodddt ;load with ddt
popj p,
;two-segment switch
twoswt: movei b,codnoi ;noise
pushj p,comndj
setom hisw
popj p,
;dummy routine for unimplemented switches
swnimp: movei a,"%" ;give warning message
jsys pbout
hlro a,b ;get switch specified
psout ;say it
hrroi a,[asciz \ switch not implemented yet
\] ;warn it doesn't work
jsys psout
popj p,
;non-fatal jsys error handler
; ercal jserr0
; returns +1: always, can be used in +1 return of jsys's
jserr0: movei a,.priin ;a/ input designator
jsys cfibf ;clear typeahead
movei a,.priou ;a/ output designator
jsys dobe ;wait for previous output to finish
hrroi a,[asciz \
? JSYS ERROR: \] ;prefix message
jsys psout
movei a,.priou ;a/ output designator
hrloi b,.fhslf ;b/ this fork,,error number (last)
setz c, ;c/ output limit (none)
jsys erstr ;output standard error message
jfcl ;error return
jfcl ;error return
hrroi a,[asciz \
\] ;output crlf
jsys psout
popj p, ;done
;fatal jsys error - print message and halt
; erjmp jshlt0
; returns: never
jshlt0: pushj p,jserr0 ;print the message
jshlT1: jsys haltf ;then die
hrroi a,[asciz \PROGRAM CANNOT CONTINUE
\] ;if continued,
jsys psout ; say can't be done
jrst jshlt1 ;then die again
;***************************************************************
;* Here we have tables that can be used by both scanners, *
;* though more of them are used by the user command scanner. *
;***************************************************************
data
costbl: 0,,0 ;flags,,reparse address
.priin,,.priou ;I/O jfns
point 7,cmpmt ;pointer to ^R buffer
point 7,text ; " " text buffer
point 7,text ; " " next parse
ltext*5 ;how much room in buffer
0 ;how many chars in text buffer
point 7,atom ;pointer to atom buffer
latom*5 ;how much room in atom buffer
gjblk ;address of gtjfn argument block
cmpmt: asciz \SAIL>\ ;comnd prompt
cmnpmt: asciz \\ ;null prompt
ltext__1000 ;length of text buffer
text: block ltext ;text input buffer
latom__20 ;length of atom buffer
atom: block latom ;atom buffer
gjblk: block 16 ;gtjfn argument block
;This flddb. is in the lowseg because the code plays with the NEXT pointer
cclswi: flddb. (.cmswi,,ccswtb) ;switches for CCL parse
,pardsw ;dispatch if this one matches
enddata
swiccf: flddb. (.cmcma,,,,,<[
flddb. (.cmcfm,,,,,<[ ;comma or confirm
flddb. (.cmswi,,switab)]>)]>) ;or switch
cmacpn: flddb. (.cmcma,,,,,<[
flddb. (.cmtok,,<point 7,[asciz \)\]>)]>) ;comma or close parens
onopak: flddb. (.cmnum,,10,,,<[
flddb. (.cmtok,,<point 7,[asciz \(\]>,,,<[
flddb. (.cmkey,,akwtab)]>)]>) ;octal number, open parens,
; or arithmetic keyword
bail<
onopbk: flddb. (.cmnum,,10,,,<[
flddb. (.cmtok,,<point 7,[asciz \(\]>,,,<[
flddb. (.cmkey,,bkwtab)]>)]>) ;octal number, open parens,
; or bail keyword
>;bail
onopfk: flddb. (.cmnum,,10,,,<[
flddb. (.cmtok,,<point 7,[asciz \(\]>,,,<[
flddb. (.cmkey,,fkwtab)]>)]>) ;octal number, open parens,
; or format keyword
swisou: flddb. (.cmswi,,switab,,,<[ ;source file or switch
flddb. (.cmfil,cm%sdh,,source file)]>)
;rswsou is a special version of swisou for use in RSCAN. It also
;allows a <crlf> (though it is silent about this is the help message)
;in case the user doesn't want to type the arg's on the same line.
rswsou: flddb. (.cmcfm,cm%sdh,,,,swisou)
fdini: flddb. (.cmini)
fdifi: flddb. (.cmifi) ;parse an input file spec
fdofi: flddb. (.cmofi) ;parse an output file spec
fdfil: flddb. (.cmfil,cm%sdh,,arbitrary) ;parse an arbitrary file spec
fdakw: flddb. (.cmkey,,akwtab) ;parse arithmetic keywords
akwtab: akwtln,,akwtln
[asciz \ADJSP\],,[10,,anoi10]
[asciz \F10\],,[20,,anoi20]
[asciz \FIXR\],,[2,,anoi2]
[asciz \FLTR\],,[4,,anoi4]
[asciz \KIFIX\],,[1,,anoi1]
akwtln==.-akwtab-1
anoi1: flddb. (.cmnoi,,<point 7,[asciz \for real to integer conversion\]>)
anoi2: flddb. (.cmnoi,,<point 7,[asciz \for real to integer conversion\]>)
anoi4: flddb. (.cmnoi,,<point 7,[asciz \for integer to real conversion\]>)
anoi10: flddb. (.cmnoi,,<point 7,[asciz \KL-only stack manipulation\]>)
anoi20: flddb. (.cmnoi,,<point 7,[asciz \calling sequence for FORTRAN\]>)
bail<
fdbkw: flddb. (.cmkey,,bkwtab) ;parse bail keywords
bkwtab: bkwtln,,bkwtln
[asciz \DESCRIPTORS\],,[4,,bnoi4]
[asciz \NOLOAD\],,[10,,bnoi10]
[asciz \PC\],,[1,,bnoi1]
[asciz \PREDECLARED\],,[20,,bnoi20]
[asciz \SYMBOLS\],,[2,,bnoi2]
bkwtln==.-bkwtab-1
bnoi1: flddb. (.cmnoi,,<point 7,[asciz \to source/listing directory\]>)
bnoi2: flddb. (.cmnoi,,<point 7,[asciz \information included\]>)
bnoi4: flddb. (.cmnoi,,<point 7,[asciz \for SIMPLE procedures\]>)
bnoi10: flddb. (.cmnoi,,<point 7,[asciz \SYS:BAIL.EXE automatically\]>)
bnoi20: flddb. (.cmnoi,,<point 7,[asciz \SAIL runtimes known\]>)
>;bail
fdfkw: flddb. (.cmkey,,fkwtab) ;parse format keywords
fkwtab: fkwtln,,fkwtln
[asciz \BRACKET-MACROS\],,[20,,fnoi20]
[asciz \EXPAND-MACROS\],,[10,,fnoi10]
[asciz \LINES-NUMBERS\],,[2,,fnoi2]
[asciz \MACRO-NAMES\],,[4,,fnoi4]
[asciz \NOBANNER\],,[100,,fno100]
[asciz \NOLIST\],,[40,,fnoi40]
[asciz \PC\],,[1,,fnoi1]
fkwtln==.-fkwtab-1
fnoi1: flddb. (.cmnoi,,<point 7,[asciz \to listing file\]>)
fnoi2: flddb. (.cmnoi,,<point 7,[asciz \from source to listing file\]>)
fnoi4: flddb. (.cmnoi,,<point 7,[asciz \listed before expansion\]>)
fnoi10: flddb. (.cmnoi,,<point 7,[asciz \in listing file\]>)
fnoi20: flddb. (.cmnoi,,<point 7,[asciz \with < and >\]>)
fnoi40: flddb. (.cmnoi,,<point 7,[asciz \generated\]>)
fno100: flddb. (.cmnoi,,<point 7,[asciz \at the top of each page\]>)
fdswi: flddb. (.cmswi,,switab) ;parse from a list of switches
switab: switln,,switln
[asciz \ARITHMETIC:\],,ariswt
bail<
[asciz \BAIL:\],,baiswt
>;bail
[asciz \BINARY:\],,binswt
[asciz \CREF:\],,crfswt
[asciz \DEFINITION-PDL:\],,dpdswt
[asciz \EXTENDED\],,extswt
[asciz \FORMAT:\],,fmtswt
[asciz \GO\],,goswt
[asciz \LIST:\],,lstswt
[cm%fw+cm%inv
asciz \MODE-FOR-DEBUGGING:\],,modswt
[asciz \NOBINARY\],,nbinsw
[asciz \NOCREF\],,ncrfsw
[asciz \NOLIST\],,ncrfsw
[asciz \OFFSET:\],,offswt
[asciz \ONE-SEGMENT\],,oneswt
[asciz \PARSE-STACKS:\],,ppdswt
[asciz \PDL:\],,pdlswt
[asciz \PROFILE\],,proswt
[cm%fw+cm%inv+cm%abr
asciz \S\],,stspa
[cm%fw+cm%inv+cm%abr
asciz \ST\],,stspa
[cm%fw+cm%inv+cm%abr
asciz \STR\],,stspa
[cm%fw+cm%inv+cm%abr
asciz \STRI\],,stspa
[cm%fw+cm%inv+cm%abr
asciz \STRIN\],,stspa
[cm%fw+cm%inv+cm%abr
asciz \STRING\],,stspa
[cm%fw+cm%inv+cm%abr
asciz \STRING-\],,stspa
[asciz \STRING-PDL:\],,spdswt
stspa: [asciz \STRING-SPACE:\],,stsswt
[asciz \TEST\],,tstswt
[asciz \TWO-SEGMENT\],,twoswt
switln==.-switab-1
;Special switch table for CCL use. Note that switches specifying
; .REL or listing output are not appropriate for CCL use, since
; that is handled otherwise. Hence this list is missing a few
; entries that are present above.
ccswtb: ccswln,,ccswln
[asciz \ARITHMETIC:\],,ariswt
bail<
[asciz \BAIL:\],,baiswt
>;bail
[asciz \CREF\],,cclcrf
[asciz \DEFINITION-PDL:\],,dpdswt
[asciz \EXTENDED\],,extswt
[asciz \FORMAT:\],,fmtswt
[cm%fw+cm%inv
asciz \MODE-FOR-DEBUGGING:\],,modswt
[asciz \OFFSET:\],,offswt
[asciz \ONE-SEGMENT\],,oneswt
[asciz \PARSE-STACKS:\],,ppdswt
[asciz \PDL:\],,pdlswt
[asciz \PROFILE\],,proswt
[asciz \STRING-PDL:\],,spdswt
[asciz \STRING-SPACE:\],,stsswt
[asciz \TWO-SEGMENT\],,twoswt
ccswln==.-ccswtb-1
fdrun: flddb. (.cmkey,,runktb)
runktb: runktl,,runktl
[asciz \ERUN\],,0
[asciz \RUN\],,0
[asciz \START\],,0
runktl==.-runktb-1
extnoi: flddb. (.cmnoi,,<point 7,[asciz \compiler facilities\]>)
gonoi: flddb. (.cmnoi,,<point 7,[asciz \ahead and load after compiling\]>)
codnoi: flddb. (.cmnoi,,<point 7,[asciz \code generated\]>)
offnoi: flddb. (.cmnoi,,<point 7,[asciz \for PC in listing\]>)
pronoi: flddb. (.cmnoi,,<point 7,[asciz \counters inserted\]>)
tstnoi: flddb. (.cmnoi,,<point 7,[asciz \with DDT\]>)
fddnm: flddb. (.cmnum,,12) ;parse a decimal number
fddsl: flddb. (.cmnum,cm%sdh,12,<Decimal stack length
or zero or the switch without a colon to double the current length>)
;parse a decimal stack length
fdonm: flddb. (.cmnum,,10) ;parse an octal number
fdcpn: flddb. (.cmtok,,<point 7,[asciz \)\]>) ;parse a close parens
fdequ: flddb. (.cmtok,,<point 7,[asciz \=\]>) ;parse an equals sign
fdopn: flddb. (.cmtok,,<point 7,[asciz \(\]>) ;parse an open parens
fdcma: flddb. (.cmcma) ;parse a comma
fdcfm: flddb. (.cmcfm) ;comfirm command string
SUBTTL Production Interpreter
>;TENX