PDP-10 Archive: 7-sources/debact.mac from bb-h138f-bm

Trailing-Edge - PDP-10 Archives - bb-h138f-bm - 7-sources/debact.mac

There are 7 other files named debact.mac in the archive. Click here to see a list.

;
;	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 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.
;

TITLE	DEBACT - ACTION ROUTINES FOR RMSDEB
SUBTTL	S. COHEN/DAW
SEARCH	 RMSMAC,RMSINT
$PROLOG(DEB)
DEFINE $$CPON(X)<DB.>			;;FORCE MSG NAME DOTTED

OPDEF	PJRST	[JRST]

C$MAXB==^D17				;AAAA Highest supported block type

COMMENT	\
Revision history
 edit	Why
-------	---------------------------
   (2)	(DAW,19-Feb-82) Allocate 6 words for KNM in case $DISPLAY is done
	RMS assumes you have allocated 6 words for the key name.
   (3)	(AWN,16-Feb-83) Add new FAB fields & bits
   (4)	(AWN,12-Jul-83) Handle TOPS-20 DDT symbol table pointer (@770001)	
510(5)  (AWN,24-Sep-84) Handle $PARSE and $SEARCH
  10/3/85 asp - add Tops-10 conditionals
610(6)	(TGS,7-Mar-86) Allocate 7 words always for KNM field and chop
	long KNMs to 30-characters.
656(7)	XB$ACL is now XB$ACM and XB$PRO is now XB$PRM
\	;End comment

EXTERN A.TO.E, E.TO.A

; $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>
>

; $RBF - MACRO TO ALLOCATE RMS ARGBLK-BITFIELD DESCRIPTOR
;	 This stores bit number (bit 0 is low-order) instead of bit,
;	 so longer-than-18 bit bitfields are possible
;	 VALUE is still a bit mask, the macro converts it

DEFINE	$RBF (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/],<43-^L<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==<^D255/5>+1			;WDS IN KEY BUF
SZ%ARB==1600
SZ%DDT==200
RSSIZE==200
ESSIZE==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,3)			;SPACE FOR STRING PTR
$DATA	(TYPBLK)			;TYPE OF BLOCK IN INFO COMMAND
$DATA	(INIBLK)			;PTR TO INITIAL BLOCK (FOR ALCBLK)
$DATA	(BUFADD)			;ADDRESS OF BUFF TO USE IN EATDAT
$DATA	(CHADAT)			;ON IF CHANGE DATA FLD
$DATA	(SVP1T)
$DATA	(RSAREA,RSSIZE)			;Resultant String Area ;a511
$DATA	(ESAREA,ESSIZE)			;Expanded String Area  ;a511

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

;Messages

DB.FNU:	[ASCIZ/%DEBFNU FAB name unknown -- proceeding with initial-value FAB/]
DB.NND:	[ASCIZ/%DEBNND ^5 not defined/]

ASCSTR:	[ASCIZ/^A/]
DISSTR:	[ASCIZ/^S/]
FNACOL:	[ASCIZ/^A: ^N/]
FABINF:	[ASCIZ/^5	FAB	  ^A^A/]
RABINF:	[ASCIZ/^5	RAB	  ^A/]
XABINF:	[ASCIZ/^5	^A XAB/]
DAIINF:	[ASCIZ/^5	^A	  at W^1/]
DASINF:	[ASCIZ/^5	^A	  B^1 thru B^1/]
CONFCR:	[ASCIZ/Current RAB is  ^5/]
CONFNC:	[ASCIZ/No current RAB/]
CONFDD:	[ASCIZ/DEFINE DATA default is  ^A at ^1/]

ARYFMT:	[ASCIZ/^A^1: ^1/]

DABDEC:	[ASCIZ/^1/]			;Decimal number
DABOCT:	[ASCIZ/^2/]			;Octal number
DABDAT:	[ASCIZ/^D/]			;Date
DABFLO: [ASCIZ/^F/]			;Floating
DABDOU: [ASCIZ/^E/]			;Double
DABGFL: [ASCIZ/^G/]			;G-Floating
DABPAC:	[ASCIZ/^P/]			;Packed
DABLON:	[ASCIZ/^8/]			;Long integer
DABUNS: [ASCIZ/^U/]			;Unsigned Integer

ISSTRT: ^B010000001111			;Bit mask, on for string types
;	  UPLGDFOD6FEA


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/]
	[ASCIZ/FLOATING/]
	[ASCIZ/DOUBLE_FLOATING/]
	[ASCIZ/GFLOATING/]
	[ASCIZ/LONG_INTEGER/]
	[ASCIZ/PACKED/]
	[ASCIZ/8-BIT-ASCII/]
	[ASCIZ/UNSIGNED/]

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,<AVL,CCL,IDV,MDI,MNT,NET,ODV,REC,RMT,SQD,SPL,TRM>);M501
	$RF	(FB,FAC,<DEL,GET,PUT,TRN,UPD,BIO,BRO,APP>)		  ;M501
	$RF	(FB,FNA)
	$RF	(FB,FOP,<CIF,DFW,DRJ,SUP,WAT,SPL,SCF,DLT,NAM,CTG,LKO,TMP,MKD,OFP>)	;m501
	$RF	(FB,FSZ)					;m501
	$RF	(FB,IFI)
	$RF	(FB,JFN)
	$RF	(FB,JNL)
	$RF	(FB,MRN)
	$RF	(FB,MRS)
	$RF	(FB,ORG,<SEQ,REL,IDX>)
	$RF	(FB,NAM)					;m501
	$RF	(FB,RAT,<BLK,FTN,CR,PRN,EMB,CBL>)		;m501
	$RF	(FB,RFM,<VAR,STM,LSA,FIX,VFC,UDF,SCR,SLF>)	;m572
	$RF	(FB,SHR,<DEL,GET,PUT,TRN,UPD,BIO,BRO,APP>)	;m501
	$RF	(FB,TYP)					;m501
	$RF	(FB,XAB)
	$RF	(FB,ALQ)					;m501
	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==DT%SYA
F.FNA==DT%STR
F.MRN==DT%DEC
F.RFM==DT%SYV
F.JNL==$SH(INV)
F.XAB==DT%SYA
F.FSZ==DT%DEC				;M501
F.ALQ==DT%DEC				;M501
F.TYP==DT%SYA				;M501
F.NAM==DT%SYA				;M501

SUBTTL	$RF DESCRIPTORS FOR RAB

RABTAB:	$RF	(RB,BID)
	$RF	(RB,BLN)
	$RF	(RB,STS)
	$RF	(RB,STV)
	$RF	(RB,BKT)
	$RF	(RB,ELS)
	$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,TRA,BLK,BFT>)
	$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.ELS==DT%STR
F.PAD==DT%OCT

SUBTTL	$RF DESCRIPTORS FOR NAM

NAMTAB:

$RF (NA,BID)		;! BLOCK TYPE
$RF (NA,BLN)		;! BLOCK LENGTH
$RF (NA,ESA)		;! ADDRESS FOR EXPANDED STRING
$RF (NA,ESS)		;! BUFFSIZE FOR EXPANDED STRING
$RF (NA,ESL)		;! LENGTH OF EXPANDED STRING
$RF (NA,RLF)		;! ADDRESS OF RELATED NAM BLOCK
$RF (NA,NOP,<PWD,SYN>)	;! NAME OPTION BITS
$RF (NA,RSA)		;! ADDRESS FOR RESULTANT STRING
$RF (NA,RSL)		;! LENGTH OF RESULTANT STRING
$RF (NA,RSS)		;! BUFSIZE FOR RESULTANT STRING
$RBF (NA,FNB,<INV,GND,TFS,ACT,PRO,ULV,NHV,UHV,VER,EXT,NAM,DIR,UNT,DEV,NOD,QUO,EDE,EDI,ENA,ETY,EVE,MUL,WLD>)		;! NAME OPTION BITS
$RF (NA,WCC)			;! WILDCARD CONTEXT
$RF (NA,WCT)			;! NUMBER OF FILES FOUND
$RF (NA,WNX)			;! NUMBER OF FILES FOUND
$RF (NA,CHA,<CEX,CNA,CDI,CDE>)	;! WHAT FIELDS $SEARCH CHANGED
$RF (NA,NDL)			;! LENGTH OF NODEID
$RF (NA,DVL)		;! LENGTH OF DEVICE
$RF (NA,DRL)		;! LENGTH OF DIRECTORY
$RF (NA,NML)		;! LENGTH OF FILENAME
$RF (NA,TPL)		;! LENGTH OF EXTENSION
$RF (NA,VRL)		;! LENGTH OF DEVICE
$RF (NA,NDA)		;! POINTER TO NODEID
$RF (NA,DVA)		;! POINTER TO DEVICE
$RF (NA,DRA)		;! POINTER TO DIRECTORY
$RF (NA,NMA)		;! POINTER TO FILENAME
$RF (NA,TPA)		;! POINTER TO EXTENSION
$RF (NA,VRA)		;! POINTER TO DEVICE
Z

