Google
 

Trailing-Edge - PDP-10 Archives - 704rmsf2 - 10,7/rms10/rmssrc/utlenv.mac
There are 11 other files named utlenv.mac in the archive. Click here to see a list.
TITLE	UTLENV - STATIC ENVIR CMDS AND THEIR SUPPORT ROUTINES
SUBTTL	A. UDDIN
SEARCH	 RMSMAC,RMSINT
$PROLOG(UTL)

SZ%DRV==20				;FOR CHANGE/DISP, MAX DATFLDS/CMD LINE
SZ%DDT==^d500
$IMPURE
$DATA	(BUFSIZ)			;SIZE OF RECORD BUFFER
$DATA	(BUFADR)			;PTR TO RECORD BUFFER
$DATA	(CPOSIT)			;CURR POS FOR DATA FIELDS
$DATA	(CSTYPE)			;CURR STRING DATA TYPE
$DATA	(DDCURR)			;CURR ADDRESS IN PRIVATE SYMTAB
$DATA	(DDTAB,SZ%DDT)			;SPACE FOR PRIVATE SYMTAB
$DATA	(DEFFAB)			;ADDR OF FAB FOR A DEFINE FILE
$DATA	(ISYMBP,2)			;STP FOR DISPLAY OF SYM NAME
$DATA	(OUTFAB)			;ADDR OF FAB FOR REPORT FILE
$DATA	(TTYFAB)			;ADDR OF FAB FOR TTY:
$DATA	(VASZPT)			;SYMBOL IN RADIX50

$PURE

; FMT STATS FOR INFO COMMAND
;
INFAREA:[$FMT(,<-CA%STP,-CA%ASZ,BUCKET-SIZE=,-CA%NUM>)]
INFBKT:	[$FMT(,<Current bucket at page	,-CA%NUM>)]
INFDAI:	[$FMT(,<-CA%STP,-CA%ASZ,-CA%ASZ,	,at W,-CA%NUM>)]
INFDAS:	[$FMT(,<-CA%STP,-CA%ASZ,-CA%ASZ,	,C,-CA%NUM, thru C,-CA%NUM>)]
INFDDD:	[$FMT(,<DEFINE DATA default is  ,-CA%ASZ, at ,-CA%NUM>)]
INFFIL:	[$FMT(,<RMS file is		,-CA%ASZ>)]
INFFNO:	[$FMT(,<RMS file is		Not open>)]
INFKEY:	[$FMT(,<-CA%STP,-CA%ASZ,-CA%NOCR>)]
INFKEG:	[$FMT(,<-CA%ASZ, ,-CA%NOCR>)]
INFKA0:	[$FMT(,</NOCHA+NODUP,-CA%NOCR>)]
INFKA1:	[$FMT(,</NOCHA+DUP,-CA%NOCR>)]
INFKA2:	[$FMT(,</CHA+NODUP,-CA%NOCR>)]
INFKA3:	[$FMT(,</CHA+DUP,-CA%NOCR>)]
INFKDA:	[$FMT(,</DAN:,-CA%ASZ,-CA%NOCR>)]
INFKDF:	[$FMT(,</DAF:,-CA%NUM,-CA%NOCR>)]
INFKIA:	[$FMT(,</IAN:,-CA%ASZ,-CA%NOCR>)]
INFKIF:	[$FMT(,</IAF:,-CA%NUM,-CA%NOCR>)]
INFKRF:	[$FMT(,<Current key-of-ref is	,-CA%NUM>)]
INFREC:	[$FMT(,<Current record at	,-CA%RFA>)]
INFREP:	[$FMT(,<Report file is		,-CA%ASZ>)]

DATTYP:
	[ASCIZ/ASCII/]
	[ASCIZ/EBCDIC/]
	[ASCIZ/F-BYTES/]
	[ASCIZ/SIXBIT/]
	[ASCIZ/DECIMAL/]
	[ASCIZ/OCTAL/]
	[ASCIZ/FLOAT/]

BPWVEC:	EXP	5,4,6			;BYTES/WD BY STRING TYPE
KEYBSZ:	EXP 7,9,6

$SCOPE	(TOP-LEVEL)
$LREG	(PB)			;PTR TO CURR RMS ARG BLK

SUBTTL	PROCESS CLOSE COMMAND

$PROC	(C.CLOSE)
;
; C.CLOSE = CLOSE THE  RMS!REPORT  FILE
;
; NOTES:
;	CLOSE  RMSFILE!REPORTFILE  

	$P	(KEYW)			;PICK UP FIELD BEING DEFINED
	CASES	T1,MX%CLO
$CASE	(CLO%RMS)			;	RMS FILE
	MOVE	T5,UTLFLG		;CHECK IF FILE IS OPEN
	TXZN	T5,UT%FOP
	ERRU(FNO)			;FILE NOT OPEN
	$CALL	CLORMS			;DO REAL WORK
	RETT
$CASE	(CLO%REP)			;	REPORT FILE
	MOVE	T5,UTLFLG		;FIRST CHECK IF FILE IS OPEN
	TXZN	T5,UT%RFO
	ERRU(FNO)			;FILE NOT OPEN
	$CALL	CLORPT			;DO REAL WORK
	RETT				;DONE
$ENDPROC

$UTIL	(CLORMS)			;CLOSE RMS FILE
	$CALLB	BK$PUT,<[0]>		;RELEASE BKT IF HAVE 1
	$CALLB	VR$CLEAN		;INSURE SCAN CMDS LEFT NOTHING AROUND
	$FLAGZ	(UTLFLG,UT%FOP)		;CLEAR FLAG
	$CLOSE	@FAB			;CLOSE THE RMS FILE
	$CHKERR	(?UTLCCF could not close file)
	$CALL	M.RMSF			;FINALLY FREE ALL MEM FOR _AB BLOCKS
	RETURN
$ENDUTIL

$UTIL	(CLORPT)			;CLOSE REPORT FILE
	$CALL	RP$PUT			;INSURE RPT BUFFER CLEAN
	$CLOSE	@OUTFAB	
	$CHKERR	(?UTLCCF could not close file)
	$FLAGZ	(UTLFLG,UT%RFO)
	$CALL	M.REPF			;FREE ALL _AB BLOCKS FOR REP FILE

	$COPY	OUTFAB,TTYFAB		;RESTORE DEFAULT REPORT DEVICE
	$COPY	OUTRAB,TTYRAB
	RETURN
$ENDUTIL

SUBTTL	EXIT COMMAND

$PROC	(C.EXIT)
;
; C.EXIT - EXIT TO MONITOR AFTER CLOSING ALL OPEN FILES
;

	MOVE	T5,UTLFLG		;GET STATUS FLAGS
	TXNE	T5,UT%FOP		;IS RMS FILE OPEN?
	$CALL	CLORMS			;YES, CLEAN UP

	MOVE	T5,UTLFLG		;GET STATUS FLAGS
	TXNE	T5,UT%RFO		;IS REPORT FILE OPEN?
	$CALL	CLORPT			;YES, CLEAN UP

	IFN TOP$10,<EXIT 1,>
	IFN TOP$20,<HALTF>
	RETT

$ENTRY	(SY.EXIT)			;RET TO EXEC
	IFN TOP$10,<EXIT 1,>
	IFN TOP$20,<HALTF>
	RETT
$ENDPROC

SUBTTL	PROCESS DEFINE COMMAND

$SCOPE	(DEFINE-CMD)
$LREG	(DD)			;PTR TO ENTRY IN (DDT-LIKE) SYMTAB
$LREG	(UF)			;PTR TO CURR DAT FLD BEING DEFINED
$LREG	(P1)			;MAY BE USED BY BOTTOM-LEVEL UTILS
$LREG	(P2)
$LOCALS
 $WORD	(CAID)			;CURR AREA ID DURING DEF FILE
 $WORD	(DTPVAL)		;DAT TYP XB$ VALUE
 $WORD	(DUMDD,SZ%DD)		;USED WHEN DATFLD ALSO DEFINED AS KEY
 $WORD	(KAT)			;KEY ATTR ACCUMULATOR
 $WORD	(KREF)			;INCR BY DEF FIL TO SET REF OF XAB LIST
 $WORD	(LXAB)			;ADDR OF LAST XAB PROCESSED IN A LIST OF XAB'S
 $WORD	(SEGPTR)		;PTR OFFSET FROM XAB FOR CURR POS/SIZ
$ENDLOC

