perm filename COMSER[S,AIL]1 blob
sn#000803 filedate 1972-07-22 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00007 PAGES VERSION 16-2(10)
RECORD PAGE DESCRIPTION
00001 00001
00002 00002 HISTORY
00004 00003 Comser Data -- Povtab, Dsplin stuff
00006 00004 Strngc Supply Routines for Compiler Structures
00011 00005 Compiler-Specific portion of Error UUO stuff
00013 00006 Dsplin Routine for Displaying Input Line
00018 00007 Interrupt Handler -- Intrpt, Povtrp
00021 ENDMK
⊗;
COMMENT ⊗HISTORY
AUTHOR,REASON
021 202000000012 ⊗;
COMMENT ⊗
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
⊗
NOEXPO <
OFFRAID: .+2
0
0
DPYPRG: 0
AIVECT -=512,=50
>;NOEXPO
DLINBF: BLOCK 53
↑STODPY←DLINBF+52
ENDDBF←DLINBF+53
NOEXPO <
DPYBLK: DPYPRG
ENDDBF-DPYPRG
>;NOEXPO
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 ;→LAST BLOCK IN STRING RING
JUMPE T,CPOPJ ;DONE WHEN 0, GO MARK VARIABLES
RGSLUP: MOVEI A,$PNAME(T) ;→DESCRIPTOR
PUSHJ P,@-1(P) ;SORT IT INTO LISTS
HLRZ T,%RSTR(T) ;NEXT BLOCK
JUMPN T,RGSLUP ;CONTINUE UNLESS DONE
; →→→→→→ 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.
GAG < ;STRING GARBAGE COLLECTORS FOR GAG VARBS.
SGGAG: SKIPN T,STRSTK ;VARIABLE BLOCK (CURRENT)
JRST ARRAYS ;NO STRING VARBS.
VARS: HRRZ 6,STRSTK-1 ;COUNT OF DATA WORDS.
HLRZ A,STRSTK-1 ;COUNT OF BIT TABLE.
MOVEI 7,(T) ; → FIRSTWORD OF BIT TABLE.
ADDI A,(7) ; → FIRST VARIABLE.
HRLI 7,(<POINT 3,0>) ;7 HAS BYTE POINTER
GOIT: ILDB 10,7 ;GET BYTE
JUMPN 10,NOTHER ;END BYTE -- ALL DONE.
IBP 7 ;TWO WORDS.
PUSHJ P,@-1(P) ;A → STRING DESC.
SUBI 6,2 ;UPDATE DATA WORD COUNT.
JUMPG 6,GOIT ;AND LOOP.
NOTHER: HRRZ T,-2(T) ; → NEXT BLOCK OF VARBS.
JUMPN T,VARS ;AND LOOP.
ARRAYS:
COMMENT ⊗
SKIPN T,VARSTK+3 ; HOME OF VARIABLES.
POPJ P, ;NONE.
ARS: HRRZ 6,VARSTK-1 ;DATA LENGTH.
HLRZ A,VARSTK-1 ;AND BIT TABLE LENGTH.
MOVEI 7,(T) ; → FIRST BIT TABLE ENTRY.
ADDI A,(7) ; → FIRST VARB.
HRLI 7,(<POINT 3,0>)
GOARS: ILDB 10,7 ;GET BYTE
CAIE 10,2 ;STRING ARRAY?
JRST [CAIE 10,7 ;NO --END BYTE?
JRST NOTAR
POPJ P,]
PUSH P,A ;GOT AN ARRAY
MOVE A,(A) ;A IS ARRAY DESC.
HRRZ 10,-2(A) ;LENGTH
LSH 10,-1 ;# OF STRINGS.
SOSA A ;ADJUST TO → STRING DESC.
PUSHJ P,@-1(P) ;CALL SGC.
SOJGE 10,.-1 ;AND LOOP.
POP P,A ;RESTORE.
NOTAR: AOS A ;POINT TO NEXT VARB.
SOJG 6,GOARS ;AND LOOP UNTIL OUT.
NOHARS: HRRZ T,-2(T) ; NEXT BLOCK.
JUMPN T,ARS
⊗
POPJ P,
SGGAG ;LINK TO COLLECTOR.
0
LINK 4,.-1 ;...
>;GAG
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.
⊗;
IFN FTDEBUG,<
INNA ;FR0M ERR -- TO LOOK AT STACK
;> 0 ;NO DEBUGGER
↑↑MYERR:
MOVE 13,SRCFIL ;FILE NAME NEEDED IN ANY CASE
MOVE 16,FPAGNO ;AS IS THIS
CAIE A,1 ;IS THIS A REQUEST FOR AN EDIT??
JRST NOE
MOVE 14,SRCEXT
MOVE 11,SRCPPN
SKIPN 15,ASCLIN
MOVE 15,[ASCID/00000/]
TRO 15,1 ;FOR WFW
MOVE 12,BINLIN ;TV WILL WANT THIS NUMBER INSTEAD
POPJ P, ;RETURN WITH REGISTERS SET UP.
NOE: PUSHJ P,DSPLIN
JFCL ;DON'T CARE HOW YOU DO IT
POPJ P,
COMMENT ⊗Dsplin Routine for Displaying Input Line⊗
DSCR DSPLIN
PAR Line specs from compiler, DPYSW (indicates DPY or TTY)
CAL PUSHJ
RES DPYSW on (less than 0) -- print line displayed, no-skip return
DPYSW off -- no action, skip-return
SID changes A,B,C,TEMP
DES compiler only -- displays current input line, file and page # on
piece of glass # 1
⊗
↑DSPLIN:
AOS (P) ;ASSUME NO DISPLAY, SKIP RETURN
NOEXPO <
MOVEI TEMP,1
MOVEM TEMP,DLINBF ;
>;NOEXPO
EXPO <
SETZM DLINBF
>;EXPO
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
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
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
SETZM FILBP ;PRECAUTION
NOEXPO <
SKIPL DPYSW
JRST [
>;NOEXPO
TERPRI
MOVEI A,0
IDPB A,TEMP
TTCALL 3,DLINBF
NOEXPO <
JRST POPOP]
DPYOUT 17,OFFRAID ;TURN OFF RAID IF ON
MOVE B,[DPYJMP DPYPRG] ;DPYJMP TO START
MOVEM B,1(TEMP) ;TO END OF BUFFER
DPYSIZ (2,5)
DPYPOS (-=100)
DPYOUT 1,DPYBLK
SOS -1(P)
>;NOEXPO
POPOP: POP P,PNEXTC ;GET REAL ONE BACK
POPJ P,
↑PRSYM: PUSH P,C
HRRZ B,$PNAME(LPSA) ;PRINT SYMBOL IN LPSA
MOVE A,$PNAME+1(LPSA)
JRST PRTST
PRLOP: ILDB C,A ;GET CHAR.
TTCALL 1,C ;PRINT IT.
PRTST: SOJGE B,PRLOP
TERPRI
POP P,C
POPJ P,
↑CORERR:ERR <NO CORE AVAILABLE>
↑DSPCLR: SKIPE DPYSW ;IF ON A DISPLAY
DPYCLR ;CLEAR
POPJ P,
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.
⊗
;;#GH# DCS 2-1-72 (5-5) <ESC>I CAUSES PARSER TO BREAK AFTER NEXT SCAN
↑INTRPT:
NOEXPO <
IFN FTDEBUG, <
MOVE TEMP,JOBCNI ;REASON
TLNN TEMP,INTTTI ;<ESC> I?
JRST POVDO ; NO, PDL OV
MOVE TEMP,[XWD 400000,377777];INTERRUPT INDICATION
SETZM MULTP ;NOT IN MULTIPLE-PROCEED,
MOVEM TEMP,.DBG. ; IT IS GOING TO STOP
CALL6 DISMIS
POVDO:
>;IFN FTDEBUG
CALL6 (UWAIT) ;GET OUT OF MONITOR MODE, GET ACS
CALL6 (DEBREAK) ;"JRST" .+1
>;NOEXPO
;;#GH# (5-5)
↑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
MOVEW UUO1(LPSA),JOBTPC
;;#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/]
PRINT <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