F.ESA==DT%SYA
F.RSA==DT%SYA
F.ESS==DT%DEC
F.RSS==DT%DEC
F.NOP==DT%SYB
F.ESL==DT%DEC
F.RSL==DT%DEC
F.RLF==DT%SYA
F.NDL==DT%DEC
F.DVL==DT%DEC
F.DRL==DT%DEC
F.NML==DT%DEC
F.TPL==DT%DEC
F.VRL==DT%DEC
F.NDA==DT%OCT
F.DVA==DT%OCT
F.DRA==DT%OCT
F.NMA==DT%OCT
F.TPA==DT%OCT
F.VRA==DT%OCT
F.FNB==DT%SBV
F.WCC==DT%OCT
F.WCT==DT%DEC
F.WNX==DT%DEC
F.CHA==DT%SYB

SUBTTL	$RF DESCRIPTORS FOR TYP
TYPTAB:

$RF (TY,BID)		;! BLOCK TYPE
$RF (TY,BLN)		;! BLOCK LENGTH
$RF (TY,CLA)		;! FILE CLASS
$RF (TY,FDT)		;! FIELD DATA TYPE
$RF (TY,FLN)		;! FIELD LENGTH
$RF (TY,FSC)		;! SCALE FACTOR
$RF (TY,NEX)		;! NEXT FIELD
$RF (TY,MOR)		;! NEXT VARIANT

F.CLA==DT%OCT
F.FDT==DT%OCT
F.FLN==DT%DEC
F.FSC==DT%DEC
F.NEX==DT%SYA
F.MOR==DT%SYA

SUBTTL	$RF DESCRIPTORS FOR XAB

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

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,<STG,EBC,SIX,PAC,IN4,FL1,FL2,GFL,IN8,AS8,UN4>)
	$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

;FILE SUMMARY XAB DEFINITIONS
XABCFG: $RF (XB,BID)
	$RF (XB,BLN)
	$RF	(XB,COD,<SUM,KEY,AREA,DATE,CFG>)
	$RF	(XB,NXT)
	$RF	(XB,BFS)	;! BUFFER SIZE
	$RF	(XB,OST)	;! OPERATING SYSTEM TYPE
	$RF	(XB,FIL)	;! FILE SYSTEM TYPE
	$RF 	(XB,VER)	;! DAP VERSION NUMBER
	$RF	(XB,ECO)	;! DAP ECO NUMBER
	$RF	(XB,USN)	;! USER VERSION NUMBER
	$RF	(XB,DSV)	;! SOFTWARE VERSION NUMBER    ;m555
	$RF	(XB,USV)	;! USER SOFTWARE VERSION NUMBER ;m555
	$RF	(XB,CAP,<PRE,SQO,RLO,DRO,EXT,SQT,RRE,RVB,RKE,RHA,RRF,IMK,SWA,APA,SBA,CMP,MDS,DIS,BLR,BLU,XLN,CHK,KEM,ALM,SMM,DIR,DTM,PRM,ACM,FPR,FSB,FDE,DFS,SQA,REC,BIT,WAR,REN,WLD,GO,NAM,SEG,CAT,CDT,CPR,CNA,MAT,D3N,RAT,RDT,RPR,BCS,OVN>)
;	$RF	(XB,CAP)	;! SYSCAP BITS
;	$RF	(XB,CA1)	;!  CONTINUATION OF SYSCAP BITS
;	$RF	(XB,CA2)	;!  CONTINUATION OF SYSCAP BITS
	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%ST6
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

;FLAG DEFINITIONS FOR CONFIG XAB:
F.BFS==DT%DEC	;! BUFFER SIZE
F.OST==DT%DEC	;! OPERATING SYSTEM TYPE
F.FIL==DT%DEC	;! FILE SYSTEM TYPE
F.VER==DT%DEC	;! DAP VERSION NUMBER
F.ECO==DT%DEC	;! DAP ECO NUMBER
F.USN==DT%DEC	;! USER VERSION NUMBER
F.DSV==DT%DEC	;! SOFTWARE VERSION NUMBER 				;m555
F.USV==DT%DEC	;! USER SOFTWARE VERSION NUMBER				;m555
F.CAP==DT%SBV	;! SYSCAP BITS
F.CA1==$SH(INV)	;! SYSCAP BITS
F.CA2==$SH(INV)	;! SYSCAP BITS						;A554^^

SUBTTL	DISPLAY DESCRIPTORS FOR INTERNAL BLOCKS
LALL

FSTTAB:
	$RF	(FS,BID)
	$RF	(FS,BLN)
	$RF	(FS,FLI)
	$RF	(FS,BLI)
	$RF	(FS,ADB)
	$RF	(FS,JFN)
	$RF	(FS,BKT)
	$RF	(FB,IOR,<SEQ,REL,IDX>)
	$RF	(FS,IFG,<LKF,LOK,UDF,NEW,ILK,REO,RMT>)			;m501
	$RF	(FS,IDV)
	$RF	(FB,IRF,<VAR,STM,LSA,FIX,VFC,UDF,SCR,SLF>)		;m572
	$RF	(FB,ISH,<GET,UPD,PUT,DEL,TRN,BIO,BRO,APP,SMU>)
	$RF	(FB,IFA,<GET,UPD,PUT,DEL,TRN,BIO,BRO,APP,SMU>)
	$RF	(FS,IRS)
	$RF	(FS,MBS)
	$RF	(FS,BFN)
	$RF	(FS,BMN)
	$RF	(FS,BLO)
	$RF	(FS,IRN)
	$RF	(FB,IFO,<WAT,CIF,DRJ,DFW,SUP,SPL,SCF,DLT,NAM,CTG,LKO,TMP,MKD,OFP>)
	$RF	(FS,KBS)
	$RF	(FS,KDB)
	$RF	(FB,IRA,<BLK,FTN,CR,PRN,EMB,CBL>)
	$RF	(FS,IBS)
	$RF	(FS,DLA)
	$RF	(FS,ICT)
	$RF	(FS,SZF)
	Z


F.FLI==DT%SYA
F.BLI==DT%SYA
F.ADB==DT%SYA
F.IJF==DT%OCT
F.IBK==DT%SYA
F.IOR==DT%SYZ
F.IFG==DT%SYB
F.IDV==DT%DEC
F.IRF==DT%SYV
F.ISH==DT%SYB
F.IFA==DT%SYB
F.IRS==DT%DEC
F.MBS==DT%DEC
F.BFN==DT%DEC
F.BMN==DT%DEC
F.BLO==DT%DEC
F.IRN==DT%DEC
F.IFO==DT%SYB
F.KBS==DT%DEC
F.KDB==DT%SYA
F.IRA==DT%SYB
F.IBS==DT%DEC
F.DLA==DT%SYA
F.ICT==DT%OCT
F.SZF==DT%DEC



RSTTAB:
	$RF	(RS,BID)
	$RF	(RS,BLN)
	$RF	(RS,FLI)
	$RF	(RS,BLI)
	$RF	(RS,SFG,<PAR,EOF,LOK,SUC,UPD,SEQ,TRN>)
	$RF	(RS,FST)
	$RF	(RS,RSW)
	$RF	(RS,RSB)
	$RF	(RS,PTR)
	$RF	(FB,SRF)
	$RF	(RS,NRP)
	$RF	(C,OPR,<OPEN,CLOSE,GET,PUT,UPDATE,DELETE,FIND,TRUNCATE,CONNECT,DISCONNECT,CREATE,DEBUG,RELEASE,FLUSH,MESSAGE,NOMESSAGE,DISPLAY,ERASE,FREE,UTLINT,NXTVOL,REWIND,WAIT,READ,SPACE,WRITE,PARSE,SEARCH,ENTER,EXTEND,REMOVE,RENAME>)
	$RF	(RS,HSZ)
	$RF	(RS,BDC)
	$RF	(RS,SKB)
	$RF	(RS,BKB)
	$RF	(RS,BKA)
	$RF	(RS,BKS)
	$RF	(BK,BKF,<LOK>)
	$RF	(RS,BKN)
	$RF	(RS,HBY)
	$RF	(RS,BYC)
	$RF	(RS,KRN)
	$RF	(RS,SKR)
	$RF	(RS,SRR)
	$RF	(RS,SDR)
	$RF	(RS,SDT)
	$RF	(RS,BFP)
	$RF	(RS,BFU)
	$RF	(ZZ,BFO,<MODIFIED>)
	$RF	(RS,BFZ)
	$RF	(RS,BFN)
	Z

F.SFG==DT%SYB
F.FST==DT%SYA
F.RSW==DT%DEC
F.RSB==DT%DEC
F.PTR==DT%OCT
F.SRF==DT%OCT
F.NRP==DT%DEC
F.OPR==DT%SYV
F.HSZ==DT%DEC
F.BDC==DT%DEC
F.SKB==DT%SYA
F.BKD==$SH(INV)
F.BKB==DT%SYA
F.BKA==DT%SYA
F.BKS==DT%DEC
F.BKF==DT%SYB
F.BKN==DT%DEC
F.HBY==DT%DEC
F.BYC==DT%DEC
F.KRN==DT%DEC
F.SKR==DT%DEC
F.SRR==DT%DEC
F.SDR==DT%OCT
F.SDT==DT%OCT
F.BFP==DT%OCT
F.BFU==DT%DEC
F.BFO==DT%SYB
F.BFZ==DT%DEC
F.BFN==DT%OCT

ZZ$MODIFIED==1


