Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-11 - 43,50531/pasnum.mac
There are 4 other files named pasnum.mac in the archive. Click here to see a list.
	title PASNUM - write and read support for pascal-20

;edit history - begins at edit 2

;2 - add break character set to string input, don't gobble extra input chars
;3 - use same algorithm to read real numbers as used by compiler, to
;	guarantee number read tests equal to one compiled.
;4 - prevent arithmetic errors in this module
;5 - fix bug in readps (sometimes cleared too many character)
;6 - modify break set for new SET OF CHAR in compiler edit 106
;7 - make readr treat .25 as .25, not .24999999999999
;10 - don't assume that putch saves AC0
;11 - KA retrofit
;12 - add overflow test routine; improved real input; fix output of -0
;13 - changed readi,readr,readc the .readi,.readr,.readc, returns value
;	in C instead of to address in C
;14 - added record I/O

	subttl junk to simulate tops-10 I/O routines

	twoseg

	search pasunv,monsym

	ac0==0
	ac1==1
	reg==2
	reg1==3
	reg2==4
	reg3==5
	reg4==6
	reg5==7
	reg6==10

	
	internal safbeg,safend
	ENTRY WRTOCT
	ENTRY WRTINT
	ENTRY WRTREA
	ENTRY WRITEC
	ENTRY WRTPST
	ENTRY WRTUST
	ENTRY WRTBOL
	ENTRY WRTHEX
	ENTRY .READC
	ENTRY .READI
	ENTRY .READR
	ENTRY READPS,READUS	
	ENTRY OVERFL		;[11]
	entry .readd,.wrrec,.wrsca

	reloc 400000

safbeg:				;[4] everything from here to end is "safe"

;[11] overflow, returns T if overflow has happened, F otherwise
overfl:	movei 1,1		;[11] assume overflow
	movem 1,1(p)		;[11]
	jov .+2			;[11] see if there was
	setzm 1(p)		;[11] no
	popj p,			;[11]

;putch, output the character in t.  Calls the device-dependent PUT
;  routine directly, exactly the way PUT would.  Assumes the PUT
;  routine and everything it calls preserves AC's 2 and up.  This
;  restriction is documented in PASIO.

putch:	movem t,filcmp(b)
	jrst @filput(b)

	subttl routines for WRITE and WRITELN output
;HILFSROUTINEN FUER AUSGABE

WRTBLK: JUMPLE REG2, .+4		;WRITES BLANKES OUT
	MOVEI AC0," "
	PUSHJ P,PUTCH
	SOJG  REG2, .-2 		;[10]COUNT EQUAL ZERO?
	POPJ  P,			;YES - RETURN

WRTOPN: MOVEI REG5, (REG2)		;SAVES FORMAT BECAUSE REG2 IS USED FOR
					;IDIVI-INSTRUCTION
	SETZ  REG4,			;RH - COUNT OF DIGITS ON PUSH-LIST
					;LH - EQ 400000 IF SIGN = '-'
	JUMPGE REG1,.+4 		;NEGATIV NUMBER?
	TLO    REG4,400000		;YES - SET SIGN MARKER
	SUBI   REG5,1			;ONE PLACE IN FORMAT USE FOR SIGN
	MOVM   REG1,REG1
	JUMPL  REG1,TOOSML		;NO DECIMAL INTEGER OUTPUT
					;FOR 400 000 000 000B  - ONLY OCTAL OUTPUT !
	POPJ   P,

WRTSGN: TLZN  REG4,400000		;SIGN EQUAL '-'?
	POPJ  P,			;NO - RETURN
	MOVEI AC0,"-"			;YES
	JRST  PUTCH			;PUTCH RETURNS OVER PUT

TOOSML: MOVEI AC0, "*"			;FORMAT IS TOO SMALL
	PUSHJ  P,PUTCH
	SOJG   REG5, .-2		;[10]
	POP    P,(P)			;[11] abort caller
	POPJ   P,			;RETURNS OUT OF WRITE-ROUTINE

WRTOCT: JUMPLE REG2,OCTRET		;FIELDWIDTH = 0 ?
WRTOIN: CAIG   REG2, 14 		;LEADING BLANKS REQUIRED ?
	JRST	      OCTEST		;NO
	MOVEI	  AC0," "
	PUSHJ	 P,PUTCH
	SOJA   REG2,WRTOIN		;MORE BLANKS TO BE INSERTED ?

OCTEST: MOVE   REG3,[POINT 3,REG1]
	HRREI	  AC1,-14(REG2)
	JUMPE	  AC1,OCTWRT		;LESS THAN 12 POSITIONS REQUIRED ?
	IBP	      REG3		;YES
	AOJL	  AC1, .-1
