Trailing-Edge
-
PDP-10 Archives
-
decus_20tap1_198111
-
decus/20-0003/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
fad 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