KDBTAB:
	$RF	(KD,BID)
	$RF	(KD,BLN)
	$RF	(KD,KKR)
	$RF	(KD,ROO)
	$RF	(KD,IDB)
	$RF	(XB,KDT,<STG,EBC,SIX,PAC,IN4,FL1,FL2,GFL,IN8,AS8,UN4>)
	$RF	(KD,HSZ)
	$RF	(KD,KNX)
	$RF	(KD,KFG,<NIX,CHD,DUP,CHG,HSH>)
	$RF	(KD,KDA)
	$RF	(KD,KIA)
	$RF	(KD,DBK)
	$RF	(KD,IBK)
	$RF	(KD,MNR)
	$RF	(KD,LEV)
	$RF	(KD,KBZ)
	$RF	(KD,DFL)
	$RF	(KD,IFL)
	$RF	(KD,KSW)
	$RF	(KD,KSB)
	Z

F.KKR==DT%DEC
F.ROO==DT%DEC
F.IDB==DT%SYA
F.KDT==DT%SYV
F.HSZ==DT%DEC
F.KNX==DT%SYA
F.KFG==DT%SYB
F.KDA==DT%DEC
F.KIA==DT%DEC
F.DBK==DT%DEC
F.IBK==DT%DEC
F.MNR==DT%DEC
F.LEV==DT%DEC
F.KBZ==DT%DEC
F.DFL==DT%OCT
F.IFL==DT%OCT
F.KSW==DT%DEC
F.KSB==DT%DEC

SALL

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
NAMINI:
	NAM$B
	N$ESA	ESAREA
	N$RSA	RSAREA
	N$ESS	ESSIZE
	N$RSS	RSSIZE
	NAM$E
TYPINI:
	TYP$B
	TYP$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
XCINI:
	XAB$B	(CFG)
	XAB$E

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

SUBTTL	PROCESS ASSIGN, CHANGE, AND DEFINE DEFINE CMD

$SCOPE	(DEFINE-BLOCK)

;Some registers

P1==6
P2==7
DD==10		;Ptr to entry in (DDT-like) symtab
PB==11		;Ptr to curr RMS arg blk
RF==12

; DO.ASSIGN = INIT BLK FROM ADDRESS RATHER THAN BY ALLOCATION
; NOTES:
;	ASSIGN (NAME) name (TO ADDRESS) octal-number

DO.ASSIGN::
	$P	(FLD)			;PICK UP FIELD BEING DEFINED
	MOVEI	T1,TK.VAL(T1)		;Point to ASCIZ string of name.
	PUSHJ	P,SY.STOR		;Put in table if not already there
	JUMPF	L$ERRU(NAD)		;NAME ALREADY DEFINED
	PUSH	P,T1			;PRESERVE DD SYMBLK PTR
	$P	(NUM)			;GET THE ADDRESS
	POP	P,T2
	MOVEM	T1,DD.VAL(T2)		;PUT IT AWAY
	$FETCH	T2,BID,(T1)		;CHK IF RAB
	CAIE	T1,RA$TYP		;IS IT?
	 JRST	RTRUE			;NO, DONE
	MOVEM	T1,CURRAB		;SAVE PTR TO IT
	MOVE	T1,R50VAL		;SAVE ITS NAME
	MOVEM	T1,CRABNM
	JRST	RTRUE

SUBTTL	PROCESSOR FOR CHANGE CMD

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

DO.CHANGE::
	PUSHJ	P,%SAVEP		;SAVE PERM AC'S
	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?
	 JRST	NOTDAF			;NO
	JUMPE	PB,L$ERRU(NRC)		;NO RAB CURR
	JRST	CHGDAT			;MERGE THE DATA PATH

NOTDAF:	MOVEM	T1,PB			;PERMANIZE ARGBLK PTR
CHG.LP:	$CALL	P$KEYW			;CHK IF ARGBLK FLD
	JUMPT	CHGKWD			;YES IF JUMP
	$CALL	SY.GET			;NO, IS DATAFLD
	JUMPT	CHGDAT			;PROCEED
	$CALLB TX$OUT,<R50VAL,DB.NND> ;TELL USER
	$CALL P$NFLD			;HOP OVER VALUE
	JRST	CHGPCM			;PROCEED TO NEXT FLD (OR EOL)

CHGDAT:	MOVEM	T1,RF			;PERMANIZE FLD PTR
	$CALL	EATDAT			;PROCESS IT
	JRST	CHGPCM

;ARGBLK data

CHGKWD:	JUMPE	T1,CHGKEY		;ACTU NO, IS KEY-BUFFER
	MOVEM	T1,RF			;PERMANIZE IT
	$CALL	EATRFV			;EAT ARGBLK VALUE

;Here when done with field

CHGPCM:	$CALL	P$COMMA			;MORE IN LIST?
	JUMPT	CHG.LP			;YES
	JRST	RTRUE			;RETURN

;"CHANGE KEY-BUFFER"

CHGKED:	JUMPE	PB,L$ERRU(NRC)		;NO RAB CURR
CHGKEY:
	MOVEI	RF,KEYINI		;USE DUMMY UF
	$CALL	EATKEY			;DO THE WORK
	JRST	RTRUE

;
; EATDAT - EAT USER DATA FLD VALUE
;

EATDAT:	SETZM	BUFADD			;USE RBF BELOW
	LOAD	T2,UF.TYP(RF)		;GET TYPE OF FLD
	CASES	T2,MX%DFT
$CASE	(DFT%SIX)
	MOVEI	TAP,40			;CONV FACTOR
	MOVSI	T5,(POINT 6,)		;SIXBIT BYTE INFO
EATSTR:
	$P	(QSTR,WDT)		;PICK UP THE STRING
	MOVEI	T3,TK.VAL(T1)		;GET ADDR OF NEW VAL
	HRLI	T3,(POINT 7,)		;SETUP BP TO IT
	SKIPN	T1,BUFADD		;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			;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:
	ILDB	T1,T3			;GET A CHAR
	JUMPE	T1,EASCLE		;END?
	JUMPGE	TAP,EASCL1		;EBCDIC?		;M501

	ROT	T1,-1			;TABLE HAS 2 PER WORD
	JUMPL	T1,EASCL0
	HLRZ	T1,A.TO.E(T1)		;GET TRANSLATED CHARACTER
	JRST	EASCL1
EASCL0: HRRZ	T1,A.TO.E(T1)		;GET TRANSLATED CHARACTER

EASCL1: JUMPE	TAP,EASCL2		;SEE IF SIXBIT-ISH CONVERSION	;A575
	CAIL	T1,140			;IT IS, MAKE SURE CHAR UPPERCASE;A575
	 MOVEI	T1,-40(T1)		;MAKE IT SO			;A575
	SUB	T1,TAP			;CONV IF NECES
EASCL2:	IDPB	T1,T4			;NO, PUT IT AWAY
	SOJG	T5,EASCLP		;MORE LEFT?
	POPJ	P,			;FILLED FLD
EASCLE:
	$FETCH	T1,ROP,(PB)		;SEE IF PAD REQUESTED		;A575
	TXNN	T1,RB$PAD		;BY CHECKING BIT IN ROP		;A575
	 SKIPA	T1,[" "]		;PAD WITH SPACES		;M575
	$FETCH	T1,PAD,(PB)		;PAD WITH PAD CHAR IF SPECIFIED ;A575
	SUB	T1,TAP			;CONVERT IF NECES
	IDPB	T1,T4			;PUT IT AWAY
	SOJG	T5,.-1			;DONE YET
	POPJ	P,

$CASE	(DFT%PAC)			;Packed Decimal data		;A411
	$P	(FLD,WDT)		;Parses as Field
	MOVEI	T3,TK.VAL(T1)		;GET ADDR OF NEW VAL
	HRLI	T3,(POINT 7,)		;SETUP BP TO IT
	SKIPN	T1,BUFADD		;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
	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			;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 OF FIELD
	$CALLB	CVTZP,<T3,T4,T5>	;Convert it
	POPJ	P,			;FILLED FLD

$CASE	(DFT%EBC)			;EBCDIC				;A501
	SKIPA	TAP,[-40]		;CONVERSION FACTOR FOR SPACE
					;AND FLAG FOR EBCDIC TRANSLATION
$CASE	(DFT%ASC)							;A411
$CASE	(DFT%FIL)
EATFIL:  SETZM	TAP			;NO CONVERSION			;a501
	$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,6			;SIXBIT?
	 JRST	L$CASE(DFT%SIX)		;YES
	CAIG	T1,9			;9-Bit ASCII?			;M501
	CAIGE	T1,7			;ASCII?				;M501
	 ERRU	(BSI)			;BYTE SIZE ILLEGAL FOR INPUT	;M501
	SKIPA	T5,T1			;Yes. Get byte size in T5	;M501
					;8-bit ASCII OK too		; 501

	;Field is either 7-bit, 8-bit or 9-bit ASCII

	$P	(QSTR,WDT)		;PICK UP THE STRING		;d501
	LSH	T5,^D24			;Move byte size to correct place ;A411
	TLO	T5,440000		;Set position field		 ;A411
	JRST	EATSTR			;MERGE

$CASE	(DFT%UNS)
	$P	(UQSTR,WDT)		;Parses as unquoted string	;A411
	MOVEI	T3,TK.VAL(T1)		;GET ADDR OF NEW VAL
	HRLI	T3,(POINT 7,)		;SETUP BP TO IT
	$FETCH	T1,RBF,(PB)		;NO, GET RECORD BUFFER PTR
	$CALLB	CVTZU##,<T3,T1>		;Convert it
	POPJ	P,			;FILLED FLD
