Google
 

Trailing-Edge - PDP-10 Archives - cuspbinsrc_2of2_bb-fp63b-sb - 10,7/rms10/rmssrc/debact.mac
There are 7 other files named debact.mac in the archive. Click here to see a list.
TITLE	DEBACT - ACTION ROUTINES FOR RMSDEB
SUBTTL	S. COHEN
SEARCH	 RMSMAC,RMSINT
$PROLOG(DEB)
DEFINE $$CPON(X)<DB.>			;;FORCE MSG NAME DOTTED

; $RF - MACRO TO ALLOCATE RMS ARGBLK-FIELD DESCRIPTOR
;
DEFINE	$RF (PREFIX,NAME,VALUE),<
	ZZ==0
	IRP VALUE,<ZZ==ZZ+1>		;;COUNT # OF VALUES
	IFNDEF RF.'NAME,<RF.'NAME::>
	F$$'NAME(PB)			;;BYTE PTR TO FLD
	XWD	ZZ,F.'NAME		;;COUNT,,FMT INFO
	ASCIZ/NAME/			;;SO NAME OF FIELD CAN BE PRINTED
	IRP VALUE,<XWD [ASCIZ/VALUE/],PREFIX'$'VALUE>
>

DEFINE $SH(FLD$)<<RF%'FLD$_9>>	;;KLUDGE TO SET TYP/FLAG AT SAME TIME

;COMMON $RF FIELDS
;
F.STS==DT%OCT
F.STV==DT%OCT
F.BID==$SH(INV)
F.BLN==$SH(INV)

SUBTTL	IMPURE STORAGE

SZ%KBUF==20				;WDS IN KEY BUF
SZ%ARB==1600
SZ%DDT==200
$IMPURE
$DATA	(ARBCURR)			;CURR ADDRESS IN PRIVATE ARGBLK TABLE
$DATA	(ARBTAB,SZ%ARB)			;SPACE FOR PRIVATE ARGBLK TABLE
$DATA	(ARYNAM)			;PTR TO ARRAY NAME
$DATA	(ARYIDX)			;CURR EL OF ARRAY TO DISP
$DATA	(CRABNM)			;CURR RAB'S NAME IN R50
$DATA	(CURRAB)			;PTR TO LAST PROCESSED RAB
$DATA	(CPOSIT)			;CURR POSITION FOR DATAFLDS
$DATA	(CSTYPE)			;CURR STRING DATA TYPE
$DATA	(DDCURR)			;CURR ADDRESS IN PRIVATE SYMTAB
$DATA	(DDTAB,SZ%DDT)			;SPACE FOR PRIVATE SYMTAB
$DATA	(POSIT)				;CURR POS FOR DEFINE DATAFIELD
$DATA	(R50VAL)			;SYMBOL IN RADIX50
$DATA	(STRIPT,2)			;SPACE FOR STRING PTR

KEYINI:
	$INIT	(UF)
	$SET	(UF.BID,DA$TYP)		;SO COMPAT WITH ARGBLKS
	$SET	(UF.BLN,SZ%UF)		;SO COMPAT WITH ARGBLKS
	$SET	(UF.POS,0)		;ALWAYS BEGINNING OF KEY BUF
	$ENDINIT

$PURE
DISSTR:	$FMT(,<-CA%STP>)
FNACOL:	$FMT(,<-CA%ASZ,: ,-CA%NOCR>)
FABINF:	$FMT(,<-CA%R50,	FAB	  ,-CA%ASZ,-CA%ASZ>)
RABINF:	$FMT(,<-CA%R50,	RAB	  ,-CA%ASZ>)
XABINF:	$FMT(,<-CA%R50,	,-CA%ASZ, XAB>)
DAIINF:	$FMT(,<-CA%R50,	,-CA%ASZ,	  ,at W,-CA%NUM>)
DASINF:	$FMT(,<-CA%R50,	,-CA%ASZ,	  ,B,-CA%NUM, thru B,-CA%NUM>)
CONFCR:	$FMT(,<Current RAB is  ,-CA%R50>)
CONFNC:	$FMT(,<No current RAB>)
CONFDD:	$FMT(,<DEFINE DATA default is  ,-CA%ASZ, at ,-CA%NUM>)

ARYFMT:	$FMT(,<-CA%ASZ,-CA%NUM,: ,-CA%NUM>)

DABFMT:					;FMT STATS FOR SIMPLE DISPLAY CASES
					;IMPORTANT: 1ST 5 ENTRIES IN DT STRUCT
DABDEC:	[$FMT(,<-CA%NUM>)]		;DT%DEC
	[$FMT(,<-CA%DT>)]		;DT%DATE
DABOCT:	[$FMT(,<-CA%OCT>)]		;DT%OCT
	[$FMT(,<-CA%ASZ>)]		;DT%STR
	[$FMT(,<-CA%OCT>)]		;DT%SYA

BPWVEC:	EXP	5,0,6			;BYTES/WD BY STRING TYPE

XABTYP:
	[ASCIZ/KEY/]
	[ASCIZ/AREA/]
	[ASCIZ/DATE/]
	[ASCIZ/SUMMARY/]
DATTYP:
	[ASCIZ/ASCII/]
	[ASCIZ/F-BYTES/]
	[ASCIZ/SIXBIT/]
	[ASCIZ/DECIMAL/]
	[ASCIZ/OCTAL/]

SUBTTL	FAB FIELD DESCRIPTORS

FB$ALL==FB$ALL		;GET+PUT+DEL+TRN+UPD

FABTAB:	$RF	(FB,BID)
	$RF	(FB,BLN)
	$RF	(FB,STS)
	$RF	(FB,STV)
	$RF	(FB,BKS)
	$RF	(FB,BSZ)
	$RF	(FB,DEV,<CCL,MDI,REC,SQD,TRM>)
	$RF	(FB,FAC,<DEL,GET,PUT,TRN,UPD>)
	$RF	(FB,FNA)
	$RF	(FB,FOP,<CIF,DFW,DRJ,SUP,WAT>)
	$RF	(FB,IFI)
	$RF	(FB,JFN)
	$RF	(FB,JNL)
	$RF	(FB,MRN)
	$RF	(FB,MRS)
	$RF	(FB,ORG,<SEQ,REL,IDX>)
	$RF	(FB,RAT,<BLK>)
	$RF	(FB,RFM,<VAR,STM,LSA,FIX>)
	$RF	(FB,SHR,<DEL,GET,PUT,TRN,UPD>)
	$RF	(FB,XAB)
	Z				;END OF TABLE

;FLAGS FOR $RFS IN FAB

F.FOP==DT%SYB	;OPT IS DEFINED IN CALL
F.ORG==DT%SYV		;SAME
F.FAC==DT%SYB
F.SHR==DT%SYB
F.RAT==DT%SYB
F.MRS==DT%DEC
F.BSZ==DT%DEC
F.BKS==DT%DEC
F.DEV==DT%SYB
F.JFN==DT%OCT
F.IFI==$SH(INV)
F.FNA==DT%STR
F.MRN==DT%DEC
F.RFM==DT%SYV
F.JNL==$SH(INV)
F.XAB==DT%SYA

SUBTTL	$RF DESCRIPTORS FOR RAB

RABTAB:	$RF	(RB,BID)
	$RF	(RB,BLN)
	$RF	(RB,STS)
	$RF	(RB,STV)
	$RF	(RB,BKT)
	$RF	(RB,FAB)
	$RF	(RB,ISI)
	$RF	(RB,KBF)
	$RF	(RB,KRF)
	$RF	(RB,KSZ)
	$RF	(RB,LSN)
	$RF	(RB,MBF)
	$RF	(RB,PAD)
	$RF	(RB,RAC,<SEQ,KEY,RFA>)
	$RF	(RB,RBF)
	$RF	(RB,RFA)
	$RF	(RB,ROP,<EOF,FDL,KGE,KGT,LOA,LOC,NRP,PAD,RAH,WBH>)
	$RF	(RB,RSZ)
	$RF	(RB,UBF)
	$RF	(RB,USZ)
	Z			;END OF TABLE

;FLAGS FOR $RF MACROS IN RAB

