home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Mops 2.7 / Mops source / Module source / Instlmod.txt < prev    next >
Encoding:
Text File  |  1995-12-15  |  15.4 KB  |  568 lines  |  [TEXT/MSET]
  1. \ Install - Mops version.
  2. \ July 90        Save nucleus implemented.
  3. \ Sept 90        Necessary mod for our new "startup" CODE resource.
  4. \ Oct 91        Changed to view/window+.
  5. \ May 92        Changed vscroll objects according to "new way" for controls.
  6.  
  7. need    window+
  8.  
  9. konst resLocked        constant    LOCKED
  10. konst resPurgeable    constant    PURGEABLE
  11.  
  12.     0    value        CURSTACK
  13.     0    value        CURDICT
  14.  
  15.     0    value        HEAPAVAIL
  16. false    value        GOTFREE?
  17. true    value        SAVE?
  18.  
  19.     0    value        QUITWORD
  20.     0    value        ABORTWORD
  21.  
  22.     string+        $TMP
  23.  
  24.     int        APREFNUM
  25.     var        APPARAM
  26.  
  27.     22    dialog        IDLG
  28.  
  29. : NOGO    3 beep  3 beep  close: iDlg  set: fWind
  30.     cr ." Res error# " .
  31.     cr ." Type any key to return to Finder, hopefully"
  32.     key  bye  ;
  33.  
  34. : CHK    word0  call reserror  i->l  ?dup
  35.     IF  nogo  THEN  ;
  36.  
  37. ' null    vect    TEMP
  38.  
  39. : ONERROR        \ ( errCfa -- )
  40.         \ Here we temporarily set the error vectors.  This is normally
  41.         \ illegal since we're in a module and the vectors are not.  But
  42.         \ we're safe here, so we kludge it.
  43.     -> temp        \ Store to an internal vect, convert to reloc
  44.     ['] temp @  dup  ['] abortvec !  ['] dflt-die !  ;
  45.  
  46. \ Class RES+ adds methods to Resource to allow various modifications
  47. \ to resources.  We'll put more in as we need them.
  48.  
  49. :class    RES+    super{ resource }
  50.  
  51. objPtr    TEMPRES  class_is  res+
  52.  
  53. :m CHANGED:    get: self  call ChangedResource  ;m
  54.  
  55. :m ADDRES:  { s255 -- }
  56.     get: self
  57.     get: resType  get: ID  makeint
  58.     s255  call AddResource  chk  ;m
  59.  
  60. :m CHANGETO:    \ ( res -- )
  61.     -> tempRes
  62.     get: tempRes  dup  call DetachResource  put: self  ;m
  63.  
  64. :m SETATTRS:    \ ( n -- )
  65.     get: self  swap  makeint  call SetResAttrs  chk
  66.     changed: self  ;m
  67.  
  68. ;class
  69.  
  70.     res+    SRCRES
  71.     res+    DSTRES
  72.  
  73. : COPYRES    \ ( type resID -- )  Copies the resource by copying
  74.             \  the handle's data in memory.  Use this one for resources
  75.             \  currently in use.
  76.             
  77.     2dup  set: srcRes  set: dstRes
  78.     getnew: srcRes  chk  srcRes ->: dstRes
  79.     nullOSstr  addRes: dstRes  chk  ;
  80.  
  81.  
  82. : CHANGERES    \ ( type resID -- )  Copies the resource by detaching its
  83.         \  handle and attaching it to the new resource.  Use this
  84.         \  one for resources not in use - it has less overhead.
  85.     2dup  set: srcRes  set: dstRes
  86.     getnew: srcRes  chk  srcRes changeTo: dstRes
  87.     nullOSstr  addRes: dstRes  chk  ;
  88.  
  89. : !STACK    curStack -> stkSpace  ;
  90.  
  91. : @HEAP        \ Returns starting heap size for this nucleus.
  92.     gotFree?  NIF  free  -> heapAvail  true -> gotFree?  THEN
  93.     heapAvail  ;
  94.  
  95. : CURHEAP        \ Computes amount of heap available for current configuration.
  96.     @heap  stkspace curStack - +  room curDict - +  ;
  97.  
  98. : SETMEM        \ Sets nucleus stack to selected values
  99.     !stack
  100.     curDict -> maxdic  ;
  101.  
  102. : iMsg        \ ( addr1 len1 addr2 len2 -- )  Gives informatory message
  103.     "  " "  " ParamText draw: iDlg  ;
  104.  
  105. : ChR        \ ( handle -- handle )  Marks the resource for update to disk
  106.     dup call ChangedResource  ;
  107.  
  108. objPtr    theMod  class_is  module
  109. handle    ModHdl
  110.  
  111. : (ADDMOD)  { theCfa n \ ID -- }
  112.     theCfa mod?  NIF  drop  EXIT  THEN
  113.     >obj -> theMod
  114.     install?: theMod  0EXIT            \ Out if not to install this mod
  115.     " module:"  theCfa >name n>count  iMsg
  116.  
  117.         binName: theMod  name: fFcb  0 setVref: fFcb
  118.         openReadOnly: fFcb  ?error 138
  119.         size: fFcb  dup  new: modHdl
  120.         lock: modHdl            \ Maybe we need this
  121.         ptr: modHdl  swap  read: fFcb
  122.         unlock: modHdl        \ Unlock before error check
  123.         close: fFcb  drop  ?error 141
  124.  
  125. \    release: theMod   load: theMod
  126.     word0 'type CODE  call UniqueID  i->l  -> ID
  127.     'type CODE  ID  set: dstRes  ID  setResID: theMod
  128.     ( handle: theMod )  get: modHdl  put: dstRes
  129.     theCfa >name n>count str255  addRes: dstRes
  130.             \ NOTE: we don't release modHdl since it's the
  131.             \ Resource Manager's baby now.
  132.     locked  setAttrs: dstRes  ;        \ note - not purgeable any more - not safe
  133.  
  134. : ADDMODS
  135.     "  " 2dup 2dup 2dup  paramText
  136.     " Installing ^0 ^1" 21 putText: iDlg
  137.     ['] (addmod)  0  trav  ;
  138.  
  139. : INVWORD        \ ( item# -- )
  140.     40 beep 0 $ ffff rot  setSelect: iDlg  ReturnToModal  ;
  141.  
  142. :a OK        \ Validates quits & abort words; if bad returns to modal
  143.     10 getText: iDlg  sFind  NIF  10 invWord  EXIT  THEN
  144.     -> quitword
  145.     11 getText: iDlg  sFind  NIF  11 invWord  EXIT  THEN
  146.     -> abortword
  147.     true  ;a
  148.  
  149. :a CANCEL    false  ;a
  150.  
  151. xts{    ok cancel null null null null null null null null null
  152.         togitem togItem togItem null null null null null null null
  153.         togitem  }
  154.     111  init: iDlg   1  setBold: iDlg
  155.  
  156. : GETR
  157.     get_appl_name ->: $tmp  all: $tmp  5  putText: iDlg
  158.     get_appl_vers ->: $tmp  all: $tmp  4  putText: iDlg
  159.     get_appl_sig  pad !  pad 4  3  putText: iDlg  ;
  160.  
  161. : DROP@        \ ( addr len -- addr' )
  162.         \ Fetches 1st four bytes on an odd byte, pad with blanks
  163.     >r sp@ $ 20202020 rot rot r> 4 min cmove  ;
  164.  
  165. : SETFREF        \ ( type n -- )
  166.     'type FREF  swap  set: srcRes  getNew: srcRes
  167.     get: srcRes  ChR  >ptr !  ;
  168.  
  169.  
  170. :class    SETUPHDR    super{ object }
  171.         \ A dummy class to map the info area at the start of the
  172.         \  Setup segment
  173. record
  174. {    var        dummy
  175.     int        &bra        \ The names are the same, with & in front
  176.     var        &maxDic
  177.     var        &minHeap
  178.     var        &dicSize
  179.     var        &StkSpace
  180.     var        &RstkSpace
  181.     bool    &installed
  182.     byte    spare
  183.     int        &nop
  184. }
  185.  
  186. :m SETUP:  { instld? -- }
  187.  
  188. \    $ a9ff      put: &nop            \ Include to breakpoint on run
  189.  
  190.     maxDic        put: &maxDic
  191.     minHeap        put: &minHeap
  192.     stkSpace    put: &stkSpace
  193.     RstkSpace    put: &RstkSpace
  194.     instld?        put: &installed  ;m
  195. ;class
  196.  
  197. : SETDIC&HEAP        \ ( instld? -- )
  198.     ptr: dstRes  setup: setupHdr  ;         \ Forced bind to pseudo-object
  199.  
  200. : SETAPPLSIZE
  201.     here  nptr: srcRes  -        \ Offset to Here
  202.     curDict +  setSize: dstRes  ;
  203.  
  204. : UNPATCH  { \ ^br -- }
  205.     brs -> ^br
  206.     ^br @    ['] *  6 +    !    4 ++> ^br        \ ***NOTE: add the 6 for words
  207.     ^br @    ['] /  6 +    !    4 ++> ^br        \ with "xinfo" optimization info
  208.     ^br @    ['] mod    !    4 ++> ^br
  209.     ^br @    ['] /mod    !    4 ++> ^br
  210.     ^br @    ['] u/mod    !    4 ++> ^br
  211.     ^br @    ['] mulx    !  ;
  212.  
  213. : ADDCODE        \ Adds the CODE resources to a new application.
  214.  
  215.     " dictionary" "  "  iMsg
  216.  
  217.     'type CODE  0  copyRes            \ Copy CODE 0 (Jump table)
  218.       locked  setAttrs: dstRes
  219.     'type CODE  1  changeRes        \ And CODE 1 (Setup)
  220.       purgeable  setAttrs: dstRes
  221.     true  setDic&heap
  222.     
  223. \ Now we set all the various flags and vectors appropriately:
  224.  
  225.     unpatch  oldVecs
  226.     false -> initzed?  true -> instld?
  227.     false -> MRopen?  false -> use_paths?
  228.     0 -> CPaddr
  229.     classinit: fWind  clear: fFcb
  230.     0 -> actW  ['] appInit -> objinit
  231.     quitword -> quitvec
  232.     abortword dup -> abortvec  dup -> dflt-die  -> setFwind
  233.             \ Catch all the possibilities!
  234.             \ Note: we still have to PURGE modules in the dictionary.
  235.             \ We leave this to the last moment as some are still in use.
  236.     'type CODE  2  changeRes        \ Copy CODE 2 (main dictionary)
  237.     locked  setAttrs: dstRes
  238.     setApplSize
  239. \ Now, are we to include Handlers in the installed app?
  240.     22 getitem: idlg  0<>  -> inclHndlrs?
  241.     inclHndlrs?
  242.     IF    'type CODE  3  changeRes
  243.         locked  setAttrs: dstRes
  244.     THEN
  245. ;
  246.     
  247.  
  248. : SAVECODE  { \ addr len -- }    \ Copies the CODE resources for
  249.                                 \  a Saved nucleus.
  250.  
  251.     'type CODE  0  copyRes            \ Copy CODE 0 (Jump table)
  252.       locked  setAttrs: dstRes
  253.     'type CODE  3  changeRes        \ And CODE 3 (Handlers)
  254.     'type CODE  1  changeRes        \ And CODE 1 (Setup)
  255.       purgeable  setAttrs: dstRes
  256.     false  setDic&heap
  257.     
  258. \ Last but not least, we'll copy CODE 2 (the main dictionary).
  259. \ First we set all the various flags and vectors appropriately:
  260.  
  261.     unpatch
  262.     false -> initzed?  0 -> ExBoffs  +curs
  263.     false -> emit?  false -> MRopen?  false -> savingDic?
  264.     true -> use_paths?
  265.     true -> 68K?  false -> PPC?
  266.     0 -> CPaddr
  267.     classinit: fWind  true -> fWind?  clear: fFcb
  268.     
  269. \ Now we set all system vectors back to their defaults (by storing zero
  270. \ there).  All system vecs in file Nuc.asm and Nuc2.asm must be here, since
  271. \ any of them could have been altered.  If any are added, corresponding
  272. \ code MUST BE PLACED HERE!!
  273.  
  274.     0 -> emitvec    0 -> pemitvec
  275.     0 -> crvec        0 -> pcrvec
  276.     0 -> typevec    0 -> ptypevec
  277.     0 -> spvec        0 -> pspvec
  278.     0 -> echovec    0 -> header        0 -> logvec
  279.  
  280.     0 -> uFind  0 -> fnum?  0 -> numAccumulate
  281.     0 -> key  0 -> key!
  282.     0 -> pause        0 -> ?pause        0 -> getSpace
  283.     0 -> rngErr        0 -> $err        0 -> arithErr
  284.     0 -> objinit    0 -> extra_inits
  285.     0 -> abortvec    0 -> quitvec    0 -> setfWind
  286.     0 -> dflt-die   0 -> tstr        0 -> frefill
  287.     0 -> modload    0 -> TEidle        0 -> compinline
  288.     0 -> PPCvec
  289.     0 -> openAppVec    0 -> openDocVec    0 -> printDocVec
  290.     0 -> quitAppVec    0 -> read1docVec
  291.     0 -> actW
  292.     
  293.     'type CODE  2  ChangeRes    \ Yes, I know it's in use, but it's
  294.                                 \  OK as we're going to quit
  295.                                 \  straight away!
  296.  
  297.     purgeable  setAttrs: dstRes    \ Note: we don't set it locked since
  298.                                 \  the Setup segment will resize it
  299.                                 \  before moving it high, locking and
  300.                                 \  calling it.
  301.  
  302. \ Now we have to forget back to the bare nucleus.  The first word above
  303. \ is the dictionary mark for the first file, Base.
  304.  
  305.     " base "                    \ dic mark name is the file name followed
  306.                                 \  by a space
  307.     sFind NIF                    \ Really ought to be there
  308.         drop ['] echo?            \ If not, just use 1st word and hope for the best
  309.     THEN
  310.     >link (forget)
  311.     here  nptr: srcRes  -        \ Offset to Here
  312.     setSize: dstRes  ;
  313.     
  314.  
  315. scon    $ALQ    "alert%"    & %  & "  instead
  316.  
  317. : NEW_APPLICATION  { \ sig addr len -- }
  318.         \ This word does all the hard work of creating the
  319.         \ installed application file.
  320.         
  321.     ['] nogo  onError
  322.     5 getText: iDlg  -> len -> addr
  323.     addr len  name: fFcb
  324.     delete: fFcb  drop                    \ Delete any duplicate file
  325.     addr len str255
  326.     call CreateResFile  chk                \ Create new res file for applicn
  327.     0  buf255  call OpenResFile  drop  chk
  328.     3  getText: iDlg  drop@ -> sig        \ New sig
  329.     'type APPL  sig  set: fFcb            \ Set type & sig of appl
  330.     $ 21  fFcb $ 28 + c!                \ Set Bundle bit
  331.     setFileInfo: fFcb
  332.     addMods                                \ Copy chosen modules
  333.     addCode                                \ and CODE 0, 1, 2 and maybe 3
  334.     ['] nogo  onError
  335.     13 getitem: iDlg
  336.     IF    true -> fWind?                    \ fWind? wanted - copy it (WIND 256)
  337.         'type WIND  256  copyRes
  338.         12 getitem: iDlg  8 <<  ptr: dstRes 10 + w!
  339.                                         \ Mark visible or not
  340.     ELSE
  341.         false -> fWind?
  342.     THEN
  343.     'type SIZE  -1   copyRes            \ Copy SIZE -1
  344.     'type BNDL  128  copyRes            \ and don't drop our BNDL (128)
  345.     sig  ptr: dstRes  !                    \ Store in new BNDL
  346.     
  347. \ Now set up FREFs:
  348.  
  349.     'type FREF  128  copyRes            \ FREF for APPL - doesn't change
  350.     10 6 DO                                \ FREFs 129 onwards
  351.         i getText: iDlg  dup
  352.         NIF  drop  LEAVE  THEN
  353.         'type FREF  123 i +  copyRes
  354.         drop@  ptr: dstRes  !
  355.     LOOP
  356.     
  357. \ Now we create the new version resource which has a "type" that is the
  358. \ same as the sig, and ID 0.
  359.  
  360.     sig  0  set: dstRes
  361.     4 getText: iDlg  dup 1+ align  new: dstRes
  362.     str255  ptr: dstRes  over  c@ 1+ cMove
  363.     nullOSstr  addRes: dstRes
  364.     
  365. \ Now copy the Alert" stuff if we need it
  366.  
  367.     $alq sfind nip
  368.     IF    'type ALRT  900  copyRes
  369.         'type DITL  900  copyRes
  370.     THEN  ;
  371.     
  372.  
  373. : DOINSTALL
  374.     openMR   getnew: iDlg   getR
  375.     " go"     10 putText: iDlg
  376.     " crash" 11 putText: iDlg
  377.     0 $ ffff 3 setSelect: iDlg
  378.     modal: iDlg
  379.     IF    new_application  THEN
  380.     close: iDlg
  381.     kludge: instlMod  kludge: pathsmod
  382.     purge                            \ Dic image must have no modules loaded
  383.     bye  ;
  384.  
  385.  
  386. : SAVENUC  { \ addr len -- }            \ Saves a new Mops nucleus.
  387.     " Mops.new"  -> len -> addr
  388.     addr len  name: fFcb
  389.     create: fFcb  ?error 169
  390.     addr len  str255                    \ Create res file for new nuc
  391.     call CreateResFile
  392.     word0  call reserror  i->l  ?error 169
  393.     ['] nogo  onError
  394.     0  buf255  call OpenResFile  drop  chk
  395.     'type APPL  'type MOPS  set: fFcb    \ Set type & sig of appl
  396.     $ 21  fFcb $ 28 + c!                \ Set Bundle bit
  397.     setFileInfo: fFcb
  398.     'type WIND  256  copyRes            \ Copy fWind (WIND 256)
  399.     'type BNDL  128  copyRes            \ And don't drop our BNDL (128)
  400.     132 128 do
  401.         'type ICN#  i  copyRes            \ Copy ICN# and icl8 resources
  402.         'type icl8  i  copyRes
  403.     loop
  404.     'type ics8  128  copyRes            \ And we have one ics8 resource too
  405.     132 128 do
  406.         'type FREF  i  copyRes            \ Copy FREFs
  407.     loop
  408.  
  409.     'type SIZE  -1  copyRes                \ And SIZE -1
  410.     'type ALRT 900  copyRes                \ And ALRT and DITL for alert"
  411.     'type DITL 900  copyRes
  412.     
  413. \ Now we create the new version resource whose text we get from STR 50.
  414.  
  415.     'type STR  50  set: srcRes  getNew: srcRes
  416.     ptr: srcRes  size: srcRes  put: $tmp
  417.     'type MOPS  0  set: dstRes
  418.     len: $tmp  dup align  new: dstRes
  419. \    get: $tmp  str255  ptr: dstRes  over  c@ 1+ cMove
  420.     ptr: $tmp  ptr: dstRes  len: $tmp  cmove
  421.     release: $tmp
  422.     nullOSstr  addRes: dstRes
  423.     saveCode                            \ Add code resources
  424.     bye  ;                                \ That's all, folks
  425.  
  426.  
  427. \            ===============================================
  428.  
  429. \                        Initial INSTALL dialog
  430.  
  431. \            ================================================
  432.  
  433. true    value    ICURS
  434. false    value    CANCELLED?
  435.  
  436. \ scroll bars for Stack and Dictionary headroom
  437.  
  438. vScroll    VS1        180 15 48  init: vs1
  439. vScroll    VS2        180 85 48  init: vs2
  440.  
  441. button    SAVEBTN        238 20 " Save"        init: saveBtn
  442. button    INSTBTN        236 45 " Install"    init: instBtn
  443. button    CANBTN        236 70 " Cancel"    init: canBtn
  444. button    HEAPBTN        150 145 " Max Heap"    init: heapBtn
  445.  
  446. radioButton    mxSt    197 14  " ++"   init: mxSt
  447. radioButton    miSt    197 46     " --"    init: miSt
  448. radioButton mxDi    197 84     " ++"    init: mxDi
  449. radioButton miDi    197 116 " --"    init: miDi
  450.  
  451.  
  452. \ Rectangles for formatting screen.  These probably should be rewritten as
  453. \ child views, rather than just drawn directly in the window, but this is
  454. \ now "legacy code"!
  455.  
  456. rect stRect        20 29 170 49    put: stRect        \ stack headroom
  457. rect hpRect        20 64 170 84    put: hpRect        \ heap start size
  458. rect diRect        20 99 170 119    put: diRect        \ Dictionary headroom
  459.     
  460. rect wRect        100 40 400 210    put: wRect
  461.  
  462.  
  463. \ get current limits for stack and dict based on minHeap
  464.  
  465. : MAXSTACK  curStack curHeap minHeap - +  ;
  466. : MAXDICT   curDict  curHeap minHeap - +  ;
  467.  
  468. 20000    value    MINSTACK
  469.   128    value    MINDICT
  470.  
  471. : .VAL  { n theRect -- }    \ print number in rect
  472.     noClip
  473.     theRect ->: tempRect
  474.     4 4 inset: tempRect 100 putTopX: tempRect clear: tempRect
  475.     104 getboty: tempRect 2- gotoxy n 7  .r  ;
  476.  
  477. : .VS1    curStack stRect .val curHeap hpRect .val  ;
  478. : .VS2    curDict  diRect .val curHeap hpRect .val  ;
  479.  
  480.  
  481. \ Define the Install utility window
  482.  
  483. window+        IWIND
  484. view        IVIEW                \ This will be the contView for IWIND
  485.  
  486.  
  487. :a  DRAWIVIEW
  488.     draw: stRect draw: hpRect draw: diRect
  489.     2 tmode 0 tfont 12 tsize
  490.     24 43 gotoxy ." Stack:"
  491.     24 78 gotoxy ." Heap:"
  492.     24 113 gotoxy ." Dictionary:"  .vs1 .vs2
  493. ;a
  494.  
  495. \ CFAS{ null null drawIwind null }  actions: iWind
  496.  
  497. ' drawIView  setDraw: iView
  498.  
  499.  
  500. \ Create new window, controls
  501.  
  502. : INSTALL
  503.     release: callsMod                \ this will guarantee us 500K!
  504.     vs1  addView: iView   vs2  addView: iView
  505.     mxSt addView: iView  miSt addView: iView
  506.     mxDi addView: iView  miDi addView: iView
  507.     saveBtn addView: iView
  508.     instBtn addView: iView
  509.     canBtn    addView: iView
  510.     heapBtn    addView: iView
  511.     false -> cancelled?
  512.     wRect "  " dlgWind true false  iView  new: iWind
  513.     2000 32000 putRange: vs1  0 8000 putRange: vs2
  514.     4000 dup put: vs1  put: vs2
  515.     stkspace -> curStack  dicsize -> curDict
  516.     -curs   arrowCurs  draw: iWind
  517. \    BEGIN  key drop  cancelled?  UNTIL  ;    \ 27Feb94 DBH
  518.     EventLoop                                \ 27Feb94 DBH
  519. ;
  520.  
  521. : stDn    curStack 8 -  minStack max -> curStack  .vs1  ;
  522. : stUp    curStack 8 +  maxStack min -> curStack  .vs1  ;
  523.  
  524. : diDn    curDict 32 -  minDict max -> curDict  .vs2  ;
  525. : diUp    curDict 32 +  maxDict min -> curDict  .vs2  ;
  526.  
  527. XTS{  stUp stDn null null null  }  actions: vs1
  528. XTS{  diUp diDn null null null  }  actions: vs2
  529.  
  530.  
  531. : CONFIG        close: iWind  setMem  saveNuc  ;
  532. : WINSTALL        close: iWind  setMem  doInstall  ;
  533. : CANCEL        close: iWind  drop: instlmod  icurs -> curs
  534.                 true -> cancelled?  ;
  535.  
  536. : DOMXST        curStack 4096 + maxStack min -> curStack .vs1  ;
  537. : DOMIST        curStack 4096 - minStack max -> curStack .vs1  ;
  538. : DOMXDI        curDict 16384 + maxDict min -> curDict .vs2  ;
  539. : DOMIDI        curDict 16384 - minDict max -> curDict .vs2  ;
  540. : DOMXHP        minStack -> curStack .vs1  minDict -> curDict .vs2  ;
  541.  
  542. ' config   setClick: saveBtn
  543. ' wInstall setClick: instBtn
  544. ' cancel   setClick: canBtn
  545. ' doMxSt   setClick: mxSt
  546. ' doMiSt   setClick: miSt
  547. ' doMxDi   setClick: mxDI
  548. ' doMiDi   setClick: miDi
  549. ' doMxHp   setClick: heapBtn
  550.  
  551. endload                    \ ***
  552.  
  553. \ testing
  554.  
  555. true  setinstall: testmod
  556. compile: testmod
  557.  
  558. 20000 allot
  559.  
  560. : go
  561.     10 0 DO  ." hello there!!"  cr  LOOP
  562.     bb  .mods
  563.     500000 0 DO LOOP
  564.     bye  ;
  565.  
  566. : crash    cr cr ." Oh no!!!"
  567.     500000 0 DO LOOP  bye  ;
  568.