$CASE	(DFT%DOU)			;DOUBLE FLOATING		;A411
	$P	(UQSTR,WDT)		;Parses as unquoted string	;A411
	MOVEI	T3,TK.VAL(T1)		;GET ADDR OF NEW VAL
	HRLI	T3,(POINT 7,)		;SETUP BP TO IT
	$FETCH	T1,RBF,(PB)		;NO, GET RECORD BUFFER PTR
	$CALLB	CVTZD##,<T3,T1>		;Convert it
	POPJ	P,			;FILLED FLD
$CASE	(DFT%GFL)			;GFLOATING			;A411
	$P	(UQSTR,WDT)		;Parses as unquoted string	;A411
	MOVEI	T3,TK.VAL(T1)		;GET ADDR OF NEW VAL
	HRLI	T3,(POINT 7,)		;SETUP BP TO IT
	$FETCH	T1,RBF,(PB)		;NO, GET RECORD BUFFER PTR
	$CALLB	CVTZG##,<T3,T1>		;Convert it
	POPJ	P,			;FILLED FLD
$CASE	(DFT%LON)
	$P	(UQSTR,WDT)		;Parses as unquoted string	;A411
	MOVEI	T3,TK.VAL(T1)		;GET ADDR OF NEW VAL
	HRLI	T3,(POINT 7,)		;SETUP BP TO IT
	$FETCH	T1,RBF,(PB)		;NO, GET RECORD BUFFER PTR
	$CALLB	CVTZL##,<T3,T1>		;Convert it
	POPJ	P,			;FILLED FLD

$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
	POPJ	P,

$CASE	(DFT%FLO)			;Single Floating Point		;A411
	$P	(FLOT,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
	POPJ	P,
$CASX

;
;
; EATKEY - ENTER DATA IN KEY BUFFER
;

EATKEY:	$FETCH	T3,KBF,<(PB)>		;SET UP BUFF LOC IMMED
	JUMPN	T3,EATK1		;IS THERE 1?
	MOVEI	T1,SZ%KBUF		;KEY BUFFER SET FROM CONSTANT
	PUSHJ	P,M.ALC			;...KSZ MAY BE SMALL FOR GENERIC KEY
	$STORE	T1,KBF,<(PB)>		;PUT AWAY PTR
	MOVE	T3,T1			;SO CAN BE USED AFTER P$NUM

EATK1:	$CALL	P$NUM			;THE EASY CASE?	
	JUMPF	EATK2			;NO, IF JUMP
	MOVEM	T1,0(T3)		;PUT IT AWAY
	POPJ	P,			;DONE

EATK2:	MOVEM	T3,BUFADD		;PERMANIZE START ADDR
	$CALL	P$CURR			;PREP TO COMPUTE LEN OF ENTERED STRING
	MOVEI	T1,TK.VAL(T1)		;PT TO STRING
	HRLI	T1,(POINT 7,)		;...AND MAKE IT A BP
	SETZM	T3			;INIT CNT
	ILDB	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	EATFIL			;PASSING BUFADD

;
; DO.DEFINE - PROCESS DEFINE CMD
;

DO.DEFINE::
	PUSHJ	P,%SAVEP		;SAVE PERM AC'S
	$P	(KEYW)			;PICKUP THE KEYWORD VAL
	CASES	T1,MX%DEF		;DISPATCH OFF TYPE OF BLK
$CASE	(DEF%DAT)
	MOVEI	T1,FLDINI		;Data field desc init vals
	MOVEM	T1,INIBLK
	PUSHJ	P,ALCBLK		;ALLOCATE A BLOCK
	$P	(KEYW)			;PICK UP DATA TYPE
	STOR	T1,UF.TYP(PB)		;STORE DATA TYPE
	MOVEI	T2,1			;Test				;A411
	LSH	T2,(T1)			; stringness			;A411
	TDNN	T2,ISSTRT		;  data type is string if lit	;A411
	 JRST	[$CALL DEDINT		;YES, PROC INTEGER
		JRST RTRUE]
	$CALL	DEDSTR			;NO, PROC STRING
	JRST	RTRUE
$CASE	(DEF%RAB)
	MOVEI	T1,RABINI		;SETUP A RAB
	MOVEM	T1,INIBLK
	PUSHJ	P,ALCBLK
	PUSH	P,R50VAL		;SAVE ITS NAME
	POP	P,CRABNM
	MOVEM	PB,CURRAB		;SAVE PTR TO IT
	$CALL	SY.GET			;GET FAB PTR
	JUMPT	OKFABP			;JUMP IF FAB OK
	$CALLB TX$OUT,<DB.FNU>		;FAB NAME UNKNOWN, CON WITH INIT VAL FAB
	MOVEI	T1,FABINI		;USE INIT VALUES FAB RATHER THAN ABORT
OKFABP:	$STORE	T1,FAB,(PB)		;PUT AWAY PTR
	$CALL	DEFSWIT
	$FETCH	T1,USZ,(PB)		;GET SIZE TO ALLOC
	JUMPN	T1,OKUSZ		;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	T1,1(T1)		;ADJ FOR POSSIB TRUNC
	$STORE	T1,USZ,(PB)		;PUT IT AWAY

;Here with T1= # words to allocate for user's buffer

OKUSZ:	PUSHJ	P,M.ALC			;GET USER BUFFER
	$STORE	T1,UBF,(PB)		;PUT AWAY PTR
	$STORE	T1,RBF,(PB)		;PUT AWAY PTR
	$FETCH	T5,RSZ,(PB)		;GET SIZE TO ALLOC
	JUMPN	T5,DFRABD		;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
DFRABD:	JRST	RTRUE
$CASE	(DEF%NAM)
	MOVEI	T1,NAMINI		;SETUP A RAB
	MOVEM	T1,INIBLK
	PUSHJ	P,ALCBLK
	PUSH	P,R50VAL		;SAVE ITS NAME
	POP	P,CRABNM
	$CALL	DEFSWIT
	$FETCH	T1,ESS,(PB)		;GET SIZE TO ALLOC
	JUMPE	T1,DEFNA1		;NOTHING
	ADDI	T1,4			;
	IDIVI	T1,5			;MAKE INTO WORDS
	PUSHJ	P,M.ALC			;GET USER BUFFER
	HRLI	T1,440700		;MAKE BYTE POINTER		;m544
	$STORE	T1,ESA,(PB)		;STORE IN NAM BLOCK

DEFNA1:	$FETCH	T1,RSS,(PB)		;GET SIZE TO ALLOC
	JUMPE	T1,RTRUE		;NOTHING
	ADDI	T1,4			;
	IDIVI	T1,5			;MAKE INTO WORDS
	PUSHJ	P,M.ALC			;GET USER BUFFER
	HRLI	T1,440700		;MAKE BYTE POINTER		;m544
	$STORE	T1,RSA,(PB)		;STORE IN NAM BLOCK
	JRST	RTRUE

$CASE	(DEF%FAB)
	MOVEI	T1,FABINI		;SETUP A FAB
	MOVEM	T1,INIBLK
	PUSHJ	P,ALCBLK
	$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
	JRST	RTRUE

$CASE	(DEF%XAB)
	SETZM	INIBLK			;INDIC INIBLK DET IN ALCBLK
	PUSHJ	P,ALCBLK
	$CALL	DEFSWIT			;PROCESS SWITCHES
	JRST	RTRUE

$CASE	(DEF%TYP)			;TYPE BLOCK		    ;A510 VV
	MOVEI	T1,TYPINI		; SET UP PROTOTYPE
	MOVEM	T1,INIBLK		; SO ALCBLK CAN FIND IT
	PUSHJ	P,ALCBLK
	$CALL	DEFSWIT			;PROCESS SWITCHES
	JRST	RTRUE						    ;A510 ^^

SUBTTL	SUBROUTINES COMMON TO ASSIGN, DEFINE, AND CHANGE

;
; 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
;	DD = DDT SYMBLK PTR

ALCBLK:	$P	(FLD)			;PICK UP FIELD BEING DEFINED
	MOVEI	T1,TK.VAL(T1)		;Get ptr to ASCIZ name
	PUSHJ	P,SY.STOR		;Put in table if not already there
	JUMPF	L$ERRU(NAD)		;NAME ALREADY DEFINED
	MOVEM	T1,DD			;PRESERVE DD SYMBLK PTR
	SKIPE	T1,INIBLK		;Did user tell us an initial block?
	 JRST	GOTIB			;Yes
	$P	(KEYW)			;NO, PICK UP XAB TYPE
	MOVE	T1,XABINI(T1)		;GET INIT ARGBLK ADDR

;Here with T1 = initial block ptr.

GOTIB:	PUSH	P,T1			;Save it..
	$FETCH	T1,BLN,<(T1)>		;GET LEN OF ARGBLK NEEDED
	PUSHJ	P,M.ALC			;ALLOC A BLK
	MOVEM	T1,PB			;PRESERVE PTR TO BLK
	MOVEM	T1,DD.VAL(DD)		;SET VALUE OF SYMBOL TO ADDR OF ARGBLK
	POP	P,T2			;T2= initial block ptr.
	HRL	T1,T2			;GET ADDR OF INIT VALS
	$FETCH	T2,BLN,<(T2)>		;GET ARGBLK'S LEN BACK
	ADDI	T2,-1(PB)		;GET LAST WORD OF BLK
	BLT	T1,0(T2)		;COPY INIT VALS TO ALLOC BLK
	POPJ	P,			;RETURN

; ALCSTR - ALLOC SPACE FOR AND COPY STRING TO SPACE ALLOCATED
; RETURNS:
;	T1 = PTR TO ALLOCATED BLK

ALCSTR:	$CALL	P$NFLD			;GET DATA FOR CURR FIELD
	PUSHJ	P,%SAVEP		;Save perm ac's.
	MOVSI	P1,TK.VAL(T2)		;SAVE ADDR AND PREP TO BLT
	LOAD	P2,TK.LEN(T2)		;GET WD LEN OF TOK (INCL HDR)
	MOVEI	T1,-1(P2)		;REMOVE HDR WD FROM LEN
	PUSHJ	P,M.ALC			;GRAB THE SPACE
	HRRM	T1,P1			;FINISH SETTING UP BLT AC
	ADDM	T1,P2			;END OF BLT
	BLT	P1,-1(P2)		;MOVE THE DATA
	POPJ	P,			;RETURN WITH T1 = PTR TO BLK

;[610]
; ALCST6 - ALLOC SPACE FOR AND COPY STRING TO SPACE ALLOCATED
;	   GUARANTEED MINIMUM OF 6 WORDS+1
; RETURNS:
;	T1 = PTR TO ALLOCATED BLK

ALCST6:	$CALL	P$NFLD			;GET DATA FOR CURR FIELD
	PUSHJ	P,%SAVEP		;Save perm ac's
	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
	MOVEI	T1,7			;[610] ALLOCATE SEVEN WORDS
	PUSHJ	P,M.ALC			;[610]
	HRRM	T1,P1			;FINISH SETTING UP BLT AC
	CAILE	P2,6			;[610] IF GREATER THAN 6...
	 MOVEI	P2,6			;[610] MOVE ONLY 6
	ADDM	T1,P2			;[610] END OF BLT
	BLT	P1,-1(P2)		;MOVE THE DATA
	POPJ	P,			;RETURN WITH T1 = PTR TO BLK

;
; DEDINT - PROCESS INTEGER DATA FIELD
;
;Input:
;	PB/ ptr to block
;	DD/ symblk ptr

DEDINT:	$CALL	P$NUM			;WORD OFFSET SPEC?
	MOVE	T3,CSTYPE		;GET STRING TYPE
	MOVE	T3,BPWVEC(T3)		;GET BYTES PER WORD
	JUMPT	DEDIN1			;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

DEDIN1:	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	RTRUE			;NO, DONE
	$CALL	P$KEYW			;IS THERE A VALUE?
	JUMPF	RTRUE			;NO, DONE
	STOR	T1,UF.TYP(PB)		;JUST EXPLODE INT TO DEC/OCT
	POPJ	P,			;DONE

; DEDSTR - PROCESS STRING DATA FIELD
;
;Input:
;	PB/ address of block
;	DD/ symblk ptr

DEDSTR:	$P	(NUM)			;GET THE LENGTH
	STOR	T1,UF.SIZ(PB)		;STORE SIZE
	$CALL	P$NUM			;CHK FOR POS
	JUMPT	DEDST1			;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

DEDST1:	STOR	T1,UF.POS(PB)		;PUT IT AWAY
	$INCR	T1,UF.SIZ(PB)		;HOP OVER CURR FLD
	MOVEM	T1,CPOSIT		;PERMANIZE NEW DEFAULT
	LOAD	T2,UF.TYP(PB)		;UPDATE CURR STRING TYPE
	MOVEM	T2,CSTYPE
	POPJ	P,

;Here if error in DEDINT or DEDSTR

DEDERR:	SETZM	0(DD)			;CLEAR OUT ABORTED DEF
	ERRU	(NPS)			;TELL USER

; DEFSWIT - SCANS PARSER OUTPUT TILL EOL
;
DEFSWIT:
ESW.LP:
	$CALL	P$CFM			;IS IT EOL?
	JUMPT	[POPJ P,]		;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

; EATRFV - EAT RMS FIELD VALUE
;
EATRFV:	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	[POPJ P,]		;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
	POPJ	P,
$CASE	(DT%ST6)			;Same, except 6 words minimum
	$CALL	ALCST6			;GRAB SPACE AND COPY
	DPB	T1,RF%BP(RF)		;PUT AWAY PTR
	POPJ	P,
$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
	POPJ	P,
$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$CASE(DT%SYB)		;GET NEXT VALUE
	DPB	P1,RF%BP(RF)		;STORE AWAY ACCUM VAL
	POPJ	P,			;CHK FOR EOL
$CASE	(DT%SBV)			;SYMBOLIC BITVECTOR		;A511vv
	$P	(KEYW)			;GET SYM VALUE SPECIFIED
	MOVEI	T2,1			;MAKE A BIT
	LSH	T2,(T1)			;SHIFT IT LEFT TO MAKE A BIT MASK
	IOR	P1,T2			;MERGE IN VALUE
	$CALL	P$TOK			;CHK FOR PLUS
	JUMPT	L$CASE(DT%SBV)		;GET NEXT VALUE
	DPB	P1,RF%BP(RF)		;STORE AWAY ACCUM VAL
	POPJ	P,			;CHK FOR EOL			;a511^^
$CASF
	ERRU	(IER)			;INTERNAL ERROR

SUBTTL	PROCESS DISPLAY COMMAND

; DO.DISPLAY - DISPLAY USER FIELD OR ARG BLK
; NOTES:
;	DISPLAY <argblk-NAME> [argblk-fld-list]
;	DISPLAY [argblk-name] DATA!KEY-BUFFER!datfld-list
;
DO.DISPLAY::
	PUSHJ	P,%SAVEP		;SAVE PERM AC'S
	MOVE	PB,CURRAB		;PRESUME USE CURRENT RAB
	$CALL	P$KEYW			;CHK FOR DATA or KEY-BUFFER
	JUMPF	DSP1			;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
DSP1:	$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?
	 JRST	DSP2			;NO
	JUMPE	PB,L$ERRU(NRC)		;YES, NO CURRENT RAB?
	JRST	DSPDL1			;MERGE THE DATA-LIST PATH

DSP2:	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
	CAIG	T1,MX%DSN	;SMALL NUMBER				;a577
	 JRST	DSPFSP		;YES. DISPLAY FILESPEC FROM NAME BLOCK  ;a577
	MOVEM	T1,RF		;PERMANIZE RMS FIELD DESCRIPTOR
	$CALL	DABVAL		;DISPLAY ONE VALUE
	$CALL	P$COMMA		;MORE IN LIST?
	JUMPT	DSPABL		;YES
	JRST	RTRUE		;NO

DSPABA:				;DISPLAY ARGBLK
	$FETCH	T1,BID,(PB)	;GET ID
	CASES	T1,C$MAXB	;DISPATCH OFF IT			;AAAA
$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)
IFE <XA$TYP-FS$TYP>,<		; Same value was used for both		;AAAA
	$FETCH	T1,BLN,(PB)	; Get length of block			;AAAA
	CAIN	T1,FS$LNG	; Same as FST?				;AAAA
	 JRST	[MOVEI RF,FSTTAB ; Yes. it is an FST			;AAAA
		 JRST L$CASX]	; 					;AAAA
	>								;AAAA
	$FETCH	T1,COD,(PB)	;GET CODE FIELD
	MOVE	RF,XABTAB(T1)	;PICKUP FLD TABLE FOR APPROP XAB TYPE
	JRST	L$CASX
