qemu/roms/SLOF/slof/fs/history.fs

   1 \ *****************************************************************************
   2 \ * Copyright (c) 2004, 2008 IBM Corporation
   3 \ * All rights reserved.
   4 \ * This program and the accompanying materials
   5 \ * are made available under the terms of the BSD License
   6 \ * which accompanies this distribution, and is available at
   7 \ * http://www.opensource.org/licenses/bsd-license.php
   8 \ *
   9 \ * Contributors:
  10 \ *     IBM Corporation - initial implementation
  11 \ ****************************************************************************/
  12
  13 \ Create debug section in NVRAM
  14 : debug-init-nvram ( -- )
  15    nvram-partition-type-debug get-nvram-partition IF
  16       cr ." Could not find debug partition in NVRAM - "
  17       nvram-partition-type-debug s" debug" d# 1024 new-nvram-partition
  18       ABORT" Failed to create DEBUG NVRAM partition"
  19       2dup erase-nvram-partition drop
  20       ." created." cr
  21    THEN
  22    s" debug-nvram-partition" $2constant
  23 ;
  24
  25 debug-init-nvram
  26
  27 : debug-add-env ( "name" "value" -- ) debug-nvram-partition 2rot 2rot internal-add-env drop ;
  28 : debug-set-env ( "name" "value" -- ) debug-nvram-partition 2rot 2rot internal-set-env drop ;
  29 : debug-get-env ( "name" -- "value" TRUE | FALSE) debug-nvram-partition 2swap internal-get-env ;
  30
  31 : debug-get-history-enabled ( -- n )    s" history-enabled?" debug-get-env IF $number IF 0 THEN ELSE 0 THEN ;
  32 : debug-set-history-enabled ( n -- )    (.) s" history-enabled?" 2swap debug-set-env ;
  33
  34
  35 debug-get-history-enabled constant nvram-history?
  36
  37 nvram-history? [IF]
  38
  39 : history-init-nvram ( -- )
  40    nvram-partition-type-history get-nvram-partition IF
  41       cr ." Could not find history partition in NVRAM - "
  42       nvram-partition-type-history s" history" d# 2048 new-nvram-partition
  43       ABORT" Failed to create SMS NVRAM partition"
  44       2dup erase-nvram-partition drop
  45       ." created" cr
  46    THEN
  47    s" history-nvram-partition" $2constant
  48 ;
  49
  50 history-init-nvram
  51
  52 0 value (history-len)
  53 0 value (history-adr)
  54
  55 : (history-load-one) ( str len -- len )
  56    \ 2dup ." loading " type cr
  57    to (history-len) to (history-adr)
  58    /his (history-len) + alloc-mem ( his )
  59    his-tail 0= IF dup to his-tail THEN
  60    his-head over his>next ! to his-head
  61    his-head his>next @  his>prev his-head swap !
  62    (history-len) his-head his>len !
  63    (history-adr) his-head his>buf (history-len) move
  64    (history-len) 1+
  65 ;
  66
  67 : history-load ( -- )
  68    history-nvram-partition drop BEGIN dup WHILE
  69       dup rzcount ( part str len )
  70       dup IF
  71          (history-load-one) +
  72       ELSE
  73          3drop 0
  74       THEN
  75    REPEAT
  76    drop
  77 ;
  78
  79 : (history-store-one) ( pos len saddr slen -- FALSE | npos nlen TRUE )
  80    dup 3 pick < IF \ enough space
  81       dup >r rot >r
  82       \ 2dup ." storing " type cr
  83       bounds DO dup i c@ swap nvram-c! 1+ LOOP
  84       dup 0 swap nvram-c! 1+
  85       r> r> - 1- true
  86    ELSE
  87       2drop false
  88    THEN
  89 ;
  90
  91 : history-store ( -- )
  92    history-nvram-partition erase-nvram-partition drop
  93    history-nvram-partition his-tail BEGIN dup WHILE
  94       dup his>buf over his>len @
  95       ( position len link saddr slen )
  96       rot >r (history-store-one) r>
  97       swap IF his>prev @ ELSE drop 0 THEN
  98    REPEAT
  99    2drop drop
 100 ;
 101
 102 \ redefine "end of SLOF" words to safe history
 103 : reset-all history-store reset-all ;
 104 : reboot history-store reboot ;
 105 : boot history-store boot ;
 106
 107 [THEN]