17.31. ICVOLNY Funkce: Podprogram ICVOLNY zpracuje numerický literál umístěný znakově (ve zdrojovém formátu) v zadané vysílající položce a přesune jej do zadané příjmové numerické položky. Způsob volání: CALL 'ICVOLNY' USING vysílající příjmová indikátor Pravidla: Prvním argumentem je vysílající položka, která smí mít libovolný typ (rozumný smysl má ovšem pouze položka alfanumerická nebo skupinová) a jejíž délka (jež smí být i proměnná) musí být kladná a nejvýše rovná 32767 bytů. Tato vysílající položka musí v okamžiku volání podprogramu ICVOLNY obsahovat znakově zapsaný numerický literál v obvyklém zdrojovém cobolském tvaru; jsou přípustné všechny zápisy přípustné ve zdrojovém cobolském programu (viz 1.3.1.), navíc je přípustná i desetinná tečka na konci numerického literálu (např. 325.), formát s E resp. e bez desetinné tečky (např. 12E5 nebo 12e-5), i větší počet cifer exponentu než dvě (např. 7E125), přičemž celkový počet cifer není omezen. I v případě uvedení klauzule DECIMAL-POINT IS COMMA je nutno používat desetinnou tečku a nikoliv desetinnou čárku. Numerický literál smí být ve vysílající položce umístěn odleva nebo odprava nebo kdekoliv uprostřed, přičemž případně zbylé byty vysílající položky musí být všechny mezerové (mezera se ovšem nesmí vyskytnout uvnitř numerického literálu). Druhým argumentem je příjmová položka; smí to být numerická položka libovolného typu. Podprogram ICVOLNY získá numerickou hodnotu numerického literálu umístěného ve vysílající položce a přesune ji numericky (dle pravidel příkazu MOVE) do příjmové položky. Třetím argumentem by měla být položka s PIC X nebo PIC 9 (teoreticky jakýkoliv argument představující adresu, naplňuje se pouze jeho první byte). Do této položky uloží podprogram ICVOLNY znakovou cifru indikující úspěšnost akce: '0' ... vysílající položka obsahovala přípustný numerický literál, při jehož přesunu do příjmové položky nebylo nutno odřezávat nenulové cifry vpředu ani vzadu ani ignorovat znaménko - u literálu (z důvodu neexistence příznaku znaménka v PICTURE příjmové položky); nevadí ovšem odřezávání nulových cifer ani znaménka + '1' ... numerický literál byl sice přípustný, avšak při jeho přesunu do příjmové položky bylo třeba odřezat nenulové cifry vzadu (za desetinnou tečkou) '2' ... numerický literál byl sice přípustný, avšak při jeho přesunu do příjmové položky bylo třeba odřezat nenulové cifry vpředu (před desetinnou tečkou) '3' ... byly odřezány nenulové cifry vpředu i vzadu '4' ... numerický literál byl sice přípustný, měl však uvedeno znaménko -, zatímco příjmová položka nemá v PICTURE žádný příznak znaménka (S,+,-,CR,DB); znaménko - se ignoruje a přesunuje se absolutní hodnota uvedeného literálu '5' ... byly odřezány nenulové cifry vzadu a znaménko - '6' ... byly odřezány nenulové cifry vpředu a znaménko - '7' ... byly odřezány nenulové cifry vpředu i vzadu a znaménko - '9' ... vysílající položka neobsahuje numerický literál doplněný mezerami (nekladná délka, samé mezery, nepřípustný znak, ani jedna cifra v mantise, za E resp. e není přípustný exponent, exponent > 730, literál je rozdělen mezerou nebo zbytek položky za literálem neobsahuje pouze mezery); dosavadní obsah příjmové položky zůstane nezměněn Je-li příjmová položka exponenciální (dlouhá, krátká nebo znaková), může být do položky "indikátor" dosazena pouze hodnota '0' nebo '9'; odřezávání nenulových cifer vpředu ani znaménka - zde nemůže nastat a přebytek nenulových cifer za tečkou (které již nemohou ovlivnit výslednou hodnotu položky) se neindikuje. Maximální hodnota, která může být uložena do exponenciální krátké nebo dlouhé položky, je počítačově závislá; účinek překročení této maximální hodnoty je rovněž počítačově závislý a může způsobit nesprávný výsledek nebo i havárii výpočtu. Poznámky: 1) Obsah vysílající položky se nemění (samozřejmě s výjimkou případu, že se vysílající a příjmová položka překrývají, což je přípustné a nenaruší funkci podprogramu ICVOLNY). 2) Podprogram ICVOLNY je výhodný v případě, že vysílající položka byla naplněna příkazem ACCEPT nebo READ (případně CALL) čtoucím z terminálu nebo jiného média, jehož obsah vytvořil člověk a ne počítač. Umožňuje operátorovi zapisovat numerické literály v tzv. "volném formátu". Podprogram ICVOLNY ovšem sám z média nečte; uživatel musí vysílající položku naplnit již před vyvoláním ICVOLNY. 3) Příkaz CALL 'ICVOLNY' je překládán voláním podpůrného podprogramu icbvoldi nebo icbvoled; žádný podprogram se jménem ICVOLNY neexistuje a není dodáván. Příklad: 77 VYSIL PIC X(80). 77 PRIJM PIC 9999V99 COMP. 77 INDIK PIC X. : ZNOVU. MOVE SPACE TO VYSIL. &příkaz ACCEPT nedoplní mezery! DISPLAY 'NAPIS NUMERICKY LITERAL' UPON CONSOLE. ACCEPT VYSIL FROM CONSOLE. CALL 'ICVOLNY' USING VYSIL PRIJM INDIK. IF INDIK NOT= '0' DISPLAY 'CHYBNY ZAPIS' UPON CONSOLE GO ZNOVU. : &zpracování položky PRIJM Operátor smí napsat např. 5, 1.2, 1234.56, 56E2, .7E4, 1e002, 700E-4, +0001234.56000 apod., a to od začátku řádku nebo po několika mezerách. Pokud by operátor hned stiskl klávesu ENTER (CR) nebo zapsal samé mezery, 1 234, 12C, 123-, 1E2.0, 1,234.56, +, 1.2E, 1.2E+, +.E2, 1E4, 1.E4, 0.009, -1 apod., obsah položky PRIJM zůstane nezměněn a podprogram ICVOLNY uloží do položky INDIK jiný znak než '0'. Kdyby chtěl programátor připustit nadbytečné cifry za desetinnou tečkou, psal by "IF INDIK > '1' ...", pak by např. při zápisu 2.789 byla do příjmové položky uložena "seříznutá" hodnota 2.78 (nezaokrouhluje se). Příklad: V 80-bytové položce STITEK je načten text obsahující několik (1-50) numerických literálů oddělených čárkami; zbytek položky STITEK za posledním literálem je mezerový. Máme tyto literály přesunout do položek A(1),..., A(N), přičemž speciální index N máme nastavit na pořadí rovné počtu literálů. (Dvěma bezprostředně za sebou následujícím čárkám má odpovídat hodnota 0.) 77 STITEK PIC X(80). &např. 5,-3.26,67.2E4,-76 a mezery 01. 02 A PIC S9(7)V99 COMP OCCURS 50 INDEXED N. 77 P PIC S9(4) COMP VALUE 1. &POINTER pro příkaz UNSTRING 77 C PIC S9(4) COMP. &COUNT pro příkaz UNSTRING 77 POM1 PIC X(80). &pro UNSTRING pevná délka = 80 01 POM2 REDEFINES POM1. &pro ICVOLNY proměnná délka = C 02 PIC X OCCURS 80 DEPENDING C. 77 INDIK PIC X. : SET N TO 1. Q1. UNSTRING STITEK DELIMITED ',' OR ALL SPACE INTO POM1 COUNT C POINTER P. IF C = 0 MOVE 0 TO A(N) ELSE CALL 'ICVOLNY' USING POM2 A(N) INDIK IF INDIK NOT= '0' GO CHYBA. IF P < 81 IF N < 50 SET N UP 1 GO Q1 ELSE GO CHYBA. Naši úlohu lze vyřešit i bez použití příkazu UNSTRING: 77 STITEK PIC X(80). 01. 02 A PIC S9(7)V99 COMP OCCURS 50 INDEXED N. 77 Z PIC S9(4) COMP. &délka zbytku STITEK bez závěreč.mezer 77 INDIK PIC X. : LINKAGE SECTION. 01 ZBYTEK. 02 PIC X OCCURS 80 DEPENDING Z. &zbytek bez mezer 01 USEK REDEFINES ZBYTEK. 02 PIC X OCCURS 80 DEPENDING TALLY. &po nejbližší čárku : SET N TO 1. EXAMINE STITEK TALLYING ENDING SPACE. &TALLY=počet mezer COMPUTE Z = 80 - TALLY. &Z=délka textu bez závěr.mezer CALL 'ICIDENT' USING ZBYTEK STITEK. &ZBYTEK=STITEK bez m. Q1. EXAMINE ZBYTEK TALLYING UNTIL FIRST ','. &TALLY = počet &znaků před nejbližší čárkou resp. až do konce textu IF TALLY = 0 MOVE 0 TO A(N) &dvě čárky za sebou ELSE CALL 'ICVOLNY' USING USEK A(N) INDIK IF INDIK NOT= '0' GO CHYBA. IF TALLY < Z ADD 1 TO TALLY &TALLY=délka úseku i s čárkou CALL 'ICIDENT' USING ZBYTEK ZBYTEK TALLY &ZBYTEK = od prvního bytu za čárkou SUBTRACT TALLY FROM Z &Z=délka zbytku za č. IF N < 50 SET N UP 1 GO Q1 ELSE GO CHYBA.