IFN <XA$TYP-FS$TYP>,<		; Unfortunately, these are the same	;AAAA
	MOVEI	RF,FSTTAB	; Get desc for FST			;AAAA
	JRST	L$CASX		;					;AAAA
	>			;					;AAAA
$CASE	(RS$TYP)		; RST					;AAAA
	MOVEI	RF,RSTTAB	;					;AAAA
	JRST	L$CASX		;					;AAAA
$CASE	(KD$TYP)		; KDB					;AAAA
	MOVEI	RF,KDBTAB	;					;AAAA
	JRST 	L$CASX							;AAAA
$CASE	(NA$TYP)
	MOVEI	RF,NAMTAB	; NAM					;A510
	JRST	L$CASX		;					;A510
$CASE	(TY$TYP)
	MOVEI	RF,TYPTAB	; NAM					;A510
	JRST	L$CASX		;					;A510
$CASF
	ERRU	(IER)
$CASX
DABALP:
	SKIPN	0(RF)		;THRU?
	 JRST	RTRUE		;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

DSPFSP:	; DISPLAY FILESPEC FROM NAM BLOCK				;A577
	CASES	T1,MX%DSN	;DISPATCH OFF IT
$CASE	(DSN%DA)
$CASE	(DSN%KE)
	RET			;HANDLED ELSEWHERE
$CASE	(DSN%EX)
	$FETCH	T2,ESA,(PB)	;GET EXP STRING PTR
	$FETCH	T3,ESL,(PB)	;ITS LEN
	JUMPE	T2,RTRUE	;NO BUFF
	JRST	DSPFS1		;MERGE TO OUTPUT STRING
$CASE	(DSN%RE)
	$FETCH	T2,RSA,(PB)	;GET RESULTANT STRING PTR
	$FETCH	T3,RSL,(PB)	;ITS LEN
	JUMPE	T2,RTRUE	;NO BUFF
	JRST	DSPFS1		;MERGE TO OUTPUT STRING