OCTWRT: ILDB	  AC0,REG3		;GET DIGIT
	ADDI	  AC0, 60		;CONVERT TO ASCII
	PUSHJ	 P,PUTCH
	SOJG   REG2,OCTWRT		;MORE DIGITS TO BE OUTPUT ?
OCTRET: POPJ	 P,			;NO - RETURN

WRTINT:	PUSHJ  P,WRTOPN
	JUMPE  REG1, .+4
	IDIVI  REG1, 12 		;GETS LOWEST DIGIT TO REG2
	PUSH   P, REG2		;AND SAVES IT IN PUSH-LIST
	AOJA   REG4, .-3
	TRNE   REG4, 777777		;VALUE EQUAL 0?
	JRST	.+4			;NO
	SETZ   REG2,			;YES - PUTS ONE ZERO INTO PUSH-LIST
	PUSH   P,REG2
	AOJ    REG4,
	CAIGE  REG5,(REG4)		;FORMAT LARGE ENOUGH ?
	MOVEI  REG5,(REG4)		;NO - MAKE IT BE
	SUBI   REG5,(REG4)		;GETS NUMBER OF LEADING BLANKS
	MOVEI  REG2,(REG5)		;WRITEBLANK-ROUTINE WORKS ON REG2
	PUSHJ  P,WRTBLK		;WRITES BLANKS IF ANY
	PUSHJ  P,WRTSGN		;WRITES SIGN : " " IF POSITIV,"-" IF NEGATIV
	POP    P,AC0 		;GETS DIGIT IN PUSH-LIST
	ADDI   AC0, "0" 		;CONVERTS TO ASCII
	PUSHJ  P, PUTCH		;WRITES THEM OUT
	SOJG   REG4, .-3		;MORE DIGITS ?
INTRET: POPJ   P,			;NO - RETURN

WRTHEX: JUMPLE REG2,HEXRET		;FIELD = 0?
WRTHIN:	CAIG	REG2,	 11		;LEADING BLANKS REQUIRED?
	JRST	     HEXTST		;NO
	MOVEI	AC0 ,  " "
	PUSHJ	P,PUTCH
	SOJA	REG2,WRTHIN

HEXTST:	MOVE	REG3,[POINT 4,REG1]
	HRREI	 AC1,-11(REG2)
	JUMPE	 AC1,HEXWRT		;LESS THEN 11 POSITIONS
	  IBP	       REG3		;YES
	 AOJL	 AC1,.-1

HEXWRT:	ILDB	 AC0,REG3
	ADDI	 AC0, 60
	CAIL	 AC0, 72		;DIGIT?
	ADDI	 AC0,  7		;NO LETTER
	PUSHJ	P,PUTCH
	SOJG	REG2,HEXWRT
HEXRET:	POPJ	P,

WRTMAT:	SOJL   REG5,.+4			;MORE LEADING ZERO'S REQUEST
	MOVEI  AC0,"0"			;YES - WRITE THEM OUT
	PUSHJ  P,PUTCH
	SOJG   REG4,.-3 		;MORE LEADING ZERO'S BEFORE POINT ?
	JUMPLE REG4,MATEND		;NO - MORE DIGITS BEFORE POINT ?
WRTM1:	JUMPE  REG1,WRTM2 		;MANTISSE EQUAL ZERO ?
	LDB    AC0,[POINT 9,REG1,8]	;NO - GET NEXT DIGIT
	HLRE   AC1,REG3			;GET NO. OF SIGN. DIGITS
	CAIG   AC1,0			;ANY LEFT?
	SETZ   AC0,			;NO - USE 0
	SUBI   AC1,1			;1 FEWER DIGITS
	HRLM   AC1,REG3
	TLZ    REG1,777000		;RESETZ THIS BITS
	IMULI  REG1,12
	ADDI   AC0,"0"			;CONVERTS THEM TO ASCII
	PUSHJ  P,PUTCH
	SOJG   REG4,WRTM1 		;MORE DIGITS BEFORE POINT FROM REG1 ?
WRTM2:	JUMPLE	REG4,MATEND		;NO - MORE DIGITS NEEDED BEFORE POINT ?
	MOVEI  AC0,"0"			;     YES - WRITES ONE ZERO OUT
	PUSHJ  P,PUTCH
	SOJG   REG4,.-2			;[10]
MATEND: POPJ   P,

