--- \ load screen for 68k assembler 12/23/86 " forth.data" 16 fload \ get calculated goto " forth.data" 18 fload \ get 1-dimensional arrays octal 12 124 loads \ load screens 10 through 93 decimal forth definitions --- --- --- \ error messages 11/25/86 empty stack dictionary full wrong addressing mode isn't unique out of range disc range ? full stack disc error ! string stack empty string stack overflow can't redirect input string too small wrong operand size Hewlett Packard Integral Personal Computer forth --- \ error messages compilation only, use in definition execution only conditionals not paired definition not finished in protected dictionary use only when loading off current editing screen declare vocabulary --- --- --- --- \ FIG-Forth notice This version of forth is based on the FIG-Forth model provided through the courtesy of the: Forth Interest Group P. O. Box 1105 San Carlos, Ca. 94070 (release 1 with compiler security and variable length names) Further distribution must include the above notice. It was adapted for the Hewlett Packard Integral Personal Computer by Lawrence Woestman. \ startup load screen 12/23/86 50 load 150 get \ standard setup load screen 12/23/86 50 load \ get 'get' and 'save' 80 8 loads \ get misc stuff 30 load \ get 'disforther' " screen_ed.data" 1 fload \ get screen editor 150 save \ error messages 11/25/86 empty stack dictionary full wrong addressing mode isn't unique out of range disc range ? full stack disc error ! string stack empty string stack overflow can't redirect input string too small wrong operand size Hewlett Packard Integral Personal Computer forth \ error messages compilation only, use in definition execution only conditionals not paired definition not finished in protected dictionary use only when loading off current editing screen declare vocabulary \ trace colon words forth definitions 0 variable tflag : (trace) \ give trace output. to be inserted as first word tflag @ \ trace if #0 if cr ." ..." r 4 - nfa dup id. ( print name ) c@ 31 and 32 swap - spaces ( name ) .s \ stack then ; : : \ redefined to insert trace word after colon ?exec !csp current @ context ! create ' (trace) cfa dup @ here 4 - ! , ] ; immediate ;s \ double number enhancements 5/28/85 : d>r r> rot rot >r >r >r ; : dr> r> r> r> rot >r ; : ddup over over ; : ddrop drop drop ; : dswap rot >r rot r> ; : drot d>r dswap dr> dswap ; : dover d>r ddup dr> dswap ; : d> rot swap ddup = if ddrop > else > swap drop swap drop then ; : d< dswap d> ; : d= rot = rot rot = and ; : d@ dup 4 + @ swap @ ; : d! swap over ! 4 + ! ; : dvariable ; : dconstant d@ ; : d/ swap over /mod >r swap u/ swap drop r> ; : d* dup rot * rot rot u* rot + ; : d/mod u/ ; ;s \ i' j j' k k' 2* 2^ : i' ( _ return stack-2 ) r> r> i swap >r swap >r ; : j ( _ return stack-3 ) r> r> i' swap >r swap >r ; : j' ( _ return stack-4 ) r> r> j swap >r swap >r ; : k ( _ return stack-5 ) r> r> j' swap >r swap >r ; : k' ( _ return stack-6 ) r> r> k swap >r swap >r ; : 2* ( n _ 2n ) dup + ; : 2^ ( n _ 2^n ) 1 swap -dup if 0 do 2* loop then ; ;s \ case of endof endcase 01/27/87 \ adapted from "just in case" by Dr. Charles E. Eaker, in \ forth dimensions ii/3 : case ?comp csp @ !csp 4 ; immediate : of 4 ?pairs compile over compile = compile 0branch here 0 , compile drop 5 ; immediate : endof 5 ?pairs compile branch here 0 , swap 2 [compile] endif 4 ; immediate : endcase 4 ?pairs compile drop begin sp@ csp @ = 0= while 2 [compile] endif repeat csp ! ; immediate ;s \ documentation for case 5/26/85 \ A case statement may contain any number of of...endof \ pairs, and the constants may be arranged in any order. \ Between an endof and the next of the programmer may insert \ as much code as he wishes, including code to compute the \ "constant". Case statements may be nested; a case...endcase \ pair may appear between an of...endof pair. Furthermore, \ there need not be any code between case and endcase, nor \ must there be code between of and endof. There must be code \ which pushes a number to the stack prior to each of. \ : example case \ 0 of do0thing endof \ 1 of do1thing endof \ 2 of endof \ wrong-number \ endcase ; \ computed goto 5/26/85 \ adapted from Forth Dimensions II/3 by David Kilbridge : (cgoto) ( n _ ) \ execute n'th word in list dup + dup + 0 max r @ 8 - min \ truncate to be in list r> dup dup @ + >r + 4 + @ execute ; : cgoto ( n _ ) \ execute n+2'th word in list compile (cgoto) here 0 , 2 ; immediate ;s example: value cgoto value<=0 value=1 ... value=n-1 value>=n then where n is the number of references between cgoto and then. \ matrix(1d) : matrix(1d) \ defining word for 1-dimensional arrays swap dup + dup + + ; ;s ---------------------------- an nx1 matrix with name array1 is defined as follows: n matrix(1d) array1 array1 is used in the form: s array1 where s=0 through n-1 and array1 returns the address of the s'th vector element. \ matrix(2d) : matrix(2d) \ defining word for 2-dimensional arrays rot over @ * dup + dup + + swap dup + dup + + 4 + ; ;s ---------------------------- an n1xn2 matrix with name array2 is defined as follows: n1 n2 matrix(2d) array2 array2 is used in the form: s1 s2 array2 where s1,s2=0 through n-1 and array2 returns the address of the s1,s2'th element. \ matrix(3d) : matrix(3d) \ defining word for 3-dimensional arrays rot over @ * rot + dup + dup + swap 4 + rot over @ * dup + dup + + + 4 + ; ;s ---------------------------- an n1xn2xn3 matrix with name array3 is defined as follows: n1 n2 n3 matrix(3d) array3 array3 is used in the form: s1 s2 s3 array3 where s1,s2,s3=0 through n-1 and array3 returns the address of the s1,s2,s3'th element. \ virtual (disk) numeric array 9/22/86 : 1d_virtual_array \ one-dimensional numeric array \ stored on disc blocks ( index pfa _ ) @ swap \ get the starting block # 4 b/buf */mod \ convert index to block, offset rot + block \ get correct block from disc + \ get address of indexed number ; \ to 0 variable %var \ if 1 then store, otherwise fetch : to 1 %var ! ; : from 0 %var ! ; : (( r> %var @ >r >r from ; \ preserve %var flag : )) r> r> %var ! >r ; \ restore %var flag : variable ( defined to observe to ) %var @ if ! from \ set, so store else @ then ; \ clear, so fetch \ .base h. o. b. : .base ( _ ) \ prints current base in decimal base @ dup decimal . base ! ; : based. \ : n _ \ create base-specific stack-print operators @ base @ swap base ! swap . base ! ; 16 based. h. \ print tos in hex 8 based. o. \ in octal 2 based. b. \ in binary \ random number generator decimal 0 variable seed : (rand) ( _ random# ) \ generates 0 <= random# <= 32767 seed @ 259 * 3 + 32767 and dup seed ! ; : random ( range _ random# ) \ 0 <= random# <= range-1 (rand) 32767 */ ; ;s \ view : view ( _ ) \ list source screen of definition [compile] ' nfa 4 - @ -dup if list endif ; : >doc< ( _ ) \ save screen # in definition blk @ b/scr / , ; : constant >doc< [compile] constant ; : variable >doc< [compile] variable ; : vocabulary >doc< [compile] vocabulary ; : doc< [compile] doc< [compile] user ; : create >doc< [compile] create ; : : >doc< [compile] : ; ;s \ disforther primitives 5/28/85 \ adapted from HP-9835 forth user's manual 5 variable litlst ] lit (loop) (+loop) branch 0branch [ 4 variable branches ] (loop) (+loop) branch 0branch [ 1 variable strlst ] (.") [ 1 variable $strlst ] (") [ 2 variable terminators ] ;s (;code) [ --> \ more disforther primitives : element? ( n \ list _ pos ) \ list is searched for n dup 4 + \ address of first value in list swap @ 4 * \ number of bytes in list over + swap \ loop from first value to last value do i @ \ get a value over = \ is it the one being searched for? if drop i 0 \ yes: put index of value, FALSE on stack leave \ and leave the loop then 4 +loop \ look at next value if 0 then \ if didn't find it, put FALSE on stack ; --> \ more disforther primitives 5/28/85 : inline-(.") \ addr of (.") _ addr after string 4 + count \ get the addr and length of the string over over type \ duplicate them, type the string + 1+ even ; \ advance to the end of the string : inline-(") \ addr of (") _ addr after string 4 + strlen \ get the addr and length of the string over over type \ duplicate them, type the string + 1+ even ; \ advance to the end of the string : inline-literal ( addr of word _ addr after literal ) dup @ branches element? \ is literal a branch? if dup 4 + dup @ + \ yes: figure resulting addr else dup 4 + @ \ no: get literal value endif u. 8 + ; --> \ output and skip addr or value \ more disforther primitives 5/28/85 : print-word ( address of word _ address after word ) >r cr r 0 6 d.r \ output address of word, r @ 0 6 d.r space space \ cfa of defn. at word, r @ 4 + nfa id. \ name of defn. at word r @ strlst element? \ does defn. use inline (.")? if r> inline-(.") \ handle an inline (.") else r @ $strlst element? \ does defn. use inline (")? if r> inline-(") \ handle an inline (") else r @ litlst element? \ does defn. use inline litera if r> inline-literal \ handle a literal else r> 4 + \ else advance to next word endif endif endif ; --> \ more disforther primitives : print-def ( pfa _ ) \ print the words in a colon definition begin dup @ terminators element? 0= while \ while the word is not a terminator print-word \ print the word repeat print-word drop ; \ print the terminator definition --> \ disforth : disforth ( disforth cccc ) [compile] ' \ get pfa of cccc dup nfa cr id. \ print name of cccc dup nfa c@ 64 and if ." ( immediate ) " then dup cfa @ [ ' . cfa @ ] literal = if print-def \ colon definition else dup cfa @ [ ' fence cfa @ ] literal = if ." is a user variable. offset: " @ . cr else dup cfa @ [ ' 0 cfa @ ] literal = if ." is a symbolic constant. value: " @ . cr else dup cfa @ [ ' use cfa @ ] literal = if ." is a variable. contents: " @ . cr else ." is a code def. " cr drop then then then then ; ;s \ editor \ adapted from fig-forth installation manual provided \ through the courtesy of the forth interest group \ p.o box 1105, san carlos, ca 94070 vocabulary editor immediate hex : where ( scr# \ offset _ ) \ disp screen # and image of error dup b/scr / dup scr ! ." scr# " decimal . swap c/l /mod c/l * rot block + cr c/l type cr here c@ - spaces 5E emit [compile] editor quit ; --> \ line editor editor definitions : #locate ( _ cursor offset \ line ) r# @ c/l /mod ; : #lead ( _ line addr \ offset to cursor ) #locate line swap ; : #lag ( _ cursor address \ count after cursor ) #lead dup >r + c/l r> - ; : h \ hold numbered line at pad line pad 1+ c/l dup pad c! cmove ; --> \ line editing commands : m \ move cursor by signed amount-1, disp its line r# +! cr space #lead type 5E emit #lag type #locate . drop ; : t \ type line-1, save also in pad dup c/l * r# ! dup h 0 m ; : i \ insert text from pad onto line dup sl rl ; : top \ home cursor 0 r# ! ; --> \ edit match routine 0 variable len$ 0 variable text^ \ len$: length of string text^: pointer into screen : compare c@ swap c@ - ; \ compare 2 chars on top of stack : setflag swap drop text^ @ - swap dup if swap len$ @ + else swap 1+ endif ; \ push delta text^ and found flag --> \ edit match routine : nextchar rot 1 - dup if rot rot 1+ 0 else rot rot 1 endif ; \ get the next text char if no match found : comparemore len$ @ 1 do over forth i editor + over forth i editor + compare if leave 0 endif loop -dup if 1 else nextchar endif ; \ if first char matches check len$-1 more : match ( cursor addr\bytes left\string addr\its count ) ( leaves boolean\cursor advancement) len$ ! rot dup text^ ! begin over over compare if nextchar else len$ @ 1 - if comparemore else 1 endif endif until setflag ; --> \ string editing commands : 1line \ scan line with cursor for match to pad text \ update cursor, return boolean #lag pad count match r# +! ; : find \ string at pad over full screen range, else error begin 3FF r# @ < if top pad here c/l 1+ cmove 0 error endif 1line until ; : delete \ backwards at cursor by count-1 >r #lag + forth r - \ save blank fill location editor #lag forth r editor minus r# +! #lead + swap cmove r> blanks update ; \ fill from end of text --> \ string editor commands : n \ find next occurance of previous text find 0 m ; : f \ find occurance of following text 1 text n ; : b \ backup cursor by text in pad pad c@ minus m ; : x \ delete following text 1 text find pad c@ delete 0 m ; : till \ delete on cursor line, from cursor to text end #lead + 1 text 1line 0= 0 ?error #lead + swap - delete 0 m ; --> \ string editor commands : c \ spread at cursor and copy in the following text 1 text pad count #lag rot over min >r forth r r# +! \ bump cursor r - >r \ chars to save dup here r cmove editor \ from old cursor to here here #lead + r> cmove \ here to cursor location r> cmove update \ pad to old cursor 0 m ; \ look at new line : dc \ delete characters-1, reshow line delete 0 m ; forth definitions decimal ;s \ get/save primitives forth definitions octal : block-data @ swap block + ; \ compile: offsetinblock _ run: block# _ address 100 block-data s_start 104 block-data s_dp 110 block-data s_context 114 block-data s_voc-link 120 block-data s_forth_ptr 124 block-data s_fence here constant start-addr \ start addr for save decimal --> \ save-data get-data : save-data ( block# _ ) \ save the pointers [compile] forth definitions start-addr over s_start ! dp @ over s_dp ! context @ over s_context ! context @ @ over s_forth_ptr ! voc-link @ over s_voc-link ! fence @ swap s_fence ! ; : get-data ( block# _ ) \ restore the pointers dup s_dp @ dp ! dup s_context @ context ! dup s_forth_ptr @ context @ ! definitions dup s_voc-link @ voc-link ! s_fence @ fence ! ; --> \ figure-size : figure-size ( _ #ofblocks ) \ computes the number of blocks needed to hold defns here start-addr - 1 - b/buf / 1+ ; --> \ get : get ( screen# _ ) \ load precompiled defns from screens b/scr * \ convert to block# dup s_start @ start-addr = 0= if ." addresses don't match " drop else dup get-data 1+ \ skip data block start-addr swap figure-size over + 1+ swap \ set up limits do i block over b/buf cmove b/buf + loop drop endif ; --> \ save : save ( screen# _ ) \ save ram starting at start-addr \ out to m.s. starting at screen# b/scr * ( to block # ) dup save-data update start-addr swap 1+ figure-size dup b/scr / 1+ cr ." used " . ." screens " cr over + 1+ swap do dup i block b/buf cmove update b/buf + loop drop flush ; here ' start-addr ! \ set start-addr to start after these definitions ;s \ string functions load screen next_screen 7 loads \ $variable $input 6/17/85 : $variable ( builds: max_number_of_chars _ ) ( does: _ addr_of_first_char ) ; \ leave address of first char : $input ( _ ) \ input a string to the string stack pad 80 expect \ read 80 chars or until a NL to pad pad $@ ; \ move chars from pad to string stack \ $drop $length $dup $! : $drop ( _ ) \ drop string from stack ( error checking ) $stack_empty? ($drop) ; : $length ( _ length of top string on stack ) $stack_empty? $sp@ strlen swap drop ; : $dup ( _ ) \ duplicate top string on stack $stack_empty? $sp@ $@ ; : $! ( addr _ ) \ store the top string on stack at address $stack_empty? \ error if no string on stack $sp@ strlen 1+ \ get length of string including null rot swap cmove \ copy string from stack to addr ($drop) ; \ remove string from string stack \ two_strings? $swap : two_strings? ( _ ) \ error message if not two strings on stack $stack_empty? \ error if no first string $sp@ after_string \ get address of second string addr_empty? ; \ error if no second string : $swap ( _ ) \ swap top two strings on stack two_strings? \ error if not two strings on stack pad $! \ store first string temporarily at pad pad after_string \ get addr following first string dup $! \ store second string following first pad $@ $@ ; \ fetch strings in reverse order \ & : & ( _ ) \ concatenate top string to front of next string two_strings? \ error if not two strings pad $! \ store to string at pad pad after_string \ get addr of end of string 1 - $! \ store next string onto end of first pad $@ ; \ fetch combined string to stack \ chr$ num : chr$ ( n _ ) \ create a string of one char on stack from n pad c! \ store n at pad 0 pad 1+ c! \ put a null after n pad $@ ; \ fetch string to string stack : num ( _ n ) \ ordinal of first char in top string $stack_empty? \ error if no string on stack $sp@ c@ \ get first char of string (0 if null) ($drop) ; \ drop string from stack \ $_to_double double_to_$ : $_to_double ( _ d ) \ convert top string to double number \ no leading blanks, at least one trailing blank needed $length pad c! \ put length of string at pad pad 1+ $! \ store string at pad pad number ; \ convert string to number : double_to_$ ( d _ ) \ convert double number to top string swap over dabs \ set up to convert double number <# #s sign #> \ convert double number to string over + 0 swap c! \ put a null at end of string $@ ; \ fetch string to string stack \ $extract 6/17/85 : $extract ( pos count _ ) \ replace top string on stack with \ substring 'count' chars long starting at offset 'pos' over over + \ make sure substring specified fits $length 1+ > \ in top string on stack 12 ?error \ error if string too small pad $! \ store top string at pad swap pad + \ get addr of first char of substring dup rot + \ get addr of first char after substring 0 swap c! \ put null at end of substring $@ ; \ fetch substring to string stack \ ascii control 8/27/86 : ascii ( _ n ) \ return value of first char following bl word \ get following word from input stream here 1+ c@ \ get the first char of the word state @ \ check the state if \ if compiling compile lit , \ compile lit and the value of the char endif ; immediate : control ( _ n ) \ return control code of first char bl word \ get following word from input stream here 1+ c@ \ get the first char of the word 31 and \ make it a control character state @ \ check the state if \ if compiling compile lit , \ compile lit and the control code endif ; immediate \ depth 8/27/86 : depth ( _ n ) \ return the current depth of the stack sp@ \ get current stack pointer value s0 @ \ get original stack pointer value swap - \ get difference between values 4 / \ divide by size of stack (in bytes) 0 max ; \ bounds check depth of stack \ pick 8/27/86 : pick ( n _ n'th_stack_value ) \ pick n'th value from stack 1+ \ account for n being on the stack dup + dup + \ multiply by size of stack value (4) sp@ + \ add offset to stack pointer @ ; \ fetch the stack value \ data-file 12/23/86 : data-file ( _ ) \ attempt to make the file name on the \ string stack the forth data file 2 0 open \ attempt to open the file dup 0< \ save a copy of the file descriptor if \ if it is < 0, then error on open drop ." error " errno . \ report error number ." opening file" else flush empty-buffers \ make sure old file is up to date disk_fd @ close \ close old data file drop \ ignore any error message disk_fd ! \ select new data file endif ; \ fload 9/16/86 : fload ( n _ ) \ load block n from file name on string stack 2 0 open dup 0< \ attempt to open the file if drop drop ." error " errno . ." opening file in fload" else disk_fd @ >r \ save current file descriptor flush empty-buffers \ make sure file is up to date disk_fd ! load \ set to new file and load flush empty-buffers \ make sure file is up to date disk_fd @ close 0< \ attempt to close the file if ." error " errno . ." closing file in fload" endif r> disk_fd ! \ restore old file descriptor endif ; \ printer display pages 11/24/86 output_fd @ variable display_fd \ save the current display_fd : printer ( _ ) \ set the output_fd to the printer printer_fd @ output_fd ! ; : display ( _ ) \ set the output_fd back to the display display_fd @ output_fd ! ; : pages ( start_screen end_screen _ ) \ output screens as pages printer \ output to printer 2+ swap \ make sure to include last screen do \ do pages i triad 3 +loop display ; \ set output back to display \ .char 12/04/86 : .char ( c _ ) \ emit printable chars dup dup \ get two copies of char 32 < swap \ is char unprintable? 126 > or if drop 46 \ if yes, replace it with a "." endif emit \ output the char ; \ wdump 12/04/86 : wdump ( start_addr count _ ) \ dump data a word at a time cr even over + swap \ set up range to dump do i 0 11 d.r space \ output address i @ 0 11 d.r space \ output long at address i w@ 7 .r space \ output word at address i c@ 5 .r space \ output byte at address i 1+ c@ 5 .r 3 spaces \ output byte at address + 1 i c@ .char \ output char at address i 1+ c@ .char cr \ output char at address + 1 ?terminal if leave then \ stop? if yes, leave loop 2 +loop ; lfFF||Th ascii k12@66B1P5Z1:+:"+`6/vcontrol lf12@66B1P+`.x5Z1:+:"+`6/vdepth l1/31:072IN2HN/vpickl16B004004/041:/vdata-file m4122Z00 +60<error 3S< opening file+$JJ6 1:**06 1/vfload mf122Z00 +D00<error 3S<opening file in fload +6 1:/JJ6 1MrJJ6 1:**0 +4<error 3S<closing file in fload /6 1/vdisplay_fdm2dprinter n16 1:51/vdisplay n1n1:51/vpages o1n6V0,F,`T2,o$/v.char o<100+` 7T0+`~7~.+0+`.(*/vwdump ox1(< is a symbolic constant. value: 1:S(+v081:+`27*+8<is a variable. contents: 1:S(+"< is a code def. (0/vcaset19L51:82/vofu129:"0:"7*:"+626:"0+`/vendof u1+`9:"+62602P2/vendcase v$129:"0/51:7*/+2P+51/v$variable vh1;N602>6Cp;j/v$inputv1?t+`P=J?tX/v$drop v1XX/v$length w&1XW~W00/v$dupwB1XW~X/v$!wl1XW~W6B70-X/vtwo_strings?w1XW~WX /v$swap w1w?tw?tW0w?tXX/v& w1w?tw?tW27w?tX/vchr$x 1?t12?t6B1?tX/vnum xX1XW~1PX/v$_to_double x1wP?t1?t6Bw?tA/vdouble_to_$ x100GR*RRtRF004201X/v$extractx10004wP6B7~+` 9?tw0?t040704201X/v(sy41+`)@/v(py1+`)@/vascii y12@66B1P5Z1:+:"+`6/vdepth y1/31:072IN2HN/v1-z127/v<>zR17*//v2dupzj100/v2drop z100/vbeepz1+`(*/vboundsz10040/vbmove z17+\//04zZ0zZ/z0,F,`1P01zZ+`,0+z/vmovez177zD+7{+ 7-/vcase: {r1;N:n:;j02I041:+z/v-tidy {1z,F,`1P27T+2,`1+/veditor{;FT F&mode Fx2d&cursor |X2d&update |l2d&buf-adr|2d&e-id |2d %x-off|2B%y-off|2Bc/scr |2Bl/scr |2Be-fcn } 2d&end-screen }2d'crtxy}22d 'crtclr-scr }L2dn'clear-to-eol }`2dcrtxy }z1}X1:+z/vcrtclr-scr}1}r1:+z/vclear-to-eol}1}1:+z/vcurpos}1|z1:/v+curpos ~1|z1~ 2HN+`H |z1/vmove-cursor ~1~*~ 2I.|040|040}/vbuf-adr ~Z1|1:04/vbufpos~1~ ~/ve-update~12|1/vinit-variables~12|d12|z12|1/vbuf-move17~7~7{|~/v?printable@10+` 7T0+`~7~.//v>line#r12IN/vline#>12I/vchars-to-eol12Il207/vchars-to-eos1}07/vdisplay-to-eol10~0<7004/;/}/v?empty-line >1~2<00//vdisplay-to-eos1~ 0}0,F,`0|z12~lR+|z12~l/vexpand100204}07N~2?,~/vshrink(1020400}07N+`~2?,~/vinsert-line l1+`+04+z/vdelete-line 10x/vins-char 1006B0zZN~1/vdel-char41006B00N004zZ~201/vr-arrow n12~*/vl-arrow 1+`~*/vu-arrow 120p~*/vd-arrow 12~*/vi-line"1~ /vd-line@1~ /vd-char\1~ |~ R/vinsert-mode x1|d21"+`(2}|d1:+< Insert ON ++` Q/vreturn1~ 6B+`H |z1/ve-tab 12~ 2Il7~*/vclr-screen>1~ ~~ *?,~ ~/v$xy j;v&a00r28C00 00&a00r00Cstore_num_as_chars1/+` I.+`004/1+`004/6B1/v.xydisp 1~ 2I.z+` 04+` 04|04+`04|04+`04+`;/vclr-line,1~ 0~~ ?,~2~l~ }|z1/vmark-update 1}~l((5S|1:+@|+`6~+` -< modified JRJ+< unmodified /v?empty-screen 1K}<00//vscr-expand1JJ,F,`27,`]4+`,/vscr-shrink1JJ0/0,F,`6B,`]4+51:/\51/vquery-user141:/41:/241>2ET/41/41/vget-a-numberx1z&/z&/7*/+ 00/vget-end-screen# 12+`}<enter end screen number? }DS+`+`}}D1:}D12+`}2}2~l}D1:/vdel-screen151:0z7T+4(51:K|12+z00/vdo-ins-screen 10++z00/vins-screen0151:0z7T+<~ /D/|z151:K|1+z00/vget-user-id t1|+` </+(<enter your id: +` 2,F+`.(*++` 2,F+`(*++` =J|+` {+0/vinit-terminal 1+`(*<&s1A+`(*<&f2a5k8d2L Ins Scr+`(*<t +`(*<&f2a6k8d2L Del Scr+`(*<u +`(*<&f2a7k8d2L Abort +`(*<v +`(*<&f2a8k8d2L Exit +`(*<w /vrestore-terminal1+`(*<&s0A+`(*< &f2a5k-1d-1L+`(*< &f2a6k-1d-1L+`(*< &f2a7k-1d-1L+`(*< &f2a8k-1d-1L/vprevious1/0/0/0/0/051:27}*1:+z/vnextj1/0/0/0/0/051:6B}*1:+z/vexit-edit 1(/0/0/0/0/0/0/vexit-update 1./vexit-scratchn1}~l((5S< abandoned ./vspecial-keys1(t+`A07*+0++`B07*+00+l+`C07*+0+D+`D07*+0++`J07*+0z++`K07*+0++`L07*+0L++`M07*+0h+|+`P07*+0+T+`Q07*+0+,+`U07*+0++`V07*+0x++`h07*+02|z1++`t07*+0++`u07*+0+\+`v07*+0+4+`w07*+0+ z0/v(control-char);{zzzzzzzzJzzzzzzzzzzzzzzz/vcontrol-char10+`7*+0+`0+`7T++ 0z/ve-overstrike<1(t0+(0(*~1~2~*+N/ve-insert1(t0+$~ B~ R2~*+N/vdisp_line_numbers 1}2,F,`2Sf(+/ve-initJ151:K|1}2|}b+`2}<scr:51:2Sf2/ve |81z&+ 51:|d1:+ ++/vhpcrtclr-scr1+`(*+`h(*+`(*+`J(*/vhpcrtclr-eol\10+`(*+`K(*/vxystring;v&a00r00Chpcrtxy 1204+`04+` ;/vsave tions oaded &a00r00C11