IMD 1.16: 31/05/2007 19:55:44 FOGCPM.107 ååååååååååååååå--FOGCPM107README 80 € README 80  -CPM108 DOC žŸ-07-00 86 ›KERNEL80BLK€ !"#$KERNEL80BLK€%&'()*+,-./01234KERNEL80BLK€56789:;<=>?@ABCDKERNEL80BLK€EFGHIJKLMNOPQRSTKERNEL80BLK€UVWXYZ[\]^_`abcdKERNEL80BLK€efghijklmnopqrstKERNEL80BLK€uvwxyz{|}~€‚ƒ„KERNEL80BLK€…†‡ˆ‰Š‹ŒŽ‘’“”KERNEL80BLK0•–—˜™š-CPM109 DOC ¡¢-CPM107 DOC œåååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååThis is the disk name. åååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååå.PO 3 WELCOME TO FORTH   Thió   ió  á  publiã  domaiî  system¬   anä  maù  bå  freelù distributeä anä copied¬  aó lonç aó thå authoró arå giveî  crediô anä  nï copyrighô noticå ió placeä upoî it®  Iæ wå catcè  someonå sellinç thió systeí aó theiò owî proprietarù product¬  witè theiò copyrighô noticå ¬ wå wilì dï ouò besô tï makå theí regreô iô foò thå  resô  oæ theiò lives®  Yoõ havå beeî  warned!¡  Thió  Fortè  useó thå fileó oæ thå  hosô  operatinç  system® Althougè  thió reduceó performance¬  iô ió mucè morå portablå anä morå convenienô foò novices®  Thå uså oæ fileó wilì bå  describeä later. Thió  disë containó somå Huffmaî encodeä files®  Theù  allo÷ thå  systeí  tï fiô oî onå floppù disk®  Youò firsô tasë  ió  tï expanä  theí  intï thå sourcå fileó foò thå system®  Thå  Huffmaî fileó anä theiò expansionó areº M80.HUF --> META80.BLK K80.HUF --> KERNEL80.BLK E80.HUF --> EXTEND80.BLK C80.HUF --> CPU8080.BLK UT.HUF --> UTILITY.BLK HF.HUF --> HUFFMAN.BLK CK.HUF --> CLOCK.BLK FX.HUF --> F83-FIXS.TXT Iî additioî therå arå á fe÷ noî-compresseä files®  Theså arå thå following: README.80 This file which you are hopefully reading. RUNME.COM Thå filå thaô yoõ wilì ruî tï creatå thå BLË files. EXPAND80.BLK The file used to expand the HUF files. Iî  ordeò  tï recoveò thå actuaì sourcå  code¬  simplù  typå RUNMÅ  anä  follo÷  thå  directions®   Iæ  alì  goeó  well¬  thå correspondinç  BLË fileó wilì bå created®  Yoõ shoulä oæ  courså makå  backuð  copieó oæ thå expandeä sourcå codå aó  sooî  aó  iô exists®  Wå apologizå foò thå timå thå expansioî takes¬ buô sucè ió life®  Yoõ arå no÷ iî á positioî tï modifù anä regeneratå thå system. Tï  dï  so¬  yoõ shoulä puô META80.BLË anä  KERNEL80.BLË  oî drivå B:¬ anä puô F83.COM oî drivå A:® Makå surå therå ió rooí oî Aº  foò thå ne÷ KERNEL.COM¬  theî loç ontï drivå Bº  anä typå thå following: B>A:F8³ META80.BLË ¨ ruî F8³ oî META80.BLË ) OË ¨ loadó metá compileò anä generateó KERNEL.COM ) BYÅ ¨ returî tï CP/Í ) No÷ yoõ havå á ne÷ KERNEL.COM oî Aº anä yoõ arå readù tï adä Šthå selecteä extensionó anä makå á ne÷ F83.COM ¨ yoõ diä bacë  uð thå  olä onå didn'ô you?)®  Puô  EXTEND80.BLK¬  CPU8080.BLK¬  anä UTILITY.BLK on A: with KERNEL.COM and type the following: A>KERNEL EXTEND80.BLË ¨ ruî KERNEL80 oî EXTEND80.BLË ) OK ¨ loadó alì extensionó anä createó ne÷ versioî oæ F83.COM ) BYÅ ¨ returî tï CP/Í ) Yoõ  caî havå á printouô oæ theså instructionó bù usinç Controì Ð anä enterinç TYPÅ README.80 Iî  whaô  followó  thå      Forth will reply with: 8080 Forth 83 Model 2.0.0 Modified 01Apr84 Fortè  ió abouô teî yearó olä no÷ (iî 1983© buô somå oæ  thå featureó  oæ F8³ arå relativelù ne÷ tï thió Publiã  Domaiî  Fortè Model.    Thå VIE× commanä ió onå oæ thå best®  VIE× ¬  provideä thaô  thå  filå thaô containó Therå  ió  alsï  á decompileò  presenô  whicè  reverseó  thå compilinç  process¬  producinç sourcå codå froí objecô code®  Thå useò  interfacå tï iô ió thå worä SEÅ Yoõ arå lookinç aô á screeî oæ editinç commands®  Letó gï tï thå shado÷ witè thå Á Ì commanä anä dï somå exploring®  Whilå  wå arå  iî  thå  shadowó letó looë aô thå nexô fivå  oò  siø  shado÷ screenó  thaô  shoulä bå editoò words®  Uså Î L®  Iæ yoõ  havå  á printeò  yoõ  maù prinô theså screenó no÷ aó follows®  Typå  VIE× WIPÅ  foò example®  Iæ wipå ió thå firsô oæ ¶ screenó  oæ  editoò wordó remembeò thå screeî number®  Iæ foò instancå iô waó 8° theî typå 8° 8µ SHADO× SHOW No÷  á  brieæ worä abouô ouò masó  storagå  interface®  Ouò Fortè  8³ systeí runó aó á guesô undeò á hosô system'ó  operatinç system®  Becauså  oæ  this¬  wå uså thå host'ó  filå  systeí  tï contaiî  ouò screeî files®  Screenó arå implementeä aó 1Ë blockó withiî  á random accesó file®  Screenó arå stilì treateä  aó  1¶ lineó  oæ 6´ characteró wheî editing¬  witè nï embeddeä  carriagå returnó oò linå feeds®  Iî ordeò tï accesó á screeî filå iô musô firsô bå opened®  Thió caî bå donå iî twï ways® Thå mosô commoî ió  tï  specifù thå namå oæ thå screeî filå oî thå executå  line® Thuó  iæ yoõ wanteä tï opeî MY.BLË yoõ coulä firå uð  Fortè  witè the following: A>F83 MY.BLK .pa ŠOncå  yoõ arå iî Forth¬  yoõ caî opeî otheò fileó witè thå  Fortè worä OPEÎ indicates carriage return, as usual. F83 ( fire up forth from the CP/M environment ) 8080 Forth 83 Model 2.0.0 ( Forth's reply and ) Modified 01Apr84 ( sign on message ) WORDS empty mark hello .... 10 CREATE-FILE SAMPLE.BLK ( Creates a file called SAMPLE.BLK ) ( which is 10 screens big. ) 1 LIST Scr# 1 0 1 2 ( This will be a blank screen ) ... 15 ( Now we will edit screen 1 with the default dumb terminal ) ( editor which is pre-installed for you. Your first task is ) ( to install the cursor addressing routines to make the editor ) ( more convenient to use ) 1 EDIT Enter your id: .......... ( Your id is a 10 character string that will automatically ) ( be placed in the upper right hand corner of line 0 of the ) ( current screen you are editing if you modify that screen ) ( I usually enter the date and my initials as follows: ) 10MAR84HHL ( The screen will be blanked and listed, you should have ) ¨ á resulô similaò tï ± LISÔ above¬  buô witè thå linå ) ( number also appearing on the right hand side of the screen ) ( Now we will enter the source code necessary to install ) ( the cursor routine drivers for an ADM-3A terminal ) .pa Š0 NEW ( This allows us to enter multiple lines of text. The text ) ( input is terminated with a null line. After each line is ) ( entered, it is redisplayed for you ) \ CURSOR ROUTINES FOR AN ADM-3A TERMINAL ( it is best to use line 0 for a comment ) EDITOR DEFINITIONS ( This will add the following definitions to the editor ) : ADM-AT 27 EMIT ASCII = EMIT 32 + EMIT 32 + EMIT ; : ADM-DARK CONTROL Z EMIT ; : ADM-3A ['] .ALL IS .SCREEN ['] ADM-AT IS AT ['] ADM-DARK IS DARK ['] NOOP IS -LINE ['] (BLOT) IS BLOT ; ADM-3A DONE 1 modified ¨ Typinç thaô lasô ( Now the editor will work the way it was intended to ) ( with the current screen image always displayed at the ) ( top of the screen, and the line you are entering at the ) ( bottom of the screen. To make sure type: ) 1 EDIT ( The screen should be blanked, and the text you just ) ( entered will be displayed at the top of the screen. ) ( The current line will be displayed at the bottom of the ) ( screen with a ^ pointing to the current editing cursor ) ( position. The terminal's cursor will be below the ) ( line, and ready for an editing command. ) DONE 1 Unmodified ( Will again leave the editor and return to Forth ) ( Now we will save the system and leave Forth ) SAVE-SYSTEM F.COM ( That will save the current system as a file called ) ( F.COM on the currently logged drive. ) BYE ( This exits Forth and returns to CP/M. Now if you use ) ( F.COM instead of F83.COM you will have your terminal ) ( routines installed at boot up time. ) .pa Š Notå  thaô  thå  abovå routineó arå designeä foò  aî  ADM-3Á terminal¬  anä  wilì noô worë iæ youò terminaì ió noô aî  ADM-3A® Yoõ  wilì  havå tï consulô youò terminaì manuaì foò  thå  correcô escapå  sequenceó  requireä iî ordeò tï positioî thå  cursoò  anä implemenô thå otheò speciaì functionó required®  Á betteò waù tï dï  thå  abovå  ió tï recompilå  thå  entirå  system¬  witè  youò terminaì  routineó  installeä aó thå defaulô insteaä oæ thå  DUM terminaì  routineó  supplieä  witè  thå  system®   Iî  ordeò  tï accomplisè thió yoõ shoulä copù thå screeî yoõ jusô entereä  intï thå UTILITY.BLË filå anä recompilå thå systeí aó describeä above® Thå  followinç  illustrateó ho÷ tï dï this¬  usinç thå  multifilå utility words implemented in F83. F83 UTILITY.BLK ( files up F83 and opens UTILITY.BLK as the default file. ) ¨ Makå surå thaô UTILITY.BLË ió oî thå currentlù loggeä ) ( drive ) ( Now find a blank or irelevant screen at the end of the ) ( editors set of screens, on top of which we are going to ) ( put the screen we just entered. Suppose it is screen ) ( number 32. You should now type: ) FROM SAMPLE.BLK 1 32 COPY ( This will copy screen 1 from SAMPLE.BLK to screen 32 of ) ( the current file. Note that SAMPLE.BLK must also be on ) ( the currently logged drive. ) ( You can now recompile the high level portion of the ) ( by leaving Forth and typeing the following: ) BYE ( leave Forth ) KERNEL EXTEND80.BLK START ( Of course all of the necessary files should be present ) ( on the currently logged drive in order for this to work ) Iæ  yoõ  arå ne÷ tï Fortè youò besô beô ió tï  purchaså  thå booë  STARTINÇ  FORTÈ  bù LEÏ BRODIE®  Iô costó  abouô  seventeeî dollaró  anä ió availablå aô mosô largå booë stores®  Oî pagå  8´ yoõ wilì finä thå commandó foò thå linå editor®  Anotheò valuablå referencå ió thå ne÷ booë bù MARTIN TRACY calleä FORTH TOOLS® Iô ió  availablå froí MicroMotion¬  1207· Wilshirå Blvd®  Suitå 506¬ Wesô Loó Angeles¬  CÁ 90025®  Thå pricå foò thå booë ió  $20.00® Thå F8³ modeì followó botè thå booë anä thå Fortè 8³ standard® Thå Fortè Interesô Grouð ¨ FIÇ © haó chapteró iî manù areas® Iî  thå  Saî  Franciscï Baù Area¬  meetingó arå helä oî  thå  4tè Saturdaù oæ eacè month¬  currentlù aô Chaboô Collegå iî  Hayward¬ CA®  Calì  thå  FIÇ  hoô  linå iæ yoõ wisè tï  doublå  checë  thå locatioî pè 962-865³ oò thå FIÇ Treå BBÓ (30° baud© aô 538-3580. Henry Laxen                                  Mike Perry 1259 Cornell Avenue                          1125 Bancroft Way Berkeley, CA 94706                           Berkeley, CA 94702 .pa Š              System Memory Map   Thå  memorù mað wilì varù somewhaô witè CPU¬  anä  operatinç system¬  anä  options®  Foò CP/Í oî thå 808° witè 64Ë oæ  memory¬ witè fouò blocë bufferó anä alì utilities¬  iô ió aó  followsº  ¨ alì addresseó iî hexadecimal)      0100      Jump to cold start      0104      Jump to warm start      0108 ----                Dictionary with all utilities loaded.      5E75 ---- HERE                Free space.      D10E ---- SP0, TIB                | Text Input Buffer                V                             ^                Return Stack |      D1D6 ---- RP0, >BUFFERS                Block Buffer Pointer Table      D200 ---- FIRST                Block Buffers      E200 ---- LIMIT .PA Š             Standard System Documentation Requirement 1.  The  system  dictionary space is CPU  dependant  and  can  be  determined by typeing HERE U.  2. The application dictionary space is also CPU dependant and  is  the  difference  between  the  top  of  the  dictionary  and  the  beginning of the parameter stack.  The location of the  parameter  stack  varies depending on the amount of memory available to  the  machine.   The application dictionary space can be determined  by  typing SP@ HERE - U.  3. The data stack space is the same as the dictionary space. 4.  The return stack space was arbitrarily set at 256 bytes.   It  can be altered by remeta-compiling the system. 5.  No  mass  storage block ranges are reserved  by  the  system,  other than the contents of the files that are distributed. 6. The user has available to him blocks 0 thru 65534.  Note  that  block  0  may  not be used for loading.  Block  number  65535  is  reserved to indicate the buffer is missing. 7. Any ascii terminal should work with this system.  If the  user  has  a  cursor  addressable terminal, the editor  can  be  easily  modified to take advantage of the terminal's characteristics. 8. System action taken upon error conditions:      '  [']   not found results in ? error message           */ */MOD / /MOD MOD UM/MOD all division by 0 errors result in a 0 quotient : in the case of an error, a ? error message will be printed DO if a nesting error occurs, the system will crash. (if you are lucky) EXECUTE if addr is not a compilation address, the system will crash. see DO EXIT if the top of the return stack does not contain a valid return point, the system will crash. see DO FORGET if is not found, a ? error message is printed. If the compilation vocabulary is forgotten, the system will crash. see DO FORTH-83 if the error condition occurs, that this is not a standard system, I don't want to hear about it and I hope the system not only crashes, but burns. LOAD if u is zero, the system will crash. see DO Štions:      '  [']   not found results in ? error message           */ */MOD / /MOD MOD UM/MOD all division by 0 errors result in a 0 quotient : in the case of an error, a ? error message will be printed DO if a nesting error occurs, the system will crash. (if you are lucky) EXECUTE if addr is not a compilation addres\ 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 *** *** *** ************************************************************* ************************************************************* \ Target System Setup 24Apr84mapWARNING OFF ONLY FORTH META ALSO FORTH 256 DP-T ! HERE 12000 + ' TARGET-ORIGIN >BODY ! IN-META 2 92 THRU ( System Source Screens ) WARNING ON CR .( Unresolved references: ) CR .UNRESOLVED CR .( Statistics: ) CR .( Last Host Address: ) [FORTH] HERE U. CR .( First Target Code Address: ) META 256 THERE U. CR .( Last Target Code Address: ) META HERE-T THERE U. CR CR META 256 THERE HERE-T ONLY FORTH ALSO DOS SAVE A:KERNEL.COM FORTH CR .( Now return to CP/M and type: ) CR .( KERNEL EXTEND80.BLK ) CR .( OK ) \ Declare the Forward References and Version # 04Apr84map: ]] ] ; : [[ [COMPILE] [ ; FORTH IMMEDIATE META FORWARD: DEFINITIONS FORWARD: [ \ Boot up Vectors and NEXT Interpreter 28AUG83HHLASSEMBLER LABEL ORIGIN NOP -1 JMP ( Low Level COLD Entry point ) NOP -1 JMP ( Low Level WARM Entry point ) LABEL DPUSH D PUSH LABEL HPUSH H PUSH LABEL >NEXT IP LDAX IP INX A L MOV IP LDAX IP INX A H MOV LABEL >NEXT1 M E MOV H INX M D MOV XCHG PCHL FORTH ASSEMBLER DEFINITIONS META H: NEXT >NEXT JMP ; H: IP>HL B H MOV C L MOV ; IN-META HERE-T DUP 100 + CURRENT-T ! ( harmless ) VOCABULARY FORTH FORTH DEFINITIONS 0 OVER 2+ !-T ( link ) DUP 2+ SWAP 16 + !-T ( thread ) IN-META \ Run Time Code for Defining Words 13Apr84mapVARIABLE RP ( Not enough registers on an 8080 ) ASSEMBLER LABEL NEST RP LHLD H DCX B M MOV H DCX C M MOV RP SHLD D INX E C MOV D B MOV NEXT CODE EXIT (S -- ) RP LHLD M C MOV H INX M B MOV H INX RP SHLD NEXT END-CODE CODE UNNEST ' EXIT @-T ' UNNEST !-T END-CODE ASSEMBLER LABEL DODOES RP LHLD H DCX B M MOV H DCX C M MOV RP SHLD B POP D INX D PUSH NEXT LABEL DOCREATE D INX D PUSH NEXT \ Run Time Code for Defining Words 09MAR83HHLVARIABLE UP ASSEMBLER LABEL @USER ( in: DE out: DE uses: HL ) UP LHLD D DAD M E MOV H INX M D MOV RET LABEL !USER ( in: DE=off HL=value out: none ) H PUSH UP LHLD D DAD D POP E M MOV H INX D M MOV RET LABEL DOCONSTANT D INX XCHG M E MOV H INX M D MOV D PUSH NEXT LABEL DOUSER-VARIABLE D INX XCHG M E MOV H INX M D MOV UP LHLD D DAD H PUSH NEXT CODE (LIT) (S -- n ) IP LDAX IP INX A L MOV IP LDAX IP INX A H MOV HPUSH JMP END-CODE \ Meta Defining Words 07SEP83HHLT: LITERAL (S n -- ) [TARGET] (LIT) ,-T T; T: DLITERAL (S d -- ) [TARGET] (LIT) ,-T [TARGET] (LIT) ,-T T; T: ASCII (S -- ) [COMPILE] ASCII [[ TRANSITION ]] LITERAL [META] T; T: ['] (S -- ) 'T >BODY @ [[ TRANSITION ]] LITERAL [META] T; : CONSTANT (S n -- ) RECREATE [[ ASSEMBLER DOCONSTANT ]] LITERAL ,-T DUP ,-T CONSTANT ; \ Identify numbers and forward References 04Apr84mapFORWARD: <(;CODE)> T: DOES> (S -- ) [FORWARD] <(;CODE)> HERE-T DOES-OP C,-T [[ ASSEMBLER DODOES ]] LITERAL ,-T T; : NUMERIC (S -- ) [FORTH] HERE [META] NUMBER DPL @ 1+ IF [[ TRANSITION ]] DLITERAL [META] ELSE DROP [[ TRANSITION ]] LITERAL [META] THEN ; : UNDEFINED (S -- ) HERE-T 0 ,-T IN-FORWARD [FORTH] CREATE [META] TRANSITION [FORTH] , FALSE , [META] DOES> FORWARD-CODE ; \ Meta Compiler Compiling Loop 04MAR83HHL[FORTH] VARIABLE T-IN META : ] (S -- ) STATE-T ON IN-TRANSITION BEGIN >IN @ T-IN ! DEFINED IF EXECUTE ELSE COUNT NUMERIC? IF NUMERIC ELSE T-IN @ >IN ! UNDEFINED THEN THEN STATE-T @ 0= UNTIL ; T: [ (S -- ) IN-META STATE-T OFF T; T: ; (S -- ) [TARGET] UNNEST [[ TRANSITION ]] [ T; : : (S -- ) TARGET-CREATE [[ ASSEMBLER NEST ]] LITERAL ,-T ] ;  \ Run Time Code for Control Structures 04MAR83HHLCODE BRANCH (S -- ) IP>HL M C MOV H INX M B MOV NEXT END-CODE CODE ?BRANCH (S f -- ) H POP L A MOV H ORA ' BRANCH @-T JZ IP INX IP INX NEXT END-CODE \ Meta Compiler Branching Words 01AUG83HHLT: BEGIN ?MARK T; T: THEN ?>RESOLVE T; T: ELSE [TARGET] BRANCH ?>MARK 2SWAP ?>RESOLVE T; T: WHILE [[ TRANSITION ]] IF T; T: REPEAT 2SWAP [[ TRANSITION ]] AGAIN THEN T; \ Run Time Code for Control Structures 07JUL83HHLASSEMBLER LABEL LOOP-EXIT RP LHLD 6 D LXI D DAD RP SHLD IP INX IP INX NEXT CODE (LOOP) (S -- ) RP LHLD M INR 0= IF H INX M INR LOOP-EXIT JZ THEN ' BRANCH @-T JMP END-CODE LABEL LOOP-BRANCH XCHG RP LHLD E M MOV H INX D M MOV ' BRANCH @-T JMP CODE (+LOOP) (S n -- ) RP LHLD M E MOV H INX M D MOV H POP H A MOV A ORA 0< NOT IF D DAD LOOP-EXIT JC LOOP-BRANCH JMP THEN D DAD LOOP-BRANCH JC LOOP-EXIT JMP END-CODE \ Run Time Code for Control Structures 02MAR83HHL: (DO) (S n1 n2 -- ) R> DUP @ >R 2+ -ROT SWAP DUP >R - >R >R ; : (?DO) (S n1 n2 -- ) 2DUP = IF 2DROP R> @ >R ELSE R> DUP @ >R 2+ -ROT SWAP DUP >R - >R >R THEN ; : BOUNDS (S adr len -- lim first ) OVER + SWAP ; \ Meta compiler Branching & Looping 01AUG83HHLT: ?DO [TARGET] (?DO) ?>MARK T; T: DO [TARGET] (DO) ?>MARK T; T: LOOP [TARGET] (LOOP) 2DUP 2+ ?RESOLVE T; T: +LOOP [TARGET] (+LOOP) 2DUP 2+ ?RESOLVE T;  \ Execution Control 07SEP83HHLASSEMBLER >NEXT META CONSTANT >NEXT CODE EXECUTE (S cfa -- ) H POP >NEXT1 JMP END-CODE CODE PERFORM (S addr-of-cfa -- ) H POP M E MOV H INX M D MOV XCHG >NEXT1 JMP END-CODE LABEL DODEFER (S -- ) D INX XCHG ' PERFORM @-T 1+ JMP LABEL DOUSER-DEFER D INX XCHG M E MOV H INX M D MOV @USER CALL XCHG >NEXT1 JMP CODE GO (S addr -- ) RET END-CODE CODE NOOP NEXT END-CODE CODE PAUSE NEXT END-CODE \ Execution Control 01Oct83mapCODE I (S -- n ) RP LHLD M E MOV H INX M D MOV H INX M A MOV H INX M H MOV A L MOV D DAD HPUSH JMP END-CODE CODE J (S -- n ) RP LHLD 6 D LXI D DAD ' I @-T 3 + JMP END-CODE CODE (LEAVE) (S -- ) RP LHLD H INX H INX H INX H INX M C MOV H INX M B MOV H INX RP SHLD NEXT END-CODE CODE (?LEAVE) (S f -- ) H POP H A MOV L ORA ' (LEAVE) @-T JNZ NEXT END-CODE T: LEAVE [TARGET] (LEAVE) T; T: ?LEAVE [TARGET] (?LEAVE) T; \ 16 and 8 bit Memory Operations 24FEB83HHLCODE @ (S addr -- n ) H POP M E MOV H INX M D MOV D PUSH NEXT END-CODE CODE ! (S n addr -- ) H POP D POP E M MOV H INX D M MOV NEXT END-CODE CODE C@ (S addr -- char ) H POP M L MOV 0 H MVI HPUSH JMP END-CODE CODE C! (S char addr -- ) H POP D POP E M MOV NEXT END-CODE \ Block Move Memory Operations 24FEB83HHLCODE CMOVE (S from to count -- ) IP>HL B POP D POP XTHL ( STACK=IP BC=len DE=to HL=from ) BEGIN B A MOV C ORA 0= NOT WHILE M A MOV H INX D STAX D INX B DCX REPEAT B POP NEXT END-CODE CODE CMOVE> (S from to count -- ) IP>HL B POP D POP XTHL ( STACK=IP BC=len DE=to HL=from ) B DAD H DCX XCHG B DAD H DCX XCHG BEGIN B A MOV C ORA 0= NOT WHILE M A MOV H DCX D STAX D DCX B DCX REPEAT B POP NEXT END-CODE \ 16 bit Stack Operations 24FEB83HHLCODE SP@ (S -- n ) 0 H LXI SP DAD HPUSH JMP END-CODE CODE SP! (S n -- ) H POP SPHL NEXT END-CODE CODE RP@ (S -- addr ) RP LHLD HPUSH JMP END-CODE CODE RP! (S n -- ) H POP RP SHLD NEXT END-CODE  \ 16 bit Stack Operations 24FEB83HHLCODE DROP (S n1 -- ) H POP NEXT END-CODE CODE DUP (S n1 -- n1 n1 ) H POP H PUSH HPUSH JMP END-CODE CODE SWAP (S n1 n2 -- n2 n1 ) H POP XTHL HPUSH JMP END-CODE CODE OVER (S n1 n2 -- n1 n2 n1 ) D POP H POP H PUSH DPUSH JMP END-CODE \ 16 bit Stack Operations 11MAR83HHLCODE TUCK (S n1 n2 -- n2 n1 n2 ) H POP D POP H PUSH DPUSH JMP END-CODE CODE NIP (S n1 n2 -- n2 ) H POP D POP HPUSH JMP END-CODE CODE ROT (S n1 n2 n3 --- n2 n3 n1 ) D POP H POP XTHL DPUSH JMP END-CODE CODE -ROT (S n1 n2 n3 --- n3 n1 n2 ) H POP D POP XTHL XCHG DPUSH JMP END-CODE CODE FLIP (S n -- n ) D POP E H MOV D L MOV HPUSH JMP END-CODE : ?DUP (S n -- [n] n ) DUP IF DUP THEN ; \ 16 bit Stack Operations 24FEB83HHLCODE R> (S -- n ) RP LHLD M E MOV H INX M D MOV H INX RP SHLD D PUSH NEXT END-CODE CODE >R (S n -- ) D POP RP LHLD H DCX H DCX RP SHLD E M MOV H INX D M MOV NEXT END-CODE CODE R@ RP LHLD M E MOV H INX M D MOV D PUSH NEXT END-CODE CODE PICK (S nm ... n2 n1 k -- nm ... n2 n1 nk ) H POP H DAD SP DAD M E MOV H INX M D MOV D PUSH NEXT END-CODE : ROLL (S n1 n2 .. nk n -- wierd ) >R R@ PICK SP@ DUP 2+ R> 1+ 2* CMOVE> DROP ; \ 16 bit Logical Operations 13Apr84mapCODE AND (S n1 n2 -- n3 ) D POP H POP E A MOV L ANA A L MOV D A MOV H ANA A H MOV HPUSH JMP END-CODE CODE OR (S n1 n2 -- n3 ) D POP H POP E A MOV L ORA A L MOV D A MOV H ORA A H MOV HPUSH JMP END-CODE CODE XOR (S n1 n2 -- n3 ) D POP H POP E A MOV L XRA A L MOV D A MOV H XRA A H MOV HPUSH JMP END-CODE CODE NOT (S n -- n' ) H POP L A MOV CMA A L MOV H A MOV CMA A H MOV HPUSH JMP END-CODE -1 CONSTANT TRUE 0 CONSTANT FALSE ASSEMBLER LABEL YES TRUE H LXI HPUSH JMP LABEL NO FALSE H LXI HPUSH JMP \ Logical Operations 16Oct83mapCODE CSET (S b addr -- ) H POP D POP M A MOV E ORA A M MOV NEXT END-CODE CODE CRESET (S b addr -- ) H POP D POP E A MOV CMA A E MOV M A MOV E ANA A M MOV NEXT END-CODE CODE CTOGGLE (S b addr -- ) H POP D POP M A MOV E XRA A M MOV NEXT END-CODE CODE ON (S addr -- ) TRUE H LXI XTHL H PUSH ' ! @-T JMP END-CODE CODE OFF (S addr -- ) FALSE H LXI XTHL H PUSH ' ! @-T JMP END-CODE  \ 16 bit Arithmetic Operations 13Apr84mapCODE + (S n1 n2 -- sum ) D POP H POP D DAD HPUSH JMP END-CODE CODE NEGATE (S n -- n' ) H POP H DCX H PUSH ' NOT @-T JMP END-CODE CODE - (S n1 n2 -- n1-n2 ) D POP H POP D A MOV CMA A D MOV E A MOV CMA A E MOV D INX D DAD HPUSH JMP END-CODE CODE ABS (S n -- n ) H POP H PUSH H A MOV A ORA ' NEGATE @-T JM NEXT END-CODE CODE +! (S n addr -- ) H POP D POP M A MOV E ADD A M MOV H INX M A MOV D ADC A M MOV NEXT END-CODE 0 CONSTANT 0 1 CONSTANT 1 2 CONSTANT 2 3 CONSTANT 3 \ 16 bit Arithmetic Operations 26Sep83mapCODE 2* (S n -- 2*n ) H POP H DAD HPUSH JMP END-CODE CODE 2/ (S n -- n/2 ) H POP H A MOV RLC RRC RAR A H MOV L A MOV RAR A L MOV HPUSH JMP END-CODE CODE U2/ (S u -- u/2 ) H POP A ORA H A MOV RAR A H MOV L A MOV RAR A L MOV HPUSH JMP END-CODE CODE 8* (S n -- 8*n ) H POP H DAD H DAD H DAD HPUSH JMP END-CODE CODE 1+ H POP H INX HPUSH JMP END-CODE CODE 2+ H POP H INX H INX HPUSH JMP END-CODE CODE 1- H POP H DCX HPUSH JMP END-CODE CODE 2- H POP H DCX H DCX HPUSH JMP END-CODE \ 16 bit Arithmetic Operations Unsigned Multiply 26Sep83map ASSEMBLER LABEL MPYX 0 H LXI ( 0=Partial Product ) 4 C MVI ( Loop Counter ) BEGIN H DAD ( Shift AHL left by 24 bits ) RAL CS IF D DAD 0 ACI THEN H DAD RAL CS IF D DAD 0 ACI THEN C DCR 0= UNTIL RET CODE UM* (S n1 n2 -- d ) D POP H POP B PUSH H B MOV L A MOV MPYX CALL H PUSH A H MOV B A MOV H B MOV MPYX CALL D POP D C MOV B DAD 0 ACI L D MOV H L MOV A H MOV B POP DPUSH JMP END-CODE : U*D (S n1 n2 -- d ) UM* ; \ 16 bit Arithmetic Operations Division subroutines 25FEB83HHLASSEMBLER LABEL USL0 A E MOV H A MOV C SUB A H MOV E A MOV B SBB CS IF H A MOV C ADD A H MOV E A MOV D DCR RZ LABEL USLA H DAD RAL USL0 JNC A E MOV H A MOV C SUB A H MOV E A MOV B SBB THEN L INR D DCR USLA JNZ RET LABEL USBAD -1 H LXI B POP H PUSH HPUSH JMP \ 16 bit Arithmetic Operations Unsigned Divide 25FEB83HHLCODE UM/MOD (S d1 n1 -- Remainder Quotient ) IP>HL B POP D POP XTHL XCHG ( HLDE = Numerator BC = Denominator ) L A MOV C SUB H A MOV B SBB USBAD JNC H A MOV L H MOV D L MOV 8 D MVI D PUSH USLA CALL D POP H PUSH E L MOV USLA CALL A D MOV H E MOV B POP C H MOV B POP D PUSH HPUSH JMP END-CODE  \ 16 bit Comparison Operations 13Apr84mapCODE 0= (S n -- f ) H POP L A MOV H ORA YES JZ NO JMP END-CODE CODE 0< (S n -- f ) H POP H DAD YES JC NO JMP END-CODE CODE 0> (S n -- f ) H POP H A MOV A ORA NO JM L ORA YES JNZ NO JMP END-CODE CODE 0<> (S n -- f ) H POP L A MOV H ORA YES JNZ NO JMP END-CODE CODE = (S n1 n2 -- f ) H POP D POP L A MOV E CMP NO JNZ H A MOV D CMP NO JNZ YES JMP END-CODE : <> (S n1 n2 -- f ) = NOT ; : ?NEGATE (S n1 n2 -- n3 ) 0< IF NEGATE THEN ; \ 16 bit Comparison Operations 13Apr84mapCODE U< (S n1 n2 -- f ) H POP D POP LABEL U<1 H A MOV LABEL U<2 D CMP NO JC YES JNZ L A MOV E CMP NO JC YES JNZ NO JMP END-CODE CODE U> (S n1 n2 -- f ) D POP H POP U<1 JMP END-CODE CODE < (S n1 n2 -- f ) H POP D POP LABEL <1 D A MOV 128 XRI A D MOV H A MOV 128 XRI U<2 JMP END-CODE CODE > (S n1 n2 -- f ) D POP H POP <1 JMP END-CODE : MIN (S n1 n2 -- n3 ) 2DUP > IF SWAP THEN DROP ; : MAX (S n1 n2 -- n3 ) 2DUP < IF SWAP THEN DROP ; : BETWEEN (S n1 min max -- f ) >R OVER > SWAP R> > OR NOT ; : WITHIN (S n1 min max -- f ) 1- BETWEEN ; \ 32 bit Memory Operations 09MAR83HHLCODE 2@ (S addr -- d ) H POP 2 D LXI D DAD M E MOV H INX M D MOV D PUSH -3 D LXI D DAD M E MOV H INX M D MOV D PUSH NEXT END-CODE CODE 2! (S d addr -- ) H POP D POP E M MOV H INX D M MOV H INX D POP E M MOV H INX D M MOV NEXT END-CODE \ 32 bit Memory and Stack Operations 13Apr84mapCODE 2DROP (S d -- ) H POP H POP NEXT END-CODE CODE 2DUP (S d -- d d ) H POP D POP D PUSH H PUSH DPUSH JMP END-CODE CODE 2SWAP (S d1 d2 -- d2 d1 ) H POP D POP XTHL H PUSH 5 H LXI SP DAD M A MOV D M MOV A D MOV H DCX M A MOV E M MOV A E MOV H POP DPUSH JMP END-CODE CODE 2OVER (S d2 d2 -- d1 d2 d1 ) 7 H LXI SP DAD M D MOV H DCX M E MOV D PUSH H DCX M D MOV H DCX M E MOV D PUSH NEXT END-CODE : 3DUP (S a b c -- a b c a b c ) DUP 2OVER ROT ; : 4DUP (S a b c d -- a b c d a b c d ) 2OVER 2OVER ; : 2ROT (S a b c d e f --- c d e f a b ) 5 ROLL 5 ROLL ; \ 32 bit Arithmetic Operations 13Apr84mapCODE D+ (S d1 d2 -- dsum ) 6 H LXI SP DAD M E MOV C M MOV H INX M D MOV B M MOV B POP H POP D DAD XCHG H POP L A MOV C ADC A L MOV H A MOV B ADC A H MOV B POP DPUSH JMP END-CODE CODE DNEGATE (S d# -- d#' ) H POP D POP A SUB E SUB A E MOV 0 A MVI D SBB A D MOV 0 A MVI L SBB A L MOV 0 A MVI H SBB A H MOV DPUSH JMP END-CODE CODE S>D (S n -- d ) D POP 0 H LXI D A MOV 128 ANI 0= NOT IF H DCX THEN DPUSH JMP END-CODE CODE DABS (S d# -- d# ) H POP H PUSH H A MOV A ORA ' DNEGATE @-T JM NEXT END-CODE \ 32 bit Arithmetic Operations 06Apr84mapCODE D2* (S d -- d*2 ) H POP D POP E A MOV RAL A E MOV D A MOV RAL A D MOV L A MOV RAL A L MOV H A MOV RAL A H MOV DPUSH JMP END-CODE CODE D2/ (S d -- d/2 ) H POP D POP H A MOV RLC RRC RAL A H MOV L A MOV RAL A L MOV D A MOV RAL A D MOV E A MOV RAL A E MOV DPUSH JMP END-CODE : D- (S d1 d2 -- d3 ) DNEGATE D+ ; : ?DNEGATE (S d1 n -- d2 ) 0< IF DNEGATE THEN ; \ 32 bit Comparison Operations 05Oct83map: D0= (S d -- f ) OR 0= ; : D= (S d1 d2 -- f ) D- D0= ; : DU< (S ud1 ud2 -- f ) ROT SWAP 2DUP U< IF 2DROP 2DROP TRUE ELSE <> IF 2DROP FALSE ELSE U< THEN THEN ; : D< (S d1 d2 -- f ) 2 PICK OVER = IF DU< ELSE NIP ROT DROP < THEN ; : D> (S d1 d2 -- f ) 2SWAP D< ; : DMIN (S d1 d2 -- d3 ) 4DUP D> IF 2SWAP THEN 2DROP ; : DMAX (S d1 d2 -- d3 ) 4DUP D< IF 2SWAP THEN 2DROP ; \ Mixed Mode Arithmetic 01Oct83map: *D (S n1 n2 -- d# ) 2DUP XOR >R ABS SWAP ABS UM* R> ?DNEGATE ; : M/MOD (S d# n1 -- rem quot ) ?DUP IF DUP >R 2DUP XOR >R >R DABS R@ ABS UM/MOD SWAP R> ?NEGATE SWAP R> 0< IF NEGATE OVER IF 1- R@ ROT - SWAP THEN THEN R> DROP THEN ; : MU/MOD (S d# n1 -- rem d#quot ) >R 0 R@ UM/MOD R> SWAP >R UM/MOD R> ; \ 16 bit multiply and divide 27Sep83map: * (S n1 n2 -- n3 ) UM* DROP ; : /MOD (S n1 n2 -- rem quot ) >R S>D R> M/MOD ; : / (S n1 n2 -- quot ) /MOD NIP ; : MOD (S n1 n2 -- rem ) /MOD DROP ; : */MOD (S n1 n2 n3 -- rem quot ) >R *D R> M/MOD ; : */ (S n1 n2 n3 -- n1*n2/n3 ) */MOD NIP ; \ Task Dependant USER Variables 24Mar84mapUSER DEFINITIONS VARIABLE TOS ( TOP OF STACK ) VARIABLE ENTRY ( ENTRY POINT, CONTAINS MACHINE CODE ) VARIABLE LINK ( LINK TO NEXT TASK ) VARIABLE SP0 ( INITIAL PARAMETER STACK ) VARIABLE RP0 ( INITIAL RETURN STACK ) VARIABLE DP ( DICTIONARY POINTER ) VARIABLE #OUT ( NUMBER OF CHARACTERS EMITTED ) VARIABLE #LINE ( THE NUMBER OF LINES SENT SO FAR ) VARIABLE OFFSET ( RELATIVE TO ABSOLUTE DISK BLOCK 0 ) VARIABLE BASE ( FOR NUMERIC INPUT AND OUTPUT ) VARIABLE HLD ( POINTS TO LAST CHARACTER HELD IN PAD ) VARIABLE FILE ( POINTS TO FCB OF CURRENTLY OPEN FILE ) VARIABLE IN-FILE ( POINTS TO FCB OF CURRENTLY OPEN FILE ) VARIABLE PRINTING \ System VARIABLEs 24Mar84mapDEFER EMIT ( TO ALLOW PRINT SPOOLING ) META DEFINITIONS VARIABLE SCR ( SCREEN LAST LISTED OR EDITED ) VARIABLE PRIOR ( USED FOR DICTIONARY SEARCHES ) VARIABLE STATE ( COMPILATION OR INTERPRETATION ) VARIABLE WARNING ( GIVE USER DUPLICATE WARNINGS IF ON ) VARIABLE DPL ( NUMERIC INPUT PUNCTUATION ) VARIABLE R# ( EDITING CURSOR POSITION ) VARIABLE LAST ( POINTS TO NFA OF LATEST DEFINITION ) VARIABLE CSP ( HOLDS STACK POINTER FOR ERROR CHECKING ) VARIABLE CURRENT ( VOCABULARY WHICH GETS DEFINITIONS ) 8 CONSTANT #VOCS ( THE NUMBER OF VOCABULARIES TO SEARCH ) VARIABLE CONTEXT ( VOCABULARY SEARCHED FIRST ) HERE THERE #VOCS 2* DUP ALLOT ERASE \ System Variables 08Jan84mapVARIABLE 'TIB ( ADDRESS OF TERMINAL INPUT BUFFER ) VARIABLE WIDTH ( WIDTH OF NAME FIELD ) VARIABLE VOC-LINK ( POINTS TO NEWEST VOCABULARY ) VARIABLE BLK ( BLOCK NUMBER TO INTERPRET ) VARIABLE >IN ( OFFSET INTO INPUT STREAM ) VARIABLE SPAN ( NUMBER OF CHARACTERS EXPECTED ) VARIABLE #TIB ( NUMBER OF CHARACTERS TO INTERPRET ) VARIABLE END? ( TRUE IF INPUT STREAM EXHAUSTED ) \ Devices Strings 13Apr84map 32 CONSTANT BL 8 CONSTANT BS 7 CONSTANT BELL VARIABLE CAPS CODE FILL ( start-addr count char -- ) IP>HL D POP B POP XTHL XCHG BEGIN B A MOV C ORA 0= NOT WHILE L A MOV D STAX D INX B DCX REPEAT B POP NEXT END-CODE : ERASE (S addr len -- ) 0 FILL ; : BLANK (S addr len -- ) BL FILL ; CODE COUNT (S addr -- addr+1 len ) H POP M E MOV 0 D MVI H INX XCHG DPUSH JMP END-CODE CODE LENGTH (S addr -- addr+2 len ) H POP M E MOV H INX M D MOV ' COUNT @-T 4 + JMP END-CODE : MOVE ( from to len -- ) -ROT 2DUP U< IF ROT CMOVE> ELSE ROT CMOVE THEN ; \ Devices Strings 13Apr84mapASSEMBLER LABEL >UPPER ASCII a CPI RC ASCII z 1+ CPI RNC BL SUI RET CODE UPC (S char -- char' ) H POP L A MOV >UPPER CALL A L MOV H PUSH NEXT END-CODE CODE UPPER (S addr len -- ) D POP H POP BEGIN D A MOV E ORA 0= NOT WHILE M A MOV >UPPER CALL A M MOV H INX D DCX REPEAT NEXT END-CODE : HERE (S -- addr ) DP @ ; : PAD (S -- addr ) HERE 80 + ; : -TRAILING (S addr len -- addr len' ) DUP 0 ?DO 2DUP + 1- C@ BL <> ?LEAVE 1- LOOP ; \ Devices Strings 26Sep83mapCODE COMP (S addr1 addr2 len -- -1 | 0 | 1 ) C L MOV B H MOV B POP D POP XTHL ( Stack=IP BC=len DE=addr2 HL=addr1 ) BEGIN B A MOV C ORA 0= NOT WHILE M A MOV XCHG M CMP XCHG 0= IF D INX H INX B DCX ELSE 0< IF 1 H LXI ELSE -1 H LXI THEN B POP HPUSH JMP THEN REPEAT 0 H LXI B POP HPUSH JMP END-CODE \ Devices Strings 26Sep83mapCODE CAPS-COMP (S addr1 addr2 len -- -1 | 0 | 1 ) C L MOV B H MOV B POP D POP XTHL ( Stack=IP BC=len DE=addr2 HL=addr1 ) BEGIN B A MOV C ORA 0= NOT WHILE M A MOV >UPPER CALL B PUSH A C MOV XCHG M A MOV >UPPER CALL C CMP B POP XCHG 0= IF D INX H INX B DCX ELSE 0< IF 1 H LXI ELSE -1 H LXI THEN B POP HPUSH JMP THEN REPEAT 0 H LXI B POP HPUSH JMP END-CODE : COMPARE (S addr1 addr2 len -- -1 | 0 | 1 ) CAPS @ IF CAPS-COMP ELSE COMP THEN ; \ Devices Terminal IO via CP/M BIOS 11Apr84mapCODE BDOS (S n fun -- m ) H POP D POP B PUSH L C MOV 5 CALL 0 H MVI A L MOV B POP HPUSH JMP END-CODE CODE BIOS (S parm func# -- ret ) 1 LHLD D POP D DCX D DAD D DAD D DAD D POP B PUSH D B MOV E C MOV HERE 5 + D LXI D PUSH PCHL 0 H MVI A L MOV B POP HPUSH JMP END-CODE : (KEY?) (S -- f ) 0 2 BIOS 0<> ; : (KEY) (S -- char ) BEGIN PAUSE (KEY?) UNTIL 0 3 BIOS ; : (CONSOLE) (S char -- ) PAUSE 4 BIOS DROP 1 #OUT +! ; \ Devices Terminal Input and Output 19Apr84mapDEFER KEY? DEFER KEY DEFER CR : PR-STAT (S -- f ) TRUE ( 0 15 BIOS ) ; : (PRINT) (S char -- ) BEGIN PAUSE PR-STAT UNTIL 5 BIOS DROP 1 #OUT +! ; : (EMIT) (S char -- ) PRINTING @ IF DUP (PRINT) -1 #OUT +! THEN (CONSOLE) ; : CRLF (S -- ) 13 EMIT 10 EMIT #OUT OFF 1 #LINE +! ; : TYPE (S addr len -- ) 0 ?DO COUNT EMIT LOOP DROP ; : SPACE (S -- ) BL EMIT ; : SPACES (S n -- ) 0 MAX 0 ?DO SPACE LOOP ; : BACKSPACES (S n -- ) 0 ?DO BS EMIT LOOP ; : BEEP (S -- ) BELL EMIT ; \ Devices System Dependent Control Characters 02Apr84map: BS-IN (S n c -- 0 | n-1 ) DROP DUP IF 1- BS ELSE BELL THEN EMIT ; : (DEL-IN) (S n c -- 0 | n-1 ) DROP DUP IF 1- BS EMIT SPACE BS ELSE BELL THEN EMIT ; : BACK-UP (S n c -- 0 ) DROP DUP BACKSPACES DUP SPACES BACKSPACES 0 ; : RES-IN (S c -- ) FORTH TRUE ABORT" Reset" ; : P-IN (S c -- ) DROP PRINTING @ NOT PRINTING ! ; \ Devices Terminal Input 16FEB84MAP: CR-IN (S m a n c -- m a m ) DROP SPAN ! OVER BL EMIT ; : (CHAR) (S a n char -- a n+1 ) 3DUP EMIT + C! 1+ ; DEFER CHAR DEFER DEL-IN VARIABLE CC CREATE CC-FORTH ] CHAR CHAR CHAR RES-IN CHAR CHAR CHAR CHAR BS-IN CHAR CHAR CHAR CHAR CR-IN CHAR CHAR P-IN CHAR CHAR CHAR CHAR BACK-UP CHAR CHAR BACK-UP CHAR CHAR CHAR CHAR CHAR CHAR CHAR [ \ Devices Terminal Input 29Sep83map: EXPECT (S adr len -- ) DUP SPAN ! SWAP 0 ( len adr 0 ) BEGIN 2 PICK OVER - ( len adr #so-far #left ) WHILE KEY DUP BL < IF DUP 2* CC @ + PERFORM ELSE DUP 127 = IF DEL-IN ELSE CHAR THEN THEN REPEAT 2DROP DROP ; : TIB (S -- adr ) 'TIB @ ; : QUERY (S -- ) TIB 80 EXPECT SPAN @ #TIB ! BLK OFF >IN OFF ; \ Devices BLOCK I/O 11Mar84map 4 CONSTANT #BUFFERS 1024 CONSTANT B/BUF 128 CONSTANT B/REC 8 CONSTANT REC/BLK 42 CONSTANT B/FCB VARIABLE DISK-ERROR -2 CONSTANT LIMIT #BUFFERS 1+ 8 * 2+ CONSTANT >SIZE LIMIT B/BUF #BUFFERS * - CONSTANT FIRST FIRST >SIZE - CONSTANT INIT-R0 : >BUFFERS (S -- adr ) FIRST >SIZE - ; : >END (S -- adr ) FIRST 2- ; : BUFFER# (S n -- adr ) 8* >BUFFERS + ; : >UPDATE (S -- adr ) 1 BUFFER# 6 + ; \ Devices BLOCK I/O 13Apr84mapDEFER READ-BLOCK (S buffer-header -- ) DEFER WRITE-BLOCK (S buffer-header -- ) : .FILE (S adr -- ) COUNT ?DUP IF ASCII @ + EMIT ." :" THEN 8 2DUP -TRAILING TYPE + ." ." 3 TYPE SPACE ; : FILE? (S -- ) FILE @ .FILE ; : SWITCH (S -- ) FILE @ IN-FILE @ FILE ! IN-FILE ! ; VOCABULARY DOS DOS DEFINITIONS : !FILES (S fcb -- ) DUP FILE ! IN-FILE ! ; : DISK-ABORT (S fcb a n -- ) TYPE ." in " .FILE ABORT ; : ?DISK-ERROR (S fcb n -- ) DUP DISK-ERROR ! IF " Disk error" DISK-ABORT ELSE DROP THEN ; \ Devices BLOCK I/O 04Apr84mapCREATE FCB1 B/FCB ALLOT : CLR-FCB (S fcb -- ) DUP B/FCB ERASE 1+ 11 BLANK ; : SET-DMA (S adr -- ) 26 BDOS DROP ; : RECORD# (S fcb -- adr ) 33 + ; : MAXREC# (S fcb -- adr ) 38 + ; : IN-RANGE (S fcb -- fcb ) DUP MAXREC# @ OVER RECORD# @ U< DUP DISK-ERROR ! IF 1 BUFFER# ON " Out of Range" DISK-ABORT THEN ; : REC-READ (S fcb -- ) DUP IN-RANGE 33 BDOS ?DISK-ERROR ; : REC-WRITE (S fcb -- ) DUP IN-RANGE 34 BDOS ?DISK-ERROR ; \ Devices BLOCK I/O 29Mar84map: SET-IO (S buf-header -- file buffer rec/blk 0 ) DUP 2@ REC/BLK * OVER RECORD# ! SWAP 4 + @ ( buf-addr ) REC/BLK 0 ; : FILE-READ (S buffer-header -- ) SET-IO DO 2DUP SET-DMA DUP REC-READ 1 SWAP RECORD# +! B/REC + LOOP 2DROP ; : FILE-WRITE (S buffer-header -- ) SET-IO DO 2DUP SET-DMA DUP REC-WRITE 1 SWAP RECORD# +! B/REC + LOOP 2DROP ; : FILE-IO (S -- ) ['] FILE-READ IS READ-BLOCK ['] FILE-WRITE IS WRITE-BLOCK ; \ Devices BLOCK I/O 29Mar84mapFORTH DEFINITIONS : CAPACITY (S -- n ) [ DOS ] FILE @ MAXREC# @ 1+ 0 8 UM/MOD NIP ; : LATEST? (S n fcb -- fcb n | a f ) DISK-ERROR OFF SWAP OFFSET @ + 2DUP 1 BUFFER# 2@ D= IF 2DROP 1 BUFFER# 4 + @ FALSE R> DROP THEN ; : ABSENT? (S n fcb -- a f ) LATEST? FALSE #BUFFERS 1+ 2 DO DROP 2DUP I BUFFER# 2@ D= IF 2DROP I LEAVE ELSE FALSE THEN LOOP ?DUP IF BUFFER# DUP >BUFFERS 8 CMOVE >R >BUFFERS DUP 8 + OVER R> SWAP - CMOVE> 1 BUFFER# 4 + @ FALSE ELSE >BUFFERS 2! TRUE THEN ; \ Devices BLOCK I/O 01Apr84map: UPDATE (S -- ) >UPDATE ON ; : DISCARD (S -- ) 1 >UPDATE ! ( 1 BUFFER# ON ) ; : MISSING (S -- ) >END 2- @ 0< IF >END 2- OFF >END 8 - WRITE-BLOCK THEN >END 4 - @ >BUFFERS 4 + ! ( buffer ) 1 >BUFFERS 6 + ! >BUFFERS DUP 8 + #BUFFERS 8* CMOVE> ; : (BUFFER) (S n fcb -- a ) PAUSE ABSENT? IF MISSING 1 BUFFER# 4 + @ THEN ; : BUFFER (S n -- a ) FILE @ (BUFFER) ; : (BLOCK) (S n fcb -- a ) (BUFFER) >UPDATE @ 0> IF 1 BUFFER# DUP READ-BLOCK 6 + OFF THEN ; : BLOCK (S n -- a ) FILE @ (BLOCK) ; : IN-BLOCK (S n -- a ) IN-FILE @ (BLOCK) ; \ Devices BLOCK I/O 01APR84MAP: EMPTY-BUFFERS (S -- ) FIRST LIMIT OVER - ERASE >BUFFERS #BUFFERS 1+ 8* ERASE FIRST 1 BUFFER# #BUFFERS 0 DO DUP ON 4 + 2DUP ! SWAP B/BUF + SWAP 4 + LOOP 2DROP ; : SAVE-BUFFERS (S -- ) 1 BUFFER# #BUFFERS 0 DO DUP @ 1+ IF DUP 6 + @ 0< IF DUP WRITE-BLOCK DUP 6 + OFF THEN 8 + THEN LOOP DROP ; : FLUSH (S -- ) SAVE-BUFFERS 0 BLOCK DROP EMPTY-BUFFERS ; : VIEW# (S -- addr ) FILE @ 40 + ; \ Devices BLOCK I/O 04Apr84mapDOS DEFINITIONS : FILE-SIZE (S fcb -- n ) DUP 35 BDOS DROP RECORD# @ ; : DOS-ERR? (S -- f ) 255 = ; : OPEN-FILE (S -- ) IN-FILE @ DUP 15 BDOS DOS-ERR? IF " Open error" DISK-ABORT THEN DUP FILE-SIZE 1- SWAP MAXREC# ! ; HEX 5C CONSTANT DOS-FCB DECIMAL FORTH DEFINITIONS : DEFAULT (S -- ) [ DOS ] FCB1 DUP IN-FILE ! DUP FILE ! CLR-FCB DOS-FCB 1+ C@ BL <> IF DOS-FCB FCB1 12 CMOVE OPEN-FILE THEN ; : (LOAD) (S n -- ) FILE @ >R BLK @ >R >IN @ >R >IN OFF BLK ! IN-FILE @ FILE ! RUN R> >IN ! R> BLK ! R> !FILES ; DEFER LOAD \ Interactive Layer Number Input 04Apr84mapCODE DIGIT (S char base -- n true | char false ) H POP D POP D PUSH E A MOV ASCII 0 SUI NO JM 10 CPI 0< NOT IF 7 SUI 10 CPI NO JM THEN L CMP NO JP A E MOV H POP D PUSH YES JMP END-CODE : DOUBLE? (S -- f ) DPL @ 1+ 0<> ; : CONVERT (S +d1 adr1 -- +d2 adr2 ) BEGIN 1+ DUP >R C@ BASE @ DIGIT WHILE SWAP BASE @ UM* DROP ROT BASE @ UM* D+ DOUBLE? IF 1 DPL +! THEN R> REPEAT DROP R> ; \ Interactive Layer Number Input 06Oct83map: (NUMBER?) (S adr -- d flag ) 0 0 ROT DUP 1+ C@ ASCII - = DUP >R - -1 DPL ! BEGIN CONVERT DUP C@ ASCII , ASCII / BETWEEN WHILE 0 DPL ! REPEAT -ROT R> IF DNEGATE THEN ROT C@ BL = ; : NUMBER? (S adr -- d flag ) FALSE OVER COUNT BOUNDS ?DO I C@ BASE @ DIGIT NIP IF DROP TRUE LEAVE THEN LOOP IF (NUMBER?) ELSE DROP 0 0 FALSE THEN ; : (NUMBER) (S adr -- d# ) NUMBER? NOT ?MISSING ; DEFER NUMBER \ Interactive Layer Number Output 03Apr84map: HOLD (S char -- ) -1 HLD +! HLD @ C! ; : <# (S -- ) PAD HLD ! ; : #> (S d# -- addr len ) 2DROP HLD @ PAD OVER - ; : SIGN (S n1 -- ) 0< IF ASCII - HOLD THEN ; : # (S -- ) BASE @ MU/MOD ROT 9 OVER < IF 7 + THEN ASCII 0 + HOLD ; : #S (S -- ) BEGIN # 2DUP OR 0= UNTIL ; : HEX (S -- ) 16 BASE ! ; : DECIMAL (S -- ) 10 BASE ! ; : OCTAL (S -- ) 8 BASE ! ; \ Interactive Layer Number Output 24FEB83HHL: (U.) (S u -- a l ) 0 <# #S #> ; : U. (S u -- ) (U.) TYPE SPACE ; : U.R (S u l -- ) >R (U.) R> OVER - SPACES TYPE ; : (.) (S n -- a l ) DUP ABS 0 <# #S ROT SIGN #> ; : . (S n -- ) (.) TYPE SPACE ; : .R (S n l -- ) >R (.) R> OVER - SPACES TYPE ; : (UD.) (S ud -- a l ) <# #S #> ; : UD. (S ud -- ) (UD.) TYPE SPACE ; : UD.R (S ud l -- ) >R (UD.) R> OVER - SPACES TYPE ; : (D.) (S d -- a l ) TUCK DABS <# #S ROT SIGN #> ; : D. (S d -- ) (D.) TYPE SPACE ; : D.R (S d l -- ) >R (D.) R> OVER - SPACES TYPE ; \ Interactive Layer Parsing 30Sep83mapLABEL $DONE B POP H PUSH D PUSH NEXT END-CODE CODE SKIP (S addr len char -- addr' len' ) IP>HL B POP D POP XTHL ( C=char DE=length HL=addr ) BEGIN D A MOV E ORA 0<> WHILE M A MOV C CMP $DONE JNZ H INX D DCX REPEAT $DONE JMP END-CODE CODE SCAN (S addr len char -- addr' len' ) IP>HL B POP D POP XTHL ( C=char DE=length HL=addr ) BEGIN D A MOV E ORA 0<> WHILE M A MOV C CMP $DONE JZ H INX D DCX REPEAT $DONE JMP END-CODE \ Interactive Layer Parsing 02Apr84map: /STRING (S addr len n -- addr' len' ) OVER MIN ROT OVER + -ROT - ; : PLACE (S str-addr len to -- ) 3DUP 1+ SWAP MOVE C! DROP ; : (SOURCE) (S -- addr len ) BLK @ ?DUP IF BLOCK B/BUF ELSE TIB #TIB @ THEN ; DEFER SOURCE : PARSE-WORD (S char -- addr len ) >R SOURCE TUCK >IN @ /STRING R@ SKIP OVER SWAP R> SCAN >R OVER - ROT R> DUP 0<> + - >IN ! ; : PARSE (S char -- addr len ) >R SOURCE >IN @ /STRING OVER SWAP R> SCAN >R OVER - DUP R> 0<> - >IN +! ; \ Interactive Layer Parsing 07Mar84map: 'WORD (S -- adr ) HERE ; : WORD (S char -- addr ) PARSE-WORD 'WORD PLACE 'WORD DUP COUNT + BL SWAP C! ( Stick Blank at end ) ; : >TYPE (S adr len -- ) TUCK PAD SWAP CMOVE PAD SWAP TYPE ; : .( (S -- ) ASCII ) PARSE >TYPE ; IMMEDIATE : ( (S -- ) ASCII ) PARSE 2DROP ; IMMEDIATE : \S (S -- ) END? ON ; IMMEDIATE \ Interactive Layer Dictionary 26May84mapCODE TRAVERSE (S addr direction -- addr' ) D POP H POP 127 A MVI BEGIN D DAD M CMP 0< UNTIL HPUSH JMP END-CODE : DONE? (S n -- f ) STATE @ <> END? @ OR END? OFF ; : FORTH-83 (S -- ) FORTH DEFINITIONS CAPS OFF ; \ Interactive Layer Dictionary 04Apr84map: N>LINK 2- ; : L>NAME 2+ ; : BODY> 2- ; : NAME> 1 TRAVERSE 1+ ; : LINK> L>NAME NAME> ; : >BODY 2+ ; : >NAME 1- -1 TRAVERSE ; : >LINK >NAME N>LINK ; : >VIEW >LINK 2- ; : VIEW> 2+ LINK> ; \ Interactive Layer Dictionary 27AUG83HHLCODE HASH (S str-addr voc-ptr -- thread ) D POP H POP H INX M A MOV 3 ANI A L MOV 0 H MVI H DAD D DAD HPUSH JMP END-CODE CODE (FIND) (S here nfa -- here false | cfa flag ) H POP H A MOV L ORA NO JZ BEGIN D POP D PUSH H PUSH H INX H INX D LDAX M XRA 63 ANI 0= IF BEGIN D INX H INX D LDAX M XRA A ADD 0= IF 2SWAP CS UNTIL H INX D POP XTHL XCHG H INX H INX M A MOV 64 ANI YES JZ 1 H LXI HPUSH JMP THEN THEN H POP M E MOV H INX M D MOV XCHG H A MOV L ORA 0= UNTIL NO JMP END-CODE \ Interactive Layer Dictionary 03Apr84map4 CONSTANT #THREADS : FIND (S addr -- cfa flag | addr false ) DUP C@ IF PRIOR OFF FALSE #VOCS 0 DO DROP CONTEXT I 2* + @ DUP IF DUP PRIOR @ OVER PRIOR ! = IF DROP FALSE ELSE OVER SWAP HASH @ (FIND) DUP ?LEAVE THEN THEN LOOP ELSE DROP END? ON ['] NOOP 1 THEN ; : ?UPPERCASE (S adr -- adr ) CAPS @ IF DUP COUNT UPPER THEN ; : DEFINED (S -- here 0 | cfa [ -1 | 1 ] ) BL WORD ?UPPERCASE FIND ; \ Interactive Layer Interpreter 27Sep83map: ?STACK (S -- ) ( System dependant ) SP@ SP0 @ SWAP U< ABORT" Stack Underflow" SP@ PAD U< ABORT" Stack Overflow" ; DEFER STATUS (S -- ) : INTERPRET (S -- ) BEGIN ?STACK DEFINED IF EXECUTE ELSE NUMBER DOUBLE? NOT IF DROP THEN THEN FALSE DONE? UNTIL ; \ Extensible Layer Compiler 11Apr84map: ALLOT (S n -- ) DP +! ; : , (S n -- ) HERE ! 2 ALLOT ; : C, (S char -- ) HERE C! 1 ALLOT ; : ALIGN ( HERE 1 AND IF BL C, THEN ) ; IMMEDIATE : EVEN ( DUP 1 AND + ) ; IMMEDIATE : COMPILE (S -- ) R> DUP 2+ >R @ , ; : IMMEDIATE (S -- ) 64 ( Precedence bit ) LAST @ CSET ; : LITERAL (S n -- ) COMPILE (LIT) , ; IMMEDIATE : DLITERAL (S d# -- ) SWAP [COMPILE] LITERAL [COMPILE] LITERAL ; IMMEDIATE : ASCII (S -- n ) BL WORD 1+ C@ STATE @ IF [COMPILE] LITERAL THEN ; IMMEDIATE : CONTROL (S -- n ) BL WORD 1+ C@ 31 AND STATE @ IF [COMPILE] LITERAL THEN ; IMMEDIATE \ Extensible Layer Compiler 08Oct83map: CRASH (S -- ) TRUE ABORT" Uninitialized execution vector." ; : ?MISSING (S f -- ) IF 'WORD COUNT TYPE TRUE ABORT" ?" THEN ; : ' (S -- cfa ) DEFINED 0= ?MISSING ; : ['] (S -- ) ' [COMPILE] LITERAL ; IMMEDIATE : [COMPILE] (S -- ) ' , ; IMMEDIATE : (") (S -- addr len ) R> COUNT 2DUP + EVEN >R ; : (.") (S -- ) R> COUNT 2DUP + EVEN >R TYPE ; : ," (S -- ) ASCII " PARSE TUCK 'WORD PLACE 1+ ALLOT ALIGN ; : ." (S -- ) COMPILE (.") ," ; IMMEDIATE : " (S -- ) COMPILE (") ," ; IMMEDIATE \ Interactive Layer Dictionary 12Apr84mapVARIABLE FENCE : TRIM (S faddr voc-addr -- ) #THREADS 0 DO 2DUP @ BEGIN 2DUP U> NOT WHILE @ REPEAT NIP OVER ! 2+ LOOP 2DROP ; : (FORGET) (S addr -- ) DUP FENCE @ U< ABORT" Below fence" DUP VOC-LINK @ BEGIN 2DUP U< WHILE @ REPEAT DUP VOC-LINK ! NIP BEGIN DUP WHILE 2DUP #THREADS 2* - TRIM @ REPEAT DROP DP ! ; : FORGET (S -- ) BL WORD ?UPPERCASE DUP CURRENT @ HASH @ (FIND) 0= ?MISSING >VIEW (FORGET) ; \ Extensible Layer Compiler 11Mar84mapDEFER WHERE DEFER ?ERROR : (?ERROR) (S adr len f -- ) IF >R >R SP0 @ SP! PRINTING OFF BLK @ IF >IN @ BLK @ WHERE THEN R> R> SPACE TYPE SPACE QUIT ELSE 2DROP THEN ; : (ABORT") (S f -- ) R@ COUNT ROT ?ERROR R> COUNT + EVEN >R ; : ABORT" (S -- ) COMPILE (ABORT") ," ; IMMEDIATE : ABORT (S -- ) TRUE ABORT" " ; \ Extensible Layer Structures 03Apr84map: ?CONDITION (S f -- ) NOT ABORT" Conditionals Wrong" ; : >MARK (S -- addr ) HERE 0 , ; : >RESOLVE (S addr -- ) HERE SWAP ! ; : MARK (S -- f addr ) TRUE >MARK ; : ?>RESOLVE (S f addr -- ) SWAP ?CONDITION >RESOLVE ; : ?RESOLVE ; IMMEDIATE : DO COMPILE (DO) ?>MARK ; IMMEDIATE : ?DO COMPILE (?DO) ?>MARK ; IMMEDIATE : LOOP COMPILE (LOOP) 2DUP 2+ ?RESOLVE ; IMMEDIATE : +LOOP COMPILE (+LOOP) 2DUP 2+ ?RESOLVE ; IMMEDIATE : UNTIL COMPILE ?BRANCH ?MARK ; IMMEDIATE : ELSE COMPILE BRANCH ?>MARK 2SWAP ?>RESOLVE ; IMMEDIATE : WHILE [COMPILE] IF ; IMMEDIATE \ Extensible Layer Defining Words 08Apr84map: ,VIEW (S -- ) BLK @ DUP IF VIEW# @ 4096 * + THEN , ; : "CREATE (S str -- ) COUNT HERE EVEN 4 + PLACE ALIGN ,VIEW HERE 0 , ( reserve link ) HERE LAST ! ( remember nfa ) HERE ( lfa nfa ) WARNING @ IF FIND IF HERE COUNT TYPE ." isn't unique " THEN DROP HERE THEN ( lfa nfa ) CURRENT @ HASH DUP @ ( lfa tha prev ) HERE 2- ROT ! ( lfa prev ) SWAP ! ( Resolve link field) HERE DUP C@ WIDTH @ MIN 1+ ALLOT ALIGN 128 SWAP CSET 128 HERE 1- CSET ( delimiter Bits ) COMPILE [ [FORTH] ASSEMBLER DOCREATE , META ] ; : CREATE (S -- ) BL WORD ?UPPERCASE "CREATE ; \ Extensible Layer Defining Words 04Apr84map: !CSP (S -- ) SP@ CSP ! ; : ?CSP (S -- ) SP@ CSP @ <> ABORT" Stack Changed" ; : HIDE (S -- ) LAST @ DUP N>LINK @ SWAP CURRENT @ HASH ! ; : REVEAL (S -- ) LAST @ DUP N>LINK SWAP CURRENT @ HASH ! ; : (;USES) (S -- ) R> @ LAST @ NAME> ! ; VOCABULARY ASSEMBLER : ;USES (S -- ) ?CSP COMPILE (;USES) [COMPILE] [ REVEAL ASSEMBLER ; IMMEDIATE : (;CODE) (S -- ) R> LAST @ NAME> ! ; : ;CODE (S -- ) ?CSP COMPILE (;CODE) [COMPILE] [ REVEAL ASSEMBLER ; IMMEDIATE : DOES> (S -- ) COMPILE (;CODE) 205 ( CALL ) C, [ [ASSEMBLER] DODOES META ] LITERAL , ; IMMEDIATE \ Extensible Layer Defining Words 27Sep83map: [ (S -- ) STATE OFF ; IMMEDIATE : ] (S -- ) STATE ON BEGIN ?STACK DEFINED DUP IF 0> IF EXECUTE ELSE , THEN ELSE DROP NUMBER DOUBLE? IF [COMPILE] DLITERAL ELSE DROP [COMPILE] LITERAL THEN THEN TRUE DONE? UNTIL ; : : (S -- ) !CSP CURRENT @ CONTEXT ! CREATE HIDE ] ;USES NEST , : ; (S -- ) ?CSP COMPILE UNNEST REVEAL [COMPILE] [ ; IMMEDIATE \ Extensible Layer Defining Words 03Apr84map: RECURSIVE (S -- ) REVEAL ; IMMEDIATE : CONSTANT (S n -- ) CREATE , ;USES DOCONSTANT , : VARIABLE (S -- ) CREATE 0 , ;USES DOCREATE , : DEFER (S -- ) CREATE ['] CRASH , ;USES DODEFER , DODEFER RESOLVES : VOCABULARY (S -- ) CREATE #THREADS 0 DO 0 , LOOP HERE VOC-LINK @ , VOC-LINK ! DOES> CONTEXT ! ; RESOLVES : DEFINITIONS (S -- ) CONTEXT @ CURRENT ! ; \ Extensible Layer Defining Words 03Apr84map: 2CONSTANT CREATE , , (S d# -- ) DOES> 2@ ; (S -- d# ) DROP : 2VARIABLE 0 0 2CONSTANT (S -- ) DOES> ; (S -- addr ) DROP VARIABLE AVOC : CODE (S -- ) CREATE HIDE HERE DUP 2- ! CONTEXT @ AVOC ! ASSEMBLER ; ASSEMBLER DEFINITIONS : END-CODE AVOC @ CONTEXT ! REVEAL ; FORTH DEFINITIONS META IN-META \ Extensible Layer Defining Words 13Apr84mapVARIABLE #USER VOCABULARY USER USER DEFINITIONS : ALLOT (S n -- ) #USER +! ; ' CREATE ( avoid recursion: leave address for , in CREATE ) : CREATE (S -- ) [ , ] #USER @ , ;USES DOUSER-VARIABLE , : VARIABLE (S -- ) CREATE 2 ALLOT ; : DEFER (S -- ) VARIABLE ;USES DOUSER-DEFER , FORTH DEFINITIONS META IN-META \ Extensible Layer ReDefining Words 21Dec83map: >IS (S cfa -- data-address ) DUP @ DUP [ [ASSEMBLER] DOUSER-VARIABLE META ] LITERAL = SWAP DUP [ [ASSEMBLER] DOUSER-DEFER META ] LITERAL = SWAP DROP OR IF >BODY @ UP @ + ELSE >BODY THEN ; : (IS) (S cfa --- ) R@ @ >IS ! R> 2+ >R ; : IS (S cfa --- ) STATE @ IF COMPILE (IS) ELSE ' >IS ! THEN ; IMMEDIATE \ Initialization High Level 29Sep83map: RUN (S -- ) STATE @ IF ] STATE @ NOT IF INTERPRET THEN ELSE INTERPRET THEN ; : QUIT (S -- ) SP0 @ 'TIB ! BLK OFF [COMPILE] [ BEGIN RP0 @ RP! STATUS QUERY RUN STATE @ NOT IF ." ok" THEN AGAIN ; DEFER BOOT : WARM (S -- ) TRUE ABORT" Warm Start" ; : COLD (S -- ) BOOT QUIT ; \ Initialization High Level 19Apr84map1 CONSTANT INITIAL : OK (S -- ) INITIAL LOAD ; : START (S -- ) EMPTY-BUFFERS DEFAULT ; : BYE ( -- ) CR HERE 0 256 UM/MOD NIP 1+ DECIMAL U. ." Pages" 0 0 BDOS ; \ Initialization Low Level 29Sep83map[FORTH] ASSEMBLER HERE ORIGIN 6 + !-T ( WARM ENTRY POINT ) ' WARM H LXI >NEXT1 JMP HERE ORIGIN 2 + !-T ( COLD ENTRY POINT ) 6 LHLD 0 L MVI ' LIMIT 2+ SHLD #BUFFERS B/BUF * NEGATE D LXI D DAD ' FIRST 2+ SHLD >SIZE NEGATE D LXI D DAD RP SHLD H PUSH RP0 D LXI !USER CALL H POP 200 NEGATE D LXI D DAD ( Return Stack Size ) H PUSH 'TIB SHLD H POP H PUSH SP0 D LXI !USER CALL H POP SPHL ' COLD H LXI >NEXT1 JMP \ Initialize User Variables 11Apr84mapHERE UP !-T ( SET UP USER AREA ) 0 , ( TOS ) 0 , ( ENTRY ) 0 , ( LINK ) INIT-R0 256 - , ( SP0 ) INIT-R0 , ( RP0 ) 0 , ( DP ) ( Must be patched later ) 0 , ( #OUT ) 0 , ( #LINE ) 0 , ( OFFSET ) 10 , ( BASE ) 0 , ( HLD ) 0 , ( FILE ) 0 , ( IN-FILE ) FALSE , ( PRINTING ) ' (EMIT) , ( EMIT ) \ Resident Tools 02Apr84map: DEPTH (S -- n ) SP@ SP0 @ SWAP - 2/ ; : .S (S -- ) DEPTH ?DUP IF 0 DO DEPTH I - 1- PICK 7 U.R SPACE KEY? ?LEAVE LOOP ELSE ." Empty " THEN ; : .ID (S nfa -- ) DUP 1+ DUP C@ ROT C@ 31 AND 0 ?DO DUP 127 AND EMIT 128 AND IF ASCII _ 128 OR ELSE 1+ DUP C@ THEN LOOP 2DROP SPACE ; : DUMP (S addr len -- ) 0 DO CR DUP 6 .R SPACE 16 0 DO DUP C@ 3 .R 1+ LOOP 16 +LOOP DROP ; \ For Completeness 03Apr84map: RECURSE (S -- ) LAST @ NAME> , ; IMMEDIATE \ Resolve Forward References 21Dec83map ' (.") RESOLVES <(.")> ' (") RESOLVES <(")> ' (;CODE) RESOLVES <(;CODE)> ' (;USES) RESOLVES <(;USES)> ' (IS) RESOLVES <(IS)> ' (ABORT") RESOLVES <(ABORT")> [ASSEMBLER] DOCREATE META RESOLVES [ASSEMBLER] DOUSER-DEFER META RESOLVES [ASSEMBLER] DOUSER-VARIABLE META RESOLVES \ Resolve Forward References 04Apr84map' R> RESOLVES R> ' DUP RESOLVES DUP ' @ RESOLVES @ ' >R RESOLVES >R ' -ROT RESOLVES -ROT ' SWAP RESOLVES SWAP ' - RESOLVES - ' = RESOLVES = ' 2DROP RESOLVES 2DROP ' + RESOLVES + ' OVER RESOLVES OVER ' DEFINITIONS RESOLVES DEFINITIONS ' [ RESOLVES [ ' 2+ RESOLVES 2+ ' 1+ RESOLVES 1+ ' 2* RESOLVES 2* ' 2DUP RESOLVES 2DUP ' ?MISSING RESOLVES ?MISSING ' QUIT RESOLVES QUIT ' RUN RESOLVES RUN ' ABORT RESOLVES ABORT \ Initialize DEFER words 24Apr84map ' (LOAD) IS LOAD ' (KEY?) IS KEY? ' (KEY) IS KEY ' CRLF IS CR ' FILE-READ IS READ-BLOCK ' FILE-WRITE IS WRITE-BLOCK ' NOOP IS WHERE ' CR IS STATUS ' (SOURCE) IS SOURCE ' START IS BOOT ' (NUMBER) IS NUMBER ' (CHAR) IS CHAR ' (DEL-IN) IS DEL-IN ' (?ERROR) IS ?ERROR \ Initialize Variables 20Apr84map' FORTH >BODY CURRENT !-T ' FORTH >BODY CONTEXT !-T ' CC-FORTH >BODY CC !-T HERE-T DP UP @-T + !-T ( INIT USER DP ) #USER-T @ #USER !-T ( INIT USER VAR COUNT ) TRUE CAPS !-T ( SET TO IGNORE CASE ) TRUE WARNING !-T ( SET TO ISSUE WARNINGS ) 31 WIDTH !-T ( 31 CHARACTER NAMES ) VOC-LINK-T @ VOC-LINK !-T ( INIT VOC-LINK ) \ Further Instructions 27SEP83MAPEXIT ******************************************************************* ****** Thus we have created a hopefully running ****** Forth system for the 8080. After this file ****** has been compiled, it is saved as a COM file ****** called KERNEL.COM on the disk. To generate ****** a system you must now leave the Meta Compiler ****** and fire up KERNEL with the file EXTEND80.BLK ****** on the execute line. Be sure to prefix a B: ****** if necessary. ( KERNEL EXTEND80.BLK ) ****** Once you have fired it up, type START and it ****** will compile the applications. Good Luck. ****** *******************************************************************\ 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 \ Declare the Forward References 27Jan84map]] We will need the FORTH version of ] quite often. [[ The same is true for [[. DEFINIITONS To avoid finding DEFINITIONS in the ONLY vocabulary[ To avoid finding [ in the TRANSITION vocabulary \ Boot up Vectors and NEXT Interpreter 02AUG83HHL The first 8 bytes in the system are vectors to the Cold and Warmstart entries. You can freely jump to them in code anytime. The DPUSH and HPUSH labels are space savers. We jump to them in several CODE words when we want to push their contents on theParameter Stack. >NEXT is where all the action is. It is the guts of the Forth Virtual Machine. It must advance the interpretive pointer held in the IP register pair and jump indirect to what it points to. We define a few macros here to make our life a little easier later. Using NEXT as a macro allows us to put it inline later. \ Run Time Code for Defining Words 23JUL83HHLRP Used to hold the depth of the return stack NEST The runtime code for : It pushs the current IP onto the return stack and sets the IP to point to the parameter field of the word being executed. EXIT Pop an entry off the return stack and place it into the Interpretive Pointer. Terminates a Hi Level definition. UNNEST Same as exit. Compiled by ; to help decompiling. DODOES The runtime portion of defining words. First it pushes the IP onto the return stack and then it pushes the BODY address of the word being executed onto the parameter stack. DOCREATE Leave a pointer to its own parameter field on the stack. This is also the runtime for variable. \ Run Time Code for Defining Words 02AUG83HHLUP Holds a pointer to the current USER area. ( multitasking ) @USER A subroutine called from code level words that returns the contents of a particular user variable. !USER A subroutine called from code level words that sets the contents of a particular user variable. DOCONSTANT The run time code for CONSTANT. It takes the contents of the parameter field and pushes it onto the stack.DOUSER The run time code for USER variables. Places a pointer to the current version of this variable on the stack. Needed for multitasking. (LIT) The runtime code for literals. Pushes the following two bytes onto the parameter stack and moves the IP over them. It is compiled by the word LITERAL. \ Meta Defining Words 10MAR83HHLLITERAL Now that code field of (LIT) is known, define LITERAL DLITERAL Both LITERAL and DLITERAL are TRANSITION words, ie IMMEDIATE ASCII Compile the next character as a literal. ['] Compile the code field of the next word as a literal. CONSTANT Define a CONSTANT in the Target. We also save its value in META for use during interpretation. \ Identify numbers and forward References 02AUG83HHL<(;CODE)> Forward reference for code to patch code field. DOES> Compile the code field for (;CODE) and a CALL instruction to the run time for DOES, called DODOES. NUMERIC Make a number out of this word and compile it as either a single or double precision literal. NUMERIC is only called if the word is known to be a number. UNDEFINED Creates a forward reference "on the fly". The symbol is kept in the FORWARD vocabulary and it is initialized to unresolved. When executed it either compiles itself or links into a backwards pointing chain of forward references. \ Meta Compiler Compiling Loop 10MAR83HHLT-IN Needed to save a pointer into the input stream for later.] Start compiling into the TARGET system. Always search TRANSITION before TARGET for immediate words. If word is found, execute it. It must compile itself. If word is not found, convert it to a number if it is numeric, otherwise it is a forward reference. [ Sets STATE-T to false to exit the Meta Compiling loop above. ; Compile the code field of UNNEST and terminate compilation : Create a target word and set its code field to NEST. \ Run Time Code for Control Structures 05MAR83HHLBRANCH Performs an unconditional branch. Notice that we are using absolute addresses insead of relative ones. (fast) ?BRANCH Performs a conditional branch. If the top of the parameter stack in True, take the branch. If not, skip over the branch address which is inline. \ Meta Compiler Branching Words 10MAR83HHLThese are the META versions of the structured conditionals found in FORTH. They must compile the correct run time branch instruction, and then Mark and Resolve either forward or backward branches. These are very analogous to the regular conditionals in Forth. Since they are in the TRANSITION vocabulary, which is searched before the TARGET vocabulary, they will be executed instead of the TARGET versions of these words which are defined much later. \ Run Time Code for Control Structures 07JUL83HHLLOOP-EXIT is a common routine used by (LOOP) and (+LOOP) It is called when the loop has terminated and is exited normally. (LOOP) the runtime procedure for LOOP. Branches back to the beginning of the loop if there are more iterations to do. Otherwise it exits. The loop counter is incremented. LOOP-BRANCH A common routine needed twice in the 8080 implementation of (+LOOP). (+LOOP) Increment the loop counter by the value on the stack and decide whether or not to loop again. Due to the wierdness of the 8080, you have to stand on your head to determine the conditions under which you loop or exit. \ Run Time Code for Control Structures 28AUG83HHL(DO) The runtime code compiled by DO. Pushes the inline address onto the return stack along with values needed by (LOOP). (?DO) The runtime code compiled by ?DO. The difference between ?DO and DO is that ?DO will not perform any iterations if the initial index is equal to the final index. BOUNDS Given address and length, make it ok for DO ... LOOP. \ Meta compiler Branching & Looping 10MAR83HHLThese are again the TRANSITION versions of the immediate words for looping. They compile the correct run time code and then Mark and Resolve the various branches. \ Execution Control 06SEP83HHL>NEXT The address of the inner interpreter. EXECUTE the word whose code field is on the stack. Very useful for passing executable routines to procedures!!! PERFORM the word whose code field is stored at the address pointed to by the number on the stack. Same as @ EXECUTE DO-DEFER The runtime code for deferred words. Fetches the code field and executes it. DOUSER-DEFER The runtime code for User deferred words. These are identical to regular deferred words except that each task has its own version. GO Execute code at the given address. NOOP One of the most useful words in Forth. Does nothing. PAUSE Used by the Multitasker to switch tasks. \ Execution Control 01Oct83mapI returns the current loop index. It now requires a little more calculation to compute it than in FIG Forth but the tradeoff is a much faster (LOOP). The loop index is stored on the Return Stack. J returns the loop index of the inner loop in nested DO .. LOOPs. (LEAVE) Does an immediate exit of a DO ... LOOP structure. Unlike FIG Forth which waits until the next LOOP is executed. (?LEAVE) Leaves if the flag on the stack is true. Continues if not. LEAVE I have to do this to be 83-Standard. \ 16 and 8 bit Memory Operations 05MAR83HHL@ Fetch a 16 bit value from addr. ! Store a 16 bit value at addr. C@ Fetch an 8 bit value from addr. C! Store an 8 bit value at addr. \ Block Move Memory Operations 05MAR83HHLCMOVE Move a set of bytes from the from address to the to address. The number of bytes to be moved is count. The bytes are moved from low address to high address, so overlap is possible and in fact sometimes desired. CMOVE> The same as CMOVE above except that bytes are moved in the opposite direction, ie from high addresses to low addresses. \ 16 bit Stack Operations 02AUG83HHLSP@ Return the address of the next entry on the parameter stackSP! ( Warning, this is different from FIG Forth ) Sets the parameter stack pointer to the specified value. RP@ Return the address of the next entry on the return stack. RP! ( Warning, this is different from FIG Forth ) Sets the return stack pointer to the specified value. \ 16 bit Stack Operations 05MAR83HHLDROP Throw away the top element of the stack. DUP Duplicate the top element of the stack. SWAP Exchange the top two elements on the stack. OVER Copy the second element to the top. \ 16 bit Stack Operations 11MAR83HHLTUCK Tuck the first element under the second one. NIP Drop the second element from the stack. ROT Rotate the top three element, bringing the third to the top. -ROT The inverse of ROT. Rotates the top element to third place. FLIP Exhange the hi and low halves of a word. ?DUP Duplicate the top of the stack if it is non-zero. \ 16 bit Stack Operations 26Sep83mapR> Pops a value off of the return stack and pushes it onto the parameter stack. It is dangerous to use this randomly! >R Pops a value off of the parameter stack and pushes it onto return stack. It is dangerous to use this randomly! R@ Copies the value on the return stack to the parameter stack. PICK Reaches into the stack and grabs an element, copying it to the top of the stack. For example, if the stack has 1 2 3 Then 0 PICK is 3, 1 PICK is 2, and 2 PICK is 1. ROLL Similar to SHAKE and RATTLE. Should be avoided. 1 ROLL is SWAP, 2 ROLL is ROT, etc. ROLL can be useful, but it is slow. \ 16 bit Logical Operations 05MAR83HHLAND Returns the bitwise AND of n1 and n2 on the stack. OR Returns the bitwise OR of n1 and n2 on the stack. XOR Returns the bitwise Exclusive Or of n1 and n2 on the stack. NOT Does a ones complement of the top. Equivalent to -1 XOR. TRUE FALSE Constants for clarity. YES Push a true flag on the stack and jump to next NO Push a false flag on the stack and jump to next \ Logical Operations 83HHL 16Oct83mapCSET Set the contents of addr so that the bits that are 1 in n are also 1 in addr. Equivalent to DUP C@ ROT OR SWAP C! CRESET Set the contents of addr so the the bits that are 1 in n are zero in addr. Equivalent to DUP C@ ROT NOT AND SWAP C! CTOGGLE Flip the bits in addr by the value n. Equivalent to DUP C@ ROT XOR SWAP C! ON Set the contents of addr to TRUE OFF Set the contents of addr to FALSE \ 16 bit Arithmetic Operations 05MAR83HHL+ Add the top two numbers on the stack and return the result. NEGATE Turn the number into its negative. A twos complement op. - Subtracts n2 from n1 leaving the result on the stack. ABS Return the absolute value of the 16 bit integer on the stack +! Increment the value at addr by n. This is equivalent to the following: DUP @ ROT + SWAP ! but much faster. 0 1 Frequently used constants 2 3 Are faster and more code efficient. \ 16 bit Arithmetic Operations 26Sep83map2* Double the number on the Stack. 2/ Shift the number on the stack right one bit. Equivalent to division by 2 for positive numbers. U2/ 16 bit logical right shift. 8* Multiply the top of the stack by 8. 1+ Increment the top of the stack by one. 2+ Increment the top of the stack by two. 1- Decrement the top of the stack by one. 2- Decrement the top of the stack by two. \ 16 bit Arithmetic Operations Unsigned Multiply 26Sep83mapYou could write a whole book about multiplication and division, and in fact Knuth did. Suffice it to say that UM* is the basic multiplication primitive in Forth. It takes two unsigned 16 bitintegers and returns an unsigned 32 bit result. All other multiplication functions are derived from this primitive one. It probably isn't particularly fast or elegant, but that is because I never liked arithmetic and I stole this implementationfrom FIG Forth anyway. U*D is a synonym for UM* \ 16 bit Arithmetic Operations Division subroutines 05MAR83HHL These are various subroutines used by the division primitive in Forth, namely U/. Again I must give credit for them to FIG Forth, since if I can't even understand multiply, divide would be completely hopeless. \ 16 bit Arithmetic Operations Unsigned Divide 05MAR83HHLUM/MOD This is the division primitive in Forth. All other division operations are derived from it. It takes a double number, d1, and divides by by a single number n1. It leaves a remainder and a quotient on the stack. For a clearer understanding of arithmetic consult Knuth Volume 2 on Seminumerical Algorithms. \ 16 bit Comparison Operations 05MAR83HHL0= Returns True if top is zero, False otherwise. 0< Returns true if top is negative, ie sign bit is on. 0> Returns true if top is positive. 0<> Returns true if the top is non-zero, False otherwise. = Returns true if the two elements on the stack are equal, False otherwise. <> Returns true if the two element are not equal, else false. ?NEGATE Negate the second element if the top is negative. \ 16 bit Comparison Operations 27Sep83mapU< Compare the top two elements on the stack as unsigned integers and return true if the second is less than the first. Be sure to use U< whenever comparing addresses, or else strange things will happen beyond 32K. U> Compare the top two elements on the stack as unsigned integers. True if n1 > n2 unsigned. < Compare the top two elements on the stack as signed integers and return true if n1 < n2. > Compare the top two elements on the stack as signed integers and return true if n1 > n2. MIN Return the minimum of n1 and n2 MAX Return the maximum of n1 and n2 BETWEEN Return true if min <= n1 <= max, otherwise false. WITHIN Return true if min <= n1 < max, otherwise false.  \ 32 bit Memory Operations 09MAR83HHL2@ Fetch a 32 bit value from addr. 2! Store a 32 bit value at addr. \ 32 bit Memory and Stack Operations 26Sep83map2DROP Drop the top two elements of the stack. 2DUP Duplicate the top two elements of the stack. 2SWAP Swap the top two pairs of numbers on the stack. You can use this operator to swap two 32 bit integers and preserve their meaning as double numbers. 2OVER Copy the second pair of numbers over the top pair. Behaves like 2SWAP for 32 bit integers. 3DUP Duplicate the top three elements of the stack. 4DUP Duplicate the top four elements of the stack. 2ROT rotates top three double numbers. \ 32 bit Arithmetic Operations 05MAR83HHLD+ Add the two double precision numbers on the stack and return the result as a double precision number. DNEGATE Same as NEGATE except for double precision numbers. S>D Take a single precision number and make it double precision by extending the sign bit to the upper half. DABS Return the absolute value of the 32 bit integer on the stack \ 32 bit Arithmetic Operations 06Apr84mapD2* 32 bit left shift. D2/ 32 bit arithmetic right shift. Equivalent to divide by 2. D- Subtract the two double precision numbers. ?DNEGATE Negate the double number if the top is negative. \ 32 bit Comparison Operations 01Oct83mapD0= Compare the top double number to zero. True if d = 0 D= Compare the top two double numbers. True if d1 = d2 DU< Performs unsigned comparison of two double numbers. D< Compare the top two double numbers. True if d1 < d2 D> Compare the top two double numbers. True if d1 > d2 DMIN Return the lesser of the top two double numbers. DMAX Return the greater of the the top two double numbers. !\ Mixed Mode Arithmetic 27Sep83mapThis does all the arithmetic you could possibly want and even more. I can never remember exactly what the order of the arguments is for any of these, except maybe * / and MOD, so I suggest you just try it when you are in doubt. That is one of the nice things about having an interpreter around, you can ask it questions anytime and it will tell you the answer. *D multiplys two singles and leaves a double. M/MOD divides a double by a single, leaving a single quotient and a single remainder. Division is floored. MU/MOD divides a double by a single, leaving a double quotient and a single remainder. Division is floored. \ 16 bit multiply and divide 27Sep83map */ is a particularly useful operator, as it allows you to do accurate arithmetic on fractional quantities. Think of it as multiplying n1 by the fraction n2/n3. The intermediate result is kept to full accuracy. Notice that this is not the same as * followed by /. See Starting Forth for more examples. \ Task Dependant USER Variables 24Mar84map TOS Saved during Task switching. ENTRY Jumped to during multitasking. LINK Points to next task in the circular queue SP0 Empty parameter stack for this task. RP0 Empty return stack for this task. DP Size of dictionary. Next available location. #OUT Number of characters sent since last CR. #LINE Number of CR's sent since last page. OFFSET Added to all block references. BASE The current numeric base for number input output. HLD Points to a converted character during numeric output. FILE Allows printing of one file while editing another. IN-FILE Allows printing of one file while editing another. PRINTING indicates whether printing is enabled. \ System VARIABLEs 24Mar84mapEMIT Sends a character to the output device. SCR Holds the screen number last listed or edited. PRIOR Points to the last vocabulary that was searched. DPL The decimal point location for number input. WARNING Checked by WARN for duplicate warnings. R# The cursor position during editing. HLD Points to a converted character during numeric output. LAST Points to the name of the most recently CREATEd word. CSP Used for compile time error checking. CURRENT New words are added to the CURRENT vocabulary. #VOCS The number of elements in the search order array. CONTEXT The array specifying the search order. \ System Variables 02AUG83HHL'TIB Points to characters entered by user. WIDTH Number of characters to keep in name field. VOC-LINK Points to the most recently defined vocabulary. BLK If non-zero, the block number we are interpreting. >IN Number of characters interpreted so far. SPAN Number of characters input by EXPECT. #TIB Used by WORD, when interpreting from the terminal. END? True if input stream exhausted, else false. " This is the release date of the disk. åååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååå Fog Library Disk FOG-CPM.107 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 2 of 3. FORTH 83 -- for all CPM systems. Filename Description -07-00 .86 This is the release date of the disk. -CPM107 .DOC This is the description of the disk contents. README .80 4A8D 18K ver. 83 [Forth83 7 of 10] KERNEL80.BLK 9B75 134K ver. 83 [Forth83 8 of 10]  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 2 of 3. FORTH 83 -- for all CPM systems. Filename Description -07-00 .86 This is the release date of åååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååå Fog Library Disk FOG-CPM.108 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 3 of 3. FORTH 83 -- for all CPM systems. Filename Description -07-00 .86 This is the release date of the disk. -CPM108 .DOC This is the description of the disk contents. META80 .BLK 5B47 49K ver. 83 [Forth83 9 of 10] UTILITY .BLK 0A02 110K ver. 83 [Forth83 10 of 10] šsÇ*sCLASI20 FON šsä*ºhCLASB20 FON šsÿ*VjCLAS24 FON £|4+°µCLASI24 FON I™sH+!‹CLASB24 FON T™sk+T¦CLASI30 FON h •+|áCLASB30 FON ±–ý Î+#çCLASI36 FON Šj ,C CLASB36 FON gk K,åFBUS9 FON ôk7j/åååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååå# Fog Library Disk FOG-CPM.109 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. Assembly Language programming. Filename Description -07-00 .86 This is the release date of the disk. -CPM109 .DOC This is the description of the disk contents. CALL-CPM.COM AE14 16K [CALL-CPM 1 of 2] Learn about CP/M function calls with this program which shows registers on the screen. CALL-CPM.DOC F7B5 5K [CALL-CPM 2 of 2] DASM .ZLG 7F69 16K Zilog mnemonic insert for ZZSOURCE. DIS .COM 14E6 5K [DIS 1 of 3] 8080 Disassembler. ASseMbler source is included. DIS .INS A6A7 5K [DIS 2 of 3] DIS .AQM 3F74 27K [DIS 3 of 3] DISASM .AQM 0F75 17K [DISASM 1 of 2] Squeezed ASseMbler source for a Zilog Z80 disassembler. DISASM .DOC 03BE 6K [DISASM 2 of 2] DISSAM .ASM BAEE 23K [DISSAM 1 of 2] ASseMbler source for an 8080 disassembler. DISSAM .DOC 9DFB 1K [DISSAM 2 of 2] EM2 .COM B7EC 3K [EM2 1 of 3] Performs 8080 operations and displays register and flag  information. An excellent way to learn. EM2 .DOC D6AE 5K [EM2 2 of 3] EM2 .ASM DFF7 22K [EM2 3 of 3] MSA15 .COM BCC8 7K ver. 1.5 [MSA 1 of 3] 8080 disassembler. MSA15 .DOC C9FE 1K ver. 1.5 [MSA 2 of 3] MSA .INF 3340 1K ver. 1.5 [MSA 3 of 3] ZDIS .COM 8D70 5K Zilog Z80 disassembler. f 2] EM2 .COM B7EC 3K [EM2 1 of 3] Performs 8080 operations and displays register and flag åååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååå$ååååå%ååååå&ååååå'ååååå