wrtrea:	caige reg2,1			;width at least 1 (for sign)
	movei reg2,1			;no - make it be
	caige reg3,0			;at least 0 digits (or magic)
	movei reg3,0			;no - make it be
	jov .+1				;clear flag
	fsc reg1,0			;normalize it
	jov [setz reg1,			;if underflow, it is zero.  I think
	     jrst .+1]			; overflow is not possible
	PUSHJ  P,WRTOPN		;SETS SIGN BIT AND PUTS FIELDWIDTH TO REG5
	SETZ   REG6,			;TO SAVE DECIMAL EXPONENT
	JUMPN  REG1,.+3 		;VALUE EQUAL ZERO ?
	MOVEI  AC0,555555		;YES - REMEMBER IT IN AC0
	JRST	WRTFF			;      AND WRITE IT OUT
	CAML   REG1, [10.0]		;REAL VALEU SHOULD BE LESS THEN 10.0
	JRST	TOOBIG			;   AND GREATER OR EQUAL THEN 1.0
	CAML   REG1, [1.0]
	JRST	NOWCOR			;NOW CORRECTLY POSITIONED
	FMPR   REG1, [10.0]		;IT'S TOO SMALL
	SOJA   REG6,.-3 		;EXPONENT BECOMES NEGATIV - CHECK AGAIN
TOOBIG: FDVR  REG1,[10.0]		;REAL VALUE IS TOO LARGE
	AOJ   REG6,			;EXPONENT BECOMES POSITIV
	CAML  REG1,[10.0]		;STILL TOO LARGE?
	JRST	TOOBIG			;YES
NOWCOR: LDB   REG2,[POINT 8,REG1,8]	;GETS BINARY EXPONENT
	SUBI  REG2,200
	TLZ   REG1,377000		;CLEARS EXPONENT
	LSH   REG1,(REG2)		;SHIFTS MANTISSE BY BINARY EXPONENT LEFT
WRTFF:	CAIN   REG3,123456		;FIXEDREAL OR FLOATING REAL ?
	JRST	WRTFLO			;FLOATING REAL
	MOVEI  REG2,(REG5)		;FIXED REAL - GET FORMAT
	SUBI   REG2,(REG3)		;REG3 CONTAINS NR OF DIGITS AFTER POINT
	MOVEI  AC1,1(REG3)
	ADD    AC1,REG6			;AC1 _ NO. OF SIGN. DIGITS
	PUSHJ  P,WRTRND			;ROUND
	JUMPL	REG6,WRTNGX		;EXPONENT NEGATIV ?
	HRRI	REG4,1(REG6)		;NOW REG4 CONTAINS NR OF DIGITS BEFOR POINT
	CAIGE  REG2,2(REG4)		;FORMAT LARGE ENOUGH ?
	MOVEI   REG2,2(REG4)		;NO - MAKE IT BE
	CAIE   AC0,555555		;VALUE EQUAL ZERO ?
	SETZ   REG5,			;NO - NO LEADING ZERO'S
	JRST   WRTALX
WRTNGX:	CAIGE	REG2,3
	MOVEI	REG2,3
	HRRI	REG4,1			;ONE ZERO BEFORE POINT
	MOVM   REG5,REG6		;NUMBER OF LEADING ZEROS'S
WRTALX:	MOVEI	REG6,765432		;TO REMEMBER THAT NO EXPONENT SHALL
					;BE GIVEN OUT
	SUBI	REG2,1(REG4)		;FOR POINT AND DIGITS BEFORE POINT
	JRST	WRTOUT
WRTFLO: HRRI	REG4,1			;ONE DIGIT BEFORE POINT
	MOVEI  REG2,1			;AT LEAST ONE LEADING BLANK
	SKIPL  REG4			;AND IF NON-NEGATIVE,
	MOVEI  REG2,2			; TWO
	SUBI   REG5,(REG2)		;AND SAVE SPACE FOR IT
	CAIGE  REG5, 7			;FORMAT BIG ENOUGH ?
	MOVEI   REG5,7			;NO - MAKE IT BE
	MOVEI  REG3,-6(REG5)		;DIGITS BEHIND POINT
	CAIG   REG3,6			;MORE DIGITS THAN ACCURACY?
	JRST   .+4			;NO - LEAVE ALONE
	SUBI   REG3,6			;YES - HOW MANY EXTRA?
	ADD    REG2,REG3		;MAKE LEADING BLANKS
	MOVEI  REG3,6			;AND USE ONLY 6
	MOVEI  AC1,1(REG3)		;SIGNIF. DIGITS
	PUSHJ  P,WRTRND			;ROUND
	CAIE   AC0,555555		;VALUE EQUAL ZERO ?
	SETZ   REG5,			;NO - NO LEADING ZERO'S IN FLOATING FORMAT
					;<REG1>: VALUE OF MANTISSE
					;<REG2>: NR OF LEADING BLANKS
					;<REG3>: NR OF DIGITS BEHIND POINT
					;  LH = no. of signif. digits
					;<REG4>: NR OF DIGITS BEFORE POINT
					;<REG5>: NR OF LEADING ZERO'S
					;<REG6>: DECIMAL EXPONENT
