How to Handle Stack Overflow in Scheme?

Yep, use tail recursion. As for the time limit, usually (well, at least for the older problems...) the time limit is set to 20-30 times more than what a "proper" solution in C would take, so you should have no problems (I solved PRIME1 and PALIN in Scheme/Guile). Most SPOJ problems are not about micro-optimizations; solutions with algorithms with the wrong asymptotic complexity will time out regardless of the implementation language. This issue has been discussed before.

Ok, I take back what I said. Some problems are impossible to solve in Scheme. I tried to solve QKP in Scheme (a pretty straightforward problem) and couldn't get it to run under the time limit of 1s. I implemented the same algorithm in C and it ran in 0.02s (so far, mine is the fastest accepted solution). So a solution implemented in Scheme, with Guile, can be expected to be more than 50 times slower than the C implementation.

My Scheme code (TLEd) is below. I don't know what else to change to make it faster. Yes, I'm aware that 'do' is considered in poor taste in some circles, but, with Guile, I found that it's slightly faster than a loop with named let.

(define visited (make-string (* 1004 1004)))
(let do-test-case ((rows (read)) (cols (read)) (board-number 1))
  (if (and (> rows 0) (> cols 0))
    (let* ((read-piece-list (lambda (n)
                        (let loop ((n n) (l '()))
                          (if (= n 0) l (loop (- n 1) (cons (cons (+ 1 (read)) (+ 1 (read))) l))))))
           (fix-coords (lambda (x) (+ (* (car x) (+ cols 4)) (cdr x))))
           (queens (map fix-coords (read-piece-list (read))))
           (knights (map fix-coords (read-piece-list (read))))
           (pawns (map fix-coords (read-piece-list (read))))
           (knight-directions (map fix-coords '((1 . 2) (-1 . 2) (1 . -2) (-1 . -2) (2 . 1) (-2 . 1) (2 . -1) (-2 . -1))))
           (queen-directions (map fix-coords '((1 . 0) (-1 . 0) (0 . 1) (0 . -1) (1 . 1) (1 . -1) (-1 . 1) (-1 . -1))))
           (attack-count 0))
      ;
  ; initialize visited
  ;
  ; #\O: occupied; #\x: attacked; #\space: safe
  ;
  
  (substring-fill! visited 0 (* 2 (+ cols 4)) #\O)
  (let loop ((r 0) (index (* 2 (+ cols 4))))
    (if (< r rows)
      (begin
        (string-set! visited index #\O)
        (string-set! visited (+ index 1) #\O)
        (string-set! visited (+ index 2 cols) #\O)
        (string-set! visited (+ index 3 cols) #\O)
        (substring-fill! visited (+ index 2) (+ index 2 cols) #\space)
        (loop (+ r 1) (+ index cols 4)))))
  (substring-fill! visited (* (+ 2 rows) (+ cols 4)) (* (+ 4 rows) (+ 4 cols)) #\O)

  ;
  ; do the dog
  ;

  (letrec ((visit-square (lambda (i)
                           (string-set! visited i #\O)
                           (set! attack-count (+ attack-count 1))))

           (walk-queen (lambda (i d)
                         (do ((i i (+ i d)))
                             ((char=? (string-ref visited i) #\O))
                             (if (char=? (string-ref visited i) #\space)
                               (begin
                                 (string-set! visited i #\x)
                                 (set! attack-count (+ attack-count 1)))))))

            (visit-queen (lambda (i)
                          (do ((l queen-directions (cdr l)))
                              ((null? l))
                              (walk-queen (+ i (car l)) (car l)))))

            (visit-knight (lambda (i)
                           (do ((l knight-directions (cdr l)))
                               ((null? l))
                               (let* ((d (car l))
                                      (i (+ i d)))
                                 (if (char=? (string-ref visited i) #\space)
                                   (begin
                                     (string-set! visited i #\x)
                                     (set! attack-count (+ attack-count 1)))))))))

    (for-each visit-square queens)
    (for-each visit-square knights)
    (for-each visit-square pawns)
    (for-each visit-queen queens)
    (for-each visit-knight knights))

  (display "Board ") (display board-number)
  (display " has ") (display (- (* rows cols) attack-count))
  (display " safe squares.\n")

  (do-test-case (read) (read) (+ 1 board-number)))))

I am trying to solve PL6COL, but I cannot get rid of the stack overflow.

Any idea how to convert this to a tail recursive solution?

Thx.

(use-modules (ice-9 rdelim))
(use-modules (srfi srfi-1))
(define (select-unassigned-variable assignment graph)
  (define (suv i l ass c cm)
    (cond
     ((= i l) c)
     ((not (list? (vector-ref ass i))) (suv (+ 1 i) l ass c cm))
     (else
      (let ((mul (length (vector-ref ass i))))
        (if (> mul cm)
            (suv (+ 1 i) l ass i mul)
            (suv (+ 1 i) l ass c cm))))))
  (suv 0 (vector-length graph) assignment -1 -1))
(define (consistent col assignment neighbours)
  (if (null? neighbours) 
      #t
      (let ((nv (vector-ref assignment (car neighbours))))
        (cond
         ((and (not (list? nv)) (= nv col)) #f)
         ((not (list? nv)) (consistent col assignment (cdr neighbours)))
         (else
          (let ((nc (delete col nv)))
            (if (null? nc) 
                #f
                (begin
                  (vector-set! assignment (car neighbours) nc)
                  (consistent col assignment (cdr neighbours))))))))))
(define (vector-copy v)
  (list->vector (vector->list v)))
(define (recursive-backtracking assignment graph)
  (let ((i (select-unassigned-variable assignment graph)))
    (if (= i -1) 
        assignment
        (let loop ((cols (vector-ref assignment i))
                   (ass (vector-copy assignment)))
          (if (null? cols) 
              #f
              (if (consistent (car cols) ass (vector-ref graph i))
                  (begin
                    (vector-set! ass i (car cols))
                    (let ((r (recursive-backtracking ass graph)))
                      (if r 
                          r
                          (loop (cdr cols) (vector-copy assignment)))))
                  (loop (cdr cols) (vector-copy assignment))))))))
(define (backtracking-search graph)
  (recursive-backtracking (make-vector (vector-length graph) 
                                       (list 1 2 3 4 5 6)) 
                          graph))
(define (print-results i ass)
  (if (< i (vector-length ass))
      (begin
        (display i)
        (display " ")
        (display (vector-ref ass i))
        (newline)
        (print-results (+ i 1) ass))))
(define (read-testcase)
  (define (read-edges e g)
    (define (sort-vector i m g)
  (if (= i m) 
      g
      (begin
        (vector-set! g i (sort! (vector-ref g i) <))
        (sort-vector (+ i 1) m g))))

(let ((e1 (read-delimited ",{}" (current-input-port) 'trim))
      (v1 (string->number (read-delimited ",{}" (current-input-port) 'trim)))
      (v2 (string->number (read-delimited ",{}" (current-input-port) 'trim))))
  (vector-set! g v1 (cons v2 (vector-ref g v1)))
  (vector-set! g v2 (cons v1 (vector-ref g v2)))
  (if (= 1 e)
      (sort-vector 0 (vector-length g) g)
      (begin
        (read-delimited ",{}" (current-input-port) 'trim)
        (read-edges (- e 1) g)))))
  (read) (read)
  (let ((nodes (read)))
    (read) (read)
    (let ((edges (read))
          (graph (make-vector nodes '())))
      (read)
      (read-edges edges graph))))
(let loop((i (read)))
  (if (> i 0)
      (begin
        (print-results 0 (backtracking-search (read-testcase)))
        (newline)
        (loop (- i 1)))))