( ERROR MESSAGES )                                              EMPTY STACK                                                     DICTIONARY FULL                                                 HAS INCORRECT ADDRESS MODE                                      ISN'T UNIQUE                                                                                                                    DISC RANGE ?                                                    FULL STACK                                                      DISC ERROR !                                                    FILE OPEN ERROR                                                 OUT OF VIRTUAL RANGE                                            FILE MAKE ERROR                                                 DISK WRITE ERROR                                                DISK FILE CLOSE ERROR                                           EXECUTION VARIABLE UNDEFINED                                                                                                    ( ERROR MESSAGES )                                              COMPILATION ONLY, USE IN DEFINITION                             EXECUTION ONLY                                                  CONDITIONALS NOT PAIRED                                         DEFINITION NOT FINISHED                                         IN PROTECTED DICTIONARY                                         USE ONLY WHEN LOADING                                           OFF CURRENT EDITING SCREEN                                      DECLARE VOCABULARY                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              ( LOAD SCREEN FOR SYSTEM GENERATION ABOVE TASK                 )                                                                10 LOAD                       ( UTILITIES )                     15 LOAD                       ( EDITOR )                        21 LOAD                       ( ASSEMBLER )                     24 LOAD                       ( 2SWAP,PICK,ROLL,MSEC)           25 LOAD                       ( SYSGEN,SCRCPY,PWR2 )            27 LOAD                       ( GO, J )                         29 LOAD                       ( ADDBUF, CHR )                   \ 32 LOAD                     ( ALGEBRAIC )                     39 LOAD                       ( BDOS VIRTUAL EXTENSIONS )       \ 58 LOAD                       ( TRANSIENTS )                  \ 60 LOAD                       ( XEC, INSTALL, AS, CR )                                                                        60 LOAD                       ( MASTER MIND )                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   ( \ LL BB THRU U. DEPTH FORG )                                                                                                  : \    IN @ 64 /MOD SWAP  IF 1+ THEN 64 * IN ! ;  IMMEDIATE     : LL      1 SCR +!   SCR @ LIST ;                               : BB     -1 SCR +!   SCR @ LIST ;                               : THRU   1+ SWAP DO I LOAD LOOP ;                               : 2DROP DROP DROP ;                                             : DEPTH   SP@ S0 @ SWAP - 2 / ;                                 : FORG    126 EMIT 31 EMIT ;                                                                                                    -->                                                                                                                                                                                                                                                                                                                                                                                             \ BINARY OCTAL B. H. S. RANGE NOT                      6Apr81map                                                                DECIMAL                         : NOT   0= ;                                                                                    : BINARY 2 BASE ! ;             : OCTAL 8 BASE ! ;                                                                              : B. BASE @ SWAP BINARY U. BASE ! ;                                                                                             : H.   BASE @ SWAP HEX U. BASE ! ;                                                                                              : S. DEPTH DUP IF  S0 @ SWAP 1+ 1 DO DUP I 2 * - ? LOOP                                  ELSE ." Empty " THEN DROP  ;                                                                           : RANGE   ( addr,count -->  final,start )  OVER + SWAP  ;                                                                       -->                                                             HEX   \ DUMP                                          27Mar81map: 2H. DUP 10 < IF 30 EMIT THEN . ;                                                                                              : HDUMP   RANGE DO I C@ 2H. LOOP ;                                                                                              : EMIT.   7F AND   DUP 1F > OVER 7B < AND NOT                                        IF  DROP 2E THEN  EMIT ;                                                                                   : ADUMP   RANGE DO I C@ EMIT. LOOP ;                                                                                            : DUMPLINE CR  DUP U. SPACE 10  2DUP HDUMP SPACE ADUMP ;                                                                        : DUMPER 10 * OVER + SWAP DO I DUMPLINE                           ?TERMINAL IF LEAVE ENDIF 10 +LOOP CR ;                        : DUMP   BASE @ HEX SWAP  10  DUMPER  BASE ! ;                  DECIMAL         ;S                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              ( EDITOR - 1 OF 4 TEXT LINE WHERE #LOCATE #LEAD #LAG -MOVE H E )FORTH DEFINITIONS HEX                                           : TEXT HERE C/L 1+ BLANKS WORD HERE PAD C/L 1+ CMOVE ;          : LINE DUP FFF0 AND 17 ?ERROR SCR @ (LINE) DROP ;                VOCABULARY EDITOR IMMEDIATE HEX                                 : WHERE DUP B/SCR / DUP SCR ! ." SCR # " DECIMAL . SWAP C/L       /MOD C/L * ROT BLOCK + CR C/L TYPE 2 -                          SPACES 21 EMIT [COMPILE] EDITOR QUIT ;                        EDITOR DEFINITIONS                                              : #LOCATE R# @ C/L /MOD ;                                       : #LEAD #LOCATE LINE SWAP ;                                     : #LAG #LEAD DUP >R + C/L R> - ;                                : -MOVE LINE C/L CMOVE UPDATE ;                                 : H LINE PAD 1+ C/L DUP PAD C! CMOVE ;                          : E LINE C/L BLANKS UPDATE ;                                   -->                                                             ( EDITOR - 2 OF 4 S D M T L R P I TOP CLEAR )                    : S DUP 1 - 0E DO I LINE I 1+ -MOVE -1 +LOOP E ;                : D DUP H 0F DUP ROT DO I 1+ LINE I -MOVE LOOP E ;              : M  R# +! CR SPACE #LEAD TYPE 5F EMIT #LAG TYPE #LOCATE .        DROP ;                                                       : T DUP C/L * R# ! DUP H 0 M ;                                  : L SCR @ LIST 0 M ;                                            : R PAD 1+ SWAP -MOVE ;                                         : P 1 TEXT R ;                                                  : I DUP S R ;                                                   : TOP 0 R# ! ;                                                  : CLEAR SCR ! 10 0 DO FORTH I EDITOR E LOOP ;                   -->                                                                                                                                                                                                                                                             ( EDITOR - 3 OF 4 COPY 2SWAP MATCH 1LINE FIND DELETE N F )      : COPY B/SCR * OFFSET @ + SWAP B/SCR * B/SCR OVER + SWAP DO DUP   FORTH I BLOCK 2 - ! 1+ UPDATE LOOP DROP FLUSH ;               : (MATCH) -DUP IF OVER + SWAP DO DUP C@ FORTH I C@ - IF 0= LEAVE  ELSE 1+ ENDIF LOOP ELSE DROP 0= ENDIF ;                       : 2SWAP ROT >R ROT R> ;                                         : MATCH >R >R 2DUP R> R> 2SWAP OVER + SWAP DO 2DUP FORTH I SWAP   (MATCH) IF >R 2DROP R> - FORTH I SWAP - 0 SWAP 0 0 LEAVE ENDIF  LOOP 2DROP SWAP 0= SWAP ;                                     : 1LINE #LAG PAD COUNT MATCH R# +! ;                            : FIND BEGIN 3FF R# @ < IF TOP PAD HERE C/L 1+ CMOVE 0 ERROR      ENDIF 1LINE UNTIL ;                                           : DELETE >R #LAG + FORTH R - #LAG R MINUS R# +! #LEAD + SWAP      CMOVE R> BLANKS UPDATE ;                                      : N FIND 0 M ;                                                  : F 1 TEXT N ; -->                                              ( EDITOR - 4 OF 4 B X TILL C )                                  : B PAD C@ MINUS M ;                                            : X 1 TEXT FIND PAD C@ DELETE 0 M ;                             : TILL #LEAD + 1 TEXT 1LINE 0= 0 ?ERROR #LEAD + SWAP - DELETE     0 M ;                                                         : C 1 TEXT PAD COUNT #LAG ROT OVER MIN >R FORTH R R# +! R - >R    DUP HERE R CMOVE HERE #LEAD + R> CMOVE R> CMOVE UPDATE 0 M ;                                                                  FORTH DEFINITIONS   DECIMAL                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     \ 8080 ASSEMBLER 1 OF 3                                4Mar81mapVOCABULARY ASSEMBLER IMMEDIATE   HEX                            0 VARIABLE OLDBASE                                              : ENTERCODE [COMPILE] ASSEMBLER BASE @ OLDBASE ! HEX SP@ ;      : ;CODE ?CSP COMPILE (;CODE) [COMPILE] [ ENTERCODE ; IMMEDIATE  : CODE CREATE ENTERCODE ;                                       ASSEMBLER DEFINITIONS                                           : END-CODE CURRENT @ CONTEXT ! OLDBASE @ BASE ! SP@ 2+ = IF       SMUDGE ELSE ." CODE ERROR, STACK DEPTH CHANGED " ENDIF ;      : 8* DUP + DUP + DUP + ;        : C; END-CODE ;                 : M1 <BUILDS , DOES> @ OVER + C, 40 AND IF C, ENDIF ;           : M2 <BUILDS , DOES> @ SWAP 8* + C, ;                           : M3 <BUILDS , DOES> @ C, , ;                                   : M4 <BUILDS , DOES> @ C, C, ;                                  : M5 <BUILDS , DOES> @ C, ;                                     : M6 <BUILDS DOES> DROP 8* 1+ C, , ; -->                        \ 8080 ASSEMBLER 2 OF 3                                4Mar81map: M7 <BUILDS DOES> DROP 8* 40 + + C, ;                          : M8 <BUILDS DOES> DROP 8* 6 + C, C, ;                          : M9 <BUILDS DOES> DROP 8* C7 + C, ;                            CE M4 ACI    88 M1 ADC    80 M1 ADD    C6 M4 ADI    A0 M1 ANA   E6 M4 ANI    CD M3 CALL   DC M3 CC     FC M3 CM     2F M5 CMA   3F M5 CMC    B8 M1 CMP    D4 M3 CNC    C4 M3 CNZ    F4 M3 CP    EC M3 CPE    FE M4 CPI    E4 M3 CPO   0CC M3 CZ     27 M5 DAA   09 M2 DAD    05 M2 DCR    0B M2 DCX    F3 M5 DI     FB M5 EI    76 M5 HLT    DB M4 IN     04 M2 INR    03 M2 INX    DA M3 JC    FA M3 JM     C3 M3 JMP    D2 M3 JNC    C2 M3 JNZ    F2 M3 JP    EA M3 JPE    E2 M3 JPO    CA M3 JZ     3A M3 LDA    0A M2 LDAX  2A M3 LHLD      M6 LXI       M7 MOV       M8 MVI    00 M5 NOP   B0 M1 ORA    F6 M5 ORI    D3 M4 OUT    E9 M5 PCHL   C1 M2 POP   C5 M2 PUSH   17 M5 RAL    1F M5 RAR    D8 M5 RC     C9 M5 RET   07 M5 RLC    F8 M5 RM     D0 M5 RNC    C0 M5 RNZ   F0 M5 RP --> \ 8080 ASSEMBLER 3 OF 3                                4Mar81mapE8 M5 RPE    E0 M5 RPO    0F M5 RRC       M9 RST    C8 M5 RZ    98 M1 SBB    DE M4 SBI    22 M3 SHLD   F9 M5 SPHL   32 M3 STA   02 M2 STAX   37 M5 STC    90 M1 SUB    D6 M4 SUI    EB M5 XCHG  A8 M1 XRA    EE M4 XRI    E3 M5 XTHL                             7 CONSTANT A    0 CONSTANT B     1 CONSTANT C     2 CONSTANT D  3 CONSTANT E    4 CONSTANT H     5 CONSTANT L     6 CONSTANT M  6 CONSTANT SP   6 CONSTANT PSW  CA CONSTANT 0#  C2 CONSTANT 0= DA CONSTANT CNS D2 CONSTANT CS   EA CONSTANT PO  E2 CONSTANT PE FA CONSTANT 0>= F2 CONSTANT 0<                                  0145 CONSTANT NEXT  0144 CONSTANT HPUSH  0143 CONSTANT DHP      : IF C, HERE 0 , ;                                              : ELSE C3 C, HERE 0 , SWAP HERE SWAP ! ;                        : ENDIF HERE SWAP ! ;                                           : BEGIN HERE ;                                                  : UNTIL C, , ; FORTH DEFINITIONS   DECIMAL                      ( 2SWAP, PICK, ROLL, MSEC )                                                                                                     : 2SWAP   ROT >R ROT R> ;                                                                                                       : PICK  DUP + SP@ + @ ; ( N --- Copy Nth item to top )                                                                          : ROLL   ( N ---    Move Nth word to top of stack )                 -DUP IF DUP 1+ PICK SWAP DUP + SP@ SWAP OVER +                  DO I @ I 2+ ! -2 +LOOP DROP ENDIF ;                                                                                         : MSEC  ( N ---  )   0 DO 14 0 DO LOOP LOOP ;                                                                                                                                                                                                                                                                                                                                                   ( SYSGEN, SCRCPY, PWR2 )                                                                                                        : SYSGEN                                                             DP @ 286 ! ( TOP OF DICTIONARY )                                VOC-LINK @ 288 ! ( ALL VOCABS )                                 [ ' FORTH 4 + ] LITERAL @ 268 ! ( TOP OF FORTH )                ." SAVE " DP @ 255 + 256 / . CR ;                                                                                          : SCRCPY ( FROM, TO, N --- )                                        0 DO 2DUP EDITOR COPY FORTH ( COPY A SCR )                      FLUSH  I .  1 1 D+  LOOP ( DUMP EACH 1K )                       DROP DROP ; ( CLEAN THE STACK )                                                                                             : PWR2  ( N --- 2**N )                                              1 SWAP -DUP IF 0 DO DUP + LOOP ENDIF ;                                                                                      ( CASE STATEMENT )                                                                                                              : CASE   ?COMP CSP @ !CSP 4 ; IMMEDIATE                                                                                         : OF   4 ?PAIRS  COMPILE OVER COMPILE = COMPILE 0BRANCH                     HERE  0 ,    COMPILE DROP  5 ; IMMEDIATE                                                                            : ENDOF   5 ?PAIRS  COMPILE BRANCH  HERE 0 ,                              SWAP  2 [COMPILE]  ENDIF  4  ; IMMEDIATE                                                                              : ENDCASE  4 ?PAIRS  COMPILE DROP                                       BEGIN  SP@  CSP @ = 0=                                          WHILE  2 [COMPILE]  ENDIF  REPEAT                               CSP !  ; IMMEDIATE                                                                                                                                                                      ( GO, ASC", J )                                                                                                                 : GO   ( EXECUTE UNTIL BREAK )                                       [COMPILE] ' CFA >R                                              BEGIN R EXECUTE ?TERMINAL UNTIL                                 R> DROP ;                                                                                                                  : ASC"   <BUILDS 34 WORD HERE C@ 1+ ALLOT DOES> ;               ( ASC SMITH SMITH"   SMITH COUNT TYPE --- 'SMITH' )                                                                             HEX                                                             CODE J   ( --- EXTERNAL DO LOOP INDEX )                             128 LHLD  4 D LXI  D DAD  M E MOV  H INX  M D MOV               XCHG  HPUSH   JMP   C;                                      DECIMAL                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         ( ADDBUF, CHR )                                                                                                                 : ADDBUF ( N --- )                                                  FLUSH ( CLEAR BUFFERS )                                         DUP ' #BUFF +! ( ADD TO #BUFF )                                 B/BUF 4 + * ( BYTES ADDED )                                     ' LIMIT +!  EMPTY-BUFFERS ;                                                                                                 : CHR   ( SINGLE CHARACTER FOLLOWS )                                32 WORD HERE 1+ C@ ( GET THE CHARACTER )                        STATE @ IF [COMPILE] LITERAL ENDIF ; IMMEDIATE                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              ( OBWRO'CONY ANGIELSKI                             MCS 81MAR06 )                                                                0 VARIABLE OPS   HERE 42 DUP ALLOT ERASE       ( OP CODE STACK )                                                                : PUSHOP   ( CFA \ LEV ---  )                                       OPS 4 OVER +! DUP @ + 2! ;                                                                                                  : POPOP    (  --- CFA \ LEV )                                       OPS DUP @ + 2@ -4 OPS +! ;                                                                                                  : EXECOP   POPOP DROP EXECUTE ;                                                                                                 : DUMPOP   BEGIN OPS @ WHILE EXECOP REPEAT ;                                                                                                                                                    -->                                                             ( OBWRO'CONY ANGIELSKI                             MCS 81MAR06 )                                                                : ALG   ( LEV ---  )      ( DEFINE ALGEBRAIC EQUIV OF STACK OP )    <BUILDS , LATEST C@ 63 AND 1+ MINUS IN +!                       SMUDGE [COMPILE] ' CFA , SMUDGE                                 DOES> 2@ BEGIN DUP OPS DUP @ + @ > 0= WHILE                     >R >R EXECOP R> R> REPEAT PUSHOP ;                                                                                          VOCABULARY ALGEBRAIC IMMEDIATE      ALGEBRAIC DEFINITIONS                                                                       2 ALG XOR     2 ALG AND     2 ALG OR                                                                                            3 ALG +     3 ALG -     4 ALG *     4 ALG /    4 ALG MOD                                                                        -->                                                                                                                             ( OBWRO'CONY ANGIELSKI                             MCS 81MAR06 )                                                                : (   [ ' NOOP CFA ] LITERAL    1 PUSHOP ;                                                                                      : )    FORTH BEGIN OPS DUP @ + @ 1 > WHILE EXECOP REPEAT            OPS DUP @ + @ 1 = IF EXECOP                                     ELSE ." MISSING LEFT PAREN " QUIT ENDIF ;                                                                                   : =   DUMPOP . ;                                                                                                                FORTH DEFINITIONS                                                                                                               ;S                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              ( BDOS VIRTUAL LOAD SCREEN                         MCS 81FEB21 )                                                                ( 40 LOAD * )                           ( >BDOS, BDOS )         ( 41 LOAD * )                           ( %LINK, %OPEN )        ( 42 LOAD * )                           ( %NAME, %DEFLT )       ( 43 LOAD * )                           ( R/W )                 44 LOAD                                 ( UFN )                 45 LOAD                                 ( %MAKE, OPEN, CLOSE )  ( 46 LOAD )                             ( NEWFILE )             ( 47 LOAD )                             ( EXAMPLE )             ( 48 LOAD )                             ( EXAMPLE )             ( 49 LOAD )                             ( SCRCPY )                                                                              ( *  SCREENS 40 - 43 INCLUDED BY ASSEMBLY )                                                                                                                                                     ( BDOS VIRTUAL - >BDOS, BDOS                       MCS 81FEB21 )                                                                CODE >BDOS   ( ARG, FUNCT --- RESULT FLAG )                         0 H LXI   B DAD   B POP   D POP   H PUSH   5 CALL               0 H MVI   A L MOV   B POP   HPUSH JMP   C;                                                                                  : BDOS >BDOS DISK-ERROR ! ; ( ARG, FUNCT --- )                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  ( BDOS VIRTUAL - %LINK, %OPEN                      MCS 81FEB21 )                                                                50 USER FILES     ( CLEAR IN COLD )                                                                                             : %LINK ( PTR --- PTR )                                             FILES @ OVER FILES !            ( LINK FILES TO THIS )          -DUP IF 2DUP SWAP 4 + !         ( LINK THIS TO PREV )           2+ @ 2DUP SWAP +! OVER 2+ +!    ( OFFSET FIRST & LAST )         ENDIF ;                         ( RETURN PTR )                                                                              : %OPEN ( PTR --- PTR )                                             DUP 6 + DUP 15 BDOS             ( OPEN THE FILE )               DISK-ERROR @ 255 = 9 ?ERROR     ( OPEN ERROR )                  DUP 35 BDOS                     ( GET FILE SIZE )               33 + @ OVER 2+ ! ;              ( SET SIZE )                                                                                ( BDOS VIRTUAL - %NAME, %DEFLT                     MCS 81FEB21 )                                                                ASC" %NAME FORTH   BLK"                   ( DEFAULT FILE NAME )                                                                 : %DEFLT   ( R/W, BLOCK, 0 --- R/W, BLOCK, PTR )                    DROP 86 DUP 42 0 FILL                ( CREATE AND CLEAR )       DUP 6 + %NAME OVER 12 CMOVE           ( COPY NAME )             0 SWAP C!                            ( AND CURRENT DRIVE )      %OPEN %LINK   1 WARNING ! ;          ( OPEN AND LINK )                                                                                                                                                                                                                                                                                                                                                                                                                                                                      ( BDOS VIRTUAL - R/W                               MCS 81FEB21 )                                                                : R/W   ( ADDR, BLOCK, R/W --- )                                    ROT 26 BDOS                         ( SET DMA ADDRESS )         SWAP FILES @ DUP 0= IF %DEFLT ENDIF ( FILE MUST EXIST )         2DUP 2+ @ < 0= 10 ?ERROR            ( OUT OF RANGE ? )          BEGIN 2DUP @ < WHILE 4 + @ REPEAT   ( FIND FCB FOR BLOCK )      SWAP OVER @ - OVER 39 + !           ( SET ABSOLUTE RECORD )     6 + SWAP IF 33 ELSE 34 ENDIF BDOS   ( R/W )                     DISK-ERROR @ 8 ?ERROR ;             ( CHECK FOR ERROR )                                                                                                                                                                                                                                                                                                                                                                                                     ( BDOS VIRTUAL - UFN                               MCS 81FEB21 )                                                                : UFN ( ADDR --- )                                                  DUP 11 32 FILL   32 WORD                                        HERE COUNT 11 MIN 0 DO                                          2DUP C@ DUP 46 -                                                IF SWAP C! 1 1 D+                                               ELSE DROP DROP 8 R - 1 D+                                       HERE C@ R - 4 MIN 1 DO 2DUP C@ SWAP C! 1 1 D+                   LOOP LEAVE ENDIF LOOP DROP DROP ;                                                                                                                                                                                                                                                                                                                                                                                                                           ( BDOS VIRTUAL - %MAKE, OPEN, CLOSE                MCS 81FEB21 )                                                                : %MAKE ( DRV --- PTR    <FOLLOW WITH ID & UFN> )                   <BUILDS HERE 42 ALLOT DUP 42 0 FILL ( MAKE AND CLEAR )          SWAP OVER 6 + C!  DUP 7 + UFN ( INSERT DRV AND NAME )           DOES> ;                                                                                                                     : OPEN  ( DRV ---       <FOLLOW WITH ID & UFN>  )                   %MAKE %OPEN %LINK DROP ;                                                                                                    : CLOSE   ( PTR --- ) 4 + @ FILES ! ;                                                                                           : FTYPE   CR 2@ DO I BLOCK B/BUF TYPE                               ?TERMINAL IF LEAVE ENDIF LOOP ;                                                                                                                                                             ( BDOS VIRTUAL - NEWFILE                           MCS 81FEB21 )                                                                : NEWFILE ( SIZE, DRV --- PTR   <FOLLOW WITH ID & UFN> )        ( SIZE IN BLOCKS, MAY USE %OPEN & %LINK AFTER CREATED          )    %MAKE                                 ( CREATE THE FCB )        DUP 6 + DUP 22 BDOS                   ( CP/M MAKE )             DISK-ERROR @ 255 = 11 ?ERROR          ( MAKE ERROR )            128 DUP BL FILL                       ( CLEAR BUFFER )          ROT 0 DO   128 26 BDOS                ( SET DMA ADDRESS )       I OVER 33 + !  DUP 34 BDOS            ( WRITE EACH RECORD )     DISK-ERROR @ 12 ?ERROR                ( WRITE ERROR )           LOOP    16 BDOS                       ( CLOSE THE FILE )        DISK-ERROR @ 255 = 13 ?ERROR          ( CLOSE ERROR )           DOES> ;                               ( RETURNS PTR )                                                                                                                                       ( BDOS VIRTUAL - EXAMPLES OF FILE PROCESSING       MCS 81FEB21 )                                                                ( TYPE A CP/M TEXT FILE - EXPAND TABS )                                                                                         : TAB   8 OUT @ 7 AND - SPACES ;                                                                                                : DOBUF ( ADDR --- )   B/BUF OVER + SWAP DO                         I C@   DUP BL < IF ( CTL )                                        DUP 13 = IF ( CR )   CR  0 OUT !  ENDIF                         DUP 9 = IF ( HT ) TAB ENDIF DROP                              ELSE EMIT ENDIF LOOP ;                                                                                                      : FILTYP   ( PTR --- )                                              2@ DO I BLOCK DOBUF ?TERMINAL IF LEAVE ENDIF LOOP ;                                                                                                                                         ( BDOS VIRTUAL - EXAMPLES OF FILE PROCESSING       MCS 81FEB21 )                                                                : CHR   ( SINGLE CHARACTER FOLLOWS )                                32 WORD HERE 1+ C@ ( GET THE CHARACTER )                        STATE @ IF [COMPILE] LITERAL ENDIF ; IMMEDIATE                                                                              : UPPER  ( chr --- CHR )                                            DUP CHR a < OVER CHR z > OR 0=                                  IF ( LOWER CASE ) 32 - ENDIF ;                                                                                              : DOBUF ( ADDR --- )                                                B/BUF OVER + SWAP DO I DUP C@ UPPER SWAP C! LOOP UPDATE ;                                                                   : CONVERT ( PTR --- )   2@ DO I DOBUF LOOP ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    ( START OF DIAGNOSTIC ROUTINES FOR DECISION.   DCB 3/9/82 )     HEX      0 VARIABLE P4DATA                                      : GRP0 0 4F P! ;     : POE 1 4E P! ;                            : PFOR DUP 4B P! 4B P@ = NOT IF ." BAD " THEN ;                 : P4 GRP0 POE PFOR ;                                            : P4TEST 0 P4DATA ! FF 0 DO P4DATA @ DUP DUP P4 1+ P4DATA ! . CR   LOOP ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       DECIMAL                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        :