WRTOUT:	HRLM   AC1,REG3		;SAVE NO. OF SIGN. DIGITS
	PUSHJ  P,WRTBLK		;WRITES LEADING BLANKS
	PUSHJ  P,WRTSGN		;WRITES SIGN
	PUSHJ  P,WRTMAT		;WRITES MANTISSE BEFORE POINT
	MOVEI  AC0,"."			;WRITES DECIMAL POINT OUT
	PUSHJ  P,PUTCH
	MOVEI  REG4,(REG3)
	PUSHJ  P,WRTMAT		;WRITES MANTISSE BEHIND POINT
	CAIN   REG6,765432		;WRITE EXPONENT OR NOT ?
	JRST	REARET			;NO
	MOVEI	AC0,"E" 		;YES - WRITE E OUT
	PUSHJ	P,PUTCH
	MOVEI	AC0,"+" 		;WRITES SIGN OUT
	SKIPGE	REG6			;EXPONENT POSITIV
	MOVEI	AC0,"-" 		;NO - WRITE MINUS SIGN
	PUSHJ	P,PUTCH		;WRITES OUT SIGN
	MOVM	REG1,REG6		;DEZIMAL EXPONENT TO REG1 - FOR WRITEINTEGER
	MOVEI	AC0,"0" 		;TO WRITE ONE ZERO IF EXPONENT LESS THAN 12
	CAIGE	REG1,12 		;EXPONENT GREATER 12
	PUSHJ	P,PUTCH		;NO - WRITE ONE ZERO OUT
	MOVEI	REG2,2			;FORMAT - TWO DIGITS NORMALLY
	CAIGE  REG1,12			;NEED MORE THAN ONE DIGIT ?
	MOVEI  REG2,1			;NO - FORMAT ONLY ONE DIGIT
	PUSHJ  P,WRTINT		;WRITES DECIMAL EXPONENT OUT
REARET: POPJ   P,			;RETURN

wrtrnd:	caile ac1,7		;too many sign. digits?
	movei ac1,7		;yes - use 7
	cail ac1,0		;any significance?
	add reg1,[005000000000	;now round there
		     400000000
		      31463147
		       2436561
		        203045
		         15067
		          1240
		           104
		             7](ac1) ;the 6 is extra now (for 8 digits)
	caml reg1,[012000000000];overflow?
	jrst [	push p,reg2	;yes - renormalize
		idivi reg1,12
		pop p,reg2
		aoj reg6,
		aoj ac1,	;one more sign. digit there
		jrst .+1]
	popj p,

WRITEC:	SOJLE   REG2, .+4		;LEADING BLANKS REQUESTED ?
	MOVEI	  AC0," "		;YES
	PUSHJ	 P,PUTCH
	SOJG   REG2, .-2		;[10]MORE LEADING BLANKS ?
	MOVE   AC0, REG1		;CHARACTER TO BE OUTPUT MUST BE IN AC0
	PUSHJ	 P,PUTCH
WRITRT: POPJ	 P,

WRTPST: HRLI   REG1,440700		;WRITE PACKED STRING
	SKIPA
WRTUST: HRLI   REG1,444400		;WRITE NOTPACKED STRING
	JUMPLE REG2,WRTRET		;FIELDWIDTH = 0 ?
WRTEST: CAIG   REG2,(REG3)		;LEADING BLANKS REQUESTED ?
	JRST	      STROUT		;NO
	MOVEI	  AC0," "
	PUSHJ	 P,PUTCH
	SOJA   REG2,WRTEST		;MORE LEADING BLANKS ?
STROUT: ILDB	  AC0,REG1
	PUSHJ	 P,PUTCH
	SOJG   REG2,STROUT		;ANY CHARACTER LEFT ?
WRTRET: POPJ	 P,			;NO - RETURN

;[14] begin
;read record - addr of place to put it is in C, FCB in B
.readd:	move a,filcnt(b)	;a _ aobjn word for source
	jumpge a,readd2		;count = 0 or non-binary file - no-op
readd1:	move t,(a)		;copy loop
	movem t,(c)
	aoj c,
	aobjn a,readd1
