Google
 

Trailing-Edge - PDP-10 Archives - bb-jr93h-bb - alglib.c05
There are 15 other files named alglib.c05 in the archive. Click here to see a list.
 REP 3/1	;05C1
	;COPYRIGHT (C) 1975,1981,1982 BY
 WIT
	;COPYRIGHT (C) 1975,1982,1983 BY
 DEL 47/2	;05C2
		.PTSFD==3		; [275] PATH. BLOCK INDEX FOR SFD'S
		.PTPPN==2		; [275] INDEX FOR PPN
 DEL 83/2	;05C3
		HRLZI	A1,%JBEDT
		LSH	A1,^D9
		MOVEI	A2,3
		HRLZI	A5,(SIXBIT/ALG/)
		MOVE	A3,[POINT 6,A5,17]
		MOVE	A4,[POINT 7,SEGMES+6,6]

	GET2:	SETZ	A0,
		LSHC	A0,3
		ADDI	A0,20		; TO SIXBIT
		IDPB	A0,A3
		ADDI	A0,40		; TO ASCII
		IDPB	A0,A4		; TO ERROR-MESSAGE
		SOJG	A2,GET2
		MOVEM	A5,HSEG+1
		MOVEM	A5,HSEG1+1
 REP 102/2	;05C4
		JRST	NOSYS		; NOT FOUND
 WIT
		JRST	NOSEG		; [322] NOT FOUND
 DEL 107/2	;05C5

	NOSYS:	MOVEI	A0,HSEG1
		GETSEG	A0,		; TRY ON DSK INSTEAD
		JRST	NOSEG		; NOT THERE EITHER
		JRST	GET1		; FOUND ON DSK
 REP 14/3	;05C6
	HSEG:	SIXBIT /SYS/
		0	0
 WIT
	HSEG:	SIXBIT	/SYS/		; [340]
		SIXBIT	/ALGOTS/	; [340]
		SIXBIT	/EXE/		; [340]
 DEL 20/3	;05C7
	HSEG1:	SIXBIT /DSK/
		0	0
		0
		0
		0

 REP 36/3	;05C8
	?ALGOL object time system ALGNNN.EXE not found, GETSEG error code / ; [265]
 WIT
	?ALGOL object time system ALGOTS.EXE not loaded, GETSEG error code /
					; [340] [322] [265]
 DEL 166/115	;05C9
	;[245]	XCTA	.A(DL)		; GET ADDRESS OF A
 REP 25/116	;05C10
		LDB	A0,[
		POINT	24,STR2(A2),35]	; AND ITS LENGTH
 WIT
		LDB	A0,[POINT 24,STR2(A2),35] ; AND ITS LENGTH
 INS 1/117	;05C11

 REP 5/117	;05C12
		LDB	A0,[
		POINT	6,STR1(A2),11]	; GET BYTE SIZE
 WIT
		LDB	A0,[POINT 6,STR1(A2),11] ; GET BYTE SIZE
 INS 14/129	;05C13
		MOVE	AX,PRGLNK(DL)	; [335] GET RETURN ADDR.
		MOVE	AX,-1(AX)	; [335] GET FORMAL BITS
		MOVEM	AX,A01TMP(DB)	; [335] PUT THEM HERE UNTIL WE NEED THEM
 REP 24/129	;05C14
		SETZ	A0,		; [256] GET READY TO DELETE STRING SPACE
		TLC	A2,STRDYN!STRPRC; [256] COMPLEMENT STRING STATUS BITS
		TLCE	A2,STRDYN!STRPRC; [256] WAS THIS A TRANSIENT STRING?
		JRST	.EXIT(DL)	; [256] NO, EXIT
		PUSHJ	SP,GETOWN	; [256] YES, DELETE IT
 WIT
		HLRZ	A0,A01TMP(DB)	; [335] GET FORMAL BITS INTO RIGHT HALF
		TRZ	A0,77		; [335] TURN OFF WHAT WE DON'T CARE ABOUT
		CAIE	A0,$PRO!$S	; [335] STATIC SIMPLE STRING PROC (USER PROC.)?
		CAIN	A0,$D!$EXP!$S	; [335] DYNAMIC SIMPLE STR EXPR (STR EXPRSION)?
		 JRST	LAB321		; [335] YES, GO DELETE IT
		CAIE	A0,$PRO!$S!$EXT	; [335] STATIC EXTERN STR PROC. (ALGLIB PROC.)?
		JRST	.EXIT(DL)	; [335] NO, EXIT BUT DON'T DELETE IT
	LAB321:	SETZ	A0,		; [335] YES, GET READY TO DELETE THE STRING
		PUSHJ	SP,GETOWN	; [335] DO IT
 INS 14/130	;05C15

		MOVE	AX,PRGLNK(DL)	; [335] GET RETURN ADDR.
		MOVE	AX,-1(AX)	; [335] GET FORMAL BITS
		MOVEM	AX,A01TMP(DB)	; [335] PUT THEM HERE UNTIL WE NEED THEM
 REP 22/130	;05C16
		SETZ	A0,		; [256] GET READY TO DELETE STRING SPACE
		TLC	A2,STRDYN!STRPRC; [256] COMPLEMENT STRING STATUS BITS
		TLCE	A2,STRDYN!STRPRC; [256] WAS THIS A TRANSIENT STRING?
		JRST	.EXIT(DL)	; [256] NO, EXIT
		PUSHJ	SP,GETOWN	; [256] YES, DELETE IT
 WIT
		HLRZ	A0,A01TMP(DB)	; [335] GET FORMAL BITS INTO RIGHT HALF
		TRZ	A0,77		; [335] TURN OFF WHAT WE DON'T CARE ABOUT
		CAIE	A0,$PRO!$S	; [335] STATIC SIMPLE STRING PROC (USER PROC.)?
		CAIN	A0,$D!$EXP!$S	; [335] DYNAMIC SIMPLE STR EXPR (STR EXPRSION)?
		 JRST	LAB326		; [335] YES, GO DELETE IT
		CAIE	A0,$PRO!$S!$EXT	; [335] STATIC EXTERN STR PROC. (ALGLIB PROC.)?
		JRST	.EXIT(DL)	; [335] NO, EXIT BUT DON'T DELETE IT
	LAB326:	SETZ	A0,		; [335] YES, GET READY TO DELETE THE STRING
		PUSHJ	SP,GETOWN	; [335] DO IT
 DEL 15/131	;05C17
	EDIT (133)	; AVOID STACK-SHIFT PROBLEMS
 REP 1/132	;05C18
		TITLE	CONCAT - STRING CONCATENATION ROUTINE
 WIT
	TITLE CONCAT - STRING CONCATENATION ROUTINE
 DEL 35/132	;05C19
 REP 15/133	;05C20
		LDB	A0,[
		POINT	6,STR1(A2),11]	; GET BYTE-SIZE INTO A0
		LDB	A1,[
		POINT 24,STR2(A2),35]	; AND LENGTH INTO A1
 WIT
		LDB	A0,[POINT 6,STR1(A2),11] ; GET BYTE-SIZE INTO A0
		LDB	A1,[POINT 24,STR2(A2),35] ; AND LENGTH INTO A1
 REP 6/134	;05C21
		LDB	A5,[
		POINT 24,STR2(A2),35]	; GET LENGTH OF STRING
 WIT
		LDB	A5,[POINT 24,STR2(A2),35] ; GET LENGTH OF STRING
 REP 35/145	;05C22
		IOERR	6,(A13)		; [251][E1017] HIT EOF, ERROR WITH CH. # IN A13
 WIT
		JRST	READ90		; [312] EOF, DONE
 INS 14/148	;05C23
		MOVE	AX,PRGLNK(DL)	; [335] GET RETURN ADDR.
		MOVE	AX,-1(AX)	; [335] GET FORMAL BITS
		MOVEM	AX,A01TMP(DB)	; [335] PUT THEM HERE UNTIL WE NEED THEM
 REP 19/148	;05C24

	WRIT1:	MOVE	A3,STR1(A0)	; [237] GET BYTE-POINTER
		LDB	A1,[POINT 24,STR2(A0),35]  ; [237] GET STRING LENGTH
 WIT
		MOVE	A3,A0		; [325] [237] GET BYTE-POINTER
		LDB	A1,[POINT 24,A1,35] ; [325] [237] GET STRING LENGTH
 REP 30/148	;05C25
		SETZ	A0,		; [256] GET READY TO DELETE STRING SPACE
		TLC	A2,STRDYN!STRPRC; [256] COMPLEMENT STRING STATUS BITS
		TLCE	A2,STRDYN!STRPRC; [256] WAS THIS A TRANSIENT STRING?
		JRST	.EXIT(DL)	; [256] NO, EXIT
		PUSHJ	SP,GETOWN	; [256] YES, DELETE IT
		JRST	.EXIT(DL)	; [256] AND EXIT
	WRIT4:	JSP	AX,WRIT2	; GET NEXT BYTE

	WRIT5:	CAIN	A13,"["		; LEFT SQUARE BRACKET?
		XCT	[
		AOJA	A4,WRIT4
		AOJA	A4,WRIT4
		SOJA	A4,WRIT6]+1(A4)
		CAIN	A13,"]"		; NO - RIGHT SQUARE BRACKET?
		XCT	[
		AOJA	A4,WRIT6
		SOJA	A4,WRIT4
		SOJA	A4,WRIT6]+1(A4)
		XCT	[
		AOJA	A4,WRIT6
		JRST	WRIT6
		JRST	WRIT8]+1(A4)	; NO
 WIT
		HLRZ	A0,A01TMP(DB)	; [335] GET FORMAL BITS INTO RIGHT HALF
		TRZ	A0,77		; [335] TURN OFF WHAT WE DON'T CARE ABOUT
		CAIE	A0,$PRO!$S	; [335] STATIC SIMPLE STRING PROC (USER PROC.)?
		CAIN	A0,$D!$EXP!$S	; [335] DYNAMIC SIMPLE STR EXPR (STR EXPRSION)?
		 JRST	LAB413		; [335] YES, GO DELETE IT
		CAIE	A0,$PRO!$S!$EXT	; [335] STATIC EXTERN STR PROC. (ALGLIB PROC.)?
		JRST	.EXIT(DL)	; [335] NO, EXIT BUT DON'T DELETE IT
	LAB413:	SETZ	A0,		; [335] YES, GET READY TO DELETE THE STRING
		PUSHJ	SP,GETOWN	; [335] DO IT
		JRST	.EXIT(DL)	; [256] AND EXIT
	WRIT4:	JSP	AX,WRIT2	; GET NEXT BYTE
	WRIT5:	CAIN	A13,"["		; LEFT SQUARE BRACKET?
		XCT	[AOJA	A4,WRIT4
			AOJA	A4,WRIT4
			SOJA	A4,WRIT6]+1(A4)
		CAIN	A13,"]"		; NO - RIGHT SQUARE BRACKET?
		XCT	[AOJA	A4,WRIT6
			SOJA	A4,WRIT4
			SOJA	A4,WRIT6]+1(A4)
		XCT	[AOJA	A4,WRIT6
			JRST	WRIT6
			JRST	WRIT8]+1(A4)	; NO
 REP 22/149	;05C26

	WRIT8:	TDZA	A5,A5		; CLEAR COUNT (FIRST TIME)

 WIT
	WRIT8:	TDZA	A5,A5		; CLEAR COUNT (FIRST TIME)
 INS 15/160	;05C27
		.SFMAX=6		; [324] MAX. DEPTH OF SFD'S ALLOWED + 1

 REP 29/160	;05C28
	OPF0:	JRST	OPF0(A1)	; BRANCH ON NUMBER OF PARAMETERS
 WIT
	OPNFIL:	JRST	OPNFIL(A1)	; [324] BRANCH ON NUMBER OF PARAMETERS
 REP 46/160	;05C29
		MOVE	A2,.LU(DL)	; RESTORE ADDRESS OF STRING
		MOVEI	A2,@A2		; STATICISE IT
		LDB	A0,[POINT 24,STR2(A2),35]  ; GET IT'S LENGTH
		MOVE	A4,STR1(A2)	; AND SAVE BYTE POINTER
		SETZB	A5,A6		; CLEAR FILE AND EXTENSION
		JUMPE	A0,OPF5		; NULL STRING?
		MOVE	A7,[POINT 6,A5,]; BYTE POINTER FOR FILE NAME
		MOVEI	A10,1		; BYTE INDEX
	OPF1:	PUSHJ	SP,OPF6		; GET NEXT BYTE
		CAIN	A2,'.'		; POINT?
		AOJA	A10,OPF3	; YES
		IDPB	A2,A7		; PLANT BYTE IN NAME
		CAIGE	A10,6		; NAME FULL?
		AOJA	A10,OPF1	; NO - KEEP GOING
		AOJ	A10,		; [210] COUNT THE SIXTH CHARACTER

	OPF2:	PUSHJ	SP,OPF6		; SCAN FOR POINT
		CAIE	A2,'.'
		AOJA	A10,OPF2
		ADDI	A10,1

	OPF3:	MOVE	A7,[POINT 6,A6,]; BYTE POINTER FOR FILE EXTENSION
		MOVEI	A11,3		; BYTE COUNT

	OPF4:	PUSHJ	SP,OPF6		; GET NEXT BYTE
		IDPB	A2,A7		; AND PLANT IT IN EXTENSION
		SOJE	A11,OPF5	; ANY MORE EXTENSION?
		AOJA	A10,OPF4	; NO - KEEP GOING

	EDIT(); FIX STACK ON RETURN FROM OPF6
	OPF5A:	POP	SP,(SP)		; [E037] STEP BACK OVER RETURN ADDRESS
	OPF5:	MOVE	A1,.N(DL)	; RESTORE CHANNEL NUMBER
		LRLOAD	A2,A5		; LOAD FILE NAME AND EXTENSION
		HRLZ	A4,.P(DL)
		LSH	A4,11		; PROTECTION
		MOVE	A5,.PP(DL)	; PROJECT-PROGRAMMER
		PUSHJ	SP,OPFILE	; AND OPEN FILE
		POP	SP,A2		; GET ADDR OF I (OR 0)
		SKIPN	A0,		; ERROR ?

	EDIT(160); Don't clobber label address when storing error code.
		JRST	[POP	SP,(SP)		; [E160]
			JRST	.EXIT(DL)]	; [E160]
		SUBI	A0,100		; ERR-CODE HAS 100 ADDED TO IT BY OTS
		SKIPE	.I(DL)		; YES - I ?
		XCT	.I+1(DL)	; YES - PUT ERROR-CODE IN IT
		POP	SP,A2		; [E160] Get label address
	EDIT(020) ; FORLAB NEEDS ADDRESS IN A2, NOT A3 !
		SKIPE	A2		; [E020][E160] IS THERE AN ERROR EXIT ?
		JRST	(A2)		; [E020] IF SO, TAKE IT
		IOERR	5,(A1)		; ELSE GIVE ERROR MESSAGE

	OPF6:	CAMLE	A10,A0		; GET SIXBIT BYTE SUBROUTINE
		JRST	OPF5A		; [E037] NONE LEFT - ERROR RETURN
		ILDB	A2,A4		; AND GET NEXT BYTE
		SUBI	A2,40
		JUMPL	A2,OPF7		; TOO LOW
		CAILE	A2,132
		JRST	OPF7		; TOO HIGH
		CAIL	A2,100		; LOWER CASE ALPHA?
		SUBI	A2,40		; YES - RECODE TO UPPER CASE ALPHA
		POPJ	SP,0

	OPF7:	MOVEI	A2,0
		POPJ	SP,0
 WIT
		MOVEI	A0,.SFMAX+4	; [324] NEED SPACE FOR PATH BLOCK
		PUSHJ	SP,GETCLR	; [324] GET THE SPACE
		PUSH	SP,A1		; [324] SAVE ADDR. OF PATH BLOCK
		MOVE	A2,.LU(DL)	; [324] GET ADDR. OF STRING
		MOVEI	A2,@A2		; [324] STATICISE IT
		MOVE	A0,.PP(DL)	; [324] GET PPN
		MOVEM	A0,.PTPPN(A1)	; [324] STORE IN PATH BLOCK
		SETZB	A5,A6		; [324] CLEAR FILENAME AND EXTENSION
		LDB	A10,[POINT 24,STR2(A2),35] ; [324] GET STRING LENGTH
		JUMPE	A10,OPFNOW	; [324] ALLOW NULL NAME TO DELETE FILE
		MOVE	A4,STR1(A2)	; [324] COPY BYTE POINTER
		MOVE	A7,[POINT 6,A5]	; [324] BYTE POINTER FOR FILE NAME
		MOVEI	A0,6		; [324] MAX. LENGTH OF FILENAME
		PUSHJ	SP,GETCHR	; [324] GET FIRST BYTE OF FILESPEC
		 PUSHJ	SP,OPFERR	; [324] ERROR IF STRING EOF IS FOUND
		CAIG	A2,'Z'		; [324] FIRST CHR. MUST BE ALPHANUMERIC
		CAIGE	A2,'0'		; [324]
		 PUSHJ	SP,OPFERR	; [324] ISN'T, CHR. CAN'T APPEAR HERE
		JRST	OPFNM1		; [324] NO, BEGIN BUILDING FILENAME

	; [324] PARSE AND BUILD FILENAME IN A5
	OPFNAM:	PUSHJ	SP,GETCHR	; [324] GET NEXT BYTE
		 JRST	OPFNOW		; [324] GO OPEN FILE IF STRING EOF IS FOUND
		CAIN	A2,'.'		; [324] POINT?
		 JRST	OPFEXT		; [324] YES, GO PARSE EXTENSION
		CAIN	A2,'['		; [324] NO, BEGINNING OF PPN AND SFD SPEC.?
		 JRST	OPFPPN		; [324] YES, GO PARSE IT
	OPFNM1:	IDPB	A2,A7		; [324] NO, PLANT BYTE IN FILENAME
		SOJG	A0,OPFNAM	; [324] LOOP UNTIL SIX CHRS. OR A DELIMITER

		PUSHJ	SP,GETCHR	; [324] SIX CHRS. FOUND, GET NEXT ONE
		 JRST	OPFNOW		; [324] GO OPEN FILE IF STRING EOF IS FOUND
		CAIN	A2,'['		; [324] BEGINNING OF PPN AND SFD SPEC.?
		 JRST	OPFPPN		; [324] YES, GO PARSE IT
		CAIE	A2,'.'		; [324] NO, POINT?
		 PUSHJ	SP,OPFERR	; [324] NO, FILESPEC IS BAD

	; [324] PARSE AND BUILD EXTENSION IN A6
	OPFEXT:	MOVEI	A0,3		; [324] MAX. LENGTH OF EXTENSION
		MOVE	A7,[POINT 6,A6]	; [324] BYTE POINTER FOR EXTENSION
	OPFEX1:	PUSHJ	SP,GETCHR	; [324] GET NEXT BYTE
		 JRST	OPFNOW		; [324] GO OPEN FILE IF STRING EOF IS FOUND
		CAIN	A2,'['		; [324] BEGINNING OF PPN AND SFD SPEC.?
		 JRST	OPFPPN		; [324] YES, GO PARSE IT
		IDPB	A2,A7		; [324] NO, PLANT IT IN EXTENSION
		SOJG	A0,OPFEX1	; [324] LOOP UNTIL THREE CHRS. OR A DELIMITER

		PUSHJ	SP,GETCHR	; [324] GET NEXT CHR.
		 JRST	OPFNOW		; [324] GO OPEN FILE IF STRING EOF IS FOUND
		CAIE	A2,'['		; [324] BEGINNING OF PPN AND SFD SPEC?
		 PUSHJ	SP,OPFERR	; [324] NO, BAD FILESPEC

	; [324] PARSE PPN AND SFD SPEC.  PPN IS BUILT FIRST, IN A7
	OPFPPN:	PUSHJ	SP,GETPP	; [324] GET PROJECT NUMBER IN A3 RIGHTHALF
		 JRST	[JUMPE	A3,OPFERR	; [324] DON'T ALLOW EOF AFTER BRACKET
			MOVEI	A2,']'		; [324] OK, FAKE OURSELVES OUT
			JRST	.+1]		; [324] AND CONTINUE
		HRLZ	A7,A3		; [324] SAVE PROJECT NUMBER IN A7 LEFTHALF
		CAIN	A2,']'		; [324] END OF ENTIRE FILESPEC?
		 JRST	OPFPP1		; [324] YES, GO BUILD PPN AND OPEN FILE
		PUSHJ	SP,GETPP	; [324] NO, GET PROGRAMMER NUMBER
		 MOVEI	A2,']'		; [324] EOF, FAKE OURSELVES OUT
		HRR	A7,A3		; [324] MAKE COMPLETE PPN
	OPFPP1:	JUMPE	A7,OPFSFD	; [324] IF PPN IS ZERO, DON'T DEFAULT HERE!
		GETPPN	A0,		; [324] SOME PPN SPEC WAS GIVEN, GET OUR PPN
		TRN			; [324] IGNORE NORMAL RETURN
		HLRZ	A3,A7		; [324] GET PROJECT NUMBER
		SKIPN	A3		; [324] ZERO?
		 HLL	A7,A0		; [324] YES, DEFAULT TO OUR PROJECT NUMBER
		HRR	A3,A7		; [324] NO, GET PROGRAMMER NUMBER
		SKIPN	A3		; [324] ZERO?
		 HRR	A7,A0		; [324] YES, DEFAULT TO OUR PROGRAMMER NUMBER
		MOVEM	A7,.PP(DL)	; [324] NO, SAVE COMPLETED PPN
		MOVE	A1,(SP)		; [324] GET PATH BLOCK ADDR. BACK
		MOVEM	A7,.PTPPN(A1)	; [324] STORE PPN IN PATH BLOCK

	; [324] NOW BUILD SFD LIST
	OPFSFD:	CAIN	A2,']'		; [324] DONE WITH SFD'S?
		 JRST	OPFNOW		; [324] YES, GO OPEN FILE
		MOVEI	A1,.SFMAX	; [324] NO, LOAD MAX. DEPTH OF SFD'S ALLOWED
	OPFSF1:	PUSHJ	SP,GETSFD	; [324] GET FIRST SFD NAME
		 JUMPE	A7,OPFSF2	; [324] DONE WITH SFD LIST IF NULL
		MOVE	A3,(SP)		; [324] GET PATH BLOCK ADDR.
		SUBI	A3,(A1)		; [324] POINT TO PROPER SFD NAME ENTRY
		MOVEM	A7,.PTSFD+.SFMAX(A3) ; [324] PLANT SFD NAME
		CAIN	A2,']'		; [324] LAST NAME IN SFD LIST?
		 JRST	OPFNOW		; [324] YES, GO OPEN FILE
		SOJG	A1,OPFSF1	; [324] NO, LOOP UNTIL MAX. SFD NAMES ARE READ
		PUSHJ	SP,GETCHR	; [324] GET NEXT CHR. AFTER MAX. SFD'S READ
		 JRST	OPFNOW		; [324] HAD BETTER BE EOF
		PUSHJ	SP,OPFERR	; [324] ELSE BAD FILESPEC

	OPFSF2:	CAIN	A2,','		; [324] NULL SFD NAME FOUND?
		 PUSHJ	SP,OPFERR	; [324] YES, ILLEGAL FILESPEC

	; [324] THE PPN AND SFD'S ARE ALL NOW IN PLACE - OPEN THE FILE.
	OPFNOW:	MOVE	A1,.N(DL)	; [324] RESTORE CHANNEL NUMBER
		LRLOAD	A2,A5		; [324] LOAD FILENAME AND EXTENSION
		HRLZ	A4,.P(DL)	; [324] GET PROTECTION CODE
		LSH	A4,11		; [324] MOVE IT OVER
		MOVE	A5,(SP)		; [324] GET PATH BLOCK ADDR.
		PUSHJ	SP,OPFILE	; [324] AND GO OPEN FILE
		POP	SP,A1		; [324] RESTORE PATH BLOCK ADDR.
		PUSH	SP,A0		; [324] SAVE ERROR CODE FROM ALGOTS
		SETZ	A0,		; [324] RETURN SPACE TO HEAP
		PUSHJ	SP,GETOWN	; [324] DO IT
		POP	SP,A0		; [324] RESTORE ERROR CODE
		POP	SP,A2		; [324] GET ADDR. OF I (OR 0)
		JUMPE	A0,[POP	SP,(SP)		; [324] RESTORE LABEL ADDR.
			JRST	.EXIT(DL)]	; [324] AND EXIT
		SUBI	A0,100		; [324] ERROR CODE HAS 100 ADDED TO IT BY OTS
		SKIPE	.I(DL)		; [324] HAVE ANYPLACE TO PUT ERROR CODE?
		XCT	.I+1(DL)	; [324] YES, PLANY CODE
		POP	SP,A2		; [324] GET LABEL ADDRESS
		JUMPN	A2,(A2)		; [324] TAKE ERROR EXIT IF ONE EXISTS
		MOVE	A1,.N(DL)	; [324] ELSE GET CHANNEL NUMBER BACK
		IOERR	5,(A1)		; [324] AND GIVE ERROR MESSAGE
		JRST	.EXIT(DL)	; [324] CONTINUE AT USER'S RISK ONLY

	; [324] GET UP TO SIX OCTAL NUMBERS IN A3 RIGHTHALF.  USED IN BUILDING PPN.
	; [324] DELIMITING CHR. IS LEFT IN A2.
	GETPP:	MOVEI	A0,6		; [324] MAX. LENGTH OF NUMBER
		SETZ	A3,		; [324] INIT. A3 TO BUILD SIX DIGIT NUMBER
	GETPP1:	PUSHJ	SP,GETCHR	; [324] GET NEXT CHR.
		 POPJ	SP,		; [324] RETURN IF EOF
		CAIN	A2,','		; [324] COMMA?
		 JRST	AOSRET		; [324] YES, END OF PROJECT NUMBER
		CAIN	A2,']'		; [324] NO, CLOSE BRACKET?
		 JRST	AOSRET		; [324] YES, END OF PROJECT NUMBER
		CAIG	A2,'7'		; [324] NO, WITHIN RANGE OF
		CAIGE	A2,'0'		; [324] OCTAL NUMBERS?
		 PUSHJ	SP,OPFERR	; [324] NO, BAD SPEC.
		SUBI	A2,'0'		; [324] YES, CONVERT TO BINARY
		LSH	A3,3		; [324] MAKE ROOM FOR NEW DIGIT
		ADD	A3,A2		; [324] CONTINUE BUILDING PROJECT NUMBER
		SOJG	A0,GETPP1	; [324] LOOP UNTIL 6 CHRS. READ

		PUSHJ	SP,GETCHR	; [324] GET NEXT CHR.
		 JRST	AOSRET		; [324] YES, END OF PROJECT NUMBER
		CAIN	A2,','		; [324] COMMA?
		 JRST	AOSRET		; [324] YES, END OF PROJECT NUMBER
		CAIN	A2,']'		; [324] NO, END OF WHOLE FILESPEC?
		 JRST	AOSRET		; [324] YES, END OF PROJECT NUMBER
		PUSHJ	SP,OPFERR	; [324] NO, BAD FILESPEC

	; [324] GET UP TO SIX SFD-TYPE CHRS. IN A7.  DELIMITING CHR. IS LEFT IN A2.
	GETSFD:	MOVEI	A0,6		; [324] MAX. NUMBER OF CHRS. IN SFD NAME
		MOVE	A3,[POINT 6,A7]	; [324] LOAD SIXBIT ILDB PTR. TO BUILD SFD NAME
		SETZ	A7,		; [324] CLEAR SFD NAME
	GETSF1:	PUSHJ	SP,GETCHR	; [324] GET CHR.
		 POPJ	SP,		; [324] RETURN IF EOF
		CAIN	A2,','		; [324] COMMA?
		 POPJ	SP,		; [324] YES, END OF THIS SFD NAME
		CAIN	A2,']'		; [324] NO, CLOSE BRACKET?
		 POPJ	SP,		; [324] YES, END OF WHOLE FILESPEC
		CAIG	A2,'Z'		; [324] OUTSIDE RANGE OF
		CAIGE	A2,'0'		; [324] LEGAL SFD NAME CHRS.?
		 PUSHJ	SP,OPFERR	; [324] YES, BAD FILESPEC
		CAILE	A2,'9'		; [324] WITHIN RANGE OF
		CAIL	A2,'A'		; [324] GOOD CHRS.?
		 TRNA			; [324] YES, SKIP
		PUSHJ	SP,OPFERR	; [324] NO, BAD FILESPEC
		IDPB	A2,A3		; [324] CONTINUE BUILDING SFD NAME
		SOJG	A0,GETSF1	; [324] LOOP UNTIL SIX CHRS. ARE READ

		PUSHJ	SP,GETCHR	; [324] GET NEXT CHR.
		 POPJ	SP,		; [324] RETURN IF EOF
		CAIN	A2,','		; [324] COMMA?
		 POPJ	SP,		; [324] YES, END OF THIS SFD NAME
		CAIN	A2,']'		; [324] NO, CLOSE BRACKET?
		 POPJ	SP,		; [324] YES, END OF WHOLE FILESPEC
		PUSHJ	SP,OPFERR	; [324] NO, BAD FILESPEC

	; [324] GET SIXBIT BYTE SUBROUTINE - RETURNS THE NEXT SIXBIT CHARACTER OF
	; [324] THE FILESPEC IN A2.  THE CHR. IS GUARANTEED TO BE A LEGITIMATE
	; [324] SIXBIT FILESPEC-TYPE CHR. (UPPERCASE, ALPHANUMERIC, COMMA, OPEN
	; [324] OR CLOSE BRACKET, OR PERIOD).
	; [324]
	; [324]	RETURN:	+1	END OF FILESPEC STRING
	; [324]		+2	NORMAL, A2/ SIXBIT CHR.
	; [324]
	; [324]
	GETCHR:	SOJGE	A10,.+2		; [324] KEEP CHR. COUNT - DONE?
		 POPJ	SP,		; [324] YES, RETURN
		ILDB	A2,A4		; [324] NO, GET NEXT ASCII BYTE
		CAILE	A2,"]"		; [324] LOWER CASE?
		 SUBI	A2,"a"-"A"	; [324] MAYBE, CONVERT TO UPPER CASE
		CAILE	A2,"["		; [324] NO, ABOVE MAX. LIMIT FOR LEGAL CHR.?
		CAIN	A2,"]"		; [324] CHECK THIS CHR. TOO
		 TRNA			; [324] SKIP IF GOOD SO FAR
		 PUSHJ	SP,OPFERR	; [324] ELSE BAD CHR.
		CAIE	A2,"."		; [324] IS THIS A DOT?
		CAIN	A2,","		; [324] OR COMMA?
		 JRST	GETCH1		; [324] YES, GOOD CHR.
		CAIGE	A2,"0"		; [324] NO, BELOW ASCII ZERO?
		 PUSHJ	SP,OPFERR	; [324] YES, BAD CHR.
		CAILE	A2,"9"		; [324] LAST CHECK FOR GOOD CHR.
		CAIL	A2,"A"		; [324] BETWEEN ASCII "9" AND "A"?
		TRNA			; [324] NO, CHR. IS GOOD AT LAST
		 PUSHJ	SP,OPFERR	; [324] YES, CHR. IS BAD
	GETCH1:	SUBI	A2,"A"-'A'	; [324] CONVERT TO SIXBIT
	AOSRET:	AOS	(SP)		; [324] PREPARE FOR GOOD RETURN
		POPJ	SP,		; [324] RETURN WITH GOOD FILESPEC CHR. IN A2

	OPFERR:	MOVE	A1,.N(DL)	; [324] BAD FILESPEC, GET CHANNEL NUMBER BACK
		IOERR	16,(A1)		; [324] AND GIVE THE ERROR (STACK IS WRONG)
		JRST	.EXIT(DL)	; [324] CONTINUE AT USER'S RISK ONLY
 REP 17/168	;05C30
		SETO	A2,		; PRESET ANSWER
 WIT
		MOVEI	A2,1		; [336] PRESET ANSWER
 REP 21/168	;05C31
		AOJA	A2,INFO1	; NO
 WIT
		LIBERR	10,		; [336]
 REP 26/168	;05C32
	INFOTB:	HRRZ	A2,.JBREL	; 0 -CORE SIZE
 WIT
	INFOTB:	ADD	A2,.JBREL	; [336] 0 - CORE SIZE (.JBREL LEFT MUST BE 0)
 REP 31/168	;05C33
		PUSHJ	SP,INFPRC	; 5 - PROCESSOR (1=KA,2=KI,3=KL)
 WIT
		LDB	A2,[POINT 2,DB,1] ; [336] GET PROCESSOR TYPE (1=KA,2=KI,3=KL)
 DEL 41/168	;05C34
	INFPRC:	HLRZ	A2,DB
		LSH	A2,-^D16	; GET OMC BITS (PROCESSOR TYPE)
		AOS	2(A2)		; KLUDGE - IF 0, MAKE IT 1 !
		POPJ	SP,

 REP 42/169	;05C35
		MOVE	A2,[
		XWD	%CNMON,.GTCNF]
 WIT
		MOVE	A2,[%CNMON,,.GTCNF]
 REP 47/169	;05C36
		ADD	A2,[
		POINT	7,MONTAB-2]	; GET POINTER TO ASCII MONTH
		MOVE	A0,.LU(DL)		; RECOVER # CHARS (3 OR MANY)
 WIT
		ADD	A2,[POINT 7,MONTAB-2] ; GET POINTER TO ASCII MONTH
		MOVE	A0,.LU(DL)	; RECOVER # CHARS (3 OR MANY)
 REP 58/169	;05C37
		MOVE	A2,[
		XWD	%CNYER,.GTCNF]
 WIT
		MOVE	A2,[%CNYER,,.GTCNF]
 REP 15/170	;05C38
		HRLI	A1,440700	; MAKE BYTE-POINTER TO IT
		MOVE	A2,[
		STRDYN!STRPRC,,^D8]
		LRSTOR	A1,.EXIT+1(DL)	; THE ANSWER (8 CHARS, DYNAMIC, RESULT-OF-PROC)
		MOVEI	A4,":"		; GET SEPARATOR
		MOVE	A2,[
		XWD	%CNHOR,.GTCNF]
		PUSHJ	SP,TIME2	; GET HOUR & CONVERT TO ASCII
		IDPB	A4,A1		; DEPOSIT SEPARATOR
		MOVE	A2,[
		XWD	%CNMIN,.GTCNF]	; MINUTE
		PUSHJ	SP,TIME2
		IDPB	A4,A1
		MOVE	A2,[
		XWD	%CNSEC,.GTCNF]	; SECOND
 WIT
		HRLI	A1,(POINT 7,)	; [334] MAKE BYTE-POINTER TO IT
		MOVE	A2,[STRDYN!STRPRC,,^D8]
		LRSTOR	A1,.EXIT+1(DL)	; THE ANSWER (8 CHARS, DYNAMIC, RESULT-OF-PROC)
		MOVEI	A4,":"		; GET SEPARATOR
		MOVE	A2,[%CNHOR,,.GTCNF]
		PUSHJ	SP,TIME2	; GET HOUR & CONVERT TO ASCII
		IDPB	A4,A1		; DEPOSIT SEPARATOR
		MOVE	A2,[%CNMIN,,.GTCNF] ; MINUTE
		PUSHJ	SP,TIME2
		IDPB	A4,A1
		MOVE	A2,[%CNSEC,,.GTCNF] ; SECOND
 REP 12/173	;05C39
		HLRZ	A0,%SYS17(DB)
 WIT
		HLRZ	A0,%UUOTM(DB)	; [320] PICK UP TRAP NUMBER
 SUM 66881