Google
 

Trailing-Edge - PDP-10 Archives - bb-kl11f-bm_tops20_v7_0_atpch1_19 - autopatch/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 27/2	;05C2
		.PTSFD==3		; [275] PATH. BLOCK INDEX FOR SFD'S
		.PTPPN==2		; [275] INDEX FOR PPN
 DEL 63/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 82/2	;05C4
		JRST	NOSYS		; NOT FOUND
 WIT
		JRST	NOSEG		; [322] NOT FOUND
 DEL 88/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]
 INS 1/112	;05C9

 INS 14/123	;05C10
		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/123	;05C11
		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/124	;05C12

		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/124	;05C13
		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/125	;05C14
	EDIT (133)	; AVOID STACK-SHIFT PROBLEMS
 REP 1/126	;05C15
		TITLE CONCAT - STRING CONCATENATION ROUTINE
 WIT
	TITLE CONCAT - STRING CONCATENATION ROUTINE
 DEL 35/126	;05C16
 REP 15/127	;05C17
		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/128	;05C18
		LDB	A5,[
		POINT 24,STR2(A2),35]	; GET LENGTH OF STRING
 WIT
		LDB	A5,[POINT 24,STR2(A2),35] ; GET LENGTH OF STRING
 REP 18/139	;05C19
		IOERR	6,(A13)		; [E1017] EOF - channel # in A13.
 WIT
		JRST	READ8		; [312] EOF, RETURN EOF STATUS FOR IOCHAN
 INS 14/142	;05C20
		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/142	;05C21

	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/142	;05C22
		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
 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
 REP 4/143	;05C23
		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
		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/143	;05C24

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

 WIT
	WRIT8:	TDZA	A5,A5		; CLEAR COUNT (FIRST TIME)
 INS 15/153	;05C25

 REP 28/153	;05C26
	OPF0:	JRST	OPF0(A1)	; BRANCH ON NUMBER OF PARAMETERS
 WIT

	OPNFIL:	JRST	OPNFIL(A1)	; [324] BRANCH ON NUMBER OF PARAMETERS
 REP 45/153	;05C27
		MOVE	A2,.LU(DL)	; RESTORE ADDRESS OF STRING
		MOVEI	A2,@A2		; STATICISE IT
		LDB	A0,[POINT 24,STR2(A2),35]  ; GET STRING LENGTH
		MOVE	A4,STR1(A2)	; AND SAVE BYTE PTR.
		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(036); FIX STACK ON RETURN FROM OPF6
	OPF5A:	POP	SP,(SP)		; [E037] STEP BACK OVER RETURN ADDRESS
	OPF5:	MOVE	A1,.N(DL)	; RESTORE CHANNEL NUMBER
		DMOVE	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
		MOVE	A2,.LU(DL)	; [324] GET ADDR. OF STRING
		MOVEI	A2,@A2		; [324] STATICISE IT
		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 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 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 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 SPEC?
		 PUSHJ	SP,OPFERR	; [324] NO, BAD FILESPEC

	; [324] PARSE PPN SPEC.  PPN IS BUILT 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,OPFNOW	; [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

	; [324] THE PPN IS NOW IN PLACE - OPEN THE FILE.
	OPFNOW:	MOVE	A1,.N(DL)	; [324] RESTORE CHANNEL NUMBER
		DMOVE	A2,A5		; [324] LOAD FILENAME AND EXTENSION
		HRLZ	A4,.P(DL)	; [324] GET PROTECTION CODE
		LSH	A4,11		; [324] MOVE IT OVER
		MOVE	A5,.PP(DL)	; [324] GET PATH BLOCK ADDR.
		PUSHJ	SP,OPFILE	; [324] AND GO OPEN FILE
		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 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/161	;05C28
		SETO	A2,		; PRESET ANSWER
 WIT
		MOVEI	A2,1		; [336] PRESET ANSWER
 REP 21/161	;05C29
		AOJA	A2,INFO1	; NO
 WIT
		LIBERR	10,		; [336]
 REP 26/161	;05C30
	INFOTB:	HRRZ	A2,.JBREL	; 0 -CORE SIZE
 WIT
	INFOTB:	ADD	A2,.JBREL	; [336] 0 - CORE SIZE (.JBREL LEFT MUST BE 0)
 REP 31/161	;05C31
		SETZ	A2,		; 5 - PROCESSOR
 WIT
		MOVEI	A2,3		; [336] 5 - PROCESSOR (ALWAYS KL FOR TOPS-20)
 REP 45/162	;05C32
		ADD	A3,[
		POINT	7,MONTAB]	; GET POINTER TO ASCII MONTH
 WIT
		ADD	A3,[POINT 7,MONTAB] ; GET POINTER TO ASCII MONTH
 INS 66/162	;05C33
		TLO	A4,STRDYN!STRPRC ; [334] MARK DYNAMIC (R.H. = # CHARS)
 REP 15/163	;05C34
		HRLI	A1,440700	; MAKE BYTE-POINTER TO IT
		MOVEI	A2,^D8
 WIT
		HRLI	A1,(POINT 7,)	; MAKE BYTE-POINTER TO IT
		MOVE	A2,[STRDYN!STRPRC,,^D8] ; [334] DYNAMIC, RESULT OF PROC,,LENGTH
 INS 1/166	;05C35
	TITLE TRAPNO - GET TRAP NUMBER ; [337]

	; INTEGER PROCEDURE TRAPNO	; [337]

		.EXIT=1			; [337]

		SEARCH	ALGPRM,ALGSYS	; [337]

	LIBENT(460,TRAPNO)		; [337]
		XWD	0,2		; [337]
		XWD	$PRO!$I!$SIM,1	; [337]
		HLRZ	A0,%UUOTM(DB)	; [337] PICK UP TRAP NUMBER
		ANDI	A0,77		; [337] ISOLATE TRAP #
		MOVEM	A0,.EXIT+1(DL)	; [337]
		JRST	.EXIT(DL)	; [337]

		PRGEND			; [337]
 SUM 108476