readd2:	hlre c,filcnt(b)	;now get count for the GET
	movn c,c		;make positive
	jrst @filget(b)		;get next item
;[14] end

	subttl routines for READ and READLN input
readps:	hrli reg1,440700	;reg1=array ptr. make byte ptr
	skipa			;reg2=count of destination
readus:	hrli reg1,444400	;reg3=place to put count of source
	skipe fileof(reg)	;stop reading after error
	 jrst reader		;return zero count
	skipn reg4		;[2] if break set specified
	skipe reg5		;[2] either word
	tlo reg3,400000		;[2] reg3 bit 0 set as flag that break set
	push p,reg4		;[2] -1(p)=1st word of break set
	push p,reg5		;[2]   (p)=2nd word of break set
	movei reg4,0		;reg4=count of source
read1:	skipe fileol(reg)	;stop if source done
	 jrst readsl		; i.e. end of line
	move reg5,filcmp(reg)	;get current character
	jumpge reg3,nobr	;[2] skip tests if no break set
	movsi ac0,400000	;[2] see if in break set
	setz ac1,		;[2]
	movn reg5,.stchm##(reg5);[6] turn char into index into set
	lshc ac0,(reg5)		;[2] now have bit in set
	tdnn ac0,-1(p)		;[2] if on, done
	tdne ac1,(p)		;[2]
	jrst readsl		;[2]
	move reg5,filcmp(reg)	;[2] get back current character
nobr:	sojl reg2,readse	;[2] stop if destination full
	addi reg4,1		;count destin char's
	pushj P,@filget(reg)	;and advance
	idpb reg5,reg1		;put in destin
	jrst read1		;try again

readse:	addi reg4,1		;[2] destination full - set to beyond end
	jrst reads2		;[2] done

readsl:	sojl reg2,reads2	;[5] ran out of source - see if room
	movei reg5,40		;fill destin with blanks
	idpb reg5,reg1		
	jrst readsl		;[5]

reads2:	trne reg3,777777	;[2] done, see if store count
	movem reg4,(reg3)	;yes
	adjstk p,-2		;[2] break set is on stack
	popj P,		

reader:	setzm (reg3)		;error at beginning - use zero count
	popj p,

;AUSSCHREIBEN BOOLE'SCHER GROESSEN

WRTBOL:	SKIPE  REG1			;NORMALIZE TRUE
	MOVNI  REG1,1			;TO -1.
	CAIGE  REG2,5(REG1)		;ENOUGHT SPACE?
	MOVEI  REG2,5(REG1)		;NO - MAKE THERE BE
	SUBI   REG2,5(REG1)		;HOW MUCH EXTRA SPACE?
	PUSHJ  P, WRTBLK		;WRITES LEADING BLANKS IF ANY
	MOVEI  REG2,5(REG1)		;CHARACTERS IN OUTPUT
	MOVE   REG3,[POINT 7,BOLWRD(REG1)]
	ILDB   AC0, REG3		;GETS CHARACTER
	PUSHJ  P,PUTCH
	SOJG   REG2, .-2		;MORE CHARACTERS?
	POPJ   P,			;NO - RETURN

	ASCII  /true/
BOLWRD:	ASCII  /false/

;EINGABETEILE FUER CHARACTER, INTEGER, REAL

.READC:	skipe fileof(reg)		;stop if error
	popj p,
	MOVE REG1,FILCMP(REG)
	PUSHJ P,@filget(reg)
	POPJ P,

gtsext:	pop p,(p)			;exit from caller
	popj p,

GTSGN:	SKIPE	FILEOF(REG)		;END-OF-FILE = TRUE
	jrst	gtsext			;yes - exit the caller
	PUSHJ  P,@filget(reg)		;GETS NEXT COMPONENT
GETSGN:	skipe fileof(reg)		;stop if error
	jrst gtsext
	MOVE   AC0,FILCMP(REG)		;GETS FIRST COMPONENT
	cain	ac0,11			;ignore tabs, too
	jrst	gtsgn
	SKIPN	FILEOL(REG)		;EOL IS NOT BLANK NOW
	CAIN   AC0," "			;LEADING BLANKS
	JRST	GTSGN			;YES - OVERREAD THEM
	SETZ   REG2,			;FOR INTEGER VALUE
	SETZ   REG3,			;FOR SIGN
	CAIN   AC0,"+"			;FIRST COMPONENT EQUAL PLUS ?
	JRST	.+4			;YES - GET NEXT COMPONENT
	CAIE   AC0,"-"			;FIRST COMPONENT EQUAL MINUS ?
	POPJ   P,			;NO - RETURN
	MOVEI  REG3,1			;YES - SET SIGN BIT
	SKIPN	FILEOL(REG)		;ENDOFLINE = TRUE ?
	PUSHJ  P,@filget(reg)		;NO - GET NEXT COMPONENT
	MOVE   AC0,FILCMP(REG)		;FOR FOLLOWING PARTS TO AC0
	POPJ   P,

