Google
 

Trailing-Edge - PDP-10 Archives - bb-bt99e-bb - srtsta.c05
There are 2 other files named srtsta.c05 in the archive. Click here to see a list.
 REP 2/1	;05C1
	SUBTTL	D.M.NIXON/DMN/DZN/DLC/BRF/CLRH	4-Jun-81
 WIT
	SUBTTL	D.M.NIXON/DMN/DZN/DLC/BRF/CLRH/GCS	27-Oct-82
 REP 9/1	;05C2
	;COPYRIGHT (C) 1975, 1981 BY DIGITAL EQUIPMENT CORPORATION
 WIT
	;COPYRIGHT (C) 1975, 1982 BY DIGITAL EQUIPMENT CORPORATION
 REP 10/6	;05C3
		  JFCL			;[C20]   ..
 WIT
	;**;[473] @FORENT + 6L Replace 1 line with 2	GCS	9-DEC-81
		  JRST	$4		;[473]  TRY TO GO VIRTUAL
		TLZ	T3,200000	;[473] CLEAR VIRTUAL BIT
 REP 14/6	;05C4
	  >
		MOVEM	T1,FORFUN	;[C20] SAVE FUNCT. ADDRESS
 WIT
	;**;[473] @FORENT + 11L Insert 20 lines	GCS	9-Dec-81
		JRST	$6		;[473] SKIP VIRTUAL ROUTINE

	  $4%	CAIN	T0,PAGNX%	;[473] VIRTUAL PRIVS?
		 JRST	$5		;[473]  NO!
		TLNE	T3,200000	;[473] HAVE WE ALREADY WENT VIRTUAL?
		 JRST	$5		;[473]  YES, GIVE UP. PAGE CAN'T BE CREATED.
		CAIE	T0,PAGLE%	;[473] CORE LIMIT EXCEEDED?
		 JRST	$5		;[473]  NO, ALL OTHER ERRORS ARE FATAL.

		HRLI	T3,200000	;[473] SET BIT IN ARG BLOCK.
		JRST	$1		;[473] GO TRY TO CREATE ON DISK.

	  $5%	OUTSTR	E$$PCF		;[473] START ERROR MESSAGE.
		HRRZ	T1,T3		;[473] GET PAGE #
		PUSHJ	P,.TOCTW	;[473] TYPE IT.
		OUTSTR	E$$PC1		;[473] CONTINUE ERROR MESSAGE.
		MOVE	T1,T0		;[473] GET PAGE. ERROR CODE
		PUSHJ	P,.TOCTW	;[473] TYPE IT.
		OUTSTR	E$$PC2		;[473] CONTINUE
		JRST	(T4)		;[473] FORTRAN RETURN ADDR.(FORRET)
	  >
	  $6%	MOVEM	T1,FORFUN	;[C20] SAVE FUNCT. ADDRESS
 REP 27/6	;05C5
		MOVE	T1,FORARG	;[C20] GET FIRST ARG ADDRESS
		HRR	T1,@T1		;[C20]   ..
 WIT
	;**;[476] @FORENT+13L Replace 2 lines with 8.	GCS	18-Jan-82
		MOVE	L,FORARG	;[476] GET FIRST ARG ADDRESS
		SETZ	T1,		;[476]
		XMOVEI	T1,20		;[476] GET OUR SECTION NUMBER.
		TLNN	T1,7777		;[476] IN A NON-ZERO SECTION?
		TLO	L,20		;[476] NO - SET THE INDIRECT BIT.
		TLO	L,200000	;[476] YES - SET NON-ZERO SECTION IB.
		XMOVEI	T1,@L		;[476] GET ADDRESS OF ARG TO SORT
		MOVEM	T1,FORARG	;[476] SAVE IT.
 INS 23/7	;05C6
	;**;[475] @LOOP +16L INSERT 5L	ERD	15-DEC-81
	IFE FTOPS20,<			;[475]
	IFE FTFORTRAN,<			;[475]
	IFN FTVM,<			;[475]
	.HELPR::$ERROR	(?,UKS,<Unknown switch /HELP>);[475]HELPER not available
	>>>				;[475]
 REP 15/8	;05C7
	 IFN FTVM,<
		XMOVEI	P,STACK-1		;[C20] SET UP STACK
	 >
	 IFE FTVM,<
		MOVE	P,[IOWD PDLEN,STACK]	;[N21] SET UP STACK
	>>
 WIT
	;**;[474] @INITIALIZE +5L REPLACE 1L	ERD		14-DEC-81
	 IFN FTOPS20,<				;[474]
		XMOVEI	P,STACK-1		;[C20] SET UP STACK
	 >
	;**;[474] @INITIALIZE +8L REPLACE 1L	ERD		14-DEC-81
	 IFE FTOPS20,<				;[474]
		MOVE	P,[IOWD PDLEN,STACK]	;[N21] SET UP STACK
	;**;[474] @INITIALIZE +10L REPLACE 1L WITH 4L  ERD	14-DEC-81
	>					;[474]
		SKIPE	FORPDP			;[474] CALLED FROM FORTRAN?
		PUSH	P,['STOP!!']		;[474] YES, LOAD END OF STACK INDICATOR
	>					;[474]
 INS 17/12	;05C8
	;**;[511] @USRFMT + 13 lines,  Insert 11 lines.	DMN	27-Oct-82
		SETZB	T3,KY.FMT+2		;[511] CLEAR FORMAT FLAGS.
		CAIN	T4,'B'			;[511] IS IT BLANK=?
		JRST	[ILDB	T4,T0		;[511] YES, SEE WHICH ONE.
			CAIN	T4,'N'		;[511] BLANK=NULL?
			MOVX	T3,KY%FBN	;[511] YES.
			CAIN	T4,'Z'		;[511] BLANK=ZERO?
			MOVX	T3,KY%FBZ	;[511] YES.
			JUMPE	T3,E$$FSA	;[511] NEITHER IS AN ERROR.
			IORM	T3,KY.FMT+2(T1)	;[511] STORE FLAGS.
			ILDB	T4,T0		;[511] GET NEXT CHAR.
			JRST	.+1]		;[511] CONTINUE FORMAT SCAN.
 REP 49/14	;05C9
		AOJA	P1,$1		;UPDATE THE INDEX AND TRY AGAIN
		JRST	$1		;GET THE NEXT CHARACTER
 WIT
	;**;[500] In BLDCOL at $2% - 2L  Replace 2 lines with 3.  GCS  13-APR-82
		TXNN	P1,COL.QU	;[500] DID WE SEE A QUOTE?
		AOJA	P1,$1		;[500] NO, UPDATE INDEX AND TRY AGAIN
		AOJA	P1,$2		;[500] YES, GET THE NEXT CHARACTER
 REP 103/14	;05C10
		JRST	$1		;END OF RANGE
 WIT
	;**;[500] In BLDCOL at $9% + 2L  Replace 1 line with 3.  GCS  13-APR-82
		JRST	[TXNN	P1,COL.QU  ;[500] END OF RANGE, SEE A QUOTE?
			JRST	$1	   ;[500] NO
			JRST	$2]	   ;[500] YES, PROCESS THE STRING
 REP 20/15	;05C11
		XCT	[HRLM	P1,(T1)	     ;[OK] STORE IN THE LEFT HALF (EVEN)
			HRRM	P1,(T1)](T2) ;[OK] STORE IN THE RIGHT HALF (ODD)
 WIT
	;**;[500] In BLDCOS at $1% + 2L  Replace 2 lines with 10.  GCS  13-APR-82
		JUMPN	T2,$4		;[500] JUMP IF RIGHT HALF OF TABLE
		HLRZ	T2,(T1)		;[500] A DUPLICATE?
		CAIE	T2,707070	;[500] ...
		PUSHJ	P,ERRDCC	;[500] YES, WARN USER
		HRLM	P1,(T1)		;[500] STORE IN THE LEFT HALF (EVEN)
		RETURN			;[500]
	  $4%	HRRZ	T2,(T1)		;[500] A DUPLICATE?
		CAIE	T2,707070	;[500] ...
		PUSHJ	P,ERRDCC	;[500] YES, WARN USER
		HRRM	P1,(T1)		;[500] STORE IN THE RIGHT HALF (ODD)
 INS 20/16	;05C12
	;**;[500] In BLDIGT at $1% + 7L  Insert 3 lines.  GCS  13-APR-82
		CAIE	T1,"'"		;[500] IS IT A SINGLE QUOTE?
		CAIN	T1,""""		;[500] OR A DOUBLE QUOTE?
		JRST	$6		;[500] YES, END OF DIGITS
 INS 28/16	;05C13
	;**;[500] In BLDIGT at $3%  Insert 3 lines.  GCS  13-APR-82
	  $6%	TXO	P1,COL.QU	;[500] SET QUOTE FLAG
		MOVEM	T1,QOTCHR	;[500] SAVE THE QUOTE CHAR
		JRST	$2		;[500] RETURN THE DIGIT
 REP 121/20	;05C14
	SETMAF:	MOVEI	J,IX.FPA	;[C20] FORTRAN FLOATING POINT ASCII
 WIT
	;**;[511] @SETMAF:   Insert 2 lines.	DMN	27-Oct-82
	SETMAF:	TXNE	T1,RM.UNS	;[511] IS IT UNSIGNED?
		SKIPA	J,[IX.FPU]	;[511] YES.
		MOVEI	J,IX.FPA	;[C20] FORTRAN FLOATING POINT ASCII
 INS 24/25	;05C15
	;**;[500] @E$$ICS: + 1L  Insert 4 lines.  GCS  13-APR-82
	ERRDCC:	PUSHJ	P,.PSH4T	;[500] SAVE T1 THRU T4
		$ERROR	(%,DCC,<Duplicate character in collating sequence>)  ;[500]
		PUSHJ	P,.POP4T	;[500] RESTORE T1 THRU T4
		POPJ	P,		;[500]
 INS 4/50	;05C16

	;**;[473] @E$$ELN + 1L Insert 5 lines	GCS	9-Dec-81
	E$$PCF:	ASCIZ	/
	?SRTPCF Page /			;[473]
	E$$PC1:	ASCIZ	/ creation failed.(PAGE. UUO error /	;[473]
	E$$PC2:	ASCIZ	/)
	/					;[473]

 SUM 191450