$PROC	(C.DEFINE)
;
; C.DEFINE - PROCESS DEFINE CMD
;
;	DEFINE AREA area-name (WITH BUCKET SIZE) n1
;	DEFINE DATAFIELD datafield-name (WITH TYPE) ASCII!FILE-BYTES!SIXBIT (WITH LENGTH) n1 (STARTING AT BYTE) n2
;	DEFINE KEY key-name (WITH SEGMENTS) segment-list
;	DEFINE FILE  file-name (WITH ORGANIZATION) [see DEFORG]

	$EH	(DEFABORT)		;CLEAN UP PARTIALLY DEF SYMS
	SETZM	DD			;INDIC NO SYMBOL DEFINED YET
	$P	(KEYW)			;PICKUP THE KEYWORD VAL
	CASES	T1,MX%DEF		;DISPATCH OFF TYPE OF BLK

$CASE	(DEF%FIL)			; ** DEFINE A SKELETON FILE
	$CALL	INITAB,<FABINI>		;SETUP A FAB
	MOVEM	PB,DEFFAB		;SAVE IT'S ADDR
	$CALL	M.TOK			;ALC ROOM AND COPY FILE STRING
	$STORE 	(T1,FNA,(PB))		;PTR TO FILE SPEC
	MOVEI	T1,FB$PUT		;INDIC WRITE ACCESS
	$STORE	T1,FAC,(PB)		;PUT IT IN FAB
	$CALL	DEFORG			;REST OF CMD LINE IS FILE ORG DEPENDENT
	$CREATE	@DEFFAB			;PUT THE FILE ON DISK
	$CHKERR	(?UTLCDF could not DEFINE file)
	$CLOSE	@DEFFAB			;PERMANIZE IT
	$CHKERR	(?UTLCCF could not close file)
	RETT				;** DONE
DEFABORT:
	JUMPE	DD,L$RETF		;NO SYMBOL ALLOC
	MOVNI	T1,SZ%DD		;GET SIZE OF ENTRY ALLOC
	ADDM	T1,DDCURR		;MOVE CURR PTR BACK OVER IT
	RETF				;HAVE CLEANED UP
	
SUBTTL	(RE)DEFINING NAMES

$CASE	(DEF%DAT)			; ** DEFINE DATA FIELDS
	$CALL	ALCBLK,<FLDINI>		;DATA FIELD DESC INIT VALS
	$CALL	DEDTYP			;PROC DATA TYPE
	MOVEM	PB,UF			;ADJ TO KEY CONTEXT
	SETZM	PB			;DONE
	$CALL	DKDSWIT			;EAT DATFLD & KEY SWITS
	RETT

$CASE	(DEF%KEY)			; ** DEFINE KEY XAB. (ADDITIONAL INFO FOR CREATING AN ISAM FILE)
	$CALL	ALCBLK,<XKINI>		;SET UP XAB WITH INIT VALUES
	MOVEM	PB,SEGPTR(CF)		;INIT CURR SEG TO 1ST ONE
	SOS	SEGPTR(CF)		;DO "FULL" TEST AT TOP OF LOOP
					;(AFTER SY.CHK SO PTR NOT CLOBBED)
DKS.LP:
	$CALL	SY.CHK,<DA$TYP>		;MUST BE DATAFLD (SET PB)
	AOS	T4,SEGPTR(CF)		;POINT TO NEXT SEGMENT
	CAIL	T4,8(PB)		;AT MOST EIGHT SEGS
	ERRU	(TMS)			;TOO MANY SEGS
	MOVEM	T2,XK.SEG(T4)		;SAME PTR TO SEG'S SYMBOL
	$CALL	P$COMMA			;MORE SEGMENTS?
	JUMPT	DKS.LP

	$CALL	DKDSWIT			;PROCESS SWITCHES
	RETT

$CASE	(DEF%ARE)			; DEFINE AREA (ALLOCATION) XAB.
	$CALL	ALCBLK,<XAINI>		;SET UP AREA XAB & INIT.
	$P	(NUM)			;FETCH BUCKET SIZE
	$STORE	T1,BKZ,(PB)		;PUT IT IN XAB
	RETT

$CASF
	ERRU(IUE)			;INTERNAL ERROR

$ENTRY	(C.REDEF)
;
; C.REDEF - REDEF PROPS OF A DATA NAME
; NOTES:
;	LOCATES SYMBOL BLK AND THEN MERGES WITH DEFINE

	$CALL	SY.GET			;PICK UP NAME TO REDEF
	MOVEM	T2,DD			;SAVE SYMBLK PTR
	$FETCH	T3,BID,(T1)		;GET BLK TYPE
	CAIN	T3,DA$TYP		;DAT BLK?
	JRST	L$CASE(DEF%DAT)		;YES
	CAIE	T3,XA$TYP		;MUST BE XAB
	ERRU	(IUE)			;OOPS
	$FETCH	T3,COD,(T1)		;GET TYPE OF XAB
	CAIN	T3,XB$KEY		;KEY?
	JRST	L$CASE(DEF%KEY)		;YES
	CAIN	T3,XB$ALL		;AREA?
	JRST	L$CASE(DEF%AR)		;YES
	ERRU	(IUE)			;OOPS

SUBTTL	GENERAL SUBROUTINES TO SUPPORT DEFINE

$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

$REG	(IB,P1)				;PTR TO INIT ARGBLK
$REG	(BSZ,P2)			;WDS IN BLK

	MOVEI	IB,@INIBLK(AP)		;MATER PTR TO INIT VAL BLK
	JUMPN	DD,ALBINI		;SYM ALR LOC, INIT IT
	$CALL	SY.STOR			;PUT IN TABLE IF NOT ALREADY THERE
	JUMPF	L$ERRU(NAD)		;NAME ALREADY DEFINED
	MOVEM	T1,DD			;PRESERVE DD SYMBLK PTR
ALBINI:
	$FETCH	(BSZ,BLN,(IB))		;GET LEN OF ARGBLK NEEDED
	CAIN	IB,XKINI		;SPECIAL CASE?
	ADDI	BSZ,2+8			;YES, ALC WDS FOR XK.IAP, XK.DAP & SEGS
	SKIPE	T1,DD.VAL(DD)		;ARGBLK ALREADY ALLOC?
	$SKIP				;NO
		$CALL	M.ALC,<BSZ>	;ALLOC A BLK
	$ENDIF
	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
	ADDI	BSZ,-1(PB)		;GET LAST WORD OF BLK
	BLT	T1,0(BSZ)		;COPY INIT VALS TO ALLOC BLK
	RETURN
$ENDUTIL

SUBTTL	ROUTINES TO SUPPORT DEFINE-FILE

$UTIL	(DEFFXC)
;
; DEFFXC - CHK REC SIZE FOR FILES WITH FIXED FORMAT
;
	$FETCH	T1,RFM,(PB)		;GET REC FMT
	CAIE	T1,FB$FIX		;FIXED LEN RECS?
	$SKIP				;YES
		$FETCH	T1,MRS,(PB)	;GET REC SIZE
		JUMPE	T1,L$ERRU(RSR)	;REC SIZ REQUIRED FOR FIXED R
	$ENDIF
	RETURN
$ENDUTIL

$UTIL	(DEFORG)
;
; DEFORG - PARSE THE ORG DEPENDENT PART OF THE CMD LINE
; RETURNS:
;	FIELDS IN FAB SET UP & xabs linked into chain
; NOTES:
;	INDEXED (WITH KEYS) key-name-list
;	RELATIVE (WITH MAX REC SIZE) N
;		:

	$CALL	P$KEYW
	JUMPF	L$CASE(DFO%SEQ)		;NO ORGANIZATION. DEFAULTS TO SEQ.

	CASES	T1,MX%DFO		;FILE ORG CASES
$CASE	(DFO%STR)			;STREAM ASCII
	MOVEI	T1,FB$STM		;INDIC TYPE OF SEQ FILE
	$STORE	T1,RFM,(PB)		;DONE
$CASE	(DFO%LSA)			;LINE-SEQ
	MOVEI	T1,FB$LSA		;INDIC TYPE OF SEQ FILE
	$STORE	T1,RFM,(PB)		;DONE
;	JRST	L$CASE(DFO%SEQ)		;SET ORG TOO

$CASE	(DFO%SEQ)			;SEQUENTIAL
	MOVEI	T1,FB$SEQ
	$STORE	T1,ORG,(PB)
	$CALL	DEFSWIT			;GET SWITCHES
	$CALL	DEFFXC			;CHK RFM VS. MRS
	RETURN