GETINT: JFCL   10,.+1			;CLAERS  FLAGS
GTINT:	CAIG   AC0,"9"			;COMPONENT IN DIGITS ?
	CAIGE  AC0,"0"
	POPJ   P,			;NO - RETURN
	SUBI   AC0,"0"			;CONVERTS ASCII TO INTEGER
DANGER:	IMULI  REG2,12			;OLD INTEGER - may overflow
	ADD   REG2,AC0			;ADD NEW ONE
	SKIPN  FILEOL(REG)		;ENDOFLINE = TRUE ?
	PUSHJ  P,@filget(reg)		;NO - GET NEXT COMPONENT
	MOVE   AC0,FILCMP(REG)		;AND GETS IT FOR FOLLOWING PARTS
	JRST   GTINT			;GET NEXT DIGIT IF ANY

RTEST:	CAIG   AC0,"9"			;CARACTER IN DIGITS ?
	CAIGE  AC0,"0"
ifn tops10,<jrst badtst-1>		;error
ife tops10,<jrst [movei ac0,flinx1
		  jrst badtst-1]>
	POPJ   P,			;YES - RETURN

ife tops10,<
conerr:	push p,d
	push p,c
	push p,b
	move d,b
	pushj p,erp..##		;non-fatal error printer
	move b,(p)
	pcall f%shln		;show line with ^ under it
	move t,-3(p)		;t _ PC to print
	subi t,1		;ret addr - 1
	pcall f%fxln		;get new line
	pop p,b
	pop p,c
	pop p,d
	pop p,a			;get return address
	subi a,1		;addr of pushj to us
	jrst (a)		;try again

	pop	p,(p)
	pop	p,(p)		;special entry to abort caller
badtst:	movem	ac0,filerr(reg)
	movei	ac0,4		;bit for user wants to handle format errors
	tdnn	ac0,filflg(reg)
> ;ife tops10

ifn tops10,<
conerr:	push p,d
	push p,c
	push p,b
	pushj p,analys##	;non-fatal error printer
	move a,filr99(b)
	pushj p,@filshl(a)	;show where error is
	move t,-3(p)		;t _ PC to print
	subi t,1		;ret addr - 1
	move a,filr99(b)
	pushj p,@filfxl(a)	;get new line
	pop p,b
	pop p,c
	pop p,d
	pop p,a			;get return address
	subi a,1		;addr of pushj to us
	jrst (a)		;try again

	pop	p,(p)
	pop	p,(p)
badtst:	movsi	ac0,010000	;code for data errors
	iorm	ac0,filerr(reg)	;tell him it happened
	movei	ac0,010000	;see if enabled
	tdnn	ac0,filerr(reg)
> ;ifn tops10
	jrst	conerr		; no - fatal message
	setzb	reg2,reg1	;return 0 (reg2 for readi/n)
	setzm	filcmp(reg)	;clear out things like ioer
	move	ac0,filbad(reg)
	movem	ac0,fileof(reg)
	movem	ac0,fileol(reg)
	POPJ	P,

ITEST:	CAIG   AC0,"9"			;CARACTER IN DIGITS ?
	CAIGE  AC0,"0"
ifn tops10,<jrst badtst-1>		;error
ife tops10,<jrst [movei ac0,ifixx2
		  jrst badtst-1]>
	POPJ   P,			;YES - RETURN


.READI:	PUSHJ  P,GETSGN		;GETS SIGN IF ANY AND FIRST COMPONENT TO AC0
	PUSHJ  P,ITEST		;TEST IF FIRST COMPONENT IN DIGITS
	PUSHJ  P,GETINT		;GETS INTEGER TO REG2
	SKIPE  REG3			;SIGN EQUAL MINUS ?
	MOVN   REG2,REG2		;YES - NEGATE INTEGER
ifn tops10,<JFCL 10,badtst>		;OVERFLOW BIT SET ?
ife tops10,<jfcl 10,[movei ac0,ifixx3
		     jrst badtst]>
	MOVEM  REG2,REG1		;PUTS INTEGER IN PLACE LOADED TO REG1
	POPJ   P,

;READIN and INTEST are for the internal call within READR.  A separate
; routine is needed because error recovery is different.

