SUBT > Sys.Input ; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; + I N P U T + ; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ GBLL debincon ; Whether to debug input conversions debincon SETL 1=0 ^ 0 want_integer # 1 ; Unique manifests; values irrelevant want_real # 1 from_argp # 1 from_fcb # 1 ; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; Buffer character read to allow user to edit input ; In : linbufptr, linbfX -> next char to read (linbfX = 0 if empty) ; Out : R0b = char read. Other regs + flags preserved PasRdch ROUT [ debin STRIM " PasRdch" ] STASH "t1, link" LV R0, linbufptr LV t1, linbfX CMP t1, #0 ; If input buffer empty then get BLEQ PasReadLine ; another line from the console MOVEQ t1, #0 LDRB R0, [R0, t1] CMP R0, #CR CMPNE R0, #LF MOVEQ t1, #0 ADDNE t1, t1, #1 SV t1, linbfX GRABS "t1, pc" ; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; Read line into linbuf, aborting on Escape ; Out : line input, terminated by CR, all regs + flags preserved PasReadLine ROUT [ debin STRIM " ReadLine =>" ] STASH "R0-R3, link" LV R0, linbufptr MOV R1, #255 MOV R2, #space MOV R3, #255 SWI Readline MOV R2, #CR ; Always terminate line with CR STRB R2, [R0, R1] LDMCCDB hasp!, {R0-R3, pc}^ ; NB. Preserve flags too ! ; The whalley pressed Escape, so terminate him ! EscapeDeath [ debin STRIM " ESCAPE !!!" ] MOV osbA, #126 ; Acknowledge it first SWI Byte ERROR "Escape" ; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; function eoln (f : file) : boolean; iEoln [ debin STRIM " eoln ()" ] STASH link POP addr BL PossGetInput LDRB R0, [addr, #fcbflags] TST R0, #F_file LDMNEDB hasp!, {link} BNE eEof TST R0, #L_file MOV arga, #falsch MOVEQ arga, #troo GRABS pc ; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; function eof (f : file) : boolean; iEof [ debin STRIM " eof ()" ] STASH link POP addr BL PossGetInput LDRB R0, [addr, #fcbflags] TST R0, #F_file MOV arga, #falsch MOVEQ arga, #troo GRABS pc ; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; addr := validated FCB for input ReadCommon [ debin STRIM " ReadCommon" ] LDR addr, [currbase, #hkffcbref] ; ............................................................................. ; addr -> FCB to validate for input ; Out : argp -> BV. All other regs + flags preserved GetCheck [ debin STRIM " GetCheck" ] STASH "R0, link" ADD argp, addr, #fcbBV ; argp -> BV BL PossGetInput LDRB R0, [addr, #fcbflags] TST R0, #R_file LDMEQDB hasp!, {R0, link} BEQ eWriteOnlyFile TST R0, #F_file LDMNEDB hasp!, {R0, link} BNE eEof GRABS "R0, pc" ; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; Check g(et pending on input) and update if necessary ; In : addr -> FCB ; Out : All regs + flags preserved PossGetInput [ debin STRIM " PossGetInput" ] STASH "R0, link" BL FCBtest LDMCCDB hasp!, {R0, link} BCC eUndefinedFile LDRB R0, [addr, #fcbflags] TST R0, #G_file LDMEQDB hasp!, {R0, pc}^ BIC R0, R0, #G_file STRB R0, [addr, #fcbflags] GRAB "R0, link" ; ............................................................................. ; Get a byte into the current BV from the selected input stream ; In : addr -> FCB ; Out : All regs + flags preserved GetInput ROUT [ debin STRIM " GetInput" ] STASH "R0, R1, link" LDRB R0, [addr, #fcbflags] ; If p(hysical eof) then set f else rch TST R0, #P_file BNE %FT90 LDR R1, [addr, #fcbhandle] ; If console then different eof (char) CMP R1, #0 BNE %FT60 ; *** Console handler *** BL PasRdch CMP R0, #eof_char BEQ %FT80 ; test R0b=CR then f^, f.L := ' ', true ; else f^, f.L := R0b, false 40 LDRB R1, [addr, #fcbflags] BIC R1, R1, #L_file CMP R0, #CR ; Allow both CR and LF to give eoln status (Tutu-ism) CMPNE R0, #LF BNE %FT55 ; Below (51) jumped to from file handler 51 MOV R0, #space ; If eoln read set f^ := ' ', f.L = true ORR R1, R1, #L_file 55 STRB R0, [addr, #fcbBV] ; f^ := R0b STRB R1, [addr, #fcbflags] ; f.L := R1b (and all other flags) GRABS "R0, R1, pc" ; *** File handler *** 60 SWI Bget ; Handle in R1w BCC %BT40 80 ; Physical eof read, so set p & test l for possible eoln append LDRB R1, [addr, #fcbflags] ORR R1, R1, #P_file TST R1, #L_file BEQ %BT51 90 ; Update flags : v l~f -> ~v~l f EOR R1, R1, #(V_file + L_file + F_file) STRB R1, [addr, #fcbflags] GRABS "R0, R1, pc" ; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; Perform lazy IO on the console stream ; In : addr -> FCB ; Out : All regs + flags preserved LazyGetText [ debin STRIM " LazyGetText" ] LDR R0, [addr, #fcbhandle] CMP R0, #0 BNE GetInput ; link ok LDRB R0, [addr, #fcbflags] ; Set g ORR R0, R0, #G_file STRB R0, [addr, #fcbflags] MOVS pc, link ; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; BL code &87 - Pr_Trd_Ln iTrdLn ROUT [ debin STRIM " TrdLn ()" ] STASH link BL ReadCommon 10 LDRB R0, [addr, #fcbflags] ; Read characters until eoln TST R0, #L_file BLEQ GetInput BEQ %BT10 GRAB link B LazyGetText ; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; BL code &8D - Pr_Get_Txt iGetText [ debin STRIM " GetText ()" ] STASH link POP addr BL GetCheck GRAB link B LazyGetText ; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; BL code &88 - Pr_Trd_Chr iTrdChr [ debin STRIM " TrdChr ()" ] STASH link BL ReadCommon LDRB R0, [addr, #fcbBV] PUSH R0 GRAB link B LazyGetText ; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; BL code &8A - Pr_Trd_Int iTrdInt [ debin STRIM " TrdInt ()" ] STASH link BL ReadCommon MOV R0, #want_integer BL NumConInput GRAB link B LazyGetText ; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; BL code &8B - Pr_Trd_Rea iTrdRea [ debin STRIM " TrdRea ()" ] STASH link BL ReadCommon MOV R0, #want_real BL NumConInput STRIM " Back in the USSR" GRAB link B LazyGetText ; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ iGetBytes ; Size read from FCB [ debin STRIM " GetBytes ()" ] POP addr STASH link BL GetCheck B GetThem iIrdType ROUT ; Common routine for pr_iwr_bce/ptr/int/rea/set [ debin STRIM " IrdType ()" ] STASH link BL ReadCommon LDR count, [addr, #fcbcsz] ; Push f^ SUB count, count, #1 MOVEBLK sp, argp LDR count, [addr, #fcbcsz] ADD sp, sp, count B GetThem iIrdUby [ debin STRIM " IrdUby ()" ] STASH link BL ReadCommon LDRB r0, [argp] ; Push f^ PUSH r0 B GetThem iIrdUwd [ debin STRIM " IrdUwd ()" ] STASH link BL ReadCommon LDRB r0, [argp] ; Push f^ LDRB r1, [argp, #1] ORR r0, r0, r1, LSL #8 PUSH r0 B GetThem iIrdBlk ; Size read from FCB [ debin STRIM " IrdBlk ()" ] STASH link BL ReadCommon POP argp LDR count, [addr, #fcbcsz] ; Push f^ SUB count, count, #1 MOVEBLK sp, argp ; ............................................................................. AAgetBytes ADD argp, addr, #fcbBV ; argp -> BV ; ............................................................................. ; Get bytes (size read from FCB) from input and stick in BV ; In : addr -> FCB, argp -> BV GetThem ROUT [ debin STRIM " GetThem" ] LDR count, [addr, #fcbcsz] LDR R1, [addr, #fcbhandle] 10 SWI Bget BCS %FT90 STRB R0, [argp], #1 SUBS count, count, #1 BNE %BT10 GRAB pc 90 ; Got EOF - change v~f to ~v f LDRB r0, [addr, #fcbflags] EOR r0, r0, #(V_file + F_file) STRB r0, [addr, #fcbflags] GRAB pc ; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; BL code &4B - Ident_I_rb. Pop FCB, check defined and v(alid BV) and push BV^ iIdnIrdbuff ROUT [ debin STRIM " Ident_I_rdbuff ()" ] STASH "addr, link" POP addr BL PossGetInput LDRB R0, [addr, #fcbflags] TST R0, #V_file LDMEQDB hasp!, {addr, link} BEQ eUndefinedBV ADD addr, addr, #fcbBV PUSH addr GRABS "addr, pc" ; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; BL code &F0 - Ident_I_wb. Pop FCB, set v(alid BV) and push BV^ iIdnIwrbuff ROUT [ debin STRIM " Ident_I_wrbuff ()" ] STASH "addr, link" POP addr BL PossGetInput ; Is this wally ? LDRB R0, [addr, #fcbflags] ORR R0, R0, #V_file STRB R0, [addr, #fcbflags] ADD addr, addr, #fcbBV PUSH addr GRABS "addr, pc" ; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; Convert text to a number ; In : argp -> string, R0 = want_type (want_integer,real) ; Out : argp -> first unused character. Number on TOS, error if bad or unwanted iacc RN addr mantlo RN t1 PointFlag RN t2 BinExp RN PointFlag ; Use doesn't conflict in here DecExp RN t3 read_src RN R1 ; Please don't use R1 in these routines ! ; Can't use t0 here 'cos that's argp ! NumConString ; For reading numbers from stracc (ival/rval) [ debin STRIM " NumConString" ] MOV read_src, #from_argp LV argp, straccptr B NumericConv NumConInput ; For reading numbers from input device (trd_int/trd_rea) [ debin STRIM " NumConInput" ] MOV read_src, #from_fcb SV addr, stashed_fcb_addr ; addr = iacc, so we'd better hide it ! ; ............................................................................. ; Must preserve addr for i/o routines NumericConv ROUT [ debincon STRIM " Converting string to number :" ] STASH "addr, link" SV R0, want_type MOV DecExp, #0 ; Decimal exp (count digits after point) MOV PointFlag, #0 ; Point met flag CMP read_src, #from_argp ; If reading from fcb, first char in f^ LDRNEB R0, [addr, #fcbBV] ; Last chance to use addr (=iacc) 10 BLEQ ReadChar ; NB. When looping, EQ==AL. Cond for above ! CMP R0, #space ; Skip preceding spaces BEQ %BT10 CMP R0, #"9" ; Must have a leading digit char BHI eBadNumber SUBS iacc, R0, #"0" ; Save digit in iacc BCC eBadNumber ; Got a digit so we'll read an integer until that fails IntRdLoop [ debincon DREG iacc ] BL ReadChar ; ***^ CMP R0, #"9" BHI IntEnd SUBS R0, R0, #"0" BCC IntEnd2 SUB DecExp, DecExp, PointFlag ; Count digits if after point LDR temp, =(&7FFFFFFF/10) ; &0CCCCCCC CMP iacc, temp BGT Int0Flo ; Got to move onto FP if iacc too big for *10 ADD iacc, iacc, iacc, LSL #2 ; iacc *:= 10 then +:= digit ADDS iacc, R0, iacc, LSL #1 ; Nasty, uh ?! BVC IntRdLoop B Int0Flo2 ; Got to move onto FP if overflowed on addition IntEnd CMP R0, #ExpChar ; Exponent following ? CMPNE R0, #AltExpChar BEQ IntAndExp B IntEnd3 IntEnd2 CMP R0, #("."-"0") ; Got a point here ? BEQ IntAndPt IntEnd3 SUB argp, argp, #1 ; Set argp back -> duff char CMP PointFlag, #0 ; Had a point already ? BNE FPinIACC ; Yup - float the bugger LV R0, want_type ; If we wanted a real, float iacc CMP R0, #want_real BEQ FrdFltI PUSH iacc [ debincon SWI Newline STRIM "Result iacc =" DREG iacc ] GRAB "addr, pc" ; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; Number has an point in it IntAndPt [ debincon STRIM " Has Point" ] LV R0, want_type ; If we really want integer, then don't try FP CMP R0, #want_integer BEQ IntEnd3 CMP PointFlag, #0 ; Had a point already ? SUBNE argp, argp, #1 ; If so, set argp back -> point BNE FPinIACC ; and float the bugger MOV PointFlag, #1 ; Continue reading as integer, then FP B IntRdLoop ; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; Number has an exponent following it. Mantissa in iacc IntAndExp BL ExpRead ; Adds exponent to DecExp ; ............................................................................. ; Got mantissa in iacc, decimal exp in DecExp, so float it to TOS FPinIACC ROUT LV R0, want_type CMP R0, #want_integer BEQ eIntegerWanted CMP iacc, #0 ; 0.0En = 0.0 BEQ ZeroRes CMP DecExp, #0 ; Did we just get a point ? or 0 exp ? BEQ FrdFltI ; Now have mantissa in iacc, non-zero decimal exp in DecExp [ debincon STRIM " floating iacc (" DREG iacc STRIM " ) E DecExp (" DREG DecExp STRIM " )" ] LDR BinExp, =1022+32 ; Real binary exp ; Note iacc 1st time has to be positive 20 MOVS iacc, iacc, LSL #1 ; Normalize mantissa SUB BinExp, BinExp, #1 BPL %BT20 [ debincon STRIM " normalized :" DREG iacc DREG BinExp ] MOV mantlo, #0 ; Lower mantissa bits ; Now got mantissa in (iacc,mantlo) CMP DecExp, #0 ; Zero exponent case left behind BGT PosDecExp NegDecExp ; Deal with -ve DecExp - for i := DecExp to 0 do (iacc,mantlo) /:= 10 [ debincon STRIM " Negative DecExp" ] BL FtenFDiv ADDS DecExp, DecExp, #1 BNE NegDecExp B FPnumBuild ; We done normalized PosDecExp ; for i := 0 to DecExp do (iacc,mantlo) *:= 10 [ debincon STRIM " Positive DecExp" ] BL FtenFMult SUBS DecExp, DecExp, #1 BNE PosDecExp ; ............................................................................. ; In : normalized mantissa (iacc,mantlo), BinExp = binary exp ; Out : float on TOS FPnumBuild ROUT [ debincon STRIM " make float (" DREG iacc STRIM "," DREG mantlo STRIM " ) BinExp" DREG BinExp ] TST mantlo, #(1 :SHL: 10) ; Round mantissa BEQ NoRound ADDS mantlo, mantlo, #&800 BCC NoRound ADDS iacc, iacc, #1 ADDCS BinExp, BinExp, #1 ; Bump up BinExp if iacc overflowed MOVCS mantlo, mantlo, LSR #1 ; iacc must be 0 from above MOVCS iacc, #bit31 ; Renormalize NoRound SUB R0, BinExp, #&FF ; CMP BinExp, #&7FF SUBS R0, R0, #&700 ; -> CMP (BinExp-&FF), #&700 BGE eFloatingOverflow ; Exponent of all ones reserved (IEEE) CMP BinExp, #0 ; Underflowed ? BLT ZeroRes [ debincon STRIM " Building float (" DREG iacc STRIM "," DREG mantlo STRIM " ) BinExp" DREG BinExp ] EOR BinExp, BinExp, #1 ; Toggle bit for later MOV BinExp, BinExp, ROR #12 ; Put exponent in place MOV mantlo, mantlo, LSR #11 ; Part of mantissa in place MOV temp, iacc, LSL #21 MOV iacc, iacc, LSR #11 EOR iacc, iacc, BinExp ; Got top word in iacc complete ORR mantlo, mantlo, temp ; And mantissa completed in mantlo PUSH iacc ; Lower word (x). See fp-doc ! PUSH mantlo ; Higher word (x+4) [ debincon SWI Newline STRIM "Result (iacc,mantlo)" DREG iacc DREG mantlo ] GRAB "addr, pc" ; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; Move onto double length arithmetic now. iacc not yet *10 - due to blow. Int0Flo ROUT [ debincon STRIM " iacc *10 too big - going to (iacc,mantlo) * 10" ] MOV mantlo, iacc ; (iacc,mantlo) := (0,mantlo) * 10 MOV iacc, mantlo, LSR #30 ; iacc (b1b0) := mantlo (b31b30) ADDS mantlo, mantlo, mantlo, LSL #2 ; *5 ADC iacc, iacc, #0 ; Possible carry ADDS mantlo, mantlo, mantlo ; *2 ADC iacc, iacc, iacc ; Possible carry ADDS mantlo, mantlo, R0 ; (iacc,mantlo) +:= digit ADC iacc, iacc, #0 ; Can't overflow B Dble Int0Flo2 ; iacc blew on adding digit and so has the full (unsigned) mantissa [ debincon STRIM " iacc blew on adding digit" ] MOV mantlo, iacc ; Set up extended integer (iacc,mantlo) MOV iacc, #0 Dble ; Very similar to single precision stuff above DbleLoop [ debincon STRIM " DbleLoop" DREG iacc DREG mantlo ] BL ReadChar ; ***^ CMP R0, #"9" BHI DbleEnd SUBS R0, R0, #"0" BCC DbleEnd2 LDR temp, =&19999999 ; &FFFFFFFF/10. Would we blow on *10 ? CMP iacc, temp BHI Dble0Flo SUB DecExp, DecExp, PointFlag ; Count digits after point if *10 ok ; (iacc,mantlo) *:= 10. Lower word first, suss bits to add into top word MOV temp, mantlo, LSR #30 ; temp (b1b0) := mantlo (b31b30) ADDS mantlo, mantlo, mantlo, LSL #2 ; *5 ADC temp, temp, #0 ; Possible carry ADDS mantlo, mantlo, mantlo ; *2 ADC temp, temp, temp ; Possible carry ADD iacc, iacc, iacc, LSL #2 ; Now top word *:= 10 + bits ADDS iacc, temp, iacc, LSL #1 BVS Dble0Flo2 ; If signed overflow, all bits set ok ADDS mantlo, mantlo, R0 ; (iacc,mantlo) +:= digit ADCS iacc, iacc, #0 BVC DbleLoop B Dble0Flo2 LTORG ; Dump all those nasty literals eBadNumber ERROR "Bad number" eIntegerWanted ERROR "Integer wanted" eFloatingOverflow ERROR "Floating point overflow" DbleEnd2 [ debincon STRIM " DbleEnd2" ] CMP R0, #("."-"0") BNE DBE4 ; Not a point - terminate CMP PointFlag, #0 ; Point yet ? BNE DBE4 ; Terminate if had a point MOV PointFlag, #1 B Dble DbleEnd CMP R0, #ExpChar ; Exponent following ? CMPNE R0, #AltExpChar BLEQ ExpRead DBE4 CMP iacc, #0 CMPEQ mantlo, #0 BEQ ZeroRes DBE1 LDR BinExp, =1022+64 ; Real binary exponent TEQ iacc, #0 ; Already normalized ? BMI %FT90 80 ADDS mantlo, mantlo, mantlo ; Normalize (iacc,mantlo) ADCS iacc, iacc, iacc SUB BinExp, BinExp, #1 BPL %BT80 90 TEQ DecExp, #0 BEQ FPnumBuild BPL PosDecExp B NegDecExp ZeroRes MOV iacc, #0 PUSH iacc PUSH iacc [ debincon SWI Newline STRIM "Result is zero" ] GRAB "addr, pc" LTORG ; Dump that darn literal ! FrdFltI ; iacc is the whole result, float to TOS FLTD fa, iacc STFD fa, [sp], #8 [ debincon SWI Newline STRIM "Result = FLOAT (" DREG iacc STRIM " )" ] GRAB "addr, pc" ; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; Double length arithmetic has blown - plenty of spare bits of precision now ! ; - Guard is 11 bits Dble0Flo ; Would blow on *10 -> shift digit by at least 1 -> < 3 bits to add in [ debincon STRIM " dble0flo" ] ADD DecExp, DecExp, #1 SUB DecExp, DecExp, PointFlag ; Add 1 if decimal point not had yet Dble0Flo2 ; Blew on addition, so got correct unsigned mantissa [ debincon STRIM " dble0flo2" ] SUB PointFlag, PointFlag, #1 SkipLoop ; Skip over insignificant digits BL ReadChar ; ***^ CMP R0, #"9" BHI DbleEnd SUBS R0, R0, #"0" BCS SkipLoop CMP R0, #("."-"0") BNE DbleEnd CMP PointFlag, #0 ; Had point before this one ? BEQ DbleEnd MOV PointFlag, #0 B SkipLoop ; Wobble over pointless fraction digits ; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; Read an exponent ! In ISO-Pascal, 'scale-factor' ::= 'signed-integer' ; In : argp -> just after "e"|"E" ; Out : DecExp = corrected decimal exponent, argp -> 1st unused char ExpRead ROUT [ debincon STRIM " Reading exponent" ] STASH link BL ReadChar CMP R0, #"+" BEQ ExpReadC CMP R0, #"-" BNE ExpReadA RSB DecExp, DecExp, #0 ; -ve exponent, so fudge BL ExpReadN ; Get -DecExp+exponent RSB DecExp, DecExp, #0 ; DecExp-exponent GRABS pc ExpReadN STASH link ExpReadC BL ReadChar ExpReadA ; Got first char of exponent in R0 CMP R0, #"9" ; Pascal wants first good digit BHI eBadExponent SUBS BinExp, R0, #"0" ; BinExp := digit BCC eBadExponent ; Loop, reading chars for exponent, until non-digit 10 BL ReadChar ; ***^ CMP R0, #"9" ; Terminate if non-digit BHI %FT99 SUBS R0, R0, #"0" BCC %FT99 ADD BinExp, BinExp, BinExp, LSL #2 ; BinExp *:= 10 ADD BinExp, BinExp, BinExp ADD BinExp, BinExp, R0 ; BinExp +:= digit B %BT10 eBadExponent ERROR "Bad exponent" 99 SUB argp, argp, #1 ; argp -> 1st unused char ADD DecExp, DecExp, BinExp ; DecExp +:= exponent read [ debincon STRIM " DecExp" DREG DecExp STRIM " BinExp" DREG BinExp ] GRABS pc ; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; Gets char in either using GetText (for addr -> FCB) or reading from argp ; Out : R0b = char, flags set on CMP R0, #"9". All other regs preserved ReadChar ROUT [ debincon STRIM " rdch " ] CMP read_src, #from_argp BEQ %FT50 STASH "R1-sp, link" ; addr is used as iacc above ! LV addr, stashed_fcb_addr BL GetInput LDRB R0, [addr, #fcbBV] [ debincon BL PasWrch ] CMP R0, #"9" GRAB "R1-sp, pc" ; NB. flags set on CMP ! 50 LDRB R0, [argp], #1 [ debincon BL PasWrch ] CMP R0, #"9" MOV pc, link ; NB. flags set on CMP ! ; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; Extended precision handlers : mantissa (iacc,mantlo), BinExp binary exponent ; Mantissa is in this case a left justified quad fraction ; (iacc,mantlo) *:= 10. (R0,temp), flags corrupt. All other regs preserved FtenFMult [ debincon STRIM " FtenFmult -" DREG iacc DREG mantlo DREG BinExp ] ADD BinExp, BinExp, #3 ; *8 MOV temp, mantlo, LSR #2 ; temp := mantlo >> 2 ORR temp, temp, iacc, LSL #30 ; Low word of mantissa >> 2 MOV R0, iacc, LSR #2 ; (R0,temp) := (iacc,mantlo) >> 2 TST mantlo, #(1 :SHL 1) ; Do addition with bit carried out ; ............................................................................. ; In : long integers in (iacc,mantlo) and (R0,temp). NE if rounding wanted ; Out : result of addition in (iacc,mantlo). (R0,temp) +:= 1 if rounding wanted ; All other regs + flags preserved FTenAdd ROUT STASH link BEQ %FT10 ADDS temp, temp, #1 ; Add in carry from bit we just lost ADC R0, R0, #0 ; Can't overflow - top bits cleared 10 ADDS mantlo, mantlo, temp ADCS iacc, iacc, R0 [ debincon BCS %FT42 STRIM " Leaving FTenAdd CC" 42 ] LDMCCDB hasp!, {pc}^ ; No overflow so we're still normalized ADD BinExp, BinExp, #1 ; Bump up BinExp MOVS iacc, iacc, LSR #1 ; (iacc,mantlo) >> 1 MOV mantlo, mantlo, RRX ORR iacc, iacc, #bit31 ; Set top bit again [ debincon STRIM " Leaving FTenAdd CS" ] GRABS pc ; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; (iacc,mantlo) /:= 10. (R0,temp) corrupt. All other regs + flags preserved FtenFDiv [ debincon STRIM " FtenFDiv -" DREG iacc DREG mantlo DREG BinExp ] STASH link SUB BinExp, BinExp, #4 ; *0.0001 (binary) MOVS R0, iacc, LSR #1 ; (temp,R0) := (iacc,mantlo) >> 1 MOV temp, mantlo, RRX TST mantlo, #(1 :SHL: 0) ; Get carry BL FTenAdd ; Get *0.00011 [ debincon STRIM " + >> 1 =" DREG iacc DREG mantlo DREG BinExp ] MOV temp, mantlo, LSR #4 ; (temp,R0) := (iacc,mantlo) >> 4 ORR temp, temp, iacc, LSL #32-4 MOV R0, iacc, LSR #4 TST mantlo, #(1 :SHL: 3) ; Get carry BL FTenAdd ; Get *0.000110011 [ debincon STRIM " + >> 4 =" DREG iacc DREG mantlo DREG BinExp ] MOV temp, mantlo, LSR #8 ; (temp,R0) := (iacc,mantlo) >> 8 ORR temp, temp, iacc, LSL #32-8 MOV R0, iacc, LSR #8 TST mantlo, #(1 :SHL: 7) ; Get carry BL FTenAdd ; Get *0.00011001100110011 [ debincon STRIM " + >> 8 =" DREG iacc DREG mantlo DREG BinExp ] MOV temp, mantlo, LSR #16 ; (temp,R0) := (iacc,mantlo) >> 16 ORR temp, temp, iacc, LSL #32-16 MOV R0, iacc, LSR #16 TST mantlo, #(1 :SHL: 15) ; Get carry BL FTenAdd ; Get *0.00011001100110011.. [ debincon STRIM " + >> 16 =" DREG iacc DREG mantlo DREG BinExp ] MOV temp, iacc ; (temp,R0) := (iacc,mantlo) >> 32 MOV R0, #0 TST mantlo, #(1 :SHL: 31) ; Get carry BL FTenAdd ; Get *0.00011001100110011.... [ debincon STRIM " + >> 32 =" DREG iacc DREG mantlo DREG BinExp STRIM " Leaving FtenFDiv" ] GRABS pc ; Done it to enough precision now LNK Sys.Output