Google
 

Trailing-Edge - PDP-10 Archives - BB-H138F-BM_1988 - 7-sources/rmsosm.mac
There are 6 other files named rmsosm.mac in the archive. Click here to see a list.
TITLE	RMSOSM - OS DEPENDENT MACRO CODE FOR RMS
SUBTTL	S. COHEN/RL
SEARCH	RMSINT,RMSMAC
$PROLOG

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

;++
; FACILITY: RMS
;
; ABSTRACT:
;	RMSOSM contains operating system dependent code for RMS.
;	These include monitor error handlers, memory initialization
;	routines, and a filename parser for TOPS-10.
;
; AUTHOR: Seth Cohen, CREATION DATE: ???
;
;--
REPEAT 0,<

*************************************************
*						*
*		NEW REVISION HISTORY		*
*						*
*************************************************

PRODUCT	MODULE	 SPR
 EDIT	 EDIT	 QAR		DESCRIPTION
======	======	=====		===========
53	1	XXXXX		(RLUSK) RMSSTACK incorrectly signed
				as local, should be global.


	***** END OF REVISION HISTORY *****

	***** Start Version 2 development *****

PRODUCT	MODULE	 SPR
 EDIT	 EDIT	 QAR		DESCRIPTION
======	======	=====		===========
301	300	XXXXX		(DAW, 1-Feb-82) Support for
				extended addressing.

402	401	xxxxx		(RL, 6-May-83) Change error handling
				in OKCREA.

>;END REPEAT 0

$PURE

; FORMAT STATEMENTS FOR RMS
;
DEFINE $MFMT (NAME,TEXT),<
INTERN	MF$'NAME
MF$'NAME:	ASCIZ \TEXT\
>

;^s: A = asciz, B= ascii, C= cont message, D=Date/time, J=JSYS error,
;	L=type crlf, N= no crlf, R= RFA, S=string, 1=Dec, 2=oct, 5=RAD50

$MFMT	(CAX,<$ ^J
Type CONTINUE after expunging deleted files.>)
$MFMT	(CLI,<?RMSOSE CALLI ^2^N>)
$MFMT	(CON,<^A^C>)
$MFMT	(ENR,<[Entering routine: ^A]>)
$MFMT	(ENT,<[RMS entry: ^A]>)
$MFMT	(FOP,<?RMSOSE FILOP. option ^2^N>)
$MFMT	(IER,<
?RMSIER An internal error was found in routine "^A" at ^2
	Error is:	^A>)
$MFMT	(IJC,<?RMSIJC invalid RMS JSYS code ^2 in call at ^2>)
$MFMT	(IOM,<?RMSOSE stream I/O monitor call failed with status code ^2>)
$MFMT	(JSY,<?RMSOSE JSYS ^2 failed at ^2: ^J>)
$MFMT	(OCT,<	^2>)
$MFMT	(RPF,<?RMSOSE reference to page ^2 failed: ^J>)
$MFMT	(RSF,<^A:	^2>)
$MFMT	(UEF,<?User error found: ^A>)
$MFMT	(UUO,< failed at ^2^LStatus code = ^2>)
SUBTTL	RMS INITIALIZATION ROUTINE

$SCOPE	(TOP-LEVEL)