INTEST:	CAIG   AC0,"9"			;CARACTER IN DIGITS ?
	CAIGE  AC0,"0"
ifn tops10,<jrst badtst-2>		;error
ife tops10,<jrst [movei ac0,flinx1
		  jrst badtst-2]>
	POPJ   P,			;YES - RETURN


;Note that no overflow test is done here, since one is done in READR.
; We call GTINT instead of GETINT to avoid clearing overflow bits, since
; this could result in our missing an overflow.
READIN:	PUSHJ  P,GETSGN		;GETS SIGN IF ANY AND FIRST COMPONENT TO AC0
	PUSHJ  P,INTEST		;TEST IF FIRST COMPONENT IN DIGITS
	PUSHJ  P,GTINT		;GETS INTEGER TO REG2
	SKIPE  REG3			;SIGN EQUAL MINUS ?
	MOVN   REG2,REG2		;YES - NEGATE INTEGER
	MOVEM  REG2,REG1		;PUTS INTEGER IN PLACE LOADED TO REG1
	POPJ   P,

;[12] This routine has been largely recoded to allow typing the largest
;	and smallest possible reals, and generally reducing the frequency
;	of complaints about exponent being too large or small.
;	The code is compiled directly from INSYMBOL in the compiler.
max10:	exp ^D3435973836	;{maximum number, sans last digit}

.READR:	PUSHJ  P,GETSGN		;GETS SIGN IF ANY AND FIRST COMPONET TO AC0
	setz reg6,		;scale := 0;
	CAIN	AC0,"."			;BEGIN WITH PT?
	JRST	PNTFST			;YES
	PUSHJ  P,RTEST		;TEST IF FIRST COMPONENT IN DIGITS
					;IF NOT ERROR - MESSAGE AND EXIT
BEFLOP:	CAIG AC0,"9"		;while ch in digits do
	CAIGE  AC0,"0"
	jrst pntfst
	caile reg6,0		;if scale > 0
	aoja reg6,beflp2	;  then scale := scale + 1
	camge reg2,max10	;else if ival < max10
	jrst beflp1		;  then ...
	camn reg2,max10		;else if ival = max10
	caile ac0,"7"		;	and ch <= 7
	aoja reg6,beflp2	;[else scale := scale + 1]
beflp1:	SUBI AC0,"0"		;  then ival := 10*ival + ord(ch) - ord("0")
	IMULI REG2,12
	ADD REG2,AC0
beflp2:	SKIPN  FILEOL(REG)		;ENDOFLINE = TRUE ?
	PUSHJ  P,@filget(reg)		;NO - GET NEXT COMPONENT
	MOVE   AC0,FILCMP(REG)		;AND GETS IT FOR FOLLOWING PARTS
	JRST BEFLOP		;  {end of while}
; note - old comment claimed we were converting to ASCII ??????
PNTFST:	MOVE   AC0,FILCMP(REG)	;if ch = '.'
	CAIE   AC0,"."
	JRST   REXP		;then
BEHPNT: SKIPE	FILEOL(REG)	;loop
	JRST	REXP
	PUSHJ  P,@filget(reg)	;nextch;
	MOVE   AC0,FILCMP(REG)	;exit if not ch in digits
	CAIG   AC0,"9"			;IN DIGITS ?
	CAIGE  AC0,"0"
	JRST	REXP			;NO
	caile reg6,0		;if scale > 0
	aoja reg6,behpt2	;  then scale := scale + 1
	camge reg2,max10	;else if ival < max10
	jrst behpt1		;  then ...
	camn reg2,max10		;else if ival = max10
	caile ac0,"7"		;	and ch <= 7
	aoja reg6,behpt2	;[else scale := scale + 1]
behpt1:	SUBI AC0,"0"		;  then ival := 10*ival + ord(ch) - ord("0")
	IMULI REG2,12
	ADD REG2,AC0
behpt2:	soja reg6,behpnt	;scale := scale - 1 end;
REXP:	move reg4,reg2			;REG4 is now ival
	MOVEI REG5,(REG3)		;REG5 is now sign
	CAIE AC0,"E"		;if ch='E' or 'e'
	CAIN AC0,"e"
	JRST .+2
	jrst noexp		;then begin
	SKIPN	FILEOL(REG)
	PUSHJ  P,@filget(reg)	;nextch;
	PUSHJ  P,READIN		;scale := scale + readint
	ADD    REG6,REG2	;end;
noexp:
ife kacpu,< ;[11]
	fltr reg4,reg4		;rval := ival
>
ifn kacpu,<
	MOVEI	AC1,reg4		;PLACE WHERE FIXED NO. IS
	PUSHJ	P,INTREA		;CONVERT TO FLOATING