F.ROP==DT%SYB
F.USZ==DT%DEC
F.RSZ==DT%DEC
F.KBF==$SH(BUF)!DT%OCT
F.UBF==$SH(BUF)!DT%OCT
F.RAC==DT%SYV
F.RFA==DT%OCT
F.RBF==$SH(BUF)!DT%OCT
F.ISI==DT%OCT
F.FAB==DT%SYA
F.KRF==DT%DEC
F.KSZ==DT%DEC
F.MBF==DT%DEC
F.LSN==DT%DEC
F.BKT==DT%DEC
F.PAD==DT%OCT

SUBTTL	$RF DESCRIPTORS FOR XAB

XABTAB:				;FOR DISPLAY ENTIRE-ARGLBK DISPATCH
	XABKEY
	XABAREA
	XABDAT
	XABSUM

XABKEY:	$RF	(XB,BID)
	$RF	(XB,BLN)
	$RF	(XB,COD,<SUM,KEY,AREA,DATE>)
	$RF	(XB,NXT)
	$RF	(XB,DAN)
	$RF	(XB,DFL)
	$RF	(XB,DTP,<EBC,SIX,STG>)
	$RF	(XB,FLG,<CHG,DUP>)
	$RF	(XB,IAN)
	$RF	(XB,IFL)
	$RF	(XB,KNM)
	$RF	(XB,POS)
	$RF	(XB,PS1)
	$RF	(XB,PS2)
	$RF	(XB,PS3)
	$RF	(XB,PS4)
	$RF	(XB,PS5)
	$RF	(XB,PS6)
	$RF	(XB,PS7)
	$RF	(XB,REF)
	$RF	(XB,SIZ)
	$RF	(XB,SZ1)
	$RF	(XB,SZ2)
	$RF	(XB,SZ3)
	$RF	(XB,SZ4)
	$RF	(XB,SZ5)
	$RF	(XB,SZ6)
	$RF	(XB,SZ7)
	BLOCK	SZ%RF		;END OF XAB KEY TAB (WHOLE BLK TO TERM ARR DISP)
	RF.PS0==:RF.POS
	RF.SZ0==:RF.SIZ

XABARE:	$RF	(XB,BID)
	$RF	(XB,BLN)
	$RF	(XB,COD,<SUM,KEY,AREA,DATE>)
	$RF	(XB,NXT)
	$RF	(XB,AID)
	$RF	(XB,BKZ)
	Z			;END OF XAB ALL TABLE

XABDAT: $RF (XB,BID)
	$RF (XB,BLN)
	$RF	(XB,COD,<SUM,KEY,AREA,DATE>)
	$RF	(XB,NXT)
	$RF (XB,CDT)		
	$RF (XB,EDT)		
	$RF (XB,RDT)		
	Z			;END OF XAB DAT TABLE

;FILE SUMMARY XAB DEFINITIONS
XABSUM: $RF (XB,BID)
	$RF (XB,BLN)
	$RF	(XB,COD,<SUM,KEY,AREA,DATE>)
	$RF	(XB,NXT)
	$RF	(XB,NOA)	;NUMBER OF AREAS
	$RF	(XB,NOK)	;NUMBER OF KEYS
	Z			;END OF XAB DAT TABLE

;FLAGS FOR FIELDS IN XAB

F.AID==DT%DEC
F.COD==DT%SYV
F.NXT==DT%SYA
F.DTP==DT%SYV
F.FLG==DT%SYB
F.REF==DT%OCT
F.IAN==DT%OCT
F.DAN==DT%OCT
F.IFL==DT%DEC
F.DFL==DT%DEC
F.NOA==DT%DEC
F.NOK==DT%DEC
F.KNM==DT%STR
F.POS==$SH(ARY)!DT%DEC
F.SIZ==$SH(ARY)!DT%DEC
F.PS1==$SH(ARY)!$SH(INV)!DT%DEC
F.PS2==$SH(ARY)!$SH(INV)!DT%DEC
F.PS3==$SH(ARY)!$SH(INV)!DT%DEC
F.PS4==$SH(ARY)!$SH(INV)!DT%DEC
F.PS5==$SH(ARY)!$SH(INV)!DT%DEC
F.PS6==$SH(ARY)!$SH(INV)!DT%DEC
F.PS7==$SH(ARY)!$SH(INV)!DT%DEC
F.SZ1==$SH(ARY)!$SH(INV)!DT%DEC
F.SZ2==$SH(ARY)!$SH(INV)!DT%DEC
F.SZ3==$SH(ARY)!$SH(INV)!DT%DEC
F.SZ4==$SH(ARY)!$SH(INV)!DT%DEC
F.SZ5==$SH(ARY)!$SH(INV)!DT%DEC
F.SZ6==$SH(ARY)!$SH(INV)!DT%DEC
F.SZ7==$SH(ARY)!$SH(INV)!DT%DEC
F.BKZ==DT%DEC

;FLAG DEFINITIONS FOR DATE XAB:
F.CDT==DT%DAT		;THIS IS A DATE FIELD
F.RDT==DT%DAT		;THIS IS A DATE FIELD
F.EDT==DT%DAT		;THIS IS A DATE FIELD

SUBTTL	INITIALIZED STORAGE FOR EACH TYPE OF ARG BLK

FLDINI:
	$INIT	(UF)
	$SET	(UF.BID,DA$TYP)		;SO COMPAT WITH ARGBLKS
	$SET	(UF.BLN,SZ%UF)		;SO COMPAT WITH ARGBLKS
	$ENDINIT
FABINI:
	FAB$B
	F$SHR	FB$NIL
	F$MRS	^D250
	F$BSZ	7
	FAB$E
RABINI:
	RAB$B
	R$KSZ	^D30
	RAB$E
XKINI:
	XAB$B	(KEY)
	X$DTP	XB$STG
	X$SIZ	1
	XAB$E
XAINI:
	XAB$B	(ALL)
	X$BKZ	1
	X$AID	1
	XAB$E
XDINI:
	XAB$B	(DAT)
	XAB$E
XSINI:
	XAB$B	(SUM)
	XAB$E

XABINI:				;INIT BLK ACCESSED INDEXED THRU XABINI
	XKINI
	XAINI
	XDINI
	XSINI

SUBTTL	PROCESS ASSIGN, CHANGE, AND DEFINE DEFINE CMD

$SCOPE	(DEFINE-BLOCK)
$LREG	(DD)				;PTR TO ENTRY IN (DDT-LIKE) SYMTAB
$LREG	(PB)				;PTR TO CURR RMS ARG BLK
$LREG	(RF)
$LREG	(P1)
$LREG	(P2)
$LREG	(IB)
$LOCALS
 $WORD	(BUFADD)			;ADDRESS OF BUFF TO USE IN EATDAT
 $WORD	(CHADAT)			;ON IF CHANGE DATA FLD
$ENDLOC

$PROC	(DO.ASSIGN)
;
; DO.ASSIGN = INIT BLK FROM ADDRESS RATHER THAN BY ALLOCATION
; NOTES:
;	ASSIGN (NAME) name (TO ADDRESS) octal-number
	$P	(FLD)			;PICK UP FIELD BEING DEFINED
	MOVEM	T1,T5			;MAKE PTR TO FLDNAME PASSABLE
	$CALL	SY.STOR,<TK.VAL(T5)>	;PUT IN TABLE IF NOT ALREADY THERE
	JUMPF	L$ERRU(NAD)		;NAME ALREADY DEFINED
	MOVEM	T1,DD			;PRESERVE DD SYMBLK PTR
	$P	(NUM)			;GET THE ADDRESS
	MOVEM	T1,DD.VAL(DD)		;PUT IT AWAY
	$FETCH	T2,BID,(T1)		;CHK IF RAB
	CAIE	T1,RA$TYP		;IS IT?
	RETT				;NO, DONE
	$COPY	CRABNM,R50VAL		;SAVE ITS NAME
	MOVEM	T1,CURRAB		;SAVE PTR TO IT
	RETT
$ENDPROC

SUBTTL	PROCESSOR FOR CHANGE CMD