$CASE	(DFO%REL)			;RELATIVE
	MOVEI	T1,FB$REL
	$STORE	T1,ORG,(PB)
	$P	(NUM)			;REC SIZE REQUIRED
	$STORE	T1,MRS,(PB)		;PUT IT AWAY
	$CALL	DEFSWIT			;GET SWITCHES
	RETURN
	
$CASE	(DFO%IND)			;INDEX
	MOVEI	T1,FB$IDX
	$STORE	T1,ORG,(PB)
DEFKEY:					;PARSE KEYS OF THE FILE
	SETOM	DTPVAL(CF)		;INDIC BYTE SIZE NOT KNOWN YET
	SETOM	KREF(CF)		;INIT KEY-OF-REFERENCE
	SETZM	CAID(CF)		;DITTO AID (THEY START FROM 1)
	$CALL	SYMKEY			;SCAN FOR KEY NAME
	$FETCH	T2,FLG,(T1)		;CHECK FLG FIELD.
	TXNE	T2,XB$CHG		;CHANGE OPTION SPEC.?
	ERRU	(PKC)			;PRIM KEY CAN'T CHANGE
	$STORE 	T1,XAB,(PB)		;STORE START OF XAB LIST IN FAB
DEFKLP:
	MOVEM	T1,LXAB(CF)		;REMEMBER ADDR OF LAST XAB
	AOS	T2,KREF(CF)		;SET REF FLD
	$STORE	T2,REF,(T1)		;...OF NEXT XAB IN LIST
	$CALL	DEKBSZ			;BIND SEGS TO KEY
	$CALL	DEFKAR			;PUTS ITS AREA IN LIST IF NECES
	$CALL	P$COMMA			;MORE IN THE LIST?
	JUMPF	L$IFX			;NO.
		$CALL	SYMKEY		;YES, SCAN FOR KEY NAME
		MOVE	T2,LXAB(CF)		;SET UP NXT FIELD
		$STORE	T1,NXT,(T2)
		JRST	DEFKLP
	$ENDIF
	$CALL	DEFSWIT				;PROCESS FILE  SWITCHES
	$CALL	DEFFXC				;CHK RFM VS. MRS
DFICHK:
	$FETCH	T5,BSZ,(PB)			;GET BYTE SIZE BACK
	JUMPG	T5,L$JUMP			;USER SPEC BYTE SIZE?
		SKIPGE	T1,DTPVAL(CF)		;NO, USE KEY DCL INFO IF POSS
		MOVEI	T1,XB$STG		;CANT, USE ASCII DEFAULT
		MOVE	T5,KEYBSZ(T1)		;SET FROM KEY DAT TYPE
		$STORE	T5,BSZ,(PB)		;PUT BSZ AWAY
	$JUMP					;YES
		SETOM	T1			;START WITH NULL DTP
		CAIN	T5,6			;SIXBIT?
		MOVEI	T1,XB$SIX		;YES
		CAIN	T5,7			;ASCII?
		MOVEI	T1,XB$STG		;YES
		CAIN	T5,9			;EBCDIC?
		MOVEI	T1,XB$EBC		;YES
		JUMPL	T1,L$ERRU(IBS)		;BAD BYTE SIZE FOR IDX FILE
	$ENDIF
	SKIPGE	DTPVAL(CF)			;SET YET?
	MOVEM	T1,DTPVAL(CF)			;NO, SO SET NOW
	CAME	T1,DTPVAL(CF)			;KEY SEG DAT TYPES MATCH BSZ?
	ERRU	(KIB)				;NO
	$CALL	DEFKTYP				;SET XB$DTP FOR EACH KEY
	RETURN
$CASF
	ERRI	(ISC)

$UTIL	(SYMKEY)
;
; SYMKEY - EAT TOKEN & VERIFY THAT IT IDENTIFIES KEY DESCRIPTOR
; RETURNS:
; T1 = PTR TO KEY DESC
	$CALL	SY.GET			;PICK UP XAB NAME FOR PRIMARY KEY
	JUMPF	L$ERRU(NNK,VASZPT)	;NAME NOT KNOWN
	LOAD	T3,UF.BID(T1)		;GET TYPE OF SYMBOL
	CAIE	T3,DA$TYP		;IS IT DATFLD?
	$SKIP				;YES
		SKIPN	T1,UF.KEY(T1)	;ALSO KEY?
		ERRU	(WTN,VASZPT)	;NO
		RETURN			;WITH PTR TO KEY DESC
	$ENDIF
	CAIE	T3,XA$TYP		;XAB?
	ERRU	(WTN,VASZPT)		;NO, DEF NOT RIGHT TYPE
	$FETCH	T3,COD,(T1)		;GET TYPE OF XAB
	CAIE	T3,XB$KEY		;IS IT KEY?
	ERRU	(WTN,VASZPT)		;NO
	RETURN				;WITH PTR TO KEY DESC
$ENDUTIL
$ENDUTIL

SUBTTL	ROUTINES TO SUPPORT AREAS IN DEFINING IDX FILES

$UTIL	(DEFKAR)
;
; DEFKAR - PUT KEY'S AREA XABS IN XAB CHAIN IF NECES
;

$REG	(KX,P1)				;PTR TO CURR KEY XAB

	MOVE	KX,LXAB(CF)			;GET PTR TO CURR KEY
	SKIPN	T4,XK.IAP(KX)		;IS THERE AN AREA SPEC?
	$SKIP				;YES
		$CALL	DEFARID		;SET AREA ID FROM AREA NAME
		$STORE	T1,IAN,(KX)	;PUT RET VAL AWAY
	$ENDIF
	SKIPN	T4,XK.DAP(KX)		;IS THERE AN AREA SPEC?
	$SKIP				;YES
		$CALL	DEFARID		;SET AREA ID FROM AREA NAME
		$STORE	T1,DAN,(KX)	;PUT RET VAL AWAY
	$ENDIF
	RETURN

$UTIL	(DEFARID)
;
; DEFARID - SET OR FIND AREA ID OF AREA IN XABLIST
; ARGUMENTS:
;	T4 = SYM PTR FOR AREA XAB BEING SCANNED
; RETURNS:
;	T1 = AID TO PUT IN KEY
; NOTES:
;	PUTS AREA IN XAB CHAIN IF NECES (UPDATING LXAB(CF))

	MOVE	T4,DD.VAL(T4)		;GET TO XAB ITSELF
	$FETCH	T3,XAB,(PB)		;GET HEAD OF LIST
DFARLP:
	$FETCH	T2,COD,(T3)		;SEE IF AREA
	CAIE	T2,XB$ALL		;IS IT?
	$SKIP				;YES
		$FETCH T1,AID,(T3)	;GET AID FLD IN CASE THIS 1 IT
		CAMN	T3,T4		;IS PTR IN KEY MATCH 1 IN XAB CHAIN
		RETURN			;YES, SO DONE -- RET WITH AID
	$ENDIF
	$FETCH	T3,NXT,(T3)		;GET NEXT XAB
	JUMPN	T3,DFARLP		;CHK AGAIN
	AOS	T1,CAID(CF)		;INCR CURR AREA ID
	$STORE	T1,AID,(T4)		;PUT IT IN AREA XAB
	MOVE	T5,LXAB(CF)		;GET XAB CURR LAST
	$STORE	T4,NXT,(T5)		;PUT SEARCHED FOR AREA IN XAB CHAIN
	MOVEM	T4,LXAB(CF)		;MAKE IT LAST
	RETURN
$ENDUTIL
$ENDUTIL

SUBTTL	ROUTINES TO SUPPORT KEYS IN DEFINING IDX FILES

$UTIL	(DEKBSZ)
;
; DEKBSZ -  CHK/DET BYTE SIZE OF KEYS IN FILE
; NOTES:
;	SCAN CURR KEY DESC'S SEGS, CHKING UF.TYP AGAINST DTPVAL(CF).
;	IF DTPVAL NOT SET YET, SETS IF SEGMENT HAS EXPLIC STRING TYPE.
	MOVE	T4,LXAB(CF)		;GET PTR TO THE KEY XAB
