Trailing-Edge
-
PDP-10 Archives
-
CFS_TSU04_19910205_1of1
-
update/t20src/debtop.mac
There are 7 other files named debtop.mac in the archive. Click here to see a list.
TITLE DEBTOP - TOP-LEVEL CODE OF RMSDEB
SUBTTL S. COHEN
;
; COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1984, 1986.
; ALL RIGHTS RESERVED.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND
; COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH
; THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR
; ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE
; AVAILABLE TO ANY OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE
; SOFTWARE IS HEREBY TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
; NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
; EQUIPMENT CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF
; ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
;
;
; Edit 510 -- Add $Parse, $Search, and $Rename
; Edit 577 -- Make $Rename type correct error code when it fails
; -- Add TRACE, NOTRACE, and $FREE
;
SEARCH RMSMAC,RMSINT
$PROLOG(DEB)
SEARCH CPASYM
SEARCH CMDPAR
STKSIZ=1000
LOC 137 ;VERSION #
$VERS
$IMPURE
$DATA (IPBBLK,6)
$DATA (STACK,STKSIZ)
$DATA (USERAC,20) ;SPACE FOR USER'S REGS
SYN $GDATA,DCL$GL ;DCL RMSMES SPACE
DC$MES
DC$MS2
; ERROR MESSAGES
;
$FMT (DB.BSI,<?DEBBSI byte size of datafield invalid for input>)
$FMT (DB.CIE,<? ,-CA%ASZ>)
$FMT (DB.FNU,<%DEBFNU FAB name unknown -- proceeding with initial-values FAB>)
$FMT (DB.IER,<?DEBIER internal error>)
$FMT (DB.ISC,<?DEBISC invalid syntax in command>)
$FMT (DB.IVF,<?DEBIVF invalid value in field>)
$FMT (DB.NAD,<?DEBNAD name already defined>)
$FMT (DB.NND,<%DEBNND ,-CA%R50, not DEFINEd>)
$FMT (DB.NNK,<?DEBNNK name not known>)
$FMT (DB.NNR,<?DEBNNR argblk name not a RAB>)
$FMT (DB.NPS,<?DEBNPS no position specified for datafield>)
$FMT (DB.NRC,<?DEBNRC no RAB current>)
$FMT (DB.RNC,<?DEBRNC RAB does not point to FAB>)
$FMT (DB.RMF,<[ RMS failure return: status=,-CA%NUM,/,-CA%OCT, ]>)
$FMT (DB.TMV,<?DEBTMV too many values specified>)
$FMT (DB.TFU,<?DEBTFU name table full -- no more DEFINEs allowed>)
$FMT (DB.VOF,<?DEBVOF value would overflow buffer>)
$FMT (DB.WDT,<?DEBWDT value has wrong data type>)
SUBTTL TOP-LEVEL CODE
$PURE
$SCOPE (TOP-LEVEL)
$LREG (PB)
DEFINE $$CPON(X)<DB.> ;REDEF COMPON NAME SO ALLS GLOBS DOTTED
$MAIN ;GEN ONE-TIME CODE
RMSDEB:: ;ENTER RMSDEB FROM DDT BY TYPING RMSDEB$G
MOVEM P,USERAC+P ;SAVE USER'S REGS -- P 1ST
MOVEI P,USERAC ;[0=SRC,,USERAC=DEST]
BLT P,USERAC+AP ;SAVE THE REST
MOVE P,[IOWD STKSIZ,STACK] ;USE PRIVATE STACK
MOVEM 17,15 ;SET FRAME PTR
ADJSP 17,3 ;HOP OVER FRAME HDR
$EH (CMDFAIL) ;SETUP ABORT LABEL
$RMS ;INSURE RMS IS AROUND
$CALL M.INIT ;INIT MEM MGR
; $CALL P$INIT ;INIT PARSER (PARSE$ WILL AUTO DO)
START:
MOVEI S1,PAR.SZ ;# OF WDS IN PARSE BLK
MOVEI S2,DB.CMD## ;PT TO PARSE BLK
$CALL PARSE$ ;DO ACTU PARSING
JUMPT L$IFX
MOVE S1,PRT.FL(S2) ;GET THE FLAGS
TXNE S1,P.ENDT ;END OF TAKE?
JRST START ;YES
$CALLB TX$TOUT,<[DB.CIE],PRT.EM(S2)> ;PUT OUT TEXT
JRST START
$ENDIF
$P (KEYW) ;GET THE COMMAND-NAME TOKEN
CASES S1,MX% ;DISPATCH TO COMMAND PROCESSOR
CHKERR: ;PUT OUT RMS ERR STATUS CODES
$FETCH T2,STS,(PB) ;GET STATUS FROM BLOCK
SUBI T2,ER$MIN ;MAKE AN OFFSET
$FETCH T3,STV,(PB) ;DITTO 2NDARY VALUE
$CALLB TX$TOUT,<[DB.RMF],T2,T3> ;?DEBRMF RMS FAILURE RETURN: STATUS=STS/STV
$FETCH T2,STS,(PB) ;GET STATUS FROM BLOCK
$FETCH T3,STV,(PB) ;DITTO 2NDARY VALUE
$CALLB R$MESSAGE##,<T2,T3,[0]> ;PRINT TEXT OF ERROR MESSAGE ;A542
POPJ P, ;ERCAL TO CHKERR
CMDFAIL:
$EH (CMDFAIL) ;RESTORE IT
JRST START
SUBTTL RMSDEB DISPATCH CODE
$CASE (%TAKE)
JRST START ;START EATING FROM TAKE FILE
$CASE (%ASSIGN)
$CALL DO.ASSIGN ;GO DO THE REAL WORK
JRST START
$CASE (%CHANGE)
$CALL DO.CHANGE ;GO DO THE REAL WORK
JRST START
$CASE (%DDT)
$CALL DO.DDT ;DO OS DEP STUFF
HRRZM T1,STACK ;SAVE DDT LOC
MOVSI P,USERAC ;[SRC=USERAC,,DEST=0]
BLT P,AP ;MOVE EACH AC
MOVE P,USERAC+P ;FINALLY HIS STACK PTR
JRST @STACK ;GO TO DDT
$CASE (%DEFINE)
$CALL DO.DEFINE ;GO DO THE REAL WORK
JRST START
$CASE (%DISPLAY)
$CALL DO.DISPLAY ;GO DO THE REAL WORK
JRST START
$CASE (%EXIT)
$CALL DO.EXIT ;GO DO THE REAL WORK
JRST START
$CASE (%HELP)
$CALL DO.HELP ;GO DO THE REAL WORK
JRST START
$CASE (%INFORMATION)
$CALL DO.INFORMATION ;GO DO THE REAL WORK
JRST START
$CASE (%UNDEFINE)
$CALL DO.UNDEFINE ;GO DO THE REAL WORK
JRST START
$CASE (%TRACE)
$DEBUG 400000
JRST START
$CASE (%NOTRACE)
$DEBUG 0
JRST START
SUBTTL THE VERB PROCESSORS
$CASE (%$OPEN)
$CALL REDBLK ;READ BLOCK
$OPEN <(PB)>,CHKERR ;INSTR TO BE MODIFIED
JRST START ;START OVER
$CASE (%$CREATE)
$CALL REDBLK ;READ BLOCK
$CREATE <(PB)>,CHKERR
JRST START
$CASE (%$CONNECT)
$CALL REDBLK
$CONNECT <(PB)>,CHKERR
JRST START
$CASE (%$DISCONNECT)
$CALL REDBLK
$DISCONNECT <(PB)>,CHKERR
JRST START
$CASE (%$CLOS)
$CALL REDBLK ;GET BLOCK
$CLOSE <(PB)>,CHKERR ;CLOSE
JRST START
$CASE (%$GET)
$CALL REDBLK ;GET RAB
$GET <(PB)>,CHKERR
JRST START
$CASE (%$PUT)
$CALL REDBLK ;GET RAB
$PUT <(PB)>,CHKERR
JRST START
$CASE (%$READ)
$CALL REDBLK ;GET RAB
$READ <(PB)>,CHKERR
JRST START
$CASE (%$WRITE)
$CALL REDBLK ;GET RAB
$WRITE <(PB)>,CHKERR
JRST START
$CASE (%$UPDATE)
$CALL REDBLK ;GET RAB
$UPDATE <(PB)>,CHKERR
JRST START
$CASE (%$DELETE)
$CALL REDBLK
$DELETE <(PB)>,CHKERR
JRST START
$CASE (%$FIND)
$CALL REDBLK
$FIND <(PB)>,CHKERR
JRST START
$CASE (%$TRUNCATE)
$CALL REDBLK
$TRUNCATE <(PB)>,CHKERR
JRST START
$CASE (%$DISPLAY)
$CALL REDBLK ;READ THE FAB
$DISPLAY <(PB)>,CHKERR
JRST START
$CASE (%$ERASE)
$CALL REDBLK ;READ THE FAB
$ERASE <(PB)>,CHKERR
JRST START
$CASE (%$FLUSH)
$CALL REDBLK ;READ THE RAB
$FLUSH <(PB)>,CHKERR ;DO THE FLUSH
JRST START ;OK
$CASE (%$FREE)
$CALL REDBLK ;READ THE RAB
$FREE <(PB)>,CHKERR ;DO THE FREE
JRST START ;OK
$CASE (%$MESSAGE)
$MESSAGE
JRST START
$CASE (%$NOMESSAGE)
$NOMESSAGE
JRST START
$CASE (%$PARSE)
$CALL REDBLK
$PARSE <(PB)>,CHKERR
JRST START
$CASE (%$SEARCH)
$CALL REDBLK
$SEARCH <(PB)>,CHKERR
JRST START
$CASE (%$RENAME) ;A510vv
$CALL REDBLK
PUSH P,PB
$CALL REDBLK
POP P,T2 ;m577
EXCH PB,T2 ;Put old FAB in PB for error routine ;a577
$RENAME <(PB)>,CHKERR,<(T2)> ;m577
JRST START ;a510^^
$UTIL (REDBLK)
;
; REDBLK - DERIVE BLK PTR FROM ARGBLK NAME IN CMD LINE
; RETURNS:
; PB = PTR TO ARGBLK
$P (FLD) ;ACCESS TOKEN STREAM
; MOVEM T1,T5 ;MAKE FLD NAME PASSABLE
; $CALL SY.FIND,<TK.VAL(T5)> ;LOCATE SYMBOL
; The way $CALL passes arguments changed. SY.FIND did not
MOVEI T1,TK.VAL(T1) ;POINT TO NAME ;M510
$CALL SY.FIND ;LOCATE SYMBOL ;M510
JUMPF L$ERRU(NNK) ;NAME NOT KNOWN
MOVEM T1,PB ;SETUP CURR BLK
RETURN
$ENDUTIL
$ENDMAIN
$ENDSCOPE(TOP-LEVEL)
END