IMD 1.16: 31/05/2007 19:54:39 FOGCPM.106 --FOGCPM106F83 COM F83 COM?-07-00 86 CLOCK BLK` !"#$%&CPU8080 BLK'()*+,-./0123456CPU8080 BLK789:;<=>?@ABCDEFCPU8080 BLKHGHIJKLMNO-CPM106 DOC EXPAND80BLK(PQRSTEXTEND80BLKUVWXYZ[\]^_`abcdEXTEND80BLKpefghijklmnopqrMETA80 BLKstuvwxyz{|}~META80 BLKMETA80 BLKMETA80 BLKThis is the disk name. ".. o g^#VFORTȅ+^N_^h^R{*4+p+q"4KB EXIQ*4N#F#"4 HUNNESQ*4+p+q"4  `U{X.*^#V*s#r^#V ^#V* (LIT o g  -BRANC`iN#F  ?BRANC} *4"4  (LOOP*44#4*4s#r (+LOOP9*4^#V|L!! -(DO6w%Bw%%%i U(?DO6 ` %w%Bw%%%i BOUND6di>NEXԝ EXECUTzPERFOR^#V^#V͋GNOO# PAUS2 =*4^#V#~#fo T*4@((LEAVEl*4####N#F#"4 `(?LEAVE|l ^#V 7s#r Cn& Cs CMOV`ix~#  CMOVE`i + +x~+  SP)!9 !SP: NRPI*4 ARPY"4 DROk bDUy 2SWAЉ OVEҙqTUC˪QNIк RO-ROFLIcj ?DU6wwiR*4^#V#"4  >'*4++"4s#r  R?*4^#V PICT)9^#V 8ROL6%=R'wB4iiANċ{ozg Oҟ{ozg KXOҴ{ozg `NO}/o|/g TRUŝFALSŝ! ! CSE~w CRESE{/_~w CTOGGL3~w 'OD!í=OFV!íNf NEGATy+z/W{/_ ABӞ|y `+~w#~w n2) 2|g}o U2|g}o 8&)))  16# 2D## /1S+ =2a++ !)t)| lLUMD}ggxDgJ UlgU*6i_|g{|g{)Ҵ_|g{,! UM/MO`i}||ejkW\a 0}0))"0:|30W>o>g! S>c !zn +!9 DAB| |E "s D2 {_zW}o|g" D2 |g}ozW{_" D6C  i"[ ?DNEGAT6' C i# D06i# D6 i# DU6 % 5 x3 5 i# D6R`R Z ii#9 D6 > i#^ DMI6 c  i#m DMA6 >  i$ *6 % i$M/MO6 w% %%z =' w Q=ii$ MU/MO6%=%i% 6ii% /MO6%a  i%9 6@ i% MO6@ ii%+ */MO6%  i%l *6t i& TOӦ&\ ENTR٦& LIN˦&N SP& RP& DЦ & #OUԦ & #LINŦ& OFFSEԦ& BASŦ& HLĦ& FILŦ& IN-FILŦ& PRINTINǦ'+ EMI' SC{'; PRIO{!'Y STAT{'s WARNIN{'e DP{' R{' LAS{w' CS{' CURREN{!' #VOCӝ' CONTEX{!!Z0( 'TI{( WIDT{( VOC-LIN{wN(BL{(+>I{{( SPA{(C#TI{(L END{)7B̝ )jBӝ)uBEL̝)PCAP{)FIḶ`ixʵ} é )]ERAS6i)BLAN6oi)COUN^#) LENGT^#V)MOV6 #'ia{ *UP<})o *4UPPERzc~)w#T *HER6 i*hPA6oPdi*H-TRAILIN6w dQoxQi+COMi`x~# !! ! ,CAPS-COMi`x9~)O~)&# 6/!2!  ! ,COMPAR6\^i-BDOkM&o -bBIOӄ*BK&o -y(KEY?6Oi-(KEY60i-(CONSOLE60i i.BKEY.KE.C{.PR-STA6i.(PRINT60!5i i.)(EMIT6F nw3 i. CRL6 S  S T i.OTYP6S ii.tSPAC6oS i.SPACE6 i.{BACKSPACE6zS i.BEE6S i/BS-I6iw1Qz3S i/(DEL-IN6iw\QzS z^S i/BACK-U6iwwi/dRES-I6q&Reseti/9P-I6iF F i0CR-I6iJoS i0(CHAR6 S d4i0CHA0DEL-ID0C{0CC-FORT{nn1EXPEC6wJRwow dw`t ii1TI6i1_QUER6PhJW1T=Ti2#BUFFERӝ2B/BUƝ2B/REÝ2REC/BL˝2B/FC*2DISK-ERRO{2=LIMIԝ2/>SIZŝ*2^FIRSԝ2INIT-R2l>BUFFER6tfi2>EN6t_i2BUFFER6$di2>UPDAT6di3READ-BLOC=3WRITE-BLOCp3.FIL6'@dS $: d$.i3 FILE6% i3SWITC6% 5 % 5 i3PDOӅ+x3>344)3!FILE6w% 5 i3DISK-ABOR6$ in &i3?DISK-ERRO6wJ$ Disk errorii4FCB{ 4CLR-FC6w74 i4)SET-DM6iii4RECORD6!di4MAXREC6&di4uIN-RANG6wiwJB$ Out of Rangei4_REC-REA6w!ii4REC-WRIT6w"ii5GSET-I6wO )/ id)i5FILE-REA6\] QwidE i51FILE-WRIT6\ Qwidx i5cFILE-I6=,p,i6UCAPACIT6% 4i6tLATEST6JT d O  dii6zABSENT64\Si ;O M ;jO3w%wddl i7UPDAT6Bi7DISCAR6i7MISSIN6_'_Tddwd$i7(BUFFER60#?di7ABUFFE6% 'i7(BLOCK6'8wdTi7CBLOC6% bi7IN-BLOC65 bi8EMPTY-BUFFER6tX4$t\wBd  dd i8SAVE-BUFFER6\Xw4Twd'NwwdTd&ii8FLUS6ii8^VIEW6% (di9FILE-SIZ6w#iiii9DOS-ERR6`i9OPEN-FIL65 wi$ Open errorwQi9DOS-FC\9XDEFAUL6w5 w% 34oxJ i9(LOAD6% %1%=%=T15 % (-=1i9NLOAW:DIGIԨ{0  _:DOUBLE6 4Oi: CONVER64w% % i   ii;(NUMBER?6w4-`w% w,/! y [C o`i;vNUMBER6; ij9ii;-(NUMBER6}$i;NUMBE<HOL6  i<<6 i<#6  i<)SIG6'U-i<@6   yd0di<Y#6] i<HE6 i<DECIMA6 i<OCTA6 i=(U.6.i=U6i=U.6%i=(.6wG.i=6$i=:.6%$i=(UD.6.i=UD6ki=wUD.6%ki=c(D.6z G.i=D6i=D.6%i >SKI`iz ~#>SCA`iz/~# ?/STRIN6di?PLAC6 4ii?R(SOURCE61 Wi?4SOURCw?lPARSE-WOR6%=>=%wOd=i?PARS6%=>%wO=i@'WOR6oi@ WOR6 Z wdoi@J>TYP6i@H .6)P i@6) i@w \6dBiA TRAVERSť > A DONE6{ xddTiAd FORTH-86+TiB N>LIN6_iB L>NAM6BiB BODY6_iB !NAME6 4iB LINK6!$!iB!>BOD6BiBB!>NAM6Q iBR!>LIN6Z! iBh!>VIE6p!_iBz!VIEW6B8!iC0!HASȧ!#~o&) C!(FIND!|##?!#!!###~@! ^#V|!D' #THREADӝD!FIN6wr"m T \n"i ;dwj"wm m `\"ij"!!w0"~"idB!iD"?UPPERCAS6"wPiD!DEFINE6o. ""iE"?STAC6' q&Stack Underflow'q&Stack OverflowiE"STATUEINTERPRE6""(#4#4#i #iF #ALLO6 iF"6oH#iF"C6oH#iF@#ALIG6iFw#EVE6iFd#COMPIL6wB%V#iF#IMMEDIAT6@ iFR#LITERA6#V#iF#DLITERA6##iF#ASCI6o. 4{ $#iF#CONTRO6o. 4{ ;$#iG$CRAS6q& Uninitialized execution vector.iG?$?MISSIN6$ q& ?iGr$6"}$iG$['6$#iG$[COMPILE6$V#iG#("6 d%iG$(."6 d%iG$,6" Z4H#iG".6#$$iG%6#$$iH%%FENC{X_H$TRI6 "\t%  h%X%BT% iHC%(FORGET6w=%q& Below fencew% %%w%w% "J%%i iH5%FORGE6o. "w !!}$!%iI$WHER!I&?ERRO*&Iz%(?ERROR6`&%% 8F T1P&=1 &Q-b& iI&(ABORT"6=&d%iI#ABORT6#q&$iI&ABOR6q&iJ&?CONDITIO6q&Conditionals WrongiJ%>MAR6oV#iJ&>RESOLV6oiJf&MAR6&iJ''?>RESOLV6&&iJ:'?*6{ TiN)6{ B""w*8**V#*i*#*i# *iN)6a)  L))*)6Nv*6t)#i)z*iO*RECURSIV6)iO*CONSTAN6L)V#)O*VARIABL6L)V#){OX*DEFE6L)G$V#)O%+VOCABULAR6L) "\w+V#o+o%V#%.*k iO>+DEFINITION6  iPV+2CONSTAN6L)V#V#.*kO iP+2VARIABL6+.*kiP*AVO{!P+COD6L))ow_ +)iPEND-COD6+ )iQ+#USE{Q+USE҅+,V,,h,*QALLO6;,iQCREAT6L);,V#)QVARIABL6q,^,iQDEFE6,)R+>I6ww`w`i,J!d,J!iR+(IS6=,B%iRA,I6{ -#,-$,iS,RU6{ D-*{ @-#F-#iS-QUI6 1Tz* W#(-{ }-$ oka-iS"-BOO^S3,WAR6q& Warm StartiS-COL6-Q-iTJ-INITIA̝T-O6-iT-STAR6iT-BY6o4$Pagesii!-*."Z"v"4͓8"͓!-Z.X_) _vvXW,DEPT6' iW-.6..\..;QR ..$Empty iW..I6w4w/wS /_/4w. iWx.DUM6\a/wO\Y/wO4K/75/iiX.RECURS6 $!V#i -C/̝@ &/L/SCҝ /6=w/b =i /(6{ i /6>i /?ENOUG6.Qq&Not enough Parametersi /THR6/40;0i /+THR61d1d0i ---6=T1i g/ROOԅ+1f0l1BR, ALS6 wB _i ONL6X0J! Q dX0i 0SEA6$J!  i PREVIOU6 wB _ _dTi FORT6i 0DEFINITION6+i 0ORDE6$ Context: \N1wH1!Z!.B81i$ Current: !Z!.i 0VOC6%w "!Z!.wy1ii FCB{F83 COM@a=>?@ABCDEFGHIa 1RESE6 iii CLOS6iq& Close errori 1SEARCH6ii 2SEARC6ii DELET6ii 1REA6iq& Read errori 2WRIT6iq& Write errori MAKE-FIL6iq&Can't MAKE File i 32(!FCB6w7w4 %4:`2@=>4\83w.`$3;d03 443 i 2!FC6o. Y3 P2i j2SELEC6iii 2HEADE! a3SAV61wE3w<2iw233;Qwr2731i ;0MOR6/w$% 3;L 3% 1i 0CREATE-FIL61wwE323i H2.NAM6 /74 / d4 di /DI6$ ????????.???12Q12'41'2w4ii [4DRIVE6iAdS $: i 3A6j3i Q0B6j3i 4FILE6=L)=ow7H#E3.*ki 3?DEFIN6="5J!%5i=4i 4DEFIN6 5ii 3OPE6 5i 4FRO6 55 i <5SAVE-SYSTE6o3i O5VIEW-FILE{5#6_66 5VIEW6 5 (d!5di d5KERNEL80.BL4KERNEL80BLK 4EXTEND80.BL4EXTEND80BLK 5CPU8080.BL4CPU8080 BLKG 6UTILITY.BL4UTILITY BLKz{|}~7o0)5LABE6L))i06DOES-OН06DOES-SIZŝ06DOES6w6d6`i0C6#,i0,INI6i07Ci#0V#037?>MAR0'0H7?>RESOLVF'0W7?7HPUSȝ 07DPUSȝ0&70x7WPUSȝ007Ý07ĝ07ŝ07ɝ07I07ם07W07IН08IP07ȝ0'8̝08͝018PSם08SН0Q8ӝ0;81M6L)87.*k87i072M6L)87.*kd87i0\83M6L)87.*k$d87i0E84M6L)87.*k8787i0f85M6L)87.*k87B7i08NOt808HLt8v08Dt808Et808RLt809RRt80$9RAt80/9RAt809PCHt80E9XCHt80:9REt80]9RNt80h9Rt80s9RNt80}9Rt808CMt8/09STt8709CMt8?09SPHt80Q9XTHt809RPt809RPt809Rt809DAt8'09ADč809ADÍ809SU80 :SB80:AN809XR80:OR808:CMЍ80C:STAب80":INҨ80Z:INب80-:DAĨ8 0p:DCب8 0{:POШ80:PUSȨ809RSԨ80:DCҨ80:LDAب8 0N:OU80e:I80:AD80:AC80:SU80:SB80:AN80:XR80:OR80;CP80!;SHL8"0,;CAL80 ;LHL8*08;ST820D;LD8:0:JM80f;JN80q;J80|;JN80;J80;JP80;JP80;J80;J80P;C00;C0<0;Cӝ0[;00;0<0;Pŝ0<00 <0>0;NO6i0"?LIN6 d-@U@@i@3@?C6;@i@#@.SC6$Scr # _ /Ii@@LIS6/w_ p@/\@;Ow;// d/P @ii@@TRIA6 S R / \@;@@i@i@.LINE6wb AwO/P i@?INDE6/4\OA; AGAi@1AIN6w A4]Aii@@LARGES6\A A wBAii@Y@WORD6@ o "o "yAwAw!w;@.AOA i@1WORD6Ai@A#TIME{@oATIME6BBDBBHB=Ti@UAMAN6aB=Ti@A:6)o%6V#a)*= i@eB6_ JTi@B6_ JTi@ B6_ @i@LBESTABLIS6% l i@B(COPY6 diBi@BCOP6fBfi@B@VIE6!wwq&entered at terminal.R i@BVIE6$CC5d$is in J!$screen >C$may be in current file: I$screen w>@i@CHOPPE{@BU/{@CCONVEY-COPB@CHO6Ci@WC.T6>$to w>i@C(CONVEY6PDwwCd DCCd4Dfi@CCONVE6fC'yD4Dw4C@ %,DD,DDii@!DT6o. iCi @DFOUN{ @VDSCAN-1S6DiDi @DSEARC6DT% ?ZE4R=%=DwFE% LDEDBi%wTE> E  Di @DDELET6%=w8E w=ddi @CINSER6%=w=di @DREPLAC6i @EBLOO @E-LIN! @EAFOk  i @hEDAR&FOk T Ti @EEDITO҅+VRRR3P@ @.SCREEO @AUT+# @^FEDITING{ @CHANGE{ @mFINSTAL6xFFXFeFm0xFBFTJTi@~FC/SCҝ@TO6 Ti@F6 dFb i@F6F// Fi@FCURSO6 i@FLINE6G/R i@GCOL6G/b i@/G+6#GdFi@BG'STAR6_ i@SG'CURSO6\GGdi@hG'LIN6rG6Gi@~G#AFTE6/6Gi@G#REMAININ6 Gi@G#EN6G6Gdi@FMODIFIE6FBi@GEOӝ^@G?TEX6%GwH=/4=ZH i@GC/PAĝT@&H'INSER6.Hdi@4H'FIN6>H.Hdi@JH'VIDE6RH.Hdi@NF.FRAME6$'$'i@sH.BUF6$I >H}H$F RH}Hi@^H?MISSIN6HiRH}H$ not found Q-i@HKEE6G/>HZi@H6RH.H>HRH.H>H.Hi@H6i@I'C#6rGGGi@G(I6>HG*Ii@6I(TILL6RHG*IDHi@#I'F6RHdi@GID-LEΝ @uII{ @cISTAM6I\G/d~IQ~IQi@I?STAM6FIIFTi@I6HGiG/Gi@I6/FG/GEIi@I6HGG/qEGi@ISPLI6/ rGGEGi@HJOI6G/d/*IEi@?JWIP6\G Gi@J6q&Use G !i@vJ6// d/>HZ/wFJ/Fi@]JBRIN64\Jw;JJii@JFIND6RHGrGGDi@J6JHiIFi@J6/J)KiIFOi_ \hKBFRHrGGDWKiIFijYKiq&Break!7KHi@J6RHwwF*IqEi@)J6KrKi@K6rKIi@KTIL6*ISIiIqEi@K6*ISIqEi@KK6rGSIiI>HZi@KD؝@KDٝ@K.LIN6#GOG6GP ^S rGGP i@KREDISPLA6KdFwOw// \Gd/> Ei@KCHANGED6// w\GdgHd/i@L.AL6JLKFp@ EI/\L;cLL;(LL\GgH FKFEF Ti@nKEDIT-A6G/@ KdKdFi@}LNE6/\>M;FL=TJ2MI8M;(LjXFMXFi@XLGET-I6I~IM$Enter your ID: ~I\M.S yM~II~Ihi@FDON6xFM0xFT_ /'M$Un$modifiedIIJTeFO i@7FE6MMF@FgH "FLi@MEDI6/_ FMi@EFI6=$C0N5dM=Ki@M(WHERE6J`NMQF RHZi@DSHADOׅ+NsOu\JF@DISPLACEMEN64i@{N(>SHADOW6N NdNi@>SHADO6% Ni@N>IN-SHADO65 Ni@M6_ N_ i@COP6f BNNBfi@OCONVE6 _DNNNNC_Di@&O6 JN/wFNJINi@NBRIN64\Ow;UOOii@K(AT6 i@O(BLOT6/i@O(DARK6\OOi@M.DUM6Ki@ODUM6#J!eFl O,XFO,FO,E!,EO,"Fi@DMSMAR6{J!eFl L,XFi@LANSI-A6 S [S 4O;S 4OHS i@WPANSI-BLO6iS $[Ki@PANSI-DAR6S $[2Ji@PANSI--LIN6S $[1Mi@PANS6;PaP,FP,"FP,EP,Ei@OH19-A6S YS  dS  dS i@"QH19-DAR6S ES i@MQH19-BLO6iS KS i@jQH19--LIN6S MS i@QHEAT6;P+Q,FXQ,"FQ,EuQ,Ei@QTVI-A6S =S  dS  dS i@QTVI-BLO6iS TS i@RTVI-DAR6S i@!RTVI--LIN6S RS i@8RTELEVIDE6;PQ,F,R,"FDR,E R,Ei@PQUM6bRi@OFALC6bRi@N.6]].i@Q-i @RMA6 TBdThTi @bTCASE6+)*.*kTi!@TASSOCIATIVE6+.*kww\9UB `5U i;jU i"@GT(SEEX"@.WOR6wZ!.Bi"@MU.INLIN6UUw>Bi"@eU.BRANC6UUw>Bi"@U.QUOT6UUUUi"@U.STRIN6UU di#@U.(;CODE6UU7U$DOES> Uii#@U.UNNES6$; ii#@U.FINIS6UUii$@EXECUTION-CLAS U7\#$q&.*i$)%@V.EXECUTION-CLASToUUUUUUUUUUVUUVUUi&@YV.PF6J!_@w7VlVwVii&@V.IMMEDIAT6Z!@V$ IMMEDIATEi'@V.CONSTAN6wJ!/$ CONSTANT Z!.i'@V.VARIABL6wJ!>$ VARIABLE wZ!.$Value = J!/i'@W.6$: wZ!.Vi'@GW.DOES6$DOES> !Vi'@cW.USER-VARIABL6wJ!/$USER VARIABLE wZ!.$Value = ,/i(@W.DEFE6$ DEFERRED wZ!.$IS ,GUi(@W.USER-DEFE6$USER DEFERRED wZ!.$IS ,GUi(@W.OTHE6wZ!.wJ!`SXi$is CodeOw7cXlWiO $ is Unknowni)@DEFINITION-CLAS U6{)@&X.DEFINITION-CLASTLWVWWWW/Xi*@vX((SEE)6wwXXVi*@TSE6$GUi,@TEPSO6S i,@XINIT-P!,@SFOOTIN[,@?UL/PAGŝB,@'YLOGϝ,@X#PAG{,@6YPAG\YYkKY T Ti,@YFORM-FEE6 S  S i,@QY(PAGE60Y YYi,@Y(SEMIT6F Y3Yi,@SCR#{ALLOT #i -@XTEXT6wo~! Z OZi-@YP6w?1Zi=YYYwdi-@X2P6wO// %=d/d/d4/i-@GZ2SC6O=wO\Z ;MZZ i.@ZP-HEADIN6$Page# KY/Ii.@ZP-FOOTIN6:$Forth 83 ModelXYi/@ [PR-STAR6F B TY,S YTKYYi/@:[PR-STO6X,S F Ti/@g[PR-PAG6ZYTYB\[wdZB[i!Yi/@[PR-S-PAG6ZYTYB\[wBZd[i!Yi/@[PR-FLUS6Yw.\Y*\!Z\=Y!ZOi0@CYSHO6E[4g\;YS\;!ZY`c\[G\\o\[q[i0@QOSHO6E[4\;Y\;!Z;N!ZY`\[\\\[q[i0@YLISTIN6Q|\i2@>L.I6w.w$!Qdi2@t=SLO{2@=RE{2@\(DEBUG6M=A=5= >i2@\'UNNES64wi`:]i3@]TRAC6%.Z! \\]\T]T$ --> :C`]\\F`]i(-]]Q`q&Unbugi >i3@\DEBU6$_w8]]i3@sYRESUM6]B >i5@]TASK6L) o;,>o>wodw d o }>>o;,do }>o>H#i5@4\SET-TAS6w }>__ }> }>i5@YACTIVAT6s^>i6@]BACKGROUND6 ^o>_s^a)*i ^HELL6$8080 Forth 83 Model$Version 2.1.0 Modified 01Jun84 0m0+i ^MAR6L).*k%+i 4_EMPTA_ B:F83.COM M BL4HUFFMAN BLK OZ_D+6wO % l iN_ARRA6L)H#.*kdi^2ARRA6L)/ H#.*kdi_0OR6Oi_HAPP`kw4`T$ ...Working <`B  i_READING{_IO-ARRA6L)wV#H#.*kwQ``i4\;Y\;!Z;N!ZY`\[\\\[q[i0@YLISTIN6Q|\i2@>L.I6w.w$!Qdi2@t=SLO{ \ System Support 1 Load screen 13Apr84map1 4 +THRU CR .( Clock Loaded ) EXIT \ Months and Days 07Apr84map: "ARRAY ( compile: string-length -- ) ( run: -- a n ) CREATE C, ASCII " WORD COUNT >R HERE R@ MOVE R> ALLOT DOES> COUNT >R SWAP R@ * + R> ; 3 "ARRAY "MONTH "JanFebMarAprMayJunJulAugSepOctNovDec" 3 "ARRAY "DAY "SunMonTueWedThuFriSat" HEX 5A CONSTANT CLK-C CLK-C 1+ CONSTANT CLK-D : CLK@ (S n -- nib ) 10 OR CLK-C PC! CLK-D PC@ ; : CLK! (S n a -- ) 40 CLK-C PC! 40 OR DUP CLK-C PC! SWAP CLK-D PC! DUP 60 OR CLK-C PC! CLK-C PC! ; : CLOCK? (S -- f ) 0 CLK@ 0F0 AND 0= ; DECIMAL  \ Clock 07Apr84map: CLK# (S n -- ) CLK@ 48 OR HOLD ; : (DATE) (S -- a n ) <# 11 CLK# 12 CLK# 9 CLK@ 10 CLK@ 10 * + 1- "MONTH DUP NEGATE HLD +! HLD @ SWAP CMOVE 7 CLK# 8 CLK# 0 0 #> ; : (TIME) (S -- a n ) 0. <# 0 CLK# 1 CLK# ASCII : HOLD 2 CLK# 3 CLK# ASCII : HOLD 4 CLK# 5 CLK@ 3 AND 48 OR HOLD #> ; : ?AM/PM (S -- ) 5 CLK@ DUP 8 AND 0= IF 4 AND IF ." PM" ELSE ." AM" THEN ELSE DROP THEN ; : DAY (S -- ) 6 CLK@ "DAY TYPE SPACE ; : DATE (S -- ) (DATE) TYPE SPACE ; : TIME (S -- ) (TIME) TYPE SPACE ; : NOW (S -- ) CLOCK? IF DAY DATE TIME ?AM/PM THEN ; \ Set Time 07Apr84map: INPUT? ( -- [n] f ) QUERY BL WORD NUMBER? NIP DUP 0= IF NIP THEN ; : SET-TIME (S -- ) CR ." Day of week? ( 0 to 6 ) " INPUT? IF 6 CLK! THEN CR ." Day of month? " INPUT? IF 10 /MOD 8 CLK! 7 CLK! THEN CR ." Month? " INPUT? IF 10 /MOD 10 CLK! 9 CLK! THEN CR ." Year? " INPUT? IF 10 /MOD 12 CLK! 11 CLK! THEN CR ." Hour? " INPUT? IF DUP 12 > IF 12 - 4 ELSE 0 THEN SWAP 10 /MOD ROT OR 5 CLK! 4 CLK! THEN CR ." Minute? " INPUT? IF 10 /MOD 3 CLK! 2 CLK! THEN 0 1 CLK! 0 0 CLK! CR ." Hit any key to start." CR KEY DROP 0 CLK-C PC! ; \ Automatic EDITOR ID 10Apr84map: (WHO) (S -- ) " map" ; : WHO (S -- ) (WHO) TYPE SPACE ; : SET-ID (S -- ) CLOCK? IF (DATE) [ EDITOR ] ID SWAP CMOVE (WHO) ID 7 + SWAP CMOVE THEN HELLO ; ' SET-ID IS BOOT    \ Months and Days 07Apr84map"ARRAY ( compile: string-length -- ) ( run: -- a n ) Defining word for string arrays. "MONTH Array of the names of the months. "DAY Array of the names of the days of the week. CLK-C CLK-D addresses of the clock IO ports. CLK@ get a byte from the clock. CLK! give a byte to the clock. CLOCK? test for presence of the clock. \ Clock 07Apr84mapCLK# (S n -- ) prefix a number from the clock to the output.(DATE) (S -- a n ) Build an output string representing the date. Leave its address and length. (TIME) (S -- a n ) Build an output string representing the time. Leave its address and length. ?AM/PM (S -- ) If in 12 hour mode, print AM or PM. DAY (S -- ) print the name of the day. DATE (S -- ) print the date. TIME (S -- ) print the time. NOW (S -- ) if there is a clock, print the day, date, and time. \ Set Time 07Apr84mapINPUT? ( -- [n] f ) wait for user to type a number. Leave number and true, or just false if no input. SET-TIME Set the clock. Prompt for input. Entering just a Carraige Return will leave the present value unchanged. \ Automatic EDITOR ID 07Apr84map(WHO) leave address and length of string containing user id. Change this if your initials happen to be different. WHO print user id. SET-ID This replaces the usual cold boot routine. After the usual HELLO, if there is a clock, the EDITOR ID is set to contain the present date and user initials. Set BOOT to use SET-ID. If the executable image of the system is now saved, then when it is run COLD will use SET-ID. \ The Rest is Silence 26Sep83map************************************************************* ************************************************************* *** *** *** Please direct all questions, comments, and *** *** miscellaneous personal abuse to: *** *** *** *** Henry Laxen or Michael Perry *** *** 1259 Cornell Avenue 1125 Bancroft Way *** *** Berkeley, California Berkeley, California *** *** 94706 94702 *** *** *** *** (415) 525-8582 (415) 644-3421 *** *** *** ************************************************************* *************************************************************  \ Load Screen for 8080 Dependent Code 07Apr84map ONLY FORTH ALSO DEFINITIONS DECIMAL 3 LOAD ( The Assembler ) 9 LOAD ( The Low Level for the Debugger ) 15 LOAD ( The Low Level for the MultiTasker ) 18 LOAD ( The Machine Dependent IO words ) CR .( 8080 Machine Dependent Code Loaded )  \ 8080 Assembler Load Screen 09Apr84mapONLY FORTH ALSO DEFINITIONS 1 4 +THRU ONLY FORTH ALSO DEFINITIONS EXIT The 8080 Assembler is largely due to John Cassady, who recently published it in Forth Dimensions. It implements the full 8080 instruction set as well as structured conditionals. To create an Assembler language definition, use the defining word CODE. It may, but does not have to be, terminated with C;. How the assembler operates is a very interesting example of the power of CREATE DOES> Basically, the instructions are categoriezed and a defining word is created for each category. When the mnemonic for the instruction is interpreted, it compiles itself. \ 8080 Assembler Defining Words & Registers 11Apr84map: LABEL CREATE ASSEMBLER ; 205 CONSTANT DOES-OP 3 CONSTANT DOES-SIZE : DOES? (S IP -- IP' F ) DUP DOES-SIZE + SWAP C@ DOES-OP = ; ASSEMBLER DEFINITIONS : C; END-CODE ; : INIT ; DEFER C, FORTH ' C, ASSEMBLER IS C, DEFER , FORTH ' , ASSEMBLER IS , DEFER ?>MARK FORTH ' ?>MARK ASSEMBLER IS ?>MARK DEFER ?>RESOLVE FORTH ' ?>RESOLVE ASSEMBLER IS ?>RESOLVE DEFER ?NEXT 1- CONSTANT HPUSH >NEXT 2- CONSTANT DPUSH 7 CONSTANT A DPUSH CONSTANT WPUSH 0 CONSTANT B 1 CONSTANT C 2 CONSTANT D 3 CONSTANT E 0 CONSTANT I 1 CONSTANT I' 2 CONSTANT W 3 CONSTANT W' 0 CONSTANT IP 1 CONSTANT IP' 4 CONSTANT H 5 CONSTANT L 6 CONSTANT M 6 CONSTANT PSW 6 CONSTANT SP 6 CONSTANT S : 1MI CREATE C, DOES> C@ C, ; : 2MI CREATE C, DOES> C@ + C, ; : 3MI CREATE C, DOES> C@ SWAP 8* + C, ; : 4MI CREATE C, DOES> C@ C, C, ; : 5MI CREATE C, DOES> C@ C, , ;  \ 8080 Assembler mnemonics 09MAR83HHLHEX 00 1MI NOP 76 1MI HLT F3 1MI DI FB 1MI EI 07 1MI RLC 0F 1MI RRC 17 1MI RAL 1F 1MI RAR E9 1MI PCHL EB 1MI XCHG C9 1MI RET C0 1MI RNZ C8 1MI RZ D0 1MI RNC D8 1MI RC 2F 1MI CMA 37 1MI STC 3F 1MI CMC F9 1MI SPHL E3 1MI XTHL E0 1MI RPO E8 1MI RPE F8 1MI RM 27 1MI DAA 80 2MI ADD 88 2MI ADC 90 2MI SUB 98 2MI SBB A0 2MI ANA A8 2MI XRA B0 2MI ORA B8 2MI CMP 02 3MI STAX 04 3MI INR 03 3MI INX 09 3MI DAD 0B 3MI DCX C1 3MI POP C5 3MI PUSH C7 3MI RST 05 3MI DCR 0A 3MI LDAX D3 4MI OUT DB 4MI IN C6 4MI ADI CE 4MI ACI D6 4MI SUI DE 4MI SBI E6 4MI ANI EE 4MI XRI F6 4MI ORI FE 4MI CPI 22 5MI SHLD CD 5MI CALL 2A 5MI LHLD 32 5MI STA 3A 5MI LDA C3 5MI JMP C2 5MI JNZ CA 5MI JZ D2 5MI JNC DA 5MI JC E2 5MI JPO EA 5MI JPE F2 5MI JP FA 5MI JM \ 8080 Assembler Branches 08Apr84mapDA CONSTANT C0= D2 CONSTANT C0<> D2 CONSTANT CS C2 CONSTANT 0= CA CONSTANT 0<> E2 CONSTANT PE F2 CONSTANT 0< FA CONSTANT 0>= : NOT 8 [ FORTH ] XOR ; : NEXT >NEXT JMP ; : MOV 8* 40 + + C, ; : MVI 8* 6 + C, C, ; : LXI 8* 1+ C, , ; : IF C, ?>MARK ; : THEN ?>RESOLVE ; : ELSE C3 ( JMP ) IF 2SWAP THEN ; : BEGIN ? VARIABLE CNT VARIABLE 'DEBUG ASSEMBLER LABEL SSUB ( HL = HL - DE ) L A MOV E SUB A L MOV ( LOW BYTE ) H A MOV D SBB A H MOV ( HI BYTE ) RET LABEL ?RANGE ( COMPARE DE WITH LOW & HI ) ( RETURNS CS IF IN RANGE ) LHLD SSUB CALL CMC RET  \ Subroutine to Patch NEXT 26MAY83HHLASSEMBLER HEX LABEL FNEXT 0A A MVI >NEXT STA ( B LDAX ) 03 A MVI >NEXT 1+ STA ( B INX ) 6F A MVI >NEXT 2+ STA ( A L MOV ) RET LABEL DNEXT B LDAX B INX A L MOV B LDAX B INX A H MOV HERE M E MOV H INX M D MOV XCHG PCHL CONSTANT DNEXT1 DECIMAL \ Debug version of Next 04Apr84mapASSEMBLER LABEL DEBNEXT B D MOV C E MOV ?RANGE CALL CS IF CNT LDA A INR CNT STA 2 CPI 0= IF A XRA CNT STA FNEXT CALL B PUSH 'DEBUG LHLD DNEXT1 JMP THEN THEN DNEXT JMP \ Patch and Fix NEXT 13Apr84mapHEX CODE PNEXT C3 A MVI >NEXT STA DEBNEXT H LXI >NEXT 1+ SHLD >NEXT JMP C; FORTH DEFINITIONS CODE UNBUG (S -- ) BUG FNEXT ASSEMBLER CALL >NEXT JMP C; DECIMAL  \ Load Screen for the MultiTasker 18APR83HHLONLY FORTH ALSO DEFINITIONS 1 2 +THRU CR .( MultiTasker Low Level Loaded ) ONLY FORTH ALSO DEFINITIONS EXIT The MultiTasker is loaded as an application on top of the regular Forth System. There is support for it in the nucleus in the form of USER variables and PAUSEs inserted inside of KEY EMIT and BLOCK. The Forth multitasking scheme is co-operative instead of interruptive. All IO operations cause a PAUSE to occur, and the multitasking loop looks around at all of the current task for something to do. \ Multitasking low level 30Sep83mapCODE (PAUSE) (S -- ) B PUSH ( IP to stack ) RP LHLD H PUSH ( RP to stack ) 0 H LXI SP DAD XCHG ( SP in DE ) UP LHLD E M MOV H INX D M MOV H INX ( SP to USER area ) H INX PCHL ( Jump to USER+3 ) C; CODE RESTART (S -- ) -3 H LXI D POP D DAD UP SHLD ( Set UP to new user ) M E MOV H INX M D MOV XCHG SPHL ( Restore stack ) H POP RP SHLD ( Return stack ) B POP ( Restore IP ) NEXT C; HEX C3CF ENTRY ! ( RST1 then JMP ) DECIMAL ENTRY LINK ! ( only task points to itself ) \ Manipulate Tasks 12Oct83map: LOCAL (S base addr -- addr' ) UP @ - + ; : @LINK (S -- addr ) LINK @ ; : !LINK (S addr -- ) LINK ! ; : SLEEP (S addr -- ) 0 SWAP ENTRY LOCAL C! ; : WAKE (S addr -- ) 207 SWAP ENTRY LOCAL C! ; : STOP (S -- ) UP @ SLEEP PAUSE ; : SINGLE (S -- ) ['] PAUSE >BODY ['] PAUSE ! ; : MULTI (S -- ) 195 ( JMP ) 8 C! ['] RESTART @ 9 ! ['] (PAUSE) @ ['] PAUSE ! ; \ Load Screen for Machine Dependent IO Words 04Apr84mapONLY FORTH ALSO DEFINITIONS 1 1 +THRU CR .( Machine Dependent IO Words Loaded ) ONLY FORTH ALSO DEFINITIONS EXIT Since the 8080 has a seperate IO path, we define a Forth interface to it. Use PC@ and PC! to read or write directly to the 8080 IO ports. \ Machine dependent IO words 04Apr84mapCODE PC@ (S port# -- n ) D POP HERE 5 + H LXI ( Sorry ) E M MOV 0 IN A L MOV 0 H MVI HPUSH JMP C; CODE PC! (S n port# -- ) D POP HERE 7 + H LXI ( Sorry again ) E M MOV H POP L A MOV 0 OUT NEXT C;  \ Load Screen for 8080 Dependent Code 26MAY83HHL All of the Machine Dependent Code for a Particular Forth Implementation is factored out and placed into this file. For The 8080 there are 3 different components. The 8080 assembler, The run time debugger, which must have knowledge of how NEXT is implemented, and the MultiTasker, which uses code words to WAKE tasks and put them to SLEEP.   \ 8080 Assembler Defining Words & Registers 11Apr84mapLABEL marks the start of a subroutine whose name returns its address. DOES-OP Is the op code of the call instruction used for DOES> U C; A synonym for END-CODE INIT does nothing for the 8080. Deferring the definitions of the commas, marks, and resolves allows the same assembler to serve for both the system and the Meta-Compiler. \ 8080 Assembler Defining Words & Registers 09MAR83HHL On the 8080, register names are constants. Nearly all instructions fall into the one of the five classes 1MI thru 5MI. \ 8080 Assembler mnemonics 26MAY83HHL Each mnemonic is defined as a member of a class, with an associated op code byte. \ 8080 Assembler Branches 26MAY83HHLIt is convenient to rename some of the branches for use with the structured conditionals. NEXT is a macro which assembles a jump to >NEXT. There are a few special case instructions not handled in the 1MI thru 5MI schema. The structured conditionals make it easier to write correct and understandable code, and reduce the need for forward reference and meaningless labels with silly names.   \ 16 Bit Subtract Subroutine 04Apr84mapBUG The vocabulary that holds the Debugging Words The range of IP values we are interested in CNT is a pass counter. 'DEBUG contains the address of the TRACE routine. SSUB A machine language subroutine that performs a 16 bit subtract. Thank you Intel for making it so simple! ?RANGE A machine language subroutine that sets the carry flag if the IP is in the Range we are interested in. \ Subroutine to Patch NEXT 26MAY83HHL FNEXT A machine language subroutine that Fixes NEXT back to the way it used to be. DNEXT A copy of next that gets exeucted instead of the normal one. DNEXT1 The rest of NEXT \ Debug version of Next 26MAY83HHL DEBNEXT is the debugger's version of next If the IP is between then the contents of the execution variable 'DEBUG are executed. First the IP is pushed onto the parameter stack. The word pointed to by 'DEBUG can be any high or low level word so long as it discards the IP that was pushed before it is called, and it must terminate by callingPNEXT to patch next once again for more tracing. \ Patch and Fix NEXT 26MAY83HHL PNEXT patches Forth's Next to jump to DEBNEXT. This puts us into DEBUG mode and allows for tracing. FIX restores Forth's Next to its original condition. Effectively disabling tracing.   \ Multitasking low level 26MAY83HHL(PAUSE) (S -- ) Puts a task to sleep by storing the IP and the RP on the parameter stack. It then saves the pointer to the parameter stack in the user area and jumps to the code pointed at by USER+3, switching tasks. RESTART (S -- ) Sets the user pointer to point to a new user area and restores the parameter stack that was previously saved in the USER area. Then pops the RP and IP off of the stack and resumes execution. The inverse of PAUSE. Initialize current User area to a single task. \ Manipulate Tasks 12Oct83mapLOCAL Map a User variable from the current task to another task@LINK Return a pointer the the next tasks entry point !LINK Set the link field of the current task (perhaps relative)SLEEP makes a task pause indefinitely. WAKE lets a task start again. STOP makes a task pause indefinitely. SINGLE removes the multi-tasker's scheduler/dispatcher loop. MULTI installs the multi-tasker's scheduler/dispatcher loop. By patching the appropriate INT vector and enabling PAUSE.  \ Machine dependent IO words 04Apr84mapPC@ (S port# -- n ) Fetch the value at the given input port and push it onto the stack. Sorry about the self modifying code!. PC! (S n port# -- ) Write the value to the specified port number. See P@ for apology.  \ The Rest is Silence 04Apr84map************************************************************* ************************************************************* *** *** *** Please direct all questions, comments, and *** *** miscellaneous personal abuse to: *** *** *** *** Henry Laxen or Michael Perry *** *** 1259 Cornell Avenue 1125 Bancroft Way *** *** Berkeley, California Berkeley, California *** *** 94706 94702 *** *** *** ************************************************************* ************************************************************* \ Expand the Huffman encoded files for F83 01May84mapFROM HUFFMAN.BLK OK : PROMPT (S -- ) CR ." To expand your F83 system, make sure this disk" CR ." is in drive A: and that an empty, formatted disk is" CR ." in drive B:. You will need three disks." CR ." When ready, press any key to continue. " HERE 1 EXPECT ( Give user a chance to get out ) ; : WAKE-USER (S -- ) 100 0 DO BEEP KEY? ?LEAVE LOOP ; : SWITCH-DISKS (S -- ) WAKE-USER CR ." Your disk is now full, please" CR ." remove it and insert another empty, formatted disk" CR ." in drive B: and press any key to continue. " HERE 1 EXPECT [ DOS ] 0 25 BDOS RESET SELECT ; --> \ Expand the Huffman encoded files for F83 24Apr84map: HI HELLO CR ." To expand your system, type XYZZY " ; ' HI IS BOOT DEFINE EXPAND80.BLK : XYZZY (S -- ) CR ." This takes a long long long time, and bells will " CR ." ring when you are needed, so I suggest you get it" CR ." started and have a long cool drink." PROMPT EXPAND80.BLK [ DOS ] OPEN-FILE [ FORTH ] 3 LOAD ; : EXPAND CR >IN @ ." Expanding: " BL WORD COUNT TYPE ." into " BL WORD COUNT TYPE SPACE >IN ! EXPAND ; : COMPRESS CR >IN @ ." Compressing: " BL WORD COUNT TYPE ." into " BL WORD COUNT TYPE SPACE >IN ! COMPRESS ; MARK THEN SAVE-SYSTEM RUNME.COM \ Expand the Huffman encoded files for F83 03MAY84HHL THEN EXPAND E80.HUF B:EXTEND80.BLK THEN EXPAND C80.HUF B:CPU8080.BLK THEN EXPAND UT.HUF B:UTILITY.BLK SWITCH-DISKS THEN EXPAND HF.HUF B:HUFFMAN.BLK THEN EXPAND CK.HUF B:CLOCK.BLK THEN EXPAND FX.HUF B:F83-FIXS.TXT WAKE-USER EMPTY ' HELLO IS BOOT SAVE-SYSTEM B:F83.COM CR .( Congratulations, you have a full) CR .( F83 system. May the Forth be with you.) ( These are all of the files that are distributed with a Perry & Laxen public domain Forth system. They will be expanded with this utility. Please be patient. ) \ Expand the Huffman encoded files for F83 24Apr84mapTHEN COMPRESS META80.BLK M80.HUF THEN COMPRESS KERNEL80.BLK K80.HUF THEN COMPRESS EXTEND80.BLK E80.HUF THEN COMPRESS CPU8080.BLK C80.HUF THEN COMPRESS UTILITY.BLK UT.HUF THEN COMPRESS HUFFMAN.BLK HF.HUF THEN COMPRESS CLOCK.BLK CK.HUF THEN COMPRESS F83-FIXS.TXT FX.HUF WAKE-USER \ The Rest is Silence 03Apr84map************************************************************* ************************************************************* *** *** *** Please direct all questions, comments, and *** *** miscellaneous personal abuse to: *** *** *** *** Henry Laxen or Michael Perry *** *** 1259 Cornell Avenue 1125 Bancroft Way *** *** Berkeley, California Berkeley, California *** *** 94706 94702 *** *** *** ************************************************************* ************************************************************* ( Load Screen to Bring up Standard System 07Apr84map) CR .( Loading system extensions.) CR 2 VIEW# ! ( This will be view file# 2 ) WARNING OFF 3 LOAD ( BASICS ) 6 LOAD ( FILE-INTERFACE ) FROM CPU8080.BLK 1 LOAD ( Machine Dependent Code ) FROM UTILITY.BLK 1 LOAD ( Standard System Utilities ) WARNING ON --> \ Load up the system 26May84map: HELLO (S -- ) CR ." 8080 Forth 83 Model" CR ." Version 2.1.0 Modified 01Jun84 " EMPTY-BUFFERS ONLY FORTH ALSO DEFINITIONS DEFAULT ; ' HELLO IS BOOT \ 13 LOAD ( Configuration: change and load as desired. ) : MARK (S -- ) CREATE DOES> (FORGET) FORTH DEFINITIONS ; MARK EMPTY HERE FENCE ! CR .( System has been loaded, Size = ) HERE U. SAVE-SYSTEM F83.COM CR .( System saved as F83.COM ) ( Commenting and Loading Words 16Oct83map) 64 CONSTANT C/L 16 CONSTANT L/SCR : \ ( -- ) >IN @ NEGATE C/L MOD >IN +! ; IMMEDIATE : (S ( -- ) [COMPILE] ( ; IMMEDIATE : ? (S adr -- ) @ . ; : ?ENOUGH (S n -- ) DEPTH 1- > ABORT" Not enough Parameters" ; : THRU (S n1 n2 -- ) 2 ?ENOUGH 1+ SWAP ?DO I LOAD LOOP ; : +THRU (S n1 n2 -- ) BLK @ + SWAP BLK @ + SWAP THRU ; : --> (S -- ) >IN OFF 1 BLK +! ; IMMEDIATE 1 2 +THRU ( Rest of Basic Utilities ) \ The ALSO and ONLY Concept 07Feb84mapCONTEXT DUP @ SWAP 2+ ! ( Make FORTH also ) VOCABULARY ROOT ROOT DEFINITIONS : ALSO (S -- ) CONTEXT DUP 2+ #VOCS 2- 2* CMOVE> ; : ONLY (S -- ) ['] ROOT >BODY CONTEXT #VOCS 1- 2* 2DUP ERASE + ! ROOT ; : SEAL (S -- ) ' >BODY CONTEXT #VOCS 2* ERASE CONTEXT ! ; : PREVIOUS (S -- ) CONTEXT DUP 2+ SWAP #VOCS 2- 2* CMOVE CONTEXT #VOCS 2- 2* + OFF ; \ The ALSO and ONLY Concept 28AUG83HHL: FORTH FORTH ; : DEFINITIONS DEFINITIONS ; : ORDER (S -- ) CR ." Context: " CONTEXT #VOCS 0 DO DUP @ ?DUP IF BODY> >NAME .ID THEN 2+ LOOP DROP CR ." Current: " CURRENT @ BODY> >NAME .ID ; : VOCS (S -- ) VOC-LINK @ BEGIN DUP #THREADS 2* - BODY> >NAME .ID @ DUP 0= UNTIL DROP ; ONLY FORTH ALSO DEFINITIONS \ Load Screen for DOS Interface 07Apr84mapDOS DEFINITIONS 1 6 +THRU FORTH DEFINITIONS CR .( File Interface Loaded ) \S The DOS interface consists of a set of words that access the BDOS functions of DOS, such as making, opening, and deleting files. There is also a word that parses a string and creates a file control block. Finally the word SAVE can be used to save the contents of memory as a DOS file. \ DOS Interface 10Apr84mapCREATE FCB2 B/FCB ALLOT : RESET (S -- ) 0 13 BDOS DROP ; : CLOSE (S fcb -- ) 16 BDOS DOS-ERR? ABORT" Close error" ; : SEARCH0 (S fcb -- n ) 17 BDOS ; : SEARCH (S fcb -- n ) 18 BDOS ; : DELETE (S fcb -- n ) 19 BDOS ; : READ (S fcb -- ) 20 BDOS DOS-ERR? ABORT" Read error" ; : WRITE (S fcb -- ) 21 BDOS DOS-ERR? ABORT" Write error" ; : MAKE-FILE (S fcb -- ) 22 BDOS DOS-ERR? ABORT" Can't MAKE File " ; \ Create File Control Blocks 24Apr84map: (!FCB) (S Addr len FCB-addr --- ) DUP B/FCB ERASE DUP 1+ 11 BLANK >R OVER 1+ C@ ASCII : = IF OVER C@ [ ASCII A 1- ] LITERAL - R@ C! 2 /STRING THEN R> 1+ -ROT 0 DO DUP C@ ASCII . = IF SWAP 8 I - + ELSE 2DUP C@ SWAP C! SWAP 1+ THEN SWAP 1+ LOOP 2DROP ; : !FCB (S FCB-addr ) BL WORD COUNT CAPS @ IF 2DUP UPPER THEN ROT (!FCB) ; : SELECT (S drive -- ) ( DUP 9 BIOS 0= ABORT" Illegal drive " ) 14 BDOS DROP ; \ Save a Core Image as a File on Disk 04Apr84mapDEFER HEADER ' NOOP IS HEADER : SAVE (S Addr len --- ) FCB2 DUP !FCB DUP DELETE DROP DUP MAKE-FILE -ROT HEADER BOUNDS ?DO I SET-DMA DUP WRITE 128 +LOOP CLOSE ; FORTH DEFINITIONS : MORE (S n -- ) [ DOS ] 1 ?ENOUGH CAPACITY SWAP DUP 8* FILE @ MAXREC# +! BOUNDS ?DO I BUFFER B/BUF BLANK UPDATE LOOP SAVE-BUFFERS FILE @ CLOSE ; : CREATE-FILE (S #blocks -- ) [ DOS ] FCB2 DUP !FILES DUP !FCB MAKE-FILE MORE ; \ Display Directory 13Apr84mapDOS DEFINITIONS : .NAME (S n -- ) #OUT @ C/L > IF CR THEN 32 * PAD + 1+ 8 2DUP TYPE SPACE + 3 TYPE 3 SPACES ; FORTH DEFINITIONS : DIR (S -- ) [ DOS ] " ????????.???" FCB2 (!FCB) CR PAD SET-DMA FCB2 SEARCH0 BEGIN .NAME FCB2 SEARCH DUP DOS-ERR? UNTIL DROP ; : DRIVE? (S -- ) 0 25 BDOS ASCII A + EMIT ." : " ; : A: (S -- ) [ DOS ] 0 SELECT ; : B: (S -- ) [ DOS ] 1 SELECT ; DOS DEFINITIONS \ Define and Open files 04Apr84map: FILE: (S -- fcb ) >IN @ CREATE >IN ! HERE DUP B/FCB ALLOT !FCB DOES> !FILES ; : ?DEFINE (S -- fcb ) >IN @ DEFINED IF NIP >BODY ELSE DROP >IN ! FILE: THEN ; FORTH DEFINITIONS : DEFINE (S -- ) [ DOS ] ?DEFINE DROP ; : OPEN (S -- ) [ DOS ] ?DEFINE !FILES OPEN-FILE ; : FROM (S -- ) [ DOS ] ?DEFINE IN-FILE ! OPEN-FILE ; : SAVE-SYSTEM (S -- ) [ DOS HEX ] 100 HERE SAVE ; DECIMAL \ Viewing Source Screens 26May84mapCREATE VIEW-FILES 32 ALLOT VIEW-FILES 32 ERASE : VIEWS (S n -- ) [ DOS ] ?DEFINE 2DUP 40 + ! BODY> SWAP 2* VIEW-FILES + ! ; 1 VIEWS KERNEL80.BLK 2 VIEWS EXTEND80.BLK 3 VIEWS CPU8080.BLK 4 VIEWS UTILITY.BLK \ My normal configuration 07Apr84mapCAPS ON ' EPSON IS INIT-PR ' FORM-FEED IS PAGE ' (WHERE) IS WHERE EDITOR QUME FORTH 5 VIEWS CLOCK.BLK FROM CLOCK.BLK 1 LOAD   ( Load Screen to Bring up Standard System 04Apr84map) This is set so that definitions in this file can be VIEWed. BASICS are needed by everything else. FILE-INTERFACE allows convenient use of files. CPU8080.BLK Contains all of the 8080 machine dependent stuff such as the Assembler, the Debug Utility which patches NEXT, and the MultiTasker, which needs some code words in order to function efficiently. UTILITY.BLK Contains all of the standard utilities that are usually resident in a Forth system, such as the editor, the decompiler, a print utility, etc. \ Load up the system 07Apr84mapHELLO (S -- ) Gives the user the sign on message, making him foolishly believe that he is running an 83 Standard System. It also does all of the one time start up code required, such as relocating the heads and opening the screen file, if any. Load configuration. Personalize here. MARK (S -- ) A Defining word that allows you to restore the dictionary to a known state. EMPTY The current state of the dictionary. ( Commenting and Loading Words 25Jul83map) C/L The number of characters per line. L/SCR The number of lines per screen. \ A comment word. Ignores the rest of the line (S Used for Stack Comments. Behaves just like ( ? Displays the contents of an address. ?ENOUGH (S n -- ) Issue an error message if too few parameters on the stack. THRU (S n1 n2 -- ) Load a bunch of screens. +THRU (S n1 n2 -- ) Load a bunch of screens relative to the current screen. --> (S -- ) Load the next screen. \ The ALSO and ONLY Concept 03Apr84map ROOT A small vocabulary for controlling search order. ALSO (S -- ) Adds another vocabulary to the search order. ONLY Erases the search order and forces the ROOT vocabulary to be the first and last. SEAL Usage: SEAL FORTH will change the search order such that only FORTH will be searched. Used for turn-key applications. PREVIOUS The inverse of ALSO, removes the most recently referenced vocabulary from the search order. \ The ALSO and ONLY Concept 03Apr84mapWe initialize the ROOT vocabulary with a few definitions that allow us to do vocabulary related things. ORDER (S -- ) Displays the search order currently in effect. Also displays the CURRENT vocabulary, which is were definitions are placed. VOCS (S -- ) Lists all of the vocabularies that have been defined so far, in the order of their definition.  \ DOS BDOS Interface 10Apr84mapFCB2 Space for a second FCB when needed. RESET Reset the DOS disk system CLOSE Close the given file, and report errors. SEARCH0 Search for the first occurance SEARCH Search for the next occurance. DELETE Remove an old file. READ Read the next sequential record, and report errors. WRITE Write the next sequential record, and report errors. MAKE-FILE create a directory entry for a new file, and report errors. \ Create File Control Blocks 11Apr84map(!FCB) (S Addr len FCB-addr --- ) Set up the filce control block per the specified string. This is the primitive file parse word, which breaks the drive/file name string into a drive specifier, file name, and extension, and leaves the parsed result in the given file control block address. !FCB (S FCB-addr ) Parse the next word in the input stream as a file. If CAPS is false, allow lower case names. SELECT make given drive the default. \ Save a Core Image as a File on Disk 22FEB84MAPHEADER This is different for CP/M-80, CP/M-86, and CP/M-68K. SAVE (S addr len -- ) Save the string specified as a CP/M file whose name is specified following the SAVE word. The current screen file is not disturbed. MORE Extend the size of the current file by n Blocks. CREATE-FILE creates a new file containing the given number of blocks. \ Display Directory 30Mar84map .NAME prints one filename. DIR prints a directory of the current dirve. DRIVE? prints currently selected drive. A: selects drive A as the default. B: selects drive B as the default. \ Open files and list directories 29Mar84mapFILE: (S -- fcb ) Define the next word as a file by allocating an FCB in the dictionary and parsing the next word as a file name. Leave the address of the file control block. ?DEFINE (S -- fcb ) Define the next word as a file if it does not already exist. Leave the address of the file control block. DEFINE (S -- ) Define the following word as a file name without opening it. OPEN (S -- ) Open the following file and make it the current file. FROM (S -- ) Open the following file and make it the current input file. SAVE-SYSTEM (S -- ) Usage: SAVE-SYSTEM NEWNAME.68K Saves an executable image of the system as a file. \ Set up VIEW-FILES table 07Apr84mapVIEW-FILES is an array of pointers to fcbs. VIEWS installs a file into the VIEW-FILES array, and sets the fcb to contain the matching view number. Now initialize the VIEW-FILES array: KERNEL80.BLK was used to generate the precompile code. EXTEND80.BLK was opened on the execute line, loads all extras. CPU8080.BLK has the machine dependent post-compile code. UTILITY.BLK has the machine independent post-compile code.   \ The Rest is Silence 04Apr84map************************************************************* ************************************************************* *** *** *** Please direct all questions, comments, and *** *** miscellaneous personal abuse to: *** *** *** *** Henry Laxen or Michael Perry *** *** 1259 Cornell Avenue 1125 Bancroft Way *** *** Berkeley, California Berkeley, California *** *** 94706 94702 *** *** *** ************************************************************* ************************************************************* \ Load Screen for Pre-Compile 04Apr84mapONLY FORTH ALSO DEFINITIONS FENCE OFF FORGET OUT WARNING OFF : NLOAD CR .S (LOAD) ; ' NLOAD IS LOAD 3 21 THRU ( The Meta Compiler ) ONLY FORTH DEFINITIONS ALSO CR .( Meta Compiler Loaded ) FROM KERNEL80.BLK 1 LOAD  \ Vocabulary Helpers 10Jan84mapONLY FORTH ALSO VOCABULARY META META ALSO META DEFINITIONS VARIABLE DP-T : [FORTH] FORTH ; IMMEDIATE : [META] META ; IMMEDIATE : [ASSEMBLER] ASSEMBLER ; IMMEDIATE : SWITCH (S -- ) NOOP ( Context ) NOOP ( Current ) DOES> DUP @ CONTEXT @ SWAP CONTEXT ! OVER ! 2+ DUP @ CURRENT @ SWAP CURRENT ! SWAP ! ; SWITCH ( Redefine itself ) \ Memory Access Words 04Apr84map0 CONSTANT TARGET-ORIGIN : THERE (S taddr -- addr ) TARGET-ORIGIN + ; : C@-T (S taddr -- char ) THERE C@ ; : @-T (S taddr -- n ) THERE @ ; : C!-T (S char taddr -- ) THERE C! ; : !-T (S n taddr -- ) THERE ! ; : HERE-T (S -- taddr ) DP-T @ ; : ALLOT-T (S n -- ) DP-T +! ; : C,-T (S char -- ) HERE-T C!-T 1 ALLOT-T ; : ,-T (S n -- ) HERE-T !-T 2 ALLOT-T ; : S,-T (S addr len -- ) 0 ?DO COUNT C,-T LOOP DROP ; \ Define Symbol Table Vocabularies 21Dec83mapVOCABULARY TARGET VOCABULARY TRANSITION VOCABULARY FORWARD VOCABULARY USER ONLY DEFINITIONS FORTH ALSO META ALSO : META META ; : TARGET TARGET ; : TRANSITION TRANSITION ; : FORWARD FORWARD ; : USER USER ; : ASSEMBLER ASSEMBLER ; ONLY FORTH ALSO META ALSO DEFINITIONS  \ 8080 Meta Assembler 01AUG83HHL: ?>MARK (S -- f addr ) TRUE HERE-T 0 ,-T ; : ?>RESOLVE (S f addr -- ) HERE-T SWAP !-T ?CONDITION ; : ?MARK ASSEMBLER IS ?>MARK META ' ?>RESOLVE ASSEMBLER IS ?>RESOLVE META ' ? FORWARD-CODE ; \ Create Headers in Target Image 08SEP83HHLVARIABLE WIDTH 31 WIDTH ! VARIABLE LAST-T VARIABLE CONTEXT-T VARIABLE CURRENT-T : HASH (S str-addr voc-addr -- thread ) SWAP 1+ C@ 3 AND 2* + ; : HEADER (S -- ) BL WORD C@ 1+ WIDTH @ MIN ?DUP IF ALIGN BLK @ 4096 + ,-T ( Lay down view field ) HERE CURRENT-T @ HASH DUP @-T ,-T HERE-T 2- SWAP !-T HERE-T HERE ROT S,-T ALIGN DUP LAST-T ! 128 SWAP THERE CSET 128 HERE-T 1- THERE CSET THEN ; \ Meta Compiler Create Target Image 04Apr84map: TARGET-CREATE (S -- ) >IN @ HEADER >IN ! IN-TARGET CREATE IN-META HERE-T , TRUE , DOES> MAKE-CODE ; : RECREATE (S -- ) >IN @ TARGET-CREATE >IN ! ; : CODE (S -- ) TARGET-CREATE HERE-T 2+ ,-T ASSEMBLER !CSP ; ASSEMBLER ALSO DEFINITIONS : END-CODE IN-META ?CSP ; : C; END-CODE ; META IN-META \ Force compilation of target & forward words 07SEP83HHL: 'T (S -- cfa ) CONTEXT @ TARGET DEFINED ROT CONTEXT ! 0= ?MISSING ; : [TARGET] (S -- ) 'T , ; IMMEDIATE : 'F (S -- cfa ) CONTEXT @ FORWARD DEFINED ROT CONTEXT ! 0= ?MISSING ; : [FORWARD] (S -- ) 'F , ; IMMEDIATE \ Meta Compiler Branching & Defining Words 07SEP83HHL: T: (S -- ) SWITCH TRANSITION DEFINITIONS CREATE SWITCH ] DOES> >R ; : T; (S -- ) SWITCH TRANSITION DEFINITIONS [COMPILE] ; SWITCH ; IMMEDIATE : DIGIT? (S CHAR -- F ) BASE @ DIGIT NIP ; : PUNCT? (S CHAR -- F ) ASCII . OVER = SWAP ASCII - OVER = SWAP ASCII / OVER = SWAP DROP OR OR ; : NUMERIC? (S ADDR LEN -- F ) DUP 1 = IF DROP C@ DIGIT? EXIT THEN 1 -ROT 0 ?DO DUP C@ DUP DIGIT? SWAP PUNCT? OR ROT AND SWAP 1+ LOOP DROP ; \ Meta Compiler Transition Words 11Mar84mapT: ( [COMPILE] ( T; T: (S [COMPILE] (S T; T: \ [COMPILE] \ T; : STRING,-T (S -- ) ASCII " PARSE DUP C,-T S,-T ALIGN ; FORWARD: <(.")> T: ." [FORWARD] <(.")> STRING,-T T; FORWARD: <(")> T: " [FORWARD] <(")> STRING,-T T; FORWARD: <(ABORT")> T: ABORT" [FORWARD] <(ABORT")> STRING,-T T; \ Meta Compiler Defining Words 06SEP83HHLFORWARD: : CREATE RECREATE [FORWARD] HERE-T CONSTANT ; : VARIABLE (S -- ) CREATE 0 ,-T ; FORWARD: : DEFER (S -- ) TARGET-CREATE [FORWARD] 0 ,-T ; \ Meta Compiler Defining Words 07SEP83HHLFORTH VARIABLE #USER-T META ALSO USER DEFINITIONS : ALLOT (S n -- ) #USER-T +! ; FORWARD: : VARIABLE (S -- ) SWITCH RECREATE [FORWARD] #USER-T @ DUP ,-T 2 ALLOT META DEFINITIONS CONSTANT SWITCH ; FORWARD: : DEFER (S -- ) SWITCH TARGET-CREATE [FORWARD] SWITCH #USER-T @ ,-T 2 ALLOT ; ONLY FORTH ALSO META ALSO DEFINITIONS \ Meta Compiler Transition Words 04Apr84mapFORTH VARIABLE VOC-LINK-T META FORWARD: : VOCABULARY (S -- ) RECREATE [FORWARD] HERE-T #THREADS 0 DO 0 ,-T LOOP HERE-T VOC-LINK-T @ ,-T VOC-LINK-T ! CONSTANT DOES> @ CONTEXT-T ! ; : IMMEDIATE (S -- ) WIDTH @ IF ( Headers present? ) 64 ( Precedence Bit ) LAST-T @ THERE CSET THEN ; \ Meta Compiler Transition Words 04Apr84mapFORWARD: <(;USES)> FORTH VARIABLE STATE-T META T: ;USES (S -- ) [FORWARD] <(;USES)> IN-META ASSEMBLER !CSP STATE-T OFF T; T: [COMPILE] 'T EXECUTE T; FORWARD: <(IS)> T: IS [FORWARD] <(IS)> T; : IS 'T >BODY @ >BODY !-T ; T: ALIGN T; T: EVEN T; \ Display an unformatted Symbol Table 26Sep83map: .SYMBOLS (S -- ) TARGET CONTEXT @ HERE #THREADS 2* CMOVE BEGIN HERE 4 LARGEST DUP WHILE ?CR ." [[ " DUP .ID DUP NAME> >BODY @ U. ." ]] " N>LINK @ SWAP ! KEY? IF EXIT THEN REPEAT 2DROP IN-META ; \ Meta Compiler Resolve Forward References 07Jan84map: .UNRESOLVED (S -- ) FORWARD CONTEXT @ HERE #THREADS 2* CMOVE BEGIN HERE #THREADS LARGEST DUP WHILE ?CR DUP L>NAME NAME> >BODY RESOLVED? 0= IF DUP L>NAME .ID THEN @ SWAP ! REPEAT 2DROP IN-META ; : FIND-UNRESOLVED (S -- cfa f ) 'F DUP >BODY RESOLVED? ; : RESOLVE (S taddr cfa -- ) >BODY 2DUP TRUE OVER 2+ ! @ BEGIN DUP WHILE 2DUP @-T -ROT SWAP !-T REPEAT 2DROP ! ; : RESOLVES (S taddr -- ) FIND-UNRESOLVED IF >NAME .ID ." Already Resolved" DROP ELSE RESOLVE THEN ; \ Interpretive words for Meta 07SEP83HHL: H: [COMPILE] : ; H: ' 'T >BODY @ ; H: , ,-T ; H: C, C,-T ; H: HERE HERE-T ; H: ALLOT ALLOT-T ; H: DEFINITIONS DEFINITIONS CONTEXT-T @ CURRENT-T ! ;    \ Load Screen for Pre-Compile 10MAR83HHLMeta Compiling is a term to describe the process of regeneratinga Forth system by compiling itself. It is similar in idea to the ordinary notion of compiling in Forth, but has some important differences. First the code that is generated by the Meta Compiler is generally not immediately executable. This maybe for a variety of reasons, such as that the object code generated physically resides at a different address from where it must be to execute correctly. Also, it is possible through Meta Compilation to generate a Forth System for a totally different CPU than the one the Meta Compiler is running on. In such a case, the object code of course is not executable on the Host System. This Screen is the load screen for the Meta Compiler itself. The purpose of this section of the Meta Compiler is to compile Code Words correctly. \ Target System Setup 10MAR83HHL Make Room for HOST definitions Set up the address where Target Compiled Code begins Set up the address where the Target Headers begin Set up the HOST address where Target Image resides Load the Source Screens that define the System Save the System as a CP/M file, ready to be executed \ Vocabulary Helpers 07SEP83HHL META The Meta Compiler Environment, many redefintions DP-T The dictionary Pointer while meta compiling [FORTH] For convenience, an immediate version [META] For convenience, an immediate version SWITCH Exchange the saved values of CONTEXT and CURRENT with themselves. This should be used in pairs, and is only really meaningful in the second occurance. Its purpose is to save and restore the CONTEXT and CURRENT vocabularies. Following the first occurance you should invoke a vocabulary and perhaps DEFINITIONS. \ Memory Access Words 27Jan84mapTARGET-ORIGIN The Offset where the Target Image resides THERE Map a Target address to a Host address C@-T Fetch a byte at the given Target address @-T Fetch a word at the given Target address C!-T Store a byte at the given Target address !-T Store a word at the given Target address HERE-T Target address of next available dictionary byteALLOT-T Allocate more space in the Target dictionary C,-T Add a byte to the Target dictionary ,-T Add a word to the Target dictionary S,-T Add a string to the Target dictionary ALIGN Makes the dictionary even. \ Define Symbol Table Vocabularies 07SEP83HHLTARGET The symbol table for Target definitions TRANSITION Holds special case compiling words, like ." and [ FORWARD Holds all forward references, not neccessary but niceUSER Holds USER version of defining words We add all of the vocabulary names to the ONLY vocabulary so that they are always accessible. This is mainly a convienence during debugging, when something fails and we need to look at different words in various vocabularies to figure out what is going on. Now we are guaranteed that we can reference all of the vocabularies inside META without standing on our heads.   \ 68000 Meta Assembler 12Jan84map?>MARK Set up for a forward branch. ?>RESOLVE Resolve a forward branch. ? Run time forward reference for code compiled by ." ." Compile the unknown run time code, followed by the string. <(")> Run time forward reference for code compiled by " " Compile unknown run time code, followed by string. <(ABORT")> Run time forward ref. for code compiled by ABORT" ABORT" Compile the unknown run time code, followed by the string. \ Meta Compiler Transition Words 06SEP83HHL Forward reference for run time of CREATE & VARIABLECREATE Create a target word whose run time is the run time for VARIABLE. Also create a host word to rreturn Target Here addrVARIABLE Make a variable in the Target Image. Forward reference for run time of DEFER DEFER An execution vector in the Target System. "\ Meta Compiler Transition Words 06SEP83HHL#USER-T Counts the number of user variables defined so far. ALLOT Allocate space in the USER area. Forward reference for run time of USER vars. VARIABLE Create a User variable, which is task local. Forward reference for run time of USER vectorsDEFER Create a task local execution vector. \ Meta Compiler Transition Words 10MAR83HHLVOC-LINK-T Links defined Vocabularies together. Forward reference for run time of VOCABULARY VOCABULARY Create a target word that behaves like a vocabulary. Only one target vocabulary can contain definitions in this meta compiler, but several can be defined. IMMEDIATE If heads are compiled, flip the Target IMMEDIATE bit. \ Meta Compiler Transition Words 12Jan84map<(;USES)> Forward reference for code compiled by ;USES STATE-T True if compiling inside : def. False if outside. ;USES This is a new syntax that can be used to compile a code field whose code already exists. Similar to ;CODE [COMPILE] Compile a TARGET word rather than execute its TRANSITION counterpart. <(IS)> Forward reference for run time of IS IS Compiles the unknown code field of <(IS)> IS The Meta Version of IS actually does the patch. \ Display an unformatted Symbol Table 10MAR83HHL.SYMBOLS Print a primitive unformatted symbol table on the display. This is very useful if you ever need to debug with DDT, you have no idea where the addresses are. You can make it pretty if you like. \ Meta Compiler Resolve Forward References 10MAR83HHL.UNRESOLVED Display all the words in the FORWARD vocabulary that have not already been resolved. You had better resolve them before saving a system, or else they will surely crash when you execute them. FIND-UNRESOLVED Search for a word in the FORWARD vocabulary and return statusRESOLVE Run through the linked list of forward reference and resolve each of the with the given address. RESOLVES The user interface for resolving forward references. Used as follows: ' resolution-name RESOLVES forward-name #\ Interpretive words for Meta 02AUG83HHLH: Save a version of old : for later. Will be redefined. ' How ' should behave during Target Compilation. , How , should behave during Target Compilation. C, How C, should behave during Target Compilation. HERE How HERE should behave during Target Compilation. ALLOT How ALLOT should behave during Target Compilation. DEFINITIONS How DEFINITIONS should behave when interpreted.   \ Meta Compiler Resolve Forward References 10MAR83HHL.UNRESOLVED CPU8080 BLK'()*+,-./0123456CPU8080 BLK789:;<=>?@ABCDEFCPU8080 BLKHGHIJKLMNOEXPAND80BLK(PQRSTEXTEND80BLKUVWXYZ[\]^_`abcdEXTEND80BLKpefghijklmnopqrMETA80 $$$stuvwxyz{|}~META80 $$$META80 $$$META80 $$$ This is the release date of the disk. $ Fog Library Disk FOG-CPM.106 Copyright (1986) by Fog International Computer Users Group to the extent not copyrighted by the original author for the exclusive use and enjoyment of its members. Any reproduction or distribution for profit or personal gain is strictly forbidden. For information, contact FOG, P. O. Box 3474, Daly City, CA. 94015-0474. as part of the description of a file indicates that the program is distributed on a "try first, pay if you like it" basis. If you find the program(s) meet your need, please refer to the author's documentation for information on becoming a registered user. Only by registering and paying for the programs you like and use will the authors of such programs continue development. Often, more complete documentation, additional modules, and new releases are available only to registered users. Disk 1 of 3. FORTH 83 -- for all CPM systems. Filename Description -07-00 .86 This is the release date of the disk. -CPM106 .DOC This is the description of the disk contents. F83 .COM 7066 24K ver. 83 [Forth83 1 of 10] This is MVP (Mountain View Press) Forth83. CLOCK .BLK B37D 12K ver. 83 [Forth83 2 of 10] CPU8080 .BLK 4A63 41K ver. 83 [Forth83 3 of 10] EXPAND80.BLK 26C4 5K ver. 83 [Forth83 4 of 10] EXTEND80.BLK AAF7 30K ver. 83 [Forth83 5 of 10] META80 .BLK 5B47 49K ver. 83 [Forth83 6 of 10] escription -07-00 .86 This is the release date of %&'