Trailing-Edge
-
PDP-10 Archives
-
-
There are no other files named in the archive.
00100 COMMENT VALID 00010 PAGES
00200 C REC PAGE DESCRIPTION
00300 C00001 00001
00400 C00002 00002 HISTORY
00500 C00005 00003 Comser Data -- Povtab, Dsplin stuff
00600 C00007 00004 Strngc Supply Routines for Compiler Structures
00700 C00009 00005 Compiler-Specific portion of Error UUO stuff
00800 C00022 00006 SERVICE ROUTINES TO MYERR
00900 C00025 00007 MORE SERVICE ROUTINES FOR MYERR
01000 C00030 00008 DSCR PRINT.
01100 C00032 00009 Dsplin Routine for Displaying Input Line
01200 C00036 00010 Interrupt Handler -- Intrpt, Povtrp
01300 C00044 ENDMK
01400 C;
00100 COMMENT HISTORY
00200 AUTHOR,REASON
00300 021 102100000032 ;
00400
00500
00600 COMMENT
00700 VERSION 17-1(27) 10-5-78 BY RNG INSTALL TOPS-20 EDITOR INTERFACE
00800 VERSION 17-1(26) 11-1-75 BY RLS TENEX-ONLY CHANGES
00900 VERSION 17-1(25) 11-1-75
01000 VERSION 17-1(24) 10-18-74 BY RLS CHECK EDIT CODE FOR FEAT %BV%
01100 VERSION 17-1(23) 10-10-74 BY RLS BETTER IMSSS EDITOR INTERFACE
01200 VERSION 17-1(22) 10-10-74
01300 VERSION 17-1(21) 10-10-74
01400 VERSION 17-1(20) 9-27-74 BY JFR FIX AUTHOR REASON STUFF
01500 VERSION 17-1(18) 3-19-74 BY RHT LOOK OVER CODE WITH RLS
01600 VERSION 17-1(17) 3-17-74 BY RLS INSTALL TENEX
01700 VERSION 17-1(16) 12-8-73 BY JRL REMOVE SPECIAL STANFORD CHARACTERS(WHERE POSSIBLE)
01800 VERSION 17-1(15) 11-17-73
01900 VERSION 17-1(14) 11-10-73 BY KVL %AI% ADD <ESC> I INTERRUPT TO RESET ERROR HANDLER
02000 VERSION 17-1(13) 7-26-73 BY RHT **** VERSION 17 ****
02100 VERSION 16-2(12) 6-29-73 BY JRL END RINGSORT WITH POPJ P,
02200 VERSION 16-2(11) 3-13-73 BY JRL REMOVE REFERENCES TO GAG
02300 VERSION 16-2(10) 7-3-72 BY DCS INSTALL VERSION 16
02400 VERSION 15-2(9) 2-26-72 BY DCS <ESC> I ALWAYS BREAKS
02500 VERSION 15-2(8) 2-6-72 BY DCS BUG #GM# RETURN ADDRESS BEING WIPED OUT IN POVTRP
02600 VERSION 15-2(7) 2-5-72 BY DCS BUG #GJ# ADD LSTON LISTING CONTROL STUFF
02700 VERSION 15-2(6) 2-1-72 BY DCS BUG #GH# <ESC>I CAUSES PARSER TO BREAK AFTER NEXT SCAN
02800 VERSION 15-2(5) 12-26-71 BY DCS BUG #FU# REENABLE ACCESS TO FTDEBUG FROM ERR UUO
02900 VERSION 15-2(4) 12-22-71 BY DCS BUG #FT# DSPLIN CLEANED UP
03000 VERSION 15-2(3) 12-22-71 BY DCS BUG #FT# MYERR RETURNS BINLIN (SEQUENTIAL LINE #)
03100 VERSION 15-2(2) 12-21-71 BY DCS BUG #FS# REMOVE COM2 REFS (ASSUME RUNTIM OR LIB)
03200 VERSION 15-2(1) 12-2-71 BY DCS INSTALL VERSION NUMBER
03300
03400 ;
00100 COMMENT Comser Data -- Povtab, Dsplin stuff
00200 LSTON (COMSER)
00300
00400 BEGIN COMSER ;SERVICE ROUTINES FOR COMPILER.
00500
00600 ZERODATA (COMSER VARIABLES)
00700
00800 COMMENT
00900 POVTAB -- table of ASCIZ strings, one per AC, giving reasonable
01000 messages to be typed when PDL overflow occurs. 0 if none
01100 provided -- set up in POVSET from SAIL INIT -- changed
01200 occasionally as needs change. Used by POVTRP below
01300
01400 ^^POVTAB: BLOCK 10
01500
01600 ;PDLSV, PDLSV1 -- save AC's when PDL trapping
01700 ?PDLSV: 0
01800 ?PDLSV1:0
01900
02000 DATA (COMSER VARIABLES)
02100
02200 COMMENT
02300 DSPLIN and MYERR variables
02400
02500 DLINBF: BLOCK 53
02600
02700 ENDDBF_DLINBF+53
02800
02900 DATA(LOGGING VARIABLES)
03000
03100 NOTENX <
03200 MAKCDB(LOG,LOG,0,0,1)
03300 >;NOTENX
03400 TENX <
03500 LOGJFN: 0 ;LOGFLN, a bp to log file name, is set up in SAIL
03600 ;in the command scanner
03700 >;TENX
03800
03900 ZERODATA( LOGGING VARIABLES)
04000
04100 ^..STR:0
04200 ^..LOCA:0
04300 ^%QUIET: 0
04400 %MINUS: 0
04500 %NUMBS: 0
04600 %LOGGIN:0
04700
04800 ENDDATA
00100 COMMENT Strngc Supply Routines for Compiler Structures
00200
00300 ; SORT THE STRINGS IN SYMBOL TABLE
00400
00500 DSCR RINGSORT
00600 CAL PUSHJ from STRINGC.
00700 DES It passes off to the GC all of the Strings located in
00800 symbol table Semblks in the compiler. It does this by
00900 searching down the %RSTR ring (STRRNG).
01000
01100
01200 T__11
01300
01400 ^RINGSORT:
01500 HRRZ T,STRRNG ;PTR TO LAST BLOCK IN STRING RING
01600 JUMPE T,CPOPJ ;DONE WHEN 0, GO MARK VARIABLES
01700 RGSLUP: MOVEI A,$PNAME(T) ;PTR TO STRING DESCRIPTOR
01800 PUSHJ P,@-1(P) ;SORT IT INTO LISTS
01900 HLRZ T,%RSTR(T) ;NEXT BLOCK
02000 JUMPN T,RGSLUP ;CONTINUE UNLESS DONE
02100 POPJ P,
02200
02300
02400 ; SORT STRINGS IN DEFINE STACK
02500 DSCR DEFSRT
02600 CAL PUSHJ from STRINGC
02700 DES Passes off all Strings currently in the Define stack to be collected.
02800 ;
02900
03000 ^DEFSRT:
03100 HRRZ A,DFSTRT ;SORT STRINGS ON DEFINE STACK
03200 HRRZ T,DEFPDP ;TERMINATION VALUE
03300 SUBI A,1 ;INIT
03400 JRST SGDTST ;JUMP INTO THINGS
03500
03600 DEFMRK:
03700 PUSHJ P,@-1(P) ;SORT INTO STRUCTURE
03800 SGDTST:
03900 ADDI A,2 ;AUTO-INCR DOESN'T GO FAR ENOUGH
04000 CAMGE A,T ;DONE?
04100 JRST DEFMRK ; NO
04200 POPJ P, ; YES
04300
04400
04500 RINGSORT ;1 ROUTINE
04600 0
04700 LINK 4,.-1 ;FOR STRING GARBAGE COLL.
04800
04900 DEFSRT
05000 0
05100 LINK 4,.-1 ;AND ANOTHER ROUTINE.
05200
05300
00100 COMMENT Compiler-Specific portion of Error UUO stuff
00200
00300 TENX <
00400 SUMEX<;MYERR FOR SUMEX SYSTEM
00500 DSCR MYERR
00600 DES Part of the second segment kludge -- so that the error
00700 handler can call some routines which are specific to the
00800 compiler. There routines are -- display the current line.
00900 -- call the editor on the current input file.
01000 ;
01100 IFN FTDEBUG,<
01200 INNA ;FR0M ERR -- TO LOOK AT STACK
01300 ;> 0 ;NO DEBUGGER
01400 ^^MYERR:
01500
01600 DSCR
01700 Glorious SUMEX EDITOR interface. (Patent pending.)
01800 Here we are going to decide whether we want to edit,
01900 and if so, which editor.
02000 If ac A has 1, then we want some kind of edit.
02100 The information as to which editor we use is on the
02200 stack -- 0 for whichever editor is appropriate to the device,
02300 non-zero for STOPGAP, regardless of the device.
02400
02500 ;
02600
02700 EXTERNAL RUNPRG
02800
02900 CAIE A,1 ;REQUEST FOR EDIT?
03000 JRST NOE ;NO
03100
03200 ;definitely call some editor. First store things that
03300 ;are the same for all editors.
03400
03500 MOVE TEMP,[XWD TMPCBF,TMPCBF+1]
03600 SETZM TMPCBF
03700 BLT TEMP,TMPCBF+37 ;clear before starting
03800
03900 EXCH SP,STPSAV ;STRING STACK
04000 HRROI 1,TMPCBF+1
04100 HRRZ 2,SRCJFN
04200 SETZ 3,
04300 JSYS JFNS ;NAME OF FILE
04400 SETZ 3,
04500 IDPB 3,2 ;PUT A ZERO THERE IN CASE
04600
04700 HRROI 1,TMPCBF+13
04800 HRROI 2,[ASCIZ/<SUBSYS>SAIL.SAV/]
04900 SETZ 3,
05000 JSYS SOUT ;COPY STRING FOR RETURN
05100
05200 MOVE TEMP,[XWD CMDLIN,TMPCBF+21]
05300 BLT TEMP,TMPCBF+37 ;COPY OVER COMMAND
05400
05500 SKIPN TEMP,ASCLIN ;LINE NUMBER
05600 MOVE TEMP,[ASCID/00000/]
05700 TRO TEMP,1 ;TURN ON BIT IF OFF
05800 MOVEM TEMP,TMPCBF+20 ;STORE
05900
06000 MOVE TEMP,FPAGNO ;THE PAGE
06100 DPB TEMP,[POINT 12,TMPCBF,11]
06200 MOVE TEMP,BINLIN ;THE LINE
06300 DPB TEMP,[POINT 12,TMPCBF,23]
06400
06500 ;TRICKY CODE TO GET THE BYTE NUMBER
06600 MOVE A,PNEXTC ;BP TO NEXT CHAR
06700 SKIPN LSTCHR ;NEED TO BACK UP BP?
06800 JRST DOTEC1 ;NO
06900 REPEAT 4,<IBP A>
07000 SOJ A, ;BACK IT UP
07100 DOTEC1: SETZ C, ;KEEP COUNT IN 3
07200 MOVE B,PLINE ;POINTER TO BEGINNING OF CURRENT LINE
07300
07400 DOTECL: IBP B ;INCREMENT
07500 AOJ C, ;ONE MORE CHAR
07600 CAMN A,B ;SAME YET?
07700 JRST GOTIT ;YES
07800 CAIG C,=300 ;NO LINE GOES MORE THAN 300 CHARS
07900 JRST DOTECL ;ANOTHER
08000 SETZ C, ;ASSUME NONE
08100 GOTIT:
08200 DPB C,[POINT 12,TMPCBF,35]
08300
08400 MOVEI TEMP,[=15
08500 POINT 7,[ASCIZ/<SUBSYS>TV.SAV/],-1]
08600 SKIPE -1(P) ;INSIST ON STOPGAP
08700 MOVEI TEMP,[=15
08800 POINT 7,[ASCIZ/<SUBSYS>SOS.SAV/],-1]
08900 DORUNC:
09000 SETO A,
09100 MOVEI B,TMPCBF
09200 JSYS PTINF ;SPECIAL IMSSS PTINF JSYS
09300 JFCL ;ERROR RETURN
09400
09500 MOVEI A,400000 ;THIS FORK
09600 SETO B,
09700 JSYS DIC ;DEACTIVATE ALL CHANNELS
09800 JSYS CIS ;CLEAR INTERRUPT SYSTEM
09900 MOVEI A,10 ;CONTROL-H INTERRUPT
10000 JSYS DTI ;DISABLE IT
10100 JSYS RESET ;CLOSE ALL FILES ETC MUMBLE
10200
10300 PUSH P,[1] ;INCREMENT FOR CCL STUFF
10400 PUSH P,[0] ;SAME FORK
10500 PUSH SP,(TEMP) ;PROGRAM TO RUN
10600 PUSH SP,1(TEMP)
10700 PUSHJ P,RUNPRG ;SHOULD NEVER RETURN
10800 HRROI 1,[ASCIZ/
10900 Runcall error for IMSSS editor interface.
11000 /]
11100 JSYS PSOUT
11200 EXCH SP,STPSAV
11300 JRST SAIL ;AND RESTART
11400
11500 >;SUMEX
11600 NOSUMEX<
11700 IMSSS<;MYERR FOR IMSSS SYSTEM
11800 DSCR MYERR
11900 DES Part of the second segment kludge -- so that the error
12000 handler can call some routines which are specific to the
12100 compiler. There routines are -- display the current line.
12200 -- call the editor on the current input file.
12300 ;
12400 IFN FTDEBUG,<
12500 INNA ;FR0M ERR -- TO LOOK AT STACK
12600 ;> 0 ;NO DEBUGGER
12700 ^^MYERR:
12800
12900 DSCR
13000 Glorious IMSSS EDITOR interface. (Patent pending.)
13100 Here we are going to decide whether we want to edit,
13200 and if so, which editor.
13300 If ac A has 1, then we want some kind of edit.
13400 The information as to which editor we use is on the
13500 stack -- 0 for whichever editor is appropriate to the device,
13600 non-zero for STOPGAP, regardless of the device.
13700
13800 ;
13900
14000 EXTERNAL JFNS,CVSIX,JFNTBL,RUNPRG
14100
14200 DEFINE JFNSMK(X,Y)<
14300 PUSH P,[1]
14400 PUSH P,[XWD X,0]
14500 PUSHJ P,JFNS
14600 PUSHJ P,CVSIX
14700 MOVEM A,Y
14800 >
14900
15000 CAIE A,1 ;REQUEST FOR EDIT?
15100 JRST NOE ;NO
15200
15300 ;definitely call some editor. First store things that
15400 ;are the same for all editors.
15500
15600 MOVE TEMP,[XWD TMPCBF,TMPCBF+1]
15700 SETZM TMPCBF
15800 BLT TEMP,TMPCBF+37 ;clear before starting
15900 MOVEW JFNTBL+1,SRCJFN ;FAKE FOR JFNS -- WHAT A KROK
16000 MOVEW TMPCBF+32,<[SIXBIT/SYS/]>
16100 MOVEW TMPCBF+33,<[SIXBIT/SAIL/]> ;return to SAIL
16200 MOVE TEMP,[XWD CMDLIN,TMPCBF+6]
16300 BLT TEMP,TMPCBF+30 ;COPY OVER COMMAND
16400 EXCH SP,STPSAV ;GET STRING PDL
16500 JFNSMK(001000,TMPCBF) ;GET FILE NAME PIECES
16600 JFNSMK(000100,TMPCBF+1)
16700 JFNSMK(010000,TMPCBF+3)
16800 MOVEW TMPCBF+5,FPAGNO ;page number
16900 SKIPN -1(P) ;STOPGAP?
17000 JRST DECIDE ;NOPE, DECIDE WHICH EDITOR
17100 DOSOS: SKIPN TEMP,ASCLIN ;THE LINE NO
17200 MOVE TEMP,[ASCID/00000/];SUPPLY ONE
17300 TRO TEMP,1 ;TURN ON BIT, IN CASE OFF
17400 MOVEM TEMP,TMPCBF+4
17500 ;STORE RUNCALL INFO IN TEMP
17600 MOVEI TEMP,[ =16
17700 POINT 7,[ASCIZ/<SUBSYS>EDIT.SAV/],-1]
17800 DORUNC:
17900 SETO A,
18000 MOVEI B,TMPCBF
18100 JSYS PTINF ;SPECIAL IMSSS PTINF JSYS
18200 JFCL
18300
18400 MOVEI A,400000 ;THIS FORK
18500 SETO B,
18600 JSYS DIC ;DEACTIVATE ALL CHANNELS
18700 JSYS CIS ;CLEAR INTERRUPT SYSTEM
18800 MOVEI A,10 ;CONTROL-H INTERRUPT
18900 JSYS DTI ;DISABLE IT
19000 JSYS RESET ;CLOSE ALL FILES ETC MUMBLE
19100
19200 PUSH P,[1] ;INCREMENT FOR CCL STUFF
19300 PUSH P,[0] ;SAME FORK
19400 PUSH SP,(TEMP) ;PROGRAM TO RUN
19500 PUSH SP,1(TEMP)
19600 PUSHJ P,RUNPRG
19700 HRROI A,[ASCIZ/
19800 Runcall error for IMSSS editor interface.
19900 /]
20000 JSYS PSOUT
20100 EXCH SP,STPSAV ;PUT BACK THE STRING PDL
20200 JRST SAIL
20300
20400 DECIDE:
20500 MOVE TEMP,BINLIN ;LINE NUMBER
20600 ;TRICKY CODE TO GET THE BYTE NUMBER
20700 MOVE A,PNEXTC ;BP TO NEXT CHAR
20800 SKIPN LSTCHR ;NEED TO BACK UP BP?
20900 JRST DOTEC1 ;NO
21000 REPEAT 4,<IBP A>
21100 SOJ A, ;BACK IT UP
21200 DOTEC1: SETZ C, ;KEEP COUNT IN 3
21300 MOVE B,PLINE ;POINTER TO BEGINNING OF CURRENT LINE
21400
21500 DOTECL: IBP B ;INCREMENT
21600 AOJ C, ;ONE MORE CHAR
21700 CAMN A,B ;SAME YET?
21800 JRST GOTIT ;YES
21900 CAIG C,=300 ;NO LINE GOES MORE THAN 300 CHARS
22000 JRST DOTECL ;ANOTHER
22100 SETZ C, ;ASSUME NONE
22200 GOTIT:
22300 HRL TEMP,C ;XWD BYTENO,LINENO
22400
22500 MOVEM TEMP,TMPCBF+4 ;STORE IT
22600 MOVEI TEMP,[=15
22700 POINT 7,[ASCIZ/<SUBSYS>TV.SAV/],-1]
22800 JRST DORUNC ;STORE INFO AND DO RUN CALL
22900
23000 >;IMSSS
23100 NOIMSSS<;MYERR FOR NON-IMSSS TENEX SYSTEM
23200 DSCR MYERR
23300 DES TOPS-20 EDITOR interface (by Bob Goldberg and Chuck Hedrick).
23350 Does RUNPRG on logical name EDITOR: as an editor
23400 after putting "EDIT <filename><crlf>" in the RSCAN buffer and
23500 storing the following seven 36-bit words into the PRARG buffer.
23600 Note that this could be read by looking up the file "EDI" in
23700 TMPCOR using the emulator, though we expect editors to do
23800 PRARG directly.
23900
24000 1 - number of argument blocks
24100 2 - start of first argument block
24200 'EDI',,4 - argument name,,length
24300 ASCLIN - The ascii line number on which the
24400 error handler was called, or 00100 if
24500 the file does not have line numbers.
24600 FPAGNO - The binary page number, e.g. 2.
24700 BINLIN - The binary line number on this page.
24800 BYTENO - The byte within the line which is
24900 about to be scanned by the compiler.
25000
25100 The editor is expected to look for the PRARG block
25200 whenever it is started. DEC is using the +1 start
25300 address for reenter, so we can't use it. Editors
25400 that don't understand PRARG should at least get the
25500 file name right.
25600 ;
25700 EXTERNAL RUNPRG,$OSTYP;
25800 ^^MYERR:
25900 SKIPE $OSTYP ;[clh] only on Tops-20
26000 CAIE A,1 ;REQUEST FOR EDIT?
26100 JRST NOE ;NO
26200 MOVE TEMP,[XWD TMPCBF,TMPCBF+1] ;ZERO BUFFER
26300 SETZM TMPCBF
26400 BLT TEMP,TMPCBF+37 ;WITH BLT TRICK
26500 EXCH SP,STPSAV ;GET STRING PDL
26600 HRROI A,TMPCBF ;PLACE TO PUT RSCAN STRING
26700 HRROI B,[ASCIZ/EDIT /];SET UP TO DO SOUT TO TMPCBF
26800 SETZ C,
26900 JSYS SOUT ;SEND IT TO TMPCBF
27000 MOVE C,A ;SAVE POINTER
27100 AGAIN: HRLZI A,160003 ;I/O to terminal, short form, confirm & msg
27200 MOVE B,[xwd 100,101]
27300 SETZ D, ;ASSUME USING NEW FILE
27400 JSYS GTJFN
27500 ERJMP [CAIE A,600115 ;Null file name?
27600 JRST BADFIL ;No, a real error
27700 MOVE A,SRCJFN ;Yes, get default
27800 SETO D, ;Say the same file
27900 JRST .+1]
28000 HRRZ B,A ;GET JFN IN B
28100 MOVE A,C ;RESTORE POINTER TO A
28200 MOVE C,[222200,,1] ;Format with no generation number
28300 JSYS JFNS ;FILE NAME
28400 SETZ C,
28500 HRROI B,CRLF..
28600 JSYS SOUT ;FINISH LINE
28700 SETZ B,
28800 IDPB B,A ;MAKE STRING ASCIZ
28900 HRROI A,TMPCBF ;BEGINNING OF RSCAN STRING
29000 JSYS RSCAN ;STUFF IT IN BUFFER
29100 JFCL ;IGNORE ERRORS
29200 JUMPE D,DORUN ;IF NEW FILE, NO PRARG
29300
29400 ;; Now put 4 words of info in the PRARG buffer
29500
29600 MOVE D,[XWD [,1
29700 ,2
29800 XWD 'EDI',4],TMPCBF]
29900 BLT D,TMPCBF+2 ;SET UP +0 TO +2 IN BUFFER
30000 SKIPN D,ASCLIN ;LINE NUMBER
30100 MOVE D,[ASCID/00100/];CHOOSE A REASONABLE DEFAULT
30200 TRO D,1 ;Make sure bit is on
30300 MOVEM D,TMPCBF+3 ;First word of buffer is ASCLIN
30400 MOVE D,FPAGNO
30500 MOVEM D,TMPCBF+4 ;Second word is FPAGNO
30600 MOVE D,BINLIN
30700 MOVEM D,TMPCBF+5 ;Third word is BINLIN
30800 ;TRICKY CODE TO GET THE BYTE NUMBER
30900 MOVE A,PNEXTC ;BP TO NEXT CHAR
31000 SKIPN LSTCHR ;NEED TO BACK UP BP?
31100 JRST DOTEC1 ;NO
31200 REPEAT 4,<IBP A>
31300 SOJ A, ;BACK IT UP
31400 DOTEC1: SETZ C, ;KEEP COUNT IN 3
31500 MOVE B,PLINE ;POINTER TO BEGINNING OF CURRENT LINE
31600
31700 DOTECL: IBP B ;INCREMENT
31800 AOJ C, ;ONE MORE CHAR
31900 CAMN A,B ;SAME YET?
32000 JRST GOTIT ;YES
32100 CAIG C,=300 ;NO LINE GOES MORE THAN 300 CHARS
32200 JRST DOTECL ;ANOTHER
32300 SETZ C, ;ASSUME NONE
32400 GOTIT:
32500 MOVEM C,TMPCBF+6 ;Fourth word is Byte number in line
32600 MOVE A,[2,,400000] ;store in PRARG,current process
32700 MOVEI B,TMPCBF ;Where PRARG will find args
32800 MOVEI C,7 ;Length of arg block
32900 JSYS PRARG ;always returns .+1
33000
33100 ;; Now run the editor
33200 DORUN: MOVEI TEMP,[=7 ;LENGTH OF STRING.
33300 POINT 7,[ASCIZ/EDITOR:/],-1] ;EDITOR: SHOULD BE DEFINED
33400 ;BY SYSTEM TO BE DEFAULT
33500 ;EDITOR. USER CAN
33600 ;REDEFINE IF HE WANTS
33700 MOVEI A,400000 ;THIS FORK
33800 SETO B,
33900 JSYS DIC ;DEACTIVATE ALL CHANNELS
34000 JSYS CIS ;CLEAR INTERRUPT SYSTEM
34100 MOVEI A,10 ;CONTROL-H INTERRUPT
34200 JSYS DTI ;DISABLE IT
34300 JSYS RESET ;CLOSE ALL FILES ETC MUMBLE
34400
34500 PUSH P,[0] ;INCREMENT FOR CCL STUFF
34600 PUSH P,[0] ;SAME FORK
34700 PUSH SP,(TEMP) ;PROGRAM TO RUN
34800 PUSH SP,1(TEMP)
34900 PUSHJ P,RUNPRG
35000 HRROI A,[ASCIZ/
35100 ? Could not run "EDITOR:" as an editor.
35200 /]
35300 JSYS PSOUT
35400 EXCH SP,STPSAV ;PUT BACK THE STRING PDL
35500 JRST SAIL
35600
35700 BADFIL: HRROI A,[ASCIZ/
35800 ? Invalid file spec: Type file spec, or <CR> to edit source file
35900 */]
36000 JSYS PSOUT
36100 JRST AGAIN
36200 >;NOIMSSS
36300 >;NOSUMEX
36400 >;TENX
36500 NOTENX <
36600 COMMENT Compiler-Specific portion of Error UUO stuff
36700
36800 DSCR MYERR
36900 DES Part of the second segment kludge -- so that the error
37000 handler can call some routines which are specific to the
37100 compiler. There routines are -- display the current line.
37200 -- call the editor on the current input file -- log error messages.
37300 ;
37400 ^^MYERR:
37500 MOVE 13,SRCFIL ;FILE NAME NEEDED IN ANY CASE
37600 MOVE 14,SRCEXT
37700 MOVE 11,SRCPPN
37800 SKIPE A,-1(P) ;GO TO EDITOR?
37900 JRST NOE ;NOPE, DO DSPLIN & LOGGING STUFF
38000 MOVE 16,FPAGNO ;AS IS THIS
38100 SKIPN 15,ASCLIN
38200 MOVE 15,[ASCID/00000/]
38300 TRO 15,1 ;FOR WFW
38400 SKIPA 12,BINLIN ;TV WILL WANT THIS NUMBER INSTEAD
38500 >;NOTENX
38600 GOHOHO: SUB SP,X44 ;GET RID OF STRINGS
38700 SUB P,X22
38800 JRST @2(P)
38900
39000 NOE: HRRZM A,..LOCA ;STORE NUMBERS
39100 MOVE A,-2(SP) ;GET STRING
39200 HRRZM A,..STR ;STORE IT TOO
39300 SKIPL %RECOV
39400 SETZM %QUIET ;MAKE FATAL ERRORS PRINT
39500 PUSHJ P,ERPRIN ;PRINT MSG, ETC.
39600 ;;=I02= CHECK TO SEE IF A BATCH JOB. CLH 31-MAY-75
39700 DEC<
39800 EXTERNAL %BATCH
39900 SKIPN %BATCH ;DO WE KNOW IF BATCH?
40000 JRST [AOS %BATCH ;NO- ASSUME IT IS
40100 MOVE A,[XWD -1,40]
40200 CALLI A,41 ;GETTAB
40300 JFCL
40400 TLNN A,200 ;BATCH?
40500 SETOM %BATCH ;NO - SET TO -1
40600 JRST .+1]
40700 SKIPL %BATCH ;BATCH?
40800 JRST HOME2 ;YES
40900 > ;DEC
41000 ;;=I02= ^
41100 SKIPE %ERGO ;AUTO CONTINUE?
41200 JRST HOME2
41300 ;;#PR# RHT FLUSH TYPE AHEAD (1 OF 2)
41400 PUUO 2,B ;INCHRS
41500 JRST PROMPT ;NO TYPE AHEAD
41600 PUUO 11,0 ;CLEAR BUFFER
41700 CAIN B,12 ;ONLY USE TYPE AHEAD IF WAS A LF
41800 JRST CHRGOT ;HAVE GOT IT
41900 ;;#PR#
42000 PROMPT: PUUO 3,CRLF..
42100 MOVEI A,"?" ;PRINT ? FOR IRRECOVERABLE ERRORS,
42200 SKIPGE %RECOV ;CAN CONTINUE?
42300 MOVEI A,"^" ;SOMETHING PRINTABLE
42400 PUUO 1,A ;PRINT IT
42500 NOPROM:
42600 PUUO 0,B ;GET RESPONSE CHAR
42700 CHRGOT: PUSHJ P,DSPATC ;GO DO THE RIGHT THINGS
42800 JRST HOME0 ;GOT AN ACTIVATION LETTER
42900 SKIPE %MINUS ;DONOT PROMPT IF WE RECEIVED A MINUS
43000 JRST NOPROM
43100 JRST PROMPT
43200 ;;#PR#
43300 HOME0: CAIN B,15 ;IF A CR
43400 PUUO 2,A ;GOBBLE THE LF
43500 JRST HOME1 ;NOT ONE THERE
43600 JRST HOME1 ;
43700 ;;#PR#
43800 HOME2: SKIPA A,[0]
43900 HOME1: HRRZ A,B ;PUT LEFTOVER CHARACTER IN
44000 TLO A,3 ;DO NOT PRINT OR GIVE NUMBERS
44100 JRST GOHOHO ; AND A BOTTLE OF RUM
44200
00100 ; SERVICE ROUTINES TO MYERR
00200 ;Dspatc is also called from GEN in the routine that does REQUIRE ERROR!MODES.
00300 ;Dspatc skip returns if the contents of B was any of the error modes.
00400 ;It does a regular return if B was any of the activation responses.
00500 ;It skip returns if it doesn't recognize the character.
00600 ^DSPATC:
00700 CAIL B,"a" ;lower case?
00800 SUBI B,40 ;YES, CONVERT TO UPPER
00900 CAIN B,"Q"
01000 JRST SETQT
01100 CAIN B,"N"
01200 JRST SETNUM
01300 CAIN B,"L"
01400 JRST SETLOG
01500 CAIN B,"F"
01600 JRST SETFL
01700 CAIN B,"-"
01800 JRST SETMN
01900 CAIN B,"B"
02000 JRST DEBUGA
02100
02200 CAIE B,12 ;LF
02300 CAIN B,15 ;CR
02400 JRST GOTRY
02500 CAIE B,"X"
02600 CAIN B,"S"
02700 JRST GOTRY
02800 CAIE B,"T"
02900 CAIN B,"E"
03000 JRST GOTRY
03100 CAIE B,"B"
03200 CAIN B,"D"
03300 JRST GOTRY
03400 CAIE B,"A"
03500 CAIN B,"C"
03600 JRST GOTRY
03700 NOTYMSHR<
03800 NODEC<
03900 PUUO 3,[ASCIZ /Error modes are: Q(quiet), L or F (logging), N (numbers).
04000 Precede a mode letter by - to reset the mode. Action responses are: <CR>(continue),
04100 <LF>(auto cont), D(DDT), B(debugger), E(SOS), T(TV editor), X(exit), S(restart)
04200 /]
04300 >;NODEC
04400 DEC<
04500 PUUO 3,[ASCIZ /Error modes are: Q(quiet), L or F (logging), N (numbers).
04600 Precede a mode letter by - to reset the mode. Action responses are: <CR>(continue),
04700 <LF>(auto cont), D(DDT), B(debugger), E(SOS), T(TECO), X(exit), S(restart)
04800 /]
04900 >;DEC
05000 >;NOTYMSHR
05100 TYMSHR<
05200 PUUO 3,[ASCIZ /Error modes are: Q(quiet), L or F (logging), N (numbers).
05300 Precede a mode letter by - to reset the mode. Action responses are: <CR>(continue),
05400 <LF>(auto cont), D(DDT), B(debugger), E(EDIT10), T(TV editor), X(exit), S(restart)
05500 /]>;TYMSHR
05600 GOFLY: AOS (P) ;SKIP RETURN (SETMN ROLLS ITS OWN)
05700 GOTRY: SETZM %MINUS
05800 POPJ P,
05900
00100 ;MORE SERVICE ROUTINES FOR MYERR
00200 SETMN: SETOM %MINUS
00300 AOS (P)
00400 POPJ P,
00500
00600 SETNUM: SKIPE %MINUS
00700 SOSA %NUMBS
00800 AOSA %NUMBS
00900 JRST GOFLY ;GO AWAY, HE DOESNOT WANT NUMBERS
01000 JRST DOOVER
01100
01200 SETQT: SKIPN %MINUS
01300 AOSA %QUIET
01400 SOSA %QUIET
01500 JRST GOFLY ;GO AWAY - HE WANTS QUIET
01600 DOOVER: PUSH P,%LOGGIN ;SAVE
01700 SETZM %LOGGIN
01800 PUSHJ P,ERPRIN ;PRINT AGAIN - DON'T BOTHER GETTING %ERFLGS
01900 POP P,%LOGGIN ;RESTORE
02000 JRST GOFLY
02100
02200 NOTENX <
02300 SETFL: RELEASE LOG,0
02400 SETZM %LOGGIN
02500 SKIPE %MINUS
02600 JRST GOFLY ;THE END (WAS A -F)
02700 PUSH P,TTYTYI ;SPECIAL INCHWL KLUGE
02800 SETOM TTYTYI ;
02900 HRLZI 14,'LOG' ;
03000 MOVEM 14,EXTEN ;
03100 PUSHJ P,FILNAM ;I HOPE THIS DOESN'T CLOBBER NAME... TOO BAD
03200 POP P,TTYTYI ;
03300 SKIPE NOFILE
03400 JRST [PUUO 3,[ASCIZ/INVALID FILE NAME SYNTAX
03500 /]
03600 JRST GOFLY]
03700 JRST SETLF
03800
03900 SETLOG: RELEASE LOG,0 ;ALWAYS START WITH CLEAN SLATE
04000 SETZM %LOGGIN
04100 SKIPE %MINUS
04200 JRST GOFLY ;WAS A -L
04300 HRLZI TEMP,'LOG' ;DEFAULT EXTENSION
04400 MOVEM TEMP,EXTEN
04500 SETZM WORD3
04600 MOVE TEMP,SRCPPN ;REDUNDANCY FOR REQUIRE...ERROR!MODES BENEFIT
04700 MOVEM TEMP,PPN
04800 MOVE TEMP,SRCFIL
04900 MOVEM TEMP,NAME
05000 SETLF: HRLZI TEMP,'DSK'
05100 MOVEM TEMP,LOGDEV ;
05200 MOVEI SBITS2,LOGCDB ;READY TO OPEN LOG FILE
05300 PUSHJ P,OPNUP ;OPEN SEZ ME!
05400 JRST [PUUO 3,[ASCIZ /ERROR LOGGER: OPEN FAILURE
05500 /]
05600 JRST GOFLY]
05700 JRST [PUUO 3,[ASCIZ /ERROR LOGGER: ENTER FAILURE
05800 /]
05900 JRST GOFLY]
06000 >;NOTENX
06100
06200 TENX <
06300 SETFL: HRROI 1,[ASCIZ/ Logfile:/]
06400 SKIPE %MINUS ;WAS -F, DON'T PROMPT
06500 JSYS PSOUT ;PROMPT HIM
06600 MOVEI 1,ELOGF ;FILENAME FROM TERMINAL
06700 JRST SETXX
06800 SETLOG: MOVEI 1,ELOGL ;STANDARD FILENAME
06900 SETXX: SKIPE %MINUS
07000 JRST SHUTLG ;WAS -F OR -L (CLOSE LOGFILE)
07100 EXCH 1,LOGJFN ;TAKE CARE OF ANY LEFTOVER JFN
07200 SKIPE %LOGGIN
07300 JRST [HRRZI 1,(1) ;CLEAR LH SO CLOSF WILL DO RLJFN
07400 JSYS CLOSF ;AND DROP OLD LOGFILE
07500 JFCL
07600 JRST .+1]
07700 MOVE 1,LOGJFN ;RECOVER FILE SPECS
07800 SETZB B,LOGJFN ;SET FOR GTJFN, CLEAR OLD LOG JFN
07900 JSYS GTJFN
08000 JRST [HRROI 1,[ASCIZ/
08100 Can't GTJFN your logfile.
08200 /]
08300 JRST LEAVLG]
08400 MOVEM 1,LOGJFN ;SAVE JFN
08500 MOVE B,[XWD 70000,100000] ;7 BIT WRITING
08600 JSYS OPENF
08700 JRST [HRRZ 1,LOGJFN ;CLOSE AND RELEASE JFN
08800 JSYS CLOSF
08900 HRROI 1,[ASCIZ/
09000 Can't OPENF your logfile.
09100 /]
09200 JRST LEAVLG]
09300 >;TENX
09400 SETOM %LOGGIN
09500 PUSH P,%QUIET ;SAVE FLAGS
09600 SETOM %QUIET ;MAKE IT NOT PRINT
09700 PUSHJ P,ERPRIN ;PRINT AGAIN
09800 POP P,%QUIET ;RESTORE FLAGS
09900 JRST GOFLY
10000
10100 TENX <
10200 SHUTLG: HRROI 1,[ASCIZ / No logfile to shut. /]
10300 SKIPE %LOGGIN ;ALREADY OFF
10400 JRST [HRRZ 1,LOGJFN ;GET RID OF JFN
10500 JSYS CLOSF ;DROP OLD LOGFILE
10600 JFCL
10700 HRROI 1,[ASCIZ / Logfile shut. /]
10800 JRST .+1]
10900 LEAVLG: JSYS PSOUT ;PRINT MESSAGE,
11000 SETZM LOGJFN ;GET RID OF JFN
11100 SETZM %LOGGIN ;CLEAR LOGGING
11200 JRST GOFLY ;AND CONTINUE
11300
11400
11500 ;long form GTJFN block -- this is for default file name
11600 ELOGL: XWD 400000,0
11700 XWD 377777,377777
11800 0
11900 0
12000 XWD -1,DEFFLN ;set in CC
12100 XWD -1,[ASCIZ/LOG/]
12200 BLOCK 3
12300
12400 ;this one is for file from terminal
12500 ELOGF: XWD 460000,0 ;CONFIRM BITS ON
12600 XWD 100,101
12700 0
12800 0
12900 XWD -1,DEFFLN
13000 XWD -1,[ASCIZ/LOG/]
13100 BLOCK 3
13200
13300 >;TENX
13400
13500 DEBUGA:
13600 IFN FTDEBUG <PUSHJ P,INNA ;GO TO COMPILER DEBUGGER
13700 >; FTDEBUG
13800 JRST GOFLY
00100 DSCR PRINT.
00200 PAR A points to some asciz
00300 SID none
00400 DES prints the string given it, and logs it out if the
00500 guy is enabled for that.
00600
00700
00800 ^^PRINT.:
00900 SKIPN %QUIET
01000 PUUO 3,(A) ;PRINT THE MSG
01100 SKIPN %LOGGIN
01200 POPJ P,
01300 PUSH P,B
01400
01500 NOTENX <
01600 HRLI A,(<POINT 7,0>) ;BYTE POINTER
01700 GG..: ILDB B,A ;GET BYTE
01800 JUMPE B,MPOPJ ;END OF LINE
01900 SOSG LOGCNT
02000 OUTPUT LOG,
02100 IDPB B,LOGPNT
02200 JRST GG..
02300 >;NOTENX
02400 TENX <
02500 HRROI 2,(1)
02600 HRRZ 1,LOGJFN
02700 PUSH P,3
02800 SETZ 3,
02900 JSYS SOUT
03000 POP P,3
03100 >;TENX
03200 MPOPJ: POP P,B
03300 POPJ P, ;SUPER-DUPER ERROR RECOVERY, HUH?
03400
03500
03600 ERPRIN:
03700 MOVE A,..STR ;GET MSG - ITS ALREADY ASCIZ!
03800 PUSHJ P,PRINT. ;PRINT IT!
03900 PUSHJ P,DSPLIN ;PRINT CURRENT LINE AND SUCH
04000 SKIPN %NUMBS ;WANT NUMBERS?
04100 POPJ P,
04200 MOVEI A,[ASCIZ /CALLED FROM /]
04300 PUSHJ P,PRINT.
04400 MOVE B,..LOCA ;THE LOCATION
04500 SUBI B,1
04600 PUSH P,C
04700 PUSHJ P,PRNT.
04800 POP P,C
04900 MOVEI A,CRLF..
05000 PUSHJ P,PRINT.
05100 POPJ P,
05200
05300 PRNT.: IDIVI B,10 ;FAMOUS DEC RECURSIVE NUMBER PRINTER.
05400 IORI C,"0"
05500 HRLM C,(P)
05600 SKIPE B
05700 PUSHJ P,PRNT.
05800 HLRZ C,(P)
05900 ROT C,-7
06000 MOVEI A,C
06100 PUSHJ P,PRINT.
06200 POPJ P,
06300
06400 CRLF..: ASCIZ /
06500 /
00100 COMMENT Dsplin Routine for Displaying Input Line
00200
00300 DSCR DSPLIN
00400 PAR Line specs from compiler,
00500 CAL PUSHJ
00600 RES Types out current input line on tty, may log if that is on.
00700 SID changes A,B,C,TEMP
00800
00900
01000 ^DSPLIN:
01100 SETZM DLINBF
01200 MOVE TEMP,[XWD DLINBF,DLINBF+1]
01300 BLT TEMP,ENDDBF-1 ;MAKE ALL DISPLAY BUFFER ASCID
01400 PUSH P,PNEXTC ;SAVE BECAUSE MIGHT GRONK
01500 SKIPN LSTCHR
01600 JRST NOBAK
01700 REPEAT 4,<IBP PNEXTC
01800 >
01900 SOS PNEXTC
02000 NOTENX <
02100 NOBAK: PUSH P,12 ;SAVE TEMPORARILY
02200 PUSH P,B
02300 MOVE 12,[POINT 7,DLINBF] ;OUTPUT POINTER, PRINSYM WANTS HERE
02400 MOVE A,SRCFIL ;PRINT FILE NAME
02500 PUSHJ P,PRINSYM ;WITH THIS ROUT
02600 MOVE TEMP,12 ;OUTPUT HERE FROM NOW ON
02700 POP P,B
02800 POP P,12
02900 >;NOTENX
03000 TENX <
03100 NOBAK: PUSH P,B
03200 MOVE TEMP,[POINT 7,DLINBF] ;OUTPUT POINTER
03300 MOVE A,[POINT 7,SRCFLN] ;NAME, SET UP IN CC
03400 PUSHJ P,ASCFIL ;COPY OVER, LEAVING UPDATED BP IN TEMP
03500 POP P,B
03600 >;TENX
03700 MOVE D,FPAGNO
03800 SETZM BKR ;DENOTE 0 AS BREAK CHAR
03900 MOVE A,[POINT 7,[ASCII /, Page /]]
04000 PUSHJ P,ASCFIL ;TELL HIM WHAT IT IS
04100 PUSHJ P,DECFIL ;STUFF PAGE NUM IN BUFFER
04200 MOVE A,[POINT 7,[<BYTE (7) 15,12>]] ;MAKE SPACE
04300 PUSHJ P,ASCFIL
04400 SETOM BKR ;BREAK ON 0, 177, OR 12
04500 MOVE A,[POINT 7,ASCLIN] ;PREPARE TO OUTPUT LINE NO.
04600 SKIPE (A)
04700 PUSHJ P,ASCFIL ;DO IT
04800 MOVE A,[POINT 7,[ASCII / /]]
04900 PUSHJ P,ASCFIL
05000 MOVE C,SCNWRD ;GET LIST CONTROL BITS
05100 TLNN C,4000 ;IN A MACRO?
05200 JRST NOMAC ;NO
05300 HRRZ C,DFSTRT
05400 MOVE C,2(C) ;PNEXTC AT THAT TIME
05500 MOVEM C,FILBP ;ARROW CONTROL
05600 MOVE A,IPLINE ;WHERE IT ALL BEGAN
05700 PUSHJ P,ASCFIL ;DO THE LINE
05800 SETZM BKR ;TEMP
05900 MOVE A,[POINT 7,[BYTE (7) 15,12,12]]
06000 PUSHJ P,ASCFIL ;GO TO NEXT LINE
06100 SETOM BKR
06200 MOVE A,[POINT 7,[ASCIZ / /]]
06300 SKIPE ASCLIN ;IF PUT OUT LINE BEFORE,
06400 PUSHJ P,ASCFIL ;MATCH IT
06500 NOMAC: MOVE C,PNEXTC ;SAME FOR CURRENT LINE
06600 MOVEM C,FILBP
06700 MOVE A,PLINE
06800 PUSHJ P,ASCFIL
06900 ;; \UR#8\ PUT A LINEFEED AFTER DISPLAYED LINE
07000 MOVEI A,12
07100 IDPB A,TEMP
07200 ;;
07300 MOVEI A,0
07400 IDPB A,TEMP ;MAKE INTO ASCIZ
07500 SETZM FILBP ;PRECAUTION
07600 ;;%AI% 11/10/73 KVL STANDARDIZE ERROR PRINTING
07700 MOVEI A,DLINBF ;PRINT (AND/OR LOG) MESSAGE
07800 PUSHJ P,PRINT.
07900 ;; %AI%
08000 POPOP: POP P,PNEXTC ;GET REAL ONE BACK
08100 POPJ P,
08200
08300 ^.CORERR:ERR <NO CORE AVAILABLE>
00100 COMMENT Interrupt Handler -- Intrpt, Povtrp
00200
00300 DSCR POVTRP
00400 CAL SYSTEM INTERRUPT
00500 PAR JOBTPC is 1 past bad instr.
00600 RES POVTAB(offending AC) is inspected for a string address.
00700 If it is there, the string is TTYOUTed as an error, indicating
00800 to the user which PDL oved. This is a fatal error message.
00900 Continuation is in general quite futile.
01000
01100 ;;%AY% -- REWORK TO USE THE RUNTIME ROUTINES
01200
01300 ;;#GH# DCS 2-1-72 (5-5) <ESC>I CAUSES PARSER TO BREAK AFTER NEXT SCAN
01400 NOTENX <
01500 ^INTRPT:
01600 NOEXPO <
01700 ;; RHT 2-12-73 INTMOD NOW DOES THE DISPATCH (%AY%)
01800 ;; MOVE TEMP,JOBCNI ;REASON
01900 ;; TLNN TEMP,INTTTI ;<ESC> I?
02000 ;; JRST POVDO ; NO, PDL OV
02100 ;; %AI% 11/10/73 KVL <ESC> I RESETS THE ERROR HANDLER
02200 ^ITTYDO:
02300 SETZM %QUIET
02400 SETZM %ERGO ;MAKE THE NEXT ERROR VISIBLE
02500 IFN FTDEBUG, <
02600 MOVE TEMP,[XWD 400000,377777];INTERRUPT INDICATION
02700 SETZM MULTP ;NOT IN MULTIPLE-PROCEED,
02800 MOVEM TEMP,.DBG. ; IT IS GOING TO STOP
02900 >;IFN FTDEBUG
03000 CALL6 DISMIS ; OR ELSE COULD JUST RETURN
03100 ^POVDO:
03200 EXTERNAL XJBTPC
03300 MOVE LPSA,GOGTAB ;
03400 MOVE TEMP,XJBTPC ;REAL TRAP LOCN
03500 MOVEM TEMP,UUO1(LPSA) ;"RETURN"
03600 CALL6 (UWAIT) ;GET OUT OF MONITOR MODE, GET ACS
03700 CALL6 (DEBREAK) ;"JRST" .+1
03800
03900 >;NOEXPO
04000 ;;#GH# (5-5)
04100 EXPO <
04200 ;; IN THIS CASE, MUST SIMULATE A DEBREAK.
04300 ^POVDO:
04400 MOVE LPSA,GOGTAB ;
04500 MOVE TEMP,JOBTPC ;REAL TRAP LOCN
04600 MOVEM TEMP,UUO1(LPSA) ;"RETURN"
04700 MOVEI TEMP,POVTRP ;WHERE GO TO
04800 MOVEM TEMP,JOBTPC ;
04900 POPJ P, ;THIS "DISMISSES" US
05000 >;EXPO
05100 ;;%AY%
05200 ^POVTRP: MOVEM TEMP,PDLSV ;SAVE ACS
05300 MOVEM LPSA,PDLSV1
05400 ;;#GM# DCS 2-6-72 (1-1) WAS WIPING OUT TEMP WITH MOVEW
05500 MOVE LPSA,GOGTAB ;NOW RECORD WHERE IT HAPPENED FOR ERR MSG
05600 ;;%AY% MOVEW UUO1(LPSA),JOBTPC -- USED TO BE
05700 MOVE TEMP,UUO1(LPSA) ;CAREFULLY SET UP ABOVE
05800 >;NOTENX
05900
06000 TENX <
06100 ;First the TENEX equivalent of <ESC>I - currently control H - which
06200 ;is copied somewhat blindly from DCS's code @ INTRPT above. The only
06300 ;other TENX switched code related to this is in SAILNIT where
06400 ;the compiler sticks the right vector into the channel table to direct
06500 ;the interrupt here and arm the control character (ATI jsys).
06600 ^ITTYDO: SETZM %ERGO
06700 SETZM %QUIET
06800 SETZM MULTP
06900 MOVEM TEMP,.DBG. ;SAVE TEMP
07000 MOVE TEMP,[XWD 400000,377777] ;MAGIC NUMBER WORKS FOR DCS
07100 EXCH TEMP,.DBG. ;OUGHT TO WORK FOR ME. RESTORE TEMP
07200 JSYS DEBRK ;CONTINUE INTERRUPTED CODE
07300
07400
07500 ;Now for PDLOV stuff. Like <ESC I> requires SAIL init. to set up CHNTAB
07600 ;but in this case it MUST set it up as a level 3 interrupt or at least
07700 ;the same level assumed by the EXCH below. Also Stanford people beware
07800 ;of TENEX DEBRK which is just different enough from your DEBREAK to be
07900 ;confusing. See a JSYS manual.
08000
08100 EXTERNAL LPC3
08200 ^POVDO: MOVEM TEMP,PDLSV
08300 MOVEM LPSA,PDLSV1
08400 HRRZI TEMP,.+3
08500 EXCH TEMP,LPC3 ;ASSUME LEVEL 3. FORCE CONTINUATION
08600 ;OF INTERRUPTED CODE AT THE DEBRK+1
08700 JSYS DEBRK
08800
08900 ;BACK TO NORMAL USERMODE NOW; AC'S NOT CHANGED (I.E. SAVED OR RESTORED)
09000 ;THUS TEMP STILL HOLDS REAL INTERRUPT ADDR FOR PUTTING INTO JOBTPC
09100 >;TENX
09200 MOVEM TEMP,JOBTPC ;SO CODE BELOW WORKS (A REAL HACK)
09300 ;;#GM# (1-1) TEMP STILL HOLDS JOBTPC
09400 LDB TEMP,[POINT 4,-1(TEMP),12] ;HOW DID IT HAPPEN?
09500 ADDI TEMP,17 ;ADJUSTMENT
09600 ANDI TEMP,17
09700 ROT TEMP,-1 ;GET INDEX TO HALF-WORDS, LOW BIT TO SIGN
09800 HRRZ LPSA,POVTAB(TEMP) ;ASSUME ODD -- RIGHT HAND
09900 JUMPL TEMP,.+2 ;CORRECT
10000 HLRZ LPSA,POVTAB(TEMP);EVEN -- WRONG
10100 JUMPN LPSA,.+2 ;WAS THERE A CLUE?
10200 MOVEI LPSA,[ASCIZ /UNKNOWN STACK/]
10300 ERRPRI <PUSH-DOWN OVERFLOW -- > ;TELL HIM SOME
10400 MOVE TEMP,PDLSV
10500 EXCH LPSA,PDLSV1 ;RESTORE ACS
10600 ERR. @PDLSV1 ;TELL HIM MORE
10700 JRST 2,@JOBTPC ;IF HE SOMEHOW CONTINUES
10800 BEND
10900
11000 USE ZVBLS
11100 ^ZZZ__.
11200 USE VBLS
11300 ^VVV__.
11400 USE
11500 ^^ZHI: ZZZ
11600 ^^VHI: VVV
11700 BEND SAIL ;WOW
11800 PATCH: BLOCK 50
11900 VAR
12000 XLIST
12100 END START