Улучшение рантайм-библиотеки Паскаля

[spamsink]

Имеющаяся в библиотеке Паскаля процедура печати целых чисел написана на отвяжись и приводит к краху при попытке напечатать самое большое по абсолютной величине представимое отрицательное число -2⁴⁰, а также иногда печатает мусор вместо младшей цифры при печати больших (грубо, abs(x) > 2³⁸) чисел.

Было, например:

 00001    1  0 PROGRAM HELLO(OUTPUT);
 00001    2  1 VAR I:INTEGER;
 00007    3  2 BEGIN
 00010    4  3         FOR I := 6417777777777777C DOWNTO 6417777777777760C DO _(
 00011    5  3         WRITE(’<’, -I:0, ’> ’);
 00017    6  3         WRITELN(’<’, I: 0, ’>’);
 00025    7  2         _);
 00027    8  2         WRITELN(7777T);
 00033    9  2         WRITELN(’<’, 642T: 0, ’>’);
 00052   10  0 END.
           *EXECUTE
<-1099511627775> <1099511627775>
<-1099511627774> <1099511627774>
<-1099511627773> <1099511627773>
<-1099511627772> <1099511627772>
<-1099511627771> <1099511627771>
<-1099511627770> <1099511627770>
<-109951162777> <109951162777>
<-109951162776.> <109951162777.>
<-109951162776-> <109951162777->
<-1099511627766> <1099511627766>
<-1099511627765> <1099511627765>
<-1099511627764> <1099511627764>
<-1099511627763> <1099511627763>
<-1099511627762> <1099511627762>
<-1099511627761> <1099511627761>
<-1099511627760> <1099511627760>
*NO INTEGER*
 КОНТРОЛЬ КОМАНДЫ

Причина этого - "оптимизированное" целочисленное деление на 10, которое дает неправильный результат при делении отрицательных или больших чисел. Ну и, разумеется, попытка сразу сменить знак числа, если оно было отрицательное.

Попробуем переписать ответственную за это процедуру P/WI как положено.

Чтобы не было проблем с самым большим отрицательным числом, и чтобы не возиться с проверкой конкретно на него, будем первым делом делить число на 10 и определять младшую цифру, и только потом заботиться о том, чтобы последующий цикл работал только с неотрицательными числами.

Получилось даже на пару слов короче, чем оригинал. "А что, так можно было?"™

 P/WI    :,NAME,
 P/7A    :,SUBP,
 PASZERO*:,LC,1
 PASMINS*:,LC,1
 SPACE*  :,LC,1
        15,UTM,15    . ALLOCA(15)
         1,AOX,11B   . =I0 ENFORCE INTEGER EXPONENT ON VALUE
          ,ITS,13
          ,ITS,8
         8,BASE,ONETENTH
          ,XTS,=:774 . EXPONENT FIELD
        15,AAX,-3    . & VALUE
         1,AEX,11B   . CHECK FOR STRAY BITS IN EXPONENT
          ,UZA,GOOD  . IF NONE, GOOD
        11,VTM,NOINT . *NO INTEGER*
        10,VTM,14B
        13,VTM,EXIT
          ,UJ,P/7A   . FIELD WIDTH IS IGNORED HERE, AS IN THE ORIGINAL
 GOOD:    ,BSS,
