vak: (Улыбка)
[personal profile] vak
Угадайте, что за код. Эту функцию наверняка знают все без исключения современные программисты.
GLOBAL $(
    wrch    : 14
    getbyte : 85
$)

LET writes(s) BE
    FOR i = 1 TO getbyte(s, 0) DO wrch(getbyte(s, i))

AND writeoct(n, d) BE
$(
    IF d>1 DO
        writeoct(n>>3, d-1)
    wrch((n/\7)+'0')
$)

AND writehex(n, d) BE
$(
    IF d>1 DO
        writehex(n>>4, d-1)
    wrch((n&15)!TABLE
        '0','1','2','3','4','5','6','7',
        '8','9','A','B','C','D','E','F')
$)

AND writed(n, d) BE
$(
    LET t = VEC 20
    AND i, k = 0, n
    IF n<0 DO
        d, k := d-1, -n
    t!i, k, i := k REM 10, k/10, i+1 REPEATUNTIL k=0
    FOR j = i+1 TO d DO
        wrch('*S')
    IF n<0 DO
        wrch('-')
    FOR j = i-1 TO 0 BY -1 DO
        wrch(t!j+'0')
$)
AND writef(format, a, b, c, d, e, f, g, h, i, j, k) BE
$(
    LET t = @a

    FOR p = 1 TO getbyte(format, 0) DO $(
        LET k = getbyte(format, p)

        TEST k='%' THEN $(
            LET f, q, n = 0, t!0, 0
            AND type = getbyte(format, p+1)
            p := p + 1
            SWITCHON type INTO $(
                DEFAULT: wrch(type); ENDCASE

                CASE 'S': f := writes;   GOTO L
                CASE 'C': f := wrch;     GOTO L
                CASE 'O': f := writeoct; GOTO M
                CASE 'X': f := writehex; GOTO M
                CASE 'I': f := writed;   GOTO M
                CASE 'N': f := writed;   GOTO L

                M: p := p + 1
                   n := getbyte(format, p)
                   n := '0'<=n<='9' -> n-'0', n-'A'+10

                L: f(q, n); t := t + 1
            $)
        $) OR
            wrch(k)
    $)
$)

Date: 2013-01-19 10:06 (UTC)
From: [identity profile] b0p0h0k.livejournal.com
Да?
А как насчёт переменных?

LET t = VEC 20
AND i, k = 0, n