#================================================
#                 BAZOVE ADRESY
#================================================
$$L. 0          # navesti (Label)
$$R. 0          # registru (Register)

#================================================
#                 TADY TO ZACINA
#================================================
#         PROCENTUALNI VYJADRENI POCTU
#   BITU S HODNOTOU "1" V DANEM BITOVEM ROZAHU
#================================================
# REGY: bitovy rozsah
# REGX: zpracovavana hodnota
uns
wide d
sto $R.VALUE    # uschovat vstupni hodnotu
clx             # potlacit "stack-lift"
1               # 1 posunuta doleva o...
x<>y            # ...celkovy pocet bitu...
sln             # ...da nejvyssi bit. pozici masky
1               # po odecteni 1...
-               # ...je maska hotova
x== 0           # je-li nulova
-1              # plati vsechny bity
sto $R.BITS     # uschovat masku
xeq $L.BITNUM   # skutecny pocet bitu...
pse             # ...zobrazit,...
x<> $R.BITS     # ...ulozit a vyzvednout masku
rcl $R.VALUE    # vstupni hodnotu...
and             # ...maskovat
xeq $L.BITNUM   # spocitat...
pse             # ...a zobrazit pocet bitu hodnoty
rcl $R.BITS     # pocty bitu masky...
x<>y            # ...a hodnoty do spravnych registru
gto $L.PERCENT  # spocitat procentualni podil

#================================================
#              ZJISTENI POCTU BITU
#================================================
# REGX: zpracovavana hodnota
lbl $L.BITNUM
0               # vynulovat pocitadlo bitu...
sto $R.BITNUM_SUMM
rdn             # zpracovavana hodnota...
#------------------------------------------------
#             HLAVNI SMYCKA VYPOCTU
#------------------------------------------------
lbl $L.BITNUM_LOOP
x== 0           # ...je nulova?
gto $L.BITNUM_DONE
                # ano, konec vypoctu
1               # maska nejnizziho bitu
x<>y
and             # je-li tam 1, pricte se
sto+ $R.BITNUM_SUMM
lastx           # v zadane hodnote...
sr              # ...nastaven dalsi bit pro test
gto $L.BITNUM_LOOP
#------------------------------------------------
#          NAVRAT S VYSLEDNOU HODNOTOU
#------------------------------------------------
lbl $L.BITNUM_DONE
rcl $R.BITNUM_SUMM
rtn

#================================================
#                 POCET PROCENT
#================================================
# REGY: zaklad
# REGX: castka
lbl $L.PERCENT
x== 0           # castka je nulova?
rtn             # ano
1000
*               # castka * 1000
x<>y            # zaklad
/               # mezivysledek: promile
5               # ekvivalent hodnoty 0.5
+               # pricist pro zaokrouhleni
10              # (z 5 deleni 10 udela 0.5)
/
rtn