PDP-10 Archive: 7-sources/debtop.mac from BB-H138F-BM

Trailing-Edge - PDP-10 Archives - BB-H138F-BM_1988 - 7-sources/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