RMSINI::
;
; THIS ROUTINE SETS UP THE START OF FREE CORE AND NO OF FREE
; PAGES FOR USE BY ITS OWN MEMORY MANAGER.
; WHEN LIBOL'S MEMORY MANAGER IS USED, THIS INFO IS NOT REFERENCED LATER.
;
; ON THE -10, THIS ROUTINE ALSO MARKS PAGES 700-714 AS BUSY
; IN THE PAGTAB. THIS IS BECAUSE THESE PAGES ARE UTILIZED BY
; VMDDT AND ARE NOT AVAILABLE FOR ALLOCATION
; NOTE: THE DEFAULT PAGE HANDLER IS AT 777000 SO IT IS NO PROBLEM
;		RMSEND+FREEPAGES LESS THAN 770
;
; CALL IS: JSP T2,RMSINI	[300]
;
; THIS ROUTINE JUGGLES THINGS BECAUSE, UNTIL UNMAP DONE,
; IT HAS "NO PLACE" TO PUT ARGBLK ADDR OR PRESERVE UJSYS & RETPC

	T$GLOB==RMS$$G##_-9		;GET 1ST PAGE OF GLOBS
	T$FREE==<RMSEND##+777>_-9	;GET PAGE PAST END OF GLOBALS

	DMOVEM	T3,USERAC##+T3		;[300] Save user's 3 and 4
	MOVE	T4,T2			;[300] Get return PC in AC4
IFN TOP$20,<
	MOVEI	T2,600			;DO THIS ONLY FOR NORMAL RMS
	CAIGE	T2,T$GLOB		;GLOBALS UP HI?
	JRST	INICMN			;NO, SKIP ZAP
	MOVE	T2,USERAC+T2		;[521] Preserve AC2
	DMOVEM	T1,RMSTACK##		;[521] [53] SAVE USER ARGBLK ADDR
	DMOVE	T1,USERAC+T3		;[300] Get user's AC 3 and 4
	DMOVEM	T1,RMSTAC+2		;[521] [300]
	DMOVE	T1,UJSYS##		;[300] Monitor sets there,
	DMOVEM	T1,RMSTAC+4		;[300] So save over Zeroing
	DMOVE	T1,RETPC##		;[300]
	DMOVEM	T1,RMSTAC+6		;[300]
	SETO	T1,			;INDIC UNMAPPING
	XMOVEI	T2,.			;[300] Get RMS's section number
	LSH	T2,-^D9			;[300] Shift to page number
	TRZ	T2,777			;[300] Get starting page of this section
	IOR	T2,[XWD .FHSLF,T$GLOB+1]	;[300] INSURE GLOBS AREA CLEAN
	MOVE	T3,[PM%CNT!<T$FREE-T$GLOB-1>]	;# OF PAGES IN GLOB AREA AFT STK
	PMAP%				;DO UNMAPPING (NO ERJMP, LET OS RPT IT)
	DMOVE	T1,RMSTAC+4		;[521] [300] Restore locs
	DMOVEM	T1,UJSYS		;[300]
	DMOVE	T1,RMSTAC+6		;[521] [300]
	DMOVEM	T1,RETPC		;[300]
	DMOVE	T1,RMSTAC+2		;[521] [300]
	DMOVEM	T1,USERAC+T3		;[300]
	DMOVE	T1,RMSTAC		;[521]
	MOVEM	T2,USERAC+2		;[521]
									;d572
INICMN:
	MOVEI	T2,T$FREE			; START OF FREE CORE
	MOVEM	T2,FRECOR##
	MOVEI	T2,FREEPAG##		; NO OF FREE PAGES
	MOVEM	T2,NUMFREE##
