# SOFTWARE LIBRARY ROUTINES FOR THE UNIVERSAL MACHINE. # Copyright Tom Jennings 1999-2002, tomj@wps.com # MRU 2 JULY 2001 # 25 JAN 2001 # NOTE! THIS PRELIMINARY CODE IS NOT OPTIMALLY CODED! RETURN EQ 0 # place-holder for return addresses POINTER EQ 0 # place-holder for runtime pointers VAR EQ 0 # place-holder for runtime variables # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # STANDARD JUMP TABLE LOCATION. track 0 sector 0 start: jump test # program entry ttyo: jump ttyo # (simulated) ttyi: jump ttyi # (simulated) ttyow: jump ttyowx # print packed chars ttyos: jump ttyosx # print string ttyod: jump ttyodx # print decimal ttyoo: jump ttyoox # print octal multUS: jump multUx # mult unsigned single multUD: jump multUDx # mult unsigned double m10: jump m10x # single mult by 10 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - track 0 sector 20 ttchar: VAR # ttyxx argument ttarg: VAR # ttyxx argument ttopt: VAR # ttyxx options zschar: VAR # zero-suppress errno: VAR # subr status Mper: VAR # multiplier Mcand: VAR # multiplicand or LSW Mcandh: VAR # multiplicand MSW Mtest: VAR # mult. routine MQ: VAR # quotient or LSW MQh: VAR # quotient MSW minus1: -1 # constant minus6: -6 # constant digtbl: '0 # table of digits '1 '2 '3 '4 '5 '6 '7 '8 '9 'A 'B 'C 'D 'E 'F # --------------------------------------------------------------- # Unsigned single-precision fixed multiply Mcand by 10. m10x: sta m10r ldm Mcand or 0 # clear carry rlc # times two, sto Mcand # save that, rlc rlc # times eight, addm Mcand # times ten, sto Mcand m10r: jump RETURN track 1 sector 0 # Unsigned double-precision multiply Mcand by Mper # leaving the result in MQ (ls word) and MQh # (ms word). Destroys Mcand and Mper. Sets errno # if overflow out of MS digit. multUDx: sta mdlr and 0 sto MQ sto MQh # initialize ld 1 mdl1: sto Mtest # m'per digit tester andm Mper # test m'per digit snz jump mdl2 # add in Mcand if 1 ldm Mcand # Mcand lo addm MQ # + MQ lo sto MQ # = MQ lo ldm Mcandh # Mcand hi adcm MQh # + MQ hi + carry sto MQh # = MQ hi ld 0 adcm errno # remember overflow error sto errno mdl2: ldm Mcand or 0 # clear carry rlc # shift multiplicand sto Mcand # Mcand * 2 ldm Mcandh # double precision adcm Mcandh # ldm Mtest or 0 # clear carry rlc snz # if no more bits mdlr: jump RETURN # done. jump mdl1 # Unsigned single-precision multiply Mcand by Mper # leaving the result in MQ. Destroys Mcand. # Sets errno if overflow out of MS digit. multUx: sta mslr and 0 sto MQ ld 1 msl1: sto Mtest # m'per digit tester andm Mper # test m'per digit snz jump msl2 # add in Mcand if 1 ldm Mcand # Mcand addm MQ # + MQ sto MQ # = MQ ld 0 adcm errno # remember overflow error sto errno msl2: ldm Mcand or 0 # clear carry rlc # shift multiplicand sto Mcand # Mcand * 2 ldm Mtest or 0 # clear carry rlc snz # if no more bits mslr: jump RETURN # done. jump msl1 # ------------------------------------------------- track 2 sector 0 # Output a string of packed characters. # ttyosx: sta ttysr ldm ttchar # ptr to string tts0: sta tts1 # set string pointer tts1: ldm POINTER # load text word, sto ttchar lda C+2 jump ttyowx # output one word, snz ttysr: jump RETURN # exit if end of string ldm tts1 add 1 # advance string ptr, jump tts0 # ----------------------------------------------------- sector 13 # OPTIMUM 64x5 ttyowx: sta ttwr ldm ttchar sto ttwv1 # optimum storage ld ttw1 # reset table ptr, ttw0: sta ttwj2 ldm ttchar # A=char, ttwj2: jump POINTER # jump into table, ttw1: jump ttw3 # LS char, jump ttw2 # 2nd char, jump ttw2 # 3rd char, ttwr: jump RETURN # return # Shift right one character, output it. ttw2: sr 0 sr 0 sr 0 sr 0 sr 0 sr 0 # Output the LS character, advance the pointer to # the next character in the word in ttchar. ttw3: sto ttchar lda C+2 jump ttyo # output a char, snz # if it was a NULL, jump ttwr # exit ldm ttwj2 # current table ptr, add 1 # increment, jump ttw0 # loop. sector 39 # OPTIMUM 64x5 ttwv1: VAR # ----------------------------------------------------- # ----------------------------------------------------- track 3 sector 0 # Output TTARG as a decimal number. Leading zero's are # handled according to ZSFLAG: # '0' displayed as 0 # ' ' displayed as space # 0 suppressed. # Modifies TTARG, TTCHAR. ttddk1: -100000 # table of divisors -10000 -1000 -100 -10 0 # end of table marker ttzchr: 0 # zero-suppress character ttddr: RETURN # return address ttddr2: RETURN # subr return address ttyodx: sto ttddr # save return addr, ldm zschar sto ttzchr # copy of zero-supp char ld ttdd7 # ptr to decade char output sto ttddr2 # inside loop ld ttddk1 # init ptr to divisors ttdd0: sta ttdd1 # top of outer loop, sta ttdd4 # set ptr to current divisor ttdd1: ldm POINTER # check for end of table or 0 # marked with 0 sz jump ttdd2 # jump if more decades, # Remainder is less than 10; output directly. ldm ttddr # set return from routine sto ttddr2 ldm ttarg # get remainder sto ttchar jump ttdd5 # go output # Determine quotient/digit by repeated subtraction of # the decade divisor. ttdd2: ldm minus1 # seed to enter loop ttdd3: add 1 sto ttchar # next try ldm ttarg # the remainder, ttdd4: addm POINTER # subtract decade, sc jump ttdd5 # until underflow, sto ttarg # repeat ldm ttchar jump ttdd3 # until it does. # Underflow -- TTCHAR is number of decades. # Output the value in TTARG as a decimal character, # but suppressing leading zeroes as indicated. This returns # according to previously-set ttddr2. ttdd5: ldm ttchar # decimal value, or 0 # (test it) ldm ttzchr # output left-fill char snz jump ttdd6a # if leading zero ld '0 # non-zero value, sto ttzchr # clear zero-suppress ldm ttchar ld digtbl # ptr to decimal characters, addm ttchar # index it, sta ttdd6 ttdd6: ldm POINTER # fetch the character, ttdd6a: sto ttchar ldm ttddr2 # where we return to... jump ttyo # output character ttdd7: ldm ttdd1 # ... here during loop. add 1 # advance divisor table ptr jump ttdd0 # loop. track 4 sector 0 # Output ttarg as an octal number. ttyoox: sta ttoor ldm minus6 # oct digits in word, sto ttopt ldm ttarg # get passed value, ttoo1: rlc # shift MSB into Cy, rlc # rotate MS octal digit sto ttarg # because carry gets lost rlc # to LS bits rlc and 7 add digtbl # ptr into digit table, sta ttoo2 ttoo2: ldm POINTER # load digit sto ttchar # setup for call ttyo ld ttoo3 jump ttyo # print digit, ttoo3: ldm ttopt add 1 snz # exit after 6 digits ttoor: jump RETURN sto ttopt ldm ttarg rlc jump ttoo1 # ---------------------------------------------------------------- # END of library, start of test code. track 10 sector 0 t1: text / TIMES / t2: text / IS / t3: text 4, 8, 2 t4: text /, OCTAL / t5: text / OVERFLOW!/, 4, 8 n: 17 m: 3 i: -10 tx1: text /OK, SO HOW DOES THIS GO? IT IS PROBABLY/, 2, 8, /STILL VERY, VERY SLOW./, 2, 8 track 11 sector 0 # test code test: ldm n sto mcand # multiply this sto ttarg and 0 sto errno sto zschar # suppress leading 0's lda C+2 jump ttyodx # print m'cand test2: ld t1 sto ttchar lda C+2 jump ttyosx # print " times " ldm m sto mper # by this sto ttarg lda C+2 jump ttyodx # print m'per ld t2 sto ttchar lda C+2 # "equals" jump ttyosx lda C+2 jump multUDx # multiply ldm errno # check for o'flow or 0 snz jump mzzz1 ld t5 # OVERFLOW ERROR! sto ttchar lda done jump ttyosx mzzz1: ldm MQ sto ttarg lda C+2 jump ttyodx # print m'per ld t4 sto ttchar # print "octal" lda C+2 jump ttyosx ldm MQ sto ttarg lda C+2 jump ttyoox # print octal ld t3 sto ttchar # print CR, LF lda C+2 jump ttyosx ldm n add 17 snc done: halt 1 sto n jump test2 track 11 sector 0 tex: ld tx1 sto ttchar ld tex2 jump ttyosx tex2: halt 0 # ---------------------------------------------------------------