perm filename COMSER.OLD[NEW,AIL] blob
sn#408280 filedate 1979-01-08 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00010 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 HISTORY
C00005 00003 Comser Data -- Povtab, Dsplin stuff
C00007 00004 Strngc Supply Routines for Compiler Structures
C00009 00005 Compiler-Specific portion of Error UUO stuff
C00022 00006 SERVICE ROUTINES TO MYERR
C00025 00007 MORE SERVICE ROUTINES FOR MYERR
C00030 00008 DSCR PRINT.
C00032 00009 Dsplin Routine for Displaying Input Line
C00036 00010 Interrupt Handler -- Intrpt, Povtrp
C00044 ENDMK
C⊗;
COMMENT ⊗HISTORY
AUTHOR,REASON
021 102100000032 ⊗;
COMMENT ⊗
VERSION 17-1(26) 11-1-75 BY RLS TENEX-ONLY CHANGES
VERSION 17-1(25) 11-1-75
VERSION 17-1(24) 10-18-74 BY RLS CHECK EDIT CODE FOR FEAT %BV%
VERSION 17-1(23) 10-10-74 BY RLS BETTER IMSSS EDITOR INTERFACE
VERSION 17-1(22) 10-10-74
VERSION 17-1(21) 10-10-74
VERSION 17-1(20) 9-27-74 BY JFR FIX AUTHOR REASON STUFF
VERSION 17-1(18) 3-19-74 BY RHT LOOK OVER CODE WITH RLS
VERSION 17-1(17) 3-17-74 BY RLS INSTALL TENEX
VERSION 17-1(16) 12-8-73 BY JRL REMOVE SPECIAL STANFORD CHARACTERS(WHERE POSSIBLE)
VERSION 17-1(15) 11-17-73
VERSION 17-1(14) 11-10-73 BY KVL %AI% ADD <ESC> I INTERRUPT TO RESET ERROR HANDLER
VERSION 17-1(13) 7-26-73 BY RHT **** VERSION 17 ****
VERSION 16-2(12) 6-29-73 BY JRL END RINGSORT WITH POPJ P,
VERSION 16-2(11) 3-13-73 BY JRL REMOVE REFERENCES TO GAG
VERSION 16-2(10) 7-3-72 BY DCS INSTALL VERSION 16
VERSION 15-2(9) 2-26-72 BY DCS <ESC> I ALWAYS BREAKS
VERSION 15-2(8) 2-6-72 BY DCS BUG #GM# RETURN ADDRESS BEING WIPED OUT IN POVTRP
VERSION 15-2(7) 2-5-72 BY DCS BUG #GJ# ADD LSTON LISTING CONTROL STUFF
VERSION 15-2(6) 2-1-72 BY DCS BUG #GH# <ESC>I CAUSES PARSER TO BREAK AFTER NEXT SCAN
VERSION 15-2(5) 12-26-71 BY DCS BUG #FU# REENABLE ACCESS TO FTDEBUG FROM ERR UUO
VERSION 15-2(4) 12-22-71 BY DCS BUG #FT# DSPLIN CLEANED UP
VERSION 15-2(3) 12-22-71 BY DCS BUG #FT# MYERR RETURNS BINLIN (SEQUENTIAL LINE #)
VERSION 15-2(2) 12-21-71 BY DCS BUG #FS# REMOVE COM2 REFS (ASSUME RUNTIM OR LIB)
VERSION 15-2(1) 12-2-71 BY DCS INSTALL VERSION NUMBER
⊗;
COMMENT ⊗Comser Data -- Povtab, Dsplin stuff⊗
LSTON (COMSER)
BEGIN COMSER ;SERVICE ROUTINES FOR COMPILER.
ZERODATA (COMSER VARIABLES)
COMMENT ⊗
POVTAB -- table of ASCIZ strings, one per AC, giving reasonable
messages to be typed when PDL overflow occurs. 0 if none
provided -- set up in POVSET from SAIL INIT -- changed
occasionally as needs change. Used by POVTRP below
⊗
↑↑POVTAB: BLOCK 10
;PDLSV, PDLSV1 -- save AC's when PDL trapping
?PDLSV: 0
?PDLSV1:0
DATA (COMSER VARIABLES)
COMMENT ⊗
DSPLIN and MYERR variables
⊗
DLINBF: BLOCK 53
ENDDBF←DLINBF+53
DATA(LOGGING VARIABLES)
NOTENX <
MAKCDB(LOG,LOG,0,0,1)
>;NOTENX
TENX <
LOGJFN: 0 ;LOGFLN, a bp to log file name, is set up in SAIL
;in the command scanner
>;TENX
ZERODATA( LOGGING VARIABLES)
↑..STR:0
↑..LOCA:0
↑%QUIET: 0
%MINUS: 0
%NUMBS: 0
%LOGGIN:0
ENDDATA
COMMENT ⊗Strngc Supply Routines for Compiler Structures⊗
; SORT THE STRINGS IN SYMBOL TABLE
DSCR RINGSORT
CAL PUSHJ from STRINGC.
DES It passes off to the GC all of the Strings located in
symbol table Semblks in the compiler. It does this by
searching down the %RSTR ring (STRRNG).
⊗
T←←11
↑RINGSORT:
HRRZ T,STRRNG ;PTR TO LAST BLOCK IN STRING RING
JUMPE T,CPOPJ ;DONE WHEN 0, GO MARK VARIABLES
RGSLUP: MOVEI A,$PNAME(T) ;PTR TO STRING DESCRIPTOR
PUSHJ P,@-1(P) ;SORT IT INTO LISTS
HLRZ T,%RSTR(T) ;NEXT BLOCK
JUMPN T,RGSLUP ;CONTINUE UNLESS DONE
POPJ P,
; SORT STRINGS IN DEFINE STACK
DSCR DEFSRT
CAL PUSHJ from STRINGC
DES Passes off all Strings currently in the Define stack to be collected.
⊗;
↑DEFSRT:
HRRZ A,DFSTRT ;SORT STRINGS ON DEFINE STACK
HRRZ T,DEFPDP ;TERMINATION VALUE
SUBI A,1 ;INIT
JRST SGDTST ;JUMP INTO THINGS
DEFMRK:
PUSHJ P,@-1(P) ;SORT INTO STRUCTURE
SGDTST:
ADDI A,2 ;AUTO-INCR DOESN'T GO FAR ENOUGH
CAMGE A,T ;DONE?
JRST DEFMRK ; NO
POPJ P, ; YES
RINGSORT ;1 ROUTINE
0
LINK 4,.-1 ;FOR STRING GARBAGE COLL.
DEFSRT
0
LINK 4,.-1 ;AND ANOTHER ROUTINE.
COMMENT ⊗Compiler-Specific portion of Error UUO stuff⊗
TENX <
SUMEX<;MYERR FOR SUMEX SYSTEM
DSCR MYERR
DES Part of the second segment kludge -- so that the error
handler can call some routines which are specific to the
compiler. There routines are -- display the current line.
-- call the editor on the current input file.
⊗;
IFN FTDEBUG,<
INNA ;FR0M ERR -- TO LOOK AT STACK
;> 0 ;NO DEBUGGER
↑↑MYERR:
DSCR
Glorious SUMEX EDITOR interface. (Patent pending.)
Here we are going to decide whether we want to edit,
and if so, which editor.
If ac A has 1, then we want some kind of edit.
The information as to which editor we use is on the
stack -- 0 for whichever editor is appropriate to the device,
non-zero for STOPGAP, regardless of the device.
⊗;
EXTERNAL RUNPRG
CAIE A,1 ;REQUEST FOR EDIT?
JRST NOE ;NO
;definitely call some editor. First store things that
;are the same for all editors.
MOVE TEMP,[XWD TMPCBF,TMPCBF+1]
SETZM TMPCBF
BLT TEMP,TMPCBF+37 ;clear before starting
EXCH SP,STPSAV ;STRING STACK
HRROI 1,TMPCBF+1
HRRZ 2,SRCJFN
SETZ 3,
JSYS JFNS ;NAME OF FILE
SETZ 3,
IDPB 3,2 ;PUT A ZERO THERE IN CASE
HRROI 1,TMPCBF+13
HRROI 2,[ASCIZ/<SUBSYS>SAIL.SAV/]
SETZ 3,
JSYS SOUT ;COPY STRING FOR RETURN
MOVE TEMP,[XWD CMDLIN,TMPCBF+21]
BLT TEMP,TMPCBF+37 ;COPY OVER COMMAND
SKIPN TEMP,ASCLIN ;LINE NUMBER
MOVE TEMP,[ASCID/00000/]
TRO TEMP,1 ;TURN ON BIT IF OFF
MOVEM TEMP,TMPCBF+20 ;STORE
MOVE TEMP,FPAGNO ;THE PAGE
DPB TEMP,[POINT 12,TMPCBF,11]
MOVE TEMP,BINLIN ;THE LINE
DPB TEMP,[POINT 12,TMPCBF,23]
;TRICKY CODE TO GET THE BYTE NUMBER
MOVE A,PNEXTC ;BP TO NEXT CHAR
SKIPN LSTCHR ;NEED TO BACK UP BP?
JRST DOTEC1 ;NO
REPEAT 4,<IBP A>
SOJ A, ;BACK IT UP
DOTEC1: SETZ C, ;KEEP COUNT IN 3
MOVE B,PLINE ;POINTER TO BEGINNING OF CURRENT LINE
DOTECL: IBP B ;INCREMENT
AOJ C, ;ONE MORE CHAR
CAMN A,B ;SAME YET?
JRST GOTIT ;YES
CAIG C,=300 ;NO LINE GOES MORE THAN 300 CHARS
JRST DOTECL ;ANOTHER
SETZ C, ;ASSUME NONE
GOTIT:
DPB C,[POINT 12,TMPCBF,35]
MOVEI TEMP,[=15
POINT 7,[ASCIZ/<SUBSYS>TV.SAV/],-1]
SKIPE -1(P) ;INSIST ON STOPGAP
MOVEI TEMP,[=15
POINT 7,[ASCIZ/<SUBSYS>SOS.SAV/],-1]
DORUNC:
SETO A,
MOVEI B,TMPCBF
JSYS PTINF ;SPECIAL IMSSS PTINF JSYS
JFCL ;ERROR RETURN
MOVEI A,400000 ;THIS FORK
SETO B,
JSYS DIC ;DEACTIVATE ALL CHANNELS
JSYS CIS ;CLEAR INTERRUPT SYSTEM
MOVEI A,10 ;CONTROL-H INTERRUPT
JSYS DTI ;DISABLE IT
JSYS RESET ;CLOSE ALL FILES ETC MUMBLE
PUSH P,[1] ;INCREMENT FOR CCL STUFF
PUSH P,[0] ;SAME FORK
PUSH SP,(TEMP) ;PROGRAM TO RUN
PUSH SP,1(TEMP)
PUSHJ P,RUNPRG ;SHOULD NEVER RETURN
HRROI 1,[ASCIZ/
Runcall error for IMSSS editor interface.
/]
JSYS PSOUT
EXCH SP,STPSAV
JRST SAIL ;AND RESTART
>;SUMEX
NOSUMEX<
IMSSS<;MYERR FOR IMSSS SYSTEM
DSCR MYERR
DES Part of the second segment kludge -- so that the error
handler can call some routines which are specific to the
compiler. There routines are -- display the current line.
-- call the editor on the current input file.
⊗;
IFN FTDEBUG,<
INNA ;FR0M ERR -- TO LOOK AT STACK
;> 0 ;NO DEBUGGER
↑↑MYERR:
DSCR
Glorious IMSSS EDITOR interface. (Patent pending.)
Here we are going to decide whether we want to edit,
and if so, which editor.
If ac A has 1, then we want some kind of edit.
The information as to which editor we use is on the
stack -- 0 for whichever editor is appropriate to the device,
non-zero for STOPGAP, regardless of the device.
⊗;
EXTERNAL JFNS,CVSIX,JFNTBL,RUNPRG
DEFINE JFNSMK(X,Y)<
PUSH P,[1]
PUSH P,[XWD X,0]
PUSHJ P,JFNS
PUSHJ P,CVSIX
MOVEM A,Y
>
CAIE A,1 ;REQUEST FOR EDIT?
JRST NOE ;NO
;definitely call some editor. First store things that
;are the same for all editors.
MOVE TEMP,[XWD TMPCBF,TMPCBF+1]
SETZM TMPCBF
BLT TEMP,TMPCBF+37 ;clear before starting
MOVEW JFNTBL+1,SRCJFN ;FAKE FOR JFNS -- WHAT A KROK
MOVEW TMPCBF+32,<[SIXBIT/SYS/]>
MOVEW TMPCBF+33,<[SIXBIT/SAIL/]> ;return to SAIL
MOVE TEMP,[XWD CMDLIN,TMPCBF+6]
BLT TEMP,TMPCBF+30 ;COPY OVER COMMAND
EXCH SP,STPSAV ;GET STRING PDL
JFNSMK(001000,TMPCBF) ;GET FILE NAME PIECES
JFNSMK(000100,TMPCBF+1)
JFNSMK(010000,TMPCBF+3)
MOVEW TMPCBF+5,FPAGNO ;page number
SKIPN -1(P) ;STOPGAP?
JRST DECIDE ;NOPE, DECIDE WHICH EDITOR
DOSOS: SKIPN TEMP,ASCLIN ;THE LINE NO
MOVE TEMP,[ASCID/00000/];SUPPLY ONE
TRO TEMP,1 ;TURN ON BIT, IN CASE OFF
MOVEM TEMP,TMPCBF+4
;STORE RUNCALL INFO IN TEMP
MOVEI TEMP,[ =16
POINT 7,[ASCIZ/<SUBSYS>EDIT.SAV/],-1]
DORUNC:
SETO A,
MOVEI B,TMPCBF
JSYS PTINF ;SPECIAL IMSSS PTINF JSYS
JFCL
MOVEI A,400000 ;THIS FORK
SETO B,
JSYS DIC ;DEACTIVATE ALL CHANNELS
JSYS CIS ;CLEAR INTERRUPT SYSTEM
MOVEI A,10 ;CONTROL-H INTERRUPT
JSYS DTI ;DISABLE IT
JSYS RESET ;CLOSE ALL FILES ETC MUMBLE
PUSH P,[1] ;INCREMENT FOR CCL STUFF
PUSH P,[0] ;SAME FORK
PUSH SP,(TEMP) ;PROGRAM TO RUN
PUSH SP,1(TEMP)
PUSHJ P,RUNPRG
HRROI A,[ASCIZ/
Runcall error for IMSSS editor interface.
/]
JSYS PSOUT
EXCH SP,STPSAV ;PUT BACK THE STRING PDL
JRST SAIL
DECIDE:
MOVE TEMP,BINLIN ;LINE NUMBER
;TRICKY CODE TO GET THE BYTE NUMBER
MOVE A,PNEXTC ;BP TO NEXT CHAR
SKIPN LSTCHR ;NEED TO BACK UP BP?
JRST DOTEC1 ;NO
REPEAT 4,<IBP A>
SOJ A, ;BACK IT UP
DOTEC1: SETZ C, ;KEEP COUNT IN 3
MOVE B,PLINE ;POINTER TO BEGINNING OF CURRENT LINE
DOTECL: IBP B ;INCREMENT
AOJ C, ;ONE MORE CHAR
CAMN A,B ;SAME YET?
JRST GOTIT ;YES
CAIG C,=300 ;NO LINE GOES MORE THAN 300 CHARS
JRST DOTECL ;ANOTHER
SETZ C, ;ASSUME NONE
GOTIT:
HRL TEMP,C ;XWD BYTENO,LINENO
MOVEM TEMP,TMPCBF+4 ;STORE IT
MOVEI TEMP,[=15
POINT 7,[ASCIZ/<SUBSYS>TV.SAV/],-1]
JRST DORUNC ;STORE INFO AND DO RUN CALL
>;IMSSS
NOIMSSS<;MYERR FOR NON-IMSSS TENEX SYSTEM
↑↑MYERR:
JRST NOE ;NO EDIT INTERFACE ON 10X (SEE IMSSS CODE
;FOR SOME BAD IDEAS)
>;NOIMSSS
>;NOSUMEX
>;TENX
NOTENX <
COMMENT ⊗Compiler-Specific portion of Error UUO stuff⊗
DSCR MYERR
DES Part of the second segment kludge -- so that the error
handler can call some routines which are specific to the
compiler. There routines are -- display the current line.
-- call the editor on the current input file -- log error messages.
⊗;
↑↑MYERR:
MOVE 13,SRCFIL ;FILE NAME NEEDED IN ANY CASE
MOVE 14,SRCEXT
MOVE 11,SRCPPN
SKIPE A,-1(P) ;GO TO EDITOR?
JRST NOE ;NOPE, DO DSPLIN & LOGGING STUFF
MOVE 16,FPAGNO ;AS IS THIS
SKIPN 15,ASCLIN
MOVE 15,[ASCID/00000/]
TRO 15,1 ;FOR WFW
SKIPA 12,BINLIN ;TV WILL WANT THIS NUMBER INSTEAD
>;NOTENX
GOHOHO: SUB SP,X44 ;GET RID OF STRINGS
SUB P,X22
JRST @2(P)
NOE: HRRZM A,..LOCA ;STORE NUMBERS
MOVE A,-2(SP) ;GET STRING
HRRZM A,..STR ;STORE IT TOO
SKIPL %RECOV
SETZM %QUIET ;MAKE FATAL ERRORS PRINT
PUSHJ P,ERPRIN ;PRINT MSG, ETC.
;;=I02= CHECK TO SEE IF A BATCH JOB. CLH 31-MAY-75
DEC<
EXTERNAL %BATCH
SKIPN %BATCH ;DO WE KNOW IF BATCH?
JRST [AOS %BATCH ;NO- ASSUME IT IS
MOVE A,[XWD -1,40]
CALLI A,41 ;GETTAB
JFCL
TLNN A,200 ;BATCH?
SETOM %BATCH ;NO - SET TO -1
JRST .+1]
SKIPL %BATCH ;BATCH?
JRST HOME2 ;YES
> ;DEC
;;=I02= ↑
SKIPE %ERGO ;AUTO CONTINUE?
JRST HOME2
;;#PR# RHT FLUSH TYPE AHEAD (1 OF 2)
PUUO 2,B ;INCHRS
JRST PROMPT ;NO TYPE AHEAD
PUUO 11,0 ;CLEAR BUFFER
CAIN B,12 ;ONLY USE TYPE AHEAD IF WAS A LF
JRST CHRGOT ;HAVE GOT IT
;;#PR#
PROMPT: PUUO 3,CRLF..
MOVEI A,"?" ;PRINT ? FOR IRRECOVERABLE ERRORS,
SKIPGE %RECOV ;CAN CONTINUE?
MOVEI A,"↑" ;SOMETHING PRINTABLE
PUUO 1,A ;PRINT IT
NOPROM:
PUUO 0,B ;GET RESPONSE CHAR
CHRGOT: PUSHJ P,DSPATC ;GO DO THE RIGHT THINGS
JRST HOME0 ;GOT AN ACTIVATION LETTER
SKIPE %MINUS ;DONOT PROMPT IF WE RECEIVED A MINUS
JRST NOPROM
JRST PROMPT
;;#PR#
HOME0: CAIN B,15 ;IF A CR
PUUO 2,A ;GOBBLE THE LF
JRST HOME1 ;NOT ONE THERE
JRST HOME1 ;
;;#PR#
HOME2: SKIPA A,[0]
HOME1: HRRZ A,B ;PUT LEFTOVER CHARACTER IN
TLO A,3 ;DO NOT PRINT OR GIVE NUMBERS
JRST GOHOHO ; AND A BOTTLE OF RUM
; SERVICE ROUTINES TO MYERR
;Dspatc is also called from GEN in the routine that does REQUIRE ERROR!MODES.
;Dspatc skip returns if the contents of B was any of the error modes.
;It does a regular return if B was any of the activation responses.
;It skip returns if it doesn't recognize the character.
↑DSPATC:
CAIL B,"a" ;lower case?
SUBI B,40 ;YES, CONVERT TO UPPER
CAIN B,"Q"
JRST SETQT
CAIN B,"N"
JRST SETNUM
CAIN B,"L"
JRST SETLOG
CAIN B,"F"
JRST SETFL
CAIN B,"-"
JRST SETMN
CAIN B,"B"
JRST DEBUGA
CAIE B,12 ;LF
CAIN B,15 ;CR
JRST GOTRY
CAIE B,"X"
CAIN B,"S"
JRST GOTRY
CAIE B,"T"
CAIN B,"E"
JRST GOTRY
CAIE B,"B"
CAIN B,"D"
JRST GOTRY
CAIE B,"A"
CAIN B,"C"
JRST GOTRY
NOTYMSHR<
NODEC<
PUUO 3,[ASCIZ /Error modes are: Q(quiet), L or F (logging), N (numbers).
Precede a mode letter by - to reset the mode. Action responses are: <CR>(continue),
<LF>(auto cont), D(DDT), B(debugger), E(SOS), T(TV editor), X(exit), S(restart)
/]
>;NODEC
DEC<
PUUO 3,[ASCIZ /Error modes are: Q(quiet), L or F (logging), N (numbers).
Precede a mode letter by - to reset the mode. Action responses are: <CR>(continue),
<LF>(auto cont), D(DDT), B(debugger), E(SOS), T(TECO), X(exit), S(restart)
/]
>;DEC
>;NOTYMSHR
TYMSHR<
PUUO 3,[ASCIZ /Error modes are: Q(quiet), L or F (logging), N (numbers).
Precede a mode letter by - to reset the mode. Action responses are: <CR>(continue),
<LF>(auto cont), D(DDT), B(debugger), E(EDIT10), T(TV editor), X(exit), S(restart)
/]>;TYMSHR
GOFLY: AOS (P) ;SKIP RETURN (SETMN ROLLS ITS OWN)
GOTRY: SETZM %MINUS
POPJ P,
;MORE SERVICE ROUTINES FOR MYERR
SETMN: SETOM %MINUS
AOS (P)
POPJ P,
SETNUM: SKIPE %MINUS
SOSA %NUMBS
AOSA %NUMBS
JRST GOFLY ;GO AWAY, HE DOESNOT WANT NUMBERS
JRST DOOVER
SETQT: SKIPN %MINUS
AOSA %QUIET
SOSA %QUIET
JRST GOFLY ;GO AWAY - HE WANTS QUIET
DOOVER: PUSH P,%LOGGIN ;SAVE
SETZM %LOGGIN
PUSHJ P,ERPRIN ;PRINT AGAIN - DON'T BOTHER GETTING %ERFLGS
POP P,%LOGGIN ;RESTORE
JRST GOFLY
NOTENX <
SETFL: RELEASE LOG,0
SETZM %LOGGIN
SKIPE %MINUS
JRST GOFLY ;THE END (WAS A -F)
PUSH P,TTYTYI ;SPECIAL INCHWL KLUGE
SETOM TTYTYI ;
HRLZI 14,'LOG' ;
MOVEM 14,EXTEN ;
PUSHJ P,FILNAM ;I HOPE THIS DOESN'T CLOBBER NAME... TOO BAD
POP P,TTYTYI ;
SKIPE NOFILE
JRST [PUUO 3,[ASCIZ/INVALID FILE NAME SYNTAX
/]
JRST GOFLY]
JRST SETLF
SETLOG: RELEASE LOG,0 ;ALWAYS START WITH CLEAN SLATE
SETZM %LOGGIN
SKIPE %MINUS
JRST GOFLY ;WAS A -L
HRLZI TEMP,'LOG' ;DEFAULT EXTENSION
MOVEM TEMP,EXTEN
SETZM WORD3
MOVE TEMP,SRCPPN ;REDUNDANCY FOR REQUIRE...ERROR!MODES BENEFIT
MOVEM TEMP,PPN
MOVE TEMP,SRCFIL
MOVEM TEMP,NAME
SETLF: HRLZI TEMP,'DSK'
MOVEM TEMP,LOGDEV ;
MOVEI SBITS2,LOGCDB ;READY TO OPEN LOG FILE
PUSHJ P,OPNUP ;OPEN SEZ ME!
JRST [PUUO 3,[ASCIZ /ERROR LOGGER: OPEN FAILURE
/]
JRST GOFLY]
JRST [PUUO 3,[ASCIZ /ERROR LOGGER: ENTER FAILURE
/]
JRST GOFLY]
>;NOTENX
TENX <
SETFL: HRROI 1,[ASCIZ/ Logfile:/]
SKIPE %MINUS ;WAS -F, DON'T PROMPT
JSYS PSOUT ;PROMPT HIM
MOVEI 1,ELOGF ;FILENAME FROM TERMINAL
JRST SETXX
SETLOG: MOVEI 1,ELOGL ;STANDARD FILENAME
SETXX: SKIPE %MINUS
JRST SHUTLG ;WAS -F OR -L (CLOSE LOGFILE)
EXCH 1,LOGJFN ;TAKE CARE OF ANY LEFTOVER JFN
SKIPE %LOGGIN
JRST [HRRZI 1,(1) ;CLEAR LH SO CLOSF WILL DO RLJFN
JSYS CLOSF ;AND DROP OLD LOGFILE
JFCL
JRST .+1]
MOVE 1,LOGJFN ;RECOVER FILE SPECS
SETZB B,LOGJFN ;SET FOR GTJFN, CLEAR OLD LOG JFN
JSYS GTJFN
JRST [HRROI 1,[ASCIZ/
Can't GTJFN your logfile.
/]
JRST LEAVLG]
MOVEM 1,LOGJFN ;SAVE JFN
MOVE B,[XWD 70000,100000] ;7 BIT WRITING
JSYS OPENF
JRST [HRRZ 1,LOGJFN ;CLOSE AND RELEASE JFN
JSYS CLOSF
HRROI 1,[ASCIZ/
Can't OPENF your logfile.
/]
JRST LEAVLG]
>;TENX
SETOM %LOGGIN
PUSH P,%QUIET ;SAVE FLAGS
SETOM %QUIET ;MAKE IT NOT PRINT
PUSHJ P,ERPRIN ;PRINT AGAIN
POP P,%QUIET ;RESTORE FLAGS
JRST GOFLY
TENX <
SHUTLG: HRROI 1,[ASCIZ / No logfile to shut. /]
SKIPE %LOGGIN ;ALREADY OFF
JRST [HRRZ 1,LOGJFN ;GET RID OF JFN
JSYS CLOSF ;DROP OLD LOGFILE
JFCL
HRROI 1,[ASCIZ / Logfile shut. /]
JRST .+1]
LEAVLG: JSYS PSOUT ;PRINT MESSAGE,
SETZM LOGJFN ;GET RID OF JFN
SETZM %LOGGIN ;CLEAR LOGGING
JRST GOFLY ;AND CONTINUE
;long form GTJFN block -- this is for default file name
ELOGL: XWD 400000,0
XWD 377777,377777
0
0
XWD -1,DEFFLN ;set in CC
XWD -1,[ASCIZ/LOG/]
BLOCK 3
;this one is for file from terminal
ELOGF: XWD 460000,0 ;CONFIRM BITS ON
XWD 100,101
0
0
XWD -1,DEFFLN
XWD -1,[ASCIZ/LOG/]
BLOCK 3
>;TENX
DEBUGA:
IFN FTDEBUG <PUSHJ P,INNA ;GO TO COMPILER DEBUGGER
>; FTDEBUG
JRST GOFLY
DSCR PRINT.
PAR A points to some asciz
SID none
DES prints the string given it, and logs it out if the
guy is enabled for that.
⊗
↑↑PRINT.:
SKIPN %QUIET
PUUO 3,(A) ;PRINT THE MSG
SKIPN %LOGGIN
POPJ P,
PUSH P,B
NOTENX <
HRLI A,(<POINT 7,0>) ;BYTE POINTER
GG..: ILDB B,A ;GET BYTE
JUMPE B,MPOPJ ;END OF LINE
SOSG LOGCNT
OUTPUT LOG,
IDPB B,LOGPNT
JRST GG..
>;NOTENX
TENX <
HRROI 2,(1)
HRRZ 1,LOGJFN
PUSH P,3
SETZ 3,
JSYS SOUT
POP P,3
>;TENX
MPOPJ: POP P,B
POPJ P, ;SUPER-DUPER ERROR RECOVERY, HUH?
ERPRIN:
MOVE A,..STR ;GET MSG - ITS ALREADY ASCIZ!
PUSHJ P,PRINT. ;PRINT IT!
PUSHJ P,DSPLIN ;PRINT CURRENT LINE AND SUCH
SKIPN %NUMBS ;WANT NUMBERS?
POPJ P,
MOVEI A,[ASCIZ /CALLED FROM /]
PUSHJ P,PRINT.
MOVE B,..LOCA ;THE LOCATION
SUBI B,1
PUSH P,C
PUSHJ P,PRNT.
POP P,C
MOVEI A,CRLF..
PUSHJ P,PRINT.
POPJ P,
PRNT.: IDIVI B,10 ;FAMOUS DEC RECURSIVE NUMBER PRINTER.
IORI C,"0"
HRLM C,(P)
SKIPE B
PUSHJ P,PRNT.
HLRZ C,(P)
ROT C,-7
MOVEI A,C
PUSHJ P,PRINT.
POPJ P,
CRLF..: ASCIZ /
/
COMMENT ⊗Dsplin Routine for Displaying Input Line⊗
DSCR DSPLIN
PAR Line specs from compiler,
CAL PUSHJ
RES Types out current input line on tty, may log if that is on.
SID changes A,B,C,TEMP
⊗
↑DSPLIN:
SETZM DLINBF
MOVE TEMP,[XWD DLINBF,DLINBF+1]
BLT TEMP,ENDDBF-1 ;MAKE ALL DISPLAY BUFFER ASCID
PUSH P,PNEXTC ;SAVE BECAUSE MIGHT GRONK
SKIPN LSTCHR
JRST NOBAK
REPEAT 4,<IBP PNEXTC
>
SOS PNEXTC
NOTENX <
NOBAK: PUSH P,12 ;SAVE TEMPORARILY
PUSH P,B
MOVE 12,[POINT 7,DLINBF] ;OUTPUT POINTER, PRINSYM WANTS HERE
MOVE A,SRCFIL ;PRINT FILE NAME
PUSHJ P,PRINSYM ;WITH THIS ROUT
MOVE TEMP,12 ;OUTPUT HERE FROM NOW ON
POP P,B
POP P,12
>;NOTENX
TENX <
NOBAK: PUSH P,B
MOVE TEMP,[POINT 7,DLINBF] ;OUTPUT POINTER
MOVE A,[POINT 7,SRCFLN] ;NAME, SET UP IN CC
PUSHJ P,ASCFIL ;COPY OVER, LEAVING UPDATED BP IN TEMP
POP P,B
>;TENX
MOVE D,FPAGNO
SETZM BKR ;DENOTE 0 AS BREAK CHAR
MOVE A,[POINT 7,[ASCII /, PAGE /]]
PUSHJ P,ASCFIL ;TELL HIM WHAT IT IS
PUSHJ P,DECFIL ;STUFF PAGE NUM IN BUFFER
MOVE A,[POINT 7,[<BYTE (7) 15,12>]] ;MAKE SPACE
PUSHJ P,ASCFIL
SETOM BKR ;BREAK ON 0, 177, OR 12
MOVE A,[POINT 7,ASCLIN] ;PREPARE TO OUTPUT LINE NO.
SKIPE (A)
PUSHJ P,ASCFIL ;DO IT
MOVE A,[POINT 7,[ASCII / /]]
PUSHJ P,ASCFIL
MOVE C,SCNWRD ;GET LIST CONTROL BITS
TLNN C,4000 ;IN A MACRO?
JRST NOMAC ;NO
HRRZ C,DFSTRT
MOVE C,2(C) ;PNEXTC AT THAT TIME
MOVEM C,FILBP ;ARROW CONTROL
MOVE A,IPLINE ;WHERE IT ALL BEGAN
PUSHJ P,ASCFIL ;DO THE LINE
SETZM BKR ;TEMP
MOVE A,[POINT 7,[BYTE (7) 15,12,12]]
PUSHJ P,ASCFIL ;GO TO NEXT LINE
SETOM BKR
MOVE A,[POINT 7,[ASCIZ / /]]
SKIPE ASCLIN ;IF PUT OUT LINE BEFORE,
PUSHJ P,ASCFIL ;MATCH IT
NOMAC: MOVE C,PNEXTC ;SAME FOR CURRENT LINE
MOVEM C,FILBP
MOVE A,PLINE
PUSHJ P,ASCFIL
;; \UR#8\ PUT A LINEFEED AFTER DISPLAYED LINE
MOVEI A,12
IDPB A,TEMP
;;
MOVEI A,0
IDPB A,TEMP ;MAKE INTO ASCIZ
SETZM FILBP ;PRECAUTION
;;%AI% 11/10/73 KVL STANDARDIZE ERROR PRINTING
MOVEI A,DLINBF ;PRINT (AND/OR LOG) MESSAGE
PUSHJ P,PRINT.
;; %AI%
POPOP: POP P,PNEXTC ;GET REAL ONE BACK
POPJ P,
↑.CORERR:ERR <NO CORE AVAILABLE>
COMMENT ⊗Interrupt Handler -- Intrpt, Povtrp⊗
DSCR POVTRP
CAL SYSTEM INTERRUPT
PAR JOBTPC is 1 past bad instr.
RES POVTAB(offending AC) is inspected for a string address.
If it is there, the string is TTYOUTed as an error, indicating
to the user which PDL oved. This is a fatal error message.
Continuation is in general quite futile.
⊗
;;%AY% -- REWORK TO USE THE RUNTIME ROUTINES
;;#GH# DCS 2-1-72 (5-5) <ESC>I CAUSES PARSER TO BREAK AFTER NEXT SCAN
NOTENX <
↑INTRPT:
NOEXPO <
;; RHT 2-12-73 INTMOD NOW DOES THE DISPATCH (%AY%)
;; MOVE TEMP,JOBCNI ;REASON
;; TLNN TEMP,INTTTI ;<ESC> I?
;; JRST POVDO ; NO, PDL OV
;; %AI% 11/10/73 KVL <ESC> I RESETS THE ERROR HANDLER
↑ITTYDO:
SETZM %QUIET
SETZM %ERGO ;MAKE THE NEXT ERROR VISIBLE
IFN FTDEBUG, <
MOVE TEMP,[XWD 400000,377777];INTERRUPT INDICATION
SETZM MULTP ;NOT IN MULTIPLE-PROCEED,
MOVEM TEMP,.DBG. ; IT IS GOING TO STOP
>;IFN FTDEBUG
CALL6 DISMIS ; OR ELSE COULD JUST RETURN
↑POVDO:
EXTERNAL XJBTPC
MOVE LPSA,GOGTAB ;
MOVE TEMP,XJBTPC ;REAL TRAP LOCN
MOVEM TEMP,UUO1(LPSA) ;"RETURN"
CALL6 (UWAIT) ;GET OUT OF MONITOR MODE, GET ACS
CALL6 (DEBREAK) ;"JRST" .+1
>;NOEXPO
;;#GH# (5-5)
EXPO <
;; IN THIS CASE, MUST SIMULATE A DEBREAK.
↑POVDO:
MOVE LPSA,GOGTAB ;
MOVE TEMP,JOBTPC ;REAL TRAP LOCN
MOVEM TEMP,UUO1(LPSA) ;"RETURN"
MOVEI TEMP,POVTRP ;WHERE GO TO
MOVEM TEMP,JOBTPC ;
POPJ P, ;THIS "DISMISSES" US
>;EXPO
;;%AY%
↑POVTRP: MOVEM TEMP,PDLSV ;SAVE ACS
MOVEM LPSA,PDLSV1
;;#GM# DCS 2-6-72 (1-1) WAS WIPING OUT TEMP WITH MOVEW
MOVE LPSA,GOGTAB ;NOW RECORD WHERE IT HAPPENED FOR ERR MSG
;;%AY% MOVEW UUO1(LPSA),JOBTPC -- USED TO BE
MOVE TEMP,UUO1(LPSA) ;CAREFULLY SET UP ABOVE
>;NOTENX
TENX <
;First the TENEX equivalent of <ESC>I - currently control H - which
;is copied somewhat blindly from DCS's code @ INTRPT above. The only
;other TENX switched code related to this is in SAILNIT where
;the compiler sticks the right vector into the channel table to direct
;the interrupt here and arm the control character (ATI jsys).
↑ITTYDO: SETZM %ERGO
SETZM %QUIET
SETZM MULTP
MOVEM TEMP,.DBG. ;SAVE TEMP
MOVE TEMP,[XWD 400000,377777] ;MAGIC NUMBER WORKS FOR DCS
EXCH TEMP,.DBG. ;OUGHT TO WORK FOR ME. RESTORE TEMP
JSYS DEBRK ;CONTINUE INTERRUPTED CODE
;Now for PDLOV stuff. Like <ESC I> requires SAIL init. to set up CHNTAB
;but in this case it MUST set it up as a level 3 interrupt or at least
;the same level assumed by the EXCH below. Also Stanford people beware
;of TENEX DEBRK which is just different enough from your DEBREAK to be
;confusing. See a JSYS manual.
EXTERNAL LPC3
↑POVDO: MOVEM TEMP,PDLSV
MOVEM LPSA,PDLSV1
HRRZI TEMP,.+3
EXCH TEMP,LPC3 ;ASSUME LEVEL 3. FORCE CONTINUATION
;OF INTERRUPTED CODE AT THE DEBRK+1
JSYS DEBRK
;BACK TO NORMAL USERMODE NOW; AC'S NOT CHANGED (I.E. SAVED OR RESTORED)
;THUS TEMP STILL HOLDS REAL INTERRUPT ADDR FOR PUTTING INTO JOBTPC
>;TENX
MOVEM TEMP,JOBTPC ;SO CODE BELOW WORKS (A REAL HACK)
;;#GM# (1-1) TEMP STILL HOLDS JOBTPC
LDB TEMP,[POINT 4,-1(TEMP),12] ;HOW DID IT HAPPEN?
ADDI TEMP,17 ;ADJUSTMENT
ANDI TEMP,17
ROT TEMP,-1 ;GET INDEX TO HALF-WORDS, LOW BIT TO SIGN
HRRZ LPSA,POVTAB(TEMP) ;ASSUME ODD -- RIGHT HAND
JUMPL TEMP,.+2 ;CORRECT
HLRZ LPSA,POVTAB(TEMP);EVEN -- WRONG
JUMPN LPSA,.+2 ;WAS THERE A CLUE?
MOVEI LPSA,[ASCIZ /UNKNOWN STACK/]
ERRPRI <PUSH-DOWN OVERFLOW -- > ;TELL HIM SOME
MOVE TEMP,PDLSV
EXCH LPSA,PDLSV1 ;RESTORE ACS
ERR. @PDLSV1 ;TELL HIM MORE
JRST 2,@JOBTPC ;IF HE SOMEHOW CONTINUES
BEND
USE ZVBLS
↑ZZZ←←.
USE VBLS
↑VVV←←.
USE
↑↑ZHI: ZZZ
↑↑VHI: VVV
BEND SAIL ;WOW
PATCH: BLOCK 50
VAR
XLIST
END START