>									;a572
IFN TOP$10, <								;m572v
	MOVE	T2,[EXP RMS$10##]	;RMS entry point (in 1st page)
	TRZ	T2,777			;Page boundary
	HLRZ	T3,.JBHRN(T2)		;Get the length of the RMS segment
	ADD	T3,T2			;Plus origin (length was relative)
	ADDI	T3,777			;Round up to next page
	LSH	T3,-^D9			;Shift to page number
	MOVEM	T3,FRECOR##		;First free page after RMS
	TRZ	T3,777000		;Only pages in the RMS section
	MOVNS	T3			;Negate that number
	ADDI	T3,775			;+ page just below PFH
	MOVEM	T3,NUMFREE##		;Save number of free pages
>									;m572^
	XMOVEI	T2,.			;[300] Get our section number
	HLLZM	T2,RMSSEC##		;[300] Save it.
	SETOM	INTFLG##		; INDICATE INITIALIZED
	MOVE	T2,T4			;[300] Get return PC
	DMOVE	T3,USERAC+T3		;[300] Restore user acs 3 and 4
	JRST	0(T2)			;[300] RET TO INST AFTER THE JSP
SUBTTL	OS ERROR ROUTINES

$REG	(CAP,6)					;AC'S NOT SAVED CAUSE GO DIRECT TO USRRET
$REG	(FOP,7)					;FILOP OPTION

STK%KLU==-2					;PRESUME CODE GEN THAT PUTS PUSHJ
						;TO HERE +1 FROM OS CALL

MONERR::
;
; MONERR - GENERATES MESSAGE WHEN A MONITOR CALL FAILS
; ARGUMENTS:
;	PRESUMES CALL IS OF FORM:
;		JSYS or CALLI AC1,UUO-TYPE
;		PUSHJ P,MONERR

	SKIPN	T4,USTOSF##			;[%50] RMS CODE SPEC BY CALLER?
	MOVEI	T4,ER$BUG			;[%50] NO, DEFAULT RMS CODE ON OS ERR
	MOVEM	T4,USRSTS##			;[%50] PERMANIZE IT

	HRRZ	CAP,0(P)			;SETUP PTR TO ARG LIST
	MOVEI	CAP,STK%KLU(CAP)		;PT AT OS CALL RATHER AFT PUSHJ
	IFN TOP$10,<
	  HRL	T1,0(CAP)			;GET CALLI INDEX OF UUO
	  MOVEM	T1,USRSTV##			;SAVE UUO ID WITH STATUS RET BY UUO
	  $CALLB PRICHK##,<USRSTV##>		;DO OUTPUT?
	  JUMPE	T1,MERREXIT			;NO
	  HRRZ	T2,0(CAP)			;ISOLATE CALLI INDEX
	  $CALLB TX$OUT,<T2,[MF$CLI]>		;PUT OUT CALLI INDEX
MERRMRG:
	  HRRZ	T1,USRSTV##			;STAT CODE OF FAILED OPERATION
	  $CALLB TX$OUT,<CAP,T1,[MF$UUO]>	;PC & STAT CODE
	>					;END IFN TOP$10
	IFN TOP$20,<
	  MOVEI	T1,.FHSLF			;GET PROCESS HANDLE
	  GETER%				;BY MON ERR CODE
	  ERJMP	.+1				;IGNORE IT
	  HRL	T2,0(CAP)			;GET INDEX OF JSYS
	  MOVEM	T2,USRSTV##			;PERMANIZE IT
	  $CALLB PRICHK##,<USRSTV##>		;DO OUTPUT?
	  JUMPE	T1,MERREXIT			;NO
	  HRRZ	T2,0(CAP)			;ISOLATE JSYS INDEX
	  $CALLB TX$OUT,<T2,CAP,[MF$JSY]>	;JSYS INDEX & PC
	>					;END IFN TOP$20
MERREXIT:
	; ---					;[%50] SET USRSTS AT TOP OF ERR CODE
	PUSHJ	P,USRERR##			;GIVE UP AFTER PUTTING THE MSG OUT
IFN TOP$10,<

FOPERR::
;
; FOPERR - GENERATES MESSAGE WHEN A FILOP. FAILS
; ARGUMENTS:
;	PRESUMES CALL IS:
;		MOVE AC2,AC1		(SAVE ARG PTR)
;		FILOP. AC1,		(RETS STAT CODE IN AC1)
;		PUSHJ P,FOPERR

	SKIPN	T4,USTOSF##			;[%50] RMS CODE SPEC BY CALLER?
	MOVEI	T4,ER$BUG			;[%50] NO, DEFAULT RMS CODE ON OS ERR
	MOVEM	T4,USRSTS##			;[%50] PERMANIZE IT

	HRRZ	CAP,0(P)			;SETUP PTR TO ARG LIST
	MOVEI	CAP,STK%KLU(CAP)		;PT AT OS CALL RATHER AFT PUSHJ
	HRRZ	FOP,0(T2)			;GET FILOP OPTION FROM ARGBLK
	HRL	T1,FOP				;MAKE IT PART OF USRSTV
	TLO	T1,1000				;DISTING IT FROM SMALL CALLI IDX
	MOVEM	T1,USRSTV##			;SAVE UUO ID WITH STATUS RET BY UUO
	$CALLB PRICHK##,<USRSTV##>		;DO OUTPUT?
	JUMPE	T1,MERREXIT			;NO
	$CALLB TX$OUT,<FOP,[MF$FOP]>		;FILOP OPTION
	JRST	MERRMRG				;THE REST IS COMMON
>						;END FOPERR CONDITIONAL

IFN TOP$20,<
$BLISS	(OKCREATE,<PAGADD,PAGNUM>)
;
; OKCREATE - CHK QUOTA EXCEEDED & PAGE CREATE DURING READ-ONLY ACCESS
; ARGUMENTS:
;	PAGADD = ADDRESS IN MEM OF PAGE IN QUESTION
;	PAGNUM = FILE PAGE NUMBER
	MOVE	T1,@PAGADD(P)		;REF 1ST WORD OF PAGE
	ERJMP	.+2			;CHK IF ILL MEM READ
	POPJ	P,			;NO, JUST RET
	MOVEI	T1,.FHSLF			;[%52] GET PROCESS HANDLE
	GETER%					;[%52] BY MON ERR CODE
	ERJMP	.+1				;[%52] IGNORE IT
	HRRZ	T1,T2				;[%52] REMOVE PROC HANDLE
;
; T1 now contains the error code from the page creation
; failure.  We can allow the following codes:
;
;	PMAPX6 - Disk quota exceeded
;	IOX11  - Disk quota exceeded
;	
	CAIN	T1,PMAPX6	;[402] [%52] QUOTA EXC CASE 1?
	JRST	OKCQEX		;[402] Take quota exceeded exit
	CAIN	T1,IOX11	;[%52] QUOTA EXC CASE 2?
	JRST	OKCQEX		;[402] QUOTA EXCEEDED EXIT
	JRST	OKCOOPS		;[402] NOT QUOTA EXCEEDED
OKCQEX:	
	;
	; Quota is exceeded or disk is full
	;
	MOVEM	T1,USRSTV##	;[402] Put error code in STV
	MOVEI	T1,ER$EXT	;[402] Error extending file
	MOVEM	T1,USRSTS##	;[402] Store error in STS
	PUSHJ	P,USRERR##	;[402] Exit to user
OKCOOPS:				;FATAL ERR IF TO HERE
	;
	; Some other error
	;
	$COPY	USRSTV##,PAGNUM(P)	;TELL USER THE PAGE THAT WAS IMPROP REF
	$COPY	USRSTS##,I ER$UDF	;PRESUME FILE SCREWED UP
	CAIN	T1,ILLX01		;IS IT
	PUSHJ	P,USRERR##		;YES, GIVE UP
	$COPY	USRSTS##,I ER$BUG	;NO, GIVE OS UNEX ERR
	MOVEM	T1,USRSTV##		;RET OS ERR CODE TOO
	$CALLB	PRICHK##,<USRSTV##>	;PUTTING OUT MSG?
	JUMPE	T1,OKCRERR		;NO
	MOVE	T1,PAGNUM(P)		;MAKE P# PASSABLE
	$CALLB	TX$OUT,<T1,[MF$RPF]>	;YES, PUT P# & OS ERR MSG OUT
OKCRERR:PUSHJ	P,USRERR##		;EXIT
>
SUBTTL	 TTY OUTPUT HACK

IFN TOP$10,<

$BLISS	(TTYHACK,<ADDBUF,CNTCHAR>)
;
; TTYHACK - OUTPUT ASCII TEXT TO TTY
; ARGUMENTS:
;	ADDBUF = ADDR OF BUFFER OF CHARS
;	CNTCHAR = # OF CHARS TO WRITE
	MOVE	T1,ADDBUF(P)			;GET BUFF PTR
	MOVE	T2,CNTCHAR(P)			;GET AMT TO WRITE
	$ENDARG
	MOVEM	T1,T3				;PREP TO BUILD BP
	HRLI	T3,440700			;WORD-ALIGNED BP
	ADJBP	T2,T3				;FIND LAST CHAR
	ILDB	T4,T2				;SAVE CHAR PAST END
	SETZM	T3				;WRITE A NUL BYTE
	DPB	T3,T2				;DONE
	OUTSTR	0(T1)				;DO THE OUTPUT
	DPB	T4,T2				;RESTORE ACTU CHAR PAST END
	RETURN
$ENDPROC
SUBTTL	TOPS-10 FILE SPEC PARSER

$SCOPE	(PARSE-10)
$LREG	(FOPBLK,6)			;PTR TO FILOP. BLK
$LREG	(PARTBP,7)			;BP TO 6BIT COMPON OF FILE SPEC
$LREG	(PATIDX,10)			;PTR INTO PATH BLK
;$LREG	(FILBLK,11)			;PTR TO LOOKUP/ENTER BLK	;d572

$BLISS	(PAR10FS,<FS, P.FOPB>)						;m572
;
; PAR10FS - PARSES A TOPS-10 FILE SPEC, PLACING PARTS IN APPROP SPOTS
; ARGUMENTS:
;	FS = BYTE PTR TO ASCIZ FILE SPEC
;	P.FOPB = PTR TO FILOP. ARG BLK
; RETURNS:
;	T1 = -1 OR ER$FSI
	$REG	(CH,T2)				;CURR CHAR OF FILE SPEC
	$REG	(LPA,T3)				;# OF CHARS ROOM LEFT IN CURR FS PART
	$REG	(PA,T4)				;TEXT OF CURRENT PART OF SPEC

	MOVE	FOPBLK,P.FOPB(P)		;MATER FILOP BLK PTR      ;d572
	$ENDARG
	HRLI	PA,(FOPBLK)			;BUILD BLT POINTER	 ;m572v
	HRRI	PA,1(FOPBLK)
	SETZM	-1(PA)				;ZERO FIRST WORD
	BLT	PA,.FOFSF+5(FOPBLK)		;ZERO WHOLE BLOCK        ;m572^
	PUSHJ	P,EATPART			;EAT STRINGS UNTIL NUL BYTE SEEN
	SKIPE	PA				;NOTHING Q-ED, CHK IF VALID SPEC
	PUSHJ	P,ATEFOX			;ATE EITHER FILE OR EXT
	SKIPE	.FOFFN(FOPBLK)			;IS THERE A FILE NAME?	  ;m572
	$SKIP					;NO, MUST BE ONLY DEVICE
		SKIPN	.FOFDV(FOPBLK)		;DEV THERE?		 ;M572
		JRST	ERROR			;NO
		SKIPNF	.FOFEX(FOPBLK)		;EXTENSION?
		SKIPE	.FOFPP(FOPBLK)		;PPN?
		JRST	ERROR			;EITHER PRESENT, TOO BAD
	$ENDIF
	MOVSI	PA,'DSK'			;DEFAULT DEV FIELD
	SKIPN	.FOFDV(FOPBLK)			;USER SET DEV?		;m572
	MOVEM	PA,.FOFDV(FOPBLK)		;NO, USE DEFAULT	;m572
;d572	SKIPN	.PTPPN(PATIDX)			;[%41] NO DIR SPEC?
;d572	SETZM	.RBPPN(FILBLK)			;[%41] RIGHT, CANT USE PATH BLK
	SETOM	T1				;RET SUCCESS (NO ERROR CODE)
	RETURN
ERROR:
	MOVEI	T1,ER$FSI			;FILE SPEC INVALID
	RETURN
EATPART:
	MOVEI	LPA,6				;MAX LENG OF SIXBIT PART
	SETZM	PA				;CLEAR SIXBIT BUILD AREA
	MOVE	PARTBP,[POINT 6,PA]		;PLACE TO BUILD PART IN
EAT.LP:
	ILDB	CH,FS(CF)			;GET NEXT CHAR OF FILE SPEC
	CAIN	CH,0				;CHK IF END OF SPEC
	POPJ	P,				;YES
	CAIN	CH,":"				;DEVICE SPEC?
	JRST	ATEDEV				;YES, PUT IT AWAY
	CAIN	CH,"."				;FILE NAME?
	JRST	ATE.FN				;YES, PUT IT AWAY
	CAIN	CH,"["				;BEGIN OF DIR?
	JRST	EATPPN				;YES
	PUSHJ	P,EATCHAR			;EAT 6BIT CHAR REPR IN ASCII
	JRST	EAT.LP				;GET NEXT CHAR
ATEDEV:
	SKIPE	.FOFDV(FOPBLK)			;ALREADY SET?		;m572
	JRST	ERROR				;YES
	MOVEM	PA,.FOFDV(FOPBLK)		;STORE DEV NAME
	JRST	EATPART				;EAT ANOTHER PART
ATE.FN:
	SKIPE	.FOFFN(FOPBLK)			;ALREADY SET
	JRST	ERROR				;YES
	MOVEM	PA,.FOFFN(FOPBLK)		;STORE FILE NAME
	JRST	EATPART
EATPPN:
	SKIPE	PA				;ANY CHARS Q-ED?
	PUSHJ	P,ATEFOX			;YES, ATE FILE OR EXT
	SKIPE	.FOFPP(FOPBLK)			;SEEN PPN ALREADY?
	JRST	ERROR				;YES
	GETPPN	T1,				;GET LOGGED IN PPN
	  JFCL
	PUSHJ	P,EATOCT			;EAT PROJ NUMBER
	CAIN	CH,"-"				;IMPLIED DEFAULT PATH?
	  JRST	[SETZM .FOFPP(FOPBLK)		;THEN DO IT
		ILDB CH,FS(CF)			;SKIP THIS CHAR
		JRST SFD.L0]
	CAIE	CH,","				;END IN VALID DELIM?
	JRST	ERROR				;NO
	SKIPN	PA				;IF THERE USE IT	;m572v
	  HLRZ	PA,T1				;ELSE DEFAULT
	HRLM	PA,.FOFPP(FOPBLK)		;STORE PROJ#
	PUSHJ	P,EATOCT			;GET PROG#
	SKIPN	PA				;IF THERE USE IT
	  HRRZ	PA,T1				;ELSE DEFAULT IT
	HRRM	PA,.FOFPP(FOPBLK)		;STORE PROG#
SFD.L0:	MOVE	PATIDX,FOPBLK			;COPY POINTER TO BLOCK
	HRLI	PATIDX,-6			;MAKE INTO AOBJ PTR	;m572^
SFD.LP:
	SETZM	.FOFSF(PATIDX)			;IF LAST SEEN IS LAST	  ;m572
	CAIN	CH,"]"				;JUST A PPN?
	 JRST	EATPART				;YES, BACK TO MAIN LOOP   ;m572
	CAIE	CH,","				;BETTER BE THE RIGHT DELIM;a572
	  JRST	ERROR				;OR THAT'S AN ERROR	  ;a572
	PUSHJ	P,EATSFD			;EAT SFD, RET WITH DELIM IN CH
	MOVEM	PA,.FOFSF(PATIDX)		;STORE SFD		  ;m572
	AOBJN	PATIDX,SFD.LP			;MORE SLOTS AVAIL?
	JRST 	ERROR				;NO
									  ;d572
SUBTTL	SUBROUTINES

ATEFOX:						;TAKES BUILT UP STRING, STORES AS FILE OR EXT
	SKIPE	.FOFFN(FOPBLK)			;FILE WITH DEFAULT EXT? ;m572
	$SKIP					;YES
	  MOVEM	PA,.FOFFN(FOPBLK)		;PUT NAME AWAY		;m572
	  POPJ	P,
	$ENDIF
	SKIPE	.FOFEX(FOPBLK)			;EXTENSION SET?		;m572
	JRST	ERROR				;YES
	HLLM	PA,.FOFEX(FOPBLK)		;PUT IT AWAY		;m572
	POPJ	P,

EATCHAR:					;EAT 6BIT CHAR REPR AS ASCII, CHK CONV ERROR
	SOSL	LPA				;IGNORE CHARS AFTER 6TH
	CAIN	CH," "				;IGNORE IMBEDDED SPACES
	POPJ	P,				;YES, GET ANOTHER CHAR
	CAIE	CH,15				;IGNORE IMBEDDED CR
	CAIN	CH,12				;IGNORE IMBEDDED LF
	POPJ	P,				;YES TO EITHER
	CAIE	CH,140				;OUT OF CONVERT RANGE?
	CAILE	CH,"z"				;OUT CAUSE BEYOND LC Z?
	JRST	ERROR				;YES TO EITHER
	CAIGE	CH,40				;OUT CAUSE TOO LOW?
	JRST	ERROR				;YES
	CAIL	CH,"a"				;lower case alph?
	SUBI	CH,40				;YES, MAP to uc ascii
	SUBI	CH,40				;DO ASCII TO SIXBIT CONVERSION
	IDPB	CH,PARTBP			;PUT IT AWAY
	POPJ	P,

EATOCT:						;EAT UP TO 6 CHAR OCT NUMBER
	SETZM	PA				;INIT VALUE
EATOLP:
	ILDB	CH,FS(CF)			;GET PPN CHAR
	CAIE	CH,"]"				;END PROG#?
	CAIN	CH,","				;END PROJ# OR PROG#?
	POPJ	P,				;YES TO EITHER Q
	CAIN	CH,"-"				;Default Directory	;a572
	POPJ	P,				;DONE			;a572
	CAIL	CH,"0"				;LT 0?
	CAILE	CH,"7"				;LE 7?
	JRST	ERROR				;LT 0 OR GT 7
	SUBI	CH,"0"				;MAP TO DIGIT
	LSH	PA,3				;MAKE ROOM FOR OCTAL DIGIT
	TLNE	PA,-1				;MORE THAN 6?
	JRST	ERROR				;YES
	IOR	PA,CH				;NO, MERGE IT IN
	JRST	EATOLP				;GET ANOTHER

EATSFD:						;PARSE A SFD
	MOVEI	LPA,6				;MAX LENG OF SIXBIT PART
	SETZM	PA				;CLEAR SIXBIT BUILD AREA
	MOVE	PARTBP,[POINT 6,PA]		;PLACE TO BUILD PART IN
EATSLP:
	ILDB	CH,FS(CF)			;GET CHAR
	JUMPE	CH,ERROR			;CANT END SPEC WITHOUT ]
	CAIE	CH,","				;PROJ OR PROG DELIM?
	CAIN	CH,"]"				;PROG DELIM?
	POPJ	P,				;YES TO EITHER Q
	PUSHJ	P,EATCHAR			;EAT A CHAR FROM SFD
	JRST	EATSLP				;EAT ANOTHER CHAR
$ENDPROC
$ENDSCOPE(PARSE-10)
>						;END IFN TOP$10
$ENDSCOPE(TOP-LEVEL)

END