perm filename CC.NEW[10X,AIL] blob
sn#157640 filedate 1975-05-07 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00017 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 TENX<TENEX COMMAND SCANNER
C00004 00003 DSCR COMND
C00008 00004 CMDSCN:
C00013 00005 GOSUB: IDPB A,CMDPTR SAVE WHATEVER CHAR IT WAS
C00016 00006 SUBCMD: SKIPE RPGSW
C00017 00007
C00019 00008 GETLST:
C00020 00009 PSWIT:
C00022 00010 DONE:
C00024 00011 DSCR Routines to print out info
C00026 00012
C00027 00013 DSCR Typing routines
C00028 00014 DSCR Long form GTJFN tables.
C00030 00015
C00035 00016
C00036 00017
C00037 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
>;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!
?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
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
⊗
COMND:
IMSSS<
SKIPN RPGSW ;CALLED IN RPGMODE?
JRST NORPG ;NO
;DAMNED IMSSS EMULATOR IS CAUSING THE NEXT KLUDGE
SETO A, ;SET TO CLEAR
HRRZ B,JOBREL
LSH B,-11 ;MAKE A PAGE NO.
ADDI B,1
HRLI B,400000 ;THIS FORK
SETZ C,
JSYS PMAP
MOVE B,[XWD 400000,711]
JSYS PMAP
SETO A,
MOVEI B,TMPCBF ;GET BUFFER
JSYS GTINF
JFCL
SKIPN TMPCBF+21 ;SOMETHING THERE?
JRST NORPG
HRROI A,[ASCIZ/
Tenex SAIL:
/]
JSYS PSOUT
MOVE A,[POINT 7,TMPCBF+21,-1] ;BP
MOVEM A,CMDJFN ;USE FOR THE COMMAND SOURCE
; JSYS PSOUT
CAIA ;SKIP OVER SETZM
NORPG:
>;IMSSS
NOIMSSS<
SETZM RPGSW
>;NOIMSSS
SETZM CMDJFN ;START WITH NOTHING
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
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:
SKIPN RPGSW ;IF IN RPG MODE
SKIPE HRLDON ;OR ALREADY PRINTED HERALD
JRST NOHRLD ;THEN DONT PRINT AGAIN
HRROI A,HERALD
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
JRST .+4
SETOM BINJFN ;INDICATE NO BINARY
IDPB A,CMDPTR
JRST GETSA1
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,"←" ;
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
CAIN A,"←" ;ARROW MEANS
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,RACS] ;A NICE BIG TEMP AREA
;;#%%# ! JFR 4-23-75 TRY THIS FOR CHANGE
MOVE C,[011100000001] ;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,RACS
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,RACS(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
JRST SUBCMD ;MORE SUBCOMMANDS?
DONE:
MOVEI A,EOLC
IDPB A,CMDPTR
IDPB A,NAMPTR
HRROI A,NAMES
MOVEM A,NXTPTR
SKIPE BINJFN ;ALREADY DECIDED ABOUT BINARY
JRST DONE1 ;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
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
↑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
<num>S string space
<num>F listing format --
!]
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:
ILDB A,SWTPTR
POPJ P,
.NXTCHR:
PUSH P,B
SKIPN A,CMDJFN
JRST .NXT1
JSYS BIN
MOVEM A,CMDJFN
.NXTRET:
MOVE A,B
POP P,B
POPJ P,
.NXT1:
MOVEI A,100 ;PRIMARY INPUT
JSYS BIN
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
HRRZI 1,37 ;EOL
SKIPE SWTLNK
JSYS PBOUT ;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,
SUBTTL Production Interpreter
>;TENX