Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/19/simds1.mac
There is 1 other file named simds1.mac in the archive. Click here to see a list.
SEARCH SIMRPA,SIMMCR,SIMMAC
SALL
RTITLE SIMDDT
SUBTTL SIMDDT
Comment;
Author: I Wennerstrom
Version:
[2] is the edit number of the first update of SIMDDT
-The DISPLAY and INSPECT commands have been added
-Some standard procedures may be referenced
-All special characters in a text variable are
replaced with ^letter
[41] is the second update of SIMDDT
-The CLOSE, NOPROCEED and @ commands have been added
-The NOARRAYS command has been removed
-THIS and QUA are accepted in an identifier
-Complete blocks can be output with * as identifier
-/-GC, /-ARRAY, /-TEXT can be specified in output commands
-It is possible to continue processing after some errors
-^C REENTER will end the processing of
the current command
-The VARIABLES command will also show the type procedure
values
-The procedure value will be output
Purposes:
SIMDDT is the debugging system for SIMULA
The SIMULA language handbook part 2 contains
a description of SIMDDT.
Contents:
SIMDDT consists of the following source modules:
SIMDS1,SIMDS2,SIMDS3,SIMDS8,SIMEDS,SIMDS9 and SIMDS7.
The main routines are placed in SIMDS1 and SIMDS9
DSIN contains all entry points to SIMDDT
DSINI start SIMDDT
DSINB entry from breakpoint
DSINE process error
DSINC return from RTS routine if garbage collection
may have been invoked
DSINR REENTER (or CONTINUE) command
DSINS removes all breakpoints
DSINM starts program execution when SIMDDT
was loaded together with main program
DSBP breakpoint processing
DSCM command accept and dispatch
DSST STOP at start of command
DSHE HELP command
DSAT AT command
DSDP DISPLAY command
DSOP OUTPUT command
DSIP INPUT command
DSRE RESET command
DSBR BREAKS command
DSCL CLOSE command
DSPR PROCEED command
DSUS USE command
DSCH CHAIN command
DSVA VARIABLES command
DSSC SCHEDULED command
DSPC INSPECT command
DSAL ALL command
DSEX EXIT command
DSNOPR NOPROCEED command
DSGET @ command
The main routines call a number of internal subroutines
which are placed in the SIMDS2 and SIMDS3 modules.
SIMDDT calls a number of RTS routines:
CSQU,TXVA,TXRE,TXPI,TXGI,TXPR,TXGR,TXBL,TXCY,TXST,CSNA,SAGC,
SUNE,IOOP,IOCL,IOOG,IOBO,IOIG,IOLN,CPNE,CSEN
The keyword table ZKW is placed in SIMDS1.
The error tables YEDD,YEDL,YEDMI,YEDLL are placed in the
SIMDS8 and SIMEDS modules.
ZBR breakpoint record is placed in the SIMDS7 module
;
RELOC 0
MACINIT
INTERN DSSTART
EXTERN .MAIN ; SIMULA main program start address
; Used if SIMDDT loaded/linked together
; with SIMULA main program
EXTERN .JBSA,.JBUUO,.JBFF
SUBTTL LOCAL REGISTERS
XDBAS=14 ;Base register for SIMDDT module
XDSTK=13 ;SIMDDT stack register
XDZBR=12 ;Base register for breakpoint record ZBR
XDINT=11 ;Input text pointer
XDOUT=XDINT ;Output text pointer, reached via XDINT + ZTV%S
XDSYM1=5 ;Sixbit symbol first 6 characters
XDSYM2=6 ;Sixbit symbol last six characters
XDBYTE=0 ;Input byte character
XDZKW=7 ;Keyword table pointer
XDZSD=7 ;Symbol table pointer
XDRTSR=7 ;Address of RTS routine
;Used when garbage collection may be invoked
XDSWIT=10 ;Switch register
XDMN=4 ;Error message number for DSPM
SETLOW ;XLOW=XIAC see RTS
$$BAS=XDBAS ;Used in SIMMAC
XDT3=3 ;Temporary work accumulator
XDT2=2 ;Temporary work accumulator
XDT4=4 ;Temporary work accumulator
XDT5=5 ;Temporary work accumulator
XDM1=XDSYM1
XDM2=XDSYM2
XDCNT=XDT3
XDM=XDT2
XDMN2=XDMN+1
XDM3=7
XDSTA=7 ;Statement address
XDZLN=6 ;ZLN pointer
XDLIN=7 ;Line number
XDZBE=7 ;ZBE pointer
XDADR=3 ;Address of variable
XDTYP=2 ;Type of variable
XDZPR=5 ;Prototype pointer
XDTA=XDT2 ;Used in DSPR (copied from COBDDT)
XDTB=XDT3
XDTC=XDT4
XDARR=4 ;Address of value in DSBP
SUBTTL ASSEMBLY TIME CONSTANTS
;ZKWTYP field values
QZKWTS=0 ;Valid at start of command
QZKWTI=1 ;Valid inside command
QZKWTR=2 ;Valid as relational operator
QZKWTQ=3 ;Valid as constant
QZKWTC=4 ;[2] Valid after / in INSPECT
;ZAR record offsets
ZARBAO=OFFSET(ZARBAD)
ZARLOO=OFFSET(ZARLOW)+2
ZARUPO=OFFSET(ZARUPP)+2
;MESSAGE NUMBERS
;All messages generated by SIMDDT are listed in the SIMULA
;language handbook part 2. All the messages starting with
;ZYD are initiated from SIMDDT while the messages starting with ZYQ are
;initiated by the RTS. The crossreference listing of SIMDDT gives the
;statement (or routine) which generates a special message.
;All messages have an internal name.
;The messages 500 to QMSUPN (547) will appear without the ZYDNNN tag.
QMPVCH=500 ;CHAR
QMOPAS=501 ;=
QMPCLI=502 ;[2] CURRENT BLOCK POINTER AT LINE
QMPVLE=503 ;LENGTH=
QMPVPO=504 ;POS=
QMPVST=505 ;SUBTEXT STARTS AT POSITION=
QMTCTP=512 ;[41] TO CONTINUE TYPE PROCEED
QMGNIL=513 ;[41] GIVE NEW INPUT LINE TO REPLACE THE LINE GIVEN ABOVE
QMGNIN=514 ;[41] GIVE NEW INTEGER ARGUMENT
QMCLFI=515 ;[41] FILE:
QMCLOD=516 ;[41] CLOSED
QMVAPV=517 ;[41] PROCEDURE VALUE
QMINST=540 ;SIMDDT STARTED
QMINER=541 ;ERROR IN JOB
QMPVDE=542 ;DETACHED
QMFADE=QMPVDE
QMFAAT=506 ;TERMINATED
QMCHIN=507 ;INSPECT BLOCK
QMSCEV=511 ;EVTIME=
QMPSPB=510 ;PREFIX BLOCK
QMSCHN=543 ;NO SCHEDULED PROCESSES
QMSCH=544 ;SCHEDULED PROCESSES
QMCHH=545 ;OPERATING CHAIN
QMVAH=547 ;VARIABLES
QMSUPN=547 ;Last ZYD message where ZYDNNN is suppressed
QMCM01=551 ;NOT VALID AT START OF COMMAND
QMCM02=552 ;NOT VALID IN DEBUG MODE
QMCM03=553 ;NOT VALID IN ERROR MODE
QMPRNA=554 ;[41] PROCEED NOT ALLOWED AFTER THIS ERROR
QMIPPR=556 ;[2] ASSIGNMENT TO STANDARD PROCEDURES NOT POSSIBLE
QMNINM=557 ;[2] TEXT ATTRIBUTE IS NOT MAIN
QMNIMP=677 ;COMMAND OR FEATURE NOT IMPLEMENTED
QMITOW=550 ;LINE OVERFLOW ON INPUT
QMPMNI=676 ;INVALID MESSAGE NUMBER
QMNITL=560 ;TYPE LABEL SYMBOL
QMNIMN=561 ;MODE NAME SYMBOL
QMNIKP=562 ;[2] KIND PROCEDURE SYMBOL AND NOT HANDLED
QMNIKC=563 ;KIND CLASS SYMBOL
QMNIUN=564 ;UNDEFINED SYMBOL
QMNINR=565 ;[2] ILLEGAL DOT NOTATION
QMNIII=566 ;IDENTIFIER EXPECTED IN INPUT
QMATII=QMNIII
QMNINV=567 ;IDENTIFIER NOT VISIBLE IN SYMBOL TABLE
QMNINA=570 ;SUBSCRIPTS IN TEXT BUT SYMBOL IS NOT ARRAY
QMNINS=571 ;SUBSCRIPTS MISSING AFTER ARRAY SYMBOL
QMNISE=572 ;, OR ) EXPECTED AFTER SUBSCRIPTS
QMNIID=573 ;ATTRIBUTE IDENTIFIER EXPECTED AFTER DOT
QMLVSN=574 ;WRONG NUMBER OF SUBSCRIPTS IN IDENTIFICATION
QMLVSL=575 ;SUBSCRIPT LESS THAN LOWER BOUND
QMLVSU=576 ;SUBSCRIPT GREATER THAN UPPER BOUND
QMOPCR=577 ;CRLF OR , EXPECTED
QMFBOV=600 ;NO MORE FREE ZBE ENTRIES
QMCSQE=601 ;QUALIFICATION ERROR
QMATCR=602 ;RELATION OPERATOR EXPECTED
QMATEI=603 ;END OF INPUT EXPECTED
QMATLC=604 ;MORE THAN ONE LOOP COUNTER
QMATNC=605 ;INVALID COUNTER VALUE
QMATNF=606 ;NO MORE FREE BREAKPOINT ENTRIES
QMGLCM=611 ;COLON MISSING AFTER MODULE NAME
QMGVCE=612 ;CHARACTER CONSTANT END ' MISSING
QMIPNA=613 ;:= OR :- EXPECTED
QMIPND=614 ;DENOTES ONLY VALID AFTER REF OR TEXT VARIABLE
QMIPNR=615 ; := NOT VALID AFTER REF VARIABLE
QMIPTA=616 ;STRING CONSTANT NOT VALID IN TEXT
;REFERENCE ASSIGNMENT
QMGVTD=617 ;DIFFERENT TYPES IN INPUT COMMAND OR AT COMMAND
QMRENB=620 ;NO BREAKPOINT
QMRENA=621 ;AT OR END OF INPUT EXPECTED
QMBREE=QMATEI ;END OF INPUT EXPECTED
QMBRRE=622 ;RESET OR END OF INPUT EXPECTED
QMIPEI=QMATEI
QMINRE=623 ;SIMDDT ENTERED VIA ^C AND REENTER
QMGSSE=625 ;FINAL " MISSING IN TEXT CONSTANT
QMIPTL=626 ;LENGTH OF RHS>LHS IN TEXT VALUE ASSIGNMENT
QMNIIA=627 ;ATTRIBUTE IDENTIFIER NOT FOUND IN SYMBOL TABLE
QMGVEL=630 ;CONSTANT OR IDENTIFICATION OF RIGHT TYPE EXPECTED
QMNATE=631 ;TYPE ERROR IN DYNAMIC RECORD
QMVANG=632 ;GARBAGE COLLECT NOT CALLED
QMTXNN=633 ;REAL OR LONG REAL VALUE NOT NORMALIZED
QMUSDB=635 ;FILE ALREADY IN USE
QMGLEM=636 ;INVALID MODULE NAME
QMGLIL=637 ;INVALID LINE NUMBER
QMRANE=640 ;TEXT OR REF VARIABLE ARRAY ELEMENT MISSING
;ALL USED
QMATOP=641 ;IDENTIFIER AND OPERATOR INCOMPATIBLE
QMATCI=642 ;CLASS IDENTIFIER EXPECTED
QMNICI=QMATCI ;[41] CLASS IDENTIFIER EXPECTED AFTER THIS AND QUA
QMPVRI=643 ;ARRAY POINTER NONE OR ARRAY OR REF POINTER ZERO
QMGVNS=644 ;NOT POSSIBLE TO OPEN NEW FILE OR TO SAVE
QMINTB=645 ;XCB POINTS AT TERMINATED BLOCK
QMUSNA=646 ;USE FILE NOT ACCEPTED
;STRING WHEN SIMDDT ENTERED VIA REENTER
;GARBAGE COLLECTION IS NOT POSSIBLE
QMVSNB=QMGVNS
QMDPEL=647 ;[2] - OR END OF LINE EXPECTED. DISPLAY COMMAND
QMDPLE=650 ;[2] LINE INTERVAL ERROR IN DISPLAY COMMAND
QMDPEO=651 ;[2] LINE NOT FOUND IN MODULE
QMRUCE=652 ; [2] RETURN OR UP NOT ALLOWED
QMPCCE=653 ; [2] KEYWORD EXPECTED AFTER /
QMPCOR=654 ; [2] OBJECT REFERENCE EXPECTED
QMLVET=655 ;[2] VALUE NOT ACCESSIBLE FROM TERMINATED BLOCK
QMNIST=656 ;[41] STAR NOT ALLOWED IN IDENTIFIER
QMCLKE=657 ;[41] CLOSE OR CRLF EXPECTED AS ANSWER
QMCHQS=660 ;[41] GIVE NOPROCEED COMMAND AND REENTER CURRENT COMMAND
QMVAKE=661 ;[41] INVALID KEYWORD AFTER / IN ALL, VARIABLES
;[41] AND OUTPUT COMMANDS
QMITTI=662 ;[41] INPUT FROM TERMINAL
QMBPCR=663 ;[156] CONTROL C REENTER COMMANDS IN CONNECTION WITH BREAKPOINTS
QMLVNP=664 ;[166] NO TYPE PROCEDURE
QMRTSD=212 ;[160] DEBUG MODE ENTERED FROM LINE
QMINNB=674 ;BREAKPOINT NOT VALID
QMTERM=675 ;SIMDDT TERMINATION ERROR
QMAS01=QMTERM
QMAS02=QMTERM
;Message number limits are:
;QZYQFN=001 ;First valid ZYQ message number
;QMSUPN=547 ;See above
QZYQLN=217 ;[2] Last valid ZYQ message number
;Constant also used in SUTEDS
QZYDFN=500 ;First valid ZYD message number
QZYDLN=677 ;Last valid ZYD number
;Size constants for records
QDSTN=^D36 ;Elements in ZDSTXT array
IFG <QDSTN-^D36 > < PRINTX QDSTN TOO LARGE>
QZBEL=4 ;Length of ZBE entry
QZBEN=^D40 ;Number of ZBE entries
QDSRN=^D36 ;Elements in ZDSREF array
IFG <QDSRN - ^D36> <PRINTX QDSRN TOO LARGE>
QDSION=^D135 ;Length of input/output text
QBRN=^D20 ;Max number of breakpoint lines
;in ZBR record
QSTAKL=40 ;SIMDDT stack length
QNSDR=^D8 ;Number of significant digits in real number
QNSDLR=^D16 ;...in long real number
;CONSTANTS
QTEXTQ=042 ;Text quote (")
QLINEM=1B19-1 ;Max line number entry for statement
;2^16-1
;Line number for declaration
;has bit one set
;Type constants for ZBE record
;Type of AT command
QBEAT=1
QBEATC=2
QBEATL=3
QBEATR=4
QBECON=0
;Type of relational operator
QACTOP=1 ;Arithmetic, character or text relation
QBOP=2 ;EQV operator
QOOP=3 ;IS or IN operator
QOTOP=4 ;== or =/= operator
SUBTTL SWITCH declarations
; The accumulator XDSWIT holds the switches when SIMDDT is active.
; The important status switches are saved in YDSWIT(XLOW) and
; the switches are valid even if SIMDDT is not executing.
; DSW (YDSACT,YDSWIT,0) ;SIMDDT active
; ;YDSACT defined in SIMRPA
DSW (YDSITTY,0,1,XDSWIT) ;[41] Input from tty
DSW (YDSDBG,0,4,XDSWIT) ;Debug mode on,
;Error mode off
DSW (YDSINI,0,2,XDSWIT) ;SIMDDT initialized
DSW (YDSTTY,0,3,XDSWIT) ;Current out file is tty
DSW (YDSTEM,0,5,XDSWIT) ;Temporary help switch
DSW (YDSLLF,0,6,XDSWIT) ;[2] Last display line ended with lf
DSW (YDSSNA,0,7,XDSWIT) ;[41] /-ARRAY found in command
DSW (YDSASG,0,8,XDSWIT) ;INPUT command operator is := if on
; :- if off
DSW (YDSLIST,0,9,XDSWIT) ;Identification list found
DSW (YDSCHG,0,10,XDSWIT) ;CHANGED found in at command
DSW (YDSBOI,0,11,XDSWIT) ;[2] Use breakoutimage and no crlf at output
DSW (YDSSTA,0,12,XDSWIT) ;Set on by DSINI to force
;return to RTS from DSPR
DSW (YDSPBT,0,13,XDSWIT) ;Output total breakpoint command in DSPB
DSW (YDSREE,0,14,XDSWIT) ;SIMDDT entered via DSINR
DSW (YDSTXR,0,15,XDSWIT) ;Call TXGR
DSW (YDSACB,0,16,XDSWIT) ;[2] Block active, used in INSPECT and
;[2] chain commands
DSW (YDSGCO,0,17,XDSWIT) ;RTS routine which may invoke
;garbage collector called
;
; All switches in right part of XDSWIT will be set to zero in DSCM
DSW (YDSTXC,0,18,XDSWIT) ;Text input RTS routine called
;Errors are expected when input not correct
DSW (YDSERE,0,19,XDSWIT) ;Error detected by RTS while
;SIMDDT active
DSW (YDSUFR,0,20,XDSWIT) ;[2] Output/input i/o RTS routine called
DSW (YDSRLC,0,21,XDSWIT) ;Relational character found in identifier
DSW (YDSCSTOP,0,22,XDSWIT) ;STOP at start of command
;Set in DSPB routine
DSW (YDSIFF,0,23,XDSWIT) ;IF found in AT command
DSW (YDSSTRING,0,24,XDSWIT) ;Text variable if on
;Text string if off, used in DSPV
DSW (YDSOBOTH,0,25,XDSWIT) ;Output text to tty and file if
;any specified
DSW (YDSOCOM,0,26,XDSWIT) ;Output command which may contain
;array identifier without index
DSW (YDSOAI,0,27,XDSWIT) ;Array to be output
DSW (YDSTOP,0,28,XDSWIT) ;STOP found in command
DSW (YDSALL,0,29,XDSWIT) ;ALL command active
DSW (YDSINO,0,30,XDSWIT) ;Set on when the input buffer does
;not contain any relevant error information
DSW (YDSDOD,0,31,XDSWIT) ;[2] Source line found and displayed
;[2]
DSW (YDSUP,0,32,XDSWIT) ; [2] Find static enclosing block
DSW (YDSRE,0,33,XDSWIT) ; [2] Find dynamically enclosing block
DSW (YDSCH,0,34,XDSWIT) ; [2] Find operating chain
DSW (YDSSGC,0,32,XDSWIT) ;[41] Avoid garbage collection
DSW (YDSSKT,0,33,XDSWIT) ;[41] Skip text characters in output
DSW (YDSOSB,0,31,XDSWIT) ;[41] Output variables in block via *
DSW (YDSHEL,0,34,XDSWIT) ;[41] HELP command
SUBTTL Local OPDEFS and MACRO definitions
OPDEF DSTACK [PUSH XDSTK,]
OPDEF DUNSTK [POP XDSTK,]
OPDEF DRETUR [POPJ XDSTK,]
DEFINE DEXEC (FR) <PUSHJ XDSTK,LAB(<FR>)>
; Local macro definitions
DEFINE $$RELO (FL) <DSSTAR(FL)> ;Used in SIMMAC
DEFINE LAB (FL) <FL-DSSTAR(XDBAS)>
DEFINE LABB(FL) <FL-DSZBRS(XDZBR)>
DEFINE DEXEC (FR) <PUSHJ XDSTK,LAB(<FR>)>
DEFINE OUTCHA <MDSOCH>
DEFINE OUTCHB <DEXEC DSOCB>
;Macros for calling the subroutines in SIMDDT
;The entry point name is prefixed by M
DEFINE x(p)<
IRP p,<OPDEF MDS'p [PUSHJ XDSTK,DS'p-DSSTAR(XDBAS)]>
>
DEFINE y(p)<
IRP p,<
DEFINE MDS'p'(n) <
IFNB <n>,<LI XDMN,n>
DEXEC DS'p>
>>
x <FK,FKI,TC,TCR,IT,OF,OFT,OT>
y <OFM,OBM,OTM,OEM,PM,VOM>
x <GL,GI,GIK,GIS,GIR,NI> ;[304]
DEFINE MDSNIS <BRANCH LAB(DSNIS)>
x <GV,GS,LO,LL,LV,PB,PBT,PS,PSP,PSK,PL,PV>
x <PI,NB,NBW,FB,FBW,RB,RBD,RL,RLB>
DEFINE MDSIS <PUSHJ XPDP,LAB(DSIS)>
;Note SIMDDT stack not yet defined, use RTS stack
x <SCI,SKB,OCH,ONL,INL,ICH,TXB,PO,POC>
DEFINE MDSSUB <PUSHJ XDSTK,@(XDSTK)>
x <VO,FA,SS,TXI,TXO,CT,VIV,VAR>
; SIMDDT calls the following RTS routines
OPDEF MCSQU [PUSHJ XDSTK,DSCSQU-DSSTAR(XDBAS)]
DEFINE m(p)<
IRP p,<OPDEF M'p [PUSHJ XPDP,p]>
>
DEFINE mds(p)<
IRP p,<OPDEF M'p [PUSHJ XDSTK,DS'p-DSSTAR(XDBAS)]>
>
m TXMN ;;[2] Used in DSSPV to reference text.Main
m <TXVA,TXRE,TXST>
DEFINE MTXPI (FP) <
IFNB<FP> <
LI XDCNT,FP
DEXEC DSTXPI>
IFB<FP> <
DEXEC DSTXPC>
>
mds <TXPR,TXGI>
DEFINE MTXBL <LI XDRTSR,TXBL
DEXEC DSCRTS>
DEFINE MTXCY <DSTACK XDZBE
LI XDRTSR,TXCY
SETZM ,1+YDSINC(XLOW)
DEXEC DSCRTP
DUNSTK XDZBE
>
DEFINE MIOCLU <DEXEC DSCLOU> ;[2]
; IOLN, CPNE, CSEN, IOOP, IOOG used
DEFINE MSUNE <EXEC @YSUNE(XLOW)>
DEFINE MCSNA (FTYP,FSUB,FUPB) <
SETZB XSAC,XWAC1
LI XWAC2,FUPB-1
EXEC CSNA
XWD FTYP,FSUB
MOVE XDBAS,YDSBAS(XLOW)
L XDSWIT,YDSWIT(XLOW)
>
DEFINE MSAGC <LI XDRTSR,SAGC
DEXEC DSCRTS>
SUBTTL ZDN record for SIMDDT
DSSTAR: ;First word in SIMDDT module, used by SUTABS program
;XDBAS must point to this word when SIMDDT is executing.
; ZDN record for SIMDDT, not including ZSDZTE
; must be placed here
EXP <QZYS>B<%ZDNTYP>
EXP DSEND-DSSTART ;Length of SIMDDT
%DSVER=:VERRTS ;SIMDDT version for SUTABS
;Not including ZSDZTE
SUBTTL DSIN main routine
Comment;
Purposes: Performs initialization for the different types
of entries to SIMDDT.
Entries: DSINI,DSINE,DSINB,DSINR,DSINC,DSINM,DSINS
Normal exits: DSCM, accept command
DSBP, process breakpoint
Return via SIMDDT stack if error found in RTS routine
when called from SIMDDT.
Return via RTS stack if the ^C command interrupted
SIMDDT processing
Return via SIMDDT stack if entry is DSINC
Return via RTS stack if entry is DSINS
BRANCH to .MAIN+2 if entry is DSINM
Error exit: See above normal exits
I/O performed:
Output to tty and current file
via output subroutines
Used subroutines: DSIS,DSO,DSPM,DSPLE,DSISRB,DSBUTX,DSPSKB and IOOG
;
PROC
DSINI:
IFN DSINI-DSSTAR-QDSINI <PRINTX QDSINI MUST BE CHANGED>
;Starts SIMDDT processing in debug mode.
;Called from OCEI before user program execution starts.
;Return to OCEI from DSPR.
;Exit to DSCM
;Initialize SIMDDT
MDSIS
MDSOFM QMINST ;Type SIMDDT started
SETONA YDSSTA ;Exit via RTS from PROCEED
ST XDSWIT,YDSWIT(XLOW)
;Accept commands
BRANCH LAB(DSCM)
DSINB: GOTO LAB(DSINB.)
DSINR: GOTO LAB(DSINR.)
DSINS: GOTO LAB(DSINS.)
DSINE:
IFN DSINE-DSSTAR-QDSINE <PRINTX QDSINR MUST BE CHANGED>
;Called from OCUU when an error has been detected
;Normal return to OCUU from DSEX when an error is not an internal SIMDDT error
;Exit from DSINE to DSCM
;
;After an internal error message has been produced
;Execution continues at the point where RTS was called
;
IF ;Already active
IFOFF YDSACT(XLOW)
GOTO FALSE
THEN ;Handle internal SIMDDT error
;Error found in RTS when processing
;call from SIMDDT
L XDSWIT,YDSWIT(XLOW)
IF ;SIMDDT is initialized
IFOFFA YDSINI
GOTO FALSE ;Error during SIMDDT
; initialization
THEN ;Error entry while SIMDDT active
SETONA YDSERE
IF
IFONA YDSGCO
GOTO FALSE ;Possible garbage collection
THEN
IF ;Not a text handling procedure
IFONA YDSTXC
GOTO FALSE
THEN ;Unexpected error
IF ;Not debug mode
IFONA YDSDBG
GOTO FALSE
THEN ;Error mode already
;Avoid loop
OUTSTR LAB(DSINE1)
BRANCH OCEP ;[41] Exit if error
;processing
DSINE1: ASCIZ /
?ZYD477 ERROR WHILE PROCESSING ERROR/
FI
;Debug mode
ST XDSWIT,YDSWIT(XLOW)
GOTO LAB(DSINE2) ;Process error
FI
;Error in TXGI or TXGR routines
FI
;Garbage collection may have occurred
BRANCH LAB(DSINC1) ;Restore and
;build message
FI
;SIMDDT error, not possible to initialize
OUTSTR LAB(DSINE3)
BRANCH OCEP ;[41] Exit
DSINE3: ASCIZ /
?ZYD476 ERROR WHILE INITIALIZING SIMDDT/
FI
;Error from RTS processing
;Update status switches
;Initialize SIMDDT
DSINE2: ;Fatal error in debug mode
MDSIS
IF ;[160] Start enter debug mode error
HRRZ XDMN,YDSENR(XLOW)
CAIE XDMN,QMRTSD ;ZYQ212 error that is enter debug mode?
GOTO FALSE ;No
THEN ;Special message given
HRRZM XDMN,LABB(YDSSENR) ;Save in case more errors are created
MDSOFT
MDSPM ;Create message
OUTCHB
L XDSTA,YDSEAD(XLOW)
DEXEC DSPLE
MDSOFT
BRANCH LAB(DSCM)
FI ;[160] End
SETOFA YDSDBG ;Error mode
;Change current file
IF ;Current file is TTY and sysout is open and not TTY
; and proceed is not allowed
IFOFFA YDSTTY
GOTO FALSE ;Current file is not tty
HLLZ X0,YDSENR(XLOW) ;[41]
JUMPN X0,FALSE ;[41] Do not close sysout
L XWAC1,YSYSOU(XLOW) ;Sysout file object
IFOFF ZFIOPN(XWAC1)
GOTO FALSE
IFON ZFITTY(XWAC1)
GOTO FALSE ;Sysout is tty
THEN ;Output sysout image
LI XDRTSR,IOOG
DEXEC DSCRTU ;Output last image
IFONA YDSUFR
GOTO FALSE ;I/o error
;Set current file to sysout
LD XWAC2,ZTV%S(XDINT)
STD XWAC2,OFFSET(ZFIIMG)(XWAC1)
ST XWAC1,YDSUFO(XLOW)
SETOFA YDSTTY
FI
SETOFA YDSUFR
ST XDSWIT,YDSWIT(XLOW)
DSINEM: ;[242] Create RTS error message
SKIPE YFOXCB(XLOW)
L XCB,YFOXCB(XLOW) ;Update XCB if FORTRAN external routine
MDSOFT ;Blank line if last line was not breakoutimage
MDSPM QMINER ;First part of message
PJOB XWAC3, ;Find job number
MTXPI ;Put integer in outtext
OUTCHB
LI X1,LAB(ZKWAT)
DEXEC DSPSKB
OUTCHB
L XDSTA,YDSEAD(XLOW) ;Fetch address of error
DEXEC DSPLE ;Put statement id in text
;and update environment
MDSOFT ;Output first line
;Standard error text
HRRZ XDMN,YDSENR(XLOW) ;Error number
MDSOBM ;Create error text
IF ;Current block is terminated
IFOFF ZDNTER(XCB)
GOTO FALSE
THEN ;Error
LI XDMN,QMINTB
MDSOBM
SETON SWNOGC(XLOW)
FI
;[41] Give message: TO CONTINUE TYPE PROCEED
HLLZ X1,YDSENR(XLOW)
IF ;PROCEED is allowed
JUMPE X1,FALSE
THEN ;Save in case new error occurs
ST X1,LABB(YDSSENR)
MDSVOM QMTCTP
FI ;[41] End
;Accept commands
BRANCH LAB(DSCM)
DSINB.:
;Starts SIMDDT processing after a breakpoint instruction
;has been executed. Called from the RTS routine
;OCUU. Locates breakpoint and exits to DSBP.
MDSIS ;Initialize
;Save XIAC in low seg
;Before entry all accumulators are saved at YUUOAC(XLOW)
L X1,YUUOAC+XLOW(XLOW)
ST X1,YDSIAC(XLOW)
;Fetch breakpoint number in X1
HRRZ X1,.JBUUO
ST X1,LABB(YDSCZBR) ;Save current breakpoint number
IF ;Breakpoint is not in table
CAIL X1,QBRN*2
GOTO TRUE
ADDI X1,LABB(DSZBRF)
LF XDZLN,ZBRZLN(X1)
JUMPG XDZLN,FALSE
THEN ;Invalid breakpoint
LI XDMN,QMINNB
MDSOBM
BRANCH LAB(DSTERM)
FI
LF X0,ZBRINS(X1) ;Fetch breakpoint instruction
ST X0,LABB(YDSLEAVE)
LF X0,ZLNADR(XDZLN)
AOJ X0,
ST X0,YDSBCOM(XLOW) ;Return address
;Check if YDSZLN and YDSCZS are valid
SKIPN X1,YDSZLN(XLOW) ;[242]
L X1,YDSZLA(XLOW) ;[242] *** Temp fix, better than ill mem ref???
IF ;Not main prog line no table
CAMN X1,YDSZLA(XLOW)
GOTO FALSE
THEN ;External line number table
LF X1,ZLNADF(X1) ;Fetch prototype
LF X1,ZPRSYM(X1) ;Fetch symbol table
LF X1,ZSMZLN(X1)
FI
IF ;Valid environment
CAMGE XDZLN,X1
CAMG XDZLN,LABB(YDSCZS)
GOTO FALSE
THEN
LOOP
SOJ XDZLN,
AS
SKIPL 0,(XDZLN)
GOTO TRUE
SA
ST XDZLN,LABB(YDSCZL)
DEXEC DSPLEE ;[2] Update variables
ELSE ;Locate environment
LF XDSTA,ZLNADR(XDZLN)
DEXEC DSPLE
DEXEC DSONL ;Remove text from output buffer
FI
BRANCH LAB(DSBP) ;To breakpoint processing
DSINR.:
;Starts SIMDDT processing after the user program execution was
;interrupted via the ^C-REENTER commands or when the CONTINUE
;command was issued after program exit. Called from the RTS routine
;OCRE. Writes a message giving the interruption point.
IF ;SIMDDT processing was interrupted
IFOFF YDSACT(XLOW)
GOTO FALSE
THEN ;Continue
RETURN
FI
MDSIS ;Initialize
SETONA YDSREE ;Entry via DSINR
SETOM ,LABB(YDSSENR) ;[41] PROCEED possible
SETONA YDSSTA ;Exit via RTS from PROCEED
IF ;Program already finished
HLRZ X0,.JBSA
CAME X0,.JBFF
GOTO FALSE
THEN ;Error mode
SETOFA YDSDBG
SETONA YDSTTY
FI
ST XDSWIT,YDSWIT(XLOW)
DSINRM: ;[242] Entry to repeat message
DEXEC DSOFT ;Create carriage return line feed
MDSPM QMINRE
L XDSTA,YDSCAD(XLOW) ;Address of ^C interrupt
;from user point of view
DEXEC DSPLE ;Put statement id in text
;and update environment
MDSOFT
BRANCH LAB(DSCM)
DSINC:
;This routine is entered via the static low area on return from
;a RTS routine that may cause garbage collection or detect an error.
;Relocates the SIMDDT stack and i/o text variables if garbage collection
;has been performed. Writes any error messages replacing ZYQ with ZYD.
L XDSWIT,YDSWIT(XLOW)
DSINC1: ;Entry after error from DSINE routine
LI XDZBR,LAB(DSZBRS)
LI XDSTK,LABB(DSZBRK)
HRLI XDSTK,-QSTAKL+1 ;Restore XDSTK
L X1,XDZBR
SUB X1,LABB(YDSOBR) ;Calculate garbage collection move
L X0,YSAGCN(XLOW)
CAMN X0,LABB(YDSOSAGCN)
JUMPE X1,LAB(DSINC2) ;No garbage collection performed
ADDM X1,LABB(YDSOST) ;Update stack pointer
LOOP
L X0,1(XDSTK)
HRRZ X2,1(XDSTK)
SUB X2,YDSBAS(XLOW)
ADD X2,X1
IF ;[2R] YDSBAS was relocated by SAGC
JUMPL X2,FALSE
CAIL X2,QDSLG
GOTO FALSE
THEN ;Inside SIMDDT
L X0,1(XDSTK)
ADD X0,X1
FI
DSTACK X0 ;Assume all stack entries are to be
;relocated
AS
CAME XDSTK,LABB(YDSOST)
GOTO TRUE
SA
DEXEC DSBUTX ;Initiate text variables
DSINC2:
L XDSTK,LABB(YDSOST)
SETOFA YDSGCO
IF ;Error exists
IFOFFA YDSERE
GOTO FALSE
THEN
;[2]
HRRZ X0,(XDSTK)
IF ;[304] Error for output to USE file
CAIE X0,LAB(DSOF02)
GOTO FALSE
THEN ;I/o error, do not use file again
SETONA YDSTTY
L X1,YDSIFO(XLOW) ;[304] Indirect file
GOTO LAB(DSINC3)
ELSE
IF ;[304] Error for indirect file
CAIE X0,LAB(DSIT02)
GOTO FALSE
THEN ;Do not use it any more
SETONA YDSITTY ;Input from tty
L X1,YDSUFO(XLOW) ;USE file ref
DSINC3: IF ;USE (indirect) file on same chnl
JUMPE X1,FALSE
WLF ,ZFICHN(XWAC1)
XOR OFFSET(ZFICHN)(X1)
TLNE (Z 17,0)
GOTO FALSE
THEN ;Drop it also
SETONA YDSTTY ;Output to tty
SETONA YDSITTY ;Input from tty
SETOFF ZFIOPN(X1) ;Closed
LF X1,ZFICHN(X1) ;Channel no
L X0,X1 ;Saved
RESDV. X0, ;Reset chnl
CAI ;Ignore error
ADDI X1,YIOCHT(XLOW) ;Word in chnl tbl
SETZM (X1) ;Clear the entry
SETZM YDSUFO(XLOW) ;No USE file
SETZM YDSIFO(XLOW) ;No @ file
HRROS OFFSET(ZFICHN)(X1);Closed
FI FI FI
HRRZ XDMN,YDSENR(XLOW) ;[41] Error number
IF ;[41] Some message other than "EXTERNAL IMAGE TOO LONG"
CAIN XDMN,76
GOTO FALSE
THEN ;Create message
MDSOFT ;Blank line
HRRZ XDMN,YDSENR(XLOW);[41]
MDSOBM
ELSE ;[41]
SUBI XWAC1,4 ;[41] See error recovery in IOIG
FI
;[304] UNSTK X0 ;Last RTS stack entry not
;to be used
L XPDP,LABB(YDSOXPDP)
IFONA YDSTXC
BRANCH LAB(DSCTX1) ;Error in text call
ELSE
SETOFA YDSUFR ;Switch off only if i/o call ok
FI
ST XDSWIT,YDSWIT(XLOW)
DRETUR
DSINM:: ;Entry point when SIMDDT was loaded/linked together with main program
;
HRRZ X1,.JBSA ;Fetch DSINM address
SUBI X1,DSINM-DSSTART ;Calculate base address DSSTART
BRANCH .MAIN+2 ;To main program start address
;X1 holds SIMDDT base
DSINS.: ;Called from SIMRTS when old breakpoints must be reset
;that is at start and reenter after program exit
;Return to SIMRTS via XPDP stack
EXEC LAB(DSISRB)
RETURN
EPROC
SUBTTL ZKW RECORDS
;The keyword table ZKW contains one entry for each special identifier
;or operator that SIMDDT must recognize while scanning a command.
;The entry contains name, control bits, control codes and a routine
;address for those keywords that may start a command.
DEFINE CZKW (MNM1,MNM2,MLNE,MDBG,MERR,MTYP,MCOD,MADR)
<
<MLNE>B0+<MDBG>B1+<MERR>B2+<MTYP>B5+<MCOD>B17+<MADR>B35
IFNB <MNM1><SIXBIT "MNM1">
IFNB <MNM2><SIXBIT "MNM2">
>
;Create table
ZKW:
CZKW ,,,1,,QZKWTR,QACTOP,<313000> ;CAMLE
SIXBIT "<"
CZKW ,,,1,,QZKWTR,QACTOP,<311000> ;CAML
SIXBIT "<="
CZKW =,,,1,,QZKWTR,QACTOP,<316000> ;CAMN
CZKW =/=,,,1,,QZKWTR,QOTOP,<312000> ;CAME
CZKW ==,,,1,,QZKWTR,QOTOP,<316000> ;CAMN
CZKW ,,,1,,QZKWTR,QACTOP,<315000> ;CAMGE
SIXBIT ">"
CZKW ,,,1,,QZKWTR,QACTOP,<317000> ;CAMG
SIXBIT ">="
CZKW @,,,1,1,QZKWTS,,<LAB(DSGET)> ;[41] Define input file
ZKWAT: CZKW AT,,,1,,QZKWTS,,<LAB(DSAT)>
CZKW ALL,,,1,1,QZKWTS,,<LAB(DSAL)>
ZKWSKA: CZKW ARRAY,,,1,1,QZKWTI ;[41]
CZKW BREAKS,,,1,1,QZKWTS,,<LAB(DSBR)>
CZKW CHAIN,,,1,1,QZKWTS,,<LAB(DSCH)>
ZKWCLO: CZKW CLOSE,,,1,1,QZKWTS,,<LAB(DSCL)> ;[41]
CZKW DISPLA,Y,1,1,1,QZKWTS,,<LAB(DSDP)> ;[2]
CZKW EQ,,,1,,QZKWTR,QACTOP,<316000> ;CAMN
CZKW EQV,,,1,,QZKWTR,QBOP,<316000> ;CAMN
CZKW EXIT,,,1,1,QZKWTS,,<LAB(DSEX)>
ZKWFAL: CZKW FALSE,,,1,,QZKWTQ,QBOOLEAN,0
ZKWSKG: CZKW GC,,,1,1,QZKWTI ;[41]
CZKW GE,,,1,,QZKWTR,QACTOP,<317000> ;CAMG
; CZKW GET,,,1,1,QZKWTS,,<LAB(DSNOTI)> [41]
CZKW GT,,,1,,QZKWTR,QACTOP,<315000> ;CAMGE
CZKW HELP,,,1,1,QZKWTS,,<LAB(DSHE)>
CZKW I,,,1,,QZKWTS,,<LAB(DSIP)> ;[2] Short form of INPUT
ZKWIS: CZKW IS,,,1,,QZKWTR,QOOP
ZKWIN: CZKW IN,,,1,,QZKWTR,QOOP
ZKWIF: CZKW IF,,,1,,QZKWTI
CZKW INPUT,,,1,,QZKWTS,,<LAB(DSIP)>
CZKW INSPEC,T,1,1,1,QZKWTS,,<LAB(DSPC)> ;[2]
ZKWIFC: CZKW IFCHAN,GED,1,1,,QZKWTI
CZKW LE,,,1,,QZKWTR,QACTOP,<311000> ;CAML
CZKW LT,,,1,,QZKWTR,QACTOP,<313000> ;CAMLE
CZKW NE,,,1,,QZKWTR,QACTOP,<312000> ;CAME
CZKW NOARRA,YS,1,1,1,QZKWTS,,<LAB(DSNOTI)> ;[41]
ZKWNON: CZKW NONE,,,1,,QZKWTQ,QREF,NONE
CZKW NOPROC,EED,1,1,1,QZKWTS,,<LAB(DSNOPR)> ;[41]
ZKWNOT: CZKW NOTEXT,,,1,,QZKWTQ,QTEXT,0
CZKW OUTPUT,,,1,1,QZKWTS,,<LAB(DSOP)>
ZKWPRO: CZKW PROCEE,D,1,1,1,QZKWTS,,<LAB(DSPR)> ;[41] Allow PROCEED in error mode
CZKW RESET,,,1,1,QZKWTC,,<LAB(DSPCRT)> ; [2]
ZKWREM: CZKW REMOVE,,,1,,QZKWTS,,<LAB(DSRE)>
CZKW RETURN,,,1,1,QZKWTC,,<LAB(DSPCRN)> ; [2]
CZKW ST,,,1,1,QZKWTS,,<LAB(DSST)> ; [2] [41] Short form of STOP
ZKWSTO: CZKW STOP,,,1,1,QZKWTS,,<LAB(DSST)> ;[41]
ZKWSTA: CZKW START,,,1,1,QZKWTC,,<LAB(DSPCST)> ; [2]
CZKW SCHEDU,LED,1,1,1,QZKWTS,,<LAB(DSSC)>
ZKWSKT: CZKW TEXT,,,1,1,QZKWTI ;[41]
ZKWTHI: CZKW THIS,,,1,1,QZKWTI ;[41]
ZKWTRU: CZKW TRUE,,,1,,QZKWTQ,QBOOLEAN,1
CZKW TTY,,,1,1,QZKWTI
CZKW UP,,,1,1,QZKWTC,,<LAB(DSPCUP)> ; [2]
CZKW USE,,,1,1,QZKWTS,,<LAB(DSUS)>
CZKW VARIAB,LES,1,1,1,QZKWTS,,<LAB(DSVA)>
ZKWQUA: CZKW QUA,,,1,1,QZKWTI
ZKWL: ;LAST ZKW ENTRY
CZKW ,,,1,,QZKWTR,QACTOP,<312000> ;CAME
SIXBIT "\="
;Dummy entry
ZKWBLOCK:CZKW BLOCK,
ZKWMAIN:CZKW MAIN,
;[2]
;Symbol table ZSD entry for main text procedure
DSZSDM: DZSD MAIN,QIMAIN,QTEXT,,QPROCEDURE,0
SUBTTL SIMDDT records, field and switch definitions
;Field and switch definitions
;ZKW, keyword table
DSW (ZKWLNE,0,0,XDZKW) ;Flag set if ZKWNM2 present
DSW (ZKWDBG,0,1,XDZKW) ;Flag set if keyword allowed in debug mode
DSW (ZKWERR,0,2,XDZKW) ;Flag set if keyword allowed in error mode
DF (ZKWTYP,0,3,5) ;Type of keyword, QZKWTS,...
DF (ZKWCOD,0,12,17) ;XDBAS is placed in this field
;if ZKWTYP is QZKWTS
;This field gives the type of a relational
;operator or the type of a constant
DF (ZKWADR,0,18,35) ;Address of command routine if qzkwts
;Instruction (left part) to be used
;if relational operator entry
DF (ZKWVAL,0,18,35) ;Value of constants TRUE, FALSE, NOTEXT
;and NONE
DF (ZKWNM1,1,36,35) ;Sixbit name, six first letters
DF (ZKWNM2,2,36,35) ;Sixbit name, six last letters
;ZBR, breakpoint record
DF (ZBRZBE,0,18,17) ;Pointer to ZBE entry
DF (ZBRZLN,0,18,35) ;Pointer to ZLN entry
DF (ZBRINS,1,36,35) ;Breakpoint instruction
;ZBE, breakpoint entry
DF (ZBEZBE,0,18,17) ;Pointer to next ZBE entry
DSW (ZBESTO,0,18) ;STOP found in command
DSW (ZBESTB,0,19) ;String found in command
DF (ZBETYP,0,4,23) ;Type of ZBE entry
;QBEAT,QBEATL,QBEATC,QBEATR or QBECON
DF (ZBESTR,0,36,35) ;String first 5 characters
DF (ZBENIN,0,18,17) ;Initial value of counter n
DF (ZBENVA,0,18,35) ;Current value of counter n
DF (ZBEZSD,0,18,35) ;Pointer to ZSD entry
DSW (ZBEIDL,0,0) ;Not last identification
DSW (ZBETHI,0,1) ;[41] THIS used in identification
;[41] ZBEZSD points at class prototype
DSW (ZBEQUA,0,14) ;[41] QUA used in identification
DSW (ZBEIDD,0,2) ;Dot present after identifier1
DSW (ZBESTA,0,15) ;[41] * present instead of identifier
DF (ZBEEBL,0,7,9) ;Effective block level
DF (ZBESUN,0,4,13) ;Number of subscripts
DF (ZBEVSU,0,36,35) ;Subscript value
DF (ZBEVAL,0,36,35) ;Value of constant or variable
DF (ZBEROP,0,18,17) ;Pointer to relation operator entry in ZKW
DSW (ZBETCI,0,18) ;Flag set if constant follows
;relation operator
;Error message definitions
;SIMEDS contains table
;Start of tables is DSERRM
YDSDLN=DSERRM ;Number of words in EDL table
YDSDN=DSERRM+1 ;Number of words in Ed table
YDSMN=DSERRM+2 ;Number of words in EM table
YDSMIN=DSERRM+3 ;Number of words in EMI table
YDSEDL=DSERRM+4 ;Start of EDL table
YDSED=YDSEDL+^D15 ;Start of ED table, max length of word is 15
DF (YDSDLC,0,18,17) ;Number of preceding chars.
DF (YDSDLW,0,18,35) ;Number of preceding words
;[2] Dummy line number table to be used with standard classes
YDSZLS: XWD 520000,0 ;Class prototype entry
XWD 0,0 ;Dummy line 0
XWD 600000,0 ;End of table, addresses filled by DSPC routine