;Experimental Dictionary Overflow Prevention Patch 5/31/10 (comments 6/4/10)
;**** note - this code has issues, read all comments, may be other bugs ****
;If using this patch @BLK *must* be set after EOD or will corrupt
;(always the case unless you manually mess with @BLK, see comments)
;There *MUST* be block memory allocated, strings still overflow before
;it detects the situation (and block memory must be temporary but usually
;that's the case). Use of this patch isn't recommended unless dictionary
;overflow is an issue with an existing build that would be inconvenient
;to rebuild (say a custom dev/library build), then only apply it to a copy.
;
;This patch replaces the PUT words in DEFINE and ADDCODE with
;a custom PUT that will not write into block memory, if the
;dictionary overflows it displays OVFLOW and warmboots.
;To avoid corruption if right on the edge it always writes a 0
;to start of blocks - 1 so if it makes it to FIXLINKS and fails
;when adding the terminating 0 the error message will be displayed
;but the word will get created and dictionary properly terminated.
;However, this means if @BLK is manually set to the middle of a
;word it WILL corrupt the dictionary requiring manual PUTs to fix.
;To recover, put a zero right after the last good word:
;"LASTGOODWORD" $DEFADR DEC GET 0 PUT (don't mistype!)
;This should never happen during normal use, just when testing
;or other hacking where @BLK gets accidentally set to before EOD.

"Applying dictionary overflow patch..." $PRINT CRLF

OCTAL DEFINE T ;test to make sure 3740-3777 is all zero
"T" $DEFADR 4 SUB 0 PUT ;self-remove T definition
#0 ;error flag
3740 3777 +DO INDEX GET IFNZ DROP #1 ENDIF +LOOP
IFNZ "3740-3777 not empty, not patching." $PRINT CRLF CONSOLE ENDIF
END T
                ;  ORG 3740B
3740 003741 PUT ;  DEF *+1         word address
3741 114324 PUT ;  JSB 324B,I      pop put data
3742 073764 PUT ;  STA PDATA       save it
3743 114324 PUT ;  JSB 324B,I      pop put address
3744 073765 PUT ;  STA PADR        save it
3745 060453 PUT ;  LDA 453B        get block start address
3746 043766 PUT ;  ADA MIN1        decrement to place final 0
3747 006400 PUT ;  CLB             avoid possible corruption...
3750 174000 PUT ;  STB 0,I         put a 0 at start of blocks - 1
3751 067765 PUT ;  LDB PADR        get put address
3752 007000 PUT ;  CMB
3753 006004 PUT ;  INB             2's complement
3754 040001 PUT ;  ADA 1           A = (block adr - 1) - put adr
3755 002020 PUT ;  SSA             skip if not negative
3756 027767 PUT ;  JMP UERR        if > (block adr - 1) jump to error
3757 002003 PUT ;  SZA,RSS         skip if not zero
3760 027767 PUT ;  JMP UERR        if = (block adr - 1) jump to error
3761 063764 PUT ;  LDA PDATA       get put data
3762 173765 PUT ;  STA PADR,I      store in put address
3763 124321 PUT ;  JMP 321B,I      exit word
3764 000000 PUT ;PDATA OCT 0       storage for put data
3765 000000 PUT ;PADR OCT 0        storage for put address
3766 177777 PUT ;MIN1 DEC -1       to decrement
3767 067774 PUT ;UERR LDB EMA      error print - get str adr in B
3770 063773 PUT ;  LDA EMC         get word length in A
3771 114343 PUT ;  JSB 343B,I      call the string print code
3772 124457 PUT ;  JMP 457B,I      warm-boot
3773 000003 PUT ;EMC OCT 3         word length of message
3774 003775 PUT ;EMA DEF *+1       address of message
3775 047526 PUT ;  ASC 3,OVFLOW
3776 043114 PUT
3777 047527 PUT

DEFINE P ;patcher
"PUT" $DEFADR ;push WA of PUT word to search for
$DEFADR ;push WA of word to patch
DUP IFZ DROP ELSE ;if word exists
 DUP DEC GET ;push link address
 +DO ;scan from WA to link
  DUP ;push WA of word to replace
  INDEX GET ;push data at index
  SUB IFZ ;if a match
   INDEX 3740 PUT ;replace w/ WA of replacement put 
  ENDIF
 +LOOP
ENDIF
DROP ;drop WA of search word
END

;patch the words that add code to the dictionary...
"DEFINE" P
"ADDCODE" P
"P" $DEFADR 4 SUB 0 PUT ;remove the patch word
"Patch applied." $PRINT CRLF
CONSOLE