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