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)
    $)
$)
This account has disabled anonymous posting.
If you don't have an account you can create one now.
HTML doesn't work in the subject.
More info about formatting

If you are unable to use this captcha for any reason, please contact us by email at support@dreamwidth.org