$CASE	(DSN%NO)
	$FETCH	T2,NDA,(PB)	;GET NODE STRING PTR
	$FETCH	T3,NDL,(PB)	;ITS LEN
	JUMPE	T2,RTRUE	;NO BUFF
	JRST	DSPFS1		;MERGE TO OUTPUT STRING
$CASE	(DSN%DE)
	$FETCH	T2,DVA,(PB)	;GET DEV STRING PTR
	$FETCH	T3,DVL,(PB)	;ITS LEN
	JUMPE	T2,RTRUE	;NO BUFF
	JRST	DSPFS1		;MERGE TO OUTPUT STRING
$CASE	(DSN%DI)
	$FETCH	T2,DRA,(PB)	;GET DIR STRING PTR
	$FETCH	T3,DRL,(PB)	;ITS LEN
	JUMPE	T2,RTRUE	;NO BUFF
	JRST	DSPFS1		;MERGE TO OUTPUT STRING
$CASE	(DSN%NA)
	$FETCH	T2,NMA,(PB)	;GET NAME STRING PTR
	$FETCH	T3,NML,(PB)	;ITS LEN
	JUMPE	T2,RTRUE	;NO BUFF
	JRST	DSPFS1		;MERGE TO OUTPUT STRING
$CASE	(DSN%TY)
	$FETCH	T2,TPA,(PB)	;GET TYPE STRING PTR
	$FETCH	T3,TPL,(PB)	;ITS LEN
	JUMPE	T2,RTRUE	;NO BUFF
	JRST	DSPFS1		;MERGE TO OUTPUT STRING
$CASE	(DSN%VE)
	$FETCH	T2,VRA,(PB)	;GET VERSION STRING PTR
	$FETCH	T3,VRL,(PB)	;ITS LEN
	JUMPE	T2,RTRUE	;NO BUFF
	JRST	DSPFS1		;MERGE TO OUTPUT STRING
$CASX
DSPFS1:
	DMOVEM	T2,STRIPT	;Store byte pointer & length in block
	MOVEI	T3,1		;ASCII
	MOVEM	T3,STRIPT+2	;Save string datatype
	$CALLB	TX$OUT,<[STRIPT],DISSTR>	;PUT OUT STRING
	JRST	RTRUE

DSPKEY:	$FETCH	T2,KBF,(PB)	;GET KEY BUFF PTR
	JUMPE	T2,RTRUE	;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$OUT,<T1,DABDEC> ;Output number
	JRST	RTRUE

DSPDAL:	$CALL	SY.GET		;DERIVE FLD PTR FROM CURR TOKEN
	JUMPT	DSPDL1		;VALID NAME
	$CALLB TX$OUT,<R50VAL,DB.NND>	;TELL USER
	JRST	DSPDL2		;PROCEED

;Here with T1= valid symbol value

DSPDL1:	MOVEM	T1,RF		;TREAT AS ARGBLK FLD (USE RF TO PT AT IT)
	$CALL	DDAVAL		;DISP DATA VAL

DSPDL2:	$CALL	P$COMMA		;CHK IF MORE IN LIST
	JUMPF	RTRUE		;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

;Datatype, right now, is a function of byte size only.

	MOVEI	T3,1		;Assume ASCII
	CAIN	T1,6		;Sixbit?
	 MOVEI	T3,0		;Yes
	CAIN	T1,^D9		;EBCDIC?		;????
	 MOVEI	T3,2		;Yes
	MOVEM	T3,STRIPT+2	;Save string datatype
	$CALLB	TX$OUT,<[STRIPT],DISSTR>	;PUT OUT STRING
	JRST	RTRUE

;
; DABVAL - DISPLAY THE CURRENTLY IDENTIFIED ARGBLK FIELD
;

DABVAL:	LOAD	T1,RF%FLAG(RF)	;SEE IF ARRAY
	TXNE	T1,RF%INV	;INVISIBLE?
	  POPJ	P,		;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,[POPJ P,]	;SKIP NULL VALUES
	MOVEI	T5,RF%NAM(RF)	;GET PTR TO TEXT
	$CALLB	TX$OUT,<T5,FNACOL>	;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)
	$CALLB	TX$OUT,<P1,DABDAT>
	POPJ	P,
$CASE	(DT%DEC)		;DECIMAL NUMBER
	$CALLB	TX$OUT,<P1,DABDEC>
	POPJ	P,
$CASE	(DT%OCT)
	$CALLB	TX$OUT,<P1,DABOCT>
	POPJ	P,
$CASE	(DT%STR)
	$CALLB	TX$OUT,<P1>	;Output string
	POPJ	P,
$CASE	(DT%SYA)
	$CALLB	TX$OUT,<P1,DABOCT>
	POPJ	P,
LALL
$CASE	(DT%ST6)
SALL
	$CALLB	TX$OUT,<P1>	;Simple string
	POPJ	P,
$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

;Loop through symbol table looking for value
; If not found, give error

DSYBLP:	LOAD	T1,SYV.VL(DD)		;GET CURR SYM'S VAL
	TDZN	P1,T1			;IS CURR VAL SUBSET OF ACTU VALUE?
	 JRST	NOTSBS			;NO
	LOAD	T5,SYV.NM(DD)		;GET PTR OF NAME
	MOVEI	T4,[ASCIZ/^A/] 		;Presume last one
	SKIPE	P1			;MORE OPTIONS TO PUT OUT
	MOVEI	T4,[ASCIZ/^A+^N/] 	;More follow
	$CALLB TX$OUT,<T5,T4>		;PUT OUT SYM VAL
	JUMPE	P1,[POPJ P,]		;ALL BITS ACCOUNTED FOR
NOTSBS:	AOBJN	DD,DSYBLP		;CHK NEXT SYM
	ERRU	(IVF)			;INVALID VALUE IN FIELD

$CASE	(DT%SBV)							;a511vv
; This can handle up to 72-bit bitvectors
	LOAD	T1,RF%CNT(RF)	;GET NUM OF SYM OPTS			;M554
	MOVE	T3,RF%BP(RF)	;Get the byte pointer			;a554
	CAIG	T1,^D36		;How many words worth of them (less 1)?	;a554
	 TDZA	T4,T4		;Clear additional P that		;a554
	ILDB	T4,T3		;Get next byte (word)			;a554
	MOVEM	T4,P2		;Save it in P2				;a554
	MOVN	T1,T1		;MAKE NEGATIVE				;m554
	HRLI	T1,SZ%RF(RF)	;GET TO WHERE SYM WDS STORED
	MOVSM	T1,DD		;NOW AOBJ PTR TO SYM VALS

;Loop through symbol table looking for value
; If not found, give error

DSBVLP:	LOAD	T2,SYV.VL(DD)		;GET CURR SYM'S VAL
	IDIVI	T2,^D36			;Make word & bit offset
	MOVEI	T1,1			;MAKE A BIT
	LSH	T1,(T3)			;SHIFT INTO POSITION
	TDNN	T1,P1(T2)		;IS CURR VAL SUBSET OF ACTU VALUE?;m554
	 JRST	NOTSVS			;NO
	ANDCAM	T1,P1(T2)		;Clear it			;a554
	LOAD	T5,SYV.NM(DD)		;GET PTR OF NAME
	MOVEI	T4,[ASCIZ/^A/] 		;Presume last one
	SKIPN	P2							;a554
	SKIPE	P1			;MORE OPTIONS TO PUT OUT
	MOVEI	T4,[ASCIZ/^A+^N/] 	;More follow
	$CALLB TX$OUT,<T5,T4>		;PUT OUT SYM VAL
	SKIPN	P2			;Check both Ps			;a554
	JUMPE	P1,[POPJ P,]		;ALL BITS ACCOUNTED FOR
NOTSVS:	AOBJN	DD,DSBVLP		;CHK NEXT SYM
	ERRU	(IVF)			;INVALID VALUE IN FIELD		;A511^^

$CASE	(DT%SYZ)			; Symbolic value or zero	;A4
	JUMPE	P1,[POPJ P,]		;Type nothing if zero.		;A4
					;Fall into DSYSYV if nonzero.	;A4

$CASE	(DT%SYV)			; Symbolic value
	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

;Loop through symbols looking for the value.
; If found, print it. If not found, give error.
;DD/ AOBJ ptr to sym table.
;P1/ value to compare against.

DSYVLP:	LOAD	T1,SYV.VL(DD)		;GET CURR SYM'S VAL
	CAME	T1,P1			;DOES ACTU VALUE MATCH?
	 JRST	DSYABJ			;NO
	LOAD	T5,SYV.NM(DD)		;GET PTR OF NAME
	MOVEI	T4,[ASCIZ/^A/]		;Presume last 1
	$CALLB TX$OUT,<T5,T4>		;PUT OUT SYM VAL
	POPJ P,

DSYABJ:	AOBJN	DD,DSYVLP		;CHK NEXT SYM
	ERRU	(IVF)			;INVALID VALUE IN FIELD

ARYVAL:
	MOVEI	T1,RF%NAM(RF)		;PREP TO OUTPUT NAME
	MOVEM	T1,ARYNAM
	SETZM	ARYIDX			;INIT INDEX
ARYVLP:
	LDB	T4,RF%BP(RF)		;GET CURR VALUE
	JUMPE	T4,ARYVL1		;NOTHING
	$CALLB TX$OUT,<ARYNAM,ARYIDX,T4,ARYFMT>	;OUTPUT IT