DSB.LP:
	SKIPN	T3,XK.SEG(T4)		;GET SYM PTR FOR CURR SEG
	RETURN				;ALL DONE IF 0
	MOVE	T5,DD.VAL(T3)		;PT TO DATFLD BLK
	LOAD	T2,UF.TYP(T5)		;GET DAT TYPE
	SETOM	T1			;PRESUME NUMERIC
	CAIN	T2,DFT%SIX		;SIXBIT?
	MOVEI	T1,XB$SIX		;YES
	CAIN	T2,DFT%ASC		;ASCII?
	MOVEI	T1,XB$STG		;YES
	CAIN	T2,DFT%EBC		;EBCDIC?
	MOVEI	T1,XB$EBC		;YES
	SKIPGE	DTPVAL(CF)		;SET YET?
	MOVEM	T1,DTPVAL(CF)		;NO, SO SET NOW
	CAME	T1,DTPVAL(CF)		;MATCH KEYS (OR STILL UNSET)?
	JUMPGE	T1,L$ERRU(KIB)		;NO, ERR UNL CURR KEY NUMERIC OR F-BYTE
	AOJA	T4,DSB.LP		;BUMP PTR TO NEXT POS,SIZ,SEG
$ENDUTIL

$UTIL	(DEFKTYP)
;
; DEFKTYP - SET XB$DTP AND SEGM DATA FOR EACH KEY OF FILE
;
	$FETCH	T3,XAB,(PB)		;GET HEAD OF LIST
	MOVE	T4,DTPVAL(CF)		;VAL TO SET EACH XB$DTP TO
DFKTLP:
	$FETCH	T1,COD,(T3)		;SEE IF KEY
	CAIE	T1,XB$KEY		;IS IT?
	$SKIP				;YES, CHK FOR NUMERIC SEGS
		$STORE	T4,DTP,(T3)		;PUT AWAY KEY STRING TYPE
		MOVEM	T3,T5			;DONT CLOB XAB PTR
DFNSLP:						;DEF NUM SEG
		SKIPN	T2,XK.SEG(T5)		;GET SYM PTR FOR CURR SEG
		JRST	L$IFX			;ALL DONE IF 0
		MOVE	T2,DD.VAL(T2)		;PT TO DATFLD BLK
		LOAD	T1,UF.TYP(T2)		;CHK IF NUMERIC
		CAIL	T1,DFT%INT		;IS IT?
		SKIPA	TAP,BPWVEC(T4)		;YES, CONV POS/SIZ TO BYTES
		MOVEI	TAP,1			;NO
		LOAD	T1,UF.POS(T2)		;POS  TO XAB
		IMUL	T1,TAP			;WD OFF * B/W = BYT OFFS
		$STORE	T1,POS,(T5)		;DONE
		LOAD	T1,UF.SIZ(T2)		;SIZE  TO XAB
		IMUL	T1,TAP			;DITTO SIZE
		$STORE	T1,SIZ,(T5)		;DITTO, SIZE
		AOJA	T5,DFNSLP		;BUMP PTR TO NEXT POS,SIZ,SEG
	$ENDIF
	$FETCH	T3,NXT,(T3)		;GET NEXT XAB
	JUMPN	T3,DFKTLP		;CHK AGAIN
	RETURN
$ENDUTIL

SUBTTL	ROUTINES FOR DEFINE-DATA

$UTIL	(DEDTYP)
;
; DEDTYP - PROCESS DATA TYPE OF DEFINE-DATA
;
	$P	(KEYW)			;PICK UP DATA TYPE
	STOR	T1,UF.TYP(PB)		;STORE DATA TYPE
	CAIGE	T1,DFT%INT		;INTEGER?
	JRST	DEDSTR			;STR DATA TYPE
DEDBIN:
	$CALL	P$NUM			;WORD OFFSET SPECIFIED?
	MOVE	T3,CSTYPE		;GET STRING TYPE (INIT ASCII)
	MOVE	T3,BPWVEC(T3)		;GET BYTES PER WORD
	JUMPT	L$IFX			;POSIT SPECIFIED
		MOVE	T1,CPOSIT	;GET DEFAULT POS.
		ADDI	T1,-1(T3)	;SETUP FOR TRUNCATING DIVID
		IDIV	T1,T3		;GET WD OFFSET
	$ENDIF
	STOR	T1,UF.POS(PB)		;STORE WORD OFFSET
	ADDI	T1,1			;HOP PAST IT
	IMUL	T1,T3			;RECONVERT TO CHARS
	MOVEM	T1,CPOSIT
	$COPY	UF.SIZ(PB),I 1		;# OF WDS IN FLD
	RETURN
DEDSTR:
	$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 FIELD
	MOVEM	T1,CPOSIT		;PERMANIZE NEW DEFALUT
	$COPY	CSTYPE,UF.TYP(PB)	;UPDATE CURR STRING TYPE
	RETURN
DEDERR:					;SUBROUTINES MAY ABORT TO HERE
	SETZM	0(DD)			;CLEAR OUT ABORTED DEF
	ERRU	(NPS)			;TELL USER
$ENDUTIL

SUBTTL	SWITCH PROCESSING FOR DEFINE

$UTIL	(DEFSWIT)
;
; DEFSWIT -PARSES SWITCHES ON DEFINE FILE COMMAND.
;
; NOTES:
;	EATRFV IS NOT USED BECAUSE OF CONFLICTS IN DISPLACEMENTS
;	OF CERTAIN FIELDS IN RMS argblks AND RMS ENTITY DESCRIPTORS.

DEFSLP:
	$CALL	P$SWIT			;GET A SWITCH
	JUMPF	L$RET			; ALL DONE
	CASES T1,MX%DFI

$CASE	(DFI%BKS)			;BKT SIZE FOR AREA 0
	$CALL	P$NUM			;EAT IT
	$STORE 	T1,BKS,(PB)
	JRST	DEFSLP
$CASE	(DFI%BSZ)			;BYTE SIZE
	$CALL	P$NUM
	CAILE	T1,^D36			;MUST BE <= 36
	ERRU	(IBS)			;invalid BYTE SIZE
	$STORE 	T1,BSZ,(PB)
	JRST	DEFSLP
$CASE	(DFI%MRS)			;MAX. RECORD SIZE
	$CALL	P$NUM
	$STORE	T1,MRS,(PB)
	JRST	DEFSLP
$CASE	(DFI%RFM)			;RECORD FORMAT
	$CALL	P$KEYW
	$STORE	T1,RFM,(PB)
	JRST	DEFSLP			;CHK FOR ANOTHER SWITCH
$ENDUTIL

$UTIL	(DKDSWIT)
;
; DKDSWIT - PROCESS SWITCHES ON DEFINE KEY & DATFLD CMDS
; NOTES:
;	CHABVAL ISNT USED BECAUSE AREA-NAMES & THE FLAG SWITCHES ARE SPECIAL

	SETZM	KAT(CF)			;INIT KEY ATTRIBUTES ACCUM
DKDSLP:
	$CALL	P$SWIT			;PICK UP NEXT SWITCH
	JUMPT	L$IFX			;NO JUMP IF DONE
		JUMPE	PB,L$RET	;EXIT IF NO KEY XAB
		MOVE	T1,KAT(CF)	;GET KEY ATTR
		$STORE	T1,FLG,(PB)	;STORE FLAG FLD IN XAB
		RETURN
	$ENDIF
	CAIN	T1,KD%DIS		;OTHER THAN /DISP?
	$SKIP				;YES, INIT KEY ENVIR IF NECES
		JUMPN	PB,L$IFX	;KEY XAB ALREADY SET UP
		PUSH	P,T1		;KLUDGILY PRESERVE CASE VAR
		$CALL	ALCKEY		;ALC KEY DESC IF NECES (PB=0)
		POP	P,T1		;RESTOR CASE VAR
	$ENDIF

	CASES	T1,MX%KD		;DISPATCH
$CASE	(KD%DIS)			;DATFLD SWITCH, DISPLAY FMT
	$P	(KEYW)			;PICK UP DEC/OCT
	STOR	T1,UF.TYP(UF)		;JUST EXPLODE INT TO DEC/OCT
	JRST	DKDSLP
$CASE	(KD%KEY)			;ATTRIBUTE-LESS KEY
	JRST	DKDSLP			;SYNTAX TABS GUARAN NEXT CALL FAILS

$CASE	(KD%DAN)			;DATA-AREA NAME
	$CALL	SY.CHK,<-XB$ALL>	;GET AREA NAME
	MOVEM	T2,XK.DAP(PB)		;STORE PTR TO AREA SYM
	JRST	DKDSLP			;CHK FOR MORE SWIT
$CASE	(KD%DFL)			;DATA-FILL  LIMIT
	$CALL	P$NUM			;GET THE LIMIT
	$STORE	T1,DFL,(PB)
	JRST	DKDSLP			;CHK FOR MORE SWIT
$CASE	(KD%CHA)			;CHANGES ALLOWED?
	$FLAGO	KAT(CF),XB$CHG
	JRST	DKDSLP			;CHK FOR MORE SWIT