> ;end [11]
;NOTE: The code from here to REAOUT is essentially hand-compiled from
; the compiler source in INSYMBOL.  This is to be sure that numbers typed
; in at runtime and at compile time are the same.
	jumpe reg6,reaout		;[3] if scale # 0 then begin
	move ac1,[10.0]			;[3] fac := 10.0;
	movm reg2,reg6			;[7] ascale := abs(scale);
					;[11] loop
rexp1:	trnn reg2,1			;[7]   if odd (ascale) then
	jrst rexp1a			;[12]
	caile reg6,0			;[12]    if scale > 0
	fmpr reg4,ac1			;[12]      then rval := rval*fac
	caig reg6,0			;[12]      else rval := rval/fac
	fdvr reg4,ac1			;[12]
rexp1a:	lsh reg2,-1			;[7]   ascale := ascale div 2;
	jumpe reg2,reaout		;[11] exit if ascale = 0;
	fmpr ac1,ac1			;[3]   fac := sqr(fac);
	jrst rexp1			;[11] end; end
REAOUT: 
ifn tops10,<JFCL 10,badtst>		;OVERFLOW - BIT SET ?
ife tops10,<jfcl 10,[movei ac0,flinx3	;IF SET JUMP TO CONERR
		     jrst badtst]>
	SKIPE  REG5			;SIGN EQUAL PLUS ?
	MOVN   REG4,REG4		;NO - NEGATE REAL VALUE
	MOVEM  REG4,REG1		;STARES VALUE INTO ADDRESS
	POPJ   P,

;[14] begin
;write record - addr of place to put it is in C, FCB in B
.wrrec:	move a,filcnt(b)	;a _ aobjn word for source
	jumpge a,wrrec2		;count = 0 or non-binary file - no-op
wrrec1:	move t,(c)		;copy loop
	movem t,(a)
	aoj c,
	aobjn a,wrrec1
wrrec2:	hlre c,filcnt(b)	;get count for PUT
	movn c,c		;make positive
	jrst @filput(b)		;put this item out

;write scalar - like write record but the thing is loaded into AC's
.wrsca:	hlre a,filcnt(b)	;a _ word count
	jumpge a,wrsca2		;count = 0 or non-binary file - no-op
	movem c,filcmp(b)	;always one word
	came a,[exp -1]		;if exactly one, no more to do
	movem d,filcmp+1(a)	;maybe second word
wrsca2:	hlre c,filcnt(b)	;get count for PUT
	movn c,c		;make positive
	jrst @filput(b)		;put this item out
;[14] end

ifn kacpu,<

entry intrea,trunc

;*** CONVERTS INTEGER TO REAL
;<AC1> = REGISTER WHERE INTEGERVALUE STANDS

intrea:	push p,ac1		;save return location
	move ac0,(ac1)		;ac0 _ original
	idivi ac0,400000	;magic taken from SAIL
	skipe ac0
	tlc ac0,254000
	tlc ac1,233000
	fadr ac0,ac1
	pop p,ac1
	movem ac0,(ac1)		;return value to same place
	popj p,

;*** STANDARDPROCEDURE TRUNC
;      CONVERTS REAL TO INTEGER
;	INPUT AND RESULT ARE STANDING IN REG
;	pointed to by ac1, lh=-1 for round

trunc:	move ac0,(ac1)		;ac0 _ value of number
	jumpge ac0,nonneg
	movn ac0,ac0
;here for negative numbers
	jumpge ac1,.+2		;unless truncating
	fadri ac0,(0.5)		;round negative numbers
	push p,ac1
	muli ac0,400
	tsc ac0,ac0
	exch ac0,ac1
	ash ac0,-243(ac1)
	movn ac0,ac0		;make negative again
	pop p,ac1
	movem ac0,(ac1)
	popj p,

;here for non-negative numbers
nonneg:	jumpge ac1,.+2		;unless truncating
	fadri ac0,(0.5)		;round positive number
	push p,ac1		;save location
	muli ac0,400		;magic from SAIL
	tsc ac0,ac0
	exch ac0,ac1
	ash ac0,-243(ac1)
	pop p,ac1
	movem ac0,(ac1)		;return value to same AC
	popj p,
> ;ifn kacpu

;this code is here to avoid overflow problems
ifn tops10,<
entry .%adgb
.%adgb:	jov .+1		;clear overflow
	imul b,h	;shift one digit
	add b,g		;add new
	jov .+2
	aos (p)		;skip is OK
	popj p,
>
	

safend:					;[4] end of "safe" area
	END