ARYVL1:	AOS	ARYIDX			;HOP INDEX
	ADDI	RF,SZ%RF		;GET TO NEXT
	LOAD	T1,RF%FLAG(RF)		;MORE ENTRIES
	TXNN	T1,RF%ARY		;CHK IT?
	 POPJ	P,			;DONE
	JRST	ARYVLP			;NO, PROC ANOTHER

;
; DDAVAL - DISPLAY THE CURRENTLY IDENTIFIED DATAFIELD
;

DDAVAL:	LOAD	T4,UF.TYP(RF)		;GET DATA TYPE TO USE
	CASES	T4,MX%DFT
$CASE	(DFT%SIX)			;SIXBIT DATA
	MOVEI	TAP,6			;SIXBIT BYTES
	JRST	DDAVSTR			;STRING MERGE
$CASE	(DFT%EBC)			;EBCDIC DATA			;M501vv
	MOVNI	TAP,40			;EBCDIC BYTES -- NETATIVE VALUE IS FLAG
	JRST	DDAVSTR			;STRING MERGE
$CASE	(DFT%AS)			;ASCII DATA			;M411
$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

;Find datatype (from byte size at the moment...)

	MOVEI	T3,1			;Assume ASCII
	CAIN	TAP,6			;Sixbit?
	 MOVEI	T3,0
	CAIN	TAP,^D9			;EBCDIC?
	 MOVEI	T3,2
	MOVEM	T3,STRIPT+2		;Save
	$CALLB	TX$OUT,<[STRIPT],DISSTR>	;TYPE VALUE OUT
	POPJ	P,

$CASE	(DFT%PAC)			;PACKED DECIMAL DATA		;A411
	MOVEI	TAP,9			;9-BIT BYTES
	$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
;	MOVEI	T3,3
;	MOVEM	T3,STRIPT+2		;Save
	$CALLB	TX$OUT,<T2,DABPAC>	;TYPE VALUE OUT
	POPJ	P,

$CASE	(DFT%DEC)			;INTEGER
	$FETCH	T2,RBF,(PB)		;GET REC LOCATION
	$INCR	T2,UF.POS(RF)		;GET TO RIGHT WORD
	$CALLB	TX$OUT,<0(T2),DABDEC>	;OUTPUT IT
	POPJ	P,
$CASE	(DFT%OCT)			;OCTAL NUMBER
	$FETCH	T2,RBF,(PB)		;GET REC LOCATION
	$INCR	T2,UF.POS(RF)		;GET TO RIGHT WORD
	$CALLB	TX$OUT,<0(T2),DABOCT>
	POPJ	P,
$CASE	(DFT%FLO)			;FLOATING POINT			;A411
	$FETCH	T2,RBF,(PB)		;GET REC LOCATION
	$INCR	T2,UF.POS(RF)		;GET TO RIGHT WORD
	$CALLB	TX$OUT,<0(T2),DABFLO>
	POPJ	P,
$CASE	(DFT%DOU)			;DOUBLE FLOATING POINT		;A411
	$FETCH	T2,RBF,(PB)		;GET REC LOCATION		;A411
	$INCR	T2,UF.POS(RF)		;GET TO RIGHT WORD		;A411
	$CALLB	TX$OUT,<T2,DABDOU>					;A411
	POPJ	P,							;A411
$CASE	(DFT%GFL)			;GFLOATING POINT		;A411
	$FETCH	T2,RBF,(PB)		;GET REC LOCATION		;A411
	$INCR	T2,UF.POS(RF)		;GET TO RIGHT WORD		;A411
	$CALLB	TX$OUT,<T2,DABGFL>					;A411
	POPJ	P,							;A411
$CASE	(DFT%LON)			;LONG INTEGER			;A411
	$FETCH	T2,RBF,(PB)		;GET REC LOCATION		;A411
	$INCR	T2,UF.POS(RF)		;GET TO RIGHT WORD		;A411
	$CALLB	TX$OUT,<T2,DABLON>	;OUTPUT IT			;A411
	POPJ	P,							;A411
$CASE	(DFT%UNS)			;UNSIGNED INTEGER		;A411
	$FETCH	T2,RBF,(PB)		;GET REC LOCATION		;A411
	$INCR	T2,UF.POS(RF)		;GET TO RIGHT WORD		;A411
	$CALLB	TX$OUT,<(T2),DABUNS>	;OUTPUT IT			;A411
	POPJ	P,							;A411

SUBTTL	PROCESS EXIT CMD

; DO.DDT - ENTERS DDT (DO RMSDEB$G TO RETURN TO RMSDEB)
; NOTES:
;	TO RETURN TO RMSDEB FROM DDT, THE USER TYPES RMSDEB$G
DO.DDT::
	IFN TOP$10,<MOVE T1,.JBDDT##>	;GET LOC OF DDT
	IFN TOP$20,<MOVE T1,770000>	;DITTO
	JUMPN	T1,RTRUE		;Return if there is a DDT there ;M###
	IFN TOP$20,<							;A###
	MOVEI	T1,.FHSLF		;Set up to save original	;A###
	GEVEC%				; entry vector (returned in T2)	;A###
	MOVEM	T2,T3							;A###

	MOVSI	T1,(GJ%SHT+GJ%OLD)	;Set up for GTJFN%		;A###
	HRROI	T2,[ASCIZ /SYS:UDDT.EXE/];
	GTJFN%				;
	ERJMP	NODDT			;Catch errors			;A###

	HRLI	T1,.FHSLF		;Set up for GET%		;A###
	GET%				;Merge DDT into address space	;A###

	MOVEI	T1,.FHSLF		;Set up to restore		;A###
	MOVE	T2,T3			; original			;A###
	SEVEC%				; entry vector			;A###
	MOVE	T1,116			;Get symbol table ptr		;A###
	MOVEM	T1,@770001		;Save it for DDT		;A###
	MOVE	T1,117			;Get undef symbol table ptr	;A###
	MOVEM	T1,@770002		;Save it too			;A###
	JRST	DO.DDT			;There is a DDT now.		;A###

NODDT:	HRROI	T1,[ASCIZ /?Can't Find SYS:UDDT.EXE
/]									;A###
		 PSOUT%							;A###
		 HALTF%							;A###
		 JRST DO.DDT		;Try again.			;A###
	>								;A###

	
; DO.EXIT - EXIT TO MONITOR
;
DO.EXIT::
	IFN TOP$10,<EXIT 1,>
	IFN TOP$20,<HALTF%>
	JRST	RTRUE		;HE CONTINUED

SUBTTL	HELP COMMAND

DO.HELP::
	$CALLB	TX$OUT,<[HLPMSG],ASCSTR> ;Don't worry about up-arrows.
	JRST	RTRUE

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
?

SUBTTL	PROCESS THE INFO CMD

; DO.INFO - LIST OUT SPECIFIED TYPE OF INFO
; NOTES:
;	INFO DATAF!FABS!RABS!XABS!ALL

DO.INFO::
	$P	(KEYW)
	CASES	T1,MX%INF

$CASE	(INF%CON)

INFCON:	SKIPN	CURRAB				;A CURR RAB?
	 JRST	[$CALLB TX$OUT,<CONFNC>		;NO, "no current RAB"
		JRST CONN1]
	$CALLB TX$OUT,<CRABNM,CONFCR>		;PUT IT OUT
CONN1:	MOVE	T4,CSTYPE			;GET STRING DAT TYPE

;"Current RAB is <data-type> at <position>"

	$CALLB	TX$OUT,<DATTYP(T4),CPOSIT,CONFDD>
	JRST	RTRUE

$CASE	(INF%XAB)
	MOVEI	T1,XA$TYP			;PICK UP ONLY XABS
	JRST	GODUMP
$CASE	(INF%RAB)
	MOVEI	T1,RA$TYP			;PICK UP ONLY RABS
	JRST	GODUMP
$CASE	(INF%FAB)
	MOVEI	T1,FA$TYP			;PICK UP ONLY FABS
	JRST	GODUMP
$CASE	(INF%DAT)
	MOVEI	T1,DA$TYP			;INDIC DATA FIELDS
GODUMP:	MOVEM	T1,TYPBLK			;SAVE TYPE OF BLOCK
	PUSHJ	P,DUMPAB			;DUMP THE BLOCKS
	JRST	RTRUE
$CASE	(INF%ALL)
	SETOM	TYPBLK				;INDIC ALL
	PUSHJ	P,DUMPAB			;DUMP 'EM
	$CALLB	TX$OUT,<[[0]]>			;BLANK LINE
	JRST	INFCON				;PUT OUT CONTEXT INFO TOO

; DUMPAB - SCAN PRIVATE SYM TAB, PICKING OUT INDICATED TYPE BLKS
; ARGUMENTS:
;	TYPBLK = -1 OR TYPE TO SCAN FOR

DUMPAB:	PUSHJ	P,%SAVEP		;Save some acs.
	MOVE	P1,TYPBLK		;GET ARGBLK TYPE
	MOVEI	DD,DDTAB		;PT TO BEGINNING OF PRIVATE SYMTAB
					;(Local section ptr)
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,DUADSP		;IS A TYPE SPECIFIED?
	CAME	T1,P1			;YES, A MATCH?
	JRST	DUABLE			;NO