$CASE	(KD%DUP)			;DUPLICATES-ALLOWED?
	$FLAGO	KAT(CF),XB$DUP
	JRST	DKDSLP			;CHK FOR MORE SWIT
$CASE	(KD%IAN)			;INDEX-AREA NAME
	$CALL	SY.CHK,<-XB$ALL>	;GET AREA NAME
	MOVEM	T2,XK.IAP(PB)		;STORE PTR TO AREA SYM
	JRST	DKDSLP			;CHK FOR MORE SWIT
$CASE	(KD%IFL)			;INDEX-FILL
	$CALL	P$NUM
	$STORE	T1,IFL,(PB)
	JRST	DKDSLP

$UTIL	(ALCKEY)
;
; ALCKEY - ALC A KEY XAB/DESC
; NOTES:
;	SETS UF.KEY IF ALLOC NECES
;	SETS XK.SEG IF ALLOC NECES
	SETZM	DUMDD+DD.VAL(CF)	;KLUDGE, CAUSES ALCBLK TO ALC KEY XAB
	MOVEM	DD,DUMDD+DD.NAM(CF)	;DONT CLOB DATFLD'S DD
	MOVEI	DD,DUMDD(CF)		;INDIC SYMBOL ALREADY EXISTS
	$CALL	ALCBLK,<XKINI>		;ALLOC THE KEY XAB
	MOVEM	PB,UF.KEY(UF)		;PT DATFLD DESC AT KEY XAB
	$COPY	XK.SEG(PB),DUMDD+DD.NAM(CF),DD
					;INDIC DATFLD IS 1ST (& ONLY) SEG OF KEY
	RETURN
$ENDUTIL
$ENDUTIL

$ENDSCOPE(DEFINE)

SUBTTL	PROCESS THE INFO CMD

$SCOPE	(INFO)
$LREG	(DD)				;SYMTAB PTR
$LREG	(TYP)				;SYM TYP CODE

$PROC	(C.INFO)
;
; C.INFO - LIST OUT THE CURRENT ENVIRONMENT
;
; SYNTAX:
;	INFO ALL!AREAS!CONTEXT!DATAFIELDS!KEYS

	MOVE	PB,FAB			;SETUP FAB ADDR
	$P	(KEYW)
	CASES	T1,MX%INF
$CASE	(INF%ALL)
	$CALL	INFCTX			;DISPLAY CONTEXT INFO
	$CALL	INFNAM,<[INF%DAT]>
	$CALL	INFNAM,<[INF%KEY]>
	$CALL	INFNAM,<[INF%AR]>
	RETT
$CASE	(INF%CON)
	$CALL	INFCTX
	RETT
$CASE	(INF%ARE)
$CASE	(INF%KEY)
$CASE	(INF%DAT)
	MOVEM	T1,T5			;MAKE  PASSABLE
	$CALL	INFNAM,<T5>		;PUT OUT APPROP 1
	RETT
$ENDPROC

SUBTTL	ROUTINES FOR INFO

$UTIL	(INFCTX)			;DO WORK FOR INFO CONTEXT
	MOVE	T4,CSTYPE		;GET CURR TYPE
	TT$OUT	(INFDDD,<DATTYP(T4),CPOSIT>)
					;DEF DATA DEFAULTS
	MOVE	T1,UTLFLG
	TXNE	T1,UT%FOP		;FILE OPEN?
	$SKIP				;NO
		TT$OUT	(INFFNO)	;TELL USER
		RETURN			;REST N/A
	$ENDIF
	MOVE	T2,OUTFAB		;GET RPT FILE FAB PTR
	$FETCH	T1,FNA,(T2)		;GET FILNAM PTR
	TT$OUT	(INFREP,T1)		;PUT IT OUT
	$FETCH	T1,FNA,(PB)		;GET FILNAM PTR
	TT$OUT	(INFFIL,T1)		;PUT IT OUT
	TT$OUT	(INFREC,CU.REC)		;RFA OF CURR REC
	$FETCH	T1,ORG,(PB)		;GET FILE ORG
	CAIE	T1,FB$IDX		;IS IT INDEX?
	RETURN				;NO, NO MORE CONTEXT
	TT$OUT	(INFBKT,CU.BKT)		;P# OF CURR BKT
	TT$OUT	(INFKRF,CU.KRF)		;CURR KEY OF REF
	RETURN
$ENDUTIL

$UTIL	(INFKAT)
;
; INFKAT - OUTPUT KEY ATTRIBUTES
;
	PUSH	P,PB			;SAVE ORIG ARGBLK PTR
INKSLP:
	SKIPN	T1,XK.SEG(PB)		;GET SEG NAME PTR
	$SKIP				;STILL MORE
		TT$OUT(INFKEG,0(T1))	;PUT OUT SEG NAME,
		AOJA	PB,INKSLP	;GET NEXT SEG
	$ENDIF
	POP	P,PB			;GET ORIG AB PTR BACK
	$FETCH	T1,FLG,(PB)		;GET KEY ATTR BITS
	TT$OUT	(INFKA0(T1))		;PICK RIGHT ELEM OF VECT
	SKIPN	T1,XK.DAP(PB)		;GET AREA NAME PTR
	$SKIP				;STILL MORE
		TT$OUT(INFKDA,0(T1))	;PUT OUT AREA NAME FROM SYM BLK
	$ENDIF
	SKIPN	T1,XK.IAP(PB)		;GET AREA NAME PTR
	$SKIP				;STILL MORE
		TT$OUT(INFKIA,0(T1))	;PUT OUT AREA NAME,
	$ENDIF
	$FETCH	T1,DFL,(PB)		;GET DATA FILL
	JUMPE	T1,L$IFX		;PUT OUT ONLY IF NOT NULL
		TT$OUT(INFKDF,T1)	;PUT OUT # OF WORDS
	$ENDIF
	$FETCH	T1,IFL,(PB)		;GET DATA FILL
	JUMPE	T1,L$IFX		;PUT OUT ONLY IF NOT NULL
		TT$OUT(INFKIF,T1)	;PUT OUT # OF WDS
	$ENDIF
	RETURN
$ENDUTIL

$UTIL	(INFNAM,<TYPBLK>)
;
; INFNAM - SCAN PRIVATE SYM TAB, PICKING OUT INDICATED TYPE BLKS
; ARGUMENTS:
;	TYPBLK = TYPE TO SCAN FOR
	MOVE	TYP,@TYPBLK(AP)		;GET ARGBLK TYPE
	MOVEI	DD,DDTAB		;PT TO BEGINNING OF PRIVATE SYMTAB
DUABLP:
	SKIPN	0(DD)			;IS A SYM IN THIS SLOT?
	JRST	DUABLE			;NO, INCR PTR
	MOVE	PB,DD.VAL(DD)		;PT TO NAME'S ARGBLK
	$FETCH	T1,BID,(PB)		;DISPATCH ON THIS
	CASES	TYP,MX%INF
$CASE	(INF%DAT)
	CAIE	T1,DA$TYP		;MATCH?
	JRST	DUABLE			;NO
	$CALL	SY.WID,<0(DD),[^D15]>	;RET SPT & TABS TO OUTPUT
	DMOVEM	T1,ISYMBP		;PT TO SYM TO OUTPUT
	LOAD	TAP,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,TAP			;POS+SIZ=END POS +1
	  SUBI	T4,1			;FIX IT
	  $CALLB TX$TOUT,<INFDAS,[ISYMBP],T3,DATTYP(T5),TAP,T4>
					;PUT OUT "NAME TYPE"
	  JRST	L$IFX
	$NOSKIP
	  $CALLB TX$TOUT,<INFDAI,[ISYMBP],T3,DATTYP(T5),TAP>
					;PUT OUT "NAME TYPE"
	$ENDIF
	JRST	DUABLE
$CASE	(INF%AR)
	CAIE	T1,XA$TYP		;MATCH?
	JRST	DUABLE			;NO
	$FETCH	T1,COD,(PB)		;CHK CODE TOO
	CAIE	T1,XB$ALL
	JRST	DUABLE			;NO MATCH
	$CALL	SY.WID,<0(DD),[^D15]>	;RET SPT & TABS TO OUTPUT
	DMOVEM	T1,ISYMBP		;PT TO SYM TO OUTPUT
	$FETCH	T2,BKZ,(PB)		;GET ITS BKT SIZE
	TT$OUT	(INFAREA,<[ISYMBP],T3,T2>)
	JRST	DUABLE