$PROC	(DO.CHANGE)
;
; DO.CHANGE - CHANGE VALUE OF ARGBLK OR DATA FIELD
;	CHANGE <argblk-NAME> [argblk-fld-list]
;	CHANGE [argblk-name]  KEY-BUFFER!datfld-list
;	WHERE EACH LIST IS FORM: FIELD VALUE, FIELD VALUE, ...
;
	MOVE	PB,CURRAB		;PRESUME DEFAULT RAB
	$CALL	P$KEYW			;KEY-BUFFER?
	JUMPT	CHGKED			;YES IF JUMP
	$CALL	SY.GET			;GET PTR TO ARGBLK
	JUMPF	L$ERRU(NNK)		;NAME NOT KNOWN
	$FETCH	T2,BID,(T1)		;GET TYPE OF FLD
	CAIE	T2,DA$TYP		;DATA FLD?
	$SKIP				;YES
	  JUMPE	PB,L$ERRU(NRC)		;NO RAB CURR
	  JRST	CHGDAT			;MERGE THE DATA PATH
	$ENDIF
	MOVEM	T1,PB			;PERMANIZE ARGBLK PTR
CHG.LP:
	$CALL	P$KEYW			;CHK IF ARGBLK FLD
	JUMPT	L$JUMP			;YES IF JUMP
	  $CALL	SY.GET			;NO, IS DATAFLD
	  JUMPT	CHGDAT			;PROCEED
	  $CALLB TX$TOUT,<[DB.NND##],R50VAL> ;TELL USER
	  $CALL P$NFLD			;HOP OVER VALUE
	  JRST	L$IFX			;PROCEED TO NEXT FLD (OR EOL)
	CHGDAT:
	  MOVEM	T1,RF			;PERMANIZE FLD PTR
	  $CALL	EATDAT			;PROCESS IT
	  JRST	L$IFX
	$JUMP				;YES, ARGBLK DATA
	  JUMPE	T1,CHGKEY		;ACTU NO, IS KEY-BUFFER
	  MOVEM	T1,RF			;PERMANIZE IT
	  $CALL	EATRFV			;EAT ARGBLK VALUE
	$ENDIF
	$CALL	P$COMMA			;MORE IN LIST?
	JUMPT	CHG.LP			;YES
	RETT
CHGKED:
	JUMPE	PB,L$ERRU(NRC)		;NO RAB CURR
CHGKEY:
	MOVEI	RF,KEYINI		;USE DUMMY UF
	$CALL	EATKEY			;DO THE WORK
	RETT
$ENDPROC

$UTIL	(EATDAT)
;
; EATDAT - EAT USER DATA FLD VALUE
;
	SETZM	BUFADD(CF)		;USE RBF BELOW
	LOAD	T1,UF.TYP(RF)		;GET TYPE OF FLD
	CASES	T1,MX%DFT
$CASE	(DFT%AS)
	$P	(QSTR,WDT)		;PICK UP THE STRING
	SETZM	TAP			;NO CONVERSION
	MOVSI	T5,440700		;ASCII DEST
	JRST	EATSTR			;MERGE
$CASE	(DFT%SIX)
	$P	(QSTR,WDT)			;PICK UP THE STRING
	MOVEI	TAP,40			;CONV FACTOR
	MOVSI	T5,440600		;SIXBIT BYTE INFO
EATSTR:
	MOVEI	T3,TK.VAL(T1)		;GET ADDR OF NEW VAL
	HRLI	T3,440700		;SETUP BP TO IT
	SKIPN	T1,BUFADD(CF)		;USE KBF?
	$FETCH	T1,RBF,(PB)		;NO, GET RECORD BUFFER PTR
	HRR	T5,T1			;MAKE BP
	LOAD	T4,UF.POS(RF)		;GET RELAT POSITION
	ADJBP	T4,T5			;GET THERE
EATOKC:
	LOAD	T5,UF.SIZ(RF)		;GET LENGTH
	ADJBP	T5,T4			;GET TO END OF COPY
	HRRZS	T5,T5			;ISOL ENDING ADDR OF COPY
	$FETCH	T2,USZ,(PB)		;ASSUME REC BUFF SIZE
	SKIPE	BUFADD(CF)		;CHK CASE THAT APPS
	MOVEI	T2,SZ%KBUF		;KEY BUFF SIZE
	ADD	T1,T2			;GET TO WD PAST END
	CAMG	T1,T5			;OUT OF BNDS?
	ERRU	(VOF)			;VAL OVFLOWS BUFFER
	LOAD	T5,UF.SIZ(RF)		;GET LENGTH FOR LOOP CNT
EASCLP:
	LC	T1,T3			;GET A CHAR
	JUMPE	T1,EASCLE		;END?
	SUB	T1,TAP			;CONV IF NECES
	DC	T1,T4			;NO, PUT IT AWAY
	SOJG	T5,EASCLP		;MORE LEFT?
	RETURN				;FILLED FLD
EASCLE:
	MOVEI	T1," "			;PAD WITH SPACES
	SUB	T1,TAP			;CONVERT IF NECES
	DC	T1,T4			;PUT IT AWAY
	SOJG	T5,.-1			;DONE YET
	RETURN
$CASE	(DFT%FIL)
	$FETCH	T4,FAB,(PB)		;GET FAB
	JUMPE	T4,L$ERRU(RNC)		;DOESNT PT TO FAB
	$FETCH	T1,BSZ,(T4)		;GET FILE BYTE SIZE
	CAIN	T1,7			;ASCII?
	JRST	L$CASE(DFT%AS)		;YES
	CAIN	T1,6			;SIXBIT?
	JRST	L$CASE(DFT%SIX)		;YES
	ERRU	(BSI)			;BYTE SIZE ILLEGAL FOR INPUT
$CASE	(DFT%DEC)
$CASE	(DFT%OCT)
	$P	(NUM,WDT)		;GET THE NUMBER
	$FETCH	T3,RBF,(PB)		;GET RECORD PTR
	$INCR	T3,UF.POS(RF)		;GET TO RIGHT WORD
	MOVEM	T1,0(T3)		;PUT IT AWAY
	RETURN
;
$ENTRY	(EATKEY)
;
; EATKEY - ENTER DATA IN KEY BUFFER
;
	$FETCH	T3,KBF,(PB)		;SET UP BUFF LOC IMMED
	JUMPN	T3,L$IFX		;IS THERE 1?
	 $CALL	M.ALC,<[SZ%KBUF]>	;KEY BUFFER SET FROM CONSTANT
					;...KSZ MAY BE SMALL FOR GENERIC KEY
	  $STORE	T1,KBF,(PB)		;PUT AWAY PTR
	  MOVEM	T1,T3			;SO CAN BE USED AFTER P$NUM
	$ENDIF
	$CALL	P$NUM			;THE EASY CASE?	
	JUMPF	L$IFX			;NO, IF JUMP
	  MOVEM	T1,0(T3)		;PUT IT AWAY
	  RETURN			;DONE
	$ENDIF
	MOVEM	T3,BUFADD(CF)		;PERMANIZE START ADDR
	$CALL	P$CURR			;PREP TO COMPUTE LEN OF ENTERED STRING
	MOVEI	T1,TK.VAL(T1)		;PT TO STRING
	HRLI	T1,440700		;...AND MAKE IT A BP
	SETZM	T3			;INIT CNT
	LC	T2,T1			;GET A CHAR
	SKIPE	T2			;DONE YET?
	AOJA	T3,.-2			;NO, EAT ANOTHER
	$STORE	T3,KSZ,(PB)		;STORE FLD LEN IN ARGBLK
	STOR	T3,UF.SIZ(RF)		;ALSO IN PSEUDO-DATFLD BLK
	JRST	L$CASE(DFT%FIL)		;PASSING BUFADD
$ENDUTIL

$PROC	(DO.DEFINE)
;
; DO.DEFINE - PROCESS DEFINE CMD
;
	$P	(KEYW)			;PICKUP THE KEYWORD VAL
	CASES	T1,MX%DEF		;DISPATCH OFF TYPE OF BLK
$CASE	(DEF%DAT)
	$CALL	ALCBLK,<FLDINI>		;DATA FIELD DESC INIT VALS
	$P	(KEYW)			;PICK UP DATA TYPE
	STOR	T1,UF.TYP(PB)		;STORE DATA TYPE
	CAIE	T1,DFT%INT		;INTEGER?
	$SKIP				;YES
	  $CALL	DEDINT			;PROC INTEGER
	  JRST	L$IFX
	$NOSKIP
	  $CALL	DEDSTR			;PROC STRING
	$ENDIF
	RETT
DEDERR:
	SETZM	0(DD)			;CLEAR OUT ABORTED DEF
	ERRU	(NPS)			;TELL USER

$CASE	(DEF%RAB)
	$CALL	ALCBLK,<RABINI>		;SETUP A RAB
	$COPY	CRABNM,R50VAL		;SAVE ITS NAME
	MOVEM	PB,CURRAB		;SAVE PTR TO IT
	$CALL	SY.GET			;GET FAB PTR
	JUMPT	L$IFX			;JUMP IF FAB OK
	  $CALLB TX$TOUT,<[DB.FNU##]>	;FAB NAME UNKNOWN, CON WITH INIT VAL FAB
	  MOVEI	T1,FABINI		;USE INIT VALUES FAB RATHER THAN ABORT
	$ENDIF
	$STORE	T1,FAB,(PB)		;PUT AWAY PTR
	$CALL	DEFSWIT
	$FETCH	T5,USZ,(PB)		;GET SIZE TO ALLOC
	JUMPN	T5,L$IFX		;SPECIFY USER BUF SIZ?
	  $FETCH T4,FAB,(PB)		;GET FAB PTR
	  $FETCH T1,MRS,(T4)		;USE MAX REC SIZ AS DEFAULT
	  $FETCH T3,BSZ,(T4)		;GET BYTE SIZE FOR CONVERSION
	  MOVEI	T2,^D36			;GET BITS WORD
	  IDIV	T2,T3			;GET BYTES/WORD (IN T2)
	  IDIV	T1,T2			;GET WDS/MRS
	  MOVEI	T5,1(T1)		;ADJ FOR POSSIB TRUNC
	  $STORE T5,USZ,(PB)		;PUT IT AWAY
	$ENDIF
	$CALL	M.ALC,<T5>		;GET USER BUFF SIZE
	$STORE	T1,UBF,(PB)		;PUT AWAY PTR
	$STORE	T1,RBF,(PB)		;PUT AWAY PTR
	$FETCH	T5,RSZ,(PB)		;GET SIZE TO ALLOC
	JUMPN	T5,L$IFX		;SPECIFY CURR REC SIZ?
	  $FETCH T4,FAB,(PB)		;GET FAB PTR
	  $FETCH T5,MRS,(T4)		;USE MAX REC SIZ AS DEFAULT
	  $STORE T5,RSZ,(PB)		;PUT IT AWAY
	$ENDIF
	RETT

$CASE	(DEF%FAB)
	$CALL	ALCBLK,<FABINI>		;SETUP A FAB
	$CALL	ALCSTR			;ALC ROOM AND COPY FILE STRING
	$STORE	(T1,FNA,(PB))		;PUT PTR TO FILE SPEC AWAY
	$CALL	DEFSWIT
	$FETCH	T1,BSZ,(PB)		;GET MAX REC SIZ
	RETT

$CASE	(DEF%XAB)
	$CALL	ALCBLK,<0>		;INDIC INIBLK DET IN ALCBLK
	$CALL	DEFSWIT			;PROCESS SWITCHES
	RETT

SUBTTL	SUBROUTINES COMMON TO ASSIGN, DEFINE, AND CHANGE

$UTIL	(ALCBLK,<INIBLK>)
;
; ALCBLK - SETUPS AN USER ARG BLK
; ARGUMENT:
;	INIBLK = THE INITIAL-VALUE COPY OF BLK OR 0 (FOR TOKEN DET BLK)
; RETURNS:
;	PB = PTR TO ALLOCATED BLK
	MOVEI	IB,@INIBLK(AP)		;MATER PTR TO INIT VAL BLK
	$P	(FLD)			;PICK UP FIELD BEING DEFINED
	MOVEM	T1,T5			;MAKE PTR TO FLDNAME PASSABLE
	$CALL	SY.STOR,<TK.VAL(T5)>	;PUT IN TABLE IF NOT ALREADY THERE
	JUMPF	L$ERRU(NAD)		;NAME ALREADY DEFINED
	MOVEM	T1,DD			;PRESERVE DD SYMBLK PTR
	JUMPN	IB,L$IFX		;BLK PASSED?
	  $P	(KEYW)			;NO, PICK UP XAB TYPE
	  MOVE	IB,XABINI(T1)		;GET INIT ARGBLK ADDR
	$ENDIF
	$FETCH	(T5,BLN,(IB))		;GET LEN OF ARGBLK NEEDED
	$CALL	M.ALC,<T5>		;ALLOC A BLK
	MOVEM	T1,PB			;PRESERVE PTR TO BLK
	MOVEM	T1,DD.VAL(DD)		;SET VALUE OF SYMBOL TO ADDR OF ARGBLK
	HRL	T1,IB			;GET ADDR OF INIT VALS
	$FETCH	(T2,BLN,(IB))		;GET ARGBLK'S LEN BACK
	ADDI	T2,-1(PB)		;GET LAST WORD OF BLK
	BLT	T1,0(T2)		;COPY INIT VALS TO ALLOC BLK
	RETURN
$ENDUTIL

$UTIL	(ALCSTR)
;
; ALCSTR - ALLOC SPACE FOR AND COPY STRING TO SPACE ALLOCATED
; RETURNS:
;	T1 = PTR TO ALLOCATED BLK
	$CALL	P$NFLD			;GET DATA FOR CURR FIELD
	MOVSI	P1,TK.VAL(T2)		;SAVE ADDR AND PREP TO BLT
	LOAD	P2,TK.LEN(T2)		;GET WD LEN OF TOK (INCL HDR)
	MOVEI	P2,-1(P2)		;REMOVE HDR WD FROM LEN
	$CALL	M.ALC,<P2>		;GRAB THE SPACE
	HRRM	T1,P1			;FINISH SETTING UP BLT AC
	ADDM	T1,P2			;END OF BLT
	BLT	P1,-1(P2)		;MOVE THE DATA
	RETURN				;WITH T1 = PTR TO BLK
$ENDUTIL

$UTIL	(DEDINIT)
;
; DEDINIT - PROCESS INTEGER DATA FIELD
;
DEDINT:
	$CALL	P$NUM			;WORD OFFSET SPEC?
	MOVE	T3,CSTYPE		;GET STRING TYPE
	MOVE	T3,BPWVEC(T3)		;GET BYTES PER WORD
	JUMPT	L$IFX			;POSIT SPEC
	  JUMPE	T3,DEDERR		;NO DEFAULT, TELL USE
	  MOVE	T1,CPOSIT		;GET DEFAULT POS
	  ADDI	T1,-1(T3)		;SETUP FOR TRUNCATING DIVIDE
	  IDIV	T1,T3			;GET WD OFFSET
	$ENDIF				;EXPLIC POS
	STOR	T1,UF.POS(PB)		;STORE WORD OFFSET
	ADDI	T1,1			;HOP PAST IT
	IMUL	T1,T3			;RECONVERT TO CHARS
	MOVEM	T1,CPOSIT		;PERMANIZE IT
	$CALL	P$SWIT			;IS THERE A SWITCH?
	JUMPF	L$RETT			;NO, DONE
	$CALL	P$KEYW			;IS THERE A VALUE?
	JUMPF	L$RETT			;NO, DONE
	STOR	T1,UF.TYP(PB)		;JUST EXPLODE INT TO DEC/OCT
	RETURN				;DONE
$ENDUTIL

$UTIL	(DEDSTR)
;
; DEDSTR - PROCESS STRING DATA FIELD
;
	$P	(NUM)			;GET THE LENGTH
	STOR	T1,UF.SIZ(PB)		;STORE SIZE
	$CALL	P$NUM			;CHK FOR POS
	JUMPT	L$IFX			;JUMP IF EXPLIC
	  LOAD	T2,UF.TYP(PB)		;GET CURR TYPE
	  CAME	T2,CSTYPE		;MATCH UP?
	  JRST	DEDERR			;NO, USER MUST SPEC POS
	  MOVE	T1,CPOSIT		;SET DEFAULT UP
	$ENDIF
	STOR	T1,UF.POS(PB)		;PUT IT AWAY
	$INCR	T1,UF.SIZ(PB)		;HOP OVER CURR FLD
	MOVEM	T1,CPOSIT		;PERMANIZE NEW DEFAULT
	$COPY	CSTYPE,UF.TYP(PB)	;UPDATE CURR STRING TYPE
	RETURN
$ENDUTIL

$UTIL	(DEFSWIT)
;
; DEFSWIT - SCANS PARSER OUTPUT TILL EOL
;
ESW.LP:
	$CALL	P$CFM			;IS IT EOL?
	JUMPT	L$RET			;YES, ALL DONE
	$P	(SWIT)			;EAT A SWITCH
	MOVEM	T1,RF			;PT TO THE RF RETURNED
	$CALL	EATRFV			;EAT RMS FLD VALUE
	JRST	ESW.LP			;CHK FOR ANOTHER SWITCH
$ENDUTIL

$UTIL	(EATRFV)
;
; EATRFV - EAT RMS FIELD VALUE
;
	SETZM	P1			;START WITH CLEAN SLATE
	LOAD	T1,RF.TYP(RF)		;SEE WHAT KIND OF VALUE FOLLOWS
	CASES	T1,MX%DT		;DISPATCH OFF IT
$CASE	(DT%DATE)			;INTERNAL DATE/TIME
$CASE	(DT%DEC)			;DECIMAL VALUE
$CASE	(DT%OCT)			;OCTAL VALUE
	$CALL	P$NFLD			;PICK VALUE AND STORE VERBATIM
	MOVE	T1,TK.VAL(T2)		;GET THE PARSED VAL
	DPB	T1,RF.BP(RF)		;PUT IT AWAY
	$CALL	P$TOK			;SEE IF MORE ELEMS SPEC
	JUMPF	L$RET			;NO
	ADDI	RF,SZ%RF		;SEE IF MORE LEFT
	LOAD	T1,RF.FLAG(RF)		;CHK IF ARRAY ELEM
	TXNN	T1,RF%ARY		;NEXT ELEM ARRAY TOO?
	ERRU	(TMV)			;TOO MANY VALUES SPECIFIED
	JRST	L$CASE(DT%DEC)		;PROC IT
$CASE	(DT%STR)			;VAR LEN STRING
	$CALL	ALCSTR			;GRAB SPACE AND COPY
	DPB	T1,RF.BP(RF)		;PUT AWAY PTR
	RETURN
$CASE	(DT%SYA)			;SYMBOLIC ADDR
	$CALL	SY.GET			;PICK UP BLK NAME
	JUMPF	L$ERRU(NNK)		;NAME NOT KNOWN
	DPB	T1,RF.BP(RF)		;PUT FOUND SYMBOL AWAY
	RETURN
$CASE	(DT%SYV)			;SYMBOLIC VALUE
$CASE	(DT%SYB)			;SYMBOLIC BITS
	$P	(KEYW)			;GET SYM VALUE SPECIFIED
	IOR	P1,T1			;MERGE IN VALUE
	$CALL	P$TOK			;CHK FOR PLUS
	JUMPT	L$IFX			;NO PLUS? THEN END OF SWITCH
	  DPB	P1,RF.BP(RF)		;STORE AWAY ACCUM VAL
	  RETURN			;CHK FOR EOL
	$ENDIF
	JRST	L$CASE(DT%SYB)		;GET NEXT VALUE
$CASF
	ERRU	(IER)			;INTERNAL ERROR
$ENDUTIL

SUBTTL	PROCESS DISPLAY COMMAND

$PROC	(DO.DISPLAY)
;
; DO.DISPLAY - DISPLAY USER FIELD OR ARG BLK
; NOTES:
;	DISPLAY <argblk-NAME> [argblk-fld-list]
;	DISPLAY [argblk-name] DATA!KEY-BUFFER!datfld-list
;
	MOVE	PB,CURRAB		;PRESUME USE CURRENT RAB
	$CALL	P$KEYW			;CHK FOR DATA or KEY-BUFFER
	JUMPF	L$IFX			;FALL THRU IF KYWD & DEFAULT RAB
	  JUMPE	PB,L$ERRU(NRC)		;NO CURR RAB
	  JUMPN	T1,DSPKEY		;DO KEY VALUE
	  JRST	DSPDAA			;DISP WHOLE RECORD
	$ENDIF
	$CALL	SY.GET			;GET USER'S FLD
	JUMPF	L$ERRU(NNK)		;ACTU IMPOS
	$FETCH	T2,BID,(T1)		;GET TYPE OF FLD
	CAIE	T2,DA$TYP		;DATA FLD?
	$SKIP				;YES
	  JUMPE	PB,L$ERRU(NRC)		;NO CURRENT RAB
	  JRST	DSPDL1			;MERGE THE DATA-LIST PATH
	$ENDIF
	MOVEM	T1,PB			;PERMANIZE ARGBLK PTR

DISPAB:
	$CALL	P$CFM		;ENTIRE USER BLK CASE?
	JUMPT	DSPABA		;YES, GO DO IT
DSPABL:
	$CALL	P$KEYW		;MUST BE AB FLD LIST, "DATA", OR DATFLD
	JUMPF	DSPDAL		;NOT A KEYWORD, SO ENTER DATA-LST PATH
	JUMPE	T1,DSPDAA	;DATA-ALL PATH
	CAIN	T1,DISD%K	;KEY-BUFFER?
	JRST	DSPKEY		;YES
	MOVEM	T1,RF		;PERMANIZE RMS FIELD DESCRIPTOR
	$CALL	DABVAL		;DISPLAY ONE VALUE
	$CALL	P$COMMA		;MORE IN LIST?
	JUMPT	DSPABL		;YES
	RETT			;NO

DSPABA:				;DISPLAY ARGBLK
	$FETCH	T1,BID,(PB)	;GET ID
	CASES	T1,XA$TYP	;DISPATCH OFF IT
$CASE	(FA$TYP)
	MOVEI	RF,FABTAB	;SETUP APPROP FIELD TABLE
	JRST	L$CASX
$CASE	(RA$TYP)
	MOVEI	RF,RABTAB	;DITTO
	JRST	L$CASX
$CASE	(XA$TYP)
	$FETCH	T1,COD,(PB)	;GET CODE FIELD
	MOVE	RF,XABTAB(T1)	;PICKUP FLD TABLE FOR APPROP XAB TYPE
	JRST	L$CASX
$CASF
	ERRU	(IER)
$CASX
DABALP:
	SKIPN	0(RF)		;THRU?
	RETT			;YES
	$CALL	DABVAL		;PUT OUT CURR VAL
	LOAD	T1,RF.CNT(RF)	;GET VAR LEN SIZ
	ADDI	RF,SZ%RF(T1)	;GET TO NEXT RF
	JRST	DABALP		;CHK IF MORE

DSPKEY:
	$FETCH	T2,KBF,(PB)	;GET KEY BUFF PTR
	JUMPE	T2,L$RETT	;NO KEY BUFF
	$FETCH	T3,KSZ,(PB)	;ITS LEN
	MOVE	T1,0(T2)	;GET 1ST WORD OF KEY BUFFER
	TXNE	T1,777B8	;START WITH 0 BITS?
	JRST	DSPDAK		;NO, MERGE TO OUTPUT STRING
	$CALLB	TX$TOUT,<DABDEC,T1>	;OUTPUT NUMBER
	RETT
DSPDAL:
	$CALL	SY.GET		;DERIVE FLD PTR FROM CURR TOKEN
	JUMPT	L$JUMP		;VALID NAME
	  $CALLB TX$TOUT,<[DB.NND##],R50VAL>	;TELL USER
	  JRST	L$IFX		;PROCEED
	$JUMP
	DSPDL1:
	  MOVEM	T1,RF		;TREAT AS ARGBLK FLD (USE RF TO PT AT IT)
	  $CALL	DDAVAL		;DISP DATA VAL
	$ENDIF
	$CALL	P$COMMA		;CHK IF MORE IN LIST
	JUMPF	L$RETT		;NO
	JRST	DSPDAL		;YES

DSPDAA:
	$FETCH	T2,RBF,(PB)	;GET REC LOCATION
	$FETCH	T3,RSZ,(PB)	;GET REC SIZE (IN BYTES)
DSPDAK:
	$FETCH	T4,FAB,(PB)	;GET FAB PTR
	JUMPE	T4,L$ERRU(RNC)		;DOESNT PT TO FAB
	HRLI	T2,440000	;WORD-ALIGNED BP
	$FETCH	T1,BSZ,(T4)	;FIND BYTE SIZE OF FILE
	STOR	T1,BP.SIZ+T2	;MERGE BYTE SIZE WITH BP
	DMOVEM	T2,STRIPT
	$CALLB	TX$TOUT,<[DISSTR],[STRIPT]>	;PUT OUT STRING
	RETT

$UTIL	(DABVAL)
;
; DABVAL - DISPLAY THE CURRENTLY IDENTIFIED ARGBLK FIELD
;
	LOAD	T1,RF.FLAG(RF)	;SEE IF ARRAY
	TXNE	T1,RF%INV	;INVISIBLE?
	RETURN			;YES, JUST RET IMMED
	TXNE	T1,RF%ARY	;IS IT?
	JRST	ARYVAL		;YES
	LDB	P1,RF.BP(RF)	;GET THE VALUE
	LOAD	T1,RF.TYP(RF)	;PICK UP TYPE OF CURR RF
	CAIE	T1,DT%SYV	;SHOW SYM VALS OF 0
	JUMPE	P1,L$RET	;SKIP NULL VALUES
	MOVEI	T5,RF.NAM(RF)	;GET PTR TO TEXT
	$CALLB	TX$TOUT,<[FNACOL],T5>	;PUT OUT XXX:#
	LOAD	T1,RF.TYP(RF)	;PICK UP TYPE OF CURR RF
	CASES	T1,MX%DT	;DISPATCH ON DATA TYPE
$CASE	(DT%DATE)
$CASE	(DT%DEC)		;DECIMAL NUMBER
$CASE	(DT%OCT)
$CASE	(DT%SYA)
$CASE	(DT%STR)
	$CALLB	TX$TOUT,<DABFMT(T1),P1>	;PUT OUT THE SIMPLE CASES
	RETURN
$CASE	(DT%SYB)
	LOAD	T1,RF.CNT(RF)	;GET NUM OF SYM OPTS
	MOVNS	T1		;MAKE NEG
	HRLI	T1,SZ%RF(RF)	;GET TO WHERE SYM WDS STORED
	MOVSM	T1,DD		;NOW AOBJ PTR TO SYM VALS
DSYBLP:
	LOAD	T1,SYV.VL(DD)		;GET CURR SYM'S VAL
	TDZN	P1,T1			;IS CURR VAL SUBSET OF ACTU VALUE?
	$SKIP				;YES
	  LOAD	T5,SYV.NM(DD)		;GET PTR OF NAME
	  MOVEI	T4,[$FMT(,<-CA%ASZ>)]	;PRESUME LAST 1
	  SKIPE	P1			;MORE OPTIONS TO PUT OUT
	  MOVEI	T4,[$FMT(,<-CA%ASZ,+,-CA%NOCR>)]	;MORE FOLLOW
	  $CALLB TX$TOUT,<T4,T5>	;PUT OUT SYM VAL
	  JUMPE	P1,L$RET		;ALL BITS ACCOUNTED FOR
	$ENDIF
	AOBJN	DD,DSYBLP		;CHK NEXT SYM
	ERRU	(IVF)			;INVALID VALUE IN FIELD
$CASE	(DT%SYV)
	LOAD	T1,RF.CNT(RF)	;GET NUM OF SYM OPTS
	MOVNS	T1		;MAKE NEG
	HRLI	T1,SZ%RF(RF)	;GET TO WHERE SYM WDS STORED
	MOVSM	T1,DD		;NOW AOBJ PTR
DSYVLP:
	LOAD	T1,SYV.VL(DD)		;GET CURR SYM'S VAL
	CAME	T1,P1			;DOES ACTU VALUE MATCH?
	$SKIP				;YES
	  LOAD	T5,SYV.NM(DD)		;GET PTR OF NAME
	  MOVEI	T4,[$FMT(,<-CA%ASZ>)]	;PRESUME LAST 1
	  $CALLB TX$TOUT,<T4,T5>	;PUT OUT SYM VAL
	  RETURN
	$ENDIF
	AOBJN	DD,DSYVLP		;CHK NEXT SYM
	ERRU	(IVF)			;INVALID VALUE IN FIELD

ARYVAL:
	$COPY	ARYNAM,I RF.NAM(RF)	;PREP TO OUTPUT NAME
	SETZM	ARYIDX			;INIT INDEX
ARYVLP:
	LDB	T4,RF.BP(RF)		;GET CURR VALUE
	JUMPE	T4,L$IFX		;NOTHING
	  $CALLB TX$TOUT,<[ARYFMT],ARYNAM,ARYIDX,T4>	;OUTPUT IT
	$ENDIF
	AOS	ARYIDX			;HOP INDEX
	ADDI	RF,SZ%RF		;GET TO NEXT
	LOAD	T1,RF.FLAG(RF)		;MORE ENTRIES
	TXNN	T1,RF%ARY		;CHK IT?
	RETURN				;DONE
	JRST	ARYVLP			;NO, PROC ANOTHER
$ENDUTIL

$UTIL	(DDAVAL)
;
; DDAVAL - DISPLAY THE CURRENTLY IDENTIFIED DATAFIELD
;
	LOAD	T4,UF.TYP(RF)		;GET DATA TYPE TO USE
	CASES	T4,MX%DFT
$CASE	(DFT%AS)			;ASCII DATA
	MOVEI	TAP,7			;ASCII BYTES
	JRST	DDAVSTR			;STRING MERGE
$CASE	(DFT%SIX)			;SIXBIT DATA
	MOVEI	TAP,6			;SIXBIT BYTES
	JRST	DDAVSTR			;STRING MERGE
$CASE	(DFT%FIL)			;FILE BYTES
	$FETCH	T4,FAB,(PB)		;GET FAB PTR
	JUMPE	T4,L$ERRU(RNC)		;DOESNT PT TO FAB
	$FETCH	TAP,BSZ,(T4)		;FIND BYTE SIZE OF FILE
DDAVSTR:
	$FETCH	T1,RBF,(PB)		;GET REC LOCATION
	HRLI	T1,440000		;WORD-ALIGNED BP
	STOR	TAP,BP.SIZ+T1		;MERGE BYTE SIZE WITH BP
	LOAD	T2,UF.POS(RF)		;SELECT BYTE TO POSIT TO
	ADJBP	T2,T1			;POSIT TO RIGHT BYTE
	LOAD	T3,UF.SIZ(RF)		;GET FIELD SIZE
	DMOVEM	T2,STRIPT
	$CALLB	TX$TOUT,<[DISSTR],[STRIPT]>	;TYPE VALUE OUT
	RETURN
$CASE	(DFT%DEC)			;INTEGER
	$FETCH	T2,RBF,(PB)		;GET REC LOCATION
	$INCR	T2,UF.POS(RF)		;GET TO RIGHT WORD
	$CALLB	TX$TOUT,<DABDEC,0(T2)>	;OUTPUT IT
	RETURN
$CASE	(DFT%OCT)			;OCTAL NUMBER
	$FETCH	T2,RBF,(PB)		;GET REC LOCATION
	$INCR	T2,UF.POS(RF)		;GET TO RIGHT WORD
	$CALLB	TX$TOUT,<DABOCT,0(T2)>
	RETURN
$ENDUTIL

SUBTTL	PROCESS EXIT CMD

$PROC	(DO.DDT)
;
; DO.DDT - ENTERS DDT (DO RMSDEB$G TO RETURN TO RMSDEB)
; NOTES:
;	TO RETURN TO RMSDEB FROM DDT, THE USER TYPES RMSDEB$G
	IFN TOP$10,<MOVE T1,.JBDDT##>	;GET LOC OF DDT
	IFN TOP$20,<MOVE T1,770000>	;DITTO
	RETT				;NO
$ENDPROC

$PROC	(DO.EXIT)
;
; DO.EXIT - EXIT TO MONITOR
;
	IFN TOP$10,<EXIT 1,>
	IFN TOP$20,<HALTF%>
	RETT			;HE CONTINUED
$ENDPROC

SUBTTL	HELP COMMAND

$PROC	(DO.HELP)
	$CALLB	TX$TOUT,<[RM$ASZ],[HLPMSG]>
	RETT

HLPMSG:
ASCIZ	?The RMSDEB commands are:
$name	executes the corresponding RMS command
ASSIGN	gives specified name to block at specified address
CHANGE	changes a field to the value specified in the command
DDT	enters DDT (to return type RMSDEB$G)
DEFINE	initializes block and gives it the specified name
DISPLAY	outputs the specified fields to the terminal
EXIT	returns to the EXEC (you may CONTINUE)
HELP	outputs this message
INFO	describes state of RMSDEB
TAKE	executes the RMSDEB commands in specified file
UNDEFIN	removes a name created by DEFINE
?

$ENDPROC

SUBTTL	PROCESS THE INFO CMD

$PROC	(DO.INFO)
;
; DO.INFO - LIST OUT SPECIFIED TYPE OF INFO
; NOTES:
;	INFO DATAF!FABS!RABS!XABS!ALL
	$P	(KEYW)
	CASES	T1,MX%INF
$CASE	(INF%CON)
	SKIPN	CURRAB				;A CURR RAB?
	$SKIP					;YES
	  $CALLB TX$TOUT,<[CONFCR],CRABNM>	;PUT IT OUT
	  JRST	L$IFX
	$NOSKIP
	  $CALLB TX$TOUT,<[CONFNC]>		;NO, TELL HIM
	$ENDIF
	MOVE	T4,CSTYPE			;GET STRING DAT TYPE
	$CALLB	TX$TOUT,<[CONFDD],DATTYP(T4),CPOSIT>
	RETT
$CASE	(INF%XAB)
	$CALL	DUMPAB,<[XA$TYP]>		;PICK UP ONLY XABS
	RETT
$CASE	(INF%RAB)
	$CALL	DUMPAB,<[RA$TYP]>		;PICK UP ONLY RABS
	RETT
$CASE	(INF%FAB)
	$CALL	DUMPAB,<[FA$TYP]>		;PICK UP ONLY FABS
	RETT
$CASE	(INF%DAT)
	$CALL	DUMPAB,<[DA$TYP]>		;INDIC DATA FIELDS
	RETT
$CASE	(INF%ALL)
	$CALL	DUMPAB,<[-1]>			;INDIC ALL
	$CALLB	TX$TOUT,<[[-CA%EXIT]]>		;BLANK LINE
	JRST	L$CASE	(INF%CON)		;PUT OUT CONTEXT INFO TOO

$UTIL	(DUMPAB,<TYPBLK>)
;
; DUMPAB - SCAN PRIVATE SYM TAB, PICKING OUT INDICATED TYPE BLKS
; ARGUMENTS:
;	TYPBLK = -1 OR TYPE TO SCAN FOR
	MOVE	P1,@TYPBLK(AP)		;GET ARGBLK TYPE
	MOVEI	DD,DDTAB		;PT TO BEGINNING OF PRIVATE SYMTAB
DUABLP:
	SKIPN	0(DD)			;IS THE CELL OCCUPIED?
	JRST	DUABLE			;NO
	MOVE	PB,DD.VAL(DD)		;GET ARGBLK PTR
	$FETCH T1,BID,(PB)		;GET TYPE
	JUMPL	P1,L$IFX		;IS A TYPE SPECIFIED?
	  CAME	T1,P1			;YES, A MATCH?
	  JRST	DUABLE			;NO
	$ENDIF
	CASES	T1,XA$TYP		;TYPE RIGHT MSG
$CASE	(FA$TYP)
	$FETCH	T2,FNA,(PB)		;GET FILE SPEC PTR
	SKIPN	T2			;IS THERE A FILE PTR?
	MOVEI	T2,[ASCIZ/None/]	;NO
	$FETCH	T1,JFN,(PB)		;GET JFN FIELD
	MOVEI	T3,[0]			;PRESUME NOT OPEN
	SKIPE	T1			;CHK NOW
	MOVEI	T3,[ASCIZ/ (Open)/]	;OPEN
	$CALLB	TX$TOUT,<[FABINF],0(DD),T2,T3>	;PUT OUT "NAME TYPE"
	JRST	DUABLE
$CASE	(RA$TYP)
	$FETCH	T1,ISI,(PB)		;CHK IF CONNECTED
	MOVEI	T2,[0]			;ASSUME NOT
	SKIPE	T1			;CHK NOW
	MOVEI	T2,[ASCIZ/Connected/]
	$CALLB	TX$TOUT,<[RABINF],0(DD),T2>	;PUT OUT "NAME TYPE"
	JRST	DUABLE
$CASE	(XA$TYP)
	$FETCH	T5,COD,(PB)		;GET XAB TYPE
	$CALLB	TX$TOUT,<[XABINF],0(DD),XABTYP(T5)>	;PUT OUT "NAME TYPE"
	JRST	DUABLE
$CASE	(DA$TYP)
	LOAD	T3,UF.POS(PB)		;GET POSITION
	LOAD	T4,UF.SIZ(PB)		;SIZ
	LOAD	T5,UF.TYP(PB)		;DATA TYPE CODE
	CAIL	T5,DFT%INT		;NUMERIC?
	$SKIP				;NO
	  ADD	T4,T3			;POS+SIZ=END POS +1
	  SUBI	T4,1			;FIX IT
	  $CALLB TX$TOUT,<[DASINF],0(DD),DATTYP(T5),T3,T4>	;PUT OUT "NAME TYPE"
	  JRST	L$IFX
	$NOSKIP
	  $CALLB TX$TOUT,<[DAIINF],0(DD),DATTYP(T5),T3>	;PUT OUT "NAME TYPE"
	$ENDIF
	JRST	DUABLE
DUABLE:
	ADDI	DD,SZ%DD		;HOP TO NEXT ENTRY
	CAML	DD,DDCURR		;HIT LIMIT?
	RETURN				;YES
	JRST	DUABLP			;NO
$ENDUTIL

SUBTTL	ROUTINE TO FLUSH(DELETE) A FAB , RAB, OR XAB NAME FROM TABLE

$PROC	(DO.UNDEFINE)
;
; DO.UNDEFINE - REMOVES NAME AND STORAGE FOR A NAME CREATED BY DEFINE
; NOTES:
;	UNDEFINE name, name, ...
CUNDLP:
	$CALL	SY.GET			;GET SYMBOL NAME
	JUMPF	L$JUMP
	  JUMPE	T2,L$JUMP		;MUST BE PRIVATE SYMBOL
	  SETZM	0(T2)			;KLUDGE, JUST 0 SYM NAME
	  CAMN	T1,CURRAB		;UNDEF CURR RAB?
	  SETZM	CURRAB			;YES, LEAVE NAME FOR INFO
	  JRST	L$IFX
	$JUMP				;UNKNOWN OR NOT PRIVATE SYMBOL
	  $CALLB TX$TOUT,<[DB.NND##],R50VAL>	;TELL USER
	$ENDIF
	$CALL	P$COMMA			;MORE IN LIST?
	JUMPT	CUNDLP			;YES
	RETT				;NO, ALL DONE
$ENDPROC

SUBTTL	MEMORY MGR (TRIVIALIZED)

$PROC	(M.INIT)
;
; M.INIT - SET INIT VALS FOR POINTERS
;
	SKIPE	DDCURR			;SETUP YET?
	RETT				;YES
	$COPY	DDCURR,I DDTAB		;PT TO BEGINNING OF TABLE
	$COPY	ARBCURR,I ARBTAB	;DITTO
	RETT
$ENDPROC

$PROC	(M.ALC,<WORDS>)
;
; M.ALC - ALLOCATES SPECIFIED NUMBER OF WORDS
; ARGUMENTS:
;	WORDS = # OF WDS TO ALLOC
; RETURNS:
;	T1 = PTR TO WHAT ALLOC
	MOVE	T2,@WORDS(AP)		;GET AMT TO ALLOC
	$ENDARG
	MOVE	T1,ARBCURR		;CURR SPOT IN PRIVATE TABLE
	ADDB	T2,ARBCURR		;SAVE NEW 1ST FREE
	CAIL	T2,ARBTAB+SZ%ARB-1	;HIT LIMIT
	ERRU	(TFU)			;YES, TAB FULL
	RETT
$ENDPROC

SUBTTL	SYMBOL PROCESSOR

R50TAB:
	DEFINE ZW$R50(CMT$)<0>		;6 0 CODES
	DEFINE IW$R50(CD$)<BYTE(6)CD$,CD$+1,CD$+2,CD$+3,CD$+4,CD$+5>
	DEFINE EW$R50(A$,B$,C$,D$,E$,F$)<BYTE(6)A$,B$,C$,D$,E$,F$>
	ZW$R50(0)
	ZW$R50(6)
	ZW$R50(14)
	ZW$R50(22)
	ZW$R50(30)
	ZW$R50(36)
	EW$R50 46,47,0,0,0,0		;44
	EW$R50 0,0,0,0,45,0		;52
	IW$R50(1)			;60
	EW$R50 7,10,11,12,0,0		;66
	EW$R50 0,0,0,0,0,13		;74
	IW$R50(14)			;102=B
	IW$R50(22)			;110
	IW$R50(30)			;116
	IW$R50(36)			;124
	EW$R50 44,0,0,0,0,0		;132
	EW$R50 0,13,14,15,16,17		;140
	IW$R50(20)			;146
	IW$R50(26)			;154
	IW$R50(34)			;162
	EW$R50 42,43,44,0,0,0		;170
	ZW$R50				;176

$PROC	(SY.STOR,<ASZVAL>)
;
; SY.STOR - STORE SYMBOL IN PRIVATE TABLE
; ARGUMENTS:
;	ASZVAL = THE ASCIZ STRING TO STORE
; RETURNS:
;	TF = TRUE IF SYMBOL NOT ALREADY IN TABLE, FALSE OTHERWISE
;	T1 = SYMBOL NODE ADDRESS
	MOVEI	T5,@ASZVAL(AP)		;PT TO STRING
	$ENDARG
	HRLI	T5,440700		;MAKE BP TO IT
	$CALL	SYMR50			;BUILD RADIX50 VALUE INTO R50VAL
	$CALL	SYMPRV			;SEARCH PRIVATE SYMBOL TABLE
	JUMPT	L$RETF			;FAIL IF ALREADY THERE
	MOVE	T1,DDCURR		;CURR SPOT IN PRIVATE TABLE
	CAIL	T1,DDTAB+SZ%DDT		;HIT LIMIT
	ERRU	(TFU)			;YES, TAB FULL
	MOVEI	T2,SZ%DD(T1)		;HOP TO NEXT FREE SLOT
	MOVEM	T2,DDCURR		;SAVE NEW 1ST FREE
	$COPY	DD.NAM(T1),R50VAL	;PUT SYMBOL IN TABLE
	RETT				;RET SUC
$ENDPROC

$PROC	(SY.GET)
;
; SY.GET - PICK UP FIELD TOKEN AND FIND IN SYMTAB
; RETURNS:
;	TF = -1 IF SYMBOL FOUND
;		0 IF NOT FOUND
;	T1 = VALUE OF SYMBOL
;	T2 = ADDRESS OF SYMTAB NODE IF PRIV TAB OR 0 IF DDT TABLE
	$P	(FLD)			;GET TOKEN
	MOVEI	T5,TK.VAL(T1)		;PT TO STRING
	$CALL	SYFIND			;WITH T5
	RETURN				;TRANS RET SUCC/FAIL
$ENDPROC

$PROC	(SY.FIND,<ASZVAL>)
;
; SY.FIND - FIND A SYMBOL
; ARGUMENTS:
;	ASZVAL = THE SYMBOL NAME
; RETURNS AS FOR SY.GET
	MOVEI	T5,@ASZVAL(AP)		;PT TO STRING
	$ENDARG
	$CALL	SYFIND			;WITH T5
	JUMPF	L$RET			;TRANS RET FAILURE
	$FETCH	T3,BID,(T1)		;CHK WHAT FND
	CAIE	T3,RA$TYP		;RAB?
	RETT				;RET SUCC
	$COPY	CRABNM,R50VAL		;SAVE ITS NAME
	MOVEM	T1,CURRAB		;SAVE PTR TO IT
	RETT
$ENDPROC

SUBTTL	SYMBOL TABLE SUBROUTINES

$UTIL	(SYFIND)
;
; SYFIND - DOES REAL WORK OF FINDING SYMBOL
; ARGUMENTS:
;	T5 = PTR TO ASCIZ STRING
; RETURNS:
;	SEE SY.GET
	HRLI	T5,440700		;MAKE BP TO IT
	$CALL	SYMR50			;BUILD RADIX50 VALUE INTO R50VAL
	$CALL	SYMPRV			;SEARCH PRIVATE SYMBOL TABLE
	MOVEM	T1,T2			;PRESERVE SYMTAB ADDR
	JUMPT	L$RETV(DD.VAL(T1))	;SUC IF ALREADY THERE
	$CALL	SYMDD
	JUMPF	L$RET			;FAIL IF NOT THERE EITHER
	SETZM	T2			;DONT PT INTO DDT TABLE
	RETURN	(DD.VAL(T1))		;RET WITH VAL
$ENDUTIL

$UTIL	(SYMR50)
;
; SYMR50 - CONVERT ASCII SYMBOL TO RADIX 50
; ARGUMENTS:
;	T5 = BP TO ASCIZ STRING
; RETURNS:
;	R50VAL = RADIX50 VAL
	MOVEI	T1,6			;MAX SIGNIF CHAR
	SETZM	T2			;START WITH 0 VAL
SR50LP:
	LC	TAP,T5			;GET CHAR FROM SOURCE
	JUMPE	TAP,SR50EX		;EXIT ON NUL
	IMULI	T2,50			;MOVE OVER BY RADIX
	ADJBP	TAP,[POINT 6,R50TAB]	;GET TO RIGHT ENTRY
	LC	TAP,TAP			;GET MAPPED VAL
	ADD	T2,TAP			;MERGE IN CURR LOW-ORDER BYTE
	SOJG	T1,SR50LP		;KEEP SCANNING IF NOT TO 6TH CHAR
SR50EX:
	MOVEM	T2,R50VAL		;PERMANIZE SYMBOL
	RETURN
$ENDUTIL

$UTIL	(SYMPRV)
;
; SYMPRV - SEARCH PRIVATE SYMBOL TABLE FOR R50VAL
; RETURNS:
;	TF = TRUE IF SYMBOL FOUND
;	T1 = PTR TO SYMBOL NODE
	MOVEI	T5,DDTAB		;PT TO START OF TABLE
	MOVE	T4,DDCURR		;CURR END OF TABLE
	SUBM	T5,T4			;GET NEG TABLE SIZE IN LH
	JUMPGE	T4,L$RETF		;PRIVATE SYMTAB EMPTY
	HRL	T5,T4			;NOW AOBJ PTR
	JRST	SYMERG
;
$ENTRY	(SYMDD)
;
; SYMDD - SEARCH DDT SYMBOL TABLES FOR R50VAL
; RETURNS:
;	TF = TRUE IF SYMBOL FOUND
;	T1 = PTR TO SYMBOL NODE
	SKIPN	T5,116			;PICK UP SYMTAB FROM ABSOL (.JBSYM)
	RETF				;NO SYMS, NO FIND
SYMERG:
	LOAD	T1,DD.NAM(T5)		;PICK UP SYMBOL FROM TABLE
	CAMN	T1,R50VAL		;MATCH?
	JRST	SYMEX			;YES
	AOBJN	T5,.+1			;2ND WORD IN TAB ENTRY
	AOBJN	T5,SYMERG		;LOOP IF MORE TO CHK
	RETF				;SYM NOT FND
SYMEX:
	HRRZ	T1,T5			;ISOL SYM NODE PTR
	RETT				;RET SUC
$ENDUTIL

$ENDSCOPE	(TOP-LEVEL)

;XPUNGE
END