C WITHIN GOOD, AFTER PUSHING R2, THE STACK IS
C -20   -19    -6   -5     -4    -3  -2 -1
C WIDTH DIGITS SIGN CURVAL VALUE R13 R8 R2 
          ,ITA,2
        15,XTS,-4    . <- VALUE
          ,ASN,64+40 . OR ,ASN,64-8; ,YTA, IF FASTER
         1,AAX,10B   . =1
        15,ATX,-6    . -> SIGN
        15,XTA,-4    . <- VALUE
         2,VTM,0
          ,NTR,
          ,A*X,=R0.1
          ,NTR,3
         1,AMX,11B   . =I0 ACC = FLOOR(ABS(VALUE*0.1)))
        15,ATX,-5    . -> CURVAL (GUARANTEED NON-NEGATIVE)
          ,A*X,TEN
          ,YTA,64    . NOW ACC = ABS(VALUE) / 10 * 10
        15,AVX,-4    . RESTORE SIGN
        15,AMX,-4    . SUBTRACT VALUE
         1,AVX,17B   . =I-1 (NEGATE)
 LOOP:   2,UTC,
        15,ATX,-19   . -> DIGITS[R2]
        15,XTA,-5    . <- CURVAL
        15,ATX,-4    . -> VALUE
         2,UTM,1     . INCREMENT NUMBER OF DIGITS WRITTEN
         1,AEX,11B   . =I0
          ,UZA,OUTPUT . NO MORE DIGITS TO PRODUCE
        15,XTA,-4    . <- VALUE
          ,A*X,ONETENTH . NOW WE CAN USE CHEAPER METHODS TO DIVIDE
        15,ATX,-5    . -> CURVAL
          ,A*X,TEN
          ,YTA,64    . ACC = VALUE / 10 * 10
        15,X-A,-4    . ACC = VALUE - ACC
          ,UJ,LOOP
 OUTPUT:  ,ITA,2     . <- NUM_DIGITS
        15,ARX,-6    . + SIGN
         1,AEX,11B   . =I0
        15,A-X,-20   . ACC = NUM_DIGITS + SIGN - WIDTH
          ,CALL,P/SP . IF ACC < 0, WRITE -ACC SPACES
        15,XTA,-6    . <- SIGN
          ,UZA,NOMINUS
          ,UTC,PASMINS*
          ,XTA,
          ,CALL,P/CW . PRNTING MINUS 
 NOMINUS:2,UTC,
        15,XTA,-20   . <- DIGITS[R2]
          ,AAX,=377
          ,UTC,PASZERO*
          ,ARX,
         2,UTM,-1
C ONE WORD LONGER THAN ,CALL,P/CW BUT FASTER (AS IN THE ORIGINAL)
        12,WTC,
          ,ATX,
          ,CALL,P/PF
         2,V1M,NOMINUS
        15,XTA,
          ,ATI,2
 EXIT:  15,XTA,-1
          ,ATI,8
        15,UTM,-19
        15,WTC,17
          ,UJ,
 ONETENTH:,LOG,4001 4631 4631 4632
 TEN:     ,LOG,4000 0000 0000 0012
 NOINT:   ,ISO,12H*NO INTEGER*
          ,END,

Пробуем:

 00001    1  0 РRОGRАМ НЕLLО(ОUТРUТ);
 00001    2  1 VАR I:INТЕGЕR;
 00007    3  2 ВЕGIN
 00010    4  3  FОR I := 6417777777777777С DОWNТО 6417777777777760С DО _(
 00011    5  3  WRIТЕ(’<’, -I:0, ’> ’);
 00017    6  3  WRIТЕLN(’<’, I: 0, ’>’);
 00025    7  2  _);
 00027    8  2         WRIТЕLN(7777Т);
 00033    9  2  WRIТЕLN(’<’, 642Т: 0, ’>’);
 00052   10  0 ЕND.
           *LIВRА:13
           *ЕХЕСUТЕ
<-1099511627775> <1099511627775>
<-1099511627774> <1099511627774>
<-1099511627773> <1099511627773>
<-1099511627772> <1099511627772>
<-1099511627771> <1099511627771>
<-1099511627770> <1099511627770>
<-1099511627769> <1099511627769>
<-1099511627768> <1099511627768>
<-1099511627767> <1099511627767>
<-1099511627766> <1099511627766>
<-1099511627765> <1099511627765>
<-1099511627764> <1099511627764>
<-1099511627763> <1099511627763>
<-1099511627762> <1099511627762>
<-1099511627761> <1099511627761>
<-1099511627760> <1099511627760>
*NО INТЕGЕR*
<-1099511627776>
 КОНЕЦ ЗАДАЧИ

То-то же.