Převod římských čísel na arabská a naopak - Saturn@HP-50g
Předmluva | ↑ ↓ |
Tento zápis je smutným pokračováním tématického odklonu od výchozí mánie - RPN. O této hanebnosti jsou zmínky v kapitolách předchozích témat, leč snaha po nápravě žádná. Patrně došlo k situaci, kterou lze komentovat slavným citátem „Můžeme o tom diskutovat, můžeme o tom vést spory, můžeme s tím i nesouhlasit, ale to je tak všechno, co se proti tomu dá dělat...“ A k jaké to vlastně došlo nepřístojnosti? Že nepůjde o RPN už víme. Nepůjde však ani o RPL, ba ani na jazyk C nebude zaostřeno. Předmětem zájmu je zde poklesek na nízkou, ale opravdu velmi, velmi nízkou úroveň. No učiněná Sodoma Gomora, radši o tom, paní, nikde nemluvte, taková hanba... (Scénická poznámka: Odcházející sousedka za neustálého bědování lomí rukama.)
Zde prezentovaný program je v assembleru pro procesor Saturn. Aby bylo možno jeho stavbu porovnat s řešením v jiných programovacích jazycích, jde opět o osvědčený Převod římských čísel na arabská a naopak. (Že výběr "osvědčeného" tématu je zde pouze zástupným pojmenováním pro nedostatečnou tvůrčí invenci, je více než patrné. Chlapské přiznání však laskavý čtenář očekává marně.)
Zdrojový text | ↑ ↓ |
Zde je zdrojový text programu pro Saturn - soubor roman.a. Komentáře k němu až později.
1 %%HP: T(3)A(R)F(.); 2 "CODE 3 NB4BT EQU 2 nibbles per 1 byte 4 MAXRO EQU 15 nejdelsi je MMMDCCCLXXXVIII 5 6 *===============================* 7 * VSTUPNI BOD * 8 *===============================* 9 C=DAT1 A C(A): adresa objektu na RPL-stacku 10 ?C#0 A je platna? 11 GOYES RO_ARG - ano, pokracovat 12 LA(5) #201 - ne, chybove hlaseni *Too Few Arguments* 13 RO_ERROR 14 GOVLNG =Errjmp 15 RO_ERROR_VAL 16 GOSBVL =GETPTR 17 LA(5) =argvalerr chybove hlaseni *Bad Argument Value* 18 GOTO RO_ERROR 19 20 *===============================* 21 * NA STACKU JE ARGUMENT * 22 *===============================* 23 RO_ARG 24 CD1EX D1: adresa objektu 25 A=DAT1 A A(A): prolog 26 D1=C D1: adresa objektu vracena 27 LC(5) =DOINT 28 ?A=C A je to ZINT? 29 GOYES RO_A2R - ano 30 LC(5) =DOCSTR 31 ?A#C A je to STRING? 32 GOYES + - ne 33 GOTO RO_R2A - ano 34 + 35 LA(5) =argtypeerr chybove hlaseni *Bad Argument Type* 36 GOTO RO_ERROR 37 38 *===============================* 39 * JE TO CISLO * 40 *===============================* 41 * R0(A): docasna pamet pro vysledek 42 * R1(A): pointer na cifry (vychozi D1) 43 * R2(A): index aktualni cifry (dekadicky rad) 44 * R3(A): pointer na tabulku rimskych cislic sromt[] 45 * B(A): index do tabulky sromt[] 46 * 47 D1SROMT MACRO 48 C=R3.F A C(A): sromt[] 49 C=C+B A B(A): index podle dekadickeho radu 50 D1=C D1: sromt[] + index 51 D1SROMT ENDM 52 * 53 RO_A2R 54 GOSUB RO_START 55 * D1: pointer na cifry 56 * C(A): pocet cifer 57 C=C-1 A pouze nula ma jen jeden nibble 58 ?C=0 A je to nula? 59 GOYES RO_ERROR_VAL - ano 60 AD1EX A(A): adresa hodnoty 61 A=A+C A A(A): adresa posledniho nibble... 62 D1=A D1: ...tam kam patri 63 A=DAT1 P A(0): znamenko 64 ?A#0 P je to minus? 65 GOYES RO_ERROR_VAL - ano 66 C=C-CON A,5 moc velky pocet znaku? 67 GONC RO_ERROR_VAL - ano 68 D1=D1- 1 D1: pointer na prvni cifru (MSD) 69 C=C+1 A ctyrmistne cislo? (C=C-5+1 -> C=C-1) 70 GONC + - ne, bez kontroly 71 A=DAT1 P A(0): prvni cifra 72 A=A-CON P,4 hodnota > 3999? 73 GONC RO_ERROR_VAL - ano 74 + 75 C=C+CON A,3 C(A): pocet cifer - 1 76 R2=C.F A R2(A): index prvni cifry (MSD) 77 LC(5) (MAXRO)*(NB4BT) 78 GOSUB RO_A2R_MEM 79 AD0EX A(A): docasna pamet pro vysledek 80 R0=A.F A 81 AD0EX 82 C=R2.F A C(A): index prvni cifry (MSD) 83 C=C+C A viz. NB4BT 84 C=C+C A 2 rimske cislice na kazdy dekadicky rad 85 B=C A B(A): index do tabulky sromt[] 86 GOSUB RO_SROMT R3(A): sromt[] 87 *-------------------------------* 88 * ZPRACOVANI JEDNE CIFRY * 89 *-------------------------------* 90 RO_A2R_LOOP 91 A=DAT1 P A(0): cifra 92 AD1EX 93 R1=A.F A R1(A): pointer na cifry 94 AD1EX A(0): cifra 95 LC(1) 4 96 ?A=C P je to 4? 97 GOYES RO_A2R_4_9 - ano 98 LC(1) 9 99 ?A#C P je to 9? 100 GOYES RO_A2R_REST0 - ne 101 RO_A2R_4_9 102 D1SROMT 103 C=DAT1 B z sromt[]... 104 DAT0=C B ...do vysledku 105 D0=D0+ NB4BT dalsi znak ve vysledku 106 D1=D1+ NB4BT dalsi znak v sromt[] 107 A=A+A P byla to 9? 108 GONC + - ne 109 D1=D1+ NB4BT - ano, dalsi znak v sromt[] 110 + 111 C=DAT1 B z sromt[]... 112 DAT0=C B ...do vysledku 113 D0=D0+ NB4BT dalsi znaku ve vysledku 114 GOTO RO_A2R_CONT 115 RO_A2R_REST1 116 D1SROMT 117 LC(1) 5 118 ?A<C P cifra < 5? 119 GOYES + - ano 120 D1=D1+ NB4BT - ne, dalsi znak v sromt[] 121 A=A-CON P,5-1 cifra -= 5 - 1; 122 + 123 C=DAT1 B z sromt[]... 124 DAT0=C B ...do vysledku 125 D0=D0+ NB4BT dalsi znak ve vysledku 126 A=A-1 P v cele iteraci odecteno 5 127 RO_A2R_REST0 128 ?A#0 P nenulova cifra na dekadickem radu? 129 GOYES RO_A2R_REST1 - ano 130 RO_A2R_CONT 131 A=R1.F A A(A): pointer na cifry... 132 A=A-1 A ...aktualizovat... 133 D1=A ...a dat tam, kam patri 134 B=B-CON A,2*NB4BT index -= 2; 135 C=R2.F P C(A): index aktualni cifry 136 C=C-1 P hotovo? 137 R2=C.F P 138 GOC + - ano 139 GOTO RO_A2R_LOOP - jeste ne 140 + 141 *-------------------------------* 142 * ULOZIT RETEZEC DO NOVEHO OBJ. * 143 *-------------------------------* 144 A=R0.F A A(A): adresa vysledku 145 CD0EX C(A): konec ukladani vysledku 146 C=C-A A delka retezce vysledku (nibble) 147 D1=A D1: pointer na vysledek 148 GOSUB RO_A2R_MEM D0: pointer na data noveho objektu 149 CD0EX C(A): pointer na pridelenou pamet 150 R0=C.F A uschovano v R0 151 CD0EX 152 C=C-1 A bude se testovat CARRY, ne ZERO 153 RO_A2R_MOVE 154 A=DAT1 B byte z vysledku... 155 DAT0=A B ...do noveho objektu 156 D0=D0+ NB4BT 157 D1=D1+ NB4BT 158 C=C-1 A hotovo? 159 GONC RO_A2R_MOVE - jeste ne 160 C=R0.F A C(A): pointer na pridelenou pamet 161 C=C-CON A,5+5 zpet pred prolog a delku 162 R0=C.F A 163 *===============================* 164 * HOTOVO * 165 *===============================* 166 RO_DONE 167 GOSBVL =GETPTR 168 C=R0.F A 169 DAT1=C A vysledny novy objekt 170 * LOOP 171 A=DAT0 A 172 D0=D0+ 5 173 PC=(A) 174 175 *===============================* 176 * NOVY RETEZEC - ALOKACE PAMETI * 177 *===============================* 178 * VSTUP: C(A): mnoztvi pameti [nibble] 179 * VYSTUP: D0: pointer na pridelenou pamet 180 * C(A): delka retezce [byte] 181 * ZMENY: A,R0,R1 182 RO_A2R_MEM 183 AD1EX uschovat D1... 184 R1=A.F A ...do R1 185 R0=C.F A R0(A): delka retezce [nibble] 186 C=C+CON A,5+5 mnozstvi pameti vcetne prologu a delky 187 GOSBVL =GETTEMP 188 LC(5) =DOCSTR 189 DAT0=C A prolog 190 D0=D0+ 5 preskocit prolog 191 C=R0.F A C(A): delka retezce [nibble] 192 C=C+CON A,5 hodnota je vcetne pole delky 193 DAT0=C A delka 194 D0=D0+ 5 preskocit delku na zacatek objektu 195 C=R0.F A 196 CSRB.F A # nibble -> byte 197 A=R1.F A z R1... 198 D1=A ...obnovit D1 199 RTN 200 201 *===============================* 202 * JE TO RETEZEC * 203 *===============================* 204 * R0(A): _IDX 205 * R1(0): _INC (1 nebo 5) 206 * R2(A): delka zadani (uschova C) 207 * R3(A): pointer na tabulku rimskych cislic sromt[] 208 * R4(A): pocet stejnych nebo mensich predchozich rimskych cislic 209 * D(0): prechozi _IDX 210 * D0: pointer na addt[] + subt[] 211 * D1: pointer na znaky (zadani) 212 * 213 C2ORD MICRO CSRB.F P C(A): _ORD 214 * 215 RO_R2A 216 GOSUB RO_START 217 CSRB.F A # nibble -> byte 218 * D1: pointer na znaky 219 * C(A): pocet znaku 220 C=C-1 A 221 LA(5) MAXRO 222 ?C>=A A prilis dlouhe nebo kratke zadani? 223 GOYES RO_R2A_ERROR 224 R2=C.F A R2(A): pocet znaku 225 GOSUB RO_SROMT R3(A): sromt[] 226 LC(5) 2*5 C(A): delka addt[] + subt[] 227 GOSUB RO_A2R_MEM D0: pointer na addt[] + subt[] 228 * 229 C=0 A Vynulovat: 230 R4=C A - pocet stejnych nebo mensich 231 DAT0=C A - addt[] 232 D0=D0+ 5 233 DAT0=C A - subt[] 234 D0=D0- 5 D0: pointer na addt[] + subt[] 235 * 236 C=C-1 A C(A): 0xFFFFF 237 D=C A D(0): prechozi _IDX 238 *-------------------------------* 239 * ZPRACOVANI JEDNOHO ZNAKU * 240 *-------------------------------* 241 RO_R2A_LOOP 242 AD0EX A(A): pointer na addt[] + subt[] 243 C=R3.F A 244 D0=C D0: sromt[] 245 C=DAT1 B 246 B=C B B(B): znak ze zadani 247 D0=D0- NB4BT 248 - 249 D0=D0+ NB4BT dalsi znak v sromt[] 250 C=DAT0 B C(B): znak z tabulky sromt[] 251 ?C#0 B tabulka pokracuje? 252 GOYES + - ano 253 RO_R2A_ERROR 254 GOTO RO_ERROR_VAL 255 + 256 ?C#B B znaky zadani:tabulka jsou ruzne? 257 GOYES - - ano 258 AD0EX D0: pointer na addt[] + subt[] 259 * A(A): adresa nalezu v sromt[] 260 C=R3.F A C(A): sromt[] 261 A=A-C A A(A): rozdil pointeru 262 ASRB.F A # nibble -> byte == _IDX 263 R0=A.F A R0(A): _IDX 264 LC(1) #1 maska 265 A=A&C P A(0): _WHT 266 A=A+A P 267 A=A+A P A(0): _WHT << 2 268 A=A+1 P 269 R1=A.F P R1(0): _INC 270 * 271 A=0 A A(A): smask 272 C=R0.F A C(A): _IDX 273 ?C<D A aktualni _IDX >= prechozi _IDX? 274 GOYES + - ne, smask: 0 275 A=A-1 A - ano, smask: -1 276 + 277 C=R4 A C(A): less 278 C=C-A A C(A): less - smask 279 C=C&A A C(A): less - smask & smask 280 R4=C A R4(A): nova hodnota less 281 C=C-CON A,3 less > 3? 282 GONC RO_R2A_ERROR - ano 283 * 284 C=R0.F A C(A): _IDX 285 ?C<=D A aktualni _IDX <= prechozi _IDX 286 GOYES RO_R2A_SUMM - ano 287 *-------------------------------* 288 * AKTUALNI > PREDCHOZI * 289 *-------------------------------* 290 C=R4 A C(A): less 291 C=C-CON A,2 less >= 2? 292 GONC RO_R2A_ERROR - ano 293 * 294 C=D A C(A): prechozi _IDX 295 C2ORD C(A): _ORD 296 AD0EX 297 D0=A A(A): addt[] 298 A=A+C A A(A): addt[] + _ORD 299 AD0EX A(A): addt[] 300 C=DAT0 P D0: addt[] + _ORD 301 B=C P B(0): addt[_ORD] 302 C=0 P 303 DAT0=C P addt[_ORD] = 0 304 D0=D0+ 5 D0: subt[] + _ORD 305 C=B P C(0): addt[_ORD] 306 DAT0=C P subt[_ORD] = addt[_ORD] 307 AD0EX D0: addt[] 308 C=R0.F A C(A): _IDX 309 *-------------------------------* 310 * PRICTENI AKTUALNI HODNOTY * 311 *-------------------------------* 312 RO_R2A_SUMM 313 D=C A D(A): nove prechozi _IDX 314 C2ORD C(A): _ORD 315 AD0EX 316 D0=A A(A): addt[] 317 A=A+C A A(A): addt[] + _ORD 318 AD0EX D0: addt[] + _ORD 319 C=DAT0 P 320 B=C P C(0): addt[_ORD] 321 C=R1.F P 322 C=C+B P C(0): addt[_ORD] + _INC 323 DAT0=C P 324 AD0EX D0: pointer na addt[] + subt[] 325 C=C+CON P,6 prirustek stejneho radu v norme? 326 GONC + - ano 327 GOTO RO_R2A_ERROR 328 + 329 C=R2.F A C(A): zbyvajici pocet znaku 330 C=C-1 A jeste nejake znaky ze zadani? 331 GOC + - ne, hotovo 332 R2=C.F A 333 D1=D1+ NB4BT dalsi znak ze zadani 334 GOTO RO_R2A_LOOP - ano, pokracovat 335 + 336 *-------------------------------* 337 * VYSLEDEK A JEHO DELKA * 338 *-------------------------------* 339 A=DAT0 A cely obsah addt[] 340 D0=D0+ 5 341 C=DAT0 A cely obsah subt[] 342 SETDEC 343 A=A-C A A(A): vysledek! 344 SETHEX 345 LC(5) #10000 346 B=C A 347 LC(5) 5 348 - 349 BSR A 350 C=C-1 P 351 ?A<B A je cislo mensi? 352 GOYES - - ano 353 R2=C.F A R2(A): delka - 1 354 R3=A.F A R3(A): hodnota 355 *-------------------------------* 356 * ULOZIT RETEZEC DO NOVEHO OBJ. * 357 *-------------------------------* 358 C=C+CON A,5+5+1 mnozstvi pameti vcetne prologu a delky 359 GOSBVL =GETTEMP 360 CD0EX 361 D0=C 362 R0=C.F A R0(A): pointer na novy objekt 363 LC(5) =DOINT 364 DAT0=C A prolog 365 D0=D0+ 5 preskocit prolog 366 C=R2.F A C(A): delka - 1 367 C=C+CON A,5+1 hodnota je vcetne pole delky 368 DAT0=C A delka 369 D0=D0+ 5 preskocit delku na zacatek objektu 370 C=R2.F A C(A): delka - 1 371 A=R3.F A A(A): hodnota 372 - 373 DAT0=A P cifra ulozena 374 D0=D0+ 1 pointer na dalsi cifru 375 ASR A A(P): dalsi cifra 376 C=C-1 P hotovo? 377 GONC - - ne, dalsi 378 GOTO RO_DONE 379 380 *===============================* 381 * START: ADRESA+DELKA OBJEKTU * 382 *===============================* 383 * VSTUP: D1: pointer na prvni uroven RPL-stacku 384 * VYSTUP: D1: zacatek objektu (za prologem a delkou) 385 * C(A): delka objektu [nibble] 386 * ZMENY: N/A 387 RO_START 388 GOSBVL =SAVPTR 389 C=DAT1 A 390 D1=C D1: adresa objektu na RPL-stacku 391 D1=D1+ 5 preskocit prolog 392 C=DAT1 A C: delka... 393 C=C-CON A,5 ...bez velikosti pole delky 394 D1=D1+ 5 preskocit delku na zacatek objektu 395 RTN 396 397 *===============================* 398 * TABULKA RIMSKYCH CISLIC * 399 *===============================* 400 * VSTUP: N/A 401 * VYSTUP: R3(A): pointer na tabulku 402 * ZMENY: C(A) 403 RO_SROMT 404 GOSUB + 405 CON(2) 'I' 406 CON(2) 'V' 407 CON(2) 'X' 408 CON(2) 'L' 409 CON(2) 'C' 410 CON(2) 'D' 411 CON(2) 'M' 412 CON(2) 0 konec tabulky 413 + 414 C=RSTK 415 R3=C.F A 416 RTN 417 ENDCODE"
Každému je hned na první pohled jasné, že zdrojový text roman.a není pouhou transkripcí modulu roman.c do jazyka symbolických adres procesoru Saturn. Pro ty, kterým to na první pohled jasné není, je tu nápověda: v celém programu se ani v nejmenším nevyskytuje násobení dvou proměnných, natož dělení! Těmto operacím se díky vlastnostem Saturnovým dalo vtipně vyhnout.
Dalším zcela zřejmým rozdílem je jiný přístup v řešení převodu římských čísel na arabská. Je to sice okaté, ale kdyby náhodou někdo tápal, budiž mu pomůckou obsah následující kapitoly. V té je zobrazen modul r2a2.c (pozor, neplést s R2-D2 :-), který nový postup ukazuje. Související indicií je absence tabulky svalt[]. Prostě, dělá se to jinak, tak to jde i bez ní.
Pozn.: Operandy, které program zpracovává, mají různou bitovou šíři. BCD cifra zabere 4 bity (tj. 1 nibble), znak textového řetězce "měří" 1 bajt (2 nibbles), ... Největší šířka operandu nepřekročí 20 bitů (tedy 5 nibbles).
Převod R→A trochu jinak | ↑ ↓ |
Modul r2a2.c, jehož výpis následuje, není určen pro samostatný překlad. Obě obsažené funkce (r2a2() i r2a2_value()) mají třídu uložení static. Při potřebě vyzkoušet kód modulu r2a2.c je třeba vložit jeho obsah do zdrojového textu roman.c a v jeho funkci operate() změnit volání funkce r2a() na r2a2(). To ale nikdo dělat nebude, pročež následující výpis má poslání toliko ilustrativní.
1 /*============================================================================*\ 2 RIMSKE --> ARABSKE 3 \*============================================================================*/ 4 5 6 #define R2A2_ORDER 4 // nejvyse 4 dekadicke rady 7 #define R2A2_MAXORD 1000 // 10 ^ R2A2_ORDER 8 9 10 11 /* 12 * SESTAVENI HODNOTY Z POLE CIFER 13 */ 14 15 static int r2a2_value(int const valt[]) 16 { 17 int order, 18 value; 19 20 for(order = 1, value = 0; order <= R2A2_MAXORD; order *= 10, ++valt) 21 value += valt[0] * order; 22 return(value); 23 } 24 25 26 27 /* 28 * VSTUPNI BOD 29 */ 30 31 static void r2a2(char const *valup) 32 { 33 #define THIS_ORD(i) ((i) >> 1) 34 #define THIS_WHT(i) ((i) & 001) 35 #define THIS_INC(i) (THIS_WHT(i) << 2 | 001) 36 37 int pidx, 38 less; 39 int addt[R2A2_ORDER], 40 subt[R2A2_ORDER]; 41 42 for(pidx = 0; pidx < R2A2_ORDER; ++pidx) 43 { 44 addt[pidx] = 0; 45 subt[pidx] = 0; 46 } 47 pidx = sizeof(sromt) / sizeof(*sromt) - 1; 48 less = 0; 49 do 50 { 51 int aidx; 52 char const *fndp; 53 54 if((fndp = strchr(sromt, toupper(*valup))) == NULL) 55 { 56 fprintf(stderr, "Unknown Digit: %s\n", valup); 57 return; 58 } 59 aidx = fndp - sromt; 60 do 61 { 62 #ifdef HAVE_CONDITION 63 less = aidx < pidx ? 0 : less + 1; 64 #else 65 int smask; 66 67 smask = -(aidx >= pidx); 68 less = less - smask & smask; 69 #endif 70 if(less <= 3) 71 { 72 if(aidx <= pidx) 73 break; 74 if(less <= 1) 75 { 76 pidx = THIS_ORD(pidx); 77 subt[pidx] = addt[pidx]; 78 addt[pidx] = 0; 79 break; 80 } 81 } 82 fprintf(stderr, "Unexpected Digit: %s\n", valup); 83 return; 84 } while(0); 85 pidx = aidx; 86 if((addt[THIS_ORD(aidx)] += THIS_INC(aidx)) > 9) 87 { 88 fprintf(stderr, "Too much Digits: %s\n", valup); 89 return; 90 } 91 } while(*++valup != '\0'); 92 printf("%d\n", r2a2_value(addt) - r2a2_value(subt)); 93 94 #undef THIS_ORD 95 #undef THIS_WHT 96 #undef THIS_INC 97 } 98 99 #undef R2A2_ORDER 100 #undef R2A2_MAXORD
Obsah modulu r2a2.c je snadno srozumitelný, přesto stojí za to se u některých detailů pozastavit.
| CIFRA | I N D E X | inc | Vztahy mezy hodnotami | |||
|---|---|---|---|---|---|---|
| idx | ord | wht | I | 0 | 000 | 0 | 0 | 1 |
idx = ord << 1 | wht; ord = idx >> 1; wht = idx & 001; inc = wht << 2 | 001; inc = (idx & 001) << 2 | 001; |
V | 1 | 001 | 0 | 1 | 5 | X | 2 | 010 | 1 | 0 | 1 | L | 3 | 011 | 1 | 1 | 5 | C | 4 | 100 | 2 | 0 | 1 | D | 5 | 101 | 2 | 1 | 5 | M | 6 | 110 | 3 | 0 | 1 |
Závěr | ↑ ↓ |
Jedno z předchozích řešení převodu mezi čísly římskými a arabskými je v jazyku C přímo pro srdce HP-50g, tedy procesor ARM9. Vyznačuje se těmito vlatnostmi:
Jaké je tedy resumé? Je to nenahraditelná zkušenost. A to i navzdory faktu, že Saturn se od roku 2003 nevyrábí a mimo sféru kalkulátorů by těžko hledal použití. Rozhodně to stálo za to, protože „Kdo nezkusil zkrotit Saturna, ví kulový o tom, jak se píše firmware pro pořádnou kalkulajdu“. Přesto se silně nedoporučuje preferovat tento styl programování. Vynaložené úsilí totiž naprosto neodpovídá dosaženému výsledku. Ale frajeřina je to ukrutná :-)
Pokud se někdo (nehledě na uvedené přitěžující okolnosti) cítí touto problematikou býti osloven, je zde pár drobtů ke stažení.
| Zdrojové texty | Binární kód | Vše naráz | |
|---|---|---|---|
| roman.c | Výchozí zdrojový text v jazyku C | ROMANSAT | romansat.tar |
| r2a2.c | Zdrojový text v jazyku C - modifikovaná funkce pro převod R→A | ||
| roman.a | Zdrojový text v assembleru pro procesor Saturn | ||