perm filename CC[10X,AIL]16 blob
sn#342547 filedate 1978-03-26 generic text, type T, neo UTF8
00100 COMMENT ⊗ VALID 00017 PAGES
00200 C REC PAGE DESCRIPTION
00300 C00001 00001
00400 C00002 00002 TENX<TENEX COMMAND SCANNER
00500 C00005 00003 DSCR COMND
00600 C00009 00004 CMDSCN:
00700 C00014 00005 GOSUB: IDPB A,CMDPTR SAVE WHATEVER CHAR IT WAS
00800 C00017 00006 SUBCMD: SKIPE RPGSW
00900 C00018 00007
01000 C00020 00008 GETLST:
01100 C00021 00009 PSWIT:
01200 C00023 00010 DONE:
01300 C00025 00011 DSCR Routines to print out info
01400 C00027 00012
01500 C00028 00013 DSCR Typing routines
01600 C00030 00014 DSCR Long form GTJFN tables.
01700 C00032 00015
01800 C00037 00016
01900 C00038 00017
02000 C00039 ENDMK
02100 C⊗;
00100 TENX<;TENEX COMMAND SCANNER
00200
00300
00400 ZERODATA (TENEX COMMAND SCANNER)
00500
00600 ?BINJFN: 0
00700 ?LISJFN: 0
00800 BAIL<
00900 ?SM1JFN: 0 ;FOR DEBUGGER
01000 ?SM1PNT: 0
01100 ?SM1CNT: 0
01200 SM1SIZ←←200
01300 ?SM1BUF: BLOCK SM1SIZ
01400 >;BAIL
01500 ;SRCJFN is in switched/cleared area, along with SRCFLN
01600 ?DEFFLN: BLOCK 11 ;DEFAULT FILE NAME FOR .LST, .REL FILES
01700 SAIJFN: 0
01800 NAMPTR: 0
01900 SAVEP: 0
02000 NXTPTR: 0
02100 NAMES: BLOCK 50 ;ENOUGH FOR A LOT OF CHARS!
02200 ?XTBFIL: BLOCK 40 ;NAME OF THE XSAIL BINARY FILE
02300 ?XTSFIL: BLOCK 40 ;NAME OF THE XSAIL SM1 FILE (BAIL SYMBOLS)
02400 ?CMDLIN:BLOCK 100 ;COMMAND LINE
02500 CMDPTR: 0 ;POINTS TO COMMAND LINE
02600 CMDJFN: 0 ;JFN FOR COMMANDS
02700
02800 SWTTXT: BLOCK 10 ;TEXT FOR SWITCHES
02900 SWTPTR: 0 ;POINTER TO ABOVE
03000
03100
03200 RFMODB: 0 ;TEMPORARIES FOR TTY MODE SETTINGS
03300 RFCOCB: 0
03400 RFCOCC: 0
03500
03600 LODMOD: 0 ;SET TO TRUE IF LOADING
03700 LODDDT: 0 ;LOADING WITH DDT
03800 LODSDT: 0 ;LOADING WITH SDDT
03900
04000 ENDDATA
04100
04200 DATA
04300 HRLDON: 0 ;TRUE IF WE HAVE PRINTED THE MESSAGE ONCE
04400 ENDDATA
04500
04600 HERALD: BLOCK 25 ;PUT IN HIGH CORE SINCE WE WILL SET IT THEN
04700 ;SSAVE CORE IMAGE AFTER LOADING
04800
04900
05000
05100
05200
05300
05400
00100 DSCR COMND
00200
00300 CAL PUSHJ
00400
00500 RET +1 if unsuccessful
00600 +2 if successful
00700
00800 ⊗
00900
01000
01100 COMND:
01200 IMSSS<
01300 SKIPN RPGSW ;CALLED IN RPGMODE?
01400 JRST NORPG ;NO
01500
01600 SETO A,
01700 MOVEI B,TMPCBF ;GET BUFFER
01800 JSYS GTINF
01900 JFCL
02000 NOSUMEX,<
02100 SKIPN TMPCBF+6
02200 >;
02300 SUMEX,<
02400 SKIPN TMPCBF+21 ;SOMETHING THERE?
02500 >;
02600 JRST NORPG
02700 IFN 0,<
02800 HRROI A,[ASCIZ/
02900 Tenex SAIL:
03000 /]
03100 JSYS PSOUT
03200 >;IFN 0
03300 SUMEX,<
03400 MOVE A,[POINT 7,TMPCBF+21,-1] ;BP
03500 >;SUMEX
03600 NOSUMEX,<
03700 MOVE A,[POINT 7,TMPCBF+6,-1] ;BP
03800 >;NOSUMEX
03900 MOVEM A,CMDJFN ;USE FOR THE COMMAND SOURCE
04000 IFN 0,< JSYS PSOUT>
04100 JRST NORPG1 ;SKIP OVER SETZM
04200 >;IMSSS
04300 NORPG:
04400 NOIMSSS<
04500 SETZM RPGSW
04600 >;NOIMSSS
04700 SETZM CMDJFN ;START WITH NOTHING
04800
04900 NORPG1: MOVEI A,101 ;SET TTY FOR COMMAND SCANNER
05000 JSYS RFMOD
05100 MOVEM B,RFMODB
05200 TRO B,170000 ;WAKE UP ON EVERYTHING
05300 JSYS SFMOD
05400 MOVEI A,101
05500 JSYS RFCOC
05600 MOVEM B,RFCOCB
05700 MOVEM C,RFCOCC
05800 TRZ B,006000 ;NOTHING FOR ↑L
05900 TRZ C,600000 ;NOTHING FOR ↑R
06000 JSYS SFCOC
06100
06200 PUSHJ P,CMDSCN ;GET BIN AND LST JFN'S
06300
06400 MOVEI A,101 ;RESET TTY MODES
06500 MOVE B,RFMODB
06600 JSYS SFMOD
06700 MOVEI A,101
06800 MOVE B,RFCOCB
06900 MOVE C,RFCOCC
07000 JSYS SFCOC
07100
07200 TLZ FF,LISTNG+BINARY;ASSUME NEITHER
07300 MOVE A,BINJFN
07400 JUMPL A,TRYLST ;NO BIN FILE
07500 MOVE B,[XWD 440000,100000] ;OPEN BINARY FILE
07600 JSYS OPENF
07700 JRST NOBIN ;CAN'T OPEN IT
07800 TLO FF,BINARY ;MADE IT
07900 BAIL<
08000 SKIPLE BAILON
08100 PUSHJ P,SM1INI ;INITIALIZE .SM1 FILE
08200 >;BAIL
08300 TRYLST: MOVE A,LISJFN
08400 JUMPL A,GETSRC ;NO LISTING,GO ON TO SRC
08500 MOVE B,[XWD 70000,100000]
08600 JSYS OPENF
08700 JRST NOLST2 ;NO CAN DO
08800 TLO FF,LISTNG
08900 BAIL<
09000 SKIPLE BAILON
09100 PUSHJ P,SM1LST ;ENTER LISTING FILE BLOCK INTO .SM1 FILE
09200 >;BAIL
09300 JRST GETSRC ;ACTUALLY READ THE SOURCE FILE NOW
09400
09500 NOBIN: ERR <Cannot OPENF binary file.[CR for TENX message]>,1
09600 MOVEI D,.+2
09700 JRST ERROR
09800 JRST TRYLST
09900 NOLST2: ERR <Cannot OPENF listing file.[CR for TENX message]>,1
10000 MOVEI D,.+2
10100 JRST ERROR
10200 JRST GETSRC
10300
10400 EOLC ←← 37
10500 COMMA ←← ","
10600 ESCAPE ←← 33
10700 SWCH ←← "@"
10800 QRBOUT ←← 177 ;abort command on rubout
10900 CTRLU←←"U"-100 ;also on control-U
11000 QMARK←←"?" ;for help
11100 CTRLR←←"R"-100 ;for .REL file
11200 SLASH←←"/" ;for switches
11300 SPACE←←" " ;SPACE
11400 CTRLL←←"L"-100 ;for .LST file
11500 CTRLQ←←"Q"-100 ;for halting
11600 CTRLX←←"X"-100
11700 CTRLA←←"A"-100
11800 SRCBSZ←←200 ;SIZE IN WRDS OF SRC FILE BUFFERS
11900
12000
12100 DEFINE BACKUP <PUSHJ P,.BACKUP> ;BACK UP POINTER OR JFN
12200 DEFINE NXTCHR <PUSHJ P,.NXTCHR> ;GET THE NEXT CHAR
00100 CMDSCN:
00200 SKIPN XTFLAG ;EXTENDED COMPILATION?
00300 JRST CMDSC1 ;NO
00400 HRROI A,[ASCIZ/TENEX SAIL Extended compilation
00500 /]
00600 JSYS PSOUT
00700 JRST NOHRLD ;AND DONT PRINT OUT OTHER HERALD
00800 CMDSC1:
00900 SKIPE HRLDON ;OR ALREADY PRINTED HERALD
01000 JRST NOHRLD ;THEN DONT PRINT AGAIN
01100 HRROI A,HERALD
01200 SKIPE RPGSW
01300 HRROI A,[ASCIZ/TENEX SAIL: /]
01400 JSYS PSOUT
01500 NOHRLD:
01600 SETOM HRLDON
01700 MOVEM P,SAVEP
01800 GETSAI: MOVE A,[POINT 7,NAMES,-1]
01900 MOVEM A,NAMPTR
02000 MOVE A,[POINT 7,CMDLIN,-1]
02100 MOVEM A,CMDPTR
02200 SETZM LODDDT
02300 SETZM LODMOD
02400 SETZM LODSDT
02500 SETZM DEFFLN ;MARK THAT WE DONT YET HAVE A DEFAULT NAME
02600 SETOM LISJFN ;ASSUME NO LISTING FILE
02700 SETZM BINJFN ;ASSUME WANT A BINARY
02800 SKIPE RPGSW
02900 JRST .+3
03000 HRROI A,[ASCIZ/
03100 */]
03200 JSYS PSOUT
03300 GETSA1: MOVEI D,GETSAI ;FOR ERROR RETURN
03400 NXTCHR ;PEEK AHEAD BEFORE GTJFN
03500 CAIN A,QMARK ;A QUESTION MARK?
03600 JRST QUERY ;AND RETURN TO GETSAI
03700 BACKUP ;BUT DONT GET CARRIED AWAY WITH PEEKING!
03800 GETSA2: MOVEI A,ESAI
03900 MOVE B,CMDJFN ;START WITH INPUT FROM HERE
04000 JSYS GTJFN
04100 JRST .+2
04200 JRST GOTSAI
04300 MOVEM B,CMDJFN ;SAVE POINTER
04400 MOVE B,A ;SAVE ERROR NUMBER
04500 CAIN B,600104 ;"OLD FILE REQUIRED" ??
04600 JRST ERROR ;YES, COMPLAIN
04700 BACKUP
04800 NXTCHR
04900 CAIE A,"←" ;PERHAPS DOES NOT WANT A BINARY
05000 CAIN A,"=" ;ALSO ALLOW "="
05100 JRST GETSA3
05200 JRST GETSA4
05300 GETSA3: SETOM BINJFN ;INDICATE NO BINARY
05400 IDPB A,CMDPTR
05500 JRST GETSA1
05600 GETSA4: CAIE A,QRBOUT
05700 CAIN A,CTRLU
05800 JRST CMDRES ;RESET COMMAND THING
05900 CAIN A,CTRLQ
06000 JRST DOHLT
06100 CAIN B,600115 ;NULL COMMAND -- ALLOW IT
06200 JRST GETSAI ;REPRINT "*" AND DO ANOTHER GTJFN
06300 JRST ERROR ;SOMETHING ELSE IS WRONG -- TELL THE USER
06400
06500 GOTSAI: MOVEM A,SAIJFN ;SAVE THE JFN
06600 MOVEM B,CMDJFN
06700 MOVE A,NAMPTR
06800 HRRZ B,SAIJFN
06900 SETZ C,
07000 JSYS JFNS
07100 MOVEM A,NAMPTR
07200
07300 MOVE A,CMDPTR
07400 HRRZ B,SAIJFN
07500 MOVE C,[XWD 221100,1]
07600 JSYS JFNS
07700 MOVEM A,CMDPTR
07800
07900 SKIPE DEFFLN ;DO WE ALREADY HAVE A DEFAULT NAME?
08000 JRST GTDFFN ;YES
08100 HRROI A,DEFFLN ;GET THE DEFAULT FILENAME FOR OTHER THINGS
08200 HRRZ B,SAIJFN
08300 MOVSI C,2000 ;FILENAME ONLY
08400 JSYS JFNS
08500 SETZ C,0
08600 IDPB C,A ;PUT A NULL BYTE ON THE END
08700
08800 GTDFFN: HRRZ A,SAIJFN ;GET RID OF SOURCE JFN FOR NOW
08900 JSYS RLJFN
09000 JFCL
09100
09200 BACKUP
09300 NXTCHR
09400 CAIN A,ESCAPE
09500 NXTCHR
09600 CAIN A,CTRLQ
09700 JRST DOHLT
09800 CAIN A,CTRLU
09900 JRST CMDRES
10000 CAIE A,"←" ;
10100 CAIN A,"=" ;ALSO ALLOW "="
10200 SKIPA
10300 JRST NOWNLD
10400 IDPB A,CMDPTR ;SAVE IT I GUESS
10500 SETOM LODMOD ;
10600 SETOM LODDDT
10700 JRST DONE ;MUST BE DONE -- TYPED AN ARROW
10800 NOWNLD:
10900 CAIN A,EOLC ;DONE IF EOL
11000 JRST DONE
11100 CAIE A,COMMA ;IS IT A COMMA
11200 JRST DUNCMA ;NO -- RANDOM FILE CHARACTER?
11300 ISCMA: IDPB A,CMDPTR ;SAVE THE COMMA
11400 NXTCHR
11500 CAIE A,EOLC ;IF AN EOL
11600 CAIN A,SPACE ;OR SPACE
11700 JRST GOSUB ;THEN SUBCOMMAND
11800 CAIE A,"←"
11900 CAIN A,"="
12000 JRST [SETOM LODMOD
12100 SETOM LODDDT
12200 JRST GOSUB]
12300 DUNCMA: BACKUP ;MUST BE A FILE NAME -- PUT THE CHAR BACK
12400 SETZ A,
12500 IDPB A,NAMPTR ;SEPARATE THE NAMES WITH NULLS
12600 JRST GETSA2 ;FOR GTJFN
12700
00100 GOSUB: IDPB A,CMDPTR ;SAVE WHATEVER CHAR IT WAS
00200 SKIPE RPGSW
00300 JRST SUBCMD
00400 HRROI A,[ASCIZ/
00500 /]
00600 JSYS PSOUT
00700 BAIL<
00800 JRST SUBCMD ;GET AROUND THIS CRAP
00900 SM1INI:
01000 SKIPG BAILON ;HAS USER TURNED US OFF?
01100 POPJ P, ;YES
01200 MOVE A,SM1JFN ;INITIALIZE .SM1 FILE
01300 MOVE B,[XWD 440000,100000]
01400 JSYS OPENF
01500 JRST NOSM1 ;ERROR EXIT
01600 MOVEI TEMP,SM1SIZ ;BUFFER SIZE
01700 MOVEM TEMP,SM1CNT
01800 MOVE TEMP,[POINT 36,SM1BUF]
01900 MOVEM TEMP,SM1PNT
02000 POPJ P,
02100
02200 NOSM1: ERR <Cannot OPENF debugger's file.[CR for TENX message]>,1
02300 MOVEI D,.+2 ;ALLOW CONTINUATION
02400 JRST ERROR
02500 SETOM BAILON
02600 POPJ P, ;OH WELL
02700
02800 SM1LST: MOVE B,LISJFN ;GET FILE NAME CORRESPONDING TO JFN
02900 ;AND PUT OUT A FILE INFO BLOCK
03000 ;THERE ARE CALLS TO SM1LST+1
03100 MOVE A,[POINT 7,INIACS] ;A NICE BIG TEMP AREA
03200 ;;#%%# ! JFR 4-23-75 TRY THIS FOR CHANGE
03300 MOVE C,[011100000001] ;A NICE FORMAT (?)
03400 JSYS JFNS ;JFN TO STRING CONVERSION
03500 HRRZ PNT,A ;UPDATED BYTE POINTER
03600 ;;#%%# JFR 4-5-75 ZERO OUT THE REST OF THE LAST WORD
03700 SETZ C,
03800 IDPB C,A
03900 IDPB C,A
04000 IDPB C,A
04100 IDPB C,A
04200 ;;#%%# ↑
04300 SUBI PNT,INIACS
04400 ADDI PNT,1 ;# OF WORDS IN NAME
04500 SETZ SBITS,
04600 HLLM SBITS,BCORDN ;NO LONGER DOING COORDINATES
04700 PUSHJ P,VALOUT ;END PREVIOUS TABLE
04800 MOVEI SBITS,BAIFIL
04900 PUSHJ P,VALOUT ;BEGIN FILE INFO TABLE
05000 MOVE SBITS,PNT
05100 HRL SBITS,BSRCFN ;FILE #,,# WORDS IN NAME
05200 PUSHJ P,VALOUT
05300
05400 MOVN PNT,PNT
05500 HRLZ PNT,PNT ;AOBJN POINTER
05600 SM1LS1: MOVE SBITS,INIACS(PNT) ;PICK UP A WORD
05700 PUSHJ P,VALOUT
05800 AOBJN PNT,SM1LS1
05900 POPJ P,
06000 >;BAIL
00100 SUBCMD: SKIPE RPGSW
00200 JRST .+3
00300 HRROI A,[ASCIZ/**/]
00400 JSYS PSOUT
00500 MOVEI D,SUBCMD ;SET TO RETURN TO SUBCMD
00600 NXTCHR ;GET THE NEXT CHARACTER
00700 CAIN A,QMARK ;QUERY
00800 JRST SUBQRY
00900 CAIN A,EOLC ;DONE?
01000 JRST DONE ;YEP
01100 CAIN A,CTRLL ;FOR LISTING?
01200 JRST GETLST
01300 CAIN A,CTRLR ;NON-STANDARD .REL FILE
01400 JRST GETREL ;GET ONE FROM THE USER
01500 CAIN A,SLASH ;SWITCH?
01600 JRST PSWIT ;
01700 CAIN A,CTRLQ
01800 JRST DOHLT
01900 CAIN A,CTRLU
02000 JRST CMDRES
02100 JRST SUBCMD ;KEEP LOOPING
02200
00100
00200 GETREL:
00300 SKIPE RPGSW
00400 JRST .+3
00500 HRROI A,[ASCIZ/REL file */]
00600 JSYS PSOUT
00700 MOVEI A,EREL ;addr. of tbl for long GTJFN
00800 MOVE B,CMDJFN ;MAIN STRING POINTER IF ANY
00900 JSYS GTJFN
01000 JRST [MOVEM B,CMDJFN
01100 JRST ERROR] ;NOTE THAT ERROR RETURNS TO SUBCOMMAND LEVEL IN THIS CASE
01200 MOVEM A,BINJFN ;SAVE JFN
01300 MOVEM B,CMDJFN ;possibly an updated BP
01400 BAIL<
01500 SKIPLE BAILON
01600 PUSHJ P,SM1INI ;FOR DEBUGGER
01700 >;BAIL
01800 BACKUP
01900 NXTCHR
02000 CAIN A,ESCAPE ;GET ANOTHER CHAR IF TERM WITH ALTMODE
02100 NXTCHR
02200 MOVEI A,CTRLR ;MARK THE COMMAND
02300 IDPB A,CMDPTR
02400 HRRZ B,BINJFN ;ONLY RH BITS
02500 MOVE A,CMDPTR ;SAVE THE JFN
02600 MOVE C,[XWD 221100,000001] ;ITS ANYBODY'S GUESS IF THIS IS RIGHT!
02700 JSYS JFNS ;PUT BINARY NAME INTO CMDLIN
02800 MOVEI C,EOLC ;
02900 IDPB C,A ;AN EOL
03000 MOVEM A,CMDPTR
03100 TLO FF,BINARY ;INDICATE BINARY FOR A BIT
03200 JRST SUBCMD ;AND STAY IN SUBCOMMAND MODE
00100 GETLST:
00200 SKIPE RPGSW
00300 JRST .+3
00400 HRROI A,[ASCIZ/LST file */]
00500 JSYS PSOUT
00600 MOVEI A,ELST
00700 MOVE B,CMDJFN
00800 JSYS GTJFN
00900 JRST [MOVEM B,CMDJFN
01000 JRST ERROR]
01100 MOVEM A,LISJFN
01200 MOVEM B,CMDJFN
01300 BAIL<
01400 SKIPLE BAILON
01500 PUSHJ P,SM1LST ;DEBUGGER NEEDS TO KNOW
01600 >;BAIL
01700 BACKUP
01800 NXTCHR
01900 CAIN A,ESCAPE ;IF TERMINATED WITH ESCAPE THEN
02000 NXTCHR ;GET ANOTHER CHAR
02100 MOVEI A,CTRLL
02200 IDPB A,CMDPTR
02300 HRRZ B,LISJFN
02400 MOVE A,CMDPTR
02500 MOVE C,[XWD 221100,000001]
02600 JSYS JFNS
02700 MOVEI C,EOLC ;PUT AN EOL
02800 IDPB C,A ;AT THE END OF THE COMMAND BUFFER
02900 MOVEM A,CMDPTR
03000 TLO FF,LISTNG ;INDICATE LISTING FOR A BIT
03100 JRST SUBCMD
00100 PSWIT:
00200 MOVE D,[POINT 7,SWTTXT,-1] ;BYTE POINTER TO STRING
00300 SETZ 5, ;CHAR COUNT
00400 PSWLUP: NXTCHR
00500 CAIN A,CTRLQ ;QUIT?
00600 JRST DOHLT
00700 CAIN A,CTRLU ;RESET COMMAND
00800 JRST CMDRES
00900 CAIE A,CTRLR ;REPEAT LINE?
01000 JRST NORPT
01100 DOCTR: HRROI A,[ASCIZ!
01200 /!]
01300 JSYS PSOUT
01400 JUMPE 5,PSWLUP
01500 MOVEI A,101
01600 MOVE B,[POINT 7,SWTTXT,-1]
01700 MOVN C,5 ;COUNT
01800 JSYS SOUT
01900 JRST PSWLUP ;AND CONTINUE
02000 NORPT: CAIE A,CTRLX ;RUBOUT (WHICH GOES TO SUBCOMMAND LEVEL)
02100 JRST NOCTX
02200 DOCTX: HRROI A,[ASCIZ/
02300 /]
02400 JSYS PSOUT
02500 JRST SUBCMD
02600 NOCTX: CAIE A,QRBOUT
02700 CAIN A,CTRLA
02800 JRST .+2
02900 JRST NOCTA
03000 JUMPLE 5,DOCTX
03100 MOVEI A,"\"
03200 JSYS PBOUT
03300 LDB A,D ;LAST CHAR
03400 JSYS PBOUT
03500 MOVE A,D
03600 JSYS BKJFN ;BACK UP THE BP
03700 JFCL
03800 MOVEM A,D
03900 SOJA 5,PSWLUP ;DECREMENT COUNT AND CONTINUE
04000
04100 NOCTA: CAIE A,EOLC
04200 CAIN A,ESCAPE
04300 JRST PSWDUN
04400 IDPB A,D
04500 AOJA 5,PSWLUP ;LOOK FOR MORE
04600 PSWDUN:
04700 SETZ A,
04800 IDPB A,D ;PUT A NULL BYTE
04900 MOVEI A,SLASH
05000
05100 IDPB A,CMDPTR ;SAVE THE SWITCH
05200 MOVE A,[POINT 7,SWTTXT,-1]
05300 MOVE B,CMDPTR
05400 SETZ C,
05500 JSYS SIN
05600 MOVEI C,EOLC
05700 IDPB C,B
05800 MOVEM B,CMDPTR
05900 MOVE A,[POINT 7,SWTTXT,-1]
06000 MOVEM A,SWTPTR
06100 JSP PNT,SWTGET ;PROCESS THE SWITCH
06200 ;;#XN# ! JFR 9-18-76
06300 SETZM SWTGET
06400 JRST SUBCMD ;MORE SUBCOMMANDS?
00100 DONE:
00200 MOVEI A,EOLC
00300 IDPB A,CMDPTR
00400 IDPB A,NAMPTR
00500 HRROI A,NAMES
00600 MOVEM A,NXTPTR
00700 SKIPE BINJFN ;ALREADY DECIDED ABOUT BINARY
00800 JRST DONE1 ;YES
00900 MOVEI D,CMDSCN ;BE READY TO START OVER
01000 MOVEI A,EREL1 ;NO EXTRA JFNS, NO CONFIRM
01100 HRROI B,DEFFLN ;USE THE DEFAULT NAME
01200 JSYS GTJFN
01300 JRST ERROR ;SOMETHING IS WRONG
01400 MOVEM A,BINJFN ;GOT IT
01500 TLO FF,BINARY ;INDICATE BINARY FOR A BIT
01600 BAIL<
01700 SKIPG BAILON ;GET .SM1 FILE ONLY IF BAIL ACTIVE
01800 JRST DONE1 ;OTHERWISE QUIT
01900 MOVEI D,CMDSCN
02000 MOVEI A,ESM1
02100 HRROI B,DEFFLN
02200 JSYS GTJFN ;FOR DEBUGGER
02300 JRST ERROR
02400 MOVEM A,SM1JFN
02500 >;BAIL
02600
02700 DONE1: POPJ P,
02800
02900 CMDRES: HRROI A,[ASCIZ/
03000 Restarting ...
03100 /]
03200 JSYS PSOUT
03300 JRST SAIL ;ALL OVER AGAIN
03400
03500 ;HERE TO PRINT OUT LAST ERROR, RETURN ADDRESS IN D
03600 ERROR: HRROI A,[ASCIZ/
03700 /]
03800 JSYS PSOUT
03900 MOVEI A,101 ;PRIMARY OUTPUT
04000 MOVE B,[XWD 400000,-1] ;THIS FORK, MOST RECENT ERROR
04100 SETZ C,
04200 JSYS ERSTR
04300 JFCL
04400 SKIPA A,[POINT 7,[ASCIZ/Cannot find TENEX error message.
04500 /],-1]
04600 HRROI A,[ASCIZ/
04700 /]
04800 JSYS PSOUT
04900 JRST (D)
05000
05100 DOHLT: HRROI A,[ASCIZ/
05200 Bye
05300 /]
05400 JSYS PSOUT
05500 JSYS HALTF
05600 JRST SAIL ;restart if continued
05700
00100 DSCR Routines to print out info
00200 ⊗;
00300
00400 QUERY: HRROI A,[ASCIZ!
00500
00600 <filelist> ;compile file
00700 ←<filelist> ;compile with no binary
00800 <filelist>, ;compile, subcommand mode
00900 <filelist>← ;compile, load with DDT
01000 <filelist>,← ;compile, load with DDT, subcommand
01100
01200 [Use "=" instead of "←" on TOPS20 in the above.]
01300
01400 ↑U start over
01500 ↑Q quit
01600 ? this list
01700
01800 !]
01900 JSYS PSOUT
02000 JRST (D) ;RETURN
02100 SUBQRY:
02200 HRROI A,[ASCIZ!
02300
02400 Type one of the following characters:
02500 ↑U start over
02600 ↑Q quit
02700 ↑R non-standard .REL file
02800 ↑L listing file
02900 / switch specification
03000 ? this list
03100
03200 Legal switches include the following, where <num> is a number.
03300 Edit switches with ↑R, ↑X, ↑A or rubout.
03400
03500 G load after compilation
03600 T load with DDT
03700 R double parse stacks
03800 C produce a cref listing
03900 D double define PDL
04000 P double PDL
04100 Q double string PDL
04200 H make sharable (default on TENEX)
04300 I make non-sharable
04400 K KOUNT feature
04500 X Extended compilation
04600 <num>S string space
04700 <num>F listing format --
04800 <num>B BAIL features
04900 <num>A KI and KL numerical instructions
05000
05100 !]
05200 JSYS PSOUT
05300 JRST (D) ;RETURN
00100
00200 NXTJFN: MOVSI A,100001
00300 MOVE B,NXTPTR
00400 CAMN B,NAMPTR
00500 JRST NXTDUN
00600 JSYS GTJFN
00700 CAIA ;ERROR RETURN
00800 JRST NXTJF1
00900 MOVEM B,NXTPTR ;SAVE NXTPTR
01000 SYSERR: ERR <Confusion in command scanner>,1
01100 JRST NXTJFN
01200
01300 NXTJF1: MOVEM B,NXTPTR
01400 POPJ P,
01500
01600 NXTDUN: SETO A,
01700 POPJ P,
01800
00100 DSCR Typing routines
00200 ⊗;
00300
00400 .BACKUP:
00500 SKIPE A,CMDJFN
00600 JRST .BACK1
00700 MOVEI A,100
00800 JSYS BKJFN
00900 JFCL
01000 POPJ P,
01100 .BACK1:
01200 JSYS BKJFN
01300 JFCL
01400 MOVEM A,CMDJFN
01500 POPJ P,
01600
01700 TYI:
01800 ;;#XN# JFR 9-18-76 for REQUIRE COMPILER_SWITCHES
01900 SKIPN SWTPTR ;COMMAND LINE?
02000 JRST [SOSGE A,PNAME ;NO, REQUIRE
02100 SETZM PNAME ;ALL DONE
02200 ILDB A,PNAME+1
02300 POPJ P,]
02400 ;;#XN# ↑
02500 ILDB A,SWTPTR
02600 POPJ P,
02700
02800
02900 .NXTCHR:
03000 PUSH P,B
03100 SKIPN A,CMDJFN
03200 JRST .NXT1
03300 JSYS BIN
03400 CAIN B,15 ;IF A CARRIAGE RETURN
03500 JRST .-2 ;THEN IGNORE
03600 CAIN B,12 ;IF A LINE FEED
03700 MOVEI B,EOLC ;THEN TRANSLITERATE TO AN EOL
03800 MOVEM A,CMDJFN
03900 .NXTRET:
04000 MOVE A,B
04100 POP P,B
04200 POPJ P,
04300 .NXT1:
04400 MOVEI A,100 ;PRIMARY INPUT
04500 JSYS BIN
04600 CAIN B,15 ;IF A CARRIAGE RETURN
04700 JRST .-2 ;THEN IGNORE
04800 CAIN B,12 ;IF A LINE FEED
04900 MOVEI B,EOLC ;THEN TRANSLITERATE TO AN EOL
05000 JRST .NXTRET
05100
00100 DSCR Long form GTJFN tables.
00200 ⊗;
00300
00400 EREL: XWD 400000,0 ;NEW VERSION
00500 XWD 100,101
00600 0
00700 0
00800 XWD -1,DEFFLN
00900 XWD -1,[ASCIZ/REL/]
01000 BLOCK 3
01100
01200 EREL1: XWD 400000,0
01300 XWD 377777,377777
01400 0
01500 0
01600 XWD -1,DEFFLN
01700 XWD -1,[ASCIZ/REL/]
01800 BLOCK 3
01900 BAIL<
02000 ESM1: XWD 400000,0
02100 XWD 377777,377777
02200 0
02300 0
02400 XWD -1,DEFFLN
02500 XWD -1,[ASCIZ/SM1/]
02600 BLOCK 3
02700 >;BAIL
02800 ELST: XWD 400000,0 ;NEW VERSION
02900 XWD 100,101
03000 0
03100 0
03200 XWD -1,DEFFLN
03300 XWD -1,[ASCIZ/LST/]
03400 BLOCK 3
03500
03600 ESAI: XWD 100000,0
03700 XWD 100,101
03800 0
03900 0
04000 0
04100 XWD -1,[ASCIZ/SAI/]
04200 BLOCK 3
04300
04400 ;used by REQUIRE SOURCE!FILE
04500 ESRC: XWD 100000,0
04600 XWD 377777,377777
04700 BLOCK 3
04800 XWD -1,[ASCIZ/SAI/]
04900 BLOCK 3
05000
05100 ;when REQUIRE SOURCE!FILE fails, use this
05200 ESRCT: XWD 100000,0
05300 XWD 100,101
05400 BLOCK 3
05500 XWD -1,[ASCIZ/SAI/]
05600 BLOCK 3
05700
00100
00200 ; ENTER HERE FROM SCAN WHEN EOF IS REACHED AND ANOTHER
00300 ; FILE IS NEEDED. IT IS AN ERROR IF NO MORE ARE LEFT
00400
00500 FILEIN:
00600 MOVE TBITS2,SCNWRD
00700 SKIPE SRCDLY ;IF ON, NOT END OF FILE, BUT SWITCH IN
00800 JRST GETSR2
00900 TLNE TBITS2,INSWT ;TIME TO SWITCH BACK TO PREV SOURCE FILE?
01000 JRST UNSWT ;YES
01100
01200 GETSR2: SETZ A,
01300 EXCH A,SRCDLY
01400 JUMPN A,GETSWT
01500 PUSHJ P,NXTJFN
01600 JUMPG A,GETSR3
01700 POPJ P, ;FAIL RETURN, NOSKIP
01800
01900 EXTERNAL TENXFI,CATCHR
02000
02100 GETSWT: EXCH SP,STPSAV
02200 PUSH SP,PNAME ;CONVERT FILE NAME TO TENEX FORMAT
02300 PUSH SP,PNAME+1
02400 PUSHJ P,TENXFI
02500 PUSH P,[0]
02600 PUSHJ P,CATCHR ;AND PUT A NULL FOR GTJFN
02700 POP SP,PNAME+1
02800 POP SP,PNAME
02900 EXCH SP,STPSAV
03000 MOVE B,PNAME+1 ;BYTEPOINTER
03100 MOVEI A,ESRC ;LONG FORM -- TABLE ABOVE
03200 JSYS GTJFN
03300 JRST GETSW1
03400 JRST GETSR3 ;SWITCHING DATA AREAS ALREADY DONE.
03500
03600 GETSW1: ERR <Cannot GTJFN REQUIREd file, type RETURN to GTJFN from terminal>,1
03700 HRROI A,[ASCIZ/
03800 Filename */]
03900 JSYS PSOUT
04000 MOVEI A,ESRCT ;LONG FORM
04100 SETZ B, ;GO TO TTY DIRECTLY
04200 JSYS GTJFN
04300 JRST GETSW1 ;ANOTHER ERROR!
04400 JRST GETSR3
04500
04600 GETSRC:
04700 GETSR1: PUSHJ P,NXTJFN
04800 JUMPLE A,[ERR <Need a source file>]
04900 GETSR3: MOVEM A,SRCJFN
05000 JSYS DVCHR ;GET THE DEVICE CHARS
05100 PUSH P,B ;SAVE THEM
05200 PUSH P,C
05300 MOVEI A,101 ;COMPARE TO THE CONTROLLING TERMINAL
05400 JSYS DVCHR
05500 SETO D, ;ASSUME THEY MATCH
05600 CAMN B,-1(P) ;BUT DO THEY
05700 CAME C,(P)
05800 SETZ D, ;NO MATCH
05900 MOVEM D,TTYSRC ;SAY WHETHER OR NOT IT IS THE CONTROLLING TERMINAL
06000 SUB P,X22 ;ADJUST STACK
06100 JUMPN D,OPNED ;DONT OPEN THE TTY -- WONT USE JFN ANYWAY
06200
06300 OPNUP: MOVE A,SRCJFN
06400 MOVE B,[XWD 440000,200000] ;OPEN SOURCE - NOTE IS 36-BIT
06500 JSYS OPENF
06600 ERR <Can't open source file>
06700
06800 ;NOW ALLOCATE INPUT BUFFER FOR SRCJFN, SET RELEVANT SWITCHED DATA
06900 OPNED: HRRZI C,SRCBSZ+1 ;PLUS 1 FOR EOB NULL WORD
07000 PUSHJ P,CORGET
07100 ERR <DRYROT at CC: No core for allocation>
07200 MOVEM B,BUFADR
07300 ADD C,B
07400 MOVE TEMP,B
07500 HRLS TEMP
07600 ADDI TEMP,1
07700 SETZM -1(TEMP)
07800 BLT TEMP,-1(C) ;CLEAR OUT BUFFER, SINCE CORGET DOESNT
07900 SUBI B,1
08000 HRLI B,700 ;MAKE THE KIND OF BP THAT POINTS A WORD EARLY
08100 MOVEM B,SRCPNT
08200 SETZM TNXBND ;CLEAR BUFFER END WORD FOR ADVBUF
08300 BAIL<
08400 SKIPG BAILON
08500 JRST NBAI00
08600 AOS TEMP,BNSRC ;INCR FILE COUNT
08700 MOVEM TEMP,BSRCFN ;START OFF IN THE NEW FILE
08800 SETZM BSRCFC ;AT BLOCK ZERO (FIRST READ WILL SET BLOCK TO 1)
08900 MOVE B,SRCJFN
09000 PUSHJ P,SM1LST+1 ;RE-USE PREVIOUS CODE
09100 NBAI00:
09200 >;BAIL
09300 SETZM CRIND
09400 HRROI 1,[ASCIZ/
09450 /]
09500 SKIPE SWTLNK
09600 JSYS PSOUT ;PRINT CRLF TO TTY
09700 MOVE 1,LININD
09800 HRROI 1,INDTAB(1)
09900 JSYS PSOUT
10000 HRROI A,SRCFLN
10100 HRRZ B,SRCJFN
10200 SETZ C,
10300 JSYS JFNS ;PRINT SRCFIL NAME TO TTY
10400 IDPB C,A ;TERMINATING NULL CHAR
10500 HRROI A,SRCFLN ;NOW PRINT THE NAME
10600 JSYS PSOUT
10700 SKIPN TTYSRC ;IS THE CONTROLLING TERMINAL THE SOURCE?
10800 JRST .+3 ;NO
10900 HRROI A,[ASCIZ/
11000 Type ↑Z for EOF, ↑R, ↑X, ↑A to edit.
11100 /]
11200 JSYS PSOUT
11300 AOS (P) ;SUCCESS -- SKIP RETURN FROM FILEIN
11400 POPJ P,
11500
11600 INDTAB:0 ;INDENTING SPACES
11700 ASCIZ / / ;LEVEL 1
11800 ASCIZ / /;LEVEL 2
11900 ASCIZ / /; L 3
12000 ASCIZ / /;4
12100 0 ;SAFETY
12200
00100
00200
00300 SUBTTL Production Interpreter
00400 >;TENX
00100
00200
00300
00400
00500
00600
00700
00800
00900
01000
01100
01200
01300
01400
01500
01600
01700
01800
01900
02000
02100