Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/20/simds9.mac
There are 2 other files named simds9.mac in the archive. Click here to see a list.
PRINTX SIMDS9.MAC
SUBTTL DSBP BREAKPOINT PROCESSING, SIMDDT main routine
LIST
SALL
Comment;
Updated at Acadia University for KA10
Purpose: Perform the breakpoint actions
Entry: DSBP
Normal exits: DSPR if no stop condition encountered
DSCM if stop condition found
Error exit: DSCM always stop if error found, e.g. value error
Used routines: DSNB, DSPBTS, DSPBS, DSLV, DSPI, TXRE, TXCY, DSO, DSLV
DSFCV, DSNBC, DSPV
;
RADIX 8
BEGIN
DSBP: ;Breakpoint processing
SETONA YDSINO ;No interesting input buffer
L XDZBE,LABB(YDSCZBR)
ADDI XDZBE,LABB(DSZBRF)
edit(41) ;[41]
DSTACK XDZBE ;Save ZBR pointer
MDSNB
LOOP
LF XDT2,ZBETYP(XDZBE)
SETOFA YDSCSTOP
IFON ZBESTO(XDZBE)
SETONA YDSCSTOP ;Command starts with STOP
IF ;Simple AT command
CAIE XDT2,QBEAT
GOTO FALSE
THEN SOS X1,2(XDZBE) ;Subtract from loop counter
HLLI X1,0
JUMPN X1,LAB(L8()) ;Try next command
LF X0,ZBENIN(XDZBE,2) ;Restore counter
SF X0,ZBENVA(XDZBE,2)
DEXEC DSPBTS ;Output command or only string if present
DEXEC DSBPO ;Output
GOTO LAB(L8())
FI
DEXEC DSPBS ;First part of command to buffer
CAIN XDT2,QBEATR
GOTO LAB(L2()) ;AT relation command
L X0,LABB(YDSOPO) ;Save output pointer
ST X0,1+LABB(YDSTIP)
L X0,1+ZTV%S(XDINT)
ST X0,2+LABB(YDSTIP)
LOOP
MDSLV ;Find value
JUMPE XDADR,LAB(L9()) ;Value error
edit(41)
SETOFA YDSLIST ;[41]
IFON ZBEIDL(XDZBE) ;[41]
SETONA YDSLIST ;[41] Set switch in case DSPI is skipped
L X0,XDZBE ;[41]
IFOFFA YDSOAI ;[41] Skip identification if array id.
MDSPI ;Put identification
L XDZBE,X0
;Last ZBE entry for identification
IFOFFA YDSCHG
GOTO LAB(L6()) ;Type qbeatl
LD X0,(XDADR) ;Fetch new value
MDSNBW ;XDZBE points at previous value
L XDARR,XDZBE
IF ;LONG REAL
CAIE XDTYP,QLREAL
GOTO FALSE
THEN
MDSNBW
EXCH X1,(XDZBE) ;Save new value second word
CAME X1,1(XDADR)
GOTO LAB(L7()) ;Output value and
;update first word
;Normal test
FI
CAIN XDTYP,QREF
DEXEC DSBPRAE ;Fetch array index address to
; XDARR
IF ;TEXT
CAIE XDTYP,QTEXT
GOTO FALSE
THEN
;Text array changed if length, address, pos or
; characters changed
DEXEC DSBPTAE
DSTACK XDT5
DSTACK XDTYP
DSTACK XDADR
;Fetch relation parameters
MDSNBW
L X0,(XDADR)
IF ;Address was changed
CAMN X0,(XDARR)
GOTO FALSE
THEN ;Save new address
ST X0,(XDARR)
GOTO LAB(L3())
FI
DEXEC DSBPTAE ;Address of copy
LD XDADR+2,(XDARR)
;***AUBEG
;AVOID SAME INDEX REGISTER IN LD MACRO
LI XDADR+1,(XDADR)
LD XDADR,(XDADR+1)
;***AUEND
IF
CAME XDADR+1,XDADR+3
GOTO TRUE
;Call RTS to test if any characters changed
LI XTAC,XWAC1
MTXRE
SKIPA X1,XWAC1 ;Save result
L3():!
THEN
LI X1,1 ;Dummy to indicate
;changed variable
DUNSTK XDADR
DUNSTK XDTYP
DUNSTK XDT5
JUMPE X1,LAB(L4()) ;Unchanged
;text variable
;Text changed
;Copy new text and save text reference in text array
;Output changed value
DEXEC DSBPOV
LD XWAC1,0(XDADR)
MTXCY
LD XDT2,XWAC1
DEXEC DSBPTAE ;Find text
;array element
STD XDT2,(XDARR) ;Save new value
GOTO LAB(L5())
FI
FI
CAMN X0,0(XDARR)
GOTO LAB(L4()) ;Value not changed
L7():! ;Save new value
ST X0,0(XDARR)
L6():! ;Output value
DEXEC DSBPOV ;Output value
L5():! DEXEC DSOCT ;Start next line if any with tab
; Save output pointer
L X0,LABB(YDSOPO)
ST X0,1+LABB(YDSTIP)
L X0,1+ZTV%S(XDINT)
ST X0,2+LABB(YDSTIP)
L4():! AS
IFOFFA YDSLIST
GOTO LAB(L8()) ;Next command
MDSNBW
;Restore output pointers
L X0,1+LABB(YDSTIP)
ST X0,LABB(YDSOPO)
L X0,2+LABB(YDSTIP)
ST X0,1+ZTV%S(XDINT)
GOTO TRUE ;Next element in list
SA
L2():! ;Process AT relation command
MDSLV
JUMPE XDADR,LAB(L9())
MDSPI
L XDZBE,X0 ;Last ZBE entry
MDSNBW ;Operator entry
WLF X1,ZBEROP(XDZBE)
DSTACK X1
MDSNBW
IF ;Identification follows
IFONA ZBETCI(X1)
GOTO FALSE
THEN
DSTACK XDADR
MDSLV
JUMPE XDADR,LAB(L9())
L XDARR,XDADR
DUNSTK XDADR
ELSE ;Value follows
DEXEC DSFCV ;Find constant value
FI
;XDADR points at variable
;XDARR points at value
DUNSTK X1 ;Fetch ZKW address
;Operation in ZKWADR
HLRZ X1,X1
edit(102)
ADDI X1,(XDBAS) ;[102] Use relative address in ZBE
L X0,XDADR
HRL X0,(X1)
ST X0,LABB(YDSTIP) ;Create relation operation
LF X0,ZKWCOD(X1)
IF ;IS or IN operator
CAIE X0,QOOP
GOTO FALSE
THEN
;XDADR points at ref variable
;XDT5 points at ZSD entry
;(XDARR) contains first 6 letters of
; class identifier
;Find variable prototype
L X6,(XDADR)
CAIN X6,NONE
GOTO LAB(L8()) ;FALSE if none
LF X6,ZBIZPR(X6) ;Fetch prototype
L X0,(XDZBE)
MDSNBW
LOOP
IF
LF XDT4,ZPRSYM(X6) ;Symbol table
THEN
CAME X0,-2(XDT4)
GOTO FALSE
L XDT4,-1(XDT4) ;Last six letters
CAMN XDT4,(XDZBE)
GOTO LAB(L6()) ;TRUE output value
FI
AS
CAIN X1,LAB(ZKWIS)
GOTO LAB(L8()) ;FALSE for IS
LF X6,ZCPZCP(X6)
JUMPG X6,TRUE ;Prefix class exists
SA
GOTO LAB(L8()) ;FALSE for IN
FI
IF ;TEXT value relation
CAIN XDTYP,QTEXT
CAIE X0,QACTOP
GOTO FALSE
THEN ;Call TXRE
DSTACK XDT5
DSTACK XDTYP
DSTACK XDADR
LD XDADR+2,(XDADR)
LD XDADR,(XDARR)
LI XTAC,XWAC1
MTXRE
L X0,XWAC1
LI X1,LAB(DSZERO)
edit(52)
HRRM X1,LABB(YDSTIP) ;[52]
DUNSTK XDADR
DUNSTK XDTYP
DUNSTK XDT5
ELSE ;Compare variables
LD X0,(XDARR) ;Fetch right hand value
IF ;LONG REAL or TEXT
CAIN XDTYP,QLREAL
GOTO TRUE
HRR X1,1(XDADR) ;Make pos fields equal
CAIE XDTYP,QTEXT
GOTO FALSE
THEN ;Compare second word in long real and text variable
IF ;First words equal
CAME X0,0(XDADR)
GOTO FALSE
THEN ;Second words determine result
AOS ,LABB(YDSTIP)
L X0,X1
FI
FI
FI
;Interpret relational instruction
;X0 contains rhs value and address points at identifier value
;XCT is instruction from ZKW table. X0 is identifier value
XCT ,LABB(YDSTIP)
GOTO LAB(L6()) ;TRUE output value
;FALSE next command
L8():! ;Find next command
AS
MDSONL ;Remove any tab
;Find correct ZBE entry
DEXEC DSNBC
edit(41)
IFOFF YDSSUP(XLOW) ;[41] If ^C - REENTER
JUMPN XDZBE,TRUE ;Process next command
SA
;Exit DSBP
DUNSTK ;Remove ZBR entry
IFONA YDSTOP
BRANCH LAB(DSCM) ;Accept new commands if STOP command found
edit(156)
IFOFF YDSSUP(XLOW) ;[156] User wants control?
BRANCH LAB(DSPR)
MDSOTM QMBPCR ;[156] Yes, give message that execution stopped
;[156] via ^C - REENTER commands
BRANCH LAB(DSCM) ;[156] Accept new commands
L9():! ;Value error
SETONA YDSTOP ;Always stop on error
GOTO LAB(L8())
DSBPTAE:;Local subroutine to find address of text array element
;Check if NOTEXT or array element
LI XDARR,LAB(DSNOTEXT)
SKIPN ,(XDZBE)
DRETUR ;NOTEXT constant
DEXEC DSBPTT ;Elements occupy 2 words
SUBI XDARR,1
ADD XDARR,(XDZBE)
DRETUR
DSBPTT:
SKIPA XDARR,YDSTXT(XLOW)
DSBPRAE: ;Local subroutine to find address of ref array element
L XDARR,YDSREF(XLOW)
LF XDARR,ZARBAD(XDARR)
SUBI XDARR,1 ;First element in array is 0 element
ADD XDARR,0(XDZBE) ;Add ZBEVAL
DRETUR
DSBPOV: ;Local subroutine to output value
DSTACK XDADR
DSTACK XDZBE
L XDZSD,XDT5
SETOFA YDSOBOTH
IFONA YDSCSTOP
SETONA YDSOBOTH
edit(41)
DEXEC DSPVS ;[41]Output array identifier elements
;[41] or block variables
SKIPA
MDSPV
DUNSTK XDZBE
DUNSTK XDADR
DSBPO: ;Output to file of both file and tty
;Local subroutine
IF
IFOFFA YDSCSTOP
GOTO FALSE
THEN
SETONA YDSTOP
DEXEC DSOFT
ELSE
MDSOF ;Output to file
FI
DRETUR
DSNOTEXT:
;Note, DSNOTEXT and DSZERO should be moved to
;ZBR record if rest of SIMDDT moved to high segment
DSZERO: Z
Z
PRINTX ENDD DSBP
ENDD
SUBTTL DSCM Command accept and dispatch, SIMDDT main routine
Comment;
Purpose: Output the * prompter on the user terminal and
scan the first word in input command
Branch to correct command routine via the keyword table
Entries: DSCM scan new command
DSCMO scan command after STOP
Normal exit: To command routine via address in ZKW
Error exit: -
Used routines: DSO, DSIT, DSFK, DSINL, DSSKB, DSOEM
;
edit(41) ;[41] Routine DSCMI to output * and read a line from tty
;[41] Used by DSCM and DSPR
DSCMI:
LOOP ;Until a non-blank line is input
IF ;Call was not from PROCEED
HRRZ X0,(XDSTK)
CAIE X0,LAB(DSCMO)
GOTO FALSE
THEN ;Output * on terminal
edit(302) ;[302]
IF ;Command input is from another TTY
IFOFFA YDSITTY
SKIPN X1,YDSIFO(XLOW)
GOTO FALSE
WLF ,ZFIKAR(X1)
IFOFFA ZFITA
IFOFFA ZFITTY
GOTO FALSE
THEN ;Prompt on that TTY
LF ,ZFICHN(X1) ;I/O channel
IONDX. ;Universal i/o index
GOTO FALSE ;(no luck)
ST 2(XDSTK) ;Use stack as parameter
LI .TOOUC ;area for TRMOP.
ST 1(XDSTK) ;to output a character
LI "*" ;on the terminal
ST 3(XDSTK) ;Char to output
LI 1(XDSTK) ;Addr of arg blk
HRLI 3 ;3 arg words
TRMOP. ;Output "*"
GOTO FALSE ;(no luck)
ELSE ;Prompt on controlling TTY
LI X1,"*"
OUTCHR X1
FI
FI
MDSIT
AS
LF X1,ZTVLNG(XDINT)
JUMPE X1,TRUE ;No input text found
MDSSKB ;[304] Skip blanks
JUMPE XDBYTE,TRUE ;[304] End of input
SA
BRANCH LAB(DSINL) ;[41] END ;[304] Readjust and return
DSCM: ;Command accept and dispatch
SETOFA YDSSNA ;[41] Reset switch
edit(166)
SETOFA YDSCHG ;[166] Reset switch
HLRI XDSWIT,0 ;Set all switches from bit 18 off
DEXEC DSOCR ;Remove ^O
DEXEC DSOFCR ;Output blank line to file
DSCM01:
edit(41)
DEXEC DSCMI ;[41] The loop has been a routine
DSCMO: ;Entry from STOP command routine DSST
edit(41)
SETOFF YDSSUP(XLOW) ;[41] Suppress command switch off
;Get next identifier from input text
LI XDMN,QMCM01 ;Invalid start of command
IF ;A keyword valid as a command starter is found
MDSGIK ;[304] Get initial keyword
GOTO FALSE
MDSFK
JUMPE XDZKW,FALSE
IFNEQF (XDZKW,ZKWTYP,QZKWTS)
GOTO FALSE
THEN ;Acceptable SIMDDT mode
IF ;Debug mode
IFOFFA YDSDBG
GOTO FALSE
THEN ;Check if command valid in debug mode
IFON ZKWDBG
DSCM02: ;[41]
BRANCH @(XDZKW) ;Mode ok, goto command routine
LI XDMN,QMCM02
;Fetch error number
;Ask for new command
ELSE ;Error mode
IFON ZKWERR
BRANCH @(XDZKW)
;[41] Allow command
;if continuation possible
HLLZ X0,LABB(YDSSENR) ;[41]
JUMPN X0,LAB(DSCM02) ;[41]
LI XDMN,QMCM03
FI
FI
;Error not valid start of command
;or command not valid in current mode
;May be comment ;
L XDT2,LABB(YDSIPO) ;[41]
MDSINL
MDSSKB
CAIN XDBYTE,";"
GOTO LAB(DSCM01) ;Try new command
IF ;@ command ;[41]
CAIE XDBYTE,"@"
CAIN XDBYTE,"`"
THEN
BRANCH LAB(DSGET)
FI ;[41] End
ST XDT2,LABB(YDSIPO) ;[41]
MDSOEM
GOTO LAB(DSCM)
SUBTTL DSST STOP, SIMDDT main command routine
DSST: ;STOP at start of command
SETONA YDSTOP ;Indicate STOP found
BRANCH LAB(DSCMO) ;Return to scan rest of command
;Note that the error STOP HELP ,...
;will not be detected. Put extra flag in ZKW to control this
SUBTTL DSHE HELP, SIMDDT main command routine
Comment;
Purpose: Output the file HLP:SIMDDT.HLP on the user TTY and output
file.
Entry: DSHE
Normal exit: DSDPHL to output file
Error exit: -
USED ROUTINES: DSDPHL
;
edit(41)
DSHE: ;[41] Changed to read SIMDDT.HLP
edit(242)
;[242] Check for illegal context moved to DSCF
SETZM ,LABB(YDSNDL)
LI X0,^D28 ;Read only first lines in file
ST X0,LABB(YDSKDL) ;[242] Max count, allows line numbers also
HRLOI X0,377777 ;[242] "Infinite" last line
ST X0,LABB(YDSLDL) ;[242] (count takes precedence)
DEXEC DSEXPR ;Close any DISPLAY file
SETONA YDSHEL ;Indicate HELP command
LD X1,LAB(<[SIXBIT /HLP:SIMDDT.H/ ]>)
HRLZI XDT3,'LP '
LI XDT4,^D15
DSTACK YDSZLN(XLOW)
BRANCH LAB(DSDPHL) ;Use DISPLAY routine to output file
SUBTTL DSAT AT, SIMDDT main command routine
Comment;
Purpose: Scan the AT command, save the information from the
command in the breakpoint record and entries (ZBR and ZBE'S ).
Replace the user instruction with the breakpoint uuo.
Entry: DSAT
Normal exit: DSCM
Error exit: -
Used routines: DSLB, DSFB, DSSKB, DSGS, TXGI, DSSCIR,
DSIFK, DSGI, DSRAF, DSRAT, DSNI, DSGIR, DSFKI, DSOEM
;
BEGIN
DSAT: ;AT commands, set breakpoint
;Save old environment
DSTACK YDSZLN(XLOW)
DSTACK LABB(YDSCZS)
DSTACK LABB(YDSCZL)
edit(213)
SETZM LABB(YDST3) ;[213] No breakpoint info yet
DSTACK LABB(YDST3) ;[213] Dummy for XDZLN
LD X0,LABB(YDSTRA)
STD X0,LABB(YDSTRB) ;Save status of array elements
;to be used in case of error
;Find old breakpoint ZBR entry or
;reserve new entry
MDSGL
GOTO LAB(L1()) ;Error
;New environment
ST X0,YDSZLN(XLOW)
edit(245)
DSATNL: ;[245] Here when next line to be tried
ST XDT2,LABB(YDSCZL)
ST X1,LABB(YDSCZS)
IF ;Line already in ZBR table
DEXEC DSLB
GOTO FALSE
THEN ;Breakpoint already present
;Find end of link
ST XDZBE,LABB(YDST3) ;Save breakpoint in case of error
WHILE
LF X1,ZBRZBE(XDZBE)
JUMPE X1,LAB(L3())
DO
L XDZBE,X1
ADD XDZBE,XDZBR
OD
FI
LI XDMN,QMATNF ;No more free breakpoint entries
JUMPE X1,LAB(L2())
;Insert breakpoint in code and update ZBRINS
SF XDZLN,ZBRZLN(X1)
L XDZBE,X1
ST XDZBE,LABB(YDST3)
LF XDT2,ZLNADR(XDZLN)
L X0,(XDT2) ;Fetch instruction
SF X0,ZBRINS(XDZBE) ;to ZBR record
IF ;[245] Instruction not suitable
HLRZS X0
CAIE X0,(MOVEM XWAC1,(XCB)) ;"WHEN <class-id> DO"
GOTO FALSE
THEN ;Try next line in table
LF XDLIN,ZLNLIN(XDZLN)
ADDI XDLIN,1
L XDT2,YDSZLN(XLOW)
MDSLL
GOTO LAB(L1()) ;Error
GOTO LAB(DSATNL)
FI
SUBI X1,LABB(DSZBRF) ;Calculate breakpoint number
HRLI X1,(BREAK)
ST X1,(XDT2) ;Replace actual instr with BREAK UUO
L3():! ;XDZBE points at ZBRZBE entry
;or ZBEZBE entry if not first breakpoint statement for this line
MDSFB
GOTO LAB(L1()) ;No more free ZBE entries
ST XDZBE,(XDSTK) ;Save breakpoint command start ZBE
IF ;STOP was specified
IFOFFA YDSTOP
GOTO FALSE
THEN
SETON ZBESTO(XDZBE) ;Stop flag on
FI
SETZ XWAC1, ;Assume no counter
L4():! ;Find first nonblank character
DEXEC DSSKB
IF
CAIE XDBYTE,QTEXTQ
GOTO FALSE
THEN
;Handle string
L X1,LAB(<[POINT 7,(XDZBE),34]>)
L X0,LAB([ASCII " "])
SF X0,ZBESTR(XDZBE,1)
;If two strings are present the second one is accepted
WHILE
MDSGS
GOTO LAB(L2()) ;End of input
GOTO FALSE ;End of text string
DO ;New character
TRNN X1,2 ;Store only 5 characters
IDPB XDBYTE,X1
OD
;End of string
SETON ZBESTB(XDZBE) ;String flag on
DEXEC DSSKBN
FI
IF ;Comma
CAIE XDBYTE,","
GOTO FALSE
THEN ;Handle loop counter
LI XDMN,QMATLC ;More than one loop counter
JUMPN XWAC1,LAB(L2()) ;Create error
DSTACK XDZLN
MTXGI
SETZ XWAC1, ;If error
DUNSTK XDZLN
LI XDMN,QMATNC ;Invalid counter n
JUMPLE XWAC1,LAB(L2()) ;Error
GOTO LAB(L4()) ;Check for string again
FI
;Both counter and string treated
LI X1,QBEATL ;Assume type
IF ;No more input
JUMPN XDBYTE,FALSE
THEN
SKIPN XWAC1
LI XWAC1,1 ;Default counter value
FI
IF ;No counter
JUMPE XWAC1,FALSE
THEN ;Type is QBEAT
SF XWAC1,ZBENVA(XDZBE,2)
SF XWAC1,ZBENIN(XDZBE,2)
LI X1,QBEAT
GOTO LAB(L6())
FI
SF X1,ZBETYP(XDZBE)
IF ;Text string was given
IFOFF ZBESTB(XDZBE)
GOTO FALSE
THEN
MDSFBW ;Step to next word
CAI ;Never error
FI
edit(166)
;[166] 2 instr removed
DEXEC DSSCIR ;Back one input char.
DEXEC DSIFK ;Find keyword
GOTO LAB(L8()) ;No identifier
IF
CAIN X1,LAB(ZKWIF)
GOTO 1+TRUE
CAIE X1,LAB(ZKWIFC)
GOTO FALSE
THEN
SETONA YDSCHG
SETONA YDSIFF
MDSGI ;Find identifier
GOTO LAB(DSAT09) ;[41] Error
edit(41)
ELSE
DSAT04: ;[41]
SETONA YDSOCO ;[41] Array identifier and * allowed
FI
SETOFA YDSLIST
;Look for identification
LI X1,LAB(DSAT01)
DSTACK X1
DSTACK XDZBE
L XDZLN,LABB(YDSCZL)
DSTACK XDZLN
LDB XDBYTE,LABB(YDSIPO) ;[41]
CAIN XDBYTE,"*" ;[41]
BRANCH LAB(DSNI01) ;* Found
BRANCH LAB(DSNIS)
DSAT01:
GOTO LAB(L1()) ;Error found
LOOP
EXCH X0,LABB(YDSILP) ;Save start ZBE address of
;identifier
IF
IFOFFA YDSLIST
GOTO FALSE ;No list
THEN
;Set list flag on in previous entry
DSTACK XDZBE
L XDZBE,X0
DEXEC DSNBW ;Find right entry
SETON ZBEIDL(XDZBE) ;List flag on
DUNSTK XDZBE
FI
IF ;IFCHANGED was specified
IFOFFA YDSCHG
GOTO FALSE
THEN ;Reserve ZBE entries and fill with initial values
DEXEC DSATFB
;XDTYP loaded
L XDTYP,LABB(YDSSTP)
IF
CAIE XDTYP,QLREAL
GOTO FALSE
THEN
DEXEC DSATFB
FI
MOVNI X1,1
CAIN XDTYP,QREF
DEXEC DSRAF ;Reserve ref array element
CAIN XDTYP,QTEXT
DEXEC DSRAT ;Reserve text array element
JUMPE X1,LAB(L2()) ;Error no free element
IF
JUMPL X1,FALSE
THEN
ST X1,(XDZBE) ;Save element number in ZBE
;Initialize element
PUSHJ XDSTK,(XDARR) ;Element address
LI X0,NONE
ST X0,(XDARR)
IF
CAIE XDTYP,QTEXT
GOTO FALSE
THEN
SETZM ,(XDARR)
SETZM ,1(XDARR)
DEXEC DSATFB
DEXEC DSRAT
JUMPE X1,LAB(L2())
ST X1,(XDZBE)
PUSHJ XDSTK,(XDARR)
SETZM ,(XDARR)
SETZM ,1(XDARR)
FI
FI
FI
DEXEC DSSKBN
AS
CAIE XDBYTE,","
GOTO FALSE
SETONA YDSLIST
MDSNI
GOTO LAB(L1())
GOTO TRUE
SA
LI X1,QBEATC ;Assume IFCHANGED variant of AT command
IFONA YDSCHG
GOTO LAB(L6()) ;No condition after changed
IFOFFA YDSIFF ;Relation not possible
GOTO LAB(L5()) ;No condition after list
;Save XDZLN
MDSGIR
GOTO LAB(DSAT03) ;Error
DEXEC DSATFB
L XDT2,XDZBE ;Save XDZBE
MDSFKI
EXCH XDT2,XDZBE ;XDT2 contains XDZKW
JUMPE XDT2,LAB(DSAT03) ;Error
IFNEQF (XDT2,ZKWTYP,QZKWTR)
GOTO LAB(DSAT03)
edit(102)
SUBI XDT2,(XDBAS) ;[102] Use relative address in ZBE
SF XDT2,ZBEROP(XDZBE) ;Save keyword table address
ADDI XDT2,(XDBAS) ;[102] Restore address
;Check if identifier and relation operator are compatible
LI XDMN,QMATOP
LF X1,ZKWCOD(XDT2)
L XDTYP,LABB(YDSSTP)
IF ;IS or IN
CAIE X1,QOOP
GOTO FALSE
THEN ;Must be type REF
CAIE XDTYP,QREF
GOTO LAB(L2()) ;Error
;Find class identifier and prototype
IF ;No identifier given
MDSGI
GOTO FALSE
THEN
SETON ZBETCI(XDZBE)
DEXEC DSATFB
ST XDSYM1,(XDZBE)
DEXEC DSATFB
ST XDSYM2,(XDZBE) ;Save identifier
GOTO -1+LAB(L6())
FI
LI XDMN,QMATCI
GOTO LAB(L2())
FI
IF ;Value relation operator
CAIE X1,QACTOP
GOTO FALSE
THEN ;Error for REF and BOOLEAN
CAIE XDTYP,QREF
CAIN XDTYP,QBOOLEAN
GOTO LAB(L2())
ELSE
IF ;BOOLEAN operator
CAIE X1,QBOP
GOTO FALSE
THEN ;Type must be BOOLEAN
CAIE XDTYP,QBOOLEAN
GOTO LAB(L2()) ;Error
ELSE ;Reference relation, only TEXT and REF valid
CAIE XDTYP,QREF
CAIN XDTYP,QTEXT
SKIPA
GOTO LAB(L2()) ;Error
FI
FI
L XDZLN,LABB(YDSCZL)
DEXEC DSSCIR
MDSGV
DSAT02: ;Label used in DSGV routine
GOTO LAB(L1()) ;Error no value or ident found
NOP ;Constant found
;Identification found
LI X1,QBEATR ;AT relation command
L6():! ;Correct exit set type of AT command
L XDMN,(XDSTK) ;Fetch initial ZBE entry
SF X1,ZBETYP(XDMN)
L5():! ;End of input expected
LI XDMN,QMATEI
DEXEC DSSKBN
JUMPE XDBYTE,LAB(L7())
L2():! ;Create error message
MDSOEM
L1():! ;Error already given
LD X0,LABB(YDSTRB)
STD X0,LABB(YDSTRA) ;Restore array elements
L XDZBE,(XDSTK)
L X0,LABB(YDST3)
edit(213)
JUMPE X0,LAB(L7()) ;[213] No info created before error
ST X0,(XDSTK) ;Save ZBR pointer
DEXEC DSRLBA ;Release all new breakpoint info
L7():!
;Restore environment
DUNSTK
DUNSTK LABB(YDSCZL)
DUNSTK LABB(YDSCZS)
DUNSTK YDSZLN(XLOW)
BRANCH LAB(DSCM) ;Exit
DSAT03: LI XDMN,QMATCR ;Relation operator expected
GOTO LAB(L2())
edit(41)
L8():! ;[41]
LDB XDBYTE,LABB(YDSIPO) ;[41]
CAIN XDBYTE,"*"
GOTO LAB(DSAT04) ;[41]
DSAT09: ;[41]
LI XDMN,QMATII
GOTO LAB(L2())
DSATFB: ;Reserve next ZBE word and set contents to zero
;Internal subroutine
MDSFBW
GOTO LAB(L1())
SETZM ,(XDZBE)
DRETUR
PRINTX ENDD AT
ENDD
SUBTTL DSDP DISPLAY, SIMDDT main command routine [242]
edit(242)
Comment;
;
BEGIN
DSDP: ;DISPLAY command
DSTACK YDSZLN(XLOW) ;Save current module
L X0,LABB(YDSDZLN) ;Current display module
IF ;There is a current display module
JUMPE X0,FALSE
THEN ;Exchange with current module
EXCH X0,YDSZLN(XLOW)
FI
DEXEC DSGL ;Get line identif.
DSDPGL: ;Return address from DSGL call
GOTO LAB(L1()) ;Error found
ST X0,LABB(YDSCDZLN) ;Save current module
LI ^D10 ;[242] Default number of lines
ST LABB(YDSKDL) ;[242]
DEXEC DSSKB ;Skip blanks and tabs
IF ;[242] More input available
JUMPE XDBYTE,FALSE
THEN ;[242] Find line interval
SETZM LABB(YDSLDL) ;[242] Used as flag for "no line no" in DSGLEL
CAIN XDBYTE,"-" ;Allow "-" or ":" provisionally
LI XDBYTE,":"
IF ;Colon
CAIE XDBYTE,":"
GOTO FALSE
THEN ;Get end of line interval
L X0,LABB(YDSCDZLN) ;Curr. module
DEXEC DSGLEL
GOTO LAB(L1())
IF ;No upper limit given
SKIPL LABB(YDSLDL)
GOTO FALSE
THEN ;Use default count, max upper limit
HRLOI XWAC1,377777
ELSE ;Make count infinite
HRLOI 377777
ST LABB(YDSKDL)
FI
ELSE
CAIN XDBYTE,"," ;Allow comma or "!" as synonyms
LI XDBYTE,"!"
IF ; "!"
CAIE XDBYTE,"!"
GOTO FALSE
THEN ;Number of lines
DEXEC DSGLEL
GOTO LAB(L1())
SKIPL LABB(YDSLDL) ;Keep default if unspecified
ST XWAC1,LABB(YDSKDL)
HRLOI XWAC1,377777 ;Infinite last line no
ELSE ;Some other character
CAIN XDBYTE,";"
GOTO LAB(L6())
LI XDMN,QMDPEL
GOTO LAB(L2())
FI FI
LI XDMN,QMDPLE ;Line interval error
CAMGE XWAC1,LABB(YDSNDL)
GOTO LAB(L2()) ;Error
DEXEC DSSKBN
LI XDMN,QMATEI
JUMPE XDBYTE,LAB(L2()) ;End of input expected
ELSE ;Check for no line no at all
L6():! IF SKIPL LABB(YDSLDL)
GOTO FALSE
THEN ;Treat like .!10
HRLOI XWAC1,377777
ELSE ;Only one line
L XWAC1,LABB(YDSNDL)
FI FI
ST XWAC1,LABB(YDSLDL) ;Last display line
IF ;A display file is already open
L X0,LABB(YDSDZLN)
JUMPE X0,FALSE
THEN ;Go on reading if same as current, otherwise close it
IF ;Same module
CAME X0,LABB(YDSCDZLN)
GOTO FALSE
THEN ;Check if next line can be read sequentially
L X0,LABB(YDSCDL)
CAMGE X0,LABB(YDSNDL)
GOTO LAB(L3()) ;Continue reading if ok
HRRZ XWAC1,YDSDFO(XLOW) ;[242]
DSTACK OFFSET(ZFIIBH)(XWAC1) ;[242] Save buffer pointer
DEXEC DSCLOS ;[242] Close display file
L XWAC1,YDSDFO(XLOW) ;[242]
DUNSTK OFFSET(ZFIIBH)(XWAC1) ;[242] Restore buffer
DEXEC DSCFO ;Reopen
GOTO LAB(L4()) ;Check open
FI
DEXEC DSEXPR ;Close display file and reset variables
FI
;Build module name
IF ;Main program
L X1,LABB(YDSCDZLN)
CAME X1,YDSZLA(XLOW)
GOTO FALSE
THEN ;Fetch name from monitor table
HRROI X1,3 ;[-1,,3]
GETTAB X1,
GOTO LAB(L1()) ;No luck, give up on display command
ELSE ;Find external name in symbol table
LF X1,ZLNADR(X1)
LF X1,ZPRSYM(X1)
L X1,OFFSET(ZSMRN1)(X1)
FI
;X1 holds sixbit name
L XDT2,LAB(<[SIXBIT ".SIM"]>)
edit(41)
LI XDT4,^D11 ;[41]
DSDPHL: ;[41] From HELP routine
MDSINL
SETZM ,ZTE%S+2+LABB(ZDSZTE) ;Place nulls at end of input buffer
edit(153)
SETZM ,ZTE%S+3+LABB(ZDSZTE) ;[153] One extra word to null if HELP command
DEXEC DSFSP ;Create file spec in input buffer
;Open source file for input to output buffer!
L X0,LAB(<[XWD -2,IOIN]>)
DEXEC DSCF
L4():! ;Entry if reopen
JUMPE XWAC1,LAB(L1()) ;Error file not opened
ST XWAC1,YDSDFO(XLOW)
L X0,LABB(YDSCDZLN)
ST X0,LABB(YDSDZLN) ;Save module
SETZM ,LABB(YDSCDL)
SETOFA YDSLLF
L3():! ;Continue reading
WHILE
;Read file
WHILE
edit(41)
IFON YDSSUP(XLOW) ;[41]
GOTO LAB(L1()) ;[41] Suppress rest of lines
SETZM YDSIGS(XLOW) ;Byte pointer reset
SETOFF SWLB35(XLOW) ;Line number indicator
LI XDRTSR,IOIG
L XWAC1,YDSDFO(XLOW)
IFON ZIFEND(XWAC1)
GOTO LAB(L1()) ;End of file, line not found
;Skip any rest of too long image
IFOFFA YDSERE
GOTO FALSE
DO
SETOFA YDSERE
DEXEC DSCRTU
;Check if ending char is LF
SETOFA YDSLLF
SKIPE XWAC3,YDSIGS(XLOW)
LDB XWAC3,YDSIGS(XLOW)
CAIN XWAC3," "
SETONA YDSLLF
OD
;Test if anything read
L X0,LABB(YDSNDL)
CAMLE X0,LABB(YDSLDL)
GOTO FALSE ;All lines displayed
DO
DEXEC DSCRTU ;Call Inimage in RTS
IF
IFOFFA YDSUFR
GOTO FALSE
THEN ;File error
SETOFA YDSUFR
ST XDSWIT,YDSWIT(XLOW)
IFOFFA YDSERE ;Was it "EXTERNAL IMAGE TOO LONG"?
GOTO LAB(L5()) ;No, error unacceptable
FI
IFON ZIFEND(XWAC1)
edit(242)
GOTO LAB(L1()) ;Skip /* [242] No message
SKIPE XWAC3,YDSIGS(XLOW)
LDB XWAC3,YDSIGS(XLOW)
IF ;Not a new line
CAIN XWAC3,033
GOTO TRUE ;Altmode no new line
IFOFFA YDSLLF
GOTO FALSE ;Previous line does not end with LF
SETOFA YDSLLF
L X0,LAB(<[POINT 7,ZTE%S+<QDSION+5>/5+ZDSZTE-DSZBRS,6]>)
ADD X0,XDZBR
CAME X0,YDSIGS(XLOW)
GOTO FALSE ;Not first character
CAIE XWAC3,QVT
CAIN XWAC3,QFF
GOTO TRUE
GOTO FALSE
THEN
SOS X1,LABB(YDSNDL)
CAME X1,LABB(YDSCDL)
AOS ,LABB(YDSNDL)
L XWAC1,LABB(YDSCDL)
GOTO LAB(L7()) ;VT, FF or ALTMODE
;Do not update line number
FI
CAIE XWAC3,0 ;End of image outside buffer
CAIN XWAC3," " ;Assume LF
SETONA YDSLLF ;LF at end of last record read
IF ;Line number in source
IFOFF SWLB35(XLOW)
GOTO FALSE
THEN ;Convert to binary
;Move first two words to input buffer to facilitate conversion
MDSINL
LI X0,12 ;10 characters moved
SF X0,ZTVLNG(XDINT)
LD X0,ZTE%S+<QDSION+5>/5+LABB(ZDSZTE)
edit(155)
TLZ X1,(177B6) ;[155] Force tab if number longer than
TLO X1,(<QHT>B6) ;[155] five characters
STD X0,ZTE%S+LABB(ZDSZTE)
CAME X0,LAB(<[ASCII/ /]>) ;Blanks instead of line number
MTXGI ;Convert integer
GOTO FALSE ;No valid line number
SOJ XWAC1, ;Trick, 1 will be added
CAML XWAC1,LABB(YDSCDL)
ST XWAC1,LABB(YDSCDL) ;Valid line found in source
FI
AOS XWAC1,LABB(YDSCDL) ;Update current display line
L7():! ;Current display line in XWAC1
CAMGE XWAC1,LABB(YDSNDL)
GOTO LAB(L3()) ;Skip this line
ST XWAC1,LABB(YDSNDL) ;Assume right line
;Display source line
;Output pointer from inimage variable
;Output text variable is stripped
LI XTAC,XWAC3
LD XWAC3,ZTV%S(XDINT)
MTXST
;Update output pointers
HLRZ X1,XWAC4 ;Fetch number of characters in stripped text
DSTACK X1
edit(41)
IF ;[41] Not HELP command
IFONA YDSHEL ;[41]
GOTO FALSE ;[41]
THEN ;[41] Output current line number
LD X6,ZTE%S+<QDSION+5>/5+LABB(ZDSZTE) ;Save first part of line
MDSONL
L XWAC3,LABB(YDSCDL)
MTXPI 5 ;Output current line number
IF ;No line number in source
IFON SWLB35(XLOW)
GOTO FALSE
THEN
SETONA YDSBOI ;Indicate breakoutimage
DEXEC DSOCT
MDSOFT
SETOFA YDSBOI
STD X6,ZTE%S+<QDSION+5>/5+LABB(ZDSZTE) ;Restore line
FI
FI ;[41]
DUNSTK X1
MDSONL
L XDT2,LABB(YDSOPO)
LOOP
ILDB X0,XDT2
OUTCHA
AS
SOJLE X1,FALSE
GOTO TRUE
SA
edit(242)
IF ;[242] Last character was special
LDB X1,XDT2
CAIGE X1,40
CAIN X1,QHT
GOTO FALSE
THEN ;Output as ^c
LI "^"
DPB XDT2
LI 100(X1)
OUTCHA
FI ;[242]
MDSOFT
SETONA YDSDOD ;Remember that output done
AOS X1,LABB(YDSNDL) ;Next possible line number
IF
IFOFFA YDSERE
GOTO FALSE
THEN
;Output message external image too long
edit(41)
HRRZ XDMN,YDSENR(XLOW) ;[41]
MDSOFM
SETONA YDSERE ;Skip last part of image
FI
SOSLE LABB(YDSKDL) ;[242] Count number of lines displayed
OD ;[242] Exit when count exhausted
IFONA YDSDOD
GOTO LAB(L1()) ;Ok source line(s) found
L5():! IFONA YDSHEL ;[41]
GOTO LAB(L1()) ;[41]
LI XDMN,QMDPEO ;No line found
SETONA YDSINO
L2():! MDSOEM
L1():! ;[41]
IFONA YDSHEL ;[41]
DEXEC DSEXPR ;[41] Close help file
DUNSTK YDSZLN(XLOW) ;[41]
BRANCH LAB(DSCM) ;Exit DSDP
ENDD
SUBTTL DSOP OUTPUT, SIMDDT main command routine
Comment;
Purpose: Scan the OUTPUT command and output the variable values
Entry: DSOP
Normal exit: DSCM
Error exit: -
Used routines: DSNILV, DSPVN, DSRBD, DSSCIR, DSVAK, DSPVS and DSOEM
;
BEGIN
DSOP: ;OUTPUT command
edit(242)
SETZM LABB(YDSVFA) ;[242]
SETONA YDSOBOTH
SETOFA YDSTEM ;List not yet found
SETONA YDSOCOM ;Indicate OUTPUT command
edit(41)
SKIPA ;[41] May point at /
LOOP
DEXEC DSSCI ;[41] Must not point at ,
;[41]
SETOFA YDSSNA ;[41] Reset switch
SETOFA YDSSKT ;[41]
DEXEC DSVAK ;[41]
GOTO FALSE ;Invalid keyword after /
DEXEC DSSCIR ;[41]
DEXEC DSNILV
GOTO FALSE ;Input not ok
DEXEC DSVAK ;[41]
GOTO FALSE ;[41] Invalid keyword
DEXEC DSSKBN
CAIN XDBYTE,","
SETONA YDSTEM ;List found
IF
edit(41)
DEXEC DSPVS ;[41] Find any array or *
GOTO FALSE ;[41]
THEN ;[41]
IF
IFOFFA YDSTTY
GOTO TRUE
IFOFFA YDSTEM
GOTO FALSE
THEN
MDSPI ;Put identification in output text
L XDZSD,XDT5
MDSPV
ELSE
L XDZSD,XDT5
DEXEC DSPVN
FI
MDSOFT ;Output value
FI
AS
;Release ZBE entries
MDSRBD
LI XDMN,QMOPCR
LDB XDBYTE,LABB(YDSIPO)
CAIN XDBYTE,","
GOTO TRUE ;Next identification in list
JUMPE XDBYTE,FALSE ;Ask for new command
L1():! ;[41]
;Error, comma or CRLF expected
MDSOEM
SA
MDSRBD
GOTO LAB(DSCM)
ENDD
SUBTTL DSIP INPUT, SIMDDT main command routine
Comment;
Purpose: Scan the INPUT command and change
the variable value
NORMAL EXIT: DSCM
ERROR EXIT: -
USED ROUTINES: DSNILV, DSSKB, DSSCI, DSRBD, DSFB, DSGV,
DSNB, DSLV, TXVA, CSQU, DSOBM
;
BEGIN
DSIP: ;INPUT command
DEXEC DSNILV
GOTO LAB(L1()) ;INPUT not ok
edit(2) ;[2] Input to standard procedures not possible
LI XDMN,QMIPPR
LF X0,ZSDSPI(XDT5)
CAIE XDADR,1+LABB(YDSTHD) ;This class without attributes
CAILE X0,QIMAIN
GOTO LAB(L2()) ;Standard procedure except MAIN
DEXEC DSSKBN
LI XDMN,QMIPNA ; := or :- expected
CAIE XDBYTE,":"
GOTO LAB(L2()) ;Create message
MDSSCI
SETONA YDSASG
IF ; Denotes (:-) found
CAIE XDBYTE,"-"
GOTO FALSE
THEN SETOFA YDSASG
LI XDMN,QMIPND ;Denotes only valid after REF or TEXT variable
edit(272)
IF ;[272] Not TEXT
CAIN XDTYP,QTEXT
GOTO FALSE
THEN ;Should be REF
CAIE XDTYP,QREF
GOTO LAB(L2()) ;Error
FI
ELSE ;Must be :=
CAIE XDBYTE,"="
GOTO LAB(L2()) ;Error
LI XDMN,QMIPNR ;:= not valid after REF variable
CAIN XDTYP,QREF
GOTO LAB(L2()) ;Error
FI
ST XDT5,LABB(YDSTIP) ;Save area for accumulators
STD XDTYP,1+LABB(YDSTIP)
edit(166)
SETONA YDSCHG ;[166] Trick to inhibit procedure value
;[166] on right hand side
MDSRBD
LI XDZBE,LABB(YDSBRD)
MDSFB
GOTO LAB(L1())
MDSFBW
GOTO LAB(L1())
SETZM ,(XDZBE)
L XDTYP,1+LABB(YDSTIP)
ST XDTYP,LABB(YDSSTP) ;[166]
IF ;Identification
MDSGV
GOTO LAB(L1()) ;Error
GOTO FALSE ;Constant found
THEN
MDSNBW
MDSLV
JUMPE XDADR,LAB(L1()) ;Error
ELSE ;Constant found
LI XDADR,LABB(YDST1)
FI
;
L XDT5,LABB(YDSTIP) ;Restore
LD X0,1+LABB(YDSTIP)
EXCH X0,XDTYP
IF ;TEXT
CAIE XDTYP,QTEXT
GOTO FALSE
THEN IF ; := operator
IFOFFA YDSASG
GOTO FALSE
THEN ;Value assignment
LI XDMN,QMIPTL
HLLZ X0,1(X1)
CAMGE X0,1(XDADR)
GOTO LAB(L2()) ;Text length error
LD XDT5,(XDADR)
LD XDT3,(X1)
LI XTAC,XWAC1
MTXVA
GOTO LAB(L3())
FI
;Reference assignment ( :- )
IF ; ' t :- "constant" '
L XDMN,2*ZTV%S(XDINT)
CAME XDMN,(XDADR)
GOTO FALSE
THEN ;Error
LI XDMN,QMIPTA
GOTO LAB(L2())
FI
FI
IF ;REF variable
CAIE XDTYP,QREF
GOTO FALSE
THEN ;Check qualification
SETO X0, ;Both NONE and subclass ok
EXCH XDADR,X1
EXCH XDT5,XDTYP
MCSQU
GOTO LAB(L1())
EXCH XDADR,X1
EXCH XDT5,XDTYP
FI
;Perform assignment
L X0,(XDADR) ;First word
ST X0,(X1)
IF ;Two-word quantity
CAIN XDTYP,QLREAL
GOTO TRUE
CAIE XDTYP,QTEXT
GOTO FALSE
THEN ;Store second word
L X0,1(XDADR)
ST X0,1(X1)
FI
L3():! ;Check for end of input
DEXEC DSSKBN
LI XDMN,QMIPEI
JUMPN XDBYTE,LAB(L2())
L1():! ;Error message already created
MDSRBD
BRANCH LAB(DSCM)
L2():! ;Create message
MDSOEM
GOTO LAB(L1())
PRINTX ENDD INPUT
ENDD
SUBTTL DSRE REMOVE, SIMDDT main command routine
Comment;
Purpose: Scan the REMOVE command and remove all breakpoints
or all breakpoint commands for a special breakpoint
Entry: DSRE
Normal exit: DSCM
Error exit: -
Used routines: DSGL, DSGI, DSLB, DSRL, DSOEM, DSSKB
;
BEGIN
DSRE: ;REMOVE command
IF ;Identifier follows REMOVE
MDSGI
GOTO FALSE
THEN ;Identifier must be AT
CAME XDSYM1,1+LAB(ZKWAT)
GOTO LAB(L2()) ;Error, AT expected
MDSGL ;Get statement identification
GOTO LAB(L1()) ;Error, no line identification found
IF ;There is a breakpoint
DEXEC DSLB
GOTO FALSE
THEN ;XDZBE contains ZBR entry
MDSRL ;Release
DEXEC DSSKB
JUMPN XDBYTE,LAB(L2())
BRANCH LAB(DSCM) ;Normal exit
FI
LI XDMN,QMRENB ;No breakpoint set for line
L3():! ;Error exit, produce message
MDSOEM
L1():! ;Error exit, message already produced
BRANCH LAB(DSCM)
FI
IF ;The rest of the line is not blank now
DEXEC DSSKBN
JUMPE XDBYTE,FALSE
THEN ;Error
L2():! LI XDMN,QMRENA ;AT or end of input expected
GOTO LAB(L3())
FI
LI XDZBE,LABB(DSZBRF)
LOOP ;Over all breakpoints
MDSRL ;Release breakpoint line
AS
ADDI XDZBE,2
CAIGE XDZBE,2*QBRN+LABB(DSZBRF)
GOTO TRUE
SA
BRANCH LAB(DSCM) ;Join main command loop
PRINTX ENDD REMOVE
ENDD
SUBTTL DSBR BREAKS, SIMDDT main command routine
Comment;
Purpose: List all breakpoint commands.
Stop after each command and remove it
if requested.
Entry: DSBR
Normal exit: DSCM
Error exit: -
Used routines: DSSKB, DSNBC, DSPBT, DSO, DSIT, DSIFK, DSRLB and DSOEM
;
DSBR: ;BREAKS command
edit(41) ;[41]
IFONA YDSTOP
SETONA YDSOBOTH
BEGIN
IF
DEXEC DSSKBN
JUMPN XDBYTE,FALSE
THEN
LI XDZBE,LABB(DSZBRF)
LOOP
DSTACK XDZBE
WHILE
IFON YDSSUP(XLOW) ;[41]
GOTO FALSE ;[41] Suppress command
ST XDZBE,LABB(YDST3) ;Save pointer
DEXEC DSNBC ;Fetch next command
JUMPE XDZBE,FALSE
DO ;Type breakpoint
MDSPBT
L XDZBE,X0 ;Restore to value
;given in call
IF ;STOP BREAKS command
IFOFFA YDSTOP
GOTO FALSE
THEN ;Type breakpoint
MDSOFT
MDSIT ;Read input
;CRLF or REMOVE
LF X1,ZTVLNG(XDINT)
JUMPE X1,LAB(L1()) ;CRLF found
IF ;REMOVE
DEXEC DSIFK
GOTO FALSE ;No identifier
CAIE X1,LAB(ZKWREM)
GOTO FALSE
THEN ;Reset breakpoint
MDSRLB
;Fetch previous pointer
L XDZBE,LABB(YDST3)
ELSE ;Error, CRLF or REMOVE expected
LI XDMN,QMBRRE
MDSOEM
FI
ELSE ;Write to file only
MDSOF
FI
L1():! ;Continue
OD
AS
DUNSTK XDZBE
ADDI XDZBE,2
CAIGE XDZBE,2*QBRN+LABB(DSZBRF)
GOTO TRUE
SA
BRANCH LAB(DSCM)
FI
;Error
LI XDMN,QMBREE ;End of input expected
MDSOEM
BRANCH LAB(DSCM)
PRINTX ENDD BREAKS
ENDD
SUBTTL DSCL CLOSE, SIMDDT main command routine
Comment;
Purpose: Close all open files except SYSIN and SYSOUT
or list any open file and stop to let the user
decide if it should be closed
Entry: DSCL
Normal exit: DSCM
Error exit: none
Used routines: DSCLOS,DSPSK,DSPM,MDSOFT and DSIFK
;
BEGIN
DSCL:
LI X5,1 ;Loop copied from .IOCLA in IO module
L1():! LI X1,YIOCHTB(XLOW)
HRLI X1,-^D16
DSTACK X5
LOOP ;Through channel table
;Get a file reference
edit(242)
HRRZ XWAC1,(X1) ;[242] Input side
SKIPE (XDSTK)
HLRZ XWAC1,(X1) ;[242] Output side first time
IF ;Command not suppressed and there is a file on the channel
IFON YDSSUP(XLOW)
GOTO FALSE
JUMPE XWAC1,FALSE
THEN
IFOFF ZFIOPN(XWAC1)
GOTO LAB(L9())
;File open
DSTACK X1
IF ;Not Sysin or Sysout
CAME XWAC1,YSYSIN(XLOW)
CAMN XWAC1,YSYSOU(XLOW)
GOTO FALSE
THEN
L5():! MDSPM QMCLFI ;FILE:
LI X1,XDMN-1
L XDMN,OFFSET(ZFINAM)(XWAC1)
DEXEC DSPSK ;File name
IF ;STOP CLOSE
IFOFFA YDSTOP
GOTO FALSE
THEN ;Output name and await answer
MDSOFT
MDSIT
LF X1,ZTVLNG(XDINT)
JUMPE X1,LAB(L2()) ;Do not close
DEXEC DSIFK
GOTO LAB(L3()) ;Error
CAIN X1,LAB(ZKWCLO)
GOTO LAB(L4()) ;Close file
L3():!
;Error not valid keyword close
LI XDMN,QMCLKE
DEXEC DSOFTM
MDSOFT
GOTO LAB(L5()) ;Try again
FI
DEXEC DSOCB
MDSOFM QMCLOD ;Output CLOSED
L4():! ;Close file
DEXEC DSCLOS
FI
L2():!
DUNSTK X1
FI
L9():!
AS
AOBJN X1,TRUE
SA
DUNSTK X5
SOJGE X5,LAB(L1())
SETON SDSCLO(XLOW) ;Indicate that CLOSE command has been given
BRANCH LAB(DSCM)
PRINTX ENDD CLOSE
ENDD
SUBTTL DSPR PROCEED, SIMDDT main command routine
Comment;
Purpose: Exit from SIMDDT
Normal exit: To RTS via RTS stack if DSINR or DSINI entry
Interpret user instruction and exit to user program if
DSINB entry
Skip return to RTS if continuation after error
Error exit: DSCM if continuation not possible
Used routines: DSVOM, DSCMI, DSTXGI
;
DSPR: ; PROCEED command
edit(304) ;[304] Check for non-blank directly following
LDB XDBYTE,LABB(YDSIPO)
IF ;Non-blank
CAIE XDBYTE,";"
CAIN XDBYTE," "
GOTO FALSE
JUMPE XDBYTE,FALSE
CAIN XDBYTE,QHT
GOTO FALSE
THEN ;Junk in command (tried Pnnnn command a la SOS?)
MOVSI XDBYTE,70000 ;Back up one step
ADD XDBYTE,LABB(YDSIPO) ;(should work normally)
LDB XDBYTE,XDBYTE ;Read previous char
CAIE XDBYTE,"P"
CAIN XDBYTE,"p"
BRANCH LAB(DSDP) ;Treat as DISPLAY statement
FI
edit(41) ;[41]
IF ;REENTER or error entry
IFONA YDSREE
GOTO TRUE
IFONA YDSDBG
GOTO FALSE
THEN ;Check if PROCEED is allowed
;Error mode proceed or REENTER
HLRZ XWAC1,LABB(YDSSENR)
LSH XWAC1,-5 ;Continuation code in ac field
IF ;Continuation code
JUMPE XWAC1,FALSE
THEN ;PROCEED allowed
IFOFFA YDSREE
CAIN XWAC1,QDSCON
GOTO LAB(DSPR04)
CAIN XWAC1,QDSNIN
GOTO LAB(DSPRIN)
GOTO LAB(DSPRIM)
FI
MDSVOM QMPRNA ;PROCEED not allowed
BRANCH LAB(DSCM) ;Get new command
FI
DSPR04:
edit(160)
HRRZ X0,LABB(YDSSENR) ;[160] Check for false debug
CAIN X0,QMRTSD ;[160] Error 212
SETOFA YDSDBG ;[160] Force error exit
SETZM LABB(YDSSENR) ;Reset flag [41] end
SETOFF SDSCLO(XLOW) ;[41] Reset switch if execution continues
edit(2) edit(242)
DEXEC DSPCSP ;[2] [242] Call INSPECT/START to reset variables
DSPR00: ;
SKIPGE XWAC1,YDSIFO(XLOW) ;[242] Close indirect command file if
DEXEC DSCLOI ; allocated temporarily
SKIPGE XWAC1,YDSUFO(XLOW) ;[242] Close USE file if special alloc.
MIOCLU ;[242]
DEXEC DSEXPR ;[2] Close any open display file
SETZM LABB(YDSCDL) ;[242]
SKIPE X1,LABB(YDSST0) ;[242] Restore channel zero status
SETSTS (X1) ;if saved
SETZM LABB(YDSST0) ;Clear to avoid confusion
L X1,YDSIAC(XLOW)
SETZM ,YDSIAC(XLOW)
SETOFF YDSACT(XLOW) ;SIMDDT not active
IF ;DSINI or DSINR was called
IFOFFA YDSSTA
GOTO FALSE
THEN RETURN;to RTS
edit(41)
ELSE ;[41] Error mode proceed or breakpoint return
IF ;Not debug mode
IFONA YDSDBG
GOTO FALSE
THEN ;Error mode proceed
AOS (XPDP)
RETURN ;Skip return to .OCUU
FI ;[41] End
FI
BEGIN
UNSTK (XPDP)
UNSTK (XPDP) ;Remove return addresses from RTS stack
;PROCEED after breakpoint
;Restore XIAC, note that static area cannot be used
L XIAC,X1
DSPR01: ;From interpreting XCT
;Remove indexing and indirection from breakpoint instr.
MOVEI XDTA,@LABB(YDSLEAVE)
DPB XDTA,LAB(<[POINT 23,LABB(YDSLEAVE),35]>)
LDB XDTC,LAB(<[POINT 4,LABB(YDSLEAVE),12]>)
LDB XDTA,LAB(<[POINT 9,LABB(YDSLEAVE),8]>)
;Check if instruction must be interpreted
CAIN XDTA,(<PUSHJ>/1000)
GOTO LAB(L2()) ;Interpret PUSHJ
CAIN XDTA,(<JSR>/1000)
GOTO LAB(L3())
CAIN XDTA,(<JSP>/1000)
GOTO LAB(L4())
CAIN XDTA,(<JSA>/1000)
GOTO LAB(L5())
MOVE XDTB,LABB(YDSLEAVE)
TRNN XDTA,700
GOTO LAB(L6()) ;Interpret UUO
CAIN XDTA,(<XCT>/1000)
GOTO LAB(L7()) ;Interpret XCT
DSPR03: ;
;Ordinary instruction and system UUO
MOVEI XDTA,LABB(YDSLEAVE) ;Execute instruction
HRLZI X1,320000 ;JUMP, NOOP instruction to X1
DSPR02: ;Entry if interpreted instruction
GOTO LABB(YDSBRETUR)
L7():! ;Interpret XCT
L XDTA,(XDTB)
MOVEM XDTA,LABB(YDSLEAVE) ;Replace XCT instruction with
;target instruction
GOTO LAB(DSPR01) ;Try again
L2():! ;Interpret PUSHJ
;Special restriction
;Accumulator is assumed to be XPDP
L X1,LAB(<[PUSH XPDP,@2+LABB(YDSLEAVE) ]>) ;YDSBCOM
GOTO LAB(L9())
L5():! ;Interpret JSA
;Only XCB,XPDP and XIAC allowed
L X1,LABB(YDSLEAVE) ;Fetch instruction
;Change JSA to MOVEM
AND X1,LAB(<[XWD 202777,777777 ]>)
XCT X1
L X0,@2+LABB(YDSLEAVE) ;Fetch pc
HRL X0,LABB(YDSLEAVE) ;E,pc
AOS ,LABB(YDSLEAVE) ;Return to E+1
L8():! ;Entry from JSP
L X1,XDTC
HRLI X1,202000 ;Create MOVEM X0,ac in X1
L9():! ;Exit for interpreted instructions
MOVE XDTA,LABB(YDSLEAVE)
GOTO LAB(DSPR02)
L3():! ;Interpret JSR
HRRZ XDTC,LABB(YDSLEAVE) ;E to XDTC instead of ac
AOS ,LABB(YDSLEAVE) ;Return is E+1
L4():! ;Interpret JSP
L X0,@2+LABB(YDSLEAVE) ;YDSCOM(XLOW)
GOTO LAB(L8())
L6():! ;Interpret UUO
CAIL XDTA,40
GOTO LAB(DSPR03) ;System UUO
;Do not interpret
MOVEM XDTB,40 ;Save UUO
MOVEI XDTB,41
GOTO LAB(L7())
DSPRIM: ;[41] Get new image and proceed
;First output old image
L XDADR,YUUOAC+XWAC1(XLOW)
LI XDTYP,QTEXT
SETOFA YDSSTRING
DEXEC DSPVNS
MDSOFT
;Message: GIVE NEW INPUT LINE
MDSVOM QMGNIL
;Output * and read new line from tty
DEXEC DSCMI
;Get image text pointer
L XWAC1,YUUOAC+XWAC1(XLOW)
;Get image text ref in XWAC2-3
LD XWAC2,(XWAC1)
;Call text.main
LI XTAC,XWAC2
MTXMN
;Update image to image.main
STD XWAC2,(XWAC1)
;Get new image text ref into XWAC4-5
LD XWAC4,(XDINT)
;Image.main:= new text
MTXVA
GOTO LAB(DSPR04) ;Return to continue
edit(41)
DSPRIN: ;[41] Get new integer argument and proceed
;Output message: GIVE NEW INTEGER ARGUMENT
MDSVOM QMGNIN
;Output * and read new line
DEXEC DSCMI
;Get integer from new line
MTXGI
BRANCH LAB(DSCM) ;Error in TXGI, get new command
ST XWAC1,YDSIAR(XLOW) ;Store new arg in YDSIAR
;Return to continue
GOTO LAB(DSPR04)
;[41] End
PRINTX ENDD PROCEED
ENDD
SUBTTL DSUS USE, SIMDDT main command routine
Comment;
Purpose: Initiate new output file
Entry: DSUS
Normal exit: DSCM
Error exit: -
Used routines: IOCL, IOLN, DSFSP, DSCF,
DSO, DSSCI, DSCRTU
;
BEGIN
edit(2) ;[2]
DSUS: ;USE command
edit(242)
repeat 0,<;[242] Leave test to DSCF
edit(41)
DEXEC DSCHGC ;[41]
GOTO LAB(L1()) ;Use not possible if REENTER entry
>
;Remove USE in input
SETZB X1,X2 ;Place blanks over USE in command
LF XDT4,ZTVCP(XDINT) ;[41]
DEXEC DSFSP ;Create file specification parameter
;Close any existing USE file
MIOCLU
;Check if USE file free
LD XWAC2,(XDINT)
LI XDRTSR,IOLN
DEXEC DSCRTU
IFONA YDSUFR
GOTO LAB(L1()) ;File error
LI XDMN,QMUSNA
JUMPL X2,LAB(L1()) ;TTY file
IF ;Old file
JUMPE X2,FALSE
THEN ;File already in use
IFON ZFITTY(X2)
GOTO LAB(L1()) ;TTY file already in use
IFOFF ZFIOF(X2)
GOTO LAB(L3()) ;File not output file
IF ;Error mode
IFONA YDSDBG
GOTO FALSE
THEN ;Change image pointer
LD XWAC2,ZTV%S(XDINT)
STD XWAC2,OFFSET(ZFIIMG)(X2)
ST X2,YDSUFO(XLOW)
GOTO LAB(L2()) ;Clear TTY flag
FI
LI XDMN,QMUSDB ;USE file already in use
L3():! MDSOTM
GOTO LAB(L1())
FI
;Simulate NEW Printfile
L X0,LAB(DSUS01)
DEXEC DSCF ;Create and open USE file
JUMPE XWAC1,LAB(L1()) ;Error
ST XWAC1,YDSUFO(XLOW) ;Save file object
HLLOS OFFSET(ZPFLP)(XWAC1) ;[300] Linesperpage(-1)
;USE file ok
L2():! SETOFA YDSTTY
SKIPA
L1():! ;Error found, clear YDSUFO
SETZM YDSUFO(XLOW)
SETOFA YDSUFR
ST XDSWIT,YDSWIT(XLOW)
BRANCH LAB(DSCM)
DSUS01: XWD -2,IOPF ;Parameters to CPNE call
ENDD
SUBTTL DSCH CHAIN, SIMDDT main command routine
Comment;
Purpose:
Output operating chain
starting with current block
Entry: DSCH
Normal exit: DSCVSR
Error exit: -
Used routines: DSPM, DSVO, DSO, DSSS, DSSSR, DSFA
;
BEGIN
DSCH: ;CHAIN command
DEXEC DSOSWS ;Set output switches
DSTACK LABB(YDSCZS)
L X0,LABB(YDSSZS)
ST X0,LABB(YDSCZS)
L XDZLN,LABB(YDSSZL)
ST XCB,LABB(YDSSBA) ;Current block address
LI XDMN,QMCHH ;Operating chain
MDSVOM ;Output heading
SETONA YDSCH
DEXEC DSRUC
DUNSTK LABB(YDSCZS)
BRANCH LAB(DSCVSR) ;Exit DSCH
ENDD
SUBTTL DSVA VARIABLES, SIMDDT main command routine
Comment;
Purpose: Scan the dynamic storage pool and output all
variables
Entries: DSVA all variables are output
[41] DSNA removed
Normal exit: DSCVSR
Error exit: -
Used routines: DSVO, DSOSWS, SAGC, DSFA, DSSSP, DSCT,
DSVIV, DSO, DSPSK, DSPV, DSTXPI, DSCHGC and DSVAR
;
BEGIN
edit(41) ;[41] DSNA removed
DSVA: ;VARIABLES command
;[41]
LI XDMN,QMVAH ;VARIABLES heading
L1():!
MDSVOM ;Output message
DEXEC DSOSWS ;Set output switches
DEXEC DSVAK ;[41]
BRANCH LAB(DSCVSR) ;[41] Exit if error in keyword after /
IF
IFOFFA YDSSGC ;[41] /-GC in command
DEXEC DSCHGC ;[41]
DSVA02: ;[41]
GOTO TRUE ;No G.C. if program interrupted
IFOFF SWNOGC(XLOW)
GOTO FALSE
THEN ;Garbage collection not done
MDSVOM QMVANG
ELSE ;Call garbage collector
SETZ X0, ;No new core needed
MSAGC
FI
;Search outermost block
L XDSTA,YOCXCB(XLOW)
L7():!
ST XDSTA,LABB(YDSSBA) ;Save address of block
edit(242)
CAMGE XDSTA,LABB(YDSVFA) ;[242] Output only if higher
GOTO LAB(L9()) ;[242] address than /START:aaa
edit(152)
LF X1,ZBIZPR(XDSTA) ;[152] Check if symbol table exists.
LF X1,ZPRSYM(X1) ;[152] May be switch procedure prototype
JUMPE X1,LAB(L9()) ;[152] Yes, skip this block
MDSFA
MDSVO ;Output block identification
LF X0,ZBIBNM(XDSTA) ;Find subblock level
L XDZLN,LABB(YDSCZS) ;Search only one entry
HRL XDZLN,X0 ;Put subblock state in call
LI X0,LAB(L3()) ;Address of subroutine as parameter to DSSS
;Find all variables in this block instance
LF X1,ZBIZPR(XDSTA)
DEXEC DSSSP
L9():! ;All subblocks scanned
L XDSTA,LABB(YDSSBA)
LOOP
LF XDTYP,ZDNTYP(XDSTA)
JUMPLE XDTYP,LAB(L8())
CAILE XDTYP,QZDNTM
GOTO LAB(L8()) ;Invalid type
IF
CAILE XDTYP,QZPB ;Last block instance type
GOTO FALSE
THEN
CAME XDSTA,LABB(YDSSBA)
GOTO LAB(L7()) ;New block instance
IF
CAME XDSTA,OFFSET(ZDRZPR)(XCB)
GOTO FALSE
THEN
L XDSTA,YSABOT(XLOW) ;Start of dynamic storage pool
SETZ X1, ;Use this block
ELSE
LF X1,ZBIZPR(XDSTA)
LF X1,ZPRBLE(X1) ;Find length
FI
ELSE
IF ;Temporary text variable
CAIE XDTYP,QZTT
GOTO FALSE
THEN
LI X1,ZTT%S ;Find length
ELSE
IF ;Accumulator stack
CAIE XDTYP,QZAC
GOTO FALSE
THEN
LF X1,ZACNAC(XDSTA)
ADDI X1,2+OFFSET(ZACSVA)
ELSE
LF X1,ZYSLG(XDSTA)
FI
FI
FI
;X1 contains dynamic record length
;Find next block
AS
edit(41)
IFON YDSSUP(XLOW) ;[41]
GOTO FALSE ;[41] Suppress output
ADD XDSTA,X1
CAMGE XDSTA,YSATOP(XLOW)
GOTO TRUE
SA
BRANCH LAB(DSCVSR) ;Exit DSVA
L8():!
LI XDMN,QMNATE ;[41] Type error
L6():! MDSVOM ;[41]
BRANCH LAB(DSCVSR)
edit(41)
DSVA01: ;[41] Entry from DSPVS routine
L3():! ;Subroutine called from DSSS
L XDZPR,-1(XDSTK)
DSTACK XDZLN
L XDADR,LABB(YDSSBA)
;[41] Output type procedure
IF ;Type procedure
LF X0,ZDNTYP(XDADR)
CAIE X0,QZBP
GOTO FALSE
LF XDTYP,ZPCTYP(XDZPR)
CAIN XDTYP,QNOTYPE
GOTO FALSE
THEN
DSTACK X1
LI XDADR,2(XDADR)
IF
MDSVIV
GOTO FALSE ;Initial value
THEN
DEXEC DSOCT
MDSPM QMVAPV
SETZ XDZSD,
DEXEC DSPVT
MDSVO
FI
DUNSTK X1
FI
WHILE
SKIPN ,X1
GOTO FALSE
IFOFF YDSSUP(XLOW) ;[41] Suppress output
SKIPN ,(X1)
GOTO FALSE ;No more symbols
DSTACK X1
DO
IF
MDSCT
JUMPL XDTYP,FALSE ;Type not handled by SIMDDT
THEN
ST XDTYP,LABB(YDSTYP);Save type
edit(2)
IF ;[2] Check for system procedure handled by SIMDDT
CAIE X0,QPROCEDURE
GOTO FALSE
THEN
DSTACK X0 ;Save X0
DSTACK X2 ;Save X2
EXCH X1,X2 ;Save X1 and load X2 with ZDS entry
L X1,LABB(YDSSBA) ;Load X1 with block inst. addr.
DEXEC DSSPV
L XDADR,X1 ;Address of var. into XDADR
EXCH X1,X2 ;Restore X1
DUNSTK X2 ;Restore X2
DUNSTK X0 ;Restore X0
ELSE
LF XDADR,ZSDOFS(X1)
ADD XDADR,LABB(YDSSBA) ;Address of variable
FI
IF ;NOT ARRAY
CAIN X0,QARRAY
GOTO FALSE
THEN
IF ;Not initial value
MDSVIV
GOTO FALSE
THEN
DEXEC DSOCT ;Insert tab
MDSPSK ;Output symbol name
L XDZSD,(XDSTK)
LF XDTYP,ZSDTYP(XDZSD)
DEXEC DSPVT
MDSVO
FI
ELSE
;Array symbol
IF
IFONA YDSSNA
GOTO FALSE ;Noarray command
edit(242)
L (XDADR) ;[242]
JUMPE FALSE ;[242]
CAIE NONE ;[242]
CAMGE LABB(YDSVFA) ;[242]
GOTO FALSE
THEN
DEXEC DSOCT ;Indent
DEXEC DSPAE ;Output array symbol
GOTO FALSE ;Skip subroutine
DSPAE: ;Subroutine
Comment;
Purpose: Output array identifier name and all
elements that do not have their initial value
Entry: DSPAE
Input arguments:X1 address of ZSD entry
YDSTYP type of array
XDADR address of array
-1(XDSTK) address of ZSD entry
Normal exit: DRETUR
Error exit: -
Output arguments: (XDSTK) address of ZSD entry
Used subroutines:DSPSK, TXPI, DSVO, DSO, DSVAR, DSVIV, DSPV,
;
;Output name with array bounds
MDSPSK ;Output symbol name
L XDADR,(XDADR) ;Fetch array address
LF XDT4,ZARSUB(XDADR)
DSTACK XDADR
LI X0,"["
LOOP OUTCHA
L XWAC3,ZARLOO(XDADR)
MTXPI ;Lower bound to outtext
LI X0,":"
OUTCHA
L XWAC3,ZARUPO(XDADR)
MTXPI ;Upper bound to text
AS
LI X0,","
ADDI XDADR,2
SOJG XDT4,TRUE
SA
LI X0,"]"
OUTCHA
MDSVO
;Restore XDADR and XDT4
L XDADR,(XDSTK)
LF XDT5,ZARLEN(XDADR)
ADD XDT5,XDADR ;Last element +1
DSTACK XDT5
;1 or 2 to stack i.e. element size
L XDTYP,LABB(YDSTYP)
LI X0,1
CAIE XDTYP,QTEXT
CAIN XDTYP,QLREAL
LI X0,2
DSTACK X0
MDSVAR ;Restore array pointers
LI XDADR,1(XDT3) ;Address first element
LOOP
;Check all array elements
IF
L XDTYP,LABB(YDSTYP)
MDSVIV
GOTO FALSE ;Initial value
THEN
;Print [ , , ..] value
;Create subscripts in stack
;Find array address
L X1,XDADR
MDSVAR
L XDZSD,XDT4 ;Save subscript
;counter
DSTACK X1 ;XDADR saved
MOVNI X0,1(XDT3)
ADD X0,(XDSTK)
IDIV X0,-1(XDSTK)
WHILE SOJLE XDT4,FALSE
DO
IDIV X0,(XDT3)
ADD X0,(XDT5)
DSTACK X0 ;Save subscript
L X0,X1
SUBI XDT5,2
SOJ XDT3,
OD
ADD X0,(XDT5)
;Print subscripts
L XWAC3,X0
IFOFFA YDSOAI
DEXEC DSOCT ;Two tabs if
DEXEC DSOCT ;VARIABLES command
LI X0,"["
LOOP
OUTCHA
MTXPI ;Subscript
DUNSTK XWAC3 ;Next subscript
AS
LI X0,","
SOJG XDZSD,TRUE
SA
LI X0,"]"
OUTCHA
L XDADR,XWAC3
L XDZSD,-4(XDSTK)
LF XDTYP,ZSDTYP(XDZSD)
DSTACK XDADR
DEXEC DSPV ;Output value
MDSVO
DUNSTK XDADR
FI
AS
edit(41)
IFON YDSSUP(XLOW) ;[41]
GOTO FALSE ;[41] Suppress output
ADD XDADR,(XDSTK) ;Next element
CAMGE XDADR,-1(XDSTK)
GOTO TRUE ;Check next
SA
;Remove stack entries
DUNSTK
DUNSTK
DUNSTK
DRETUR ;End of subroutine
FI
FI
FI
;Try next ZSD entry
DUNSTK X1
LF X0,ZSDTYP(X1)
SKIPGE ,(X1)
AOJ X1,
ADDI X1,2
CAIN X0,QREF
AOJ X1,
OD
DUNSTK XDZLN
DRETUR
PRINTX ENDD VARIABLES
ENDD
SUBTTL DSSC SCHEDULED, SIMDDT main command routine
Comment;
Purpose: Output all scheduled processes
Entry: DSSC
Normal exit: DSCVSR
Error exit: -
Used routines: DSOSWS, DSVO, DSO, DSPM, DSTXPR, DSFA and SUNE
;
DSSC: ;SCHEDULED command
LI XDMN,QMSCHN ;"NO SCHEDULED PROCESSES"
DEXEC DSOSWS ;Set output switches
edit(242)
HRRE YSULEV(XLOW) ;[242] Simulation block level
IF ;Simulation is active
JUMPE FALSE
LF X1,ZBIZPR(XCB)
LFE X1,ZPREBL(X1) ;Level of current block
CAMGE X0,X1
GOTO FALSE
XCT YSULEV(XLOW) ;Load Simulation block address
LF XDT2,ZBIZPR(XSAC)
LOOP LF X0,ZCPGCI(XDT2)
CAIN X0,QSUSI
GOTO LAB(L1()) ;Correct Simulation block
LF XDT2,ZCPZCP(XDT2)
AS JUMPN XDT2,TRUE
SA
GOTO FALSE ;No Simulation block
L1():!
LF XSAC,ZSUFT(XSAC) ;Event notice
LF XDSTA,ZEVZPS(XSAC) ;Fetch current process address
CAIN XDSTA,NONE
GOTO FALSE ;No scheduled processes
THEN
LI XDMN,QMSCH
MDSVOM ;Output heading SCHEDULED PROCESSES
LOOP
DEXEC DSOCT
LF X1,ZPSZEV(XDSTA)
DSTACK XDSTA
MDSPM QMSCEV
LF XWAC3,ZEVTIM(X1) ;Fetch evtime
SETZ XWAC4,
LI XWAC5,QNSDR
MTXPR ;Time to outtext
DEXEC DSOCT ;Tab to text
DUNSTK XDSTA
MDSFA ;Put identification
MDSVO ;Output text
AS
;Call SUNE
LI XTAC,XDSTA
MSUNE
edit(41)
IFON YDSSUP(XLOW) ;[41]
GOTO FALSE ;[41] Suppress output
CAIE XDSTA,NONE
GOTO TRUE ;Next event exists
SA
GOTO LAB(DSCVSR) ;Exit DSSC
FI
MDSVOM
GOTO LAB(DSCVSR)
SUBTTL DSPC INSPECT, SIMDDT main command routine
edit(2)
Comment;
[2]
Purpose: Change the current block pointer
Entry: DSPC
Normal exit: DSCM
Error exit: -
Used routines: DSSKBN,DSGI,DSFK,DSSCIR,DSNILV,DSLPR,DSOCT,
DSVO,DSPL,DSOEM and DSRU
;
BEGIN
DSPC: ;INSPECT
edit(242)
LI LAB(DSCM) ;[242] Default exit
DSTACK ;[242]
IF ;Switch follows
DEXEC DSSKBN
CAIE XDBYTE,"/"
GOTO FALSE
THEN ;Keyword expected
LI XDMN,QMPCCE
DEXEC DSGI
GOTO LAB(L1())
MDSFK
GOTOE XDZKW,LAB(L1())
IFNEQF (XDZKW,ZKWTYP,QZKWTC)
GOTO LAB(L1())
BRANCH @(XDZKW)
FI
;Object reference expected
DEXEC DSSCIR ;Reset input pointer
DEXEC DSNILV
GOTO LAB(L2()) ;Error found
;Check for object reference
LI XDMN,QMPCOR
L XDSTA,0(XDADR) ;Fetch block address
CAIE XDSTA,NONE ;Error if NONE
CAIE XDTYP,QREF
GOTO LAB(L1())
edit(41) ;[41]
LF XDT4,ZBIZPR(XDSTA) ;[242] Use actual qualification always
ST XDT4,LABB(YDSSQU) ;[242] Save actual qualification
DEXEC DSLPR ;Find prototype in ZLN table
IF ;Prototype was not found
JUMPN X1,FALSE
THEN ;Standard class, use dummy ZLN table for current block pointers
L X1,YDSZLA(XLOW)
LI XDT2,LAB(YDSZLS)
L XDT3,XDT2
SF XDT4,ZLNADF(XDT2) ;Save prototype of class in table
SF XDT2,ZLNADF(XDT2,2) ;Pointer to beginning of table
FI
L4():! ;Save environment
ST XDSTA,YDSSXCB(XLOW)
STD XDT2,LABB(YDSCZL)
ST X1,YDSZLN(XLOW)
HRRZ X0,(XDSTK) ;Return address
IF ;Called from PROCEED
CAIN X0,LAB(DSPR00)
THEN ;Return now
DRETURN
FI
L6():!
DEXEC DSOCT
MDSFA ;Output identification
L5():!
DEXEC DSVO
DEXEC DSPCL
GOTO LAB(L2())
edit(41)
DSPCL: ;[41] Used from DSPVS
;Output line identification for current line
DEXEC DSOCT
MDSPM QMPCLI
L X1,LABB(YDSCZL)
edit(154)
IF ;[154] There is a line no table
JUMPE X1,FALSE
THEN ;Find source line
LOOP
AS
SKIPGE 1(X1)
AOJA X1,TRUE
SA
LF XDSTA,ZLNADR(X1,1) ;Fetch first available line number address
ELSE ;No address found
LI XDSTA,0
FI ;[154]
MDSPL
;[41]
DEXEC DSVO
DRETUR
L2():! MDSRBD ;Release any dummy ZBR records
DEXEC DSSKBN
LI XDMN,QMATEI
JUMPN XDBYTE,LAB(L1()) ;End of input expected
edit(242)
DRETURN ;[242] Exit DSPC
L1():! MDSOEM
GOTO LAB(L2())
DSPCST: ;INSPECT/START
edit(242)
LI LAB(DSPCSM) ;[242] Alternate return via L4()
ST (XDSTK) ;[242]
DSPCSP: ;[242] Entry from PROCEED
;Fetch initial environment
L XDSTA,XCB
LD XDT2,LABB(YDSSZL)
L X1,LABB(YDSSZE)
GOTO LAB(L4()) ;Save environment
DSPCSM: ;[242] Repeats initial SIMDDT message
IFONA YDSREE
BRANCH LAB(DSINRM) ; for REENTER
IFOFFA YDSDBG
BRANCH LAB(DSINEM) ; or ERROR mode
BRANCH LAB(DSCM)
DSPCRT: ;INSPECT/RESET
L XDSTA,YDSRXCB(XLOW)
LD XDT2,LABB(YDSRZL)
L X1,LABB(YDSRZE)
GOTO LAB(L4()) ;Save environment
DSPCRN: ;INSPECT/RETURN
;Save environment
L X0,YDSSXCB(XLOW)
ST X0,YDSRXCB(XLOW)
LD XDT2,LABB(YDSCZL)
STD XDT2,LABB(YDSRZL)
L X0,YDSZLN(XLOW)
ST X0,LABB(YDSRZE)
SETONA YDSRE
SKIPA
DSPCUP: ;INSPECT/UP
SETONA YDSUP
DEXEC DSRU
L XDSTA,YDSSXCB(XLOW)
LF X0,ZTVCP(XDINT,ZTV%S)
JUMPE X0,LAB(L6()) ;Outermost block, old environment again
GOTO LAB(L5()) ;Print new block
ENDD
SUBTTL DSAL ALL, SIMDDT main command routine
DSAL: ;ALL command
SETONA YDSALL ;ALL command active
DEXEC DSCH
DEXEC DSVA
DEXEC DSSC
edit(41) ;[41]
BRANCH LAB(DSCM) ;Accept next command
DSCVSR: ;Exit from DSAL,DSSC,DSVA and DSCH command routines
edit(242)
SETZM LABB(YDSVFA) ;[242]
IFOFFA YDSALL
BRANCH LAB(DSCM) ;Accept new command
DRETUR ;Return to DSAL
SUBTTL DSEX EXIT, SIMDDT main command routine
Comment;
Purpose: Exit from SIMDDT and stop
program execution
Entry: DSEX
Normal exits: Exit to OCEP if SIMDDT in debug mode
Exit via SIMRTS stack if SIMDDT in error mode
Error exit: -
Used routines: DSCLOS, DSCLOU, DSEXPR
;
DSEX: ;EXIT command
edit(41) ;[41] Close any open input file
L XWAC1,YDSIFO(XLOW)
DEXEC DSCLOS ;[41]
;Close open USE file
MIOCLU
;Set off switches
edit(2)
DEXEC DSEXPR ; [2] Close any open display file
SETOFF YDSACT(XLOW) ;SIMDDT not active any longer
SETZM ,LABB(YDSSENR) ;[41]
IFONA YDSDBG
BRANCH OCEP ;Debug exit
RETURN ;To RTS
SUBTTL DSNOPR, SIMDDT main routine
edit(41)
Comment;
[41]
Purpose:
To enable use of critical commands in REENTER mode and other cases
where PROCEED is disallowed. It will not be possible to continue
execution after this command is given.
;
DSNOPR:
SETZM ,LABB(YDSSENR) ;Forbid PROCEED command
BRANCH LAB(DSCM)
SUBTTL DSGET, input from file, SIMDDT main routine
Comment;
Purpose: To get input from a file instead of from the tty
Command is @ file specification
Entry: DSGET
Normal exit: DSCM
Error exit: -
Used routines: DSCHGC, DSCLOS, DSFSP and DSCF
;
BEGIN
edit(41)
DSGET: ;[41]
edit(242)
repeat 0,<;[242]
DEXEC DSCHGC
BRANCH LAB(DSCM)
>
DEXEC DSCLOI ;[242] Close any old command file
SETZB X1,X2
LF XDT4,ZTVCP(XDINT)
DEXEC DSFSP ;Create file specification parameters
L X0,LAB(<[XWD -2,IOIN]>)
DEXEC DSCF
DSGET1: ;Used in DSCF
JUMPE XWAC1,LAB(DSCM) ;Error, use TTY
ST XWAC1,YDSIFO(XLOW)
SETOFA YDSITTY
ST XDSWIT,YDSWIT(XLOW) ;Indicate file input
BRANCH LAB(DSCM)
ENDD
SUBTTL DSIE and DSNOTI, SIMDDT main routines
DSNOTI: ;Not implemented commands
MDSOTM QMNIMP
BRANCH LAB(DSCM)
DSTERM: ;SIMDDT termination error
;Implementation error
DSIE: ;Entry after implementation errors, i.e. ASSERT failure
LI XDSTK,LABB(DSZBRK) ;Restore SIMDDT stack
MDSOTM QMTERM ;Outfile may be wrong!
MDSOTM QMINER
BRANCH OCEP ;Exit if termination error