Google
 

Trailing-Edge - PDP-10 Archives - 704rmsf2 - 10,7/rms10/rmssrc/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
SEARCH	RMSMAC,RMSINT
$PROLOG(DEB)
SEARCH	CPASYM

$IMPURE
$DATA	(IPBBLK,6)
$DATA	(STACK,200)
$DATA	(USERAC,20)				;SPACE FOR USER'S REGS

SYN $GDATA,DCL$GL				;DCL RMSMES SPACE
DC$MES

; 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 200,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
	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

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	(%$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	(%$MESSAGE)
	$MESSAGE
	JRST	START

$CASE	(%$NOMESSAGE)
	$NOMESSAGE
	JRST	START

$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
	JUMPF	L$ERRU(NNK)		;NAME NOT KNOWN
	MOVEM	T1,PB			;SETUP CURR BLK
	RETURN
$ENDUTIL
$ENDMAIN
$ENDSCOPE(TOP-LEVEL)

END