day10_lib.tal

( get-byte -- score* )
@check-line
  [ ,&get-byte STR2 ]
  #ffff [ ,&score STR2 ]
  ;&score64 #0000 ;short-to-64 JSR2
  #00 [ ,&skip-chars STR ]
  #00 [ ,&skip-unwind STR ]

  #00 ( stack start marker, see &unwind )
  #01 ( dummy char that won't match any closing char, in case string starts with one )
  &next-char
    LIT2 [ &get-byte $2 ] JSR2
    DUP #00 EQU ,&eol JCN
    DUP #0a EQU ,&eol JCN
    ;&score64 [ ,&score STR2 ]
    LIT [ &skip-chars $1 ] ,&not-closing JCN
    ( LIT 'i EMIT )
    DUP EMIT

    ( cn-1 cn )
    DUP ;get-opener JSR2
    ( cn-1 cn opener )
    LTHk ,&not-closing JCN
      ( cn-1 cn opener )
      STH OVR STHr ( cn-1 cn cn-1 opener )
      ( match previous char )
      ( SP OVR EMIT LIT '= EMIT DUP EMIT LIT '? EMIT LF )
      EQU ,&ok-opener JCN
        ( cn-1 cn )
        ( mismatch )
        #0000 [ ,&score STR2 ]
        #01 [ ,&skip-chars STR ]
        #01 [ ,&skip-unwind STR ]
        ,&next-char JMP

      &ok-opener
      ( cn-1 cn )
      POP2 #00
    &not-closing
    ( … cn 00 -or- … cn-2 00 )
    POP

    ,&next-char JMP
  &eol
  ( line-terminator ) POP

  ,&unwind JSR

  LIT2 [ &score $2 ]
  RTN
  [ &score64 $8 &char-score64 $8 ]

  ( 00 a b c d … )
  &unwind
    SP
    &unwind-next
      LIT [ &skip-unwind $1 ] ,&no-unwind JCN
        DUP ;get-closer JSR2
        DUP #20 LTH ,&nonprint JCN
        DUP #80 GTH ,&nonprint JCN
          DUP EMIT
          DUP ;get-score JSR2 #00 SWP ( score )
          ;&char-score64 SWP2 ;short-to-64 JSR2
          ;&score64 #05 ;mul64-byte JSR2
          ;&score64 ;&char-score64 ;add64 JSR2
          &nonprint
        POP
      &no-unwind
      ,&unwind-next JCN ( magic! )
    RTN

( '> -- score )
@get-score
  #10 SUB 20/ INC LDR RTN
  01 04 02 03

( '> -- '< )
@get-opener
@get-closer
  INC LDR
  RTN
  00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
  00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
  00 00 00 00 00 00 00 00 ') '( 00 00 00 00 00 00
  00 00 00 00 00 00 00 00 00 00 00 00 '> 00 '< 00
  00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
  00 00 00 00 00 00 00 00 00 00 00 '] 00 '[ 00 00
  00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
  00 00 00 00 00 00 00 00 00 00 00 '} 00 '{ 00 00

( list* -- )
@dump-int64-list
  &loop
    DUP2 LDA2
    ( list* b1 b2 )
    DUP2 #ffff EQU2 ,&done JCN
    ( list* b1 b2 )
    POP2 DUP2 ;print64 JSR2 SP
    #0008 ADD2
    ,&loop JMP
  &done
  ( list* b1 b2 )
  POP2 POP2
  RTN

( list* -- max* )
@find-max64
  STH2 ( : list* )
  ;&intmin [ ,&max-ptr STR2 ]
  ( : list* )
  &loop
    STH2rk LDA2
    ( val : list* )

    #ffff EQU2 ,&done JCN

    ( : list* )
    [ ,&max-ptr LDR2 ] STH2rk
    ( max* val* : list* )
    DUP4 ;geq64 JSR2 ,&not-better JCN
      ( max* val* : list* )
      STH2rk [ ,&max-ptr STR2 ]
      &not-better
    ( max* val* : list* )
    POP2
    POP2
    ( max* : list* )
    LIT2r 0008 ADD2r
    ,&loop JMP
  &done
  POP2r
  ;&max-out [ ,&max-ptr LDR2 ] ;copy64 JSR2
  [ ,&max-ptr LDR2 ] #0000 ;short-to-64 JSR2
  ;&max-out
  RTN
  [ &max-ptr $2 &intmin 00 00 00 00 00 00 00 00 &max-out $8 ]

( list* -- min )
@find-min64
  STH2 ( : list* )
  ;&intmax [ ,&min-ptr STR2 ]
  ( : list* )
  &loop
    STH2rk LDA2
    ( val : list* )

    #ffff EQU2 ,&done JCN

    STH2rk ;is-non-zero64 JSR2 ,&non-zero JCN
      ( : list* )
      #0000 ,&continue JMP
    &non-zero
    ( : list* )

    [ ,&min-ptr LDR2 ] STH2rk
    ( min* val* : list* )
    DUP4 ;geq64 JSR2 NOT ,&not-better JCN
      ( min* val* : list* )
      STH2rk [ ,&min-ptr STR2 ]
      &not-better
    ( min* val* : list* )
    POP2
    &continue
    POP2
    ( min* : list* )
    LIT2r 0008 ADD2r
    ,&loop JMP
  &done
  POP2r
  ;&min-out [ ,&min-ptr LDR2 ] ;copy64 JSR2
  [ ,&min-ptr LDR2 ] #0000 ;short-to-64 JSR2
  ;&min-out
  RTN
  [ &min-ptr $2 &intmax ff ff ff ff ff ff ff 7f &min-out $8 ]


~library/console.lib.tal
~library/string.tal
~library/math.tal