;We want to see this entry. Dispatch on its type.

DUADSP:	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$OUT,<0(DD),T2,T3,FABINF> ;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$OUT,<0(DD),T2,RABINF> ;PUT OUT "NAME TYPE"
	JRST	DUABLE
$CASE	(XA$TYP)
	$FETCH	T5,COD,(PB)		;GET XAB TYPE
	$CALLB	TX$OUT,<0(DD),XABTYP(T5),XABINF> ;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?
	 JRST	TYPNUM			;YES
	ADD	T4,T3			;POS+SIZ=END POS +1
	SUBI	T4,1			;FIX IT
	$CALLB TX$OUT,<0(DD),DATTYP(T5),T3,T4,DASINF> ;;PUT OUT "NAME TYPE"
	JRST	DUABLE

TYPNUM:	$CALLB TX$OUT,<0(DD),DATTYP(T5),T3,DAIINF> ;PUT OUT "NAME TYPE"

;Here when we have printed out an entry.

DUABLE:	ADDI	DD,SZ%DD		;HOP TO NEXT ENTRY
	CAMGE	DD,DDCURR		;HIT LIMIT?
	 JRST	DUABLP			;NO
	POPJ	P,			;YES, RETURN

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

; DO.UNDEFINE - REMOVES NAME AND STORAGE FOR A NAME CREATED BY DEFINE
; NOTES:
;	UNDEFINE name, name, ...

DO.UNDEFINE::
CUNDLP:
	$CALL	SY.GET			;GET SYMBOL NAME
	JUMPF	CUNDL2
	JUMPE	T2,CUNDL2		;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	CUNDL3

CUNDL2:	$CALLB TX$OUT,<R50VAL,DB.NND>	;TELL USER
CUNDL3:	$CALL	P$COMMA			;MORE IN LIST?
	JUMPT	CUNDLP			;YES
	JRST	RTRUE			;NO, ALL DONE

SUBTTL	MEMORY MGR (TRIVIALIZED)

; M.INIT - SET INIT VALS FOR POINTERS
;
M.INIT::
	SKIPE	DDCURR			;SETUP YET?
	 JRST	RTRUE			;YES
	MOVEI	T1,DDTAB		;PT TO BEGINNING OF TABLE
	MOVEM	T1,DDCURR
	MOVEI	T1,ARBTAB		;DITTO
	MOVEM	T1,ARBCURR
	JRST	RTRUE

; M.ALC - ALLOCATES SPECIFIED NUMBER OF WORDS
; ARGUMENTS:
;	T1 = # OF WDS TO ALLOC
; RETURNS:
;	T1 = PTR TO WHAT ALLOC

M.ALC:	MOVE	T2,T1			;GET AMT TO ALLOC
	MOVE	T1,ARBCURR		;CURR SPOT IN PRIVATE TABLE
	ADD	T2,ARBCURR		;SAVE NEW 1ST FREE
	CAIL	T2,ARBTAB+SZ%ARB-1	;HIT LIMIT
	ERRU	(TFU)			;YES, TAB FULL
	MOVEM	T2,ARBCURR		;SAVE NEW 1ST FREE
	POPJ	P,

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

; SY.STOR - STORE SYMBOL IN PRIVATE TABLE
; ARGUMENTS:
;	T1 = PTR TO ASCIZ STRING TO STORE
; RETURNS:
;	TF = TRUE IF SYMBOL NOT ALREADY IN TABLE, FALSE OTHERWISE
;	T1 = SYMBOL NODE ADDRESS

SY.STOR:
	MOVE	T5,T1			;PT TO STRING
	HRLI	T5,(POINT 7,)		;MAKE BP TO IT
	$CALL	SYMR50			;BUILD RADIX50 VALUE INTO R50VAL
	$CALL	SYMPRV			;SEARCH PRIVATE SYMBOL TABLE
	JUMPT	RFALSE			;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
	MOVE	T2,R50VAL		;PUT SYMBOL IN TABLE
	STOR	T2,DD.NAM(T1)
	JRST	RTRUE			;RET SUC

; 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

SY.GET:	$P	(FLD)			;GET TOKEN
	MOVEI	T5,TK.VAL(T1)		;PT TO STRING
	PJRST	SYFIND			;Find symbol, return with SUCC/FAIL

; SY.FIND - FIND A SYMBOL
; ARGUMENTS:
;	T1 = PTR TO SYMBOL NAME
; RETURNS: (AS FOR SY.GET)
;	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

SY.FIND::
	MOVE	T5,T1			;PT TO STRING
	$CALL	SYFIND			;WITH T5
	JUMPF	[POPJ P,]		;TRANS RET FAILURE
	$FETCH	T3,BID,(T1)		;CHK WHAT FND
	CAIE	T3,RA$TYP		;RAB?
	 JRST	RTRUE			;NO, JUST RET SUCC
	MOVEM	T1,CURRAB		;SAVE PTR TO IT
	PUSH	P,R50VAL		;SAVE ITS NAME
	POP	P,CRABNM
	JRST	RTRUE

SUBTTL	SYMBOL TABLE SUBROUTINES

; SYFIND - DOES REAL WORK OF FINDING SYMBOL
; ARGUMENTS:
;	T5 = PTR TO ASCIZ STRING
; RETURNS: (AS FOR SY.GET)
;	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

SYFIND:	HRLI	T5,(POINT 7,)		;MAKE BP TO IT
	$CALL	SYMR50			;BUILD RADIX50 VALUE INTO R50VAL
	$CALL	SYMPRV			;SEARCH PRIVATE SYMBOL TABLE
	MOVE	T2,T1			;PRESERVE SYMTAB ADDR
	JUMPT	SYFND1			;SUC IF ALREADY THERE
	$CALL	SYMDD
	JUMPF	[POPJ P,]		;FAIL IF NOT THERE EITHER
	SETZ	T2,			;DON'T PT INTO DDT TABLE
SYFND1:	MOVE	T1,DD.VAL(T1)		;Return with val
	POPJ	P,

; SYMR50 - CONVERT ASCII SYMBOL TO RADIX 50
; ARGUMENTS:
;	T5 = BP TO ASCIZ STRING
; RETURNS:
;	R50VAL = RADIX50 VAL

SYMR50:	MOVEI	T1,6			;MAX SIGNIF CHAR
	SETZ	T2,			;START WITH 0 VAL
SR50LP:	ILDB	T3,T5			;GET CHAR FROM SOURCE
	JUMPE	T3,SR50EX		;EXIT ON NUL
	IMULI	T2,50			;MOVE OVER BY RADIX
	ADJBP	T3,[POINT 6,R50TAB]	;GET TO RIGHT ENTRY
	ILDB	T3,T3			;GET MAPPED VAL
	ADD	T2,T3			;MERGE IN CURR LOW-ORDER BYTE
	SOJG	T1,SR50LP		;KEEP SCANNING IF NOT TO 6TH CHAR
SR50EX:	MOVEM	T2,R50VAL		;PERMANIZE SYMBOL
	POPJ	P,			;RETURN

; SYMPRV - SEARCH PRIVATE SYMBOL TABLE FOR R50VAL
; RETURNS:
;	TF = TRUE IF SYMBOL FOUND
;	T1 = PTR TO SYMBOL NODE

SYMPRV:	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,RFALSE		;PRIVATE SYMTAB EMPTY
	HRL	T5,T4			;NOW AOBJ PTR
	JRST	SYMERG

; SYMDD - SEARCH DDT SYMBOL TABLES FOR R50VAL
; RETURNS:
;	TF = TRUE IF SYMBOL FOUND
;	T1 = PTR TO SYMBOL NODE

SYMDD:
IFN TOP$20,<
	SKIPE	T5,770001		;Try TOPS-20 SYMTAB location	;A4
	SKIPN	T5,(T5)			;It was nonzero. Fetch pointer	;A4
>; End TOP$20
	SKIPN	T5,116			;Try TOPS-10 SYMTAB location (.JBSYM)
	 JUMPE	T5,RFALSE		;NO SYMS, NO FIND		;M4

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
	JRST	RFALSE			;SYM NOT FND
SYMEX:
	HRRZ	T1,T5			;ISOL SYM NODE PTR
	JRST	RTRUE			;RET SUC

; Returns, and routine to save Perm AC's.

RFALSE:	TDZA	TF,TF			;RETURN FALSE
RTRUE:	SETO	TF,			;RETURN TRUE
	POPJ	P,

;Routine to save perm acs, which will be restored upon POPJ

%SAVEP:	MOVEM	P1,SVP1T	;Save P1, get return address
	EXCH	P1,(P)		;SAVE P1 AND GET RETURN ADDRESS
	PUSH	P,P2		;SAVE P2
	PUSH	P,PB		;SAVE PB
	PUSH	P,DD		;SAVE DD
	PUSH	P,RF		;SAVE RF
	PUSHJ	P,SVTJMP
	 SOS	-5(P)
	POP	P,RF
	POP	P,DD
	POP	P,PB
	POP	P,P2
	POP	P,P1
	AOS	(P)		;Make skip return if needed
	POPJ	P,		;RETURN

SVTJMP:	HRLI	P1,(1B0)	;Make IFIW
	EXCH	P1,SVP1T	;Save ret inst, restore P1
	JRST	@SVP1T		;Jump to continue transfer

$ENDSCOPE	(TOP-LEVEL)

END