From IVIE@cc.usu.edu Tue Apr 15 22:27:00 1997 Date: Tue, 15 Apr 1997 16:16:48 -0600 (MDT) From: Roger Ivie To: JCOMEAU@WORLD.STD.COM Subject: VAX/VMS forth OK, here's what I have. There are four files attached to this message: - FIGFTHV2.MAR, the Fig FORTH that I've actually run. - FIGFTHV2.RNO, Runoff source for the glossary - FIGFTHV2.MEM, Runoff output for the glossary - FIGFTHV1.MAR, seems to be an earlier version Each file begins with a line of ">>>>"s followed by the filename. Use your favorite editor to extract the files. To build it, just $ MACRO FIGFTHV2 $ LINK FIGFTHV2 $ RUN FIGFTHV2 The primary downside is that it's still a 16-bit FORTH. If you want a 32-bit VAX FORTH, let me know; I have one that I download over the Ethernet to one of my VAXes when I'm checking out custom hardware. It's only loosely based on FIG, though. Roger Ivie ivie@cc.usu.edu >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> FIGFTHV2.MAR .title FIGFORTH VAX-11 fig-Forth Version 2.0 ; ; This public domain software is provided through the coutesy of ; ; Central Iowa FIG, Iowa State University, Ames, IA 50011 ; by Rodrick A. Eldridge, Iowa State University ; ; ; The public domain VAX-11 fig-Forth Version 1.0 is provided through ; the coutesy of ; ; Forth Interest Group, P.O. Box 1105, San Carlos, CA 94070 ; ; ; Further distribution must include these notices ; ; ; VAX-11 fig-Forth Version 1.0 ; as distributed by the Forth Interest Group ; ; VAX-11 fig-Forth Version 2.0 ; as distributed by the Central Iowa FIG (CIFIG) ; ; added HEAD and LINK macros ; added UPCASE to allow upper case input ; added OCTAL and BINARY for octal and binary base ; added L/S constant for lines per screen ; added HELP for online help ; added NEED for easier screen loading ; added INPUT for EXPECT to control $QIO func modifier ; added OUTPUT for TYPE to control $QIO func modifier ; added SAVE-SYSTEM to save binary code from TASK to HERE ; added LOAD-SYSTEM to load binary code saved by SAVE-SYSTEM ; added STATUS variable set by HELP, NEED, ; BLOCK-READ, BLOCK-WRITE, SAVE-SYSTEM, and LOAD-SYSTEM ; added MAXERRS and code to trap software errors and interrupts ; added DIR to set "FORTHn:" logical name ; added DEFDIR and DEFSCR as 0 and 4, respectively ; changed inline code of "next" to BRW NEXT ; changed all internal labels to local labels ; changed BLOCK-READ and BLOCK-WRITE to do SEQL I/O ; changed TYPE to code for faster terminal output ; changed EXPECT to code for faster terminal input ; changed ID. to print hex value for 1 character words < ^x20 ; changed ?STACK to catch stack error sooner ; changed "SYS$DISK:" to "FORTHn:" logical name ; changed DR0, DR1 to execute DIR with 0 and 1, repectively ; changed MESSAGE to look at DEFDIR for SCR # DEFSCR ; changed order of definitions ; renamed labels to pronounceable label names ; renamed labels to standard figForth label names ; removed DI user variable ; removed TRIAD definition ; ; Register Usage ; ; R3 (UP) user pointer ; R4 work register ; R5 work register ; R6 (IP) instruction pointer ; R7 ( W) word pointer ; R8 (RP) return stack pointer ; R9 (SP) computational stack pointer ; R10 work register ; R11 work register ; Macros link1 = 0 .macro head link2 = . .endm .macro link .word link1 link1 = link2 .endm $iodef $ssdef $chfdef $fibdef $rmsdef $lbrdef .default displacement,word .psect virtual_machine, wrt,exe,long .entry FIGFORTH, ^m $assign_s chan=input_chan,- devnam=input_name $assign_s chan=output_chan,- devnam=output_name calls #0,ctrlcast clrw ctrlc clrl r0 10$: moval trap,(fp) tstl r0 beql 20$ calls #0,warm_start brw 10$ 20$: calls #0,cold_start brw 10$ input_name: .ascid /SYS$INPUT/ input_chan: .blkw 1 output_name: .ascid /SYS$OUTPUT/ output_chan: .blkw 1 errcnt: .word 0 errmsg: .ascic /%FORTH-F-MAXERRS, exceeded maximum number of errors allowed/ depth: .long 1 ; error trap routine trap: .word 0 clrl r5 addw3 #^x0E,r3,r5 tstw (r5) beql 10$ movl chf$l_sigarglst(ap),r1 pushl #1 pushl chf$l_sig_name(r1) $putmsg_s msgvec=(r1) bsbw crlf 10$: incw errcnt clrl r5 addw3 #^x3A,r3,r5 cmpw errcnt,(r5) blss 20$ movzbw errmsg,r11 moval errmsg+1,r10 bsbw crlf bsbw xoutput bsbw crlf $exit_s r0 20$: movl r0,xstatus $unwind_s depadr=depth ret ; cold start routine cold_start: .word 0 clrl r3 clrl r4 clrl r5 clrl r6 clrl r7 clrl r8 clrl r9 clrl r10 clrl r11 movaw xorigin,r10 movaw forth+14,r11 movw (r10),(r11) ; initialize top of dictionary movw xuser,r4 ; initialize all user variables brw setup ; warm start routine warm_start: .word 0 clrl r4 movw #^x08,r4 ; re-initialize top 8 user variables ; setup user variables setup: movaw xorigin+4,r10 movw (r10),r3 ; initialize user pointer movaw xorigin,r10 movw r3,r11 10$: movw (r10)+,(r11)+ ; initialize user variable sobgtr r4,10$ movaw abort+2,r6 ; set instruction pointer to ABORT brw rpstore+2 ; start to RP! .long ^x11078020 ; VAX 11/780 Forth Version 2.0 xorigin: .word taskhead ; highest word defined .word ^x7F ; backspace .word endforth+^x5000 ; user area .word endforth+^x4800 ; s0 .word endforth+^x4FFF ; r0 .word endforth+^x4BFF ; tib .word 31 ; width .word 1 ; warning .word endforth ; fence .word endforth ; dp .word forth+16 ; voc-link .word 0 ; blk .word 0 ; in .word 0 ; out .word 0 ; scr .word 0 ; offset .word 0 ; context .word 0 ; current .word 0 ; state .word 10 ; base .word 0 ; dpl .word 0 ; fld .word 0 ; csp .word 0 ; r# .word 0 ; hld .word IO$M_TRMNOECHO ; input .word IO$M_NOFORMAT ; output .word 4 ; defscr .word 0 ; defdir .word 16 ; maxerrs firstb = ^xA000 ; 3 buffers limitb = ^xB80C ; (2K each) + (3 * 4 bytes) xuser: .word 30 ; number of user variables xvoclink: .word 0 xcontext: .word 0 xcurrent: .word 0 xsize = . - xuser ; run time routines next: ; run time next movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) docol: ; run time colon movw r6,-(r8) movw r7,r6 brw next dovar: ; run time variable addw #2,r9 movw r7,(r9) brw next docon: ; run time constant addw #2,r9 movw (r7)+,(r9) brw next douse: ; run time user addw #2,r9 addw3 r3,(r7)+,(r9) brw next ; start of Forth program head .byte ^xC1 .byte ^x80 link .word docol ; : 'null character' .word blk ; blk .word fetch ; @ .word zbranch,20$ ; if .word one ; 1 .word blk ; blk .word plustore ; +! .word zero ; 0 .word in ; in .word store ; ! .word blk ; blk .word fetch ; @ .word lit,7 ; 7 .word and ; and .word zequal ; 0= .word zbranch,10$ ; if .word qexec ; ?exec .word rfrom ; r> .word drop ; drop 10$: ; endif .word branch,30$ ; else 20$: .word rfrom ; r> .word drop ; drop 30$: ; endif .word semis ; ; head .byte ^x81 ; ! .byte ^xA1 link store: .word .+2 movzwl (r9),r10 movw -(r9),(r10) subw #2,r9 brw next head .byte ^x85 ; !code .ascii /!COD/ .byte ^xC5 link storecode: .word docol ; : !code .word create ; create .word smudge ; smudge .word latest ; latest .word pfa ; pfa .word cfa ; cfa .word store ; ! .word comma ; , .word semis ; ; head .byte ^x84 ; !csp .ascii /!CS/ .byte ^xD0 link storecsp: .word docol ; : !csp .word spfetch ; sp@ .word csp ; csp .word store ; ! .word semis ; ; head .byte ^x81 ; # .byte ^xA3 link sharp: .word docol ; : # .word base ; base .word fetch ; @ .word mslashmod ; m/mod .word rot ; rot .word lit,9 ; 9 .word over ; over .word less ; < .word zbranch,10$ ; if .word lit,7 ; 7 .word plus ; + 10$: ; endif .word lit,^x30 ; 48 ( '0' ) .word plus ; + .word hold ; hold .word semis ; ; head .byte ^x82 ; #> .byte ^x23 .byte ^xBE link sharpgtr: .word docol ; : #> .word drop ; drop .word drop ; drop .word hld ; hld .word fetch ; @ .word pad ; pad .word over ; over .word minus ; minus .word semis ; ; head .byte ^x82 ; #s .ascii /#/ .byte ^xD3 link sharps: .word docol ; : #s 10$: ; begin .word sharp ; # .word over ; over .word over ; over .word or ; or .word zequal ; 0= .word zbranch,10$ ; until .word semis ; ; head .byte ^xC1 ; ' .byte ^xA7 link tick: .word docol ; : ' .word mfind ; -find .word zequal ; 0= .word zero ; 0 .word qerror ; ?error .word drop ; drop .word literal ; literal .word semis ; ; immediate head .byte ^xC1 ; ( .byte ^xA8 link paren: .word docol ; : ( .word lit,^x29 ; 41 ( ')' ) .word word ; word .word semis ; ; immediate head .byte ^x87 ; (+loop) .ascii /(+LOOP/ .byte ^xA9 link xploop: .word .+2 tstw (r9) blss 20$ addw3 (r8),(r9),(r8) subw #2,r9 movw (r8)+,r11 subw3 r11,(r8)+,r11 bgtr 10$ addw #2,r6 brw next 10$: subw #4,r8 movw (r6)+,r6 brw next 20$: addw3 (r8),(r9),(r8) subw #2,r9 movw (r8)+,r11 subw (r8)+,r11 bgtr 10$ addw #2,r6 brw next head .byte ^x84 ; (.") .ascii /(."/ .byte ^xA9 link xdotq: .word docol ; : (.") .word r ; r .word count ; count .word dup ; dup .word oneplus ; 1+ .word rfrom ; r> .word plus ; + .word tor ; >r .word type ; type .word semis ; ; head .byte ^x87 ; (;code) .ascii /(;CODE/ .byte ^xA9 link xcode: .word docol ; : (;code) .word rfrom ; r> .word latest ; latest .word pfa ; pfa .word cfa ; cfa .word store ; ! .word semis ; ; head .byte ^x87 ; (abort) .ascii /(ABORT/ .byte ^xA9 link xabort: .word docol ; : (abort) .word abort ; abort .word semis ; ; .align long,0 fab_rblock: $fab alq=1,fac=get,fna=filname,fns=filsize, - fop=sqo,org=seq,rfm=var fab_wblock: $fab alq=1,fac=put,fna=filname,fns=filsize, - fop=sqo,org=seq,rfm=var rab_rblock: $rab fab=fab_rblock,rac=seq,ubf=firstb rab_wblock: $rab fab=fab_wblock,rac=seq,rbf=firstb filname: .ascii /FORTH0:/ bufaddr: .blkb 39 fthaddr: .ascii /.FIG/ filsize = . - filname head .byte ^x8C ; (block-read) .ascii /(BLOCK-READ/ .byte ^xA9 link xblkread: .word .+2 movzwl (r9),r11 movzwl -(r9),r10 pushr #^m movc3 r11,(r10),bufaddr movc3 #4,fthaddr,bufaddr(r11) popr #^m moval fab_rblock,r10 addw #^x0B,r11 movb r11,FAB$B_FNS(r10) $open fab=fab_rblock blbs r0,10$ brw bad_read 10$: $connect rab=rab_rblock blbs r0,20$ brw bad_read 20$: movzwl xbbuf,r10 movzwl -(r9),r11 pushr #^m movc5 #0,(r0),#^x20,r10,(r11) popr #^m moval rab_rblock,r5 movzwl xls,r4 movzwl xcl,r10 movw xbbuf,RAB$W_USZ(r5) 30$: movl r11,RAB$L_UBF(r5) $get rab=rab_rblock blbs r0,40$ cmpl r0,#RMS$_EOF beql 40$ brw bad_read 40$: addl r10,r11 sobgtr r4,30$ movl #^x20533B20,(r11) $close fab=fab_rblock blbs r0,50$ brw bad_read 50$: clrw (r9)+ clrw (r9) brw next bad_read: movl r0,xstatus movw #1,(r9)+ movw #8,(r9) brw next head .byte ^x8D ; (block-write) .ascii /(BLOCK-WRITE/ .byte ^xA9 link xblkwrite: .word .+2 movzwl (r9),r11 movzwl -(r9),r10 pushr #^m movc3 r11,(r10),bufaddr movc3 #4,fthaddr,bufaddr(r11) popr #^m moval fab_wblock,r10 addw #^x0B,r11 movb r11,FAB$B_FNS(r10) movzwl -(r9),r11 $create fab=fab_wblock blbs r0,10$ brw bad_write 10$: $connect rab=rab_wblock blbs r0,20$ brw bad_write 20$: moval rab_wblock,r5 movzwl xls,r4 30$: movzwl xcl,r10 bsbw trailing movw r10,RAB$W_RSZ(r5) movl r11,RAB$L_RBF(r5) $put rab=rab_wblock blbs r0,40$ brw bad_write 40$: movzwl xcl,r10 addl r10,r11 sobgtr r4,30$ $close fab=fab_wblock blbs r0,50$ brw bad_write 50$: clrw (r9)+ clrw (r9) brw next bad_write: movl r0,xstatus movw #1,(r9)+ movw #8,(r9) brw next head .byte ^x84 ; (cr) .ascii /(CR/ .byte ^xA9 link xcr: .word .+2 tstw ctrlc bneq 10$ bsbw crlf clrl r5 addw3 #^x1A,r3,r5 clrw (r5) 10$: brw next output_crlf: .byte ^x0D,^x0A crlf: $qiow_s chan=output_chan,- func=#IO$_WRITEVBLK!IO$M_NOFORMAT,- iosb=io_status,- p1=output_crlf,- p2=#2 rsb head .byte ^x84 ; (do) .ascii /(DO/ .byte ^xA9 link xdo: .word .+2 subw #2,r9 movw (r9)+,-(r8) movw (r9),-(r8) subw #4,r9 brw next io_char: .blkb 1 head .byte ^x86 ; (emit) .ascii /(EMIT/ .byte ^xA9 link xemit: .word .+2 movb (r9),io_char subw #2,r9 tstw ctrlc bneq 10$ $qiow_s chan=output_chan,- func=#IO$_WRITEVBLK!IO$M_NOFORMAT,- iosb=io_status,- p1=io_char,- p2=#1 clrl r5 addw3 #^x1A,r3,r5 addw #1,(r5) 10$: brw next io_status: .blkw 1 io_length: .blkw 1 .blkl 1 head .byte ^x88 ; (expect) .ascii /(EXPECT/ .byte ^xA9 link xexpect: .word .+2 movzwl (r9),r11 movzwl -(r9),r10 subw #2,r9 clrl r5 addw3 #^x32,r3,r5 clrl r4 addw3 #IO$_READVBLK,(r5),r4 $qiow_s chan=input_chan,- func=r4,- iosb=io_status,- p1=(r10),- p2=r11 movzwl io_length,r4 cmpl r4,r11 beql 10$ decl r4 10$: addl r4,r10 incl r10 movw #0,(r10) brw next head .byte ^x86 ; (find) .ascii /(FIND/ .byte ^xA9 link xfind: .word .+2 clrl r4 movzwl (r9),r10 movzwl -(r9),r11 10$: movzbl (r10),r5 xorb3 (r10)+,(r11)+,r4 bitb #^x3F,r4 bnequ 50$ 20$: tstb (r10) bgtr 40$ xorb3 (r10)+,(r11)+,r4 bitb #^x7F,r4 beqlu 60$ 30$: tstw (r10) bnequ 70$ clrw (r9) brw next 40$: xorb3 (r10)+,(r11)+,r4 beqlu 20$ 50$: bitb #^x80,(r10)+ beqlu 50$ brw 30$ 60$: addw #4,r10 movw r10,(r9)+ movw r5,(r9)+ movw #1,(r9) brw next 70$: movw (r10),r10 movw (r9),r11 brw 10$ heldesc: .word helsize .word 0 .long helname helname: .ascii /FORTHx:FIGFORTH.HELP/ helsize = . - helname lbrindex: .long 0 lbrfunc: .long LBR$C_READ lbrtype: .long LBR$C_TYP_TXT recdesc: .long 0 recaddr: .long 0 rfaaddr: .blkl 2 keydesc: .long 0 keyaddr: .long 0 head .byte ^x86 ; (help) .ascii /(HELP/ .byte ^xA9 link xhelp: .word .+2 movzwl (r9),keydesc movzwl -(r9),keyaddr pushr #^m movc3 #7,filname,helname popr #^m pushal lbrtype pushal lbrfunc pushal lbrindex calls #3,g^LBR$INI_CONTROL blbs r0,10$ brw bad_help 10$: pushal heldesc pushal lbrindex calls #2,g^LBR$OPEN blbs r0,20$ brw bad_help 20$: pushal lbrindex calls #1,g^LBR$SET_LOCATE blbs r0,30$ brw bad_help 30$: pushal rfaaddr pushal keydesc pushal lbrindex calls #3,g^LBR$LOOKUP_KEY blbs r0,40$ brw help_not_found 40$: bsbw crlf 50$: tstw ctrlc bneq 60$ pushal recdesc clrl -(sp) pushal lbrindex calls #3,g^LBR$GET_RECORD blbc r0,60$ movl recdesc,r11 movl recaddr,r10 bsbw crlf bsbw xoutput brw 50$ 60$: bsbw crlf clrw ctrlc pushal lbrindex calls #1,g^LBR$CLOSE blbs r0,70$ brw bad_help 70$: clrw (r9)+ clrw (r9) brw next bad_help: movl r0,xstatus movw #1,(r9)+ movw #8,(r9) brw next help_not_found: movl r0,xstatus movw #1,(r9)+ movw #0,(r9) brw next head .byte ^x84 ; (id) .ascii /(ID/ .byte ^xA9 link xid: .word docol ; : (id) .word pad ; pad .word bl ; bl .word lit,^x5F ; 95 .word fill ; fill .word dup ; dup .word pfa ; pfa .word lfa ; lfa .word over ; over .word minus ; - .word pad ; pad .word swap ; swap .word cmove ; cmove .word pad ; pad .word count ; count .word lit,^x1F ; 31 .word and ; and .word dup ; dup .word one ; one .word equal ; = .word zbranch,20$ ; if .word over ; over .word cfetch ; c@ .word lit,^x60 ; 96 .word and ; and .word zequal ; 0= .word zbranch,10$ ; if .word drop ; drop .word cfetch ; c@ .word lit,^x7F ; 127 .word and ; and .word lit,^x40 ; 64 .word plus ; + .word lit,^x5E ; '^' .word pad ; pad .word store ; ! .word pad ; pad .word oneplus ; 1+ .word store ; ! .word pad ; pad .word two ; 2 10$: ; endif 20$: ; endif .word semis ; ; head .byte ^x85 ; (key) .ascii /(KEY/ .byte ^xA9 link xkey: .word .+2 bsbw xinput addw #2,r9 movzbw io_char,(r9) brw next xinput: $qiow_s chan=input_chan,- func=#IO$_TTYREADALL!IO$M_NOECHO,- iosb=io_status,- p1=io_char,- p2=#1 rsb head .byte ^x86 ; (line) .ascii /(LINE/ .byte ^xA9 link xline: .word docol ; : (line) .word tor ; >r .word cl ; c/l .word bbuf ; b/buf .word starslashmod ; */ .word rfrom ; r> .word bscr ; b/scr .word star ; * .word plus ; + .word block ; block .word plus ; + .word cl ; c/l .word semis ; ; head .byte ^x8D ; (load-system) .ascii /(LOAD-SYSTEM/ .byte ^xA9 link xloadsystem: .word .+2 movzwl (r9),r11 movzwl -(r9),r10 pushr #^m movc3 r11,(r10),bufaddr movc3 #4,fthaddr,bufaddr(r11) popr #^m moval fab_rblock,r10 addw #^x0B,r11 movb r11,FAB$B_FNS(r10) $open fab=fab_rblock blbs r0,10$ brw bad_load 10$: $connect rab=rab_rblock blbs r0,20$ brw bad_load 20$: moval rab_rblock,r5 movw #^x7FFF,RAB$W_USZ(r5) movaw taskhead,r10 movzwl r10,RAB$L_UBF(r5) $get rab=rab_rblock blbs r0,30$ brw bad_load 30$: movw r3,r10 movzwl r10,RAB$L_UBF(r5) $get rab=rab_rblock blbs r0,40$ brw bad_load 40$: movaw xuser,r10 movzwl r10,RAB$L_UBF(r5) $get rab=rab_rblock blbs r0,50$ brw bad_load 50$: $close fab=fab_rblock blbs r0,60$ brw bad_load 60$: movw xvoclink,(r9)+ movw xcontext,(r9)+ movw xcurrent,(r9)+ clrw (r9)+ clrw (r9) brw next bad_load: movl r0,xstatus movw #1,(r9)+ movw #8,(r9) brw next head .byte ^x86 ; (loop) .ascii /(LOOP/ .byte ^xA9 link xloop: .word .+2 addw #1,(r8) movw (r8)+,r11 subw3 r11,(r8)+,r11 bgtr 10$ addw #2,r6 brw next 10$: subw #4,r8 movw (r6)+,r6 brw next needesc: .word neesize .word 0 .long neename neename: .ascii /FORTHx:FIGFORTH.NEED/ neesize = . - neename neeaddr: .blkb 9 head .byte ^x86 ; (need) .ascii /(NEED/ .byte ^xA9 link xneed: .word .+2 movzwl (r9),keydesc movzwl -(r9),keyaddr pushr #^m movc3 #7,filname,neename popr #^m pushal lbrtype pushal lbrfunc pushal lbrindex calls #3,g^LBR$INI_CONTROL blbs r0,10$ brw bad_need 10$: pushal needesc pushal lbrindex calls #2,g^LBR$OPEN blbs r0,20$ brw bad_need 20$: pushal lbrindex calls #1,g^LBR$SET_LOCATE blbs r0,30$ brw bad_need 30$: pushal rfaaddr pushal keydesc pushal lbrindex calls #3,g^LBR$LOOKUP_KEY blbs r0,40$ brw need_not_found 40$: pushal recdesc clrl -(sp) pushal lbrindex calls #3,g^LBR$GET_RECORD blbs r0,50$ brw bad_need 50$: pushal lbrindex calls #1,g^LBR$CLOSE blbs r0,60$ brw bad_need 60$: movl recdesc,r11 movl recaddr,r10 movb r11,neeaddr pushr #^m movc3 r11,(r10),neeaddr+1 popr #^m movaw neeaddr,(r9)+ clrw (r9) brw next bad_need: movl r0,xstatus movw #1,(r9)+ movw #8,(r9) brw next need_not_found: movl r0,xstatus movw #1,(r9)+ movw #0,(r9) brw next head .byte ^x88 ; (number) .ascii /(NUMBER/ .byte ^xA9 link xnumber: .word docol ; : (number) 10$: ; begin .word oneplus ; 1+ .word dup ; dup .word tor ; >r .word cfetch ; c@ .word base ; base .word fetch ; @ .word digit ; digit .word zbranch,30$ ; while .word swap ; swap .word base ; base .word fetch ; @ .word ustar ; u* .word drop ; drop .word rot ; rot .word base ; base .word fetch ; @ .word ustar ; u* .word dplus ; d+ .word dpl ; dpl .word fetch ; @ .word oneplus ; 1+ .word zbranch,20$ ; if .word one ; 1 .word dpl ; dpl .word plustore ; +! 20$: ; endif .word rfrom ; r> .word branch,10$ ; repeat 30$: .word rfrom ; r> .word semis ; ; getflag: .word 0 getdesc: .long 0 getaddr: .long 0 head .byte ^x87 ; (query) .ascii /(QUERY/ .byte ^xA9 link xquery: .word .+2 tstw getflag bneq 10$ movw #1,getflag movzwl (r9),r11 movw #^x50,getdesc movl r11,getaddr pushaw getdesc clrl -(sp) pushal getdesc calls #3,g^LIB$GET_FOREIGN blbc r0,10$ movzwl getdesc,r4 addl r4,r11 clrw (r11) addw #2,r9 movw r4,(r9) brw next 10$: clrw (r11) addw #2,r9 movw #0,(r9) brw next head .byte ^x85 ; (r/w) .ascii \(R/W\ .byte ^xA9 link xrw: .word docol ; : (r/w) .word tor ; >r .word dup ; dup .word lit,^x7FFF ; 7FFFF .word greater ; > .word zbranch,10$ ; if .word rfrom ; r> .word drop ; drop .word drop ; drop .word one ; 1 .word lit,^x08 ; 8 .word qerror ; ?error .word branch,40$ ; else 10$: .word base ; base .word fetch ; @ .word tor ; >r .word decimal ; decimal .word stod ; s->d .word lessharp ; <# .word sharps ; #s .word sharpgtr ; #> .word rfrom ; r> .word base ; base .word store ; ! .word rfrom ; r> .word zbranch,20$ ; if .word blkread ; block-read .word branch,30$ ; else 20$: .word blkwrite ; block-write 30$: ; endif .word qerror ; ?error 40$: ; endif .word semis ; ; head .byte ^x8D ; (save-system) .ascii /(SAVE-SYSTEM/ .byte ^xA9 link xsavesystem: .word .+2 movzwl (r9),r11 movzwl -(r9),r10 movw -(r9),xcurrent movw -(r9),xcontext movw -(r9),xvoclink pushr #^m movc3 r11,(r10),bufaddr movc3 #4,fthaddr,bufaddr(r11) popr #^m moval fab_wblock,r10 addw #^x0B,r11 movb r11,FAB$B_FNS(r10) $create fab=fab_wblock blbs r0,10$ brw bad_save 10$: $connect rab=rab_wblock blbs r0,20$ brw bad_save 20$: moval rab_wblock,r5 movaw taskhead,r10 clrl r11 addw3 #^x12,r3,r11 subw3 r10,(r11),r11 movw r11,RAB$W_RSZ(r5) movzwl r10,RAB$L_RBF(r5) $put rab=rab_wblock blbs r0,30$ brw bad_save 30$: movw r3,r10 addw3 xuser,xuser,r11 movw r11,RAB$W_RSZ(r5) movzwl r10,RAB$L_RBF(r5) $put rab=rab_wblock blbs r0,40$ brw bad_save 40$: movaw xuser,r10 movw #xsize,r11 movw r11,RAB$W_RSZ(r5) movzwl r10,RAB$L_RBF(r5) $put rab=rab_wblock blbs r0,50$ brw bad_save 50$: $close fab=fab_wblock blbs r0,60$ brw bad_save 60$: clrw (r9)+ clrw (r9) brw next bad_save: movl r0,xstatus movw #1,(r9)+ movw #8,(r9) brw next head .byte ^x85 ; (scr) .ascii /(SCR/ .byte ^xA9 link xscr: .word .+2 movzwl (r9),r11 movzwl -(r9),r10 pushr #^m movc3 r11,(r10),bufaddr movc3 #4,fthaddr,bufaddr(r11) popr #^m moval fab_rblock,r10 addw #^x0B,r11 movb r11,FAB$B_FNS(r10) movw xcl,FAB$W_MRS(r10) $open fab=fab_rblock blbs r0,10$ brw bad_scr 10$: $close fab=fab_rblock blbs r0,20$ brw bad_scr 20$: movw #1,(r9) brw next bad_scr: clrw (r9) brw next head .byte ^x87 ; (space) .ascii /(SPACE/ .byte ^xA9 link xspace: .word .+2 tstw ctrlc bneq 10$ bsbw xblank clrl r5 addw3 #^x1A,r3,r5 incw (r5) 10$: brw next output_blank: .byte ^x20 xblank: $qiow_s chan=output_chan,- func=#IO$_WRITEVBLK!IO$M_NOFORMAT,- iosb=io_status,- p1=output_blank,- p2=#1 rsb head .byte ^x86 ; (type) .ascii /(TYPE/ .byte ^xA9 link xtype: .word .+2 movzwl (r9),r11 movzwl -(r9),r10 subw #2,r9 tstl r11 beql 10$ bsbw xoutput clrl r5 addw3 #^x1A,r3,r5 addw r11,(r5) 10$: brw next xoutput: tstw ctrlc bneq 10$ clrl r5 addw3 #^x34,r3,r5 clrl r4 addw3 #IO$_WRITEVBLK,(r5),r4 $qiow_s chan=output_chan,- func=r4,- iosb=io_status,- p1=(r10),- p2=r11 10$: rsb head .byte ^x81 ; * .byte ^xAA link star: .word docol ; : * .word mstar ; m* .word drop ; drop .word semis ; ; head .byte ^x82 ; */ .ascii /*/ .byte ^xAF link starslash: .word docol ; : */ .word starslashmod ; */mod .word swap ; swap .word drop ; drop .word semis ; ; head .byte ^x85 ; */mod .ascii \*/MO\ .byte ^xC4 link starslashmod: .word docol ; : */mod .word tor ; >r .word mstar ; m* .word rfrom ; r> .word mslash ; m/ .word semis ; ; head .byte ^x81 ; + .byte ^xAB link plus: .word .+2 addw (r9),-(r9) brw next head .byte ^x82 ; +! .ascii /+/ .byte ^xA1 link plustore: .word .+2 movzwl (r9),r10 addw -(r9),(r10) subw #2,r9 brw next head .byte ^x82 ; +- .ascii /+/ .byte ^xAD link pm: .word docol ; : +- .word zless ; 0< .word zbranch,10$ ; if .word negate ; minus 10$: ; endif .word semis ; ; head .byte ^x84 ; +buf .ascii /+BU/ .byte ^xC6 link pbuf: .word docol ; : +buf .word bbuf ; b/buf .word lit,4 ; 4 .word plus ; + .word plus ; + .word dup ; dup .word limit ; limit .word equal ; = .word zbranch,10$ ; if .word drop ; drop .word first ; first 10$: ; endif .word dup ; dup .word prev ; prev .word fetch ; @ .word minus ; - .word semis ; ; head .byte ^xC5 ; +loop .ascii /+LOO/ .byte ^xD0 link ploop: .word docol ; : +loop .word three ; 3 .word qpairs ; ?pairs .word compile ; compile .word xploop ; (+loop) .word back ; back .word semis ; ; immediate head .byte ^x87 ; +origin .ascii /+ORIGI/ .byte ^xCE link porigin: .word docol ; : +origin .word origin ; origin .word plus ; + .word semis ; ; head .byte ^x81 ; , .byte ^xAC link comma: .word docol ; : , .word here ; here .word store ; ! .word two ; 2 .word allot ; allot .word semis ; ; head .byte ^x81 ; - .byte ^xAD link minus: .word docol ; : - .word negate ; minus .word plus ; + .word semis ; ; head .byte ^xC3 ; --> .ascii /--/ .byte ^xBE link arrow: .word docol ; : --> .word qloading ; ?loading .word zero ; 0 .word in ; in .word store ; ! .word bscr ; b/scr .word blk ; blk .word fetch ; @ .word over ; over .word mod ; mod .word minus ; - .word blk ; blk .word plustore ; +! .word base ; base .word fetch ; @ .word tor ; >r .word decimal ; decimal .word blk ; blk .word fetch ; @ .word dot ; . .word rfrom ; r> .word base ; base .word store ; ! .word semis ; ; immediate head .byte ^x84 ; -dup .ascii /-DU/ .byte ^xD0 link mdup: .word docol ; : -dup .word dup ; dup .word zbranch,10$ ; if .word dup ; dup 10$: ; endif .word semis ; ; head .byte ^x85 ; -find .ascii /-FIN/ .byte ^xC4 link mfind: .word docol ; : -find .word bl ; bl .word word ; word .word here ; here .word count ; count .word upcase ; upcase .word here ; here .word context ; context .word fetch ; @ .word fetch ; @ .word xfind ; (find) .word dup ; dup .word zequal ; 0= .word zbranch,10$ ; if .word drop ; drop .word here ; here .word latest ; latest .word xfind ; (find) 10$: ; endif .word semis ; ; trailing: decw r10 cmpb #^x20,(r11)[r10] bneq 10$ tstw r10 bneq trailing 10$: incw r10 rsb head .byte ^x89 ; -trailing .ascii /-TRAILIN/ .byte ^xC7 link mtrailing: .word .+2 movzwl (r9),r10 movzwl -(r9),r11 bsbw trailing movw r11,(r9)+ movw r10,(r9) brw next head .byte ^xC2 ; ." .ascii /./ .byte ^xA2 link dotq: .word docol ; : ." .word lit,^x22 ; 34 ( '"' ) .word state ; state .word fetch ; @ .word zbranch,10$ ; if .word compile ; compile .word xdotq ; (.") .word word ; word .word here ; here .word cfetch ; c@ .word oneplus ; 1+ .word allot ; allot .word branch,20$ ; else 10$: .word word ; word .word here ; here .word count ; count .word type ; type 20$: ; endif .word semis ; ; immeidate head .byte ^x81 ; . .byte ^xAE link dot: .word docol ; : . .word stod ; s->d .word ddot ; d. .word semis ; ; head .byte ^x85 ; .line .ascii /.LIN/ .byte ^xC5 link dotline: .word docol ; : .line .word xline ; (line) .word mtrailing ; -trailing .word type ; type .word semis ; ; head .byte ^x82 ; .r .byte ^x2E .byte ^xD2 link dotr: .word docol ; : .r .word tor ; >r .word stod ; s->d .word rfrom ; r> .word ddotr ; d.r .word semis ; ; head .byte ^x81 ; / .byte ^xAF link slash: .word .+2 divw (r9),-(r9) brw next head .byte ^x84 ; /mod .ascii \/MO\ .byte ^xC4 link slashmod: .word .+2 clrl r11 cvtwl (r9),r4 tstw -(r9) bgeq 10$ movl #^xFFFFFFFF,r11 10$: cvtwl (r9),r10 ediv r4,r10,r10,r4 movw r4,(r9)+ movw r10,(r9) brw next head .byte ^x81 ; 0 .byte ^xB0 link zero: .word docon .word 0 head .byte ^x81 ; 1 .byte ^xB1 link one: .word docon .word 1 head .byte ^x81 ; 2 .byte ^xB2 link two: .word docon .word 2 head .byte ^x81 ; 3 .byte ^xB3 link three: .word docon .word 3 head .byte ^x82 ; 0< .ascii /0/ .byte ^xBC link zless: .word .+2 tstw (r9) blss 10$ movw #0,(r9) brw next 10$: movw #^x01,(r9) brw next head .byte ^x82 ; 0= .ascii /0/ .byte ^xBD link zequal: .word .+2 tstw (r9) bneq 10$ movw #^x01,(r9) brw next 10$: movw #0,(r9) brw next head .byte ^x87 ; 0branch .ascii /0BRANC/ .byte ^xC8 link zbranch: .word .+2 tstw (r9) beqlu 10$ subw #2,r9 addw #2,r6 brw next 10$: subw #2,r9 movw (r6)+,r6 brw next head .byte ^x82 ; 1+ .ascii /1/ .byte ^xAB link oneplus: .word docol ; : 1+ .word one ; 1 .word plus ; + .word semis ; ; head .byte ^x82 ; 2+ .ascii /2/ .byte ^xAB link twoplus: .word docol ; : 2+ .word two ; 2 .word plus ; + .word semis ; ; head .byte ^xC1 ; : .byte ^xBA link colon: .word docol ; : : .word qexec ; ?exec .word storecsp ; !csp .word current ; current .word fetch ; @ .word context ; context .word store ; ! .word create ; create .word rbracket ; ] .word lit,^xFFFE ; FFFE .word dp ; dp .word plustore ; +! .word compile ; compile .word docol ; 'run time colon routine' .word semis ; ; immediate head .byte ^xC1 ; ; .byte ^xBB link semicolon: .word docol ; : ; .word qcsp ; ?csp .word compile ; compile .word semis ; ;s .word smudge ; smudge .word lbracket ; [ .word semis ; ; immediate head .byte ^xC5 ; ;code .ascii /;COD/ .byte ^xC5 link code: .word docol ; : ;code .word qcsp ; ?csp .word compile ; compile .word xcode ; (;code) .word lbracket ; [ .word smudge ; smudge .word semis ; ; immediate head .byte ^x82 ; ;s .ascii /;/ .byte ^xD3 link semis: .word .+2 movw (r8)+,r6 brw next head .byte ^x81 ; < .byte ^xBC link less: .word docol ; : < .word minus ; - .word zless ; 0< .word semis ; ; head .byte ^x82 ; <# .byte ^x3C .byte ^xA3 link lessharp: .word docol ; : <# .word pad ; pad .word hld ; hld .word store ; ! .word semis ; ; head .byte ^x87 ; .byte ^xBE link greater: .word docol ; : > .word swap ; swap .word less ; < .word semis ; ; head .byte ^x82 ; >r .ascii />/ .byte ^xD2 link tor: .word .+2 movw (r9),-(r8) subw #2,r9 brw next head .byte ^x81 ; ? .byte ^xBF link question: .word docol ; : ? .word fetch ; @ .word dot ; . .word semis ; ; head .byte ^x85 ; ?comp .ascii /?COM/ .byte ^xD0 link qcomp: .word docol ; : ?comp .word state ; state .word fetch ; @ .word zequal ; 0= .word lit,^x11 ; 17 .word qerror ; ?error .word semis ; ; head .byte ^x84 ; ?csp .ascii /?CS/ .byte ^xD0 link qcsp: .word docol ; : ?csp .word spfetch ; sp@ .word csp ; csp .word fetch ; @ .word minus ; - .word lit,^x14 ; 20 .word qerror ; ?error .word semis ; ; head .byte ^x86 ; ?error .ascii /?ERRO/ .byte ^xD2 link qerror: .word docol ; : ?error .word swap ; swap .word zbranch,10$ ; if .word error ; error .word branch,20$ ; else 10$: .word drop ; drop 20$: ; endif .word semis ; ; head .byte ^x85 ; ?exec .ascii /?EXE/ .byte ^xC3 link qexec: .word docol ; : ?exec .word state ; state .word fetch ; @ .word lit,^x12 ; 18 .word qerror ; ?error .word semis ; ; head .byte ^x88 ; ?loading .ascii /?LOADIN/ .byte ^xC7 link qloading: .word docol ; : ?loading .word blk ; blk .word fetch ; @ .word zequal ; 0= .word lit,^x16 ; 22 .word qerror ; ?error .word semis ; ; head .byte ^x86 ; ?pairs .ascii /?PAIR/ .byte ^xD3 link qpairs: .word docol ; : ?pairs .word minus ; - .word lit,^x13 ; 19 .word qerror ; ?error .word semis ; ; head .byte ^x84 ; ?scr .ascii /?SC/ .byte ^xD2 link qscr: .word docol ; : ?scr .word base ; base .word fetch ; @ .word tor ; >r .word decimal ; decimal .word stod ; s->d .word lessharp ; <# .word sharps ; #s .word sharpgtr ; #> .word rfrom ; r> .word base ; base .word store ; ! .word xscr ; (scr) .word semis ; ; head .byte ^x86 ; ?stack .ascii /?STAC/ .byte ^xCB link qstack: .word docol ; : ?stack .word szero ; s0 .word fetch ; @ .word twoplus ; 2+ .word dup ; dup .word spfetch ; sp@ .word greater ; > .word one ; 1 .word qerror ; ?error .word lit,^x1000 ; 4096 ( 4K ) .word plus ; + .word spfetch ; sp@ .word less ; < .word lit,7 ; 7 .word qerror ; ?error .word semis ; ; head .byte ^x89 ; ?terminal .ascii /?TERMINA/ .byte ^xCC link qterminal: .word .+2 addw #2,r9 movw ctrlc,(r9) clrw ctrlc brw next ctrlc: .blkw 1 ctrlcast: ; service routine for ctrl-c interrupt .word 0 movw #1,ctrlc $qio_s chan=input_chan,- func=#IO$_SETMODE!IO$M_CTRLCAST,- p1=ctrlcast,- p3=#3 ret head .byte ^x81 ; @ .byte ^xC0 link fetch: .word .+2 movzwl (r9),r11 movw (r11),(r9) brw next head .byte ^x85 ; abort .ascii /ABOR/ .byte ^xD4 link abort: .word docol ; : abort .word spstore ; sp! .word decimal ; decimal .word cr ; cr .word lit,^x0F ; 15 .word spaces ; spaces .word xdotq ; (.") .ascic /VAX-11 fig-Forth Version 2.0/ .word cr ; cr .word emptybuffers ; empty-buffers .word offset ; offset .word fetch ; @ .word dir ; dir .word first ; first .word dup ; dup .word prev ; prev .word store ; ! .word use ; use .word store ; ! .word forth+8 ; forth .word definitions ; definitions .word quit ; quit .word semis ; ; head .byte ^x83 ; abs .ascii /AB/ .byte ^xD3 link abs: .word docol ; : abs .word dup ; dup .word pm ; +- .word semis ; ; head .byte ^xC5 ; again .ascii /AGAI/ .byte ^xCE link again: .word docol ; : again .word one ; 1 .word qpairs ; ?pairs .word compile ; compile .word branch ; 'run time branch routine' .word back ; back .word semis ; ; immediate head .byte ^x85 ; allot .ascii /ALLO/ .byte ^xD4 link allot: .word docol ; : allot .word dp ; dp .word plustore ; +! .word semis ; ; head .byte ^x83 ; and .ascii /AN/ .byte ^xC4 link and: .word .+2 mcomw (r9),r10 bicw r10,-(r9) brw next head .byte ^x85 ; b/buf .ascii \B/BU\ .byte ^xC6 link bbuf: .word docon xbbuf: .word 2048 head .byte ^x85 ; b/scr .ascii \B/SC\ .byte ^xD2 link bscr: .word docon .word 1 head .byte ^x84 ; back .ascii /BAC/ .byte ^xCB link back: .word docol ; : back .word comma ; comma .word semis ; ; head .byte ^x84 ; base .ascii /BAS/ .byte ^xC5 link base: .word douse .word ^x26 head .byte ^xC5 ; begin .ascii /BEGI/ .byte ^xCE link begin: .word docol ; : begin .word qcomp ; ?comp .word here ; here .word one ; 1 .word semis ; ; immediate head .byte ^x86 ; binary .ascii /BINAR/ .byte ^xD9 link binary: .word docol ; : binary .word two ; 2 .word base ; base .word store ; ! .word semis ; ; head .byte ^x82 ; bl .ascii /B/ .byte ^xCC link bl: .word docon .word ^x20 head .byte ^x86 ; blanks .ascii /BLANK/ .byte ^xD3 link blanks: .word docol ; : blanks .word bl ; bl .word fill ; fill .word semis ; ; head .byte ^x83 ; blk .ascii /BL/ .byte ^xCB link blk: .word douse .word ^x16 head .byte ^x85 ; block .ascii /BLOC/ .byte ^xCB link block: .word docol ; : block .word tor ; >r .word prev ; prev .word fetch ; @ .word dup ; dup .word fetch ; @ .word r ; r .word minus ; - .word dup ; dup .word plus ; + .word zbranch,30$ ; if 10$: ; begin .word pbuf ; +buf .word zequal ; 0= .word zbranch,20$ ; if .word drop ; drop .word r ; r .word buffer ; buffer .word dup ; dup .word r ; r .word one ; 1 .word rw ; r/w .word two ; 2 .word minus ; - 20$: ; endif .word dup ; dup .word fetch ; @ .word r ; r .word minus ; - .word dup ; dup .word plus ; + .word zequal ; 0= .word zbranch,10$ ; until .word dup ; dup .word prev ; prev .word store ; ! 30$: ; endif .word rfrom ; r> .word drop ; drop .word twoplus ; 2+ .word semis ; ; head .byte ^x0A ; block-read .ascii /BLOCK-REA/ .byte ^xC4 link blkread: .word docol ; : block-read .word xblkread ; (block-read) .word semis ; ; head .byte ^x0B ; block-write .ascii /BLOCK-WRIT/ .byte ^xC5 link blkwrite: .word docol ; : block-write .word xblkwrite ; (block-write) .word semis ; ; head .byte ^x86 ; branch .ascii /BRANC/ .byte ^xC8 link branch: .word .+2 movw (r6)+,r6 brw next head .byte ^x86 ; buffer .ascii /BUFFE/ .byte ^xD2 link buffer: .word docol ; : buffer .word use ; use .word fetch ; @ .word dup ; dup .word tor ; >r 10$: ; begin .word pbuf ; +buf .word zbranch,10$ ; until .word use ; use .word store ; ! .word r ; r .word fetch ; @ .word zless ; 0< .word zbranch,20$ ; if .word r ; r .word twoplus ; 2+ .word r ; r .word fetch ; @ .word lit,^x7FFF ; 7FFFF .word and ; and .word zero ; 0 .word rw ; r/w 20$: ; endif .word r ; r .word store ; ! .word r ; r .word prev ; prev .word store ; ! .word rfrom ; r> .word twoplus ; 2+ .word semis ; ; head .byte ^x83 ; bye .ascii /BY/ .byte ^xC5 link bye: .word docol ; : bye .word cr ; cr .word flush ; flush .word mon ; mon .word semis ; ; head .byte ^x82 ; c! .ascii /C/ .byte ^xA1 link cstore: .word .+2 movzwl (r9),r10 subw #2,r9 movb (r9),(r10) subw #2,r9 brw next head .byte ^x82 ; c, .ascii /C/ .byte ^xAC link ccomma: .word docol ; : c, .word here ; here .word cstore ; c! .word one ; 1 .word allot ; allot .word semis ; ; head .byte ^x83 ; c/l .ascii \C/\ .byte ^xCC link cl: .word docon xcl: .word 64 head .byte ^x82 ; c@ .ascii /C/ .byte ^xC0 link cfetch: .word .+2 movzwl (r9),r10 movzbw (r10),(r9) brw next .byte ^x83 ; cfa .ascii /CF/ .byte ^xC1 link cfa: .word docol ; : cfa .word two ; 2 .word minus ; - .word semis ; ; head .byte ^x85 ; cmove .ascii /CMOV/ .byte ^xC5 link cmove: .word .+2 movzwl (r9),r5 movzwl -(r9),r10 movzwl -(r9),r11 subw #2,r9 10$: movb (r11)+,(r10)+ sobgtr r5,10$ brw next head .byte ^x84 ; cold .ascii /COL/ .byte ^xC4 link cold: .word .+2 clrl r0 ; indicate cold start ret head .byte ^x87 ; compile .ascii /COMPIL/ .byte ^xC5 link compile: .word docol ; : compile .word qcomp ; ?comp .word rfrom ; r> .word dup ; dup .word twoplus ; 2+ .word tor ; >r .word fetch ; @ .word comma ; , .word semis ; ; head .byte ^x88 ; constant .ascii /CONSTAN/ .byte ^xD4 link constant: .word docol ; : constant .word lit,docon ; 'run time constant routine' .word storecode ; !code .word semis ; ; head .byte ^x87 ; context .ascii /CONTEX/ .byte ^xD4 link context: .word douse .word ^x20 head .byte ^x85 ; count .ascii /COUN/ .byte ^xD4 link count: .word docol ; : count .word dup ; dup .word oneplus ; 1+ .word swap ; swap .word cfetch ; c@ .word semis ; ; head .byte ^x82 ; cr .ascii /C/ .byte ^xD2 link cr: .word docol ; : cr .word xcr ; (cr) .word semis ; ; head .byte ^x86 ; create .ascii /CREAT/ .byte ^xC5 link create: .word docol ; : create .word spfetch ; sp@ .word here ; here .word lit,^xA0 ; 160 .word plus ; + .word less ; < .word two ; 2 .word qerror ; ?error .word mfind ; -find .word zbranch,10$ ; if .word drop ; drop .word nfa ; nfa .word id ; id. .word lit,4 ; 4 .word message ; message .word space ; space 10$: ; endif .word here ; here .word dup ; dup .word cfetch ; c@ .word width ; width .word fetch ; @ .word min ; min .word oneplus ; 1+ .word allot ; allot .word dup ; dup .word lit,^xA0 ; 160 .word toggle ; toggle .word here ; here .word one ; 1 .word minus ; - .word lit,^x80 ; 128 .word toggle ; toggle .word latest ; latest .word comma ; , .word current ; current .word fetch ; @ .word store ; ! .word here ; here .word twoplus ; 2+ .word comma ; , .word semis ; ; head .byte ^x83 ; csp .ascii /CS/ .byte ^xD0 link csp: .word douse .word ^x2C head .byte ^x87 ; current .ascii /CURREN/ .byte ^xD4 link current: .word douse .word ^x22 head .byte ^x82 ; d! .ascii /D/ .byte ^xA1 link dstore: .word docol ; : d! .word dup ; dup .word rot ; rot .word swap ; swap .word store ; ! .word twoplus ; 2+ .word store ; ! .word semis ; ; head .byte ^x82 ; d* .ascii /D/ .byte ^xAA link dstar: .word .+2 subw #2,r9 movl (r9),r10 movl -(r9),r11 mull3 r11,r10,r11 movl r11,(r9) addw #2,r9 brw next head .byte ^x82 ; d+ .ascii /D/ .byte ^xAB link dplus: .word .+2 subw #2,r9 addl (r9),-(r9) addw #2,r9 brw next head .byte ^x83 ; d+- .ascii /D+/ .byte ^xAD link dpm: .word docol ; : d+- .word zless ; 0< .word zbranch,10$ ; if .word dnegate ; dminus 10$: ; endif .word semis ; ; head .byte ^x82 ; d. .byte ^x44 .byte ^xAE link ddot: .word docol ; : d. .word zero ; 0 .word ddotr ; d.r .word space ; space .word semis ; ; head .byte ^x83 ; d.r .ascii /D./ .byte ^xD2 link ddotr: .word docol ; : d.r .word tor ; >r .word swap ; swap .word over ; over .word dabs ; dabs .word lessharp ; <# .word sharps ; #s .word sign ; sign .word sharpgtr ; #> .word rfrom ; r> .word over ; over .word minus ; - .word spaces ; spaces .word type ; types .word semis ; ; head .byte ^x82 ; d/ .ascii /D/ .byte ^xAF link dslash: .word docol ; : d/ .word dslashmod ; d/mod .word dswap ; dswap .word ddrop ; ddrop .word semis ; ; head .byte ^x85 ; d/mod .ascii \D/MO\ .byte ^xC4 link dslashmod: .word .+2 clrl r11 subw #2,r9 movl (r9),r4 movl -(r9),r10 ediv r4,r10,r4,r10 movl r10,(r9)+ movl r4,(r9) addw #2,r9 brw next head .byte ^x83 ; d0= .ascii /D0/ .byte ^xBD link dzequal: .word .+2 subw #2,r9 tstl (r9) bneq 10$ movw #^x01,(r9) brw next 10$: movw #0,(r9) brw next head .byte ^x82 ; d@ .ascii /D/ .byte ^xC0 link dfetch: .word docol ; : d@ .word dup ; dup .word twoplus ; 2+ .word fetch ; @ .word swap ; swap .word fetch ; @ .word semis ; ; head .byte ^x84 ; dabs .ascii /DAB/ .byte ^xD3 link dabs: .word docol ; : dabs .word dup ; dup .word dpm ; d+- .word semis ; ; head .byte ^x85 ; ddrop .ascii /DDRO/ .byte ^xD0 link ddrop: .word docol ; : ddrop .word drop ; drop .word drop ; drop .word semis ; ; head .byte ^x84 ; ddup .ascii /DDU/ .byte ^xD0 link ddup: .word docol ; : ddup .word over ; over .word over ; over .word semis ; ; head .byte ^x87 ; decimal .ascii /DECIMA/ .byte ^xCC link decimal: .word docol ; : decimal .word lit,^x0A ; 10 .word base ; base .word store ; ! .word semis ; ; head .byte ^x8B ; definitions .ascii /DEFINITION/ .byte ^xD3 link definitions: .word docol ; : definitions .word context ; context .word fetch ; fetch .word current ; current .word store ; ! .word semis ; ; head .byte ^x86 ; defscr .ascii /DEFSC/ .byte ^xD2 link defscr: .word douse .word ^x36 head .byte ^x86 ; defdir .ascii /DEFDI/ .byte ^xD2 link defdir: .word douse .word ^x38 head .byte ^x85 ; digit .ascii /DIGI/ .byte ^xD4 link digit: .word .+2 subw #2,r9 subb3 #^x30,(r9),r5 blssu 20$ cmpb r5,#^x0A blssu 10$ cmpb r5,#^x11 blssu 20$ cmpb r5,#^x2B bgequ 20$ subb #^x07,r5 10$: addw #2,r9 cmpb r5,(r9) bgequ 20$ subw #2,r9 movw r5,(r9)+ movw #1,(r9) brw next 20$: movw #0,(r9) brw next head .byte ^x83 ; dir .ascii /DI/ .byte ^xD2 link dir: .word docol ; : dir .word dup ; dup .word offset ; offset .word store ; ! .word dup ; dup .word lit,^xFFF0 ; FFF0 .word and ; and .word lit,^x06 ; 6 .word qerror ; ?error .word base ; base .word fetch ; @ .word tor ; >r .word hex ; hex .word stod ; s->d .word lessharp ; <# .word sharps ; #s .word sharpgtr ; #> .word rfrom ; r> .word base ; base .word store ; store .word drop ; drop .word cfetch ; c@ .word lit,filname+5 ; 'FORTHx:' .word cstore ; c! .word semis ; ; head .byte ^xC8 ; dliteral .ascii /DLITERA/ .byte ^xCC link dliteral: .word docol ; : dliteral .word state ; state .word fetch ; @ .word zbranch,10$ ; if .word swap ; swap .word literal ; literal .word literal ; literal 10$: ; endif .word semis ; ; immediate head .byte ^x86 ; dminus .ascii /DMINU/ .byte ^xD3 link dnegate: .word .+2 subw #2,r9 mnegl (r9),(r9) addw #2,r9 brw next head .byte ^xC2 ; do .ascii /D/ .byte ^xCF link do: .word docol ; : do .word compile ; compile .word xdo ; (do) .word here ; here .word three ; 3 .word semis ; ; immediate head .byte ^x85 ; dover .ascii /DOVE/ .byte ^xD2 link dover: .word docol ; : dover .word dswap ; dswap .word ddup ; ddup .word tor ; >r .word tor ; >r .word dswap ; dswap .word rfrom ; r> .word rfrom ; r> .word semis ; ; head .byte ^x85 ; does> .ascii /DOES/ .byte ^xBE link does: .word docol ; : does> .word rfrom ; r> .word latest ; latest .word pfa ; pfa .word store ; ! .word xcode ; (;code) dodoe: movw r6,-(r8) movw (r7)+,r6 addw #2,r9 movw r7,(r9) brw next head .byte ^x82 ; dp .ascii /D/ .byte ^xD0 link dp: .word douse .word ^x12 head .byte ^x83 ; dpl .ascii /DP/ .byte ^xCC link dpl: .word douse .word ^x28 head .byte ^x83 ; dr0 .ascii /DR/ .byte ^xB0 link drzero: .word docol ; : dr0 .word zero ; 0 .word dir ; dir .word semis ; ; head .byte ^x83 ; dr1 .ascii /DR/ .byte ^xB1 link drone: .word docol ; : dr1 .word one ; 1 .word dir ; dir .word semis ; ; head .byte ^x84 ; drop .ascii /DRO/ .byte ^xD0 link drop: .word .+2 subw #2,r9 brw next head .byte ^x83 ; dup .ascii /DU/ .byte ^xD0 link dup: .word .+2 movw (r9)+,(r9) brw next head .byte ^x85 ; dswap .ascii /DSWA/ .byte ^xD0 link dswap: .word docol ; : dswap .word rot ; rot .word tor ; >r .word rot ; rot .word rfrom ; r> .word semis ; ; head .byte ^xC4 ; else .ascii /ELS/ .byte ^xC5 link else: .word docol ; : else .word two ; 2 .word qpairs ; ?paris .word compile ; compile .word branch ; 'run time branch routine' .word here ; here .word zero ; 0 .word comma ; , .word swap ; swap .word two ; 2 .word endif ; endif .word two ; 2 .word semis ; ; immediate head .byte ^x84 ; emit .ascii /EMI/ .byte ^xD4 link emit: .word docol ; : emit .word xemit ; (emit) .word semis ; ; head .byte ^x8D ; empty-buffers .ascii /EMPTY-BUFFER/ .byte ^xD3 link emptybuffers: .word docol ; : empty-buffers .word first ; first .word limit ; limit .word over ; over .word minus ; - .word erase ; erase .word semis ; ; head .byte ^x87 ; enclose .ascii /ENCLOS/ .byte ^xC5 link enclose: .word .+2 clrl r4 clrl r11 subw #2,r9 movzwl (r9)+,r10 movzbl (r9),r5 10$: tstb (r10) beqlu 50$ subb3 (r10),r5,r4 bnequ 20$ incw r10 incw r11 brw 10$ 20$: movw r11,(r9)+ 30$: tstb (r10) beqlu 60$ subb3 (r10),r5,r4 beqlu 40$ incw r10 incw r11 brw 30$ 40$: movw r11,(r9)+ addw3 #1,r11,(r9) brw next 50$: movw r11,(r9)+ addw3 #1,r11,(r9)+ brw 70$ 60$: movw r11,(r9)+ 70$: movw r11,(r9) brw next head .byte ^xC3 ; end .ascii /EN/ .byte ^xC4 link end: .word docol ; : end .word until ; until .word semis ; ; immediate head .byte ^xC5 ; endif .ascii /ENDI/ .byte ^xC6 link endif: .word docol ; : endif .word qcomp ; ?comp .word two ; 2 .word qpairs ; ?pairs .word here ; here .word swap ; swap .word store ; ! .word semis ; ; immediate head .byte ^x85 ; erase .ascii /ERAS/ .byte ^xC5 link erase: .word docol ; : erase .word zero ; 0 .word fill ; fill .word semis ; ; head .byte ^x85 ; error .ascii /ERRO/ .byte ^xD2 link error: .word docol ; : error .word warning ; warning .word fetch ; @ .word zless ; 0< .word zbranch,10$ ; if .word xabort ; (abort) 10$: ; endif .word here ; here .word count ; count .word type ; type .word xdotq ; (.") .ascic / ?/ ; ' ?' .word message ; message .word spstore ; sp! .word in ; in .word fetch ; @ .word blk ; blk .word fetch ; @ .word quit ; quit .word semis ; ; head .byte ^x87 ; execute .ascii /EXECUT/ .byte ^xC5 link execute: .word .+2 movw (r9),r7 subw #2,r9 movzwl (r7)+,r11 jmp (r11) head .byte ^x86 ; expect .ascii /EXPEC/ .byte ^xD4 link expect: .word docol ; : expect .word xexpect ; (expect) .word semis ; ; head .byte ^x85 ; fence .ascii /FENC/ .byte ^xC5 link fence: .word douse .word ^x10 head .byte ^x84 ; fill .ascii /FIL/ .byte ^xCC link fill: .word docol ; : fill .word swap ; swap .word tor ; >r .word over ; over .word cstore ; c! .word dup ; dup .word oneplus ; 1+ .word rfrom ; r> .word one ; 1 .word minus ; - .word cmove ; cmove .word semis ; ; head .byte ^x85 ; first .ascii /FIRS/ .byte ^xD4 link first: .word docon xfirst: .word firstb head .byte ^x83 ; fld .ascii /FL/ .byte ^xC4 link fld: .word douse .word ^x2A head .byte ^x85 ; flush .ascii /FLUS/ .byte ^xC8 link flush: .word docol ; : flush .word limit ; limit .word first ; first .word minus ; - .word bbuf ; +buf .word lit,4 ; 4 .word plus ; + .word slash ; / .word zero ; 0 .word xdo ; do 10$: .word lit,^x7FFF ; 7FFFF .word buffer ; buffer .word drop ; drop .word xloop,10$ ; loop .word semis ; ; head .byte ^x86 ; forget .ascii /FORGE/ .byte ^xD4 link forget: .word docol ; : forget .word current ; current .word fetch ; @ .word context ; context .word fetch ; @ .word minus ; - .word lit,^x18 ; 24 .word qerror ; ?error .word tick ; ' .word dup ; dup .word fence ; fence .word fetch ; @ .word less ; < .word lit,^x15 ; 21 .word qerror ; ?error .word dup ; dup .word nfa ; nfa .word dp ; dp .word store ; ! .word lfa ; lfa .word fetch ; fetch .word context ; context .word fetch ; @ .word store ; ! .word semis ; ; forth: head .byte ^xC5 ; forth .ascii /FORT/ .byte ^xC8 link .word dodoe .word dovoc .word ^x81A0 .word task-7 .word 0 head .byte ^x84 ; help .ascii /HEL/ .byte ^xD0 link help: .word docol ; : help .word bl ; bl .word word ; word .word here ; here .word count ; count .word upcase ; upcase .word here ; here .word count ; count .word offset ; offset .word fetch ; @ .word tor ; >r .word defdir ; defdir .word fetch ; @ .word dir ; dir .word xhelp ; (help) .word rfrom ; r> .word dir ; dir .word qerror ; ?error .word semis ; ; head .byte ^x84 ; here .ascii /HER/ .byte ^xC5 link here: .word docol ; : here .word dp ; dp .word fetch ; @ .word semis ; ; head .byte ^x83 ; hex .ascii /HE/ .byte ^xD8 link hex: .word docol ; : hex .word lit,^x10 ; 16 .word base ; base .word store ; ! .word semis ; ; head .byte ^x83 ; hld .ascii /HL/ .byte ^xC4 link hld: .word douse .word ^x30 head .byte ^x84 ; hold .ascii /HOL/ .byte ^xC4 link hold: .word docol ; : hold .word lit,^xFFFF ; -1 .word hld ; hld .word plustore ; +! .word hld ; hld .word fetch ; @ .word cstore ; c! .word semis ; ; head .byte ^x81 ; i .byte ^xC9 link i: .word .+2 addw #2,r9 movw (r8),(r9) brw next head .byte ^x83 ; id. .ascii /ID/ .byte ^xAE link id: .word docol ; : id. .word xid ; (id) .word type ; type .word space ; space .word semis ; ; head .byte ^xC2 ; if .ascii /I/ .byte ^xC6 link if: .word docol ; : if .word compile ; compile .word zbranch ; 'run time 0branch routine' .word here ; here .word zero ; 0 .word comma ; , .word two ; 2 .word semis ; ; immediate head .byte ^x89 ; immediate .ascii /IMMEDIAT/ .byte ^xC5 link immediate: .word docol ; : immediate .word latest ; latest .word lit,^x40 ; 64 .word toggle ; toggle .word semis ; ; head .byte ^x82 ; in .ascii /I/ .byte ^xCE link in: .word douse .word ^x18 head .byte ^x85 ; index .ascii /INDE/ .byte ^xD8 link index: .word docol ; : index .word cr ; cr .word oneplus ; 1+ .word swap ; swap .word xdo ; do 10$: .word cr ; cr .word i ; i .word three ; 3 .word dotr ; .r .word space ; space .word zero ; 0 .word i ; i .word dotline ; .line .word qterminal ; ?terminal .word zbranch,20$ ; if .word leave ; leave 20$: ; endif .word xloop,10$ ; loop .word cr ; cr .word semis ; ; head .byte ^x85 ; input .ascii /INPU/ .byte ^xD4 link input: .word douse .word ^x32 head .byte ^x89 ; interpret .ascii /INTERPRE/ .byte ^xD4 link interpret: .word docol ; : interpret 10$: ; begin .word mfind ; -find .word zbranch,40$ ; if .word state ; state .word fetch ; @ .word less ; < .word zbranch,20$ ; if .word cfa ; cfa .word comma ; comma .word branch,30$ ; else 20$: .word cfa ; cfa .word execute ; execute 30$: ; endif .word qstack ; ?stack .word branch,70$ ; else 40$: .word here ; here .word number ; number .word dpl ; dpl .word fetch ; fetch .word oneplus ; 1+ .word zbranch,50$ ; if .word dliteral ; dliteral .word branch,60$ ; else 50$: .word drop ; drop .word literal ; literal 60$: ; endif .word qstack ; ?stack 70$: ; endif .word branch,10$ ; again .word semis ; ; head .byte ^x83 ; key .ascii /KE/ .byte ^xD9 link key: .word docol ; : key .word xkey ; (key) .word semis ; ; head .byte ^x83 ; l/s .ascii \L/\ .byte ^xD3 link ls: .word docon xls: .word 16 head .byte ^x86 ; latest .ascii /LATES/ .byte ^xD4 link latest: .word docol ; : latest .word current ; current .word fetch ; @ .word fetch ; @ .word semis ; ; head .byte ^x85 ; leave .ascii /LEAV/ .byte ^xC5 link leave: .word .+2 movw (r8)+,r10 movw r10,(r8) subw #2,r8 brw next head .byte ^x83 ; lfa .ascii /LF/ .byte ^xC1 link lfa: .word docol ; : lfa .word lit,4 ; 4 .word minus ; - .word semis ; ; head .byte ^x85 ; limit .ascii /LIMI/ .byte ^xD4 link limit: .word docon xlimit: .word limitb head .byte ^x84 ; list .ascii /LIS/ .byte ^xD4 link list: .word docol ; : list .word dup ; dup .word scr ; scr .word store ; ! .word dup ; dup .word cr ; cr .word decimal ; decimal .word xdotq ; (.") .ascic /SCR # / ; 'SCR # ' .word dot ; . .word ls ; l/s .word zero ; 0 .word xdo ; do 10$: .word cr ; cr .word i ; i .word three ; 3 .word dotr ; .r .word space ; space .word i ; i .word scr ; scr .word fetch ; @ .word dotline ; .line .word qterminal ; ?terminal .word zbranch,20$ ; if .word leave ; leave 20$: ; endif .word xloop,10$ ; loop .word cr ; cr .word semis ; ; head .byte ^x83 ; lit .ascii /LI/ .byte ^xD4 link lit: .word .+2 addw #2,r9 movw (r6)+,(r9) brw next head .byte ^xC7 ; literal .ascii /LITERA/ .byte ^xCC link literal: .word docol ; : literal .word state ; state .word fetch ; @ .word zbranch,10$ ; if .word compile ; compile .word lit ; lit .word comma ; , 10$: ; endif .word semis ; ; immediate head .byte ^x84 ; load .ascii /LOA/ .byte ^xC4 link load: .word docol ; : load .word base ; base .word fetch ; @ .word tor ; >r .word decimal ; decimal .word dup ; dup .word dot ; . .word rfrom ; r> .word base ; base .word store ; ! .word blk ; blk .word fetch ; @ .word tor ; >r .word in ; in .word fetch ; @ .word tor ; >r .word zero ; 0 .word in ; in .word store ; ! .word bscr ; b/scr .word star ; * .word blk ; blk .word store ; ! .word interpret ; interpret .word rfrom ; r> .word in ; in .word store ; ! .word rfrom ; r> .word blk ; blk .word store ; ! .word semis ; ; head .byte ^x8B ; load-system .ascii /LOAD-SYSTE/ .byte ^xCD link loadsystem: .word docol ; : load-system .word bl ; bl .word word ; word .word blk ; blk .word fetch ; @ .word tor ; >r .word in ; in .word fetch ; @ .word tor ; >r .word here ; here .word count ; count .word upcase ; upcase .word here ; here .word count ; count .word xloadsystem ; (load-system) .word qerror ; ?error .word current ; current .word fetch ; @ .word store ; ! .word context ; context .word fetch ; @ .word store ; ! .word voclink ; voc-link .word fetch ; @ .word store ; ! .word rfrom ; r> .word in ; in .word store ; ! .word rfrom ; r> .word blk ; blk .word store ; ! .word semis ; ; head .byte ^xC4 ; loop .ascii /LOO/ .byte ^xD0 link loop: .word docol ; : loop .word three ; 3 .word qpairs ; ?paris .word compile ; compile .word xloop ; (loop) .word back ; back .word semis ; ; head .byte ^x82 ; m* .ascii /M/ .byte ^xAA link mstar: .word docol ; : m* .word over ; over .word over ; over .word xor ; xor .word tor ; >r .word abs ; abs .word swap ; swap .word abs ; abs .word ustar ; u* .word rfrom ; r> .word dpm ; d+- .word semis ; ; head .byte ^x82 ; m+ .ascii /M/ .byte ^xAB link mplus: .word docol ; : m+ .word stod ; s->d .word dplus ; d+ .word semis ; ; head .byte ^x82 ; m/ .ascii /M/ .byte ^xAF link mslash: .word docol ; : m/ .word over ; over .word tor ; >r .word tor ; >r .word dabs ; dabs .word r ; r .word abs ; abs .word uslash ; u/ .word rfrom ; r> .word r ; r .word xor ; xor .word pm ; +- .word swap ; swap .word rfrom ; r> .word pm ; +- .word swap ; swap .word semis ; ; head .byte ^x85 ; m/mod .ascii \M/MO\ .byte ^xC4 link mslashmod: .word docol ; : m/mod .word tor ; >r .word zero ; 0 .word r ; r .word uslash ; u/ .word rfrom ; r> .word swap ; swap .word tor ; >r .word uslash ; u/ .word rfrom ; r> .word semis ; ; head .byte ^x83 ; max .ascii /MA/ .byte ^xD8 link max: .word docol ; : max .word over ; over .word over ; over .word less ; < .word zbranch,10$ ; if .word swap ; swap 10$: ; endif .word drop ; drop .word semis ; ; head .byte ^x87 ; maxerrs .ascii /MAXERR/ .byte ^xD3 link maxerrs: .word douse .word ^x3A head .byte ^x87 ; message .ascii /MESSAG/ .byte ^xC5 link message: .word docol ; : message .word warning ; warning .word fetch ; @ .word zbranch,20$ ; if .word mdup ; -dup .word zbranch,10$ ; if .word offset ; offset .word fetch ; @ .word tor ; >r .word defdir ; defdir .word fetch ; @ .word dir ; dir .word defscr ; defscr .word fetch ; @ .word dotline ; .line .word space ; space .word rfrom ; r> .word dir ; dir 10$: ; endif .word branch,30$ ; else 20$: .word xdotq ; (.") .ascic / MSG # / ; ' MSG # ' .word dot ; . 30$: ; endif .word cr ; cr .word semis ; ; head .byte ^x83 ; min .ascii /MI/ .byte ^xCE link min: .word docol ; : min .word over ; over .word over ; over .word greater ; > .word zbranch,10$ ; if .word swap ; swap 10$: ; endif .word drop ; drop .word semis ; ; head .byte ^x85 ; minus .ascii /MINU/ .byte ^xD3 link negate: .word .+2 mnegw (r9),(r9) brw next head .byte ^x83 ; mod .ascii /MO/ .byte ^xC4 link mod: .word docol ; : mod .word slashmod ; /mod .word drop ; drop .word semis ; ; head .byte ^x83 ; mon .ascii /MO/ .byte ^xCE link mon: .word .+2 movl #SS$_NORMAL,r0 $exit_s r0 head .byte ^x84 ; need .ascii /NEE/ .byte ^xC4 link need: .word docol ; : need .word bl ; bl .word word ; word .word here ; here .word count ; count .word upcase ; upcase .word here ; here .word context ; context .word fetch ; @ .word fetch ; @ .word xfind ; (find) .word zequal ; 0= .word zbranch,10$ ; if .word here ; here .word count ; count .word xneed ; (need) .word qerror ; ?error .word base ; base .word fetch ; @ .word tor ; >r .word decimal ; decimal .word zero ; 0 .word zero ; 0 .word rot ; rot .word xnumber ; (number) .word drop ; drop .word drop ; drop .word rfrom ; r> .word base ; base .word store ; ! .word load ; load .word branch,20$ ; else 10$: .word drop ; drop .word drop ; drop 20$: ; endif .word semis ; ; head .byte ^x83 ; nfa .ascii /NF/ .byte ^xC1 link nfa: .word docol ; : nfa .word lit,5 ; 5 .word minus ; - .word lit,^xFFFF ; -1 .word traverse ; traverse .word semis ; ; head .byte ^x86 ; number .ascii /NUMBE/ .byte ^xD2 link number: .word docol ; : number .word zero ; 0 .word zero ; 0 .word rot ; rot .word dup ; dup .word oneplus ; 1+ .word cfetch ; c@ .word lit,^x2D ; 45 ( '-' ) .word equal ; = .word dup ; dup .word tor ; >r .word plus ; + .word lit,^xFFFF ; -1 10$: ; begin .word dpl ; dpl .word store ; ! .word xnumber ; (number) .word dup ; dup .word cfetch ; c@ .word bl ; bl .word minus ; - .word zbranch,20$ ; while .word dup ; dup .word cfetch ; c@ .word lit,^x2E ; 46 ( '.' ) .word minus ; - .word zero ; 0 .word qerror ; ?error .word zero ; 0 .word branch,10$ ; repeat 20$: .word drop ; drop .word rfrom ; r> .word zbranch,30$ ; if .word dnegate ; dminus 30$: ; endif .word semis ; ; head .byte ^x85 ; octal .ascii /OCTA/ .byte ^xCC link octal: .word docol ; : octal .word lit,^x08 ; 8 .word base ; base .word store ; ! .word semis ; ; head .byte ^x86 ; offset .ascii /OFFSE/ .byte ^xD4 link offset: .word douse .word ^x1E head .byte ^x82 ; or .ascii /O/ .byte ^xD2 link or: .word .+2 bisw (r9),-(r9) brw next head .byte ^x86 ; origin .ascii /ORIGI/ .byte ^xCE link origin: .word docon .word xorigin+^x06 head .byte ^x83 ; out .ascii /OU/ .byte ^xD4 link out: .word douse .word ^x1A head .byte ^x86 ; output .ascii /OUTPU/ .byte ^xD4 link output: .word douse .word ^x34 head .byte ^x84 ; over .ascii /OVE/ .byte ^xD2 link over: .word .+2 subw #2,r9 movw (r9)+,r10 addw #2,r9 movw r10,(r9) brw next head .byte ^x83 ; pad .ascii /PA/ .byte ^xC4 link pad: .word docol ; : pad .word here ; here .word lit,^x100 ; 256 .word plus ; + .word semis ; ; head .byte ^x83 ; pfa .ascii /PF/ .byte ^xC1 link pfa: .word docol ; : pfa .word one ; 1 .word traverse ; traverse .word lit,5 ; 5 .word plus ; + .word semis ; ; head .byte ^x84 ; prev .ascii /PRE/ .byte ^xD6 link prev: .word dovar .word firstb head .byte ^x85 ; query .ascii /QUER/ .byte ^xD9 link query: .word docol ; : query .word tib ; tib .word fetch ; @ .word lit,getflag ; 'get foreign command line flag' .word fetch ; @ .word zbranch,10$ ; if .word lit,^x50 ; 80 .word expect ; expect .word branch,20$ ; else 10$: .word xquery ; (query) .word type ; type 20$: ; endif .word zero ; 0 .word in ; in .word store ; ! .word semis ; ; head .byte ^x84 ; quit .ascii /QUI/ .byte ^xD4 link quit: .word docol ; : quit .word zero ; 0 .word blk ; blk .word store ; ! .word lbracket ; [ 10$: ; begin .word rpstore ; rp! .word qterminal ; ?terminal .word drop ; drop .word cr ; cr .word query ; query .word space ; space .word interpret ; interpret .word state ; state .word fetch ; @ .word zequal ; 0= .word zbranch,20$ ; if .word xdotq ; (.") .ascic / OK/ ; ' OK' 20$: ; endif .word branch,10$ ; again .word semis ; ; head .byte ^x81 ; r .byte ^xD2 link r: .word .+2 addw #2,r9 movw (r8),(r9) brw next head .byte ^x82 ; r# .ascii /R/ .byte ^xA3 link rsharp: .word douse .word ^x2E head .byte ^x83 ; r/w .ascii \R/\ .byte ^xD7 link rw: .word docol ; : r/w .word xrw ; (r/w) .word semis ; ; head .byte ^x82 ; r0 .ascii /R/ .byte ^xB0 link rzero: .word douse .word 8 head .byte ^x82 ; r> .ascii /R/ .byte ^xBE link rfrom: .word .+2 addw #2,r9 movw (r8)+,(r9) brw next head .byte ^xC6 ; repeat .ascii /REPEA/ .byte ^xD4 link repeat: .word docol ; : repeat .word tor ; >r .word tor ; >r .word again ; again .word rfrom ; r> .word rfrom ; r> .word two ; 2 .word minus ; - .word endif ; endif .word semis ; ; immedaite head .byte ^x83 ; rot .ascii /RO/ .byte ^xD4 link rot: .word docol ; : rot .word tor ; >r .word swap ; swap .word rfrom ; r> .word swap ; swap .word semis ; ; head .byte ^x83 ; rp! .ascii /RP/ .byte ^xA1 link rpstore: .word .+2 addw3 #^x08,r3,r4 movw (r4),r8 brw next head .byte ^x84 ; s->d .ascii /S->/ .byte ^xC4 link stod: .word .+2 bitw #^x8000,(r9)+ beqlu 10$ movw #^xFFFF,(r9) brw next 10$: movw #0,(r9) brw next head .byte ^x82 ; s0 .ascii /S/ .byte ^xB0 link szero: .word douse .word 6 head .byte ^x8B ; save-system .ascii /SAVE-SYSTE/ .byte ^xCD link savesystem: .word docol ; : save-system .word voclink ; voc-link .word fetch ; @ .word fetch ; @ .word context ; context .word fetch ; @ .word fetch ; @ .word current ; current .word fetch ; @ .word fetch ; @ .word bl ; bl .word word ; word .word here ; here .word count ; count .word upcase ; upcase .word here ; here .word count ; count .word xsavesystem ; (save-system) .word qerror ; ?error .word semis ; ; head .byte ^x83 ; scr .ascii /SC/ .byte ^xD2 link scr: .word douse .word ^x1C head .byte ^x84 ; sign .ascii /SIG/ .byte ^xCE link sign: .word docol ; : sign .word rot ; rot .word zless ; 0< .word zbranch,10$ ; if .word lit,^x2D ; 45 ( '-') .word hold ; hold 10$: ; endif .word semis ; ; head .byte ^x86 ; smudge .ascii /SMUDG/ .byte ^xC5 link smudge: .word docol ; : smudge .word latest ; latest .word lit,^x20 ; 32 .word toggle ; toggle .word semis ; ; head .byte ^x83 ; sp! .ascii /SP/ .byte ^xA1 link spstore: .word .+2 addw3 #^x6,r3,r4 subw3 #2,(r4),r9 brw next head .byte ^x83 ; sp@ .ascii /SP/ .byte ^xC0 link spfetch: .word .+2 movw r9,r10 addw #2,r9 movw r10,(r9) brw next head .byte ^x85 ; space .ascii /SPAC/ .byte ^xC5 link space: .word docol ; : space .word xspace ; (space) .word semis ; ; head .byte ^x86 ; spaces .ascii /SPACE/ .byte ^xD3 link spaces: .word docol ; : spaces .word mdup ; -dup .word zbranch,20$ ; if .word zero ; 0 .word xdo ; do 10$: .word xspace ; (space) .word xloop,10$ ; loop 20$: ; endif .word semis ; ; head .byte ^x85 ; state .ascii /STAT/ .byte ^xC5 link state: .word douse .word ^x24 head .byte ^x86 ; status .ascii /STATU/ .byte ^xD3 link status: .word .+2 addw #2,r9 movaw xstatus,(r9) brw next xstatus: .long 0 head .byte ^x84 ; swap .ascii /SWA/ .byte ^xD0 link swap: .word .+2 movw (r9),r10 movw -(r9),r11 movw r10,(r9)+ movw r11,(r9) brw next head .byte ^xC4 ; then .ascii /THE/ .byte ^xCE link then: .word docol ; : then .word endif ; endif .word semis ; ; immediate head .byte ^x83 ; tib .ascii /TI/ .byte ^xC2 link tib: .word douse .word ^x0A head .byte ^x86 ; toggle .ascii /TOGGL/ .byte ^xC5 link toggle: .word .+2 movb (r9),r4 movzwl -(r9),r10 subw #2,r9 xorb r4,(r10) brw next head .byte ^x88 ; traverse .ascii /TRAVERS/ .byte ^xC5 link traverse: .word docol ; : traverse .word swap ; swap 10$: ; begin .word over ; over .word plus ; + .word lit,^x7F ; 127 .word over ; over .word cfetch ; c@ .word less ; < .word zbranch,10$ ; until .word swap ; swap .word drop ; drop .word semis ; ; head .byte ^x84 ; type .ascii /TYP/ .byte ^xC5 link type: .word docol ; : type .word xtype ; (type) .word semis ; ; head .byte ^x82 ; u* .ascii /U/ .byte ^xAA link ustar: .word .+2 movzwl (r9),r10 movzwl -(r9),r11 mull3 r11,r10,r11 movl r11,(r9) addw #2,r9 brw next head .byte ^x82 ; u. .byte ^x55 .byte ^xAE link udot: .word docol ; : u. .word zero ; 0 .word ddot ; d. .word semis ; ; head .byte ^x82 ; u/ .ascii /U/ .byte ^xAF link uslash: .word .+2 clrl r11 movzwl (r9),r4 subw #4,r9 movl (r9),r10 ediv r4,r10,r4,r10 movw r10,(r9)+ movw r4,(r9) brw next head .byte ^xC5 ; until .ascii /UNTI/ .byte ^xCC link until: .word docol ; : until .word one ; 1 .word qpairs ; ?pairs .word compile ; compile .word zbranch ; 'run time 0branch routine' .word back ; back .word semis ; ; immediate head .byte ^x86 ; upcase .ascii /UPCAS/ .byte ^xC5 link upcase: .word docol ; : upcase .word over ; over .word plus ; + .word swap ; swap .word xdo ; do 10$: .word i ; i .word cfetch ; c@ .word lit,^x60 ; 96 ( > 'a' ) .word greater ; > .word i ; i .word cfetch ; c@ .word lit,^x7B ; 123 ( < 'z' ) .word less ; < .word and ; and .word zbranch,20$ ; if .word i ; i .word lit,^x20 ; 32 .word toggle ; toggle 20$: ; endif .word xloop,10$ ; loop .word semis ; ; head .byte ^x86 ; update .ascii /UPDAT/ .byte ^xC5 link update: .word docol ; : update .word prev ; prev .word fetch ; @ .word fetch ; @ .word lit,^x8000 ; 8000 .word or ; or .word prev ; prev .word fetch ; @ .word store ; ! .word semis ; ; head .byte ^x83 ; use .ascii /US/ .byte ^xC5 link use: .word dovar .word firstb head .byte ^x84 ; user .ascii /USE/ .byte ^xD2 link user: .word docol ; : user .word lit,douse ; 'run time user routine' .word storecode ; !code .word one ; 1 .word lit,xuser ; 'number of user variables' .word plustore ; +! .word semis ; ; head .byte ^x88 ; variable .ascii /VARIABL/ .byte ^xC5 link variable: .word docol ; : variable .word lit,dovar ; 'run time variable routine' .word storecode ; !code .word semis ; ; head .byte ^x85 ; vlist .ascii /VLIS/ .byte ^xD4 link vlist: .word docol ; : vlist .word cr ; cr .word lit,^x80 ; 128 .word out ; out .word store ; ! .word context ; context .word fetch ; @ .word fetch ; @ 10$: ; begin .word dup ; dup .word xid ; (id) .word swap ; swap .word drop ; drop .word out ; out .word fetch ; @ .word plus ; + .word lit,^x4C ; 76 .word greater ; > .word zbranch,20$ ; if .word cr ; cr 20$: ; endif .word dup ; dup .word id ; id. .word space ; space .word space ; space .word pfa ; pfa .word lfa ; lfa .word fetch ; @ .word dup ; dup .word zequal ; 0= .word qterminal ; ?terminal .word or ; or .word zbranch,10$ ; until .word drop ; drop .word cr ; cr .word semis ; ; head .byte ^x88 ; voc-link .ascii /VOC-LIN/ .byte ^xCB link voclink: .word douse .word ^x14 head .byte ^x8A ; vocabulary .ascii /VOCABULAR/ .byte ^xD9 link vocabulary: .word docol ; : vocabaulary .word builds ; dovoc: .word twoplus ; 2+ .word context ; context .word store ; ! .word semis ; ; head .byte ^x84 ; warm .ascii /WAR/ .byte ^xCD link warm: .word .+2 movl #1,r0 ; indicate warm start ret head .byte ^x87 ; warning .ascii /WARNIN/ .byte ^xC7 link warning: .word douse .word ^x0E head .byte ^xC5 ; while .ascii /WHIL/ .byte ^xC5 link while: .word docol ; : while .word if ; if .word twoplus ; 2+ .word semis ; ; immediate head .byte ^x85 ; width .ascii /WIDT/ .byte ^xC8 link width: .word douse .word ^x0C head .byte ^x84 ; word .ascii /WOR/ .byte ^xC4 link word: .word docol ; : word .word blk ; blk .word fetch ; @ .word zbranch,10$ ; if .word blk ; blk .word fetch ; @ .word block ; block .word branch,20$ ; else 10$: .word tib ; tib .word fetch ; @ 20$: ; endif .word in ; in .word fetch ; @ .word plus ; + .word swap ; swap .word enclose ; enclose .word here ; here .word lit,^x22 ; 34 .word blanks ; blanks .word in ; in .word plustore ; +! .word over ; over .word minus ; - .word tor ; >r .word r ; r .word here ; here .word cstore ; c! .word plus ; + .word here ; here .word oneplus ; 1+ .word rfrom ; r> .word cmove ; cmove .word semis ; ; head .byte ^x83 ; xor .ascii /XO/ .byte ^xD2 link xor: .word .+2 xorw (r9),-(r9) brw next head .byte ^xC1 ; [ .byte ^xDB link lbracket: .word docol ; : [ .word zero ; 0 .word state ; state .word store ; ! .word semis ; ; head .byte ^xC9 ; [compile] .ascii /[COMPILE/ .byte ^xDD link xcompile: .word docol ; : [compile] .word mfind ; -find .word zequal ; 0= .word zero ; 0 .word qerror ; ?error .word drop ; drop .word cfa ; cfa .word comma ; , .word semis ; ; head .byte ^x81 ; ] .byte ^xDD link rbracket: .word docol ; : ] .word lit,^xC0 ; 192 .word state ; state .word store ; ! .word semis ; ; taskhead: head .byte ^x84 ; task .ascii /TAS/ .byte ^xCB link task: .word docol ; : task .word semis ; ; endforth: . = ^xF000 .end FIGFORTH >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> FIGFTHV2.RNO .IF HELP .LO 0.SP 1.LM 0.RM 79.NNM.NHD.NFL.NFL COMMENT .LITERAL $LIBR/CREATE/TEXT SYS$LOGIN:FIGFORTH.HELP .END LITERAL .ELSE HELP .LO 3,2.SP 1.LM 0.RM 79.NNM.NHD.NFL.NFL COMMENT .FG 11 .C;VAX-11 fig-Forth Version 2.0 .B 2 .C;GLOSSARY .B 3 .C;by .B 2 .C;Rodrick A. Eldridge .C;Central Iowa Forth Interest Group .C;Iowa State University .B 11 .C;The public domain VAX-11 Fig-Forth Version 1.0 is provided through .C;the courtesy of .B .C;Forth Interest Group, P. O. Box 1105, San Carlos, CA 94070 .B 3 .C;This public domain publication is provided through the courtesy of .C;Central Iowa FIG (CIFIG), Iowa State University, Ames, IA 50011 .B 2 .C;Futher distribution must include these notices .PA .C;NOTICE .B 2 This document and its related software is placed in the public domain. Permission is granted to reproduce and distribute this document and its related software with the following restriction: .B .C;No distributor is allowed to restrict its further redistribution. .B 2 Further distribution must include the following notices: .B .C;* * * * * .B .C;The public domain VAX-11 fig-Forth Version 1.0 is provided through .C;the courtesy of .B .C;Forth Interest Group, P. O. Box 1105, San Carlos, CA 94070 .B 2 .C;This public domain publication is provided through the courtesy of .C;Central Iowa FIG (CIFIG), Iowa State University, Ames, IA 50011 .B .C;* * * * * .B 5 .C;Please send corrections and modifications to: .B .C;Central Iowa Forth Interest Group .C;c/o Rodrick A. Eldridge .C;Iowa State University .C;104 Computer Science .C;Ames, Iowa 50011 .PA .C;REFERENCES .B 5 .C;fig-Forth Installation Manual .C;by Willaim F. Ragsdale .C;Forth Interest Group .B 3 .C;Forth-79 Standard .C;Forth Interest Group .B 3 .C;Forth-83 Standard .C;Forth Interest Group .B 3 .C;fig-Forth for VAX-11, Assembly Source Listing .C;by Bob Haller and Doug Mercer .C;Forth Interest Group .B 3 .C;fig-Forth for PDP-11, Assembly Source Listing .C;by John S. James .C;Forth Interest Group .B 3 .C;Systems Guide to fig-Forth .C;by C. H. Ting, .C;Offete Enterprises, Inc. .B 3 .C;All About Forth, An annotated Glossary .C;by Glen B. Haydon .C;Mountain View Press, Inc. .PA .C;GLOSSARY .B 2 This glossary contains all of the word definitions in this implementation. .B The first line of each entry shows a symbolic description of the action of the procedure on the parameter stack. The symbols indicate the order in which input parameters have been placed on the stack. Three dashes "---" indicate the execution point and any parameters left on the stack are listed. In this notation, the top of the stack is to the right. .B The symbols shown include: .B .LITERAL addr memory address b 8 bit byte c 7 bit ascii character cfa code field address count 16 bit signed integer number d 32 bit signed double number f boolean flag. 0=false, non-zero=true ff boolean false flag=0 lfa link field address n 16 bit signed integer number nfa name field address pfa parameter field address u 16 bit unsigned integer number ud 32 bit unsigned double number tf boolean true flag=non-zero .END LITERAL .B Unless otherwise noted, all references to numbers are for 16 bit signed integers. For 32 bit signed double numbers, the most significant portion with sign is on top of stack. .B Unless otherwise specified in the glossary, all arithemetic is implicitly 16 bit signed integer math, with error and under-flow indication unspecified. .B The first line also shows the "standard" in which the word is defined. .B These symbols include: .B .LITERAL FIG defined in fig-Forth F79 defined in Forth-79 F83 defined in Forth-83 ISU local definition or modification .END LITERAL .PA .ENDIF HELP .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="^@" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL ^@ ( --- ) FIG .END LITERAL .B This is a pseudonym for the dictionary entry for a name of one character of ascii "null" (i.e. hex 00). It is the execution procedure to terminate interpretation of a line of text from the terminal or within a disk buffer, as both buffers always have a "null" at the end. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="!" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL ! ( n addr --- ) FIG,F79,F83 .END LITERAL .B Store n at address. Pronounced "store". .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="!CODE" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL !CODE ( --- ) FIG .END LITERAL .B Used by CONSTANT, USER and VARIABLE to compile a constant, user variable and variable, respectively. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="!CSP" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL !CSP ( --- ) FIG .END LITERAL .B Save the stack position in CSP. Used as part of the compiler security. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="#" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL # ( d1 --- d2 ) FIG,F79,F83 .END LITERAL .B Generate from a double number d1, the next ascii character which is placed in an output string. The result, double number d2, is the quotient after division by BASE and is maintained for further processing. Used between <# and #> .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="#>" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL #> ( d --- addr count ) FIG,F79,F83 .END LITERAL .B End numeric output conversion by dropping d, leaving the text address and character count suitable for TYPE. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="#S" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL #S ( d1 --- d2 ) FIG,F79,F83 .END LITERAL .B Convert all digits of a double number d1, adding each to the pictured numeric output text, until the remainder is zero. A single zero is added to the output string if the number was initially zero. Used between <# and #> .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="'" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL ' ( --- pfa ) FIG,F79,F83 .END LITERAL .B Used in the form: .LITERAL ' .END LITERAL .B If executing, leave the parameter field address of the next word accepted from the input stream. .B If compiling, compile this address as a literal. Later execution will place this value on the stack. .B If the word is not found after a search of CONTEXT and CURRENT, an appropriate error message is given. Pronounced "tick". .B Note: in Forth-83, ' leaves the code field address. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="(" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL ( ( --- ) FIG,F79,F83 .END LITERAL .B Used in the form: .LITERAL ( comment) .END LITERAL .B Accept and ignore comment characters from the input stream, until the next right parenthesis. As a word, the left parenthesis must be followed by one blank. It may be freely used while executing or compiling. .B Note: both ( and ) must be on the same line. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="(+LOOP)" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL (+LOOP) FIG .END LITERAL .B The run time procedure compiled by +LOOP which increments the loop index by the value on the stack and tests for loop completion. See +LOOP .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="(."")" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL (.") FIG .END LITERAL .B The run time procedure compiled by ." which transmits the following in-line text to the terminal. See ." .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="(;CODE)" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL (;CODE) FIG .END LITERAL .B The run time procedure compiled by ;CODE that rewrites the code field of the most recently defined word to point to the following machine code sequence. See ;CODE .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="(ABORT)" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL (ABORT) FIG .END LITERAL .B Executes after an error when WARNING is -1. This word normally executes ABORT but may be altered to a user's alternative procedure. See ABORT .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="(BLOCK-READ)" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL (BLOCK-READ) ISU .END LITERAL .B Used by BLOCK-READ. See BLOCK-READ .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="(BLOCK-WRITE)" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL (BLOCK-WRITE) ISU .END LITERAL .B Used by BLOCK-WRITE. See BLOCK-WRITE .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="(CR)" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL (CR) ISU .END LITERAL .B Used by CR. See CR .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="(DO)" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL (DO) FIG .END LITERAL .B The run time procedure compiled by DO which moves the loop control parameters to the return stack. See DO .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="(EMIT)" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL (EMIT) ISU .END LITERAL .B Used by EMIT. See EMIT .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="(EXPECT)" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL (EXPECT) ISU .END LITERAL .B Used by EXPECT. See EXPECT .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="(FIND)" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL (FIND) ( addr nfa --- ff ) FIG ( addr nfa --- pfa b tf ) .END LITERAL .B Searches the dictionary starting at the name field address, matching to the text at addr. Returns the parameters field address, the length byte of the name field and boolean true flag for a good match. If no match is found, only a boolean false flag is left. See -FIND .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="(HELP)" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL (HELP) ISU .END LITERAL .B Used by HELP. See HELP .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="(ID)" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL (ID) ISU .END LITERAL .B Used by ID. and VLIST. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="(KEY)" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL (KEY) ISU .END LITERAL .B Used by KEY. See KEY .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="(LINE)" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL (LINE) ( n1 n2 --- addr count ) FIG .END LITERAL .B Convert the line number n1 and the screen number n2 to the disk buffer address containing the data. A count of C/L indicates the full line text length. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="(LOAD-SYSTEM)" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL (LOAD-SYSTEM) ISU .END LITERAL .B Used by LOAD-SYSTEM. See LOAD-SYSTEM .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="(LOOP)" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL (LOOP) FIG .END LITERAL .B The run time procedure compiled by LOOP which increments the loop index and tests for loop completion. See LOOP .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="(NEED)" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL (NEED) ISU .END LITERAL .B Used by NEED. See NEED .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="(NUMBER)" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL (NUMBER) ( d1 addr1 --- d2 addr2 ) FIG .END LITERAL .B Convert the ascii text beginning at addr1+1 with regard to BASE. The new value is accumulated into double number d1, being left as d2. addr2 is the address of the first unconvertable digit. See NUMBER .B Note: in Forth-79 and Forth-83, (NUMBER) is called CONVERT. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="(QUERY)" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL (QUERY) ( --- addr count ) ISU .END LITERAL .B Used by QUERY at COLD start. Returns the "foreign command line" specified at run time. If the "foreign command": .LITERAL FORTH := VAXUSR:[CLASSLIB.005003.VAX.FORTH]FORTHV2. .END LITERAL .B is executed as: .LITERAL FORTH .END LITERAL .B then, (QUERY) will return the address of the and a count of these characters. .B You may execute (QUERY) anytime yourself to return this address and count. .B See also QUERY. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="(R/W)" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL (R/W) ISU .END LITERAL .B Used by R/W. See R/W .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="(SAVE-SYSTEM)" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL (SAVE-SYSTEM) ISU .END LITERAL .B Used by SAVE-SYSTEM. See SAVE-SYSTEM .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="(SCR)" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL (SCR) ISU .END LITERAL .B Used by ?SCR. See ?SCR .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="(TYPE)" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL (TYPE) ISU .END LITERAL .B Used by TYPE. See TYPE .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="*" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL * ( n1 n2 --- n3 ) FIG,F79,F83 .END LITERAL .B Leave the signed product of n1 * n2. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="*/" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL */ ( n1 n2 n3 --- n4 ) FIG,F79,F83 .END LITERAL .B Multiply n1 by n2, divide the result by n3 and leave the quotient. The quotient is rounded toward zero. The product of n1 * n2 is maintained as and intermediate 32 bit value for greater precision than the otherwise equivalent sequence: n1 n2 * n3 /. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="*/MOD" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL */MOD ( n1 n2 n3 --- n4 n5 ) FIG,F79,F83 .END LITERAL .B Multiply n1 by n2, divide the result by n3 and leave the remainder n4 and quotient n5. A 32 bit intermediate product is used as for */. The remainder has the same sign as n1. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="+" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL + ( n1 n2 --- n3 ) FIG,F79,F83 .END LITERAL .B Leave the sum of n1 + n2. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="+!" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL +! ( n addr --- ) FIG,F79,F83 .END LITERAL .B Add n to the 16 bit value at addr. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="+-" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL +- ( n1 n2 --- n3 ) FIG .END LITERAL .B Appy the sign of n2 to n1, which is left as n3. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="+BUF" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL +BUF ( addr1 --- addr2 f ) FIG .END LITERAL .B Advance the disk buffer address addr1 to the address of the next buffer addr2. Boolean flag f is false when addr2 is the buffer presently pointed to by variable PREV. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="+LOOP" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL +LOOP ( n --- ) FIG,F79,F83 .END LITERAL .B Used in the form: .LITERAL DO .. +LOOP .END LITERAL .B Used only in a colon definition. Add the increment n to the loop index and compare the total to the loop limit. Return execution to the corresponding DO until the new index is equal to or greater than the limit (n>0) or until the new index is less than the limit (n<0). Upon exiting the loop, the parameters are discarded and execution continues ahead. See also DO .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="+ORIGIN" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL +ORIGIN ( n --- addr ) FIG .END LITERAL .B Leave the memory address relative by n to the ORIGIN parameter area. n is in bytes. This definition is used to access or modify the boot-up parameters at the ORIGIN area. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="," .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL , ( n --- ) FIG,F79,F83 .END LITERAL .B Allocate two bytes in the dictionary, storing n there. Pronounced "comma". .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="-" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL - ( n1 n2 --- n3 ) FIG,F79,F83 .END LITERAL .B Leave the difference of n1 - n2. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="-->" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL --> ( --- ) FIG,F79,F83 .END LITERAL .B Continue interpretation with the next disk screen. Pronounced "next-screen". .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="-DUP" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL -DUP ( n --- n ) ( if zero) FIG ( n --- n n ) ( if non-zero) .END LITERAL .B Reproduce n only if it is non-zero. This is usually used to copy a value just before IF to eliminate the need for an ELSE part to DROP it. .B Note: in Forth-79 and Forth-79, -DUP is called ?DUP .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="-FIND" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL -FIND ( --- ff ) FIG ( --- pfa b tf ) .END LITERAL .B Accepts the next text word, delimited by blanks, in the input stream to HERE and searches the CONTEXT vocabulary and then the CURRENT vocabulary for a matching entry. If found, the dictionary entry's parameter field address, its length byte, and a boolean true flag is left, otherswise, only a boolean false flag is left. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="-TRAILING" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL -TRAILING ( addr n1 --- addr n2 ) FIG,F79,F83,ISU .END LITERAL .B Adjusts the character count n1 of a text string beginning at addr to exclude trailing blanks, i.e. the characters at addr+n2 to addr+n1 are blanks. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="." .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL . ( n --- ) FIG,F79,F83 .END LITERAL .B Display n converted according to BASE in a free field format with one trailing blank. If n is negative, . will display the negative sign. Pronounced "dot". .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE=".""" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL ." ( --- ) FIG,F79,F83 .END LITERAL .B Used in the form: .LITERAL ." string" .END LITERAL .B Compiles an in-line string, delimited by the trailing ." with an execution procedure to transmit the text to the terminal. If executed outside a definition, ." will immediately print the text until the final closing quote. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE=".LINE" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL .LINE ( n1 n2 --- ) FIG .END LITERAL .B Print to the terminal, a line of text from the disk by its line number n1 and screen number n2. Trailing blanks are suppressed. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE=".R" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL .R ( n1 n2 --- ) FIG .END LITERAL .B Print n1 right aligned in a field whose width is n2 characters according to BASE. If n2 is less than 1, no leading blanks are supplied. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="/" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL / ( n1 n2 --- n3 ) FIG,F79,F83 .END LITERAL .B Leave the signed quotient of n1 / n2. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="/MOD" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL /MOD ( n1 n2 --- n3 n4 ) FIG,F79,F83 .END LITERAL .B Leave the remainder and the signed quotient of n1 / n2. The remainder has the same sign as the dividend. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="0" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL 0 ( --- n ) FIG .END LITERAL .B A constant leaving 0 on the stack. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="1" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL 1 ( --- n ) FIG .END LITERAL .B A constant leaving 1 on the stack. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="2" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL 2 ( --- n ) FIG .END LITERAL .B A constant leaving 2 on the stack. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="3" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL 3 ( --- n ) FIG .END LITERAL .B A constant leaving 3 on the stack. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="0<" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL 0< ( n --- f ) FIG,F79,F83 .END LITERAL .B Leave a true flag if the number is less than zero (negative), otherwise, leave a false flag. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="0=" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL 0= ( n --- f ) FIG,F79,F83 .END LITERAL .B Leave a true flag if the number is equal to zero, otherwise, leave a false flag. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="0BRANCH" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL 0BRANCH ( f --- ) FIG .END LITERAL .B The run time procedure to conditionally branch. If f is false (zero), the following in-line address is used to branch to. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="1+" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL 1+ ( n1 --- n2 ) FIG,F79,F83 .END LITERAL .B Increment n1 by 1, leaving the sum n2. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="2+" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL 2+ ( n1 --- n2 ) FIG,F79,F83 .END LITERAL .B Increment n1 by 2, leaving the sum n2. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="2DROP" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL 2DROP ( d --- ) FIG .END LITERAL .B This word is not defined in this implementation. Use DDROP .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="2DUP" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL 2DUP ( d --- d d ) FIG .END LITERAL .B This word is not defined in this implementation. Use DDUP .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="2OVER" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL 2OVER ( d1 d2 --- d1 d2 d1 ) FIG .END LITERAL .B This word is not defined in this implementation. Use DOVER .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="2SWAP" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL 2SWAP ( d1 d2 --- d2 d1 ) FIG .END LITERAL .B This word is not defined in this implementation. Use DSWAP .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE=":" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL : ( --- ) FIG,F79,F83 .END LITERAL .B Used in the form: .LITERAL : .. ; .END LITERAL .B Creates a dictionary entry defining as equivalent to the following sequence of Forth word definitions ".." until the next ; or ;CODE. The compiling process is done by the text interpreter as long as STATE is non-zero. .B Other details are that the CONTEXT vocabulary is set to the CURRENT vocabulary and that words with the precedence bit set are executed rather than being compiled. .B Pronounced "colon". .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE=";" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL ; ( --- ) FIG,F79,F83 .END LITERAL .B Terminate a colon definition and stop futher compilation. Compiles the run time procedure ;S. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE=";CODE" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL ;CODE ( --- ) FIG .END LITERAL .B Used in the form: .LITERAL : .. ;CODE assembly_mnemonics .END LITERAL .B Stop compilation and terminate a new defining word by compiling the run time procedure (;CODE). Set the CONTEXT vocabulary to ASSEMBLER and assemble to machine code the following mnemonics. .B When later executes in the form: .LITERAL .END LITERAL .B the word will be created with its execution procedure given by the machine code following . That is, when is executed, it does so by jumping to the code after . An existing defining word must exist in prior to ;CODE. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE=";S" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL ;S ( --- ) FIG .END LITERAL .B Stop interpretation of a screen. ;S is also the run time word compiled at the end of a colon definition which returns execution to the calling procedure. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="<" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL < ( n1 n2 --- f ) FIG,F79,F83 .END LITERAL .B Leave a true flag if n1 < n2, otherwise, leave a false flag. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="<#" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL <# ( --- ) FIG,F79,F83 .END LITERAL .B Initialize for pictured numeric output formatting using the words: .LITERAL <# # #S SIGN #> .END LITERAL .B The conversion is done on a double number producing text at PAD. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE=" .. ; .END LITERAL .B Each time is executed, later executes in the form: .LITERAL .END LITERAL .B uses with a cell to the DOES> part for . .B When is later executed, it has the address of its parameter area on the stack and executes the words after DOES> in . .B allow run time procedures to be written in high-level rather than in assembler code as required by ;CODE. See also DOES> .B Note: in Forth-79 and Forth-83, ( n1 n2 --- f ) FIG,F79,F83 .END LITERAL .B Leave a true flag if n1 > n2, otherwise, leave a flase flag. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE=">IN" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL >IN ( --- addr ) F79,F83 .END LITERAL .B In fig-Forth, >IN is called IN. See IN .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE=">R" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL >R ( n --- ) FIG,F79,F83 .END LITERAL .B Transfer n to the return stack. Every >R must be balanced by a R> in the same control structure nesting level of a colon definition. Pronounced "to-r". See also R> .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="?" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL ? ( addr --- ) FIG,F79 .END LITERAL .B Print the value contained at addr in free format according to BASE. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="?COMP" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL ?COMP ( --- ) FIG .END LITERAL .B Issue an error message if not compiling. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="?CSP" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL ?CSP ( --- ) FIG .END LITERAL .B Issue an error message if the stack position differs from the value saved in CSP. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="?DUP" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL ?DUP ( n --- n ) ( if zero) F79,F83 ( n --- n n ) ( if non-zero) .END LITERAL .B In fig-Forth, ?DUP is called -DUP. See -DUP .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="?ERROR" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL ?ERROR ( --- ) FIG .END LITERAL .B Issue an error message number n, if the boolean flag is true. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="?EXEC" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL ?EXEC ( --- ) FIG .END LITERAL .B Issue an error message if not executing. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="?LOADING" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL ?LOADING ( --- ) FIG .END LITERAL .B Issue an error message if not loading. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="?PAIRS" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL ?PAIRS ( --- ) FIG .END LITERAL .B Issue an error message if n1 does not equal n2. The message indicates that compiled conditionals do not match. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="?SCR" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL ?SCR ( n --- f ) ISU .END LITERAL .B Leaves a boolean true flag on the stack if SCR # n exists, otherwise, leaves a boolean false flag. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="?STACK" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL ?STACK ( --- ) FIG,ISU .END LITERAL .B Issue an error message if the stack is out of bounds. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="?TERMINAL" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL ?TERMINAL ( --- f ) FIG .END LITERAL .B Perform a test of the terminal keyboard for actuation of the break key. A true flag indicates actuation. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="@" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL @ ( addr --- n ) FIG,F79,F83 .END LITERAL .B Leave on the stack the number contained at addr. Pronounced "fetch". .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="ABORT" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL ABORT ( --- ) FIG,F79,F83 .END LITERAL .B Clear the stacks and enter the execution state. Return control to the terminal and print a message. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="ABS" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL ABS ( n --- u ) FIG,F79,F83 .END LITERAL .B Leave the absolute value of n as u. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="AGAIN" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL AGAIN ( --- ) FIG,F79,F83 .END LITERAL .B Used in the form: .LITERAL BEGIN .. AGAIN .END LITERAL .B Used only in a colon definition. Effect an uncontional jump back to the start of a BEGIN-AGAIN loop. .B AGAIN is an alias of REPEAT. See REPEAT .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="ALLOT" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL ALLOT ( n --- ) FIG,F79,F83 .END LITERAL .B Add n bytes to the parameter field of the most recently defined word. May be used to reserve memory space. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="AND" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL AND ( n1 n2 --- n3 ) FIG,F79,F83 .END LITERAL .B Leave the bitwise logical "and" of n1 and n2. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="B/BUF" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL B/BUF ( --- n ) FIG,ISU .END LITERAL .B A constant leaving the number of bytes per block buffer. In this implementation, although there are 2048 bytes per buffer, only 1920 bytes are used (i.e. 24 lines by 80 characters). .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="B/SCR" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL B/SCR ( --- n ) FIG,ISU .END LITERAL .B A constant leaving the number of blocks per editing screen. In this implementation, there is one block per editing screen. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="BACK" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL BACK ( addr --- ) FIG .END LITERAL .B Compiles addr into the next available dictionary memory address. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="BASE" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL BASE ( --- addr ) FIG,F79,F83 .END LITERAL .B Leave the address of a user variable containing the current input and output numeric conversion base. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="BEGIN" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL BEGIN ( --- ) FIG,F79,F83 .END LITERAL .B Used in the form: .LITERAL BEGIN .. UNTIL BEGIN .. WHILE .. REPEAT .END LITERAL .B Used only in a colon definition. BEGIN marks the start of a word sequence for repetitive execution. .B A BEGIN-UNTIL loop will be repeated until flag f is true. See UNTIL .B A BEGIN-WHILE-REPEAT loop will be repeated until flag f is false. WHILE is optional. AGAIN is an alias of REPEAT. See WHILE and REPEAT .B The words after UNTIL or REPEAT will be executed when either loop is finished. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="BINARY" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL BINARY ( --- ) ISU .END LITERAL .B Set the input-output numeric conversion base to two (binary). .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="BL" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL BL ( --- c ) FIG .END LITERAL .B A constant that leaves the ascii value for "blank". .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="BLANKS" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL BLANKS ( addr n --- ) FIG .END LITERAL .B Fill an area of memory beginning at addr with n blanks. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="BLK" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL BLK ( --- addr ) FIG,F79,F83 .END LITERAL .B A user variable containing the block number begin interpreted. If zero, input is being taken from the terminal input buffer. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="BLOCK" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL BLOCK ( n --- addr ) FIG,F79,F83 .END LITERAL .B Leave the memory address of the block buffer containing block n. If the block is not already in memory, it is transferred from disk to which ever buffer was least recently written. If the block occupying that buffer has been marked as updated, it is rewritten to disk before block n is read into the buffer. See also BUFFER .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="BLOCK-READ" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL BLOCK-READ ( addr1 addr2 count --- ff 0 ) FIG,F79,F83,ISU ( addr1 addr2 count --- tf n ) .END LITERAL .B Reads a block from disk into addr1. addr2 (address of ascii screen number) and count were created by R/W. If no I/O error occured, a boolean false flag and zero are left on the stack, otherwise, a boolean true flag and an error number are left on the stack. See also R/W .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="BLOCK-WRITE" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL BLOCK-WRITE ( addr1 addr2 count --- ff 0 ) FIG,F79,F83,ISU ( addr1 addr2 count --- tf n ) .END LITERAL .B Writes a block from addr1 to disk. addr2 and count was created the same way as for BLOCK-READ. If no I/O error occured, a boolean false flag and zero are left on the stack, otherwise, a boolean true flag and an error number are left on the stack. See BLOCK-READ .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="BRANCH" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL BRANCH ( --- ) FIG .END LITERAL .B The run time procedure to unconditionally branch. An in-line address is used to branch to. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="BUFFER" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL BUFFER ( n --- addr ) FIG .END LITERAL .B Obtain the next memory buffer, assigning it to block n. If the contents of the buffer is marked as updated, it is written to the disk. The block is not read from the disk. The address left is the first cell within the buffer for data storage. See also BLOCK .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="BYE" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL BYE ( --- ) FIG .END LITERAL .B FLUSH all buffers and exit Forth. See also MON .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="C!" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL C! ( b addr --- ) FIG,F79,F83 .END LITERAL .B Store 8 bits of b at addr. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="C," .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL C, ( b --- ) FIG,F79,F83 .END LITERAL .B Store 8 bits of b into the next available dictionary byte, advancing the dictionary pointer. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="C/L" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL C/L ( --- n ) FIG .END LITERAL .B A constant leaving the number of character per line on the stack. In this implementation, there are 80 characters per line. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="C@" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL C@ ( addr --- b ) FIG,F79,F83 .END LITERAL .B Leave on the stack the contents of the byte at addr. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="CFA" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL CFA ( pfa --- cfa ) FIG .END LITERAL .B Convert the parameter field address of a definition to its code field address. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="CMOVE" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL CMOVE ( addr1 addr2 n --- ) FIG,F79,F83 .END LITERAL .B Copy n bytes starting at addr1 to addr2. The move proceeds from low memory to high memory. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="COLD" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL COLD ( --- ) FIG .END LITERAL .B The cold start procedure to adjust the dictionary pointer to the minimum standard and restart via ABORT. COLD may be called to remove application programs and restart. See ABORT. See also WARM .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="COMPILE" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL COMPILE ( --- ) FIG,F79,F83 .END LITERAL .B When the word containing COMPILE executes, the execution address of the word following COMPILE is copied (compiled) into the dictionary. This allows specific compilation situations to be handled in addition to simply compiling an execution address. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="CONSTANT" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL CONSTANT ( n --- ) FIG,F79,F83 .END LITERAL .B Used in the form: .LITERAL n CONSTANT .END LITERAL .B Creates word with it parameter field address containing n. When is later executed, it will push the value of n to the stack. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="CONTEXT" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL CONTEXT ( --- addr ) FIG,F79 .END LITERAL .B A user variable containing a pointer to the vocabulary within which dictionary searches will first begin. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="CONVERT" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL CONVERT ( d1 addr1 --- d2 addr2 ) F79,F83 .END LITERAL .B In fig-Forth, CONVERT is called (NUMBER). See (NUMBER) .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="COUNT" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL COUNT ( addr1 --- addr2 count ) FIG,F79,F83 .END LITERAL .B Leave the address, addr2, and the byte count of a text string beginning at addr1. It is presumed that the first byte at addr1 contains the text byte count and the actual text starts with the second byte. Typically COUNT is followed by TYPE. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="CR" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL CR ( --- ) FIG,F79,F83,ISU .END LITERAL .B Transmit a carriage return and line feed to the terminal. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="CREATE" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL CREATE ( --- ) F79,F83 .END LITERAL .B In fig-Forth, this form of CREATE is called .END LITERAL .B Used by such words as CODE and CONSTANT to create a dictionary header for a Forth definition. The code field address contains the address of the word's parameters field address. The new word is created in the CURRENT vocabulary. .B Note: in Forth-79 and Forth-83, DEFINITIONS .END LITERAL .B Set the CURRENT vocabulary to the CONTEXT vocabulary. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="DEFDIR" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL DEFDIR ( --- addr ) ISU .END LITERAL .B A user variable that contains the default DIR setting for disk access in HELP and MESSAGE. DEFDIR defaults to 0, i.e. HELP and MESSAGE use "FORTH0:" by default. See also DIR .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="DEFSCR" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL DEFSCR ( --- addr ) ISU .END LITERAL .B A user variable that contains the default SCR setting for disk access in MESSAGE. DEFSCR defaults to 4, i.e. MESSAGE uses SCR # 4 by default. See also MESSAGE .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="DIR" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL DIR ( n --- ) ISU .END LITERAL .B Sets the logical name "FORTHn:" and stores n into the user variable OFFSET. All disk access will be taken from this logical name. If n is not between 0 and 15, exclusively, an error message is given. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="DIGIT" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL DIGIT ( c n1 --- n2 tf ) FIG ( c n1 --- ff ) .END LITERAL .B Converts the ascii character c (using base n1) to its binary equivalent n2, accompanied by a boolean true flag. If the conversion is invalid, leaves only a boolean false flag. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="DLITERAL" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL DLITERAL ( d --- d ) ( executing) FIG ( d --- ) ( compiling) .END LITERAL .B If compiling, compile a stack double number into a literal. Later execution of the definition containing this literal will push it on the stack. If executing, the number will remain on the stack. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="DMINUS" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL DMINUS ( d1 --- d2 ) FIG .END LITERAL .B Convert d to it double number two's complement. .B Note: in Forth-79 and Forth-83, DMINUS is called DNEGATE .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="DNEGATE" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL DNEGATE ( d1 --- d2 ) F79,F83 .END LITERAL .B In fig-Forth, DNEGATE is called DMINUS. See DMINUS .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="DO" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL DO ( n1 n2 --- ) FIG,F79,F83 .END LITERAL .B Used in the form: .LITERAL DO .. +LOOP DO .. LOOP .END LITERAL .B Used only in a colon definition. Begin a loop which will terminate based on control parameters. The loop index begins at n2 and terminates based on the limit n1. At LOOP or +LOOP, the index is modified by a positive or negative value. The range of a DO-LOOP is determined by the terminating word and DO-LOOP my be nested. See also I LEAVE LOOP and +LOOP .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="DOES>" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL DOES> ( --- ) FIG,F79,F83 .END LITERAL .B A word which defines the run time action within a high level defining word. DOES> alters the code field address and first parameter of the new word to execute the sequence of compiled word addresses following DOES>. Used in combination with part executes, it begins with the address of the first parameter of the new word on the stack. This allows interpretation using this area or its contents. Typical uses include the Forth assembler, multi-dimentional arrays, and compiler generation. See also From the text address addr1 and an ascii delimiting character c, is determined the byte offset to the first non-delimiter character n1, the offset to the first delimiter after the text n2, and the offset to the first character not included n3. .B This procedure will not process past an ascii "null", treating it as an unconditional delimiter. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="END" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL END ( --- ) FIG,F79,F83 .END LITERAL .B An alias for UNTIL. See UNTIL .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="ENDIF" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL ENDIF ( --- ) FIG .END LITERAL .B Used in the form: .LITERAL IF .. ENDIF IF .. ELSE .. ENDIF .END LITERAL .B Use only in a colon defintion. ENDIF is the point where execution resumes after ELSE or IF (when no ELSE is preset). THEN is an alias for ENDIF. See also IF and ELSE .B Note: in Forth-79 and Forth-83, ENDIF is not defined. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="ERASE" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL ERASE ( addr n --- ) FIG .END LITERAL .B Clear a region of memory to zeros from addr over n addresses. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="ERROR" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL ERROR ( n1 --- n2 n3 ) FIG .END LITERAL .B Execute error notification and restart of system. WARNING is first examined: .LM +3 .LIST .LE;if WARNING IS 1, the text of line n1, relative to screen 4 of "FORTH0:" is printed. This line number may be positive or negative, and beyond just screen 4. .LE;if WARNING is 0, n is just printed as a message number. .LE;if WARNING is -1, the definition (ABORT) is executed, which executes the system ABORT. .END LIST .LM -3 Leaves the value of user variable IN as n2 and the value of user variable BLK as n3 to assist in determining the location of the error. Final action is execution of QUIT. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="EXECUTE" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL EXECUTE ( cfa --- ) FIG,F79,F83 .END LITERAL .B Execute the definition whose code field address is on the stack. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="EXPECT" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL EXPECT ( addr n --- ) FIG,F79,F83,ISU .END LITERAL .B Transfer characters from the terminal to addr, until a "return" or n characters have been received. One or more "nulls" are added to the end of the text. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="FENCE" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL FENCE ( --- addr ) FIG .END LITERAL .B A user variable containing an address below which forgetting is trapped. To FORGET below this point the user must alter the contents of FENCE. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="FILL" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL FILL ( addr count b --- ) FIG .END LITERAL .B Fill memory at addr with the specified count of bytes b. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="FIRST" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL FIRST ( --- addr ) FIG .END LITERAL .B A constant that leaves the address of the first (lowest) block buffer. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="FLD" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL FLD ( --- addr ) FIG .END LITERAL .B A user variable for control of number output field width. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="FLUSH" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL FLUSH ( --- ) FIG,F79,F83 .END LITERAL .B Causes all block buffers marked for UPDATE to be written back to disk. See also UPDATE .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="FORGET" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL FORGET ( --- ) FIG,F79,F83 .END LITERAL .B Used in the form: .LITERAL FORGET .END LITERAL .B Deletes definition named from the dictionary with all entries physically following it. An error message will occur if the CURRENT and CONTEXT vocabularies are not currently the same. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="FORTH" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL FORTH ( --- ) FIG,F79,F83 .END LITERAL .B The name of the primary vocabulary. Execution makes FORTH the CONTEXT vocabulary. Until additional user vocabularies are defined, new user definitions become a part of the FORTH vocabulary. FORTH is immediate, so it will execute during the creation of a colon definition, to select this vocabulary at compile time. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="HELP" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL HELP ( --- ) ISU .END LITERAL .B Used in the form: .LITERAL HELP .END LITERAL .B Accepts the next text word , delimited by blanks, in the input stream and searches the Forth HELP library for a matching entry. If found, the help text is displayed, otherwise, an error message is given. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="HERE" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL HERE ( --- addr ) FIG,F79,F83 .END LITERAL .B Leave the address of the next available dictionary location on the stack. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="HEX" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL HEX ( --- ) FIG .END LITERAL .B Set the input-output numeric conversion base to sixteen (hexadecimal). .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="HLD" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL HLD ( --- addr ) FIG .END LITERAL .B A user variable that holds the address of the latest character of text during numeric output conversion. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="HOLD" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL HOLD ( c --- ) FIG,F79,F83 .END LITERAL .B Used between <# and #> to insert an ascii character into a pictured numeric output string. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="I" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL I ( --- n ) FIG,F79,F83 .END LITERAL .B Used within a DO-LOOP to copy the loop index to the stack. See also R .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="ID." .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL ID. ( nfa --- ) FIG,ISU .END LITERAL .B Print a definition's name from its name field address. As a special case, all one character definition names with values less than hex 20 will be printed as ^letter (i.e. the "null" character will be printed as ^@, hex 01 will be printed as ^A, hex 02 will be printed as ^B, etc.). .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="IF" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL IF ( f --- ) FIG,F79,F83 .END LITERAL .B Used in the form: .LITERAL IF .. ENDIF IF .. ELSE .. ENDIF .END LITERAL .B Used only in a colon definition. If flag f is true, the words following IF are executed and the words following ELSE are skipped. The ELSE part is optional. If flag f is false, the words between IF and ELSE, or between IF and ENDIF (when no ELSE is used), are skipped. See also ELSE and ENDIF .B Note: in place of extensive nesting, it may be more efficient to define and use one of the several CASE utilities which have been defined in FORTH DIMENSIONS. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="IMMEDIATE" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL IMMEDIATE ( -- ) FIG,F79,F83 .END LITERAL .B Mark the most recently made dictionary entry as a word which will be executed when encounterd during compilation rather than compiled. The user may force compilation of an IMMEDIATE definition by preceeding it with [COMPILE]. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="IN" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL IN ( --- addr ) FIG .END LITERAL .B A user variable containing the byte offset within the current input text buffer (terminal or disk) from which the next text will be accepted. WORD uses and moves the value of IN. .B Note: in Forth-79 and Forth-83, IN is called >IN .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="INDEX" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL INDEX ( n1 n2 --- ) FIG .END LITERAL .B Print the first line of each screen over the range from screen n1 to n2. This is used to view the comment lines of the first line on disk screens. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="INPUT" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL INPUT ( --- addr ) ISU .END LITERAL .B A user variable that contains the VAX/VMS $QIO mask for input. INPUT defaults to IO$M_TRMNOECHO. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="INTERPRET" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL INTERPRET ( --- ) FIG,F79,F83 .END LITERAL .B The outer text interpreter which sequentially executes or compiles text from the input stream (terminal or disk) depending on STATE. If the word name cannot be found after a seach of CONTEXT and then CURRENT, it is converted to a number according to BASE. If that also fails, an error message echoing the name with a "?" will be given. .B Text input will be taken according to the convention for WORD. If a decimal point is found as part of a number, a double number value will be left. The decimal point has no other purpose then to force this action. See also NUMBER .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="KEY" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL KEY ( --- c ) FIG,F79,F83,ISU .END LITERAL .B Leave the ascii value of the next terminal key struck. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="L/S" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL L/S ( --- n ) ISU .END LITERAL .B A constant leaving the number of lines per screen on the stack. In this implementation, there are 24 lines per screen. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="LATEST" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL LATEST ( --- nfa ) FIG .END LITERAL .B Leave the name field address of the topmost word in the CURRENT vocabulary. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="LEAVE" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL LEAVE ( --- ) FIG,F79,F83 .END LITERAL .B Force termination of a DO-LOOP at the next LOOP or +LOOP by setting the loop limit equal to the current value of the index. The index itself remains unchanged, and execution proceeds normally until the loop terminating word is encountered. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="LFA" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL LFA ( pfa --- lfa ) FIG .END LITERAL .B Convert the parameter field address of a dictionary definition to its link field address. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="LIMIT" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL LIMIT ( --- addr ) FIG .END LITERAL .B A constant leaving the address just above the highest memory available for a disk buffer. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="LIST" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL LIST ( n --- ) FIG,F79,ISU .END LITERAL .B Display the ascii text of screen n to the terminal, setting the user variable SCR to n. Trailing blank lines will not be displayed. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="LIT" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL LIT ( --- n ) FIG .END LITERAL .B Within a colon definition, LIT is automatically compiled before each 16 bit literal number encountered in the input test. Later execution of LIT causes the contents of the next dictionary address to be pushed to the stack. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="LITERAL" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL LITERAL ( n --- n ) ( executing) FIG,F79,F83 ( n --- ) ( compiling) .END LITERAL .B If compiling, then compile the stack value n as a 16 bit literal, which when later executed, will leave n on the stack. If executing, leave n on the stack. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="LOAD" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL LOAD ( n --- ) FIG,F79,F83 .END LITERAL .B Begin interpretation of screen n. Screen zero is unloadable. Loading will terminate at the end of the screen or at ;S. See also ;S and --> .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="LOAD-SYSTEM" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL LOAD-SYSTEM ( --- ) ISU .END LITERAL .B Used in the form: .LITERAL LOAD-SYSTEM .END LITERAL .B Accepts the next text word , delimited by blanks, in the input stream, and loads the binary file containing the executable code after TASK using as the file name. LOAD-SYSTEM uses the current "FORTHn:" logical name. HERE is updated to point to the next available dictionary location after the load. See DR0 DR1 TASK and HERE .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="LOOP" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL LOOP ( --- ) FIG,F79,F83 .END LITERAL .B Used in the form: .LITERAL DO .. LOOP .END LITERAL .B Used only in a colon definition. LOOP increments the DO-LOOP index by one, and terminates the loop if the new index is equal to or greater than the limit. See also DO .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="M*" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL M* ( n1 n2 --- d) FIG .END LITERAL .B A mixed magnitude math operation which leaves the double number signed product of n1 * n2. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="M+" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL M+ ( d1 n --- d2 ) FIG .END LITERAL .B A mixed magnitude math operation which will add the double number d1 to n and leave the double number result d2. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="M/" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL M/ ( d n1 --- n2 n3 ) FIG .END LITERAL .B A mixed magnitude math operation which leaves the remainder n2 and quotient n3, from a double number dividend d and divisor n1. The remainder takes its sign from the dividend. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="M/MOD" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL M/MOD ( ud1 u2 --- u3 ud4 ) FIG .END LITERAL .B A mixed magnitude math operation when leaves a double number quotient ud4 and remainder u3, from a double number dividend ud1 and divisor u2. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="MAX" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL MAX ( n1 n2 --- n3 ) FIG,F79,F83 .END LITERAL .B Leave the greater of two numbers. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="MAXERRS" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL MAXERRS ( --- addr ) ISU .END LITERAL .B A user variable the contains the maximum number of system software errors allowed. If MAXERRS is exceeded, the message: .B .LITERAL %FORTH-F-MAXERRS, exceeded maximum number of errors allowed .END LITERAL .B is displayed and control is returned to the operating system. MAXERRS defaults to 16. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="MESSAGE" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL MESSAGE ( n --- ) FIG,ISU .END LITERAL .B Print on the terminal, the text of line n relative to SCR # DEFSCR in DEFDIR. n may be positive or negative. If WARNING is zero, the message will simply be printed as a number. See also ERROR WARNING DEFSCR and DEFDIR .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="MIN" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL MIN ( n1 n2 --- n3 ) FIG,F79,F83 .END LITERAL .B Leave the less of two numbers. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="MINUS" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL MINUS ( n1 --- n2 ) FIG .END LITERAL .B Leave the two's complement of a number. .B Note: in Forth-79 and Forth-83, MINUS is called NEGATE .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="MOD" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL MOD ( n1 n2 --- n3 ) FIG,F79,F83 .END LITERAL .B Leave the remainder of n1 / n2, with the same sign as n1. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="MON" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL MON ( --- ) FIG .END LITERAL .B Empty buffers and exit Forth. See also BYE and EMPTY-BUFFERS .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="NEED" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL NEED ( --- ) ISU .END LITERAL .B Used in the form: .LITERAL NEED .END LITERAL .B Accepts the next text word , delimited by blanks, in the input stream; searches the CURRENT and CONTEXT vocabularies to see if has already been defined; and if not, searches the current NEED library for a matching entry. If found, the corresponding screen is loaded, otherwise, an error message is given. .B To load a word installed in "FORTH0:", issue: .B .LITERAL DR0 NEED DR1 .END LITERAL .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="NEGATE" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL NEGATE ( n1 --- n2 ) F79,F83 .END LITERAL .B In fig-Forth, NEGATE is called MINUS. See MINUS .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="NFA" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL NFA ( pfa --- nfa ) FIG .END LITERAL .B Convert the parameter field address of a definition to its name field address. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="NUMBER" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL NUMBER ( addr --- d ) FIG .END LITERAL .B Convert a count and character string at addr, to a signed double number, using the current BASE. If numeric conversion is not possible, an error message will be given. If a decimal point is encounted in the text, its position will be recorded in the user variable DPL, but no other effect occurs. The string may contain a preceding negative sign. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="OCTAL" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL OCTAL ( --- ) ISU .END LITERAL .B Set the input-output numeric conversion base to eight. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="OFFSET" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL OFFSET ( --- addr ) FIG,ISU .END LITERAL .B A user variable which contains the last value set by DR0, DR1, etc. See DR0 DR1 .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="OR" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL OR ( n1 n2 --- n3 ) FIG,F79,F83 .END LITERAL .B Leave the bitwise logical "or" of two 16 bit values as n3 on the stack. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="ORIGIN" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL ORIGIN ( --- addr ) FIG .END LITERAL .B A user variable that contains the address of the origin parameter area. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="OUT" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL OUT ( --- addr ) FIG .END LITERAL .B A user variable that contains a value incremented by EMIT. The user may alter and examine OUT to control display formatting. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="OUTPUT" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL OUTPUT ( --- addr ) ISU .END LITERAL .B A user variable that contains the VAX/VMS $QIO output mask. OUTPUT defaults to 0. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="OVER" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL OVER ( n1 n2 --- n1 n2 n1 ) FIG,F79,F83 .END LITERAL .B Leave a copy of the second number on the stack. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="PAD" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL PAD ( --- addr ) FIG,F79,F83,ISU .END LITERAL .B Leave the address of the text output buffer, which is a fixed offset above HERE. In this implementation, PAD is 256 bytes above HERE. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="PFA" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL PFA ( nfa --- pfa ) FIG .END LITERAL .B Convert the name field address of a compiled definition to its parameter field address. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="PREV" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL PREV ( --- addr ) FIG .END LITERAL .B A user variable containing the address of the disk buffer most recently referenced. The UPDATE command marks this buffer to be later written to disk. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="QUERY" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL QUERY ( --- ) FIG,F79,ISU .END LITERAL .B Accept input of up to 80 characters (or until a "return") from the terminal, into the terminal input buffer. Text is positioned at the address contained in TIB with IN set to zero. See also TIB and IN .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="QUIT" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL QUIT ( --- ) FIG,F79,F83 .END LITERAL .B Clear the return stack, setting execution mode, and return control to the terminal. No OK message is given. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="R@" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL R@ ( --- n ) F79,F83 .END LITERAL .B In fig-Forth, R@ is called R. See R .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="R" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL R ( --- n ) FIG .END LITERAL .B Copy the top of the return stack to the computation stack. .B Note: in Forth-79 and Forth-83, R is called R@ .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="R#" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL R# ( --- addr ) FIG .END LITERAL .B A user variable which may contain the location of an editing cursor, or other file related functions. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="R/W" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL R/W ( addr n f --- ) FIG,F79,F83 .END LITERAL .B The fig-Forth standard disk read-write linkage. addr specifies the source or distination block buffer, n is the sequential number of the referenced block, and f is a flag for f=0 write and f=1 read. R/W determines the location on the disk, performs the read-write and performs error checking. See also BLOCK-READ and BLOCK-WRITE .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="R0" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL R0 ( --- addr ) FIG .END LITERAL .B A user variable containing the initial location of the return stack. See also RP! .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="R>" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL R> ( --- n ) FIG,F79,F83 .END LITERAL .B Remove the top value from the return stack and leave it on the computation stack. Pronounced "r-from". See also >R and R .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="REPEAT" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL REPEAT ( --- ) FIG,F79,F83 .END LITERAL .B Used in the form: .LITERAL BEGIN .. REPEAT BEGIN .. WHILE .. REPEAT .END LITERAL .B Used in a colon definition. REPEAT returns to just after the corresponding BEGIN. See also BEGIN .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="ROT" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL ROT ( n1 n2 n3 --- n2 n3 n1 ) FIG,F79,F83 .END LITERAL .B Rotate the top three values on the stack, bringing the third to the top. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="RP!" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL RP! ( --- ) FIG .END LITERAL .B Initialize the return stack pointer from the user variable R0. See R0 .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="S->D" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL S->D ( n --- d ) FIG .END LITERAL .B Sign extend a single number to form a double number. Pronounced "s-to-d". .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="S0" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL S0 ( --- addr ) FIG .END LITERAL .B A user variable that contains the initial value for the stack pointer. See also SP! .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="SAVE-SYSTEM" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL SAVE-SYSTEM ( --- ) ISU .END LITERAL .B Used in the form: .LITERAL SAVE-SYSTEM .END LITERAL .B Accepts the next text word , delimited by blanks, in the input stream to HERE, and writes a binary file containing the executable code from TASK to HERE using as the file name. The file is written to the current "FORTHn:" logical name. See also DR0 DR1 TASK and HERE .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="SCR" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL SCR ( --- addr ) FIG .END LITERAL .B A user variable that contains the screen number most recently referenced by LIST. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="SIGN" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL SIGN ( n d --- d ) FIG,F79,F83 .END LITERAL .B Insert the ascii "-" (negative sign) into the pictured numeric output string, if n is negative. n is removed from the stack but double number d is retained. Must be used between <# and #> .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="SMUDGE" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL SMUDGE ( --- ) FIG .END LITERAL .B Used during word definition to toggle the "smudge bit" in a definition's name field. This prevents an uncompleted definition from being found during dictionary searches, until compiling is completed without error. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="SP!" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL SP! ( --- ) FIG .END LITERAL .B Initialize the stack pointer from the user variable S0. See S0 .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="SP@" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL SP@ ( --- addr ) FIG .END LITERAL .B Return the address of top of the stack, just before SP@ was executed. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="SPACE" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL SPACE ( --- ) FIG,F79,F83 .END LITERAL .B Transmit an ascii blank to the terminal. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="SPACES" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL SPACES ( n --- ) FIG,F79,F83 .END LITERAL .B Transmit n ascii blanks to the terminal. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="STATE" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL STATE ( --- addr ) FIG,F79,F83 .END LITERAL .B A user variable containing the compilation state. A non-zero value indicates compilation. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="SWAP" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL SWAP ( n1 n2 --- n2 n1 ) FIG,F79,F83 .END LITERAL .B Exchange the top two values on the stack. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="TASK" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL TASK ( --- ) FIG .END LITERAL .B A no-operation word which marks the boundary between applications. By forgetting TASK and re-compiling, an application can be discarded in its entirety. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="THEN" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL THEN ( --- ) FIG,F79,F83 .END LITERAL .B An alias for ENDIF. See ENDIF .B Note: in Forth-79 and Forth-83, ENDIF is not defined. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="TIB" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL TIB ( --- addr ) FIG,F79 .END LITERAL .B A user variable containing the address of the terminal input buffer. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="TOGGLE" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL TOGGLE ( addr b --- ) FIG .END LITERAL .B Complement the contents of addr by the bit pattern b. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="TRAVERSE" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL TRAVERSE ( addr1 n --- addr2 ) FIG .END LITERAL .B Move across the name field of a fig-Forth variable length dictionary header. addr1 is the address of either the length byte or the last letter. The direction is based on n: .LM +3 .LIST .LE;if n is 1, the motion is toward high memory, and .LE;if n is -1, the motion is toward low memory. .END LIST .LM -3 The addr2 resulting is the address of the other end of the name. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="TRIAD" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL TRIAD ( n1 n2 --- ) FIG .END LITERAL .B This word is not defined in this implementation. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="TYPE" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL TYPE ( addr n --- ) FIG,F79,F83,ISU .END LITERAL .B Transmit n characters from addr to the terminal. No action takes place for n less than or equal to zero. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="U*" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL U* ( u1 u2 --- ud ) FIG,F79 .END LITERAL .B Perform an unsigned multiplication of u1 by u2, leaving the unsigned double number product ud. .B Note: in Forth-83, U* is called UM* .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="UM*" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL UM* ( u1 u2 --- ud ) F83 .END LITERAL .B In fig-Forth and Forth-79, UM* is called U*. See U* .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="U." .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL U. ( u --- ) FIG,F79,F83 .END LITERAL .B Display u converted according to BASE as an unsigned number, in a free field format, with one trailing blank. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="U/" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL U/ ( ud u1 --- u2 u3 ) FIG .END LITERAL .B Leave the unsigned remainder u2 and unsigned quotient u3 form the unsigned double dividend and unsigned divisor u1. .B Note: in Forth-79, U/ is called U/MOD; in Forth-83 U/ is called UM/MOD .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="U/MOD" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL U/MOD ( ud u1 --- u2 u3 ) F79 .END LITERAL .B In fig-Forth, U/MOD is called U/. See U/ .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="UM/MOD" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL UM/MOD ( ud u1 --- u2 u3 ) F83 .END LITERAL .B In fig-Forth, UM/MOD is called U/. See U/ .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="UNTIL" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL UNTIL ( f --- ) FIG,F79,F83 .END LITERAL .B Used in the form: .LITERAL BEGIN .. UNTIL .END LITERAL .B Used only in a colon definition. Terminate the BEGIN-UNTIL loop if f is true, otherwise, return to just after the corresponding BEGIN. END is an alias for UNTIL. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="UPCASE" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL UPCASE ( addr n --- ) ISU .END LITERAL .B Converts the word at HERE to upper case. Used by -FIND .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="UPDATE" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL UPDATE ( --- ) FIG,F79,F83 .END LITERAL .B Marks the most recently reference block (pointed to by PREV) as modified. The block will subsequently be automatically transferred to disk should its memory buffer be needed for storage of a different block, or upon execution of FLUSH. See also FLUSH and BYE .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="USE" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL USE ( --- addr ) FIG .END LITERAL .B A user variable containing the address of the block buffer to use next, as the least recently written. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="USER" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL USER ( n --- ) FIG .END LITERAL .B Used in the form: .LITERAL n USER .END LITERAL .B When USER is executed, it creates a user variable . The parameter field address of contains n as a fixed offset within the user area where the value for is stored. Execution of leaves its absolute user area storage address. .B In this implementation, there are 30 predefined user variables. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="VARIABLE" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL VARIABLE ( n --- ) FIG,F79,F83 .END LITERAL .B Used in the form: .LITERAL n VARIABLE .END LITERAL .B When VARIABLE is executed, it creates a dictionary entry for and assigns two bytes for storage in the parameter field address, initializing it to n. When is later executed, it will place the storage address on the stack, so that a fetch or store may access this location. .B Note: in Forth-79 and Forth-83, the variable is not initialized. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="VLIST" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL VLIST ( --- ) FIG,ISU .END LITERAL .B List the word names of the CONTEXT vocabulary starting with the most recent definition. The "break" key will terminate the listing. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="VOC-LINK" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL VOC-LINK ( --- addr ) FIG .END LITERAL .B A user variable containing the address of a field in the definition of the most recently created vocabulary. All vocabulary names are linked by these fields to allow control for forgetting through multiple vocabularies. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="VOCABULARY" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL VOCABULARY ( --- ) FIG,F79,F83 .END LITERAL .B Used in the form: .LITERAL VOCABULARY .END LITERAL .B When VOCABULARY is executed, it creates a vocabulary definition . Subsequent use of will make it the CONTEXT vocabulary which is searched first by INTERPRET. The sequence " DEFINITIONS" will also make the CURRENT vocabulary into which new definitions are placed. .B In fig-Forth, will be so chained as to include all definitions of the vocabulary in which is itself defined. All vocabularies ulitmately chain to FORTH. By convention, vocabulary names are to be declared IMMEDIATE. See also FORTH and VOC-LINK .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="WARM" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL WARM ( --- ) FIG .END LITERAL .B Restart Forth with empty buffers. See EMPTY-BUFFERS. See also COLD .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="WARNING" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL WARNING ( --- addr ) FIG .END LITERAL .B A user variable containing a flag which enables the output of selected non-fatal error messages: .LM +3 .LIST .LE;if WARNING is 1, screen 4 of "FORTH0:" is the base location for messages. .LE;if WARNING is 0, messages will be given by number. .LE;if WARNING is -1, (ABORT) will be executed. .END LIST .LM -3 See also MESSAGE and ERROR .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="WHILE" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL WHILE ( f --- ) FIG,F79,F83 .END LITERAL .B Used in the form: .LITERAL BEGIN .. WHILE .. REPEAT .END LITERAL .B Used in a colon definition. If f is true, execution will continue through to REPEAT, which then returns back to just after BEGIN. If f is false, execution is skipped to just after the corresponding REPEAT. See also BEGIN. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="WIDTH" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL WIDTH ( --- addr ) FIG .END LITERAL .B A user variable containing the maximum number of letters saved in the compilation of a definition's name. It must be 1 through 31, with a default value of 31; this value may be changed at any time within these limits. The name character count and its natural characters are saved, up to the value in WIDTH. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="WORD" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL WORD ( c --- ) FIG,F79,F83 .END LITERAL .B Read the next text characters from the input stream being interpreted, until a delimiter character c is found, storing the packed character string beginning at the dictionary buffer HERE. WORD leaves the character count in the first byte, the characters, and ends with two or more blanks. Leading occurances of character c are ignored. .B If the user variable BLK is zero, text is taken from the terminal input buffer, otherwise, text is taken from the disk block number stored in BLK. .B Note: in Forth-79 and Forth-83, the address of the beginning of this packed string is left on the stack. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="XOR" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL XOR ( n1 n2 --- n3 ) FIG,F79,F83 .END LITERAL .B Leave the bitwise logical "exclusive-or" of two 16 bit numbers. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="[" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL [ ( --- ) FIG,F79,F83 .END LITERAL .B Used in the form: .LITERAL : .. [ .. ] .. ; .END LITERAL .B Suspend compilation. The words between [ and ] are executed, not compiled. This allows calculation or compilation execptions before resuming compilation with ]. See also LITERAL and ] .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="[COMPILE]" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL [COMPILE] ( --- ) FIG,F79,F83 .END LITERAL .B Used in the form: .LITERAL : .. [COMPILE] FORTH .. ; .END LITERAL .B [COMPILE] will force the compilation of an immediate definition, that would otherwise execute during compilation. The above example will select the FORTH vocabulary when executes, rather than at compile time. .IF HELP .LITERAL $LIBR/LOG/TEXT/REPL SYS$LOGIN:FIGFORTH.HELP SYS$INPUT/MODULE="]" .END LITERAL .ELSE HELP .B 3.TP 5 .ENDIF HELP .LITERAL ] ( --- ) FIG,F79,F83 .END LITERAL .B Resume compilation, to the completion of a colon definition. See [ .IF HELP .REQUIRE "RNO:EXTEND.RNO" .ENDIF HELP >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> FIGFTHV2.MEM VAX-11 fig-Forth Version 2.0 GLOSSARY by Rodrick A. Eldridge Central Iowa Forth Interest Group Iowa State University The public domain VAX-11 Fig-Forth Version 1.0 is provided through the courtesy of Forth Interest Group, P. O. Box 1105, San Carlos, CA 94070 This public domain publication is provided through the courtesy of Central Iowa FIG (CIFIG), Iowa State University, Ames, IA 50011 Futher distribution must include these notices - 1 - NOTICE This document and its related software is placed in the public domain. Permission is granted to reproduce and distribute this document and its related software with the following restriction: No distributor is allowed to restrict its further redistribution. Further distribution must include the following notices: * * * * * The public domain VAX-11 fig-Forth Version 1.0 is provided through the courtesy of Forth Interest Group, P. O. Box 1105, San Carlos, CA 94070 This public domain publication is provided through the courtesy of Central Iowa FIG (CIFIG), Iowa State University, Ames, IA 50011 * * * * * Please send corrections and modifications to: Central Iowa Forth Interest Group c/o Rodrick A. Eldridge Iowa State University 104 Computer Science Ames, Iowa 50011 - 2 - REFERENCES fig-Forth Installation Manual by Willaim F. Ragsdale Forth Interest Group Forth-79 Standard Forth Interest Group Forth-83 Standard Forth Interest Group fig-Forth for VAX-11, Assembly Source Listing by Bob Haller and Doug Mercer Forth Interest Group fig-Forth for PDP-11, Assembly Source Listing by John S. James Forth Interest Group Systems Guide to fig-Forth by C. H. Ting, Offete Enterprises, Inc. All About Forth, An annotated Glossary by Glen B. Haydon Mountain View Press, Inc. - 3 - GLOSSARY This glossary contains all of the word definitions in this implementation. The first line of each entry shows a symbolic description of the action of the procedure on the parameter stack. The symbols indicate the order in which input parameters have been placed on the stack. Three dashes "---" indicate the execution point and any parameters left on the stack are listed. In this notation, the top of the stack is to the right. The symbols shown include: addr memory address b 8 bit byte c 7 bit ascii character cfa code field address count 16 bit signed integer number d 32 bit signed double number f boolean flag. 0=false, non-zero=true ff boolean false flag=0 lfa link field address n 16 bit signed integer number nfa name field address pfa parameter field address u 16 bit unsigned integer number ud 32 bit unsigned double number tf boolean true flag=non-zero Unless otherwise noted, all references to numbers are for 16 bit signed integers. For 32 bit signed double numbers, the most significant portion with sign is on top of stack. Unless otherwise specified in the glossary, all arithemetic is implicitly 16 bit signed integer math, with error and under-flow indication unspecified. The first line also shows the "standard" in which the word is defined. These symbols include: FIG defined in fig-Forth F79 defined in Forth-79 F83 defined in Forth-83 ISU local definition or modification - 4 - ^@ ( --- ) FIG This is a pseudonym for the dictionary entry for a name of one character of ascii "null" (i.e. hex 00). It is the execution procedure to terminate interpretation of a line of text from the terminal or within a disk buffer, as both buffers always have a "null" at the end. ! ( n addr --- ) FIG,F79,F83 Store n at address. Pronounced "store". !CODE ( --- ) FIG Used by CONSTANT, USER and VARIABLE to compile a constant, user variable and variable, respectively. !CSP ( --- ) FIG Save the stack position in CSP. Used as part of the compiler security. # ( d1 --- d2 ) FIG,F79,F83 Generate from a double number d1, the next ascii character which is placed in an output string. The result, double number d2, is the quotient after division by BASE and is maintained for further processing. Used between <# and #> #> ( d --- addr count ) FIG,F79,F83 End numeric output conversion by dropping d, leaving the text address and character count suitable for TYPE. #S ( d1 --- d2 ) FIG,F79,F83 Convert all digits of a double number d1, adding each to the pictured numeric output text, until the remainder is zero. A single zero is added to the output string if the number was initially zero. Used between <# and #> ' ( --- pfa ) FIG,F79,F83 Used in the form: ' - 5 - If executing, leave the parameter field address of the next word accepted from the input stream. If compiling, compile this address as a literal. Later execution will place this value on the stack. If the word is not found after a search of CONTEXT and CURRENT, an appropriate error message is given. Pronounced "tick". Note: in Forth-83, ' leaves the code field address. ( ( --- ) FIG,F79,F83 Used in the form: ( comment) Accept and ignore comment characters from the input stream, until the next right parenthesis. As a word, the left parenthesis must be followed by one blank. It may be freely used while executing or compiling. Note: both ( and ) must be on the same line. (+LOOP) FIG The run time procedure compiled by +LOOP which increments the loop index by the value on the stack and tests for loop completion. See +LOOP (.") FIG The run time procedure compiled by ." which transmits the following in-line text to the terminal. See ." (;CODE) FIG The run time procedure compiled by ;CODE that rewrites the code field of the most recently defined word to point to the following machine code sequence. See ;CODE (ABORT) FIG Executes after an error when WARNING is -1. This word normally executes ABORT but may be altered to a user's alternative procedure. See ABORT - 6 - (BLOCK-READ) ISU Used by BLOCK-READ. See BLOCK-READ (BLOCK-WRITE) ISU Used by BLOCK-WRITE. See BLOCK-WRITE (CR) ISU Used by CR. See CR (DO) FIG The run time procedure compiled by DO which moves the loop control parameters to the return stack. See DO (EMIT) ISU Used by EMIT. See EMIT (EXPECT) ISU Used by EXPECT. See EXPECT (FIND) ( addr nfa --- ff ) FIG ( addr nfa --- pfa b tf ) Searches the dictionary starting at the name field address, matching to the text at addr. Returns the parameters field address, the length byte of the name field and boolean true flag for a good match. If no match is found, only a boolean false flag is left. See -FIND (HELP) ISU Used by HELP. See HELP - 7 - (ID) ISU Used by ID. and VLIST. (KEY) ISU Used by KEY. See KEY (LINE) ( n1 n2 --- addr count ) FIG Convert the line number n1 and the screen number n2 to the disk buffer address containing the data. A count of C/L indicates the full line text length. (LOAD-SYSTEM) ISU Used by LOAD-SYSTEM. See LOAD-SYSTEM (LOOP) FIG The run time procedure compiled by LOOP which increments the loop index and tests for loop completion. See LOOP (NEED) ISU Used by NEED. See NEED (NUMBER) ( d1 addr1 --- d2 addr2 ) FIG Convert the ascii text beginning at addr1+1 with regard to BASE. The new value is accumulated into double number d1, being left as d2. addr2 is the address of the first unconvertable digit. See NUMBER Note: in Forth-79 and Forth-83, (NUMBER) is called CONVERT. (QUERY) ( --- addr count ) ISU Used by QUERY at COLD start. Returns the "foreign command line" specified at run time. If the "foreign command": FORTH := VAXUSR:[CLASSLIB.005003.VAX.FORTH]FORTHV2. is executed as: FORTH - 8 - then, (QUERY) will return the address of the and a count of these characters. You may execute (QUERY) anytime yourself to return this address and count. See also QUERY. (R/W) ISU Used by R/W. See R/W (SAVE-SYSTEM) ISU Used by SAVE-SYSTEM. See SAVE-SYSTEM (SCR) ISU Used by ?SCR. See ?SCR (TYPE) ISU Used by TYPE. See TYPE * ( n1 n2 --- n3 ) FIG,F79,F83 Leave the signed product of n1 * n2. */ ( n1 n2 n3 --- n4 ) FIG,F79,F83 Multiply n1 by n2, divide the result by n3 and leave the quotient. The quotient is rounded toward zero. The product of n1 * n2 is maintained as and intermediate 32 bit value for greater precision than the otherwise equivalent sequence: n1 n2 * n3 /. */MOD ( n1 n2 n3 --- n4 n5 ) FIG,F79,F83 Multiply n1 by n2, divide the result by n3 and leave the remainder n4 and quotient n5. A 32 bit intermediate product is used as for */. The remainder has the same sign as n1. - 9 - + ( n1 n2 --- n3 ) FIG,F79,F83 Leave the sum of n1 + n2. +! ( n addr --- ) FIG,F79,F83 Add n to the 16 bit value at addr. +- ( n1 n2 --- n3 ) FIG Appy the sign of n2 to n1, which is left as n3. +BUF ( addr1 --- addr2 f ) FIG Advance the disk buffer address addr1 to the address of the next buffer addr2. Boolean flag f is false when addr2 is the buffer presently pointed to by variable PREV. +LOOP ( n --- ) FIG,F79,F83 Used in the form: DO .. +LOOP Used only in a colon definition. Add the increment n to the loop index and compare the total to the loop limit. Return execution to the corresponding DO until the new index is equal to or greater than the limit (n>0) or until the new index is less than the limit (n<0). Upon exiting the loop, the parameters are discarded and execution continues ahead. See also DO +ORIGIN ( n --- addr ) FIG Leave the memory address relative by n to the ORIGIN parameter area. n is in bytes. This definition is used to access or modify the boot-up parameters at the ORIGIN area. , ( n --- ) FIG,F79,F83 Allocate two bytes in the dictionary, storing n there. Pronounced "comma". - 10 - - ( n1 n2 --- n3 ) FIG,F79,F83 Leave the difference of n1 - n2. --> ( --- ) FIG,F79,F83 Continue interpretation with the next disk screen. Pronounced "next-screen". -DUP ( n --- n ) ( if zero) FIG ( n --- n n ) ( if non-zero) Reproduce n only if it is non-zero. This is usually used to copy a value just before IF to eliminate the need for an ELSE part to DROP it. Note: in Forth-79 and Forth-79, -DUP is called ?DUP -FIND ( --- ff ) FIG ( --- pfa b tf ) Accepts the next text word, delimited by blanks, in the input stream to HERE and searches the CONTEXT vocabulary and then the CURRENT vocabulary for a matching entry. If found, the dictionary entry's parameter field address, its length byte, and a boolean true flag is left, otherswise, only a boolean false flag is left. -TRAILING ( addr n1 --- addr n2 ) FIG,F79,F83,ISU Adjusts the character count n1 of a text string beginning at addr to exclude trailing blanks, i.e. the characters at addr+n2 to addr+n1 are blanks. . ( n --- ) FIG,F79,F83 Display n converted according to BASE in a free field format with one trailing blank. If n is negative, . will display the negative sign. Pronounced "dot". ." ( --- ) FIG,F79,F83 Used in the form: ." string" Compiles an in-line string, delimited by the trailing ." with an execution procedure to transmit the text to the terminal. If executed outside a definition, ." will immediately print the text until the final closing quote. - 11 - .LINE ( n1 n2 --- ) FIG Print to the terminal, a line of text from the disk by its line number n1 and screen number n2. Trailing blanks are suppressed. .R ( n1 n2 --- ) FIG Print n1 right aligned in a field whose width is n2 characters according to BASE. If n2 is less than 1, no leading blanks are supplied. / ( n1 n2 --- n3 ) FIG,F79,F83 Leave the signed quotient of n1 / n2. /MOD ( n1 n2 --- n3 n4 ) FIG,F79,F83 Leave the remainder and the signed quotient of n1 / n2. The remainder has the same sign as the dividend. 0 ( --- n ) FIG A constant leaving 0 on the stack. 1 ( --- n ) FIG A constant leaving 1 on the stack. 2 ( --- n ) FIG A constant leaving 2 on the stack. 3 ( --- n ) FIG A constant leaving 3 on the stack. 0< ( n --- f ) FIG,F79,F83 Leave a true flag if the number is less than zero (negative), otherwise, leave a false flag. - 12 - 0= ( n --- f ) FIG,F79,F83 Leave a true flag if the number is equal to zero, otherwise, leave a false flag. 0BRANCH ( f --- ) FIG The run time procedure to conditionally branch. If f is false (zero), the following in-line address is used to branch to. 1+ ( n1 --- n2 ) FIG,F79,F83 Increment n1 by 1, leaving the sum n2. 2+ ( n1 --- n2 ) FIG,F79,F83 Increment n1 by 2, leaving the sum n2. 2DROP ( d --- ) FIG This word is not defined in this implementation. Use DDROP 2DUP ( d --- d d ) FIG This word is not defined in this implementation. Use DDUP 2OVER ( d1 d2 --- d1 d2 d1 ) FIG This word is not defined in this implementation. Use DOVER 2SWAP ( d1 d2 --- d2 d1 ) FIG This word is not defined in this implementation. Use DSWAP : ( --- ) FIG,F79,F83 Used in the form: : .. ; Creates a dictionary entry defining as equivalent to the following - 13 - sequence of Forth word definitions ".." until the next ; or ;CODE. The compiling process is done by the text interpreter as long as STATE is non-zero. Other details are that the CONTEXT vocabulary is set to the CURRENT vocabulary and that words with the precedence bit set are executed rather than being compiled. Pronounced "colon". ; ( --- ) FIG,F79,F83 Terminate a colon definition and stop futher compilation. Compiles the run time procedure ;S. ;CODE ( --- ) FIG Used in the form: : .. ;CODE assembly_mnemonics Stop compilation and terminate a new defining word by compiling the run time procedure (;CODE). Set the CONTEXT vocabulary to ASSEMBLER and assemble to machine code the following mnemonics. When later executes in the form: the word will be created with its execution procedure given by the machine code following . That is, when is executed, it does so by jumping to the code after . An existing defining word must exist in prior to ;CODE. ;S ( --- ) FIG Stop interpretation of a screen. ;S is also the run time word compiled at the end of a colon definition which returns execution to the calling procedure. < ( n1 n2 --- f ) FIG,F79,F83 Leave a true flag if n1 < n2, otherwise, leave a false flag. <# ( --- ) FIG,F79,F83 Initialize for pictured numeric output formatting using the words: <# # #S SIGN #> The conversion is done on a double number producing text at PAD. - 14 - .. ; Each time is executed, later executes in the form: uses with a cell to the DOES> part for . When is later executed, it has the address of its parameter area on the stack and executes the words after DOES> in . allow run time procedures to be written in high-level rather than in assembler code as required by ;CODE. See also DOES> Note: in Forth-79 and Forth-83, ( n1 n2 --- f ) FIG,F79,F83 Leave a true flag if n1 > n2, otherwise, leave a flase flag. >IN ( --- addr ) F79,F83 In fig-Forth, >IN is called IN. See IN >R ( n --- ) FIG,F79,F83 Transfer n to the return stack. Every >R must be balanced by a R> in the same control structure nesting level of a colon definition. Pronounced "to-r". See also R> ? ( addr --- ) FIG,F79 Print the value contained at addr in free format according to BASE. - 15 - ?COMP ( --- ) FIG Issue an error message if not compiling. ?CSP ( --- ) FIG Issue an error message if the stack position differs from the value saved in CSP. ?DUP ( n --- n ) ( if zero) F79,F83 ( n --- n n ) ( if non-zero) In fig-Forth, ?DUP is called -DUP. See -DUP ?ERROR ( --- ) FIG Issue an error message number n, if the boolean flag is true. ?EXEC ( --- ) FIG Issue an error message if not executing. ?LOADING ( --- ) FIG Issue an error message if not loading. ?PAIRS ( --- ) FIG Issue an error message if n1 does not equal n2. The message indicates that compiled conditionals do not match. ?SCR ( n --- f ) ISU Leaves a boolean true flag on the stack if SCR # n exists, otherwise, leaves a boolean false flag. - 16 - ?STACK ( --- ) FIG,ISU Issue an error message if the stack is out of bounds. ?TERMINAL ( --- f ) FIG Perform a test of the terminal keyboard for actuation of the break key. A true flag indicates actuation. @ ( addr --- n ) FIG,F79,F83 Leave on the stack the number contained at addr. Pronounced "fetch". ABORT ( --- ) FIG,F79,F83 Clear the stacks and enter the execution state. Return control to the terminal and print a message. ABS ( n --- u ) FIG,F79,F83 Leave the absolute value of n as u. AGAIN ( --- ) FIG,F79,F83 Used in the form: BEGIN .. AGAIN Used only in a colon definition. Effect an uncontional jump back to the start of a BEGIN-AGAIN loop. AGAIN is an alias of REPEAT. See REPEAT ALLOT ( n --- ) FIG,F79,F83 Add n bytes to the parameter field of the most recently defined word. May be used to reserve memory space. AND ( n1 n2 --- n3 ) FIG,F79,F83 Leave the bitwise logical "and" of n1 and n2. - 17 - B/BUF ( --- n ) FIG,ISU A constant leaving the number of bytes per block buffer. In this implementation, although there are 2048 bytes per buffer, only 1920 bytes are used (i.e. 24 lines by 80 characters). B/SCR ( --- n ) FIG,ISU A constant leaving the number of blocks per editing screen. In this implementation, there is one block per editing screen. BACK ( addr --- ) FIG Compiles addr into the next available dictionary memory address. BASE ( --- addr ) FIG,F79,F83 Leave the address of a user variable containing the current input and output numeric conversion base. BEGIN ( --- ) FIG,F79,F83 Used in the form: BEGIN .. UNTIL BEGIN .. WHILE .. REPEAT Used only in a colon definition. BEGIN marks the start of a word sequence for repetitive execution. A BEGIN-UNTIL loop will be repeated until flag f is true. See UNTIL A BEGIN-WHILE-REPEAT loop will be repeated until flag f is false. WHILE is optional. AGAIN is an alias of REPEAT. See WHILE and REPEAT The words after UNTIL or REPEAT will be executed when either loop is finished. BINARY ( --- ) ISU Set the input-output numeric conversion base to two (binary). - 18 - BL ( --- c ) FIG A constant that leaves the ascii value for "blank". BLANKS ( addr n --- ) FIG Fill an area of memory beginning at addr with n blanks. BLK ( --- addr ) FIG,F79,F83 A user variable containing the block number begin interpreted. If zero, input is being taken from the terminal input buffer. BLOCK ( n --- addr ) FIG,F79,F83 Leave the memory address of the block buffer containing block n. If the block is not already in memory, it is transferred from disk to which ever buffer was least recently written. If the block occupying that buffer has been marked as updated, it is rewritten to disk before block n is read into the buffer. See also BUFFER BLOCK-READ ( addr1 addr2 count --- ff 0 ) FIG,F79,F83,ISU ( addr1 addr2 count --- tf n ) Reads a block from disk into addr1. addr2 (address of ascii screen number) and count were created by R/W. If no I/O error occured, a boolean false flag and zero are left on the stack, otherwise, a boolean true flag and an error number are left on the stack. See also R/W BLOCK-WRITE ( addr1 addr2 count --- ff 0 ) FIG,F79,F83,ISU ( addr1 addr2 count --- tf n ) Writes a block from addr1 to disk. addr2 and count was created the same way as for BLOCK-READ. If no I/O error occured, a boolean false flag and zero are left on the stack, otherwise, a boolean true flag and an error number are left on the stack. See BLOCK-READ BRANCH ( --- ) FIG The run time procedure to unconditionally branch. An in-line address is used to branch to. - 19 - BUFFER ( n --- addr ) FIG Obtain the next memory buffer, assigning it to block n. If the contents of the buffer is marked as updated, it is written to the disk. The block is not read from the disk. The address left is the first cell within the buffer for data storage. See also BLOCK BYE ( --- ) FIG FLUSH all buffers and exit Forth. See also MON C! ( b addr --- ) FIG,F79,F83 Store 8 bits of b at addr. C, ( b --- ) FIG,F79,F83 Store 8 bits of b into the next available dictionary byte, advancing the dictionary pointer. C/L ( --- n ) FIG A constant leaving the number of character per line on the stack. In this implementation, there are 80 characters per line. C@ ( addr --- b ) FIG,F79,F83 Leave on the stack the contents of the byte at addr. CFA ( pfa --- cfa ) FIG Convert the parameter field address of a definition to its code field address. CMOVE ( addr1 addr2 n --- ) FIG,F79,F83 Copy n bytes starting at addr1 to addr2. The move proceeds from low memory to high memory. - 20 - COLD ( --- ) FIG The cold start procedure to adjust the dictionary pointer to the minimum standard and restart via ABORT. COLD may be called to remove application programs and restart. See ABORT. See also WARM COMPILE ( --- ) FIG,F79,F83 When the word containing COMPILE executes, the execution address of the word following COMPILE is copied (compiled) into the dictionary. This allows specific compilation situations to be handled in addition to simply compiling an execution address. CONSTANT ( n --- ) FIG,F79,F83 Used in the form: n CONSTANT Creates word with it parameter field address containing n. When is later executed, it will push the value of n to the stack. CONTEXT ( --- addr ) FIG,F79 A user variable containing a pointer to the vocabulary within which dictionary searches will first begin. CONVERT ( d1 addr1 --- d2 addr2 ) F79,F83 In fig-Forth, CONVERT is called (NUMBER). See (NUMBER) COUNT ( addr1 --- addr2 count ) FIG,F79,F83 Leave the address, addr2, and the byte count of a text string beginning at addr1. It is presumed that the first byte at addr1 contains the text byte count and the actual text starts with the second byte. Typically COUNT is followed by TYPE. CR ( --- ) FIG,F79,F83,ISU Transmit a carriage return and line feed to the terminal. - 21 - CREATE ( --- ) F79,F83 In fig-Forth, this form of CREATE is called Used by such words as CODE and CONSTANT to create a dictionary header for a Forth definition. The code field address contains the address of the word's parameters field address. The new word is created in the CURRENT vocabulary. Note: in Forth-79 and Forth-83, DEFINITIONS Set the CURRENT vocabulary to the CONTEXT vocabulary. DEFDIR ( --- addr ) ISU A user variable that contains the default DIR setting for disk access in HELP and MESSAGE. DEFDIR defaults to 0, i.e. HELP and MESSAGE use "FORTH0:" by default. See also DIR DEFSCR ( --- addr ) ISU A user variable that contains the default SCR setting for disk access in MESSAGE. DEFSCR defaults to 4, i.e. MESSAGE uses SCR # 4 by default. See also MESSAGE DIR ( n --- ) ISU Sets the logical name "FORTHn:" and stores n into the user variable OFFSET. All disk access will be taken from this logical name. If n is not between 0 and 15, exclusively, an error message is given. DIGIT ( c n1 --- n2 tf ) FIG ( c n1 --- ff ) Converts the ascii character c (using base n1) to its binary equivalent n2, accompanied by a boolean true flag. If the conversion is invalid, leaves only a boolean false flag. - 24 - DLITERAL ( d --- d ) ( executing) FIG ( d --- ) ( compiling) If compiling, compile a stack double number into a literal. Later execution of the definition containing this literal will push it on the stack. If executing, the number will remain on the stack. DMINUS ( d1 --- d2 ) FIG Convert d to it double number two's complement. Note: in Forth-79 and Forth-83, DMINUS is called DNEGATE DNEGATE ( d1 --- d2 ) F79,F83 In fig-Forth, DNEGATE is called DMINUS. See DMINUS DO ( n1 n2 --- ) FIG,F79,F83 Used in the form: DO .. +LOOP DO .. LOOP Used only in a colon definition. Begin a loop which will terminate based on control parameters. The loop index begins at n2 and terminates based on the limit n1. At LOOP or +LOOP, the index is modified by a positive or negative value. The range of a DO-LOOP is determined by the terminating word and DO-LOOP my be nested. See also I LEAVE LOOP and +LOOP DOES> ( --- ) FIG,F79,F83 A word which defines the run time action within a high level defining word. DOES> alters the code field address and first parameter of the new word to execute the sequence of compiled word addresses following DOES>. Used in combination with part executes, it begins with the address of the first parameter of the new word on the stack. This allows interpretation using this area or its contents. Typical uses include the Forth assembler, multi-dimentional arrays, and compiler generation. See also Deletes definition named from the dictionary with all entries physically following it. An error message will occur if the CURRENT and CONTEXT vocabularies are not currently the same. FORTH ( --- ) FIG,F79,F83 The name of the primary vocabulary. Execution makes FORTH the CONTEXT vocabulary. Until additional user vocabularies are defined, new user definitions become a part of the FORTH vocabulary. FORTH is immediate, so it will execute during the creation of a colon definition, to select this vocabulary at compile time. HELP ( --- ) ISU Used in the form: HELP Accepts the next text word , delimited by blanks, in the input stream and searches the Forth HELP library for a matching entry. If found, the help text is displayed, otherwise, an error message is given. - 29 - HERE ( --- addr ) FIG,F79,F83 Leave the address of the next available dictionary location on the stack. HEX ( --- ) FIG Set the input-output numeric conversion base to sixteen (hexadecimal). HLD ( --- addr ) FIG A user variable that holds the address of the latest character of text during numeric output conversion. HOLD ( c --- ) FIG,F79,F83 Used between <# and #> to insert an ascii character into a pictured numeric output string. I ( --- n ) FIG,F79,F83 Used within a DO-LOOP to copy the loop index to the stack. See also R ID. ( nfa --- ) FIG,ISU Print a definition's name from its name field address. As a special case, all one character definition names with values less than hex 20 will be printed as ^letter (i.e. the "null" character will be printed as ^@, hex 01 will be printed as ^A, hex 02 will be printed as ^B, etc.). IF ( f --- ) FIG,F79,F83 Used in the form: IF .. ENDIF IF .. ELSE .. ENDIF Used only in a colon definition. If flag f is true, the words following IF are executed and the words following ELSE are skipped. The ELSE part is optional. If flag f is false, the words between IF and ELSE, or between IF and ENDIF (when no ELSE is used), are skipped. See also ELSE and ENDIF Note: in place of extensive nesting, it may be more efficient to define and use one of the several CASE utilities which have been defined in FORTH DIMENSIONS. - 30 - IMMEDIATE ( -- ) FIG,F79,F83 Mark the most recently made dictionary entry as a word which will be executed when encounterd during compilation rather than compiled. The user may force compilation of an IMMEDIATE definition by preceeding it with [COMPILE]. IN ( --- addr ) FIG A user variable containing the byte offset within the current input text buffer (terminal or disk) from which the next text will be accepted. WORD uses and moves the value of IN. Note: in Forth-79 and Forth-83, IN is called >IN INDEX ( n1 n2 --- ) FIG Print the first line of each screen over the range from screen n1 to n2. This is used to view the comment lines of the first line on disk screens. INPUT ( --- addr ) ISU A user variable that contains the VAX/VMS $QIO mask for input. INPUT defaults to IO$M_TRMNOECHO. INTERPRET ( --- ) FIG,F79,F83 The outer text interpreter which sequentially executes or compiles text from the input stream (terminal or disk) depending on STATE. If the word name cannot be found after a seach of CONTEXT and then CURRENT, it is converted to a number according to BASE. If that also fails, an error message echoing the name with a "?" will be given. Text input will be taken according to the convention for WORD. If a decimal point is found as part of a number, a double number value will be left. The decimal point has no other purpose then to force this action. See also NUMBER KEY ( --- c ) FIG,F79,F83,ISU Leave the ascii value of the next terminal key struck. - 31 - L/S ( --- n ) ISU A constant leaving the number of lines per screen on the stack. In this implementation, there are 24 lines per screen. LATEST ( --- nfa ) FIG Leave the name field address of the topmost word in the CURRENT vocabulary. LEAVE ( --- ) FIG,F79,F83 Force termination of a DO-LOOP at the next LOOP or +LOOP by setting the loop limit equal to the current value of the index. The index itself remains unchanged, and execution proceeds normally until the loop terminating word is encountered. LFA ( pfa --- lfa ) FIG Convert the parameter field address of a dictionary definition to its link field address. LIMIT ( --- addr ) FIG A constant leaving the address just above the highest memory available for a disk buffer. LIST ( n --- ) FIG,F79,ISU Display the ascii text of screen n to the terminal, setting the user variable SCR to n. Trailing blank lines will not be displayed. LIT ( --- n ) FIG Within a colon definition, LIT is automatically compiled before each 16 bit literal number encountered in the input test. Later execution of LIT causes the contents of the next dictionary address to be pushed to the stack. LITERAL ( n --- n ) ( executing) FIG,F79,F83 ( n --- ) ( compiling) If compiling, then compile the stack value n as a 16 bit literal, which when later executed, will leave n on the stack. If executing, leave n on the stack. - 32 - LOAD ( n --- ) FIG,F79,F83 Begin interpretation of screen n. Screen zero is unloadable. Loading will terminate at the end of the screen or at ;S. See also ;S and --> LOAD-SYSTEM ( --- ) ISU Used in the form: LOAD-SYSTEM Accepts the next text word , delimited by blanks, in the input stream, and loads the binary file containing the executable code after TASK using as the file name. LOAD-SYSTEM uses the current "FORTHn:" logical name. HERE is updated to point to the next available dictionary location after the load. See DR0 DR1 TASK and HERE LOOP ( --- ) FIG,F79,F83 Used in the form: DO .. LOOP Used only in a colon definition. LOOP increments the DO-LOOP index by one, and terminates the loop if the new index is equal to or greater than the limit. See also DO M* ( n1 n2 --- d) FIG A mixed magnitude math operation which leaves the double number signed product of n1 * n2. M+ ( d1 n --- d2 ) FIG A mixed magnitude math operation which will add the double number d1 to n and leave the double number result d2. M/ ( d n1 --- n2 n3 ) FIG A mixed magnitude math operation which leaves the remainder n2 and quotient n3, from a double number dividend d and divisor n1. The remainder takes its sign from the dividend. - 33 - M/MOD ( ud1 u2 --- u3 ud4 ) FIG A mixed magnitude math operation when leaves a double number quotient ud4 and remainder u3, from a double number dividend ud1 and divisor u2. MAX ( n1 n2 --- n3 ) FIG,F79,F83 Leave the greater of two numbers. MAXERRS ( --- addr ) ISU A user variable the contains the maximum number of system software errors allowed. If MAXERRS is exceeded, the message: %FORTH-F-MAXERRS, exceeded maximum number of errors allowed is displayed and control is returned to the operating system. MAXERRS defaults to 16. MESSAGE ( n --- ) FIG,ISU Print on the terminal, the text of line n relative to SCR # DEFSCR in DEFDIR. n may be positive or negative. If WARNING is zero, the message will simply be printed as a number. See also ERROR WARNING DEFSCR and DEFDIR MIN ( n1 n2 --- n3 ) FIG,F79,F83 Leave the less of two numbers. MINUS ( n1 --- n2 ) FIG Leave the two's complement of a number. Note: in Forth-79 and Forth-83, MINUS is called NEGATE MOD ( n1 n2 --- n3 ) FIG,F79,F83 Leave the remainder of n1 / n2, with the same sign as n1. - 34 - MON ( --- ) FIG Empty buffers and exit Forth. See also BYE and EMPTY-BUFFERS NEED ( --- ) ISU Used in the form: NEED Accepts the next text word , delimited by blanks, in the input stream; searches the CURRENT and CONTEXT vocabularies to see if has already been defined; and if not, searches the current NEED library for a matching entry. If found, the corresponding screen is loaded, otherwise, an error message is given. To load a word installed in "FORTH0:", issue: DR0 NEED DR1 NEGATE ( n1 --- n2 ) F79,F83 In fig-Forth, NEGATE is called MINUS. See MINUS NFA ( pfa --- nfa ) FIG Convert the parameter field address of a definition to its name field address. NUMBER ( addr --- d ) FIG Convert a count and character string at addr, to a signed double number, using the current BASE. If numeric conversion is not possible, an error message will be given. If a decimal point is encounted in the text, its position will be recorded in the user variable DPL, but no other effect occurs. The string may contain a preceding negative sign. OCTAL ( --- ) ISU Set the input-output numeric conversion base to eight. OFFSET ( --- addr ) FIG,ISU A user variable which contains the last value set by DR0, DR1, etc. See DR0 DR1 - 35 - OR ( n1 n2 --- n3 ) FIG,F79,F83 Leave the bitwise logical "or" of two 16 bit values as n3 on the stack. ORIGIN ( --- addr ) FIG A user variable that contains the address of the origin parameter area. OUT ( --- addr ) FIG A user variable that contains a value incremented by EMIT. The user may alter and examine OUT to control display formatting. OUTPUT ( --- addr ) ISU A user variable that contains the VAX/VMS $QIO output mask. OUTPUT defaults to 0. OVER ( n1 n2 --- n1 n2 n1 ) FIG,F79,F83 Leave a copy of the second number on the stack. PAD ( --- addr ) FIG,F79,F83,ISU Leave the address of the text output buffer, which is a fixed offset above HERE. In this implementation, PAD is 256 bytes above HERE. PFA ( nfa --- pfa ) FIG Convert the name field address of a compiled definition to its parameter field address. PREV ( --- addr ) FIG A user variable containing the address of the disk buffer most recently referenced. The UPDATE command marks this buffer to be later written to disk. - 36 - QUERY ( --- ) FIG,F79,ISU Accept input of up to 80 characters (or until a "return") from the terminal, into the terminal input buffer. Text is positioned at the address contained in TIB with IN set to zero. See also TIB and IN QUIT ( --- ) FIG,F79,F83 Clear the return stack, setting execution mode, and return control to the terminal. No OK message is given. R@ ( --- n ) F79,F83 In fig-Forth, R@ is called R. See R R ( --- n ) FIG Copy the top of the return stack to the computation stack. Note: in Forth-79 and Forth-83, R is called R@ R# ( --- addr ) FIG A user variable which may contain the location of an editing cursor, or other file related functions. R/W ( addr n f --- ) FIG,F79,F83 The fig-Forth standard disk read-write linkage. addr specifies the source or distination block buffer, n is the sequential number of the referenced block, and f is a flag for f=0 write and f=1 read. R/W determines the location on the disk, performs the read-write and performs error checking. See also BLOCK-READ and BLOCK-WRITE R0 ( --- addr ) FIG A user variable containing the initial location of the return stack. See also RP! - 37 - R> ( --- n ) FIG,F79,F83 Remove the top value from the return stack and leave it on the computation stack. Pronounced "r-from". See also >R and R REPEAT ( --- ) FIG,F79,F83 Used in the form: BEGIN .. REPEAT BEGIN .. WHILE .. REPEAT Used in a colon definition. REPEAT returns to just after the corresponding BEGIN. See also BEGIN ROT ( n1 n2 n3 --- n2 n3 n1 ) FIG,F79,F83 Rotate the top three values on the stack, bringing the third to the top. RP! ( --- ) FIG Initialize the return stack pointer from the user variable R0. See R0 S->D ( n --- d ) FIG Sign extend a single number to form a double number. Pronounced "s-to-d". S0 ( --- addr ) FIG A user variable that contains the initial value for the stack pointer. See also SP! SAVE-SYSTEM ( --- ) ISU Used in the form: SAVE-SYSTEM Accepts the next text word , delimited by blanks, in the input stream to HERE, and writes a binary file containing the executable code from TASK to HERE using as the file name. The file is written to the current "FORTHn:" logical name. See also DR0 DR1 TASK and HERE - 38 - SCR ( --- addr ) FIG A user variable that contains the screen number most recently referenced by LIST. SIGN ( n d --- d ) FIG,F79,F83 Insert the ascii "-" (negative sign) into the pictured numeric output string, if n is negative. n is removed from the stack but double number d is retained. Must be used between <# and #> SMUDGE ( --- ) FIG Used during word definition to toggle the "smudge bit" in a definition's name field. This prevents an uncompleted definition from being found during dictionary searches, until compiling is completed without error. SP! ( --- ) FIG Initialize the stack pointer from the user variable S0. See S0 SP@ ( --- addr ) FIG Return the address of top of the stack, just before SP@ was executed. SPACE ( --- ) FIG,F79,F83 Transmit an ascii blank to the terminal. SPACES ( n --- ) FIG,F79,F83 Transmit n ascii blanks to the terminal. STATE ( --- addr ) FIG,F79,F83 A user variable containing the compilation state. A non-zero value indicates compilation. - 39 - SWAP ( n1 n2 --- n2 n1 ) FIG,F79,F83 Exchange the top two values on the stack. TASK ( --- ) FIG A no-operation word which marks the boundary between applications. By forgetting TASK and re-compiling, an application can be discarded in its entirety. THEN ( --- ) FIG,F79,F83 An alias for ENDIF. See ENDIF Note: in Forth-79 and Forth-83, ENDIF is not defined. TIB ( --- addr ) FIG,F79 A user variable containing the address of the terminal input buffer. TOGGLE ( addr b --- ) FIG Complement the contents of addr by the bit pattern b. TRAVERSE ( addr1 n --- addr2 ) FIG Move across the name field of a fig-Forth variable length dictionary header. addr1 is the address of either the length byte or the last letter. The direction is based on n: 1. if n is 1, the motion is toward high memory, and 2. if n is -1, the motion is toward low memory. The addr2 resulting is the address of the other end of the name. TRIAD ( n1 n2 --- ) FIG This word is not defined in this implementation. - 40 - TYPE ( addr n --- ) FIG,F79,F83,ISU Transmit n characters from addr to the terminal. No action takes place for n less than or equal to zero. U* ( u1 u2 --- ud ) FIG,F79 Perform an unsigned multiplication of u1 by u2, leaving the unsigned double number product ud. Note: in Forth-83, U* is called UM* UM* ( u1 u2 --- ud ) F83 In fig-Forth and Forth-79, UM* is called U*. See U* U. ( u --- ) FIG,F79,F83 Display u converted according to BASE as an unsigned number, in a free field format, with one trailing blank. U/ ( ud u1 --- u2 u3 ) FIG Leave the unsigned remainder u2 and unsigned quotient u3 form the unsigned double dividend and unsigned divisor u1. Note: in Forth-79, U/ is called U/MOD; in Forth-83 U/ is called UM/MOD U/MOD ( ud u1 --- u2 u3 ) F79 In fig-Forth, U/MOD is called U/. See U/ UM/MOD ( ud u1 --- u2 u3 ) F83 In fig-Forth, UM/MOD is called U/. See U/ UNTIL ( f --- ) FIG,F79,F83 Used in the form: BEGIN .. UNTIL Used only in a colon definition. Terminate the BEGIN-UNTIL loop if f is true, - 41 - otherwise, return to just after the corresponding BEGIN. END is an alias for UNTIL. UPCASE ( addr n --- ) ISU Converts the word at HERE to upper case. Used by -FIND UPDATE ( --- ) FIG,F79,F83 Marks the most recently reference block (pointed to by PREV) as modified. The block will subsequently be automatically transferred to disk should its memory buffer be needed for storage of a different block, or upon execution of FLUSH. See also FLUSH and BYE USE ( --- addr ) FIG A user variable containing the address of the block buffer to use next, as the least recently written. USER ( n --- ) FIG Used in the form: n USER When USER is executed, it creates a user variable . The parameter field address of contains n as a fixed offset within the user area where the value for is stored. Execution of leaves its absolute user area storage address. In this implementation, there are 30 predefined user variables. VARIABLE ( n --- ) FIG,F79,F83 Used in the form: n VARIABLE When VARIABLE is executed, it creates a dictionary entry for and assigns two bytes for storage in the parameter field address, initializing it to n. When is later executed, it will place the storage address on the stack, so that a fetch or store may access this location. Note: in Forth-79 and Forth-83, the variable is not initialized. - 42 - VLIST ( --- ) FIG,ISU List the word names of the CONTEXT vocabulary starting with the most recent definition. The "break" key will terminate the listing. VOC-LINK ( --- addr ) FIG A user variable containing the address of a field in the definition of the most recently created vocabulary. All vocabulary names are linked by these fields to allow control for forgetting through multiple vocabularies. VOCABULARY ( --- ) FIG,F79,F83 Used in the form: VOCABULARY When VOCABULARY is executed, it creates a vocabulary definition . Subsequent use of will make it the CONTEXT vocabulary which is searched first by INTERPRET. The sequence " DEFINITIONS" will also make the CURRENT vocabulary into which new definitions are placed. In fig-Forth, will be so chained as to include all definitions of the vocabulary in which is itself defined. All vocabularies ulitmately chain to FORTH. By convention, vocabulary names are to be declared IMMEDIATE. See also FORTH and VOC-LINK WARM ( --- ) FIG Restart Forth with empty buffers. See EMPTY-BUFFERS. See also COLD WARNING ( --- addr ) FIG A user variable containing a flag which enables the output of selected non-fatal error messages: 1. if WARNING is 1, screen 4 of "FORTH0:" is the base location for messages. 2. if WARNING is 0, messages will be given by number. 3. if WARNING is -1, (ABORT) will be executed. See also MESSAGE and ERROR - 43 - WHILE ( f --- ) FIG,F79,F83 Used in the form: BEGIN .. WHILE .. REPEAT Used in a colon definition. If f is true, execution will continue through to REPEAT, which then returns back to just after BEGIN. If f is false, execution is skipped to just after the corresponding REPEAT. See also BEGIN. WIDTH ( --- addr ) FIG A user variable containing the maximum number of letters saved in the compilation of a definition's name. It must be 1 through 31, with a default value of 31; this value may be changed at any time within these limits. The name character count and its natural characters are saved, up to the value in WIDTH. WORD ( c --- ) FIG,F79,F83 Read the next text characters from the input stream being interpreted, until a delimiter character c is found, storing the packed character string beginning at the dictionary buffer HERE. WORD leaves the character count in the first byte, the characters, and ends with two or more blanks. Leading occurances of character c are ignored. If the user variable BLK is zero, text is taken from the terminal input buffer, otherwise, text is taken from the disk block number stored in BLK. Note: in Forth-79 and Forth-83, the address of the beginning of this packed string is left on the stack. XOR ( n1 n2 --- n3 ) FIG,F79,F83 Leave the bitwise logical "exclusive-or" of two 16 bit numbers. [ ( --- ) FIG,F79,F83 Used in the form: : .. [ .. ] .. ; Suspend compilation. The words between [ and ] are executed, not compiled. This allows calculation or compilation execptions before resuming compilation with ]. See also LITERAL and ] - 44 - [COMPILE] ( --- ) FIG,F79,F83 Used in the form: : .. [COMPILE] FORTH .. ; [COMPILE] will force the compilation of an immediate definition, that would otherwise execute during compilation. The above example will select the FORTH vocabulary when executes, rather than at compile time. ] ( --- ) FIG,F79,F83 Resume compilation, to the completion of a colon definition. See [ - 45 - >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> FIGFTHV1.MAR .title FIGFORTH VAX-11 fig-Forth Version 1.0 ; ; This public domain software is provided through the courtesy of ; Forth Interest Group, PO Box 1105, San Carlos, CA 94070 ; Futher distribution must include this notice. ; .psect virtual_machine, wrt,exe,long .entry forth, ^m start: $trnlog_s - lognam=ttname,rsllen=nlen,rslbuf=devdesc cmpb name,#^x1B bneq 10$ subl #4,nlen addl #4,naddr 10$: $assign_s - devnam=devdesc,chan=ttchan clrw ctlc $qio_s chan=ttchan,func=#IO$_SETMODE!IO$M_CTRLCAST,p1=ctrlcast,p3=#3 jmp cold firstb = ^xA000 limitb = ^xB010 .word 0 temp1: .blkb 1 ctlc: .blkw 1 seed: .blkl 1 ttname: .ascid /SYS$INPUT/ ttchan: .blkw 1 ttiosb: .blkw 1 ttiolen: .blkw 1 .blkl 1 devdesc: nlen: .long 63 naddr: .long name name: .blkb 63 .align long,0 $fibdef $iodef $rmsdef namblk: $nam fab_rblock: $fab alq=1,fac=get,fna=filnam,fns=filsiz, - fop=ctg,mrs=1024,nam=namblk,org=seq,rfm=fix fab_wblock: $fab alq=1,fac=put,fna=filnam,fns=filsiz, - fop=ctg,mrs=1024,nam=namblk,org=seq,rfm=fix rab_rblock: $rab fab=fab_rblock,rac=seq,usz=1024,rbf=firstb rab_wblock: $rab fab=fab_wblock,rac=seq,rsz=1024,rbf=firstb filnam: .ascii /SYS$DISK:/ begadr: .blkl 3 fthadr: .ascii /.FTH/ filsiz = .-filnam ; cold start routine cold: clrl r3 clrl r4 clrl r5 clrl r6 clrl r7 clrl r8 clrl r9 clrl r10 clrl r11 movw #srtparm,r10 movw #frth+14,r11 movw (r10),(r11) movb #^x0B,r4 jmp putf warm: clrl r4 movb #^x08,r4 putf: movw #srtparm+^x4,r10 movw (r10),r3 movw #srtparm,r10 movw r3,r11 wrmlp: movw (r10)+,(r11)+ sobgtr r4,wrmlp movw #abort+2,r6 jmp rp1+2 ; start of fig-Forth program .ascii /VAX 11-780/ .blkw 2 srtparm: .word task-7 .word ^x7F .word fend+^x5000 .word fend+^x4800 .word fend+^x4FFF .word fend+^x4BFF .word 31 .word 1 .word fend .word fend .word frth+16 .byte ^x83 ; lit .ascii /LI/ .byte ^xD4 .word 0 lit: .word lit+2 addw #2,r9 movw (r6)+,(r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x87 ; execute .ascii /EXECUT/ .byte ^xC5 .word lit-6 exe: .word exe+2 movw (r9),r7 subw #2,r9 movzwl (r7)+,r11 jmp (r11) .byte ^x86 ; branch .ascii /BRANC/ .byte ^xC8 .word exe-10 brch: .word brch+2 movw (r6)+,r6 movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x87 ; 0branch .ascii /0BRANC/ .byte ^xC8 .word brch-9 zbrch: .word zbrch+2 tstw (r9) beqlu zbr1 subw #2,r9 addw #2,r6 movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) zbr1: subw #2,r9 movw (r6)+,r6 movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x86 ; (loop) .ascii /(LOOP/ .byte ^xA9 .word zbrch-10 lupe: .word lupe+2 addw #1,(r8) movw (r8)+,r11 subw3 r11,(r8)+,r11 bgtr lupe2 addw #2,r6 movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) lupe2: subw #4,r8 movw (r6)+,r6 movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x87 ; (+loop) .ascii /(+LOOP/ .byte ^xA9 .word lupe-9 plupe: .word plupe+2 tstw (r9) blss nplupe addw3 (r8),(r9),(r8) subw #2,r9 movw (r8)+,r11 subw3 r11,(r8)+,r11 bgtr plupe2 addw #2,r6 movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) plupe2: subw #4,r8 movw (r6)+,r6 movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) nplupe: addw3 (r8),(r9),(r8) subw #2,r9 movw (r8)+,r11 subw (r8)+,r11 bgtr plupe2 addw #2,r6 movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x84 ; (do) .ascii /(DO/ .byte ^xA9 .word plupe-10 pdo: .word pdo+2 subw #2,r9 movw (r9)+,-(r8) movw (r9),-(r8) subw #4,r9 movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x85 ; digit .ascii /DIGI/ .byte ^xD4 .word pdo-7 dgt: .word dgt+2 subw #2,r9 subb3 #^x30,(r9),r5 blssu bad cmpb r5,#^x0A blssu dok cmpb r5,#^x11 blssu bad cmpb r5,#^x2B bgequ bad subb #^x07,r5 dok: addw #2,r9 cmpb r5,(r9) bgequ bad subw #2,r9 movw r5,(r9)+ movw #1,(r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) bad: movw #0,(r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x86 ; (find) .ascii /(FIND/ .byte ^xA9 .word dgt-8 find: .word find+2 clrl r4 movzwl (r9),r10 movzwl -(r9),r11 find1: movzbl (r10),r5 xorb3 (r10)+,(r11)+,r4 bitb #^x3F,r4 bnequ pfind9 find2: tstb (r10) bgtr pfind8 xorb3 (r10)+,(r11)+,r4 bitb #^x7F,r4 beqlu found pfind3: tstw (r10) bnequ bok clrw (r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) pfind8: xorb3 (r10)+,(r11)+,r4 beqlu find2 pfind9: bitb #^x80,(r10)+ beqlu pfind9 jmp pfind3 found: addw #4,r10 movw r10,(r9)+ movw r5,(r9)+ movw #1,(r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) bok: movw (r10),r10 movw (r9),r11 jmp find1 .byte ^x87 ; enclose .ascii /ENCLOS/ .byte ^xC5 .word find-9 encl: .word encl+2 clrl r4 clrl r11 subw #2,r9 movzwl (r9)+,r10 movzbl (r9),r5 lop1: tstb (r10) beqlu null subb3 (r10),r5,r4 bnequ frst incw r10 incw r11 jmp lop1 frst: movw r11,(r9)+ lop2: tstb (r10) beqlu null1 subb3 (r10),r5,r4 beqlu delim incw r10 incw r11 jmp lop2 delim: movw r11,(r9)+ addw3 #1,r11,(r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) null: movw r11,(r9)+ addw3 #1,r11,(r9)+ jmp null2 null1: movw r11,(r9)+ null2: movw r11,(r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x85 ; cmove .ascii /CMOV/ .byte ^xC5 .word encl-10 cmove: .word cmove+2 movzwl (r9),r5 movzwl -(r9),r10 movzwl -(r9),r11 subw #2,r9 luup: movb (r11)+,(r10)+ sobgtr r5,luup movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x82 ; u* .ascii /U/ .byte ^xAA .word cmove-8 ustar: .word ustar+2 movzwl (r9),r10 movzwl -(r9),r11 mull3 r11,r10,r11 movl r11,(r9) addw #2,r9 movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x82 ; u/ .ascii /U/ .byte ^xAF .word ustar-5 uslsh: .word uslsh+2 clrl r11 movzwl (r9),r4 subw #4,r9 movl (r9),r10 ediv r4,r10,r4,r10 movw r10,(r9)+ movw r4,(r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x83 ; and .ascii /AN/ .byte ^xC4 .word uslsh-5 fand: .word fand+2 mcomw (r9),r10 bicw r10,-(r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x82 ; or .ascii /O/ .byte ^xD2 .word fand-6 ffor: .word ffor+2 bisw (r9),-(r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x83 ; xor .ascii /XO/ .byte ^xD2 .word ffor-5 fxor: .word fxor+2 xorw (r9),-(r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x83 ; sp@ .ascii /SP/ .byte ^xC0 .word fxor-6 fspat: .word fspat+2 movw r9,r10 addw #2,r9 movw r10,(r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x83 ; sp! .ascii /SP/ .byte ^xA1 .word fspat-6 sp1: .word sp1+2 addw3 #^x6,r3,r4 subw3 #2,(r4),r9 movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x83 ; rp! .ascii /RP/ .byte ^xA1 .word sp1-6 rp1: .word rp1+2 addw3 #^x08,r3,r4 movw (r4),r8 movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x82 ; ;s .ascii /;/ .byte ^xD3 .word rp1-6 semis: .word semis+2 movw (r8)+,r6 movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x85 ; leave .ascii /LEAV/ .byte ^xC5 .word semis-5 lve: .word lve+2 movw (r8)+,r10 movw r10,(r8) subw #2,r8 movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x82 ; >r .ascii />/ .byte ^xD2 .word lve-8 gr: .word gr+2 movw (r9),-(r8) subw #2,r9 movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x82 ; r> .ascii /R/ .byte ^xBE .word gr-5 rg: .word rg+2 addw #2,r9 movw (r8)+,(r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x81 ; r .byte ^xD2 .word rg-5 r: .word r+2 addw #2,r9 movw (r8),(r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x82 ; 0= .ascii /0/ .byte ^xBD .word r-4 zeqal: .word zeqal+2 tstw (r9) bneq none movw #^x01,(r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) none: movw #0,(r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x83 ; d0= .ascii /D0/ .byte ^xBD .word zeqal-5 dzeql: .word dzeql+2 subw #2,r9 tstl (r9) bneq dnone movw #^x01,(r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) dnone: movw #0,(r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x82 ; 0< .ascii /0/ .byte ^xBC .word dzeql-6 zless: .word zless+2 tstw (r9) blss zlone movw #0,(r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) zlone: movw #^x01,(r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x81 ; + .byte ^xAB .word zless-5 plus: .word plus+2 addw (r9),-(r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x85 ; minus .ascii /MINU/ .byte ^xD3 .word plus-4 minus: .word minus+2 mnegw (r9),(r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x82 ; d+ .ascii /D/ .byte ^xAB .word minus-8 dplus: .word dplus+2 subw #2,r9 addl (r9),-(r9) addw #2,r9 movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x86 ; dminus .ascii /DMINU/ .byte ^xD3 .word dplus-5 dmin: .word dmin+2 subw #2,r9 mnegl (r9),(r9) addw #2,r9 movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x84 ; drop .ascii /DRO/ .byte ^xD0 .word dmin-9 drop: .word drop+2 subw #2,r9 movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x84 ; over .ascii /OVE/ .byte ^xD2 .word drop-7 over: .word over+2 subw #2,r9 movw (r9)+,r10 addw #2,r9 movw r10,(r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x84 ; swap .ascii /SWA/ .byte ^xD0 .word over-7 swap: .word swap+2 movw (r9),r10 movw -(r9),r11 movw r10,(r9)+ movw r11,(r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x83 ; dup .ascii /DU/ .byte ^xD0 .word swap-7 dup: .word dup+2 movw (r9)+,(r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x82 ; +! .ascii /+/ .byte ^xA1 .word dup-6 pluss: .word pluss+2 movzwl (r9),r10 addw -(r9),(r10) subw #2,r9 movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x86 ; toggle .ascii /TOGGL/ .byte ^xC5 .word pluss-5 tgle: .word tgle+2 movb (r9),r4 movzwl -(r9),r10 subw #2,r9 xorb r4,(r10) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x81 ; @ .byte ^xC0 .word tgle-9 at: .word at+2 movzwl (r9),r11 movw (r11),(r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x82 ; c@ .ascii /C/ .byte ^xC0 .word at-4 cat: .word cat+2 movzwl (r9),r10 movzbw (r10),(r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x81 ; ! .byte ^xA1 .word cat-5 ex: .word ex+2 movzwl (r9),r10 movw -(r9),(r10) subw #2,r9 movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x82 ; c! .ascii /C/ .byte ^xA1 .word ex-4 cex: .word cex+2 movzwl (r9),r10 subw #2,r9 movb (r9),(r10) subw #2,r9 movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x84 ; emit .ascii /EMI/ .byte ^xD4 .word cex-5 emit: .word emit+2 movb (r9),temp1 subw #2,r9 $qio_s efn=#1,chan=ttchan,func=#IO$_WRITEVBLK!IO$M_NOFORMAT, - iosb=ttiosb,p1=temp1,p2=#1 $waitfr_s efn=#1 clrl r5 addw3 #^x1A,r3,r5 addw #1,(r5) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x83 ; key .ascii /KE/ .byte ^xD9 .word emit-7 key: .word key+2 $qio_s efn=#1,chan=ttchan,func=#IO$_TTYREADALL!IO$M_NOECHO, - iosb=ttiosb,p1=temp1,p2=#1 $waitfr_s efn=#1 addw #2,r9 movzbw temp1,(r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x89 ; ?terminal .ascii /?TERMINA/ .byte ^xCC .word key-6 qterm: .word qterm+2 addw #2,r9 movw ctlc,(r9) clrw ctlc movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) ctrlcast: ; service routine for .word 0 ; ctrl-c interrupt movw #1,ctlc $qio_s chan=ttchan,func=#IO$_SETMODE!IO$M_CTRLCAST, - p1=ctrlcast,p3=#3 ret .byte ^x82 ; cr .ascii /C/ .byte ^xD2 .word qterm-12 cr: .word nest .word pdq .byte ^x02 .byte ^x0D .byte ^x0A .word semis nest: movw r6,-(r8) ; run time nest movw r7,r6 movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) var: addw #2,r9 ; run time variable movw r7,(r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) const: addw #2,r9 ; run time constant movw (r7)+,(r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) user: addw #2,r9 ; run time user addw3 r3,(r7)+,(r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x81 ; 0 .byte ^xB0 .word cr-5 zero: .word const .word 0 .byte ^x81 ; 1 .byte ^xB1 .word zero-4 one: .word const .word 1 .byte ^x81 ; 2 .byte ^xB2 .word one-4 two: .word const .word 2 .byte ^x82 ; bl .ascii /B/ .byte ^xCC .word two-4 bl: .word const .word ^x20 .byte ^x83 ; c/l .ascii \C/\ .byte ^xCC .word bl-5 cl: .word const .word ^x40 .byte ^x85 ; first .ascii /FIRS/ .byte ^xD4 .word cl-6 first: .word const .word firstb .byte ^x85 ; limit .ascii /LIMI/ .byte ^xD4 .word first-8 limit: .word const .word limitb .byte ^x85 ; b/buf .ascii \B/BU\ .byte ^xC6 .word limit-8 bbuf: .word const .word ^x400 .byte ^x85 ; b/scr .ascii \B/SC\ .byte ^xD2 .word bbuf-8 bscr: .word const .word 1 .byte ^x86 ; origin .ascii /ORIGI/ .byte ^xCE .word bscr-8 orgn: .word const .word srtparm-^x0C .byte ^x87 ; +origin .ascii /+ORIGI/ .byte ^xCE .word orgn-9 porgn: .word nest .word orgn .word plus .word semis .byte ^x82 ; s0 .ascii /S/ .byte ^xB0 .word porgn-10 so: .word user .word 6 .byte ^x82 ; r0 .ascii /R/ .byte ^xB0 .word so-5 ro: .word user .word 8 .byte ^x83 ; tib .ascii /TI/ .byte ^xC2 .word ro-5 tib: .word user .word ^x0A .byte ^x85 ; width .ascii /WIDT/ .byte ^xC8 .word tib-6 width: .word user .word ^x0C .byte ^x87 ; warning .ascii /WARNIN/ .byte ^xC7 .word width-8 wrng: .word user .word ^x0E .byte ^x85 ; fence .ascii /FENC/ .byte ^xC5 .word wrng-10 fnce: .word user .word ^x10 .byte ^x82 ; dp .ascii /D/ .byte ^xD0 .word fnce-8 dp: .word user .word ^x12 .byte ^x88 ; voc-link .ascii /VOC-LIN/ .byte ^xCB .word dp-5 vl: .word user .word ^x14 .byte ^x83 ; blk .ascii /BL/ .byte ^xCB .word vl-11 blk: .word user .word ^x16 .byte ^x82 ; in .ascii /I/ .byte ^xCE .word blk-6 fin: .word user .word ^x18 .byte ^x83 ; out .ascii /OU/ .byte ^xD4 .word fin-5 fout: .word user .word ^x1A .byte ^x83 ; scr .ascii /SC/ .byte ^xD2 .word fout-6 fscr: .word user .word ^x1C .byte ^x86 ; offset .ascii /OFFSE/ .byte ^xD4 .word fscr-6 ofst: .word user .word ^x1E .byte ^x87 ; context .ascii /CONTEX/ .byte ^xD4 .word ofst-9 cntx: .word user .word ^x20 .byte ^x87 ; current .ascii /CURREN/ .byte ^xD4 .word cntx-10 crnt: .word user .word ^x22 .byte ^x85 ; state .ascii /STAT/ .byte ^xC5 .word crnt-10 stt: .word user .word ^x24 .byte ^x84 ; base .ascii /BAS/ .byte ^xC5 .word stt-8 base: .word user .word ^x26 .byte ^x83 ; dpl .ascii /DP/ .byte ^xCC .word base-7 dpl: .word user .word ^x28 .byte ^x83 ; fld .ascii /FL/ .byte ^xC4 .word dpl-6 fld: .word user .word ^x2A .byte ^x83 ; csp .ascii /CS/ .byte ^xD0 .word fld-6 csp: .word user .word ^x2C .byte ^x82 ; r# .ascii /R/ .byte ^xA3 .word csp-6 rnu: .word user .word ^x2E .byte ^x83 ; hld .ascii /HL/ .byte ^xC4 .word rnu-5 hld: .word user .word ^x30 .byte ^x82 ; di .ascii /D/ .byte ^xD6 .word hld-6 dis: .word user .word ^x32 .byte ^x82 ; 1+ .ascii /1/ .byte ^xAB .word dis-5 plus1: .word nest .word one .word plus .word semis .byte ^x82 ; 2+ .ascii /2/ .byte ^xAB .word plus1-5 plus2: .word nest .word two .word plus .word semis .byte ^x84 ; here .ascii /HER/ .byte ^xC5 .word plus2-5 here: .word nest .word dp .word at .word semis .byte ^x85 ; allot .ascii /ALLO/ .byte ^xD4 .word here-7 allot: .word nest .word dp .word pluss .word semis .byte ^x81 ; , .byte ^xAC .word allot-8 comma: .word nest .word here .word ex .word two .word allot .word semis .byte ^x82 ; c, .ascii /C/ .byte ^xAC .word comma-4 ccma: .word nest .word here .word cex .word one .word allot .word semis .byte ^x81 ; - .byte ^xAD .word ccma-5 mins: .word nest .word minus .word plus .word semis .byte ^x81 ; = .byte ^xBD .word mins-4 eql: .word nest .word mins .word zeqal .word semis .byte ^x81 ; < .byte ^xBC .word eql-4 less: .word nest .word mins .word zless .word semis .byte ^x81 ; > .byte ^xBE .word less-4 gtr: .word nest .word swap .word less .word semis .byte ^x83 ; rot .ascii /RO/ .byte ^xD4 .word gtr-4 rot: .word nest .word gr .word swap .word rg .word swap .word semis .byte ^x85 ; space .ascii /SPAC/ .byte ^xC5 .word rot-6 spc: .word nest .word bl .word emit .word semis .byte ^x84 ; -dup .ascii /-DU/ .byte ^xD0 .word spc-8 mdup: .word nest .word dup .word zbrch .word .+4 .word dup .word semis .byte ^x88 ; traverse .ascii /TRAVERS/ .byte ^xC5 .word mdup-7 trvs: .word nest .word swap tr1: .word over .word plus .word lit .word ^x7F .word over .word cat .word less .word zbrch .word tr1 .word swap .word drop .word semis .byte ^x86 ; latest .ascii /LATES/ .byte ^xD4 .word trvs-11 ltst: .word nest .word crnt .word at .word at .word semis .byte ^x83 ; lfa .ascii /LF/ .byte ^xC1 .word ltst-9 lfa: .word nest .word lit .word 4 .word mins .word semis .byte ^x83 ; cfa .ascii /CF/ .byte ^xC1 .word lfa-6 cfa: .word nest .word two .word mins .word semis .byte ^x83 ; nfa .ascii /NF/ .byte ^xC1 .word cfa-6 nfa: .word nest .word lit .word 5 .word mins .word lit .word ^xFFFF .word trvs .word semis .byte ^x83 ; pfa .ascii /PF/ .byte ^xC1 .word nfa-6 pfa: .word nest .word one .word trvs .word lit .word 5 .word plus .word semis .byte ^x84 ; !csp .ascii /!CS/ .byte ^xD0 .word pfa-6 dcsp: .word nest .word fspat .word csp .word ex .word semis .byte ^x86 ; ?error .ascii /?ERRO/ .byte ^xD2 .word dcsp-7 qerr: .word nest .word swap .word zbrch .word .+8 .word error .word brch .word .+4 .word drop .word semis .byte ^x85 ; ?comp .ascii /?COM/ .byte ^xD0 .word qerr-9 qcmp: .word nest .word stt .word at .word zeqal .word lit .word ^x11 .word qerr .word semis .byte ^x85 ; ?exec .ascii /?EXE/ .byte ^xC3 .word qcmp-8 exc: .word nest .word stt .word at .word lit .word ^x12 .word qerr .word semis .byte ^x86 ; ?pairs .ascii /?PAIR/ .byte ^xD3 .word exc-8 qpr: .word nest .word mins .word lit .word ^x13 .word qerr .word semis .byte ^x84 ; ?csp .ascii /?CS/ .byte ^xD0 .word qpr-9 qcsp: .word nest .word fspat .word csp .word at .word mins .word lit .word ^x14 .word qerr .word semis .byte ^x88 ; ?loading .ascii /?LOADIN/ .byte ^xC7 .word qcsp-7 qldg: .word nest .word blk .word at .word zeqal .word lit .word ^x14 .word qerr .word semis .byte ^x87 ; compile .ascii /COMPIL/ .byte ^xC5 .word qldg-11 cmpl: .word nest .word qcmp .word rg .word dup .word plus2 .word gr .word at .word comma .word semis .byte ^xC1 ; [ .byte ^xDB .word cmpl-10 lb: .word nest .word zero .word stt .word ex .word semis .byte ^x81 ; ] .byte ^xDD .word lb-4 rb: .word nest .word lit .word ^xC0 .word stt .word ex .word semis .byte ^x86 ; smudge .ascii /SMUDG/ .byte ^xC5 .word rb-4 smdg: .word nest .word ltst .word lit .word ^x20 .word tgle .word semis .byte ^x83 ; hex .ascii /HE/ .byte ^xD8 .word smdg-9 mhex: .word nest .word lit .word ^x10 .word base .word ex .word semis .byte ^x87 ; decimal .ascii /DECIMA/ .byte ^xCC .word mhex-6 mdcml: .word nest .word lit .word ^x0A .word base .word ex .word semis .byte ^x87 ; (;code) .ascii /(;CODE/ .byte ^xA9 .word mdcml-10 pcode: .word nest .word rg .word ltst .word pfa .word cfa .word ex .word semis .byte ^xC5 ; ;code .ascii /;COD/ .byte ^xC5 .word pcode-10 code: .word nest .word qcsp .word cmpl .word pcode .word lb .word smdg .word semis .byte ^x85 ; count .ascii /COUN/ .byte ^xD4 .word code-8 cnt: .word nest .word dup .word plus1 .word swap .word cat .word semis .byte ^x84 ; type .ascii /TYP/ .byte ^xC5 .word cnt-8 type: .word nest .word mdup .word zbrch .word .+24 .word over .word plus .word swap .word pdo typ1: .word r .word cat .word emit .word lupe .word typ1 .word brch .word .+4 .word drop .word semis .byte ^x89 ; -trailing .ascii /-TRAILIN/ .byte ^xC7 .word type-7 trlg: .word nest .word dup .word zero .word pdo trl1: .word over .word over .word plus .word one .word mins .word cat .word bl .word mins .word zbrch .word .+8 .word lve .word brch .word .+6 .word one .word mins .word lupe .word trl1 .word semis .byte ^x84 ; (.") .ascii /(."/ .byte ^xA9 .word trlg-12 pdq: .word nest .word r .word cnt .word dup .word plus1 .word rg .word plus .word gr .word type .word semis .byte ^x86 ; expect .ascii /EXPEC/ .byte ^xD4 .word pdq-7 expt: .word nest .word over .word plus .word over .word pdo expt4: .word key .word dup .word lit .word ^x0E .word porgn .word at .word eql .word zbrch .word expt1 .word drop .word lit .word 8 .word over .word r .word eql .word dup .word rg .word two .word mins .word plus .word gr .word mins .word emit .word lit .word ^x20 .word emit .word lit .word ^x08 .word brch .word expt2 expt1: .word dup .word lit .word ^x0D .word eql .word zbrch .word expt3 .word lve .word drop .word bl .word zero .word brch .word expt5 expt3: .word dup expt5: .word r .word cex .word zero .word r .word plus1 .word ex expt2: .word emit .word lupe .word expt4 .word drop .word semis .byte ^x85 ; query .ascii /QUER/ .byte ^xD9 .word expt-9 quer: .word nest .word tib .word at .word lit .word ^x50 .word expt .word zero .word fin .word ex .word semis .byte ^xC1 ; null .byte ^x80 .word quer-8 x: .word nest .word blk .word at .word zbrch .word x2 .word one .word blk .word pluss .word zero .word fin .word ex .word blk .word at .word lit .word 7 .word fand .word zeqal .word zbrch .word x1 .word exc .word rg .word drop x1: .word brch .word xend x2: .word rg .word drop xend: .word semis .byte ^x84 ; fill .ascii /FIL/ .byte ^xCC .word x-4 fill: .word nest .word swap .word gr .word over .word cex .word dup .word plus1 .word rg .word one .word mins .word cmove .word semis .byte ^x85 ; erase .ascii /ERAS/ .byte ^xC5 .word fill-7 ers: .word nest .word zero .word fill .word semis .byte ^x86 ; blanks .ascii /BLANK/ .byte ^xD3 .word ers-8 blnk: .word nest .word bl .word fill .word semis .byte ^x84 ; hold .ascii /HOL/ .byte ^xC4 .word blnk-9 hold: .word nest .word lit .word ^xFFFF .word hld .word pluss .word hld .word at .word cex .word semis .byte ^x83 ; pad .ascii /PA/ .byte ^xC4 .word hold-7 pad: .word nest .word here .word lit .word ^x44 .word plus .word semis .byte ^x84 ; word .ascii /WOR/ .byte ^xC4 .word pad-6 word: .word nest .word blk .word at .word zbrch .word wd1 .word blk .word at .word block .word brch .word wd2 wd1: .word tib .word at wd2: .word fin .word at .word plus .word swap .word encl .word here .word lit .word ^x22 .word blnk .word fin .word pluss .word over .word mins .word gr .word r .word here .word cex .word plus .word here .word plus1 .word rg .word cmove .word semis .byte ^x88 ; (number) .ascii /(NUMBER/ .byte ^xA9 .word word-7 pnmbr: .word nest .word plus1 .word dup .word gr .word cat .word base .word at .word dgt .word zbrch .word pnm2 .word swap .word base .word at .word ustar .word drop .word rot .word base .word at .word ustar .word dplus .word dpl .word at .word plus1 .word zbrch .word pnm1 .word one .word dpl .word pluss pnm1: .word rg .word brch .word pnmbr+2 pnm2: .word rg .word semis .byte ^x86 ; number .ascii /NUMBE/ .byte ^xD2 .word pnmbr-11 nmbr: .word nest .word zero .word zero .word rot .word dup .word plus1 .word cat .word lit .word ^x2D .word eql .word dup .word gr .word plus .word lit .word ^xFFFF nmb1: .word dpl .word ex .word pnmbr .word dup .word cat .word bl .word mins .word zbrch .word nmb2 .word dup .word cat .word lit .word ^x2E .word mins .word zero .word qerr .word zero .word brch .word nmb1 nmb2: .word drop .word rg .word zbrch .word nmb3 .word dmin nmb3: .word semis .byte ^x85 ; -find .ascii /-FIN/ .byte ^xC4 .word nmbr-9 mfind: .word nest .word bl .word word .word here .word cntx .word at .word at .word find .word dup .word zeqal .word zbrch .word mf1 .word drop .word here .word ltst .word find mf1: .word semis .byte ^x87 ; (abort) .ascii /(ABORT/ .byte ^xA9 .word mfind-8 pabrt: .word nest .word abort .word semis .byte ^x85 ; error .ascii /ERRO/ .byte ^xD2 .word pabrt-10 error: .word nest .word wrng .word at .word zless .word zbrch .word err1 .word pabrt err1: .word here .word cnt .word type .word pdq .byte ^x03 .ascii / ?/ .word msg .word sp1 .word fin .word at .word blk .word at .word quit .word semis .byte ^x83 ; min .ascii /MI/ .byte ^xCE .word error-8 min: .word nest .word over .word over .word gtr .word zbrch .word mn1 .word swap mn1: .word drop .word semis .byte ^x83 ; id. .ascii /ID/ .byte ^xAE .word min-6 id: .word nest .word pad .word lit .word ^x20 .word lit .word ^x5F .word fill .word dup .word pfa .word lfa .word over .word mins .word pad .word swap .word cmove .word pad .word cnt .word lit .word ^x1F .word fand .word type .word spc .word semis .byte ^x86 ; create .ascii /CREAT/ .byte ^xC5 .word id-6 crte: .word nest .word fspat .word here .word lit .word ^xA0 .word plus .word less .word two .word qerr .word mfind .word zbrch .word crt1 .word drop .word nfa .word id .word lit .word 4 .word msg .word spc crt1: .word here .word dup .word cat .word width .word at .word min .word plus1 .word allot .word dup .word lit .word ^xA0 .word tgle .word here .word one .word mins .word lit .word ^x80 .word tgle .word ltst .word comma .word crnt .word at .word ex .word here .word plus2 .word comma .word semis .byte ^xC1 ; : .byte ^xBA .word crte-9 colon: .word nest .word exc .word dcsp .word crnt .word at .word cntx .word ex .word crte .word rb .word lit .word ^xFFFE .word dp .word pluss .word cmpl .word nest .word semis .byte ^x85 ; !code .ascii /!COD/ .byte ^xC5 .word colon-4 dcode: .word nest .word crte .word smdg .word ltst .word pfa .word cfa .word ex .word comma .word semis .byte ^x88 ; constant .ascii /CONSTAN/ .byte ^xD4 .word dcode-8 cnst: .word nest .word lit .word const .word dcode .word semis .byte ^x88 ; variable .ascii /VARIABL/ .byte ^xC5 .word cnst-11 varb: .word nest .word lit .word var .word dcode .word semis .byte ^x84 ; user .ascii /USE/ .byte ^xD2 .word varb-11 usr: .word nest .word lit .word user .word dcode .word semis .byte ^x87 ; .ascii /DOES/ .byte ^xBE .word lbld-10 doesg: .word nest .word rg .word ltst .word pfa .word ex .word pcode duz1: movw r6,-(r8) movw (r7)+,r6 addw #2,r9 movw r7,(r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^xC7 ; literal .ascii /LITERA/ .byte ^xCC .word doesg-8 ltl: .word nest .word stt .word at .word zbrch .word lt1 .word cmpl .word lit .word comma lt1: .word semis .byte ^xC8 ; dliteral .ascii /DLITERA/ .byte ^xCC .word ltl-10 dltl: .word nest .word stt .word at .word zbrch .word dltl1 .word swap .word ltl .word ltl dltl1: .word semis .byte ^x86 ; ?stack .ascii /?STAC/ .byte ^xCB .word dltl-11 qstk: .word nest .word so .word at .word dup .word fspat .word gtr .word one .word qerr .word lit .word ^x100 .word plus .word fspat .word less .word lit .word 7 .word qerr .word semis .byte ^x89 ; interpret .ascii /INTERPRE/ .byte ^xD4 .word qstk-9 inpt: .word nest .word mfind .word zbrch .word pt1 .word stt .word at .word less .word zbrch .word pt2 .word cfa .word comma .word brch .word pt3 pt2: .word cfa .word exe pt3: .word qstk .word brch .word pt4 pt1: .word here .word nmbr .word dpl .word at .word plus1 .word zbrch .word pt5 .word dltl .word brch .word pt6 pt5: .word drop .word ltl pt6: .word qstk pt4: .word brch .word inpt+2 .word semis .byte ^x8A ; vocabulary .ascii /VOCABULAR/ .byte ^xD9 .word inpt-12 vbly: .word nest .word lbld .word lit .word ^x81A0 .word comma .word crnt .word at .word cfa .word comma .word here .word vl .word at .word comma .word vl .word ex .word doesg vb1: .word plus2 .word cntx .word ex .word semis frth: .byte ^xC5 ; forth .ascii /FORT/ .byte ^xC8 .word vbly-13 .word duz1 .word vb1 .word ^x81A0 .word task-7 .word 0 .byte ^x8B ; definitions .ascii /DEFINITION/ .byte ^xD3 .word frth dfn: .word nest .word cntx .word at .word crnt .word ex .word semis .byte ^x84 ; quit .ascii /QUI/ .byte ^xD4 .word dfn-14 quit: .word nest .word zero .word blk .word ex .word lb q2: .word rp1 .word cr .word quer .word inpt .word stt .word at .word zeqal .word zbrch .word q1 .word pdq .byte ^x04 .ascii / OK/ q1: .word brch .word q2 .word semis .byte ^x85 ; abort .ascii /ABOR/ .byte ^xD4 .word quit-7 abort: .word nest .word sp1 .word mdcml .word cr .word lit .word ^x15 .word spacs .word pdq .ascic /VAX-11 fig-Forth Version 1.0/ .word drzer .word mtbuf .word first .word dup .word prev .word ex .word use .word ex .word frth+8 .word dfn .word quit .word semis .byte ^xC1 ; ; .byte ^xBB .word abort-8 semic: .word nest .word qcsp .word cmpl .word semis .word smdg .word lb .word semis .byte ^xc2 ; ." .ascii /./ .byte ^xA2 .word semic-4 dotq: .word nest .word lit .word ^x22 .word stt .word at .word zbrch .word dotq1 .word cmpl .word pdq .word word .word here .word cat .word plus1 .word allot .word brch .word dotq2 dotq1: .word word .word here .word cnt .word type dotq2: .word semis .byte ^xC9 ; [compile] .ascii /[COMPILE/ .byte ^xDD .word dotq-5 bcomp: .word nest .word mfind .word zeqal .word zero .word qerr .word drop .word cfa .word comma .word semis .byte ^x89 .ascii /IMMEDIAT/ .byte ^xC5 .word bcomp-12 immed: .word nest .word ltst .word lit .word ^x40 .word tgle .word semis .byte ^xC1 ; ( .byte ^xA8 .word immed-12 paren: .word nest .word lit .word ^x29 .word word .word semis .byte ^x81 ; 3 .byte ^xB3 .word paren-4 three: .word const .word 3 .byte ^xC1 ; ' .byte ^xA7 .word three-4 tick: .word nest .word mfind .word zeqal .word zero .word qerr .word drop .word ltl .word semis .byte ^x86 ; forget .ascii /FORGE/ .byte ^xD4 .word tick-4 forg: .word nest .word crnt .word at .word cntx .word at .word mins .word lit .word ^x18 .word qerr .word tick .word dup .word fnce .word at .word less .word lit .word ^x15 .word qerr .word dup .word nfa .word dp .word ex .word lfa .word at .word cntx .word at .word ex .word semis .byte ^x82 ; +- .ascii /+/ .byte ^xAD .word forg-9 pm: .word nest .word zless .word zbrch .word pm1 .word minus pm1: .word semis .byte ^x83 ; d+- .ascii /D+/ .byte ^xAD .word pm-5 dpm: .word nest .word zless .word zbrch .word dpm1 .word dmin dpm1: .word semis .byte ^x83 ; abs .ascii /AB/ .byte ^xD3 .word dpm-6 abs: .word nest .word dup .word pm .word semis .byte ^x84 ; dabs .ascii /DAB/ .byte ^xD3 .word abs-6 dabs: .word nest .word dup .word dpm .word semis .byte ^x82 ; d- .ascii /D/ .byte ^xAD .word dabs-7 dmins: .word nest .word dmin .word dplus .word semis .byte ^x82 ; d@ .ascii /D/ .byte ^xC0 .word dmins-5 dat: .word nest .word dup .word lit .word ^x02 .word plus .word at .word swap .word at .word semis .byte ^x82 ; d! .ascii /D/ .byte ^xA1 .word dat-5 dex: .word nest .word dup .word rot .word swap .word ex .word lit .word ^x02 .word plus .word ex .word semis .byte ^x84 ; 2dup .ascii /2DU/ .byte ^xD0 .word dex-5 ddup: .word nest .word over .word over .word semis .byte ^x85 ; 2drop .ascii /2DRO/ .byte ^xD0 .word ddup-7 ddrop: .word nest .word drop .word drop .word semis .byte ^x85 ; 2swap .ascii /2SWA/ .byte ^xD0 .word ddrop-8 dswap: .word nest .word rot .word gr .word rot .word rg .word semis .byte ^x85 ; 2over .ascii /2OVE/ .byte ^xD2 .word dswap-8 dover: .word nest .word dswap .word ddup .word gr .word gr .word dswap .word rg .word rg .word semis .byte ^x82 ; d* .ascii /D/ .byte ^xAA .word dover-8 dstar: .word nest .word dup .word rot .word star .word rot .word rot .word ustar .word rot .word plus .word semis .byte ^x82 ; d/ .ascii /D/ .byte ^xAF .word dstar-5 dslas: .word nest .word swap .word over .word slmod .word over .word dup .word zless .word zbrch .word dsl1 .word plus .word brch .word dsl2 dsl1: .word drop dsl2: .word gr .word swap .word mslas .word swap .word drop .word rg .word semis .byte ^x85 ; d/mod .ascii \D/MO\ .byte ^xC4 .word dslas-5 dsmod: .word nest .word uslsh .word semis .byte ^x83 ; max .ascii /MA/ .byte ^xD8 .word dsmod-8 max: .word nest .word over .word over .word less .word zbrch .word max1 .word swap max1: .word drop .word semis .byte ^x82 ; m+ .ascii /M/ .byte ^xAB .word max-6 mplus: .word nest .word stod .word dplus .word semis .byte ^x82 ; m* .ascii /M/ .byte ^xAA .word mplus-5 mstar: .word nest .word over .word over .word fxor .word gr .word abs .word swap .word abs .word ustar .word rg .word dpm .word semis .byte ^x82 ; m/ .ascii /M/ .byte ^xAF .word mstar-5 mslas: .word nest .word over .word gr .word gr .word dabs .word r .word abs .word uslsh .word rg .word r .word fxor .word pm .word swap .word rg .word pm .word swap .word semis .byte ^x81 ; * .byte ^xAA .word mslas-5 star: .word nest .word mstar .word drop .word semis .byte ^x84 ; /MOD .ascii \/MO\ .byte ^xC4 .word star-4 slmod: .word slmod+2 clrl r11 cvtwl (r9),r4 tstw -(r9) bgeq slmod1 movl #^xFFFFFFFF,r11 slmod1: cvtwl (r9),r10 ediv r4,r10,r10,r4 movw r4,(r9)+ movw r10,(r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x81 ; / .byte ^xAF .word slmod-7 slash: .word slash+2 divw (r9),-(r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x83 ; mod .ascii /MO/ .byte ^xC4 .word slash-4 modd: .word nest .word slmod .word drop .word semis .byte ^x85 ; */mod .ascii \*/MO\ .byte ^xC4 .word modd-6 ssmod: .word nest .word gr .word mstar .word rg .word mslas .word semis .byte ^x82 ; */ .ascii /*/ .byte ^xAF .word ssmod-8 ssla: .word nest .word ssmod .word swap .word drop .word semis .byte ^x85 ; m/mod .ascii \M/MO\ .byte ^xC4 .word ssla-5 msmod: .word nest .word gr .word zero .word r .word uslsh .word rg .word swap .word gr .word uslsh .word rg .word semis .byte ^x83 ; mon .ascii /MO/ .byte ^xCE .word msmod-8 mon: .word mon+2 movl #SS$_NORMAL,r0 ret .byte ^x83 ; bye .ascii /BY/ .byte ^xC5 .word mon-6 bye: .word nest .word cr .word flush .word mon .word semis .byte ^x84 ; back .ascii /BAC/ .byte ^xCB .word bye-6 back: .word nest .word comma .word semis .byte ^xC5 ; begin .ascii /BEGI/ .byte ^xCE .word back-7 begin: .word nest .word qcmp .word here .word one .word semis .byte ^xC5 ; endif .ascii /ENDI/ .byte ^xC6 .word begin-8 endiff: .word nest .word qcmp .word two .word qpr .word here .word swap .word ex .word semis .byte ^xC4 ; then .ascii /THE/ .byte ^xCE .word endiff-8 then: .word nest .word endiff .word semis .byte ^xC2 ; do .ascii /D/ .byte ^xCF .word then-7 do: .word nest .word cmpl .word pdo .word here .word three .word semis .byte ^xC4 ; loop .ascii /LOO/ .byte ^xD0 .word do-5 loop: .word nest .word three .word qpr .word cmpl .word lupe .word back .word semis .byte ^xC5 ; +loop .ascii /+LOO/ .byte ^xD0 .word loop-7 ploop: .word nest .word three .word qpr .word cmpl .word plupe .word back .word semis .byte ^xC5 ; until .ascii /UNTI/ .byte ^xCC .word ploop-8 until: .word nest .word one .word qpr .word cmpl .word zbrch .word back .word semis .byte ^xC3 ; end .ascii /EN/ .byte ^xC4 .word until-8 endd: .word nest .word until .word semis .byte ^xC5 ; again .ascii /AGAI/ .byte ^xCE .word endd-6 again: .word nest .word one .word qpr .word cmpl .word brch .word back .word semis .byte ^xC6 ; repeat .ascii /REPEA/ .byte ^xD4 .word again-8 repea: .word nest .word gr .word gr .word again .word rg .word rg .word two .word mins .word endiff .word semis .byte ^xC2 ; if .ascii /I/ .byte ^xC6 .word repea-9 iff: .word nest .word cmpl .word zbrch .word here .word zero .word comma .word two .word semis .byte ^xC4 ; else .ascii /ELS/ .byte ^xC5 .word iff-5 elsee: .word nest .word two .word qpr .word cmpl .word brch .word here .word zero .word comma .word swap .word two .word endiff .word two .word semis .byte ^xC5 ; while .ascii /WHIL/ .byte ^xC5 .word elsee-7 while: .word nest .word iff .word plus2 .word semis .byte ^x86 ; spaces .ascii /SPACE/ .byte ^xD3 .word while-8 spacs: .word nest .word zero .word max .word mdup .word zbrch .word spax1 .word zero .word pdo spax2: .word spc .word lupe .word spax2 spax1: .word semis .byte ^x82 ; <# .byte ^x3C .byte ^xA3 .word spacs-9 bdigs: .word nest .word pad .word hld .word ex .word semis .byte ^x82 ; #> .byte ^x23 .byte ^xBE .word bdigs-5 edigs: .word nest .word drop .word drop .word hld .word at .word pad .word over .word mins .word semis .byte ^x84 ; sign .ascii /SIG/ .byte ^xCE .word edigs-5 sign: .word nest .word rot .word zless .word zbrch .word sign1 .word lit .word ^x2D .word hold sign1: .word semis .byte ^x81 ; # .byte ^xA3 .word sign-7 dig: .word nest .word base .word at .word msmod .word rot .word lit .word 9 .word over .word less .word zbrch .word dig1 .word lit .word 7 .word plus dig1: .word lit .word ^x30 .word plus .word hold .word semis .byte ^x82 ; #s .ascii /#/ .byte ^xD3 .word dig-4 digs: .word nest digs1: .word dig .word over .word over .word ffor .word zeqal .word zbrch .word digs1 .word semis .byte ^x83 ; d.r .ascii /D./ .byte ^xD2 .word digs-5 ddotr: .word nest .word gr .word swap .word over .word dabs .word bdigs .word digs .word sign .word edigs .word rg .word over .word mins .word spacs .word type .word semis .byte ^x82 ; .r .byte ^x2E .byte ^xD2 .word ddotr-6 dotr: .word nest .word gr .word stod .word rg .word ddotr .word semis .byte ^x82 ; d. .byte ^x44 .byte ^xAE .word dotr-5 ddot: .word nest .word zero .word ddotr .word spc .word semis .byte ^x81 ; . .byte ^xAE .word ddot-5 dot: .word nest .word stod .word ddot .word semis .byte ^x81 ; ? .byte ^xBF .word dot-4 ques: .word nest .word at .word dot .word semis .byte ^x82 ; u. .byte ^x55 .byte ^xAE .word ques-4 udot: .word nest .word zero .word ddot .word semis .byte ^x85 ; vlist .ascii /VLIS/ .byte ^xD4 .word udot-5 vlist: .word nest .word cr .word lit .word ^x80 .word fout .word ex .word cntx .word at .word at vlis1: .word fout .word at .word lit .word ^x45 .word gtr .word zbrch .word vlis2 .word cr .word zero .word fout .word ex vlis2: .word dup .word id .word spc .word spc .word pfa .word lfa .word at .word dup .word zeqal .word qterm .word ffor .word zbrch .word vlis1 .word drop .word semis .byte ^x87 ; message .ascii /MESSAG/ .byte ^xC5 .word vlist-8 msg: .word nest .word wrng .word at .word zbrch .word mess1 .word mdup .word zbrch .word mess2 .word lit .word 4 .word ofst .word at .word bscr .word slash .word mins .word dline .word spc mess2: .word brch .word mess3 mess1: .word pdq .byte ^x07 .ascii / MSG # / .word dot mess3: .word semis .byte ^x81 ; i .byte ^xC9 .word msg-10 i: .word i+2 addw #2,r9 movw (r8),(r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x84 ; warm .ascii /WAR/ .byte ^xCD .word i-4 wrm: .word wrm+2 jmp warm .byte ^x84 ; cold .ascii /COL/ .byte ^xC4 .word wrm-7 cld: .word cld+2 jmp cold .byte ^x84 ; s->d .ascii /S->/ .byte ^xC4 .word cld-7 stod: .word stod+2 bitw #^x8000,(r9)+ beqlu sskp sneg: movw #^xFFFF,(r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) sskp: movw #0,(r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x86 ; (line) .ascii /(LINE/ .byte ^xA9 .word stod-7 pline: .word nest .word gr .word lit .word ^x40 .word bbuf .word ssmod .word rg .word bscr .word star .word plus .word block .word plus .word lit .word ^x40 .word semis .byte ^x85 ; .line .ascii /.LIN/ .byte ^xC5 .word pline-9 dline: .word nest .word pline .word trlg .word type .word semis .byte ^x83 ; use .ascii /US/ .byte ^xC5 .word dline-8 use: .word var .word firstb .byte ^x84 ; prev .ascii /PRE/ .byte ^xD6 .word use-6 prev: .word var .word firstb .byte ^x84 ; +buf .ascii /+BU/ .byte ^xC6 .word prev-7 pbuf: .word nest .word bbuf .word lit .word 4 .word plus .word plus .word dup .word limit .word eql .word zbrch .word pbuf1 .word drop .word first pbuf1: .word dup .word prev .word at .word mins .word semis .byte ^x86 ; update .ascii /UPDAT/ .byte ^xC5 .word pbuf-7 updat: .word nest .word prev .word at .word at .word lit .word ^x8000 .word ffor .word prev .word at .word ex .word semis .byte ^x8D ; empty-buffers .ascii /EMPTY-BUFFER/ .byte ^xD3 .word updat-9 mtbuf: .word nest .word first .word limit .word over .word mins .word ers .word semis .byte ^x86 ; buffer .ascii /BUFFE/ .byte ^xD2 .word mtbuf-16 buffe: .word nest .word use .word at .word dup .word gr buff1: .word pbuf .word zbrch .word buff1 .word use .word ex .word r .word at .word zless .word zbrch .word buff2 .word r .word plus2 .word r .word at .word lit .word ^x7FFF .word fand .word zero .word rslw buff2: .word r .word ex .word r .word prev .word ex .word rg .word plus2 .word semis .byte ^x85 ; block .ascii /BLOC/ .byte ^xCB .word buffe-9 block: .word nest .word ofst .word at .word plus .word gr .word prev .word at .word dup .word at .word r .word mins .word dup .word plus .word zbrch .word bloc1 bloc2: .word pbuf .word zeqal .word zbrch .word bloc3 .word drop .word r .word buffe .word dup .word r .word one .word rslw .word two .word mins bloc3: .word dup .word at .word r .word mins .word dup .word plus .word zeqal .word zbrch .word bloc2 .word dup .word prev .word ex bloc1: .word rg .word drop .word plus2 .word semis .byte ^x83 ; r/w .ascii \R/\ .byte ^xD7 .word block-8 rslw: .word nest .word gr .word dup .word lit .word ^x7FFF .word gtr .word zbrch .word gdnews .word rg .word drop .word drop .word lit .word ^x01 .word lit .word ^x08 .word qerr .word semis gdnews: .word base .word at .word gr .word mdcml .word stod .word bdigs .word digs .word edigs .word rg .word base .word ex .word rg .word zbrch .word rslw1 .word blkrd .word brch .word rslw2 rslw1: .word blkwt rslw2: .word qerr .word semis .byte ^x0A ; block-read .ascii /BLOCK-REA/ .byte ^xC4 .word rslw-6 blkrd: .word blkrd+2 movzwl (r9),r11 movzwl -(r9),r10 pushr #^m movc3 r11,(r10),begadr movc3 #4,fthadr,begadr(r11) popr #^m moval fab_rblock,r0 addw #^x0D,r11 movb r11,FAB$B_FNS(r0) moval rab_rblock,r0 movzwl -(r9),RAB$L_UBF(r0) $open fab=fab_rblock blbc r0,badnews $connect rab=rab_rblock blbc r0,badnews1 $get rab=rab_rblock blbc r0,badnews2 $close fab=fab_rblock clrw (r9)+ clrw (r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) badnews: movw #1,(r9)+ movw #8,(r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) badnews1: movw #1,(r9)+ movw #9,(r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) badnews2: movw #1,(r9)+ movw #^x0A,(r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x0B ; block-write .ascii /BLOCK-WRIT/ .byte ^xC5 .word blkrd-13 blkwt: .word blkwt+2 movzwl (r9),r11 movzwl -(r9),r10 pushr #^m movc3 r11,(r10),begadr movc3 #4,fthadr,begadr(r11) popr #^m moval fab_wblock,r0 addw #^x0D,r11 movb r11,FAB$B_FNS(r0) moval rab_wblock,r0 movzwl -(r9),RAB$L_RBF(r0) $create fab=fab_wblock $connect rab=rab_wblock $put rab=rab_wblock $close fab=fab_wblock clrw (r9)+ clrw (r9) movw (r6)+,r7 movzwl (r7)+,r11 jmp (r11) .byte ^x84 ; load .ascii /LOA/ .byte ^xC4 .word blkwt-14 load: .word nest .word blk .word at .word gr .word fin .word at .word gr .word zero .word fin .word ex .word bscr .word star .word blk .word ex .word inpt .word rg .word fin .word ex .word rg .word blk .word ex .word semis .byte ^xC3 ; --> .ascii /--/ .byte ^xBE .word load-7 arrow: .word nest .word qldg .word zero .word fin .word ex .word bscr .word blk .word at .word over .word modd .word mins .word blk .word pluss .word semis .byte ^x83 ; dr0 .ascii /DR/ .byte ^xB0 .word arrow-6 drzer: .word nest .word zero .word ofst .word ex .word semis .byte ^x83 ; dr1 .ascii /DR/ .byte ^xB1 .word drzer-6 drone: .word nest .word bscr .word lit .word ^xFA .word star .word ofst .word ex .word semis .byte ^x84 ; list .ascii /LIS/ .byte ^xD4 .word drone-6 list: .word nest .word mdcml .word cr .word dup .word fscr .word ex .word pdq .ascic /SCR # / .word dot .word lit .word ^x10 .word zero .word pdo list1: .word cr .word i .word lit .word 3 .word dotr .word spc .word i .word fscr .word at .word dline .word qterm .word zbrch .word list2 .word lve list2: .word lupe .word list1 .word cr .word semis .byte ^x85 ; index .ascii /INDE/ .byte ^xD8 .word list-7 index: .word nest .word cr .word plus1 .word swap .word pdo inde1: .word cr .word i .word lit .word 3 .word dotr .word spc .word zero .word i .word dline .word qterm .word zbrch .word inde2 .word lve inde2: .word lupe .word inde1 .word semis .byte ^x85 ; triad .ascii /TRIA/ .byte ^xC4 .word index-8 triad: .word nest .word cr .word lit .word 3 .word slash .word lit .word 3 .word star .word lit .word 3 .word over .word plus .word swap .word pdo tria1: .word cr .word i .word list .word qterm .word zbrch .word tria2 .word lve tria2: .word lupe .word tria1 .word cr .word lit .word ^x0F .word msg .word cr .word semis .byte ^x85 ; flush .ascii /FLUS/ .byte ^xC8 .word triad-8 flush: .word nest .word limit .word first .word mins .word bbuf .word lit .word 4 .word plus .word slash .word zero .word pdo fl1: .word lit .word ^x7FFF .word buffe .word drop .word lupe .word fl1 .word semis .byte ^x84 ; task .ascii /TAS/ .byte ^xCB .word flush-8 task: .word nest .word semis fend: . = ^xF000 .end forth