$CASE	(INF%KEY)
	CAIE	T1,DA$TYP		;DATA FLD?
	$SKIP				;YES
		SKIPN	PB,UF.KEY(PB)	;KEY AS WELL?
		JRST	DUABLE		;NO
		JRST	INKOUT		;YES
	$ENDIF
	CAIE	T1,XA$TYP		;MATCH?
	JRST	DUABLE			;NO
	$FETCH	T1,COD,(PB)		;CHK CODE TOO
	CAIE	T1,XB$KEY
	JRST	DUABLE			;NO MATCH
INKOUT:
	$CALL	SY.WID,<0(DD),[^D15]>	;RET SPT & TABS TO OUTPUT
	DMOVEM	T1,ISYMBP		;PT TO SYM TO OUTPUT
	TT$OUT	(INFKEY,<[ISYMBP],T3>)	;PUT OUT KEY NAME
	$CALL	INFKAT			;PUT OUT KEY ATTR
	TT$OUT	([[0]])			;CRLF
	JRST	DUABLE
$CASF
	ERRU	(IUE)
DUABLE:
	ADDI	DD,SZ%DD		;HOP TO NEXT ENTRY
	CAML	DD,DDCURR		;HIT LIMIT?
	RETURN				;YES
	JRST	DUABLP			;NO
$ENDUTIL
$ENDSCOPE(INFO)

SUBTTL	PROCESS THE OPEN COMMAND

$PROC	(C.OPEN)
;
;	C.OPEN - OPEN THE SPECIFIED   RMS!REPORT  FILE
;
	$P	(KEYW)
	CASES	T1,MX%OPE

$CASE	(OPE%REP)			;OPEN REPORT FILE
	MOVE	T5,UTLFLG		;CHECK IF A REPORT FILE ALREADY OPEN
	TXNE	T5,UT%RFO
	ERRU	(FAO)			;ONLY 1 RPT FILE CAN BE OPEN AT A TIME

	$CALL	INITAB,<FAA1>		;SETUP FAB FOR AN STREAM ASCII REPORT FILE
	$CALL	M.TOK			;PICK UP FILE NAME
	$STORE	T1,FNA,(PB)
	MOVEM	PB,OUTFAB		;SAVE FAB ADDR FOR RAB USE

OPAOPN:					;CREATE (OR OPEN)  FILE AND CONNECT A RECORD STREAM
	$CALL	P$SWIT				;GET SWITCH
	LOADX	T1,FB$SUP			;ASSUME NOT APP
	SKIPF					;IS /APP THERE?
	LOADX	T1,FB$CIF			;CR ONLY IF NECES
	$STORE	T1,FOP,(PB)			;PUT IT AWAY
	$CREATE	0(PB)	
	$CHKERR	(?UTLCOF could not open file)
OPACON:
	$CALL	INITAB,<RAA1>
	MOVE	T1,OUTFAB			;MOVE FAB ADDR TO RAB
	$STORE	(T1,FAB,(PB))
	$FETCH	T5,FOP,(T1)			;GET FOP BACK
	TXNN	T5,FB$CIF			;OPENED IF POSSIB?
	$SKIP					;YES, SO APPEND
		LOADX	T2,RB$EOF		;SET TO EOF.
		$STORE	(T2,ROP,(PB))
	$ENDIF
	$CONNECT 0(PB)	
	$CHKERR	(?UTLCOF could not open file)
	HRRZ	T1,OV.DSIG##				;BUFFER ADDR TO RAB
	$STORE	(T1,RBF,(PB))
	MOVEM	PB,OUTRAB			;SAVE RAB ADDR FOR $PUT's
	$FLAGO	(UTLFLG,UT%RFO)			;SET REPORT FILE OPN FLG
	RETT

$CASE	(OPE%RMS)			;***	CASE 1.  RMS FILE
	MOVE	T5,UTLFLG		;CHECK IF A RMS FILE ALREADY OPEN
	TXNE	T5,UT%FOP
	ERRU	(RAO)			;ONLY ONE RMS FILE CAN BE OPEN AT A TIME

	$CALL	INITAB,<FABINI>		;SETUP A FAB FOR RMS FILE
	$CALL	M.TOK			;PICK UP FILE NAME
	$STORE	(T1,FNA,(PB))		;PUT PTR TO FILE SPEC AWAY
	MOVEM	PB,FAB			;SAVE FAB ADDR FOR USE IN RAB

ORMACC:					;CHECK OPEN FOR INPUT OR OUTPUT
	$P	(KEYW)
	LOADX	T2,FB$NIL		;DEFAULT ACCESS IS TRANSPAR INPUT
	CAIE	T1,OP%INP		;DID USER SPECIFY INPUT?
	LOADX	T2,FB$DEL!FB$UPD	;NO. OUTPUT
	$STORE	(T2,FAC,(PB))		;STORE IN FAB
	LOADX	T2,FB$NIL		;SHR FIELD.
	$STORE	(T2,SHR,(PB))		;NEVER SHARE
	MOVE	T2,UTLFLG		;SET UP TO SET PATCHING FLAG
	CAIE	T1,OP%PAT		;PATCHING?
	TXZA	T2,UT%PAT		;NO
	TXO	T2,UT%PAT		;YES
	MOVEM	T2,UTLFLG		;PERMANIZE IT

ORMJSY:					;DO RMS OPERATIONS FOR DATA FILE
	$OPEN	0(PB)			; OPEN THE FILE
	$CHKERR	(?UTLCOF could not open file)

	$FETCH	T1,IFI,(PB)		;GET PTR TO RMS'S FILE STRUCT
	MOVEM	T1,FST			;PERMANIZE IT
	$FETCH	T1,ORG,(PB)		;!!! V1 SUPPORTS ONLY IDX !!!
	CAIN	T1,FB$IDX		;IS IT AN INDEX FILE
	$SKIP				;NO
		$CALL	CLORMS		;CLEAN UP
		JRST	L$ERRU(NRF)
	$ENDIF
	$CALL	P$SWIT			;REC SIZE SWIT?
	JUMPT	L$JUMP			;JUMP IF MRS ON CMD LINE
		$FETCH	T1,MRS,(PB)	;GET MAX REC SIZE
		SKIPN	T1		;WAS THERE MRS?
		MOVEI	T1,4000		;NO, DEFAULT TO FULL PAGE
		JRST	L$IFX
	$JUMP				;PICK UP CMD LINE VAL
		$P	(NUM)		;REQUIRED
	$ENDIF
	$FETCH	T2,BSZ,(PB)		;GET FILE'S BYTE SIZE
	MOVEI	T3,^D36			;GET BITS/WD
	IDIV	T3,T2			;CALC BYTES/WD
	ADDI	T1,-1(T3)		;INSURE ROUND UP
	IDIV	T1,T3			;BYTES-PER-REC/BYTES-PER-WD=WD/REC
	MOVEM	T1,BUFSIZ		;SAVE IT
	$CALL	M.ALC,<BUFSIZ>		;ALLOC THE BUF
	MOVEM	T1,BUFADR		;SAVE IT
	$CALL	INITAB,<RABINI>		;SETUP RAB FOR $CONNECT
	MOVE	T1,FAB			;MOVE FAB ADDR TO RAB
	$STORE	(T1,FAB,(PB))
	MOVE	T1,BUFADR		;GET ADDR OF USER BUF ALLOCATED
	$STORE	T1,UBF,(PB)		;PUT IT IN RAB
	MOVE	T1,BUFSIZ		;WDS IN REC BUF
	$STORE	T1,USZ,(PB)		;PUT IN RAB
	$CONNECT 0(PB)
	$CHKERR	(?UTLCOF could not open file)
	MOVEM	PB,RAB			;PERMANIZE ADDR OF RAB
ORM.EN:					;SET CONTEXT FOR THIS FILE
	$FETCH	T1,ISI,(PB)		;GET PTR TO RMS'S REC STRUCT
	MOVEM	T1,RST			;PERMANIZE IT
	$FLAGZ	(UTLFLG,UT%EMP!UT%PCH)	;PROL NOT CHGED YET &ASSUME DATA IN FILE
	$CALLB	M$USET,<RAB>		;SET ENVIR FOR $UTLINT
	$CALLB	BK$PROL			;SET P_IN_FILE IN UTLIO (GETBKT CONSIS)
	JUMPLE	T1,L$UNW		;OOPS, UNABLE TO READ PROLOG
