!!! ==================================================================== !!! *WARNING* *WARNING* *WARNING* *WARNING* *WARNING* *WARNING* *WARNING* !!! This code does not yet work properly!!! !!! *WARNING* *WARNING* *WARNING* *WARNING* *WARNING* *WARNING* *WARNING* !!! !!! Compute the Fibonacci series in Bliss-36 on TOPS-20, including the !!! ratios of successive terms, and their differences from the golden !!! ratio, with floating-point computating in double precision !!! (D-floating) format. !!! [26-Jun-2007] !!! ==================================================================== MODULE FIBMOD(MAIN = FIBONACCI) = BEGIN REQUIRE 'TUTIO'; ROUTINE TTY_PUT_DBL(value : VECTOR[2]) : NOVALUE = BEGIN BUILTIN JSYS; LITERAL DFOUT = %O'235', PRIOU = %O'101'; REGISTER AC1 = 1, AC2 = 2, AC3 = 3, AC4 = 4; AC1 = PRIOU; AC2 = ..value[0]; AC3 = ..value[1]; AC4 = %O'024034172200'; JSYS(2, DFOUT, AC1, AC2, AC3, AC4); ! print value END; ROUTINE FIBONACCI : NOVALUE = BEGIN BUILTIN CVTID, DIVD, SUBD; LITERAL HT = %C' ', SPACE = %C' '; LOCAL den : VECTOR[2], diff : VECTOR[2], fk, fkm1, fkm2, k, num : VECTOR[2], ratio : VECTOR[2]; OWN golden_ratio : VECTOR[2] INITIAL(%D'1.61803398874989484'); TTY_PUT_QUO('Fibonacci series in Bliss-36 [D-floating computation]:'); TTY_PUT_CRLF(); k = 1; fkm2 = 1; TTY_PUT_CHAR(HT); TTY_PUT_INTEGER(.k, 10, 5); TTY_PUT_CHAR(SPACE); TTY_PUT_INTEGER(.fkm2, 10, 15); TTY_PUT_CRLF(); k = 2; fkm1 = 1; TTY_PUT_CHAR(HT); TTY_PUT_INTEGER(.k, 10, 5); TTY_PUT_CHAR(SPACE); TTY_PUT_INTEGER(.fkm1, 10, 15); TTY_PUT_CRLF(); INCR k FROM 3 TO 100 DO BEGIN fk = .fkm1 + .fkm2; ! Fibonacci recursion IF (.fk LSS 0) THEN EXITLOOP; ! wrap to negative means integer overflow CVTID(fk, num); CVTID(fkm1, den); DIVD(den, num, ratio); ! ratio = fk/fkm1 SUBD(golden_ratio, ratio, diff); ! diff = ratio - golden_ratio fkm2 = .fkm1; fkm1 = .fk; TTY_PUT_CHAR(HT); TTY_PUT_INTEGER(.k, 10, 5); TTY_PUT_CHAR(SPACE); TTY_PUT_INTEGER(.fk, 10, 15); TTY_PUT_CHAR(SPACE); TTY_PUT_DBL(ratio); TTY_PUT_CHAR(SPACE); TTY_PUT_DBL(diff); TTY_PUT_CRLF(); END; END; END ELUDOM