ORM.FL:
	MOVE	PB,FAB			;GET FAB PTR BACK
	$FETCH	T1,FAC,(PB)		;SEE HOW OPENED TO SET FLAG
	CAIE	T1,FB$NIL		;RETRIEVAL?
	$SKIP				;YES
		$FLAGO	UTLFLG,UT%IN	;SET FLAG
		JRST	L$IFX
	$NOSKIP
		$FLAGO	UTLFLG,UT%OUT	;SET OUTPUT
	$ENDIF
ORM.KY:
	$FETCH	T5,BSZ,(PB)		;FIND BYTE SIZE OF FILE
	HRLI	T1,444400		;ASSUME OCTAL DUMP
	SETZB	T2,T3			;ASSUME NO CONV
	CAIE	T5,7			;ASCII?
	$SKIP				;YES
	  MOVEI	T4,40			;ASCII BLANK
	  HRLI	T1,440700		;GET BP VAL
	  JRST	OKYDON			;SET VARS
	$ENDIF
	CAIE	T5,6			;SIXBIT?
	$SKIP				;YES
	  MOVEI	T4,0			;SIXBIT BLANK
	  MOVEI	T3,S.TO.A		;FOR DISPLAY
	  MOVEI	T2,A.TO.S		;KEY CONV TABLE TO USE
	  HRLI	T1,440600		;GET BP VAL
	  JRST	OKYDON			;SET VARS
	$ENDIF
	CAIE	T5,9			;EBCDIC?
	$SKIP				;YES
	  MOVEI	T4,100			;EBCDIC BLANK
	  MOVEI	T3,E.TO.A		;FOR DISPLAY
	  MOVEI	T2,A.TO.E		;KEY CONV TABLE TO USE
	  HRLI	T1,441100		;GET BP VAL
;	  JRST	OKYDON			;SET VARS
	$ENDIF
OKYDON:
	MOVEM	T1,STRIPT		;DONE SETTING BYTE SIZE
	MOVEM	T2,STCAIN		;TAB TO CONV CMD LINE STRINGS
	MOVEM	T3,STCINA		;FOR DISPLAY OF STRINGS
	MOVEM	T4,STFILL		;SAVE FILL CHAR TOO
ORM.CU:					;SET CURRENCY INDICS
	$EH	(ORMCAB)		;SET DEFAULT CURRENCY IF ABORT
	SETZM	CU.KRF			;START WITH PRIM KEY
	$CALL	US.INIT			;INIT ENVIR FOR CURRENCY
	JUMPT	L$IFX			;ANY ERRORS?
ORMCAB:
		SETZM	CU.REC		;INDIC CURR REC NOT SET
		$COPY	CU.BKT,I 1	;PT AT ROOT 0 AS USUAL
	$ENDIF
	$CALL	CS.NEW			;PERMANIZE NEW CURRENCY
	RETT
$ENDPROC

SUBTTL	COMMON UTILITIES

$UTIL	(INITAB,<INIBLK>)
;
; INITAB - ALLOCATE A BLOCK OF STORAGE FOR
;	  FAB/RAB AND COPY INITIAL VALUES TO IT
; ARGUMENT:
;	INIBLK = INITIALIZED COPY OF BLK
; RETURNS:
;	PB = PTR TO ALLOCATED BLK

	MOVEI	PB,@INIBLK(AP)
	$FETCH	(T5,BLN,(PB))		;GET LENGTH OF BLK
	$CALL	M.ALC,<T5>		;ALLOCATE MEM
	EXCH	T1,PB			;PRESERVE PTR TO BLK
	$FETCH	(T2,BLN,(T1))		;GET ARGBLK'S LEN BACK
	HRL	T1,PB			;GET ADDR OF ALLOC VALUES
	MOVSS	T1			;BLT INIT,,ALLOC
	ADDI	T2,-1(PB)		;GET LAST WORD OF BLK
	BLT	T1,0(T2)		;COPY INIT VALUES TO ALLOCATED BLK
	RETURN
$ENDUTIL

SUBTTL	MEMORY MGT

$PROC	(M.INIT)
	RESET				;START WITH CLEAN SLATE
	$COPY	DDCURR,I DDTAB		;INIT SYMTAB
	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
	$CALLB	(GETMEM,T2);		;CALL RMS MEM MANAGER TO ALLOCATE
	RETT
$ENDPROC

$PROC	(M.RMSF)
;
; M.RMSF - FREE ALL MEMORY ACQUIRED FOR CURRENTLY OPEN RMS FILE
;
	SKIPN	T1,BUFADR			;WAS A BUFFER ALLOCATED?
	$SKIP
		$CALLB	(FREMEM,<T1,BUFSIZ>)	;FREE BUFFER
		SETZM	BUFADR
	$ENDIF
	SKIPN	PB,FAB				;FREE FAB
	$SKIP
		$FETCH	(T1,BLN,(PB))		;LENGTH OF FAB
		$CALLB	(FREMEM,<FAB,T1>)	;FREE IT
		SETZM	FAB
	$ENDIF
	SKIPN	PB,RAB				;FREE RAB
	$SKIP
		$FETCH	(T1,BLN,(PB))
		$CALLB	(FREMEM,<RAB,T1>)
		SETZM	RAB
	$ENDIF
	RETT

$ENTRY	(M.REPF)
;
; M.REPF - FREE MEM ACQ FOR REPORT FILE
;
	MOVE	PB,OUTFAB
	SETZM	OUTFAB
	$FETCH	(T1,BLN,(PB))
	$CALLB	(FREMEM,<PB,T1>)

	MOVE	PB,OUTRAB
	SETZM	OUTRAB
	$FETCH	(T1,BLN,(PB))
	$CALLB	(FREMEM,<PB,T1>)
	RETT
$ENDPROC

$SCOPE	(M.TOK)
$LREG	(BS)				;BLT SOURCE
$LREG	(TLEN)				;TOK LEN IN WDS

$PROC	(M.TOK)
;
; M.TOK - ALLOC SPACE FOR AND COPY STRING TO SPACE ALLOCATED
; RETURNS:
;	T1 = PTR TO ALLOCATED BLK

	$CALL	P$NFLD			;GET DATA FOR CURR FIELD
	MOVSI	BS,TK.VAL(T2)		;SAVE ADDR AND PREP TO BLT
	LOAD	TLEN,TK.LEN(T2)		;GET WD LEN OF TOK (INCL HDR)
	MOVEI	TLEN,-1(TLEN)		;REMOVE HDR WD FROM LEN
	$CALL	M.ALC,<TLEN>		;GRAB THE SPACE
	HRRM	T1,BS			;FINISH SETTING UP BLT AC
	ADDM	T1,TLEN			;END OF BLT
	BLT	BS,-1(TLEN)		;MOVE THE DATA
	RETT				;WITH T1 = PTR TO BLK
$ENDPROC
$ENDSCOPE(M.TOK)

SUBTTL	OPEN TTY: (OPEN THE DEFAULT OUTPUT DEVICE)

$PROC	(RP.INIT)
;
;RP.INIT -OPEN THE DEFAULT OUTPUT DVC.
;
;
	$CALL	INITAB,<FAA1>		;BUILD A FAB 
	MOVEM	PB,TTYFAB
	MOVEM	PB,OUTFAB		;SAVE ITS ADDR
	$OPEN	@TTYFAB	
	$CHKERR	(?UTLCOF could not open TTY:)

	$CALL	INITAB,<RAA1>		;BUILD A RAB
	MOVEM	PB,TTYRAB
	MOVEM	PB,OUTRAB
	MOVE	T1,TTYFAB
	$STORE	T1,FAB,(PB)		;SAVE FAB PTR IN RAB
	$CONNECT @TTYRAB			;ESTABLISH RECORD STREAM
	$CHKERR	(?UTLCOF could not open TTY:)
	HRRZ	T1,OV.DSIG##		;ADDR OF BUFFER TO RAB
	$STORE	T1,RBF,(PB)
	RETT
$ENDPROC

SUBTTL	SYMBOL PROCESSOR

$PROC	(SY.CHK,<CHKTYP>)
;
; SY.CHK - FIND SYMBOL & SEE IF IT IS OF DESIRED TYPE
; ARGUMENTS:
;	CHKTYP = TYPE SYM MUST BE (IMM FMT)
; RETURNS:
;	T1 = PTR TO THE ARGBLK
;	T2 = ADDRESS OF SYMTAB NODE
; NOTES:
;	DOES ERRU(NNK), ERRU(NWT) IF NECES
;	XAB TYPE IS DENOTED BY A NEGATIVE ARG

	MOVE	PB,CHKTYP(AP)		;MATER TYPE CODE (MISUSE PB)
	$ENDARG
	$CALL	SY.GET			;PARSE IT
	JUMPF	L$ERRU(NNK,VASZPT)	;BAD NAME
	LOAD	T3,UF.BID(T1)		;GET ITS TYPE
	JUMPG	PB,L$IFX		;NO JUMP IF XAB SPECIAL CASE
		CAIE	T3,XA$TYP	;DOES IT MATCH
		ERRU	(WTN,VASZPT)	;NO
		$FETCH	T3,COD,(T1)	;GET TYPE OF XAB
		MOVMS	PB		;GET SIGN RIGHT
	$ENDIF
	CAME	T3,PB			;DOES IT MATCH?
	ERRU	(WTN,VASZPT)		;NO
	RETT				;WITH ARGBLK & SYM ENT PTRS
$ENDPROC

$PROC	(SY.GET)
;
; SY.GET - PICK UP FIELD TOKEN AND FIND IN SYMTAB
; RETURNS AS FOR SY.FIND
	$P	(FLD)			;GET TOKEN
	MOVEM	T1,T5			;PUT PDB PTR IN COMM SPOT
	JRST	SYFMRG			;DO THE WORK
;
$ENTRY	(SY.FIND,<CURTOK>)
;
; SY.FIND - FIND A SYMBOL
; ARGUMENTS:
;	CURTOK = THE CURR TOK'S PDB
; RETURNS:
;	TF = -1 IF SYMBOL FOUND
;		0 IF NOT FOUND
;	T1 = VALUE OF SYMBOL
;	T2 = ADDRESS OF SYMTAB NODE
	MOVEI	T5,@CURTOK(AP)		;PT TO STRING
	$ENDARG
SYFMRG:
	$CALL	SYMASZ			;BUILD RADIX50 VALUE INTO VASZPT
	$CALL	SYMFND			;SEARCH PRIVATE SYMBOL TABLE
	JUMPF	L$RET			;FAIL IF NOT THERE EITHER
	MOVEM	T1,T2			;PRESERVE SYMTAB ADDR
	RETURN	(DD.VAL(T1))		;TRAN RET SUCC WITH VAL
$ENDPROC

$PROC	(SY.STOR)
;
; SY.STOR - STORE SYMBOL IN PRIVATE TABLE
; ARGUMENTS:
;	CURR TOKEN TO PARSE
; RETURNS:
;	TF = TRUE IF SYMBOL NOT ALREADY IN TABLE, FALSE OTHERWISE
;	T1 = SYMBOL NODE ADDRESS
	$P	(FLD)			;PICK UP FIELD BEING DEFINED
	MOVEM	T1,T5			;MAKE PTR TO FLDNAME PASSABLE
	$CALL	SYMASZ			;CLEAN UP ASZ NAME & SETUP VASZPT
	$CALL	SYMFND			;SEARCH PRIVATE SYMBOL TABLE
	JUMPT	L$RETF			;FAIL IF ALREADY THERE
	$CALL	P$PREV			;BACK UP TO FLD NAM
	$CALL	M.TOK			;ALLOC SPACE FOR & COPY TOKEN
	MOVE	T3,DDCURR		;CURR SPOT IN PRIVATE TABLE
	CAIL	T3,DDTAB+SZ%DDT		;HIT LIMIT
	ERRU	(TFU)			;YES, TAB FULL
	MOVEM	T1,DD.NAM(T3)		;PUT SYMBOL IN TABLE
	MOVEI	T1,SZ%DD(T3)		;HOP TO NEXT FREE SLOT
	EXCH	T1,DDCURR		;SAVE NEW 1ST FREE & SETUP RETVAL
	RETT				;RET SUC
$ENDPROC

$PROC	(SY.WID,<BPSYM,MAXLEN>)
;
; SY.WID - INSURES FIELD IS ACCEP LEN IN TABULAR DISPLAY
; ARGUMENTS:
;	BPSYM = BYTE PTR TO SYM (LH=0 IMPLIES 440700)
;	MAXLEN = MAX LEN TABLE CAN HANDLE
; RETURNS:
;	T1/T2 = STRING PTR OF STRING TO DISPLAY
;	T3 = PTR TO ASCIZ STRING OF TABS TO GET TO NEXT TAB STOP
;	IF TRUNCATION OF MAXLEN NECES, FAILURE RET TAKEN TO DISTING
	MOVE	T4,@MAXLEN(AP)		;MATER MAX LEN
	MOVE	T5,@BPSYM(AP)		;GET PTR TO SYM NAME
	$ENDARG
	TLNN	T5,-1			;BP INFO ALREADY THERE?
	HRLI	T5,440700		;NO, MAKE IT BP
	MOVEM	T5,T1			;SET BP PART OF RET VAL
	SETZM	T2			;INIT LEN CNT
	MOVEI	T3,[ASCIZ/	/]	;INIT TAB INFO
SYW.LP:
	LC	TAP,T5			;LOOP TO FIND LEN BY BRUTE FORCE
	JUMPE	TAP,SYWTAB		;EXIT IF SHORT NAME, RET WITH ITS SP
	CAML	T2,T4			;IN RANGE?
	RETF				;RET WITH TRUNCATED NAME
	AOJA	T2,SYW.LP		;KEEP TABULATING
SYWTAB:
	SUB	T4,T2			;GET DIFF BETW MAX & ACT
	CAIGE	T4,^D32			;WITHIN 4?
	MOVEI	T3,[ASCIZ/				/]
	CAIGE	T4,^D24			;WITHIN 3?
	MOVEI	T3,[ASCIZ/			/]
	CAIGE	T4,^D16			;WITHIN 2?
	MOVEI	T3,[ASCIZ/		/]
	CAIGE	T4,^D8			;WITHIN 1 TAB STOP?
	MOVEI	T3,[ASCIZ/	/]	;YES
	RETT
$ENDPROC

SUBTTL	SYMBOL TABLE SUBROUTINES

$UTIL	(SYMASZ)
;
; SYMASZ - CLEAN UP ASCII SYMBOL
; ARGUMENTS:
;	T5 = PTR TO FLD'S PDB
; RETURNS:
;	VASZPT = RADIX50 VAL
	$COPY	VASZPT,I TK.VAL(T5),T2	;SAVE PTR TO FLD NAME
	LOAD	T1,TK.LEN(T5)		;GET # OF WDS IN ENTRY
	ADDI	T2,-2(T1)		;REMOVE HDR WD & PT TO LAST WD OF NAME
	HRLI	T2,440700		;PT TO THIS WORD
	MOVEI	T3,5			;PREP TO LOOP THRU ITS BYTES
	MOVE	T4,[LC T1,T2]		;START BY GETTING CHARS FROM IT
SASZLP:
	XCT	T4			;DO LC/DC
	SKIPN	T1			;HIT NUL BYTE YET?
	MOVE	T4,[DC T1,T2]		;YES, DEPOSIT LATER BYTES
	SOJG	T3,SASZLP		;TIL WORD EXHAUSTED
	RETURN
$ENDUTIL

$UTIL	(SYMFND)
;
; SYMFND - SEARCH SYMBOL TABLE FOR @VASZPT
; 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
SYFOLP:
	MOVE	T3,DD.NAM(T5)		;PT TO 1ST WD OF NAME IN SYMTAB
	MOVE	T2,VASZPT		;DITTO, SYM BEING SEARCHED FOR
SYFILP:
	MOVE	T1,0(T3)		;GET CURR WD OF 1 STRING
	XOR	T1,0(T2)		;= OTHER? ISOL EFFECT OF RANDOM B35'S
	TRZ	T1,1			;B35 GUARAN OFF NOW
	JUMPN	T1,SYFILX		;EXIT INNER LOOP IF WORDS DIF
	LDB	T1,[POINT 7,0(T3),34]	;IS LAST CHAR OF WD NUL?
	JUMPE	T1,SYMEX		;YES, HAVE REACHED END STILL =, SO SUCC
	ADDI	T2,1			;MOVE TO NEXT WD OF SEARCH SYM
	AOJA	T3,SYFILP		;DITTO NAME IN SYMTAB
SYFILX:
	AOBJN	T5,.+1			;2ND WORD IN TAB ENTRY
	AOBJN	T5,SYFOLP		;LOOP IF MORE TO CHK
	RETF				;SYM NOT FND
SYMEX:
	HRRZ	T1,T5			;ISOL SYM NODE PTR
	RETT				;RET SUC
$ENDUTIL

$ENDSCOPE	(TOP-LEVEL)

END