( COLLECTOR'S CORNER LABELS )                                                                                                   3295 CONSTANT EPRINT                                                                                                            : LABEL                                                             1 EPRINT !                                                      CR CR CR ." COLLECTOR'S CORNER" CR                              CR CR ."      837-3887" CR CR CR                                0 EPRINT ! ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                ( 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                                    MICHAEL STOLOWITZ  335 Merrilee Place, Danville  (415) 837-3887 ( 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 )                                                                                                                 10 LOAD                       ( DUMP, FORG )                    11 LOAD                       ( ASSEMBLER )                     24 LOAD                       ( 2SWAP,2DROP,PICK,ROLL,MSEC)     14 LOAD                       ( EDITOR )                        25 LOAD                       ( SYSGEN,SCRCPY,PWR2 )            27 LOAD                       ( GO, ASC", J )                   29 LOAD                       ( ADDBUF, CHR )                   39 LOAD                       ( BDOS VIRTUAL EXTENSIONS )       58 LOAD                       ( TRANSIENTS )                    60 LOAD                       ( XEC, INSTALL, AS, CR )                                                                                                                                                                                                                                                                          ( BOOT SCREEN )                                                                                                                 0 OPEN #1 MORHD.BLK                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             ( MORROW DESIGNS - HDC                             MCS 81JUL16 )                                                                113 LOAD                                                        HEX                                                                                                                             : ATTN   0 55 P! ;                                                                                                              : RESET  0 54 P! ;                                                                                                              20 CONSTANT SEC/TRK                     ( DISK CHARACTERISTICS ) 4 CONSTANT #HEADS                                              99 CONSTANT #TRKS                                                                                                               0 VARIABLE DRIVE                                                                                                                -->                                                             ( MORROW DESIGNS - HDC                             MCS 81JUL16 )                                                                0 VARIABLE COMMAND   -2 ALLOT                                   2 C,  0 C, 60 C,  0 C,                       ( SET DMA ADDRESS )7 C, 10 C, FF C,                                        ( SEEK )5 C, 2C C,                                            ( SELECT )B C,  0 C,  3 C,  3 C,  3 C,                      ( READ/WRITE )0 C,  0 C,                                              ( HALT )                                                                : IND COMMAND + CONSTANT ;                                                                                                      1 IND ADDR                      5 IND DIR                       6 IND STEPS                     8 IND SEL                       9 IND COM                       A IND CYL                       B IND HD                        C IND SEC                       D IND RSLT                      A IND RSLT   -->                ( MORROW DESIGNS - HDC                             MCS 81JUL16 )                                                                : INIT  1 100 C!  COMMAND 101 !  0 103 C! ; ( SET CHANNEL ADDR )                                                                : STAT.  BASE @ HEX CR ." ERROR STATUS = "                        DISK-ERROR @ . CR BASE ! 7 EMIT ;                                                                                             : EXEC  0 RSLT C!  RESET ATTN  BEGIN RSLT C@ ?TERMINAL OR UNTIL   RSLT C@ DUP FF - IF ( ERROR ) DISK-ERROR ! STAT. ELSE           DROP 0 DISK-ERROR ! ENDIF ;                                                                                                   : EXEC  0 RSLT C! RESET ATTN BEGIN RSLT C@ ?TERMINAL OR UNTIL ;                                                                 -->                                                                                                                                                                                             ( MORROW DESIGNS - HDC                             MCS 81JUL16 )                                                                00 CONSTANT STEP_IN             10 CONSTANT STEP_OUT                                                                            : SEEK  ( TRK --- )                                                 CYL @ OVER CYL !  - -DUP                          IF ( NEW )      DUP 0< IF STEP_OUT ELSE STEP_IN ENDIF DIR C!                    ABS STEPS C!                                       ENDIF ;                                                                : HOME  CYL C@ FF - SEEK  0 CYL C! ;                                                                                            -->                                                                                                                                                                                                                                                                                                                             ( MORROW DESIGNS - HDC                             MCS 81JUL16 )                                                                : X    BASE @ HEX                                                   100 DUMPLINE CR                                                 COMMAND DUMPLINE CR                                             LIMIT DUMP                                                      BASE ! ;                                                                                                                    : A  ATTN ;                                                                                                                     : R RESET ;                                                                                                                     : EXEC.  EXEC LIMIT DUMPLINE ;                                                                                                  -->                                                                                                                             ( MORROW DESIGNS - HDC                             MCS 81JUL16 )                                                                -->                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             ( MORROW DESIGNS - HDC                             MCS 81JUL16 )                                                                SEC/TRK #HEADS * CONSTANT SEC/CYL                                                                                               : SET_SEL                                                           DUP HD C! DUP + DUP +                                           DRIVE @ OR 20 OR                                                CYL C@ DUP 40 < IF 0 ELSE 80 ENDIF                                    SWAP 80 < IF 0 ELSE 40 ENDIF OR OR SEL C! ;                                                                           : T&SCALC   ( N --- )                                               SEC/CYL     /MOD   SEEK                                         SEC/TRK     /MOD   SET_SEL                                                         SEC C! ;                                                                                                 -->                                                             ( MORROW DESIGNS - HDC                             MCS 81JUL16 )                                                                -->                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             ( MORROW DESIGNS - HDC                             MCS 81JUL16 )                                                                : R/W  ( ADDR BLOCK R/W --- )                                       ROT ADDR !                                     ( SAVE ADDR )    SWAP T&SCALC                       ( SET TRACK HEAD SECTOR )    IF 8 ELSE 9 ENDIF COM C!                     ( SET COMMAND )    EXEC DISK-ERROR @ 8 ?ERROR ;               ( R/W AND CHECK )                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                ( GODBOUT HARD DISK INTERFACE                      MCS 81JUN05 )HEX                                                             : RD AB CHAN_BUF 3 + C! ;                                       : WR 2B CHAN_BUF 3 + C! ;                                                                                                       : Y  RD LIMIT SET_ADDR LOAD_CHAN 4 COMMAND ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    DECIMAL                                                                                                                         ( LINK FORTH TO USE HARD DISK )                                                                                                 ' HR/W CFA ' R/W !                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              ( STRING EDITING PRIMATIVES )                                   : (MATCH) ( address-3, address-2, count-1 -- identicality-1 )   DUP IF                                                              OVER + SWAP DO  DUP C@ FORTH I C@ -                             IF DROP 0 LEAVE  ELSE 1+ THEN LOOP                          ELSE DROP DROP DROP 1 ENDIF ;                                       DUP HERE R CMOVE                                            : MATCH ( curser-4, bytes left-3, string address-2, )                   ( string count-1 -- boolean-2, curser movement-1 )        >R >R 2DUP R> R> 2SWAP OVER + SWAP                            ( caddr-6, bleft-5, $addr-4, &len-3, caddr+bleft-2, caddr-1 )   DO  2DUP  FORTH I  SWAP  (MATCH)                                IF ROT ROT 2DROP - I SWAP - 0 SWAP 0 0 LEAVE                    ( caddr bleft &addr $len or 0 offset 0 0 )                      ENDIF LOOP 2DROP                                                SWAP 0= SWAP ; -->                                              ( STRING EDITING COMMANDS )                                     : 1LINE   ( SCAN LINE WITH CURSER FOR MATCH TO PAD TEXT )                 ( UPDATE CURSER AND RETURN BOOLEAN )                     #LAG PAD COUNT MATCH R# +! ;                                                                                                 : FIND   ( STRING AT PAD OVER FULL SCREEN RANGE, ELSE ERROR )      BEGIN 3FF R# @ <                                                   IF TOP PAD HERE C/L 1+ CMOVE 0 ERROR ENDIF                      1LINE UNTIL ;                                                                                                             : DELETE >R #LAG + FORTH R -                                        #LAG R MINUS R# +!                                              #LEAD + SWAP CMOVE                                              R> BLANKS UPDATE ;                                                                                                          -->                                                             ( STRING EDITING COMMANDS )                                     : N    ( FIND OCCURANCE OF PREVIOUS TEXT )                         FIND 0 M ;                                                                                                                   : F    ( FIND OCCURANCE OF FOLLOWING TEXT )                       1 TEXT N ;                                                                                                                    : B    ( BACKUP CURSER BY TEXT IN PAD )                           PAD C@ MINUS M ;                                                                                                              : X    ( DELETE FOLLOWING TEXT )                                   1 TEXT FIND PAD C@ DELETE 0 M ;                                                                                              : TILL   ( DELETE ON CURSER LINE, FROM CURSER TO TEXT END )        #LEAD  +  1   TEXT  1LINE  0= 0 ?ERROR                          #LEAD  +  SWAP  -  DELETE  0  M  ; -->                       ( SCREEN EDITING COMMANDS )                                     : 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 ;                                                                                                                       DECIMAL   37 LOAD    FORTH DEFINITIONS                                                                                                                                                                                                                                                                                          ( 2SWAP, 2DROP, PICK, ROLL, MSEC )                                                                                              : 2SWAP   ROT >R ROT R> ;                                                                                                       : 2DROP   DROP DROP ;                                                                                                           : 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 )                                                 : J RP@ 6 + @ ;  ;S                                             HEX                                                             CODE J   ( --- EXTERNAL DO LOOP INDEX )                             128 LHLD  4 D LXI  D DAD  M E MOV  H INX  M D MOV               XCHG  144 JMP C;                                            DECIMAL                                                                                                                         ;S                                                              : 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' )             ( DECOMPILE )                                                                                                                   : UNDO ( DECOMPILE FOLLOWING WORD )                                  [COMPILE] ' CR ." : " DUP NFA ID. ."    "                       BEGIN CR DUP @ 2+ NFA ID. 10 SPACES ." ?"                       KEY DUP 76 = IF CR SWAP 2+ DUP @ .                                SWAP 10 SPACES ." ? " ENDIF                                       SWAP 2+ SWAP 81 = IF 1 ELSE 0 ENDIF UNTIL DROP ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       ( 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                                                                                                                                                                                                                                                                                                                                              ( GODBOUT DISK BOOT )                                                                                                           HEX   C0 CONSTANT BASE  : STAT@  BASE P@ ;                      : INTS   [ BASE 2+ ] LITERAL P@ 127 > ; ( INT STATUS )          BASE 1+ CONSTANT DATA  BASE 2+ CONSTANT DMA                                                                                     : SEND   BEGIN STAT@  7F > UNTIL DATA P! ; ( DATA --- )         : RECV  BEGIN STAT@ 7F > UNTIL DATA P@ ;                        : CMD   DUP 2+ SWAP @ 0   ( ADDR ---  )                                 DO DUP C@ SEND 1+ LOOP DROP ;                           : SETDMA  0 DMA P!  40 DMA P!  0 DMA P! ;                       3 VARIABLE SPEC  03 C, 8F C, 24 C, ( SPECIFY COMMAND )          2 VARIABLE RECAL  07 C, 00 C, ( RECALIBRATE )                   9 VARIABLE READ  6 C, 0 C, 0 C, 0 C, 1 C, 0 C,                                   4 C, 7 C, 80 C,                                1 VARIABLE STREQ  8 C,   -->                                    ( GODBOUT DISK BOOT )                                                                                                           : BOOT   SETDMA SPEC CMD RECAL CMD ( BOOT THE CONTROLER )           BEGIN INTS UNTIL  STREQ CMD RECV 20 - RECV OR 8 ?ERROR          READ CMD BEGIN INTS UNTIL RECV 40 - RECV 80 - OR                5 0 DO RECV DROP LOOP 8 ?ERROR ; ( GO EXECUTE )                                                                             : RES   ( TAKE RESULT FROM READ )                                    CR 7 0 DO RECV . CR LOOP ;                                                                                                                                                                 DECIMAL                                                                                                                                                                                                                                                                                                                         ( COMMAND )                                                                                                                     HEX                                                             : SEND  BEGIN C0 P@ 7F > UNTIL C1 P! ;                          : RES   CR 7 0 DO BEGIN C0 P@ 7F > UNTIL C1 P@ . CR LOOP ;      : COMMAND ( # BYTES ---  )                                           <BUILDS DUP C, 0 DO 20 WORD HERE NUMBER DROP C, LOOP            DOES> COUNT 0 DO DUP C@ SEND 1+ LOOP DROP ;                                                                                3 COMMAND SPEC 3 8F 24                  ( SPECIFY )             2 COMMAND RECAL 7 0                     ( RECALIBRATE )         9 COMMAND READ 6 0 0 0 1 0 4 7 80       ( READ )                                                                                                                                                                                                                DECIMAL                                                         ( HAZELTINE CRT COMMANDS )                                                                                                      : LEAD 126 EMIT ; ( LEAD IN )                                                                                                   : HOME LEAD 18 EMIT ; ( HOME CURSER )                                                                                           : CLEAR LEAD 28 EMIT ; ( CLEAR SCREEN )                                                                                         : GOXY LEAD 17 EMIT ( ADDRESS CURSER )                              EMIT            ( X DIRECTION )                                 32 + EMIT ;      ( Y DIRECTION )                                                                                                                                                                                                                                                                                                                                                            ( NOTHIN )                                                                                                                      VOCABULARY NOTHIN IMMEDIATE                                     NOTHIN DEFINITIONS                                              103 VARIABLE SEED                                               0 VARIABLE X1 0 VARIABLE X2 0 VARIABLE Y1 0 VARIABLE Y2         : RANDOM SEED DUP @                                                  73 * 43 + 256 MOD                                               DUP ROT ! ;                                                : RAND80 RANDOM 80 * 256 / ;  ( RANDOM IN 0..79 )               : XAXIS BEGIN RAND80 RAND80 2DUP - ABS 1  > UNTIL                    2DUP < IF SWAP ENDIF X1 ! X2 ! ;                           : RAND24 RANDOM 24 * 256 / ;  ( RANDOM IN 0..24 )               : YAXIS BEGIN RAND24 RAND24 2DUP - ABS 1 >  UNTIL                    2DUP < IF SWAP ENDIF Y1 ! Y2 ! ;                           -->                                                             ( NOTHIN )                                                                                                                      42 CONSTANT STAR                                                                                                                                                                                                                                                                                                                : TOP X2 @ X1 @ DO STAR EMIT LOOP ;                                                                                             : RIGHT Y2 @ Y1 @ DO STAR EMIT 10 EMIT 8 EMIT LOOP ;                                                                            : BOTTOM X1 @ X2 @ DO STAR EMIT 8 DUP EMIT EMIT -1 +LOOP ;                                                                      : LEFT Y1 @ Y2 @ DO STAR EMIT 8 EMIT LEAD 12 EMIT -1 +LOOP ;                                                                    -->                                                             ( NOTHIN )                                                                                                                                                                                      : CLRL X1 @ 1+ GOXY X2 @ 1 - X1 @ DO SPACE LOOP ;                                                                               : CLEAR Y2 @ Y1 @ 1+ DO FORTH I NOTHIN CLRL LOOP ;                                                                              : BOX XAXIS YAXIS Y1 @ X1 @ GOXY                                      TOP RIGHT BOTTOM LEFT                                           Y1 @ Y2 @ - IF CLEAR ENDIF ;                                                                                              : DOIT                                                                FORTH CLEAR NOTHIN                                              BEGIN BOX ?TERMINAL UNTIL ;                                                                                                                                                               ( SCREEN EDITING COMMANDS  <MOVE, J, A             MCS 81MAR04 )                                                                : <MOVE ( FROM \ TO \ N ---   )          ( MOVE LEFT FROM PTRS )    FORTH 0 DO OVER I - C@ OVER I - C! LOOP 2DROP ;                                                                             : J                       ( JUSTIFY FROM CURSER TO END OF LINE )    #LOCATE FORTH LINE C/L 1 - SWAP OVER + SWAP ROT -               BEGIN OVER C@ BL = OVER 0 > AND WHILE                           2DUP OVER 1 - ROT ROT <MOVE  2DUP - BL SWAP C!  1  - REPEAT     2DROP UPDATE ;                                                                                                              : A  ( N ---  )               ( ALLIGN CURSER CHAR TO COLUMN N )    EDITOR #LOCATE FORTH LINE                                       2DUP + >R ROT ROT OVER SWAP - >R                 ( ADDR, N )    SWAP C/L + 1 - DUP ROT - SWAP R <MOVE                           R> R> SWAP BL FILL UPDATE ;                                 ( COMPARE TWO PROMS )                                           HEX                                                                                                                             : COMP ( A B N --- )                                                0 DO OVER C@ OVER C@ - IF ( NOT EQUAL )                           I . CR               ENDIF                                    1+ SWAP 1+ SWAP LOOP DROP DROP ;                                                                                            DECIMAL                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         ( 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 )                                                                                                                                                     ( PWR2                                             MCS 81MAR13 )                                                                : PWR2   ( N1 --- 2**N1 )                                           1 SWAP -DUP IF 0 DO DUP + LOOP ENDIF ;                                                                                      ;S                                                              ( LEAVES N2 WHICH IS 2 TO THE N1 POWER                         )                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                ( LISTING                                          MCS 81MAR13 )                                                                : LISTING   ( N1 N2 --- )                                           SWAP TRIAD                                         BEGIN           SCR @  OVER  <  WHILE  1 SCR +!  SCR @ TRIAD    REPEAT       DROP ;                                                      ;S                                                                                                                              ( LISTS SCREENS N1 THROUGH N2 USING TRIAD.                     )                                                                                                                                                                                                                                                                                                                                                                                                                                                                ( 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                                               MCS 81MAR13 )                                                                : GO   ( CCCC )                                                     [COMPILE] '   CFA   >R                                          BEGIN   R EXECUTE  ?TERMINAL  UNTIL  R> DROP ;              ;S                                                              ( Used in the form:   GO   cccc                                                                                                 The word cccc is executed repeatedly until a key is pressed     at the terminal. Used while interpreting. cccc must not         alter the stack.                                               )                                                                                                                                                                                                                                                                                                                                ( ASCII                                            MCS 81MAR13 )                                                                : ASCII   ( --- N ) ( IF EXECUTING )  ( C )                               ( --- )   ( IF COMPILING )  ( C )                         BL WORD   HERE 1+ C@   STATE @           IF ( COMPILING )         [COMPILE] LITERAL                      ENDIF ;                                                                            IMMEDIATE                                                       ;S                                                              ( Used in the form:   ASCII  c                                                                                                  The ASCII equivalent of the first character of the next word    of the input stream is place on the stack if executing or       compiled as a literal if compiling.                            )                                                                                                                                ( SCRCPY                                           MCS 81FEB25 )                                                                : SCRCPY   ( FROM, TO, N ---  )                                     ROT B/SCR *   ROT B/SCR *   SWAP  ROT B/SCR *                                                       0 DO  ( FOR EACH BLOCK )    I [ #BUFF 1 - ] LITERAL AND 0= IF           ( BUFFERS FULL )      FLUSH                        ENDIF               ( FLUSH )    2DUP   BLOCK   2 - !   UPDATE              ( READ & UPDATE )    1+ SWAP 1+ SWAP   LOOP   2DROP   FLUSH ;     ( BUMP & LOOP );S                                                              ( Will copy a sequence of N screens starting with FROM to a     sequence of screens beginning with TO . The ranges must not     overlap. All disk buffers will be used to minimize disk head    motion. Any size or number of buffers may be used by            recompiling SCRCPY .                                           )                                                                ( REMEMBER                                         MCS 81MAR15 )                                                                : TRANSIENT   ( NAME )                                              <BUILDS LATEST ,             ( SAVE NFA IN PARAMETER FIELD )    DOES>   @   DUP   DP !                        ( BACK UP DP )    PFA LFA @   CURRENT @ ! ;           ( LINK CURRENT TO PREV )                                                                ;S                                                              ( Used in the form:   REMEMBER   cccc                                                                                           Used to define word cccc which when executed will forget        itself and all subsequently defined words.                     )                                                                                                                                                                                                                                                                ( DIR - LIST CP/M DIRECTORY                        MCS 81MAR15 )                                                                REMEMBER DISCARD               DECIMAL                                                                                          %MAKE   DIRFCB   ????????.???    DROP   ( DRV ---  )                                                                            : /DIR                                                              CR 0 OUT !   128 26 BDOS       ( SET DMA TO DEFAULT BUFFER )    DIRFCB 6 + 17 BDOS                            ( FIND FIRST )    BEGIN DISK-ERROR @ DUP 255 - WHILE              ( IF FOUND )    32 * 128 + 1 + DUP 8 TYPE SPACE 8 + 3 TYPE       ( DISPLAY )    OUT @ 45 < IF ."  : " ELSE CR 0 OUT ! ENDIF    ( NEWLINE ? )    DIRFCB 6 + 18 BDOS REPEAT DROP CR ;            ( FIND NEXT )                                                                /DIR   DISCARD                                                                                                                  ( XEC, INSTALL, AS, CR                             MCS 81MAR15 )                                                                : XEC   ( CFA ---  )                            ( NAME FOLLOWS )    <BUILDS , DOES> @ EXECUTE ;                                                                                                 : INSTALL   ( NAME FOLLOWS )   [COMPILE] ' CFA ;                                                                                : AS   ( XEC VARIABLE FOLLOWS )   [COMPILE] ' 2+ ! ;                                                                            : CR    0 OUT !   CR ;                                                                                                          : UNDEF   14 MESSAGE ;                                                                                                                                                                                                                                                                                                          ( INTERNAL, EXTERNAL, MODULE                       MCS 81APR19 )                                                                : INTERNAL   LATEST ;               ( LOCAL DEFINITIONS FOLLOW )                                                                : EXTERNAL   HERE ;              ( EXTERNAL DEFINITIONS FOLLOW )                                                                : MODULE     PFA LFA ! ;                  ( LINK AROUND LOCALS )                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                ( FPLS - CONSTANTS                                 MCS 81MAR24 )                                                                VOCABULARY FPLS IMMEDIATE   FPLS DEFINITIONS                                                                                    : K   CONSTANT ;                                                                                                                0  K I0    2  K I1    4  K I2     6 K I3    8  K I4    10 K I5  12 K I6    14 K I7    16 K I8    18 K I9    20 K I10   22 K I11 24 K I12   26 K I13   28 K I14   30 K I15   32 K P0    34 K P1  36 K P2    38 K P3    40 K P4    42 K P5    44 K C0    46 K N0  48 K N1    50 K N2    52 K N3    54 K N4    56 K N5    58 K F0  60 K F1    62 K F2    64 K F3    66 K F4    68 K F5    70 K F6  72 K F7                                                                                                                         0 VARIABLE NTERMS   LIMIT CONSTANT MAP                          -->                                                             ( FPLS - EQUATION COMPILER                         MCS 81MAR24 )                                                                : BURN ( ROW, BITCOL --- )                                          8 /MOD 1+ 256 * ROT +    ( RELATIVE BYTE OF MAP )               MAP + SWAP PWR2 TOGGLE ; ( TOGGLE RELATIVE BIT  )                                                                           : TERM   ( INPUTS ... , COUNT --- )                                <BUILDS  NTERMS @ ,    ( WILL RETURN TERM NUMBER LATER )        0 DO NTERMS @ BURN LOOP ( TOGGLE AT INTERSECT           )       1 NTERMS +!  DOES> @ ; ( BUMP TERMS                    )                                                                     : SET  ( TERMS ... , COUNT, FF --- )                               SWAP 0 DO DUP ROT BURN LOOP DROP ;                                                                                           : CLR  1+ SET ;                                                 -->                                                             ( FPLS - INITIALIZE MAP                            MCS 81MAR24 )HEX                                                             : MAPCLR   MAP 700 ERASE ;                                                                                                      : MAPSET                      ( INITIALIZE ALL FUSES TO BURN )      MAP 100 + 600 OVER + SWAP DO I 4A FF FILL 100 +LOOP ;                                                                       : FPLSDUMP  BASE @  HEX  LIMIT 700 OVER + SWAP DO                   I DUMPLINE ?TERMINAL IF LEAVE ENDIF 10 +LOOP                    BASE ! ;                                                                                                                    : TERMSAV ( SAVE UNUSED TERMS )                                     30 NTERMS @ 2DUP - IF                                           DO 2D 0 DO I J BURN LOOP LOOP ELSE DROP DROP ENDIF ;        DECIMAL                                                         -->                                                             ( FPLS - DISPLAY MAP )                                                                                                          : BIN 2 BASE ! ;                                                                                                                : FPLS.                                                             CR  74 0 DO  HEX I 0 4 D.R   4 SPACES   I                       0 6 DO I 256 * OVER + LIMIT + C@                                  BIN 0 <# 8 0 DO # LOOP #> TYPE SPACE                          -1 +LOOP DROP CR ?TERMINAL IF LEAVE ENDIF                       LOOP CR DECIMAL ;                                                                                                           : *  1+ ;   : = CONSTANT ;                                                                                                      TRANSIENT DISCARD                                                                                                                                                                               ( FPLS - EXAMPLE )                                                                                                              : *  1+ ;   : = CONSTANT ;     MAPCLR  MAPSET                                                                                   I0 = SMITH  I1 = JONES  I2 = GEORGE                                                                                             SMITH  JONES *   2   TERM  T0                                   GEORGE  SMITH *  2   TERM  T1                                                                                                   T0  1  N0 SET                                                   T1  1  F0 SET                                                   T1  1  F0 CLR                                                                                                                   TERMSAV  ARY.                                                                                                                                                                                   ( A POEM )                                                           TRANSIENT DISCARD                                          : RECITE    57 LOAD DISCARD ;                                   : THE       ." the " ;                                          : THAT  CR  ." that " ;                                         : THIS  CR  ." This is " THE ;                                  : JACK      ." Jack Built" ;                                    : SUMMARY   ." Summary" ;                                       : FLAW      ." Flaw" ;                                          : MUMMERY   ." Mummery" ;                                       : K         ." Constant K" ;                                    : HAZE      ." Erudite Verbal Haze" ;                           : PHRASE    ." Turn on a Plausible Phrase" ;                    : BLUFF     ." Chaotic Confusion and Bluff" ;                   : STUFF     ." Cybernetics and Stuff"  ;                        : THEORY    ." Theory " JACK  ; -->                             ( A POEM )                                                      : BUTTON     ." Button to Start the Machine" ;                  : CHILD      ." Space Child with Brow Serene" ;                 : CYBERNETICS ." Cybernetics and Stuff" ;                       : HIDING   CR ." Hiding " THE FLAW ;                            : LAY    THAT ." lay in " THE THEORY ;                          : BASED  CR   ." Based on " THE MUMMERY ;                       : SAVED    THAT ." saved " THE SUMMARY ;                        : CLOAK  CR  ." Cloaking " K ;                                  : THICK IF THAT ELSE CR ." And " ENDIF ." Thickened " THE HAZE ; : HUNG   THAT ." hung on " THE PHRASE ;                        : COVER IF THAT ." covered " ELSE CR ." To cover " ENDIF BLUFF ; : MAKE   CR  ." To make with " THE CYBERNETICS ;               : PUSHED CR  ." Who pushed " BUTTON ;                           : REST   46 EMIT 10 SPACES KEY DROP CR CR CR ;                  : WITHOUT CR ." Without Confusion, exposing the Bluff" ; RECITE ( A POEM )                                                      CR CR CR THIS THEORY REST                                       THIS FLAW LAY REST                                              THIS MUMMERY HIDING LAY REST                                    THIS SUMMARY BASED HIDING LAY REST                              THIS K SAVED BASED HIDING LAY REST                              THIS HAZE CLOAK SAVED BASED HIDING LAY REST                     THIS PHRASE 1 THICK CLOAK SAVED BASED HIDING LAY REST           THIS BLUFF HUNG 1 THICK CLOAK SAVED BASED HIDING LAY REST       THIS STUFF 1 COVER HUNG 0 THICK CLOAK SAVED BASED HIDING           LAY REST                                                     THIS BUTTON MAKE 0 COVER HUNG 0 THICK CLOAK SAVED                 BASED HIDING LAY REST                                         THIS CHILD PUSHED CR ." That made with " CYBERNETICS WITHOUT      HUNG CR ." And, shredding " THE HAZE CLOAK CR ." Wrecked " THE  SUMMARY BASED HIDING CR ." And Demolished " THEORY REST       ( TRANSIENTS                                       MCS 81MAR15 )                                                                : TRANSIENT                                 ( FOLLOW WITH NAME )    <BUILDS LATEST ,                 ( WHEN EXECUTED WILL SELF )    DOES> @ DUP DP !   PFA LFA @   CURRENT @ ! ;    ( DESTRUCT )                                                                : DIR  ( DRV ---  ) 59 LOAD ;            ( LIST CP/M DIRECTORY ): POEM 55 LOAD ;                               ( RECITE A POEM ): PALS 73 LOAD ;                           ( MMI PAL COMPILTER )                                                                                                                                                                                                                                                                                                                                                                                                                                                                ( DIR - LIST CP/M DIRECTORY                        MCS 81MAR15 )                                                                TRANSIENT DISCARD                                                                                                               %MAKE   DIRFCB   ????????.???    DROP   ( DRV ---  )                                                                            : /DIR                                                              CR 0 OUT !   128 26 BDOS       ( SET DMA TO DEFAULT BUFFER )    DIRFCB 6 + 17 BDOS                            ( FIND FIRST )    BEGIN DISK-ERROR @ DUP 255 - WHILE              ( IF FOUND )    32 * 128 + 1 + DUP 8 TYPE SPACE 8 + 3 TYPE       ( DISPLAY )    OUT @ 45 < IF ."  : " ELSE CR 0 OUT ! ENDIF    ( NEWLINE ? )    DIRFCB 6 + 18 BDOS REPEAT DROP CR ;            ( FIND NEXT )                                                                /DIR   DISCARD                                                                                                                  ( XEC, INSTALL, AS, CR                             MCS 81MAR15 )                                                                : XEC   ( CFA ---  )                            ( NAME FOLLOWS )    <BUILDS , DOES> @ EXECUTE ;                                                                                                 : INSTALL   ( NAME FOLLOWS )   [COMPILE] ' CFA ;                                                                                : AS   ( XEC VARIABLE FOLLOWS )   [COMPILE] ' 2+ ! ;                                                                            : CR    0 OUT !   CR ;                                                                                                          : UNDEF   14 MESSAGE ;                                                                                                                                                                                                                                                                                                          ( UCSD                                             MCS 81MAR19 )                                                                64 LOAD                                                                                                                         2 OPEN #1 READ.PAS                                                                                                              1 REWRITE #2 READ.PAS                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           ( UCSD                                             MCS 81MAR19 )                                                                0 VARIABLE K   0 VARIABLE DLE                                                                                                   : OUTCHR ( C ---  )                                                 PAD K @ + C!   1 K +!   K @ 128 =                               IF   PAD #2 PUT  0 K !   ENDIF ;                                                                                            : FINISH                                                            BEGIN K @ WHILE 26 OUTCHR REPEAT   #2 CLOSE ;                                                                                                                                                                                                                                                                               -->                                                                                                                             ( UCSD                                             MCS 81MAR19 )                                                                : DOBUF ( ADDR ---  )  B/BUF OVER + SWAP DO                         I C@ DLE @ IF ( EXPAND BLANKS )                                   BL - -DUP IF 0 DO BL OUTCHR LOOP ENDIF  0 DLE !               ELSE DUP BL < IF DUP 13 = IF OUTCHR 10 OUTCHR                   ELSE DUP 16 = IF DLE ! ELSE DROP ENDIF ENDIF                    ELSE OUTCHR ENDIF ENDIF LOOP ;                                                                                              : CONVERT ( PTR ---  )  2@ 8 + DO                                   I BLOCK DOBUF ?TERMINAL IF LEAVE ENDIF LOOP FINISH ;                                                                        ( CONVERT UCSD PASCAL .TEXT FILE PTR TO A PASCAL/M FILE #2  )   ( %MAKE #2 AND CALL BDOS TO OPEN   FINISH WILL CLOSE        )   ( TO REVIEW   #2 %OPEN %LINK %FTYPE                         )                                                                   ( SEQUENCIAL FILES                                 MCS 81MAR20 )                                                                : REWRITE ( DRV ---  )                      ( FID & UFN FOLLOW )    %MAKE 6 + DUP 19 BDOS                   ( DELETE OLD FILES )    22 BDOS                                    ( MAKE THE FILE )    DISK-ERROR @ 255 = 11 ?ERROR ;                ( MAKE ERROR )                                                                : PUT ( ADDR, FID ---  )                                            SWAP 26 BDOS   6 + 21 BDOS   DISK-ERROR @ 12 ?ERROR ;                                                                       : CLOSE ( FID ---  )                                                FLUSH   DUP 6 + 16 BDOS                   ( CLOSE THE FILE )    DISK-ERROR @ 255 = 13 ?ERROR             ( CHECK FOR ERROR )    4 + @ -DUP IF FILES ! ENDIF ;           ( UNLINK IF LINKED )                                                                                                                                ( PRINTER )                                                                                                                     : PRT ( N ---  )                                                    DUP + 8 /MOD SWAP 11 P!  ( SEND LOW BYTE )                      BEGIN 10 P@ 128 AND UNTIL                                       128 OR 10 P! ;                                                                                                              : TEST CHR % PRT CHR W PRT ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    ( LISTING )                                                                                                                     : LISTING   ( N1 N2 --- )   SWAP  TRIAD                            BEGIN    SCR @ OVER < WHILE                                       1 SCR +!  SCR @ TRIAD  REPEAT  DROP ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      ( LIST )                                                        HEX                                                                                                                                                                                             : LIST DECIMAL CR DUP SCR ! ." SCR #" DUP . 5 SPACES HEX .          ." HEX" DECIMAL 10 0 DO CR R 3 .R                             SPACE R SCR @ .LINE ?TERMINAL IF LEAVE ENDIF LOOP CR ;                                                                        DECIMAL                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         ( READ                                             MCS 81MAR08 )                                                                0 VARIABLE FCB   34 ALLOT                                                                                                       : READ ( TO, BYTES, DRV ---  )        ( CPM FILE NAME FOLLOWS )     FCB  DUP 36 0 FILL  DUP 1+ UFN  C!             ( SETUP FCB )    FCB 15 BDOS  DISK-ERROR @ 255 = 9 ?ERROR   ( OPEN THE FILE )    OVER + SWAP DO                                                    I 26 BDOS   FCB 20 BDOS  DISK-ERROR @ 12 ?ERROR               128 +LOOP  FCB 16 BDOS  DISK-ERROR @ 255 = 13 ?ERROR ;                                                                                                                                                                                                                                                                                                                                                                                                      ( SAVE                                             MCS 81MAR08 )                                                                0 VARIABLE FCB   34 ALLOT                                                                                                       : SAVE ( FROM, BYTES, DRV ---  )       ( CPM FILE NAME FOLLOWS )    FCB  DUP 36 0 FILL  DUP 1+ UFN  C!             ( SETUP FCB )    FCB 19 BDOS                             ( DELETE OLD FILES )    FCB 22 BDOS  DISK-ERROR @ 255 = 11 ?ERROR  ( MAKE THE FILE )    OVER + SWAP DO                                                    I 26 BDOS   FCB 21 BDOS  DISK-ERROR @ 12 ?ERROR               128 +LOOP  FCB 16 BDOS  DISK-ERROR @ 255 = 13 ?ERROR ;                                                                                                                                                                                                                                                                                                                                      ( FPLS - DISPLAY MAP )                                                                                                          : BIN 2 BASE ! ;                                                                                                                : FPLS.                                                             CR  74 0 DO  HEX I 0 4 D.R   4 SPACES   I                       6 0 DO I 256 * OVER + LIMIT + C@                                  BIN 0 <# 8 0 DO # LOOP #> TYPE SPACE                          -1 +LOOP DROP CR ?TERMINAL IF LEAVE ENDIF                       LOOP CR DECIMAL ;                                                                                                                                                                                                                                                                                                                                                                                                                                           ( 8X300 CROSS ASSEMBLER                            MCS 81MAR01 ): OCTAL  8 BASE ! ;                                             VOCABULARY 8XASM   IMMEDIATE   8XASM    DEFINITIONS   OCTAL      0 CONSTANT R0    1 CONSTANT R1    2 CONSTANT R2                 3 CONSTANT R3    4 CONSTANT R4    5 CONSTANT R5                 6 CONSTANT R6    7 CONSTANT IOL   17 CONSTANT IOR              10 CONSTANT OVR  11 CONSTANT R11   : EQU  CONSTANT ;             0 VARIABLE M$    0 VARIABLE SORG  : ORG  SORG @ + M$ ! ;       : M,  M$ @ ! 2 M$ +! ;     : OP@  @ 40 * + ;                    : J  400 * + M, ;          : LJ 10 * + 40 * + M, ;              : A/L <BUILDS , DOES> OP@ LJ ;                                       0 A/L MOVE   1 A/L ADD   2 A/L AND   3 A/L XOR             : XTI <BUILDS , DOES> OP@ DUP 20 AND IF LJ ELSE J ENDIF ;            4 XTI XEC  5 XTI NZT  6 XTI XMIT                           : JMP 70000 + M, ;                                                                                                              ( DECOMPILE )                                                                                                                   : UNDO ( DECOMPILE FOLLOWING WORD )                                 HEX HERE 81 OVER C! 0 OVER C! CONTEXT @ @ (FIND)               DROP DROP  BEGIN CR DUP @ 2+ NFA ID. 10 SPACES ." ?"              KEY DUP 76 = IF CR SWAP 2+ DUP @ .                                SWAP 10 SPACES ." ? " ENDIF                                       SWAP 2+ SWAP 81 = IF 1 ELSE 0 ENDIF UNTIL DROP ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       ( PALS                                             MCS 81MAY28 )VOCABULARY PALS   IMMEDIATE   PALS DEFINITIONS                                                                                  0 VARIABLE TFLG       0 VARIABLE LASTOUT   0 VARIABLE INVERT    0 VARIABLE PRODUCT   32 CONSTANT -         0 VARIABLE LR                                                                        : ADDR ( INPUT --- ADDR, DATA )                                     PRODUCT @ 8 /MOD SWAP   32 * ROT + SWAP                         4 /MOD 256 * LIMIT + ROT +   SWAP PWR2 ;                                                                                    : FUSE ( INPUT ---  ) INVERT @ + 0 INVERT ! ADDR TOGGLE ;                                                                       : INPUT   <BUILDS ,                                                 DOES>   TFLG @ 0= 1201 ?ERROR   0 TFLG !                        @    FUSE ;                                                 -->                                                             ( PALS                                             MCS 81MAY28 )                                                                : +    LASTOUT @ DUP @ DUP 0= 1204 ?ERROR                           DUP + OVER + @ PRODUCT !  -1 SWAP +!                            32 0 DO I FUSE LOOP 1 TFLG ! ;                                                                                              : OUTPUT   ( T0,T1, ... ,TN,N,INPUT ---  )                          <BUILDS , DUP , 0 DO , LOOP                                     DOES> TFLG @                                                      IF @ DUP 31 > 1203 ?ERROR                 ( INPUT WANTED )        FUSE   0 TFLG !                                               ELSE 2+ LASTOUT ! INVERT @ LR @ XOR 1206 ?ERROR                 0 INVERT ! + ENDIF ;                                      : =    TFLG @ 0= 1205 ?ERROR ;                                  : /   1 INVERT ! ;                                              : *   TFLG @ 1201 ?ERROR   1 TFLG ! ; -->                       ( PALS                                             MCS 81MAY28 )                                                                : PAL.   FORTH CR 64 0 DO I PRODUCT !                               I 0 4 D.R  2 SPACES  32 0 DO I 3 AND  0= IF SPACE ENDIF           I ADDR SWAP C@ AND IF CHR - ELSE CHR X ENDIF EMIT               LOOP CR I 8 MOD 7 = IF CR ENDIF                                 ?TERMINAL IF LEAVE ENDIF LOOP ;                           : CLR   LIMIT 512 0 FILL  0 TFLG ! ;   : SKIP 32 WORD ;                                                : HI   0 TFLG ! ;        : TWK ( INPUT ---  ) PRODUCT @ SWAP ADDR OVER C@ OR SWAP C! ;                                                                   : 10H8   97 LOAD  0 LR ! ;   : 10L8   97 LOAD  1 LR ! ;         : 16R4   100 LOAD ; : 16R6   100 LOAD ; : 16R8   100 LOAD ;     : 16L8   99 LOAD ;  : 14L4   98 LOAD ;                                                                                          TRANSIENT DISCARD                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               ( LOAD SCREEN FOR NEW FPLS )                                                                                                    0 OPEN #1 NFPS.BLK                                                                                                              0 OPEN #2 FPLS2.BLK                                                                                                             129 LOAD                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        ( PAL MESSAGES )                                                OUTPUT NAME EXPECTED                                            INPUT NAME EXPECTED                                             NO FEEDBACK FROM OUTPUT                                         NO MORE TERMS                                                   MUST FOLLOW OUTPUT NAME                                         INVERT OUTPUT NAME                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              ( TEXT FILE PROCESSING )                                        13 CONSTANT ACR   9 CONSTANT HT                                                                                                 : ALN   PAD COUNT TYPE CR  0 PAD C! ;                                                                                           : XFER   ( CH ---    ADD TO PAD )                                   PAD DUP C@ 1+ 2DUP SWAP C! + C! ;                           : TAB     8 PAD C@ 7 AND - 0 DO BL XFER LOOP ;                                                                                  : ABUF   ( ADDR ---   SEND LINES TO PAD )                           B/BUF OVER + SWAP DO I C@ DUP BL < IF                           DUP ACR = IF ALN ELSE DUP HT = IF TAB ENDIF ENDIF DROP          ELSE XFER ENDIF LOOP ;                                      : AFILE   ( PTR ---   PROCESS THE TEXT FILE )                       0 PAD C!   CR                                                   2@ DO I BLOCK ABUF ?TERMINAL IF LEAVE ENDIF LOOP ;          ( TURN-KEY )                                                                                                                    : STARTUP                                                           SP! DECIMAL [COMPILE] FORTH DEFINITIONS SP!                     128 C@ IF ( TAIL ON COMMAND LINE )                              TIB @ DUP 82 0 FILL 128 COUNT ROT SWAP CMOVE                    0 IN ! [ ' QUIT ] LITERAL >R   INTERPRET                        ELSE ( NO TAIL ) 8 LOAD ENDIF ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             ( 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                                                                                                                                                                                                                                                              ( SPELL )                                                                                                                       : (COMP)   ( ADDR, ADDR, COUNT --- FLG )                            0 SWAP OVER DO DROP 1 1 D+ 2DUP C@ SWAP C@ -                    DUP IF LEAVE ENDIF LOOP SWAP DROP SWAP DROP ;                                                                               : COMP ( A, B --- FLG )                                             2DUP C@ SWAP C@ 2DUP - >R MIN (COMP)                            DUP IF R> DROP ELSE DROP R> ENDIF ;                                                                                         : MYSELF  LATEST PFA CFA , ; IMMEDIATE                                                                                          : WALK ( N --- )                                                    @ -DUP IF DUP MYSELF                   ( CALL FOR LEFT SON )    DUP 4 + COUNT TYPE SPACE                     ( OUTPUT SELF )    2+ MYSELF ENDIF ; -->                 ( CALL FOR RIGHT SON )( SPELL )                                                                                                                         LIMIT VARIABLE VP     0 VARIABLE TREE                                                                                         : ADDWORD   ( TARGET, PTR --- )                                     VP @ DUP ROT !          ( SET PTR TO VP@ )                      DUP 4 0 FILL            ( CLEAR TWO PTRS )                      4 + OVER C@ 1+          ( # OF BYTES     )                      2DUP + VP !  CMOVE ;    ( UPDATE VP AND MOVE )                                                                              : SEARCH   ( TARGET, PTR --- )                                      BEGIN   DUP @ IF                              ( PTR <> NIL )    2DUP @ 4 + COMP -DUP                             ( COMPARE )    ELSE ( PTR = NIL ) 2DUP ADDWORD 0 ENDIF                         WHILE                             ( NOT ADDWORD OR WORDS = )    0< IF @ 2+ ELSE @ ENDIF REPEAT 2DROP ; -->                  ( SPELL )                                                                                                                       : SPBUF   ( ADDR --- )                                              B/BUF OVER + SWAP DO I C@             ( GET NEXT CHARACTER )    DUP EMIT  127 AND                        ( STRIP TO 7 BITS )    DUP CHR Z > IF 32 - ENDIF          ( CONVERT TO UPPER CASE )    DUP CHR A <   OVER CHR Z >   OR      ( CHECK FOR NON ALPHA )    IF   DROP   HERE C@   IF HERE TREE SEARCH 0 HERE ! ENDIF        ELSE HERE DUP C@ 1+ DUP HERE C! + C! ENDIF LOOP ;                                                                           : SPELL   ( PTR --- )                                               0 HERE !   LIMIT VP !   0 TREE !                                2@ DO I BLOCK SPBUF ?TERMINAL IF LEAVE ENDIF LOOP ;                                                                                                                                                                                                         ( SPELL )                                                                                                                       2 OPEN DICT DICT.VOC   0 VARIABLE VPTR                                                                                          26 LOAD ( CASE )   0 VARIABLE DICTBLK                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           -->                                                             ( SPELL )                                                                                                                       : WARN ( PTR --- )                                                  DUP COUNT TYPE SPACE ." not found. A)dd or S)kip ? "            BEGIN KEY DUP CHR Z > IF 32 - ENDIF CASE                        CHR S OF DROP 1 ENDOF                                           CHR A OF DROP 7 EMIT 1 ENDOF                                    7 EMIT   0  ENDCASE UNTIL CR ;                                                                                              : NEXTBLK  DICTBLK 1 OVER +! @   ( NEXT BLOCK NUMBER )              DUP DICT 2+ @ = IF ( EOF ) 1 MINUS HERE ! ENDIF                 BLOCK VPTR ! ;                                                                                                                                                                                                                                              -->                                                             ( SPELL )                                                                                                                       : NEXTWORD   0 HERE C!  ( NEXT DICT WORD TO HERE )                  BEGIN VPTR 1 OVER +! C@ DUP CHR A <                             IF ( CTL ) IF ( DELIM ) 1 ELSE ( NULL ) NEXTBLK ENDIF           ELSE HERE 1 OVER +! DUP C@ + C! 0 ENDIF UNTIL ;                                                                             : LOOKUP ( TARGET --- )                                             BEGIN HERE OVER COMP DUP 0<                                     WHILE ( DICT < TARGET ) DROP NEXTWORD REPEAT                    IF WARN ELSE DROP ENDIF ;  ( WARN IF NOT FOUND )                                                                            : WALK ( N --- )                                                    @ -DUP IF DUP MYSELF  ( CALL FOR LEFT SON )                     DUP 4 + LOOKUP                                                  2+ MYSELF ENDIF ; -->    ( CALL FOR RIGHT SON )             ( SPELL )                                                                                                                       2 OPEN DICT DICT.VOC   0 VARIABLE VPTR                                                                                          DICT @ BLOCK VPTR !  NEXTWORD                                                                                                   TREE WALK                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       ( SPELL )                                                       ( WOULD IF BE QUICKER TO LOAD THE DICTIONERY WITH KEYED ACCESS )( INTO RAM AND THEN LOOK UP EACH WORD IN THE FILE ?            )( MEMORY SIZE WOULD LIMIT DICTIONERY - USE VIRTUAL             )( NO SORTING   WOULD BE EASIER TO FIX WORDS AS FOUND           )( EACH OCCURENCE OF THE ERROR WOULD CAUSE A BREAK              )                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                ( MULTI-M1 DETECT PAL )                                                                                                         PALS   16R4                                                                                                                     1. CLK                          20. VCC                         2. D0                           19. MM1                         3. D1                           18. /MM1                        4. D2                           17. /S0                         5. D3                           16. NC                          6. D4                           15. NC                          7. D5                           14. NC                          8. D6                           13. /M1                         9. D7                           12. /TRAP-RESET                 10. GND                         11. /OE                                                                                         -->                                                             ( MULTI-M1 DETECT PAL )                                                                                                         / /S0    = /S0 * /TRAP-RESET * D0 * / D1 * D2 * D3 * / D4 * / D5         * D6 * D7 * / /M1                                                                                                               + /S0 * /TRAP-RESET * D0 * / D1 * D2 * D3 * D4 * D5             * D6 * D7 * / /M1                                                                                                               + /S0 * /TRAP-RESET * D0 * / D1 * D2 * D3 * D4 * / D5            * D6 * D7 * / /M1                                                                                                              + /S0 * /TRAP-RESET * D0 * D1 * / D2 * D3 * / D4                * / D5 * D6 * D7 * / /M1                                                                                                                                                               -->                                                             ( MULTI-M1 DETECT PAL )                                                                                                         / /MM1  = HI                                                            + / /TRAP-RESET * / /M1                                         +   /TRAP-RESET * /S0 * / /M1                                                                                           / MM1   = HI                                                            + / /MM1                                                                                                                                                                                                                                                PAL.           TWEEK                                                                                                                                                                                                                                            LIMIT 512 0 SAVE MPZ.PAL                                        ( PALS - EXAMPLE )                                              PALS 10H8                                                       1. A   2. C  3. E   4. F   5. H   6. I   7. K   8. L   9. N     10. GND   11. O   12. NU1   13. NU2   14. P   15. M   16. J     17. G   18. D   19. B   20. VCC                                                                                                 B = A                                                           D = / C                                                         G = E * F                                                       J = H + I                                                       M = / K + / L                                                   P = / N * / O                                                                                                                   PAL.                                                                                                                                                                                            ( PALS - 10H8 - 10L8                               MCS 81MAR29 )                                                                DISCARD   TRANSIENT DISCARD   CLR                                                                                               : 1. 2 INPUT ;  : 2. 0 INPUT ;   : 3. 4 INPUT ;  : 4. 8 INPUT ; : 5. 12 INPUT ;   : 6. 16 INPUT ;   : 7. 20 INPUT ;             : 8. 24 INPUT ;   : 9. 28 INPUT ;   : 10. 32 WORD ;             : 11. 30 INPUT ;           : 12. 56 57 2 - OUTPUT ;             : 13. 48 49 2 - OUTPUT ;   : 14. 40 41 2 - OUTPUT ;             : 15. 32 33 2 - OUTPUT ;   : 16. 24 25 2 - OUTPUT ;             : 17. 16 17 2 - OUTPUT ;   : 18. 8 9 2 - OUTPUT ;               : 19. 0 1 2 - OUTPUT ;     : 20. 32 WORD ;                                                                                      : TWEEK  8 0 DO 2 0 DO FORTH J 8 * I + PRODUCT ! PALS               6 TWK 7 TWK 10 TWK 11 TWK 14 TWK 15 TWK 18 TWK 19 TWK          22 TWK 23 TWK 26 TWK 27 TWK LOOP LOOP ;                      ( PALS - 14L4                                      MCS 81MAR29 )                                                                DISCARD   TRANSIENT DISCARD   CLR   1 LR !                                                                                      : 1. 2 INPUT ;      : 2. 0 INPUT ;      : 3. 4 INPUT ;          : 4. 8 INPUT ;      : 5. 12 INPUT ;     : 6. 16 INPUT ;         : 7. 20 INPUT ;     : 8. 24 INPUT ;     : 9. 28 INPUT ;         : 10. SKIP ;        : 11. 30 INPUT ;    : 12. 26 INPUT ;        : 13. 22 INPUT ;    : 18. 10 INPUT ;    : 19. 6 INPUT ;         : 20. SKIP ;                                                    : 14. 40 41 42 43 4 - OUTPUT ;                                  : 15. 32 33 34 35 4 - OUTPUT ;                                  : 16. 24 25 26 27 4 - OUTPUT ;                                  : 17. 16 17 18 19 4 - OUTPUT ;                                  : TWEEK 6 2 DO 4 0 DO FORTH J 8 * I + PALS PRODUCT !              14 TWK 15 TWK 18 TWK 19 TWK LOOP LOOP ;                       ( PALS - 16L8                                      MCS 81MAR29 )                                                                DISCARD   TRANSIENT DISCARD   CLR       : TWEEK ;   1 LR !                                                                      : 1. 2 INPUT ;      : 2. 0 INPUT ;      : 3. 4 INPUT ;          : 4. 8 INPUT ;      : 5. 12 INPUT ;     : 6. 16 INPUT ;         : 7. 20 INPUT ;     : 8. 24 INPUT ;     : 9. 28 INPUT ;         : 10. SKIP ;        : 11. 30 INPUT ;    : 20. SKIP ;            : 12. 56 57 58 59 60 61 62 63 8 -  OUTPUT ;                     : 13. 48 49 50 51 52 53 54 55 8 26 OUTPUT ;                     : 14. 40 41 42 43 44 45 46 47 8 22 OUTPUT ;                     : 15. 32 33 34 35 36 37 38 39 8 18 OUTPUT ;                     : 16. 24 25 26 27 28 29 30 31 8 14 OUTPUT ;                     : 17. 16 17 18 19 20 21 22 23 8 10 OUTPUT ;                     : 18.  8  9 10 11 12 13 14 15 8 6  OUTPUT ;                     : 19.  0  1  2  3  4  5  6  7 8 -  OUTPUT ;                     ( PALS - 16R4 - 16R6 - 16R8                        MCS 81MAR29 )                                                                DISCARD   TRANSIENT DISCARD   CLR       : TWEEK ;   1 LR !                                                                      : 1. SKIP ;         : 2. 0 INPUT ;      : 3. 4 INPUT ;          : 4. 8 INPUT ;      : 5. 12 INPUT ;     : 6. 16 INPUT ;         : 7. 20 INPUT ;     : 8. 24 INPUT ;     : 9. 28 INPUT ;         : 10. SKIP ;        : 11. SKIP ;        : 20. SKIP ;            : 12. 56 57 58 59 60 61 62 63 8 30 OUTPUT ;                     : 13. 48 49 50 51 52 53 54 55 8 26 OUTPUT ;                     : 14. 40 41 42 43 44 45 46 47 8 22 OUTPUT ;                     : 15. 32 33 34 35 36 37 38 39 8 18 OUTPUT ;                     : 16. 24 25 26 27 28 29 30 31 8 14 OUTPUT ;                     : 17. 16 17 18 19 20 21 22 23 8 10 OUTPUT ;                     : 18.  8  9 10 11 12 13 14 15 8 6  OUTPUT ;                     : 19.  0  1  2  3  4  5  6  7 8 2  OUTPUT ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     ( G182-A   RAM16 CONTROL PAL                       WJG 81JUL02 )                                                                PALS   10L8                                                                                                                     1. PDBIN                        20. VCC                         2. A0H                          19. /SELB                       3. /PHANTOM                     18. /MSEL                       4. /A0L                         17. /SELA                       5. /SWO                         16. /SELD                       6. A15                          15. /SELC                       7. /SXTRQ                       14. /ENDO                       8. /MEMR                        13. /ENDI                       9. /BSEL                        12. /ENX                        10. GND                         11. SOUT                                                                                        -->                                                             ( G182-A   RAM16 CONTROL PAL                       WJG 81JUL02 )                                                                / /ENDI   = / /BSEL * /PHANTOM * / /MEMR * PDBIN                          + / /BSEL * /PHANTOM * / /SWO * / /SXTRQ * / SOUT                                                                     / /ENX  = / /BSEL * /PHANTOM * / /MEMR * /SXTRQ * / A0H * /A0L          + / /BSEL * /PHANTOM * / /SWO  * /SXTRQ                         *  A0H * / /A0L * / SOUT                                                                                                / /ENDO = / /BSEL * /PHANTOM * / /MEMR * / /SXTRQ * PDBIN               + / /BSEL * /PHANTOM * / /SWO  * / SOUT                                                                                                                                                                                                                                                                                 -->                                                             ( G182-A   RAM16 CONTROL PAL                       WJG 81JUL02 )                                                                / /SELA = /PHANTOM * /SXTRQ * / A15 * / A0H * /A0L                      + /PHANTOM * / /SXTRQ * / A15                                                                                           / /SELB = /PHANTOM * /SXTRQ * / A15  * A0H * / /A0L                     + /PHANTOM *  / /SXTRQ * / A15                                                                                          / /SELC = /PHANTOM * /SXTRQ * A15 * / A0H * /A0L                        + /PHANTOM *   / /SXTRQ * A15                                                                                           / /SELD = /PHANTOM * /SXTRQ * A15 * A0H * /A0L                          + /PHANTOM *   / /SXTRQ * A15                                                                                                                                                           -->                                                             ( G182-A   RAM16 CONTROL PAL                       WJG 81JUL02 )                                                                / /MSEL  = / /SWO * / SOUT * /PHANTOM                                    + / /MEMR * /PHANTOM                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   PAL.    TWEEK                                                                                                                   LIMIT 512 0 SAVE G182-A.DAT                       ( REV 7/2/81 )                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                ( UTILITIES                                        MCS 81FEB25 )                                                                : .OCT   0 <# # # # #> TYPE ;                                                                                                   : (DUMP)   ( ADDR ---  )                                            DUP 256 /MOD .OCT CHR : EMIT .OCT 2 SPACES                      8 OVER + SWAP DO I C@ .OCT 2 SPACES LOOP CR ;                                                                               : DUMP   ( ADDR --- )                                               CR BASE @ >R 8 BASE !                                           128 OVER + SWAP DO I (DUMP)                                     ?TERMINAL IF LEAVE ENDIF 8 +LOOP                                R> BASE ! ;                                                                                                                                                                                                                                                 ( UTILITIES                                        MCS 81FEB25 )                                                                : .OCT   0 <# # # # #> TYPE ;                                                                                                   : (DUMP)   ( ADDR ---  )                                            DUP 256 /MOD .OCT CHR : EMIT .OCT 2 SPACES                      8 OVER + SWAP DO I C@ .OCT 2 SPACES LOOP CR ;                                                                               : DUMP   ( ADDR --- )                                               BASE @ >R   8 BASE !   CR                                       CR [ SCR @ 4 - 16 * 15 + ] LITERAL MESSAGE CR CR                128 OVER + SWAP DO I (DUMP)                                     ?TERMINAL IF LEAVE ENDIF 8 +LOOP                                R> BASE ! ;                                                 ;S                                                              ADDRESS   0    1    2    3    4    5    6    7                  ( UTILITIES   THRU, SET                                        )                                                                : SET  ( ADDR --- )                                                 BASE @ >R   16 BASE !                                           BEGIN CR DUP 0 4 D.R 2 SPACES DUP C@ H.                         QUERY 32 WORD HERE 1+ C@                                        DUP CHR . = IF DROP 1                                           ELSE IF HERE NUMBER DROP OVER C! ENDIF 1+ 0 ENDIF               UNTIL DROP R> BASE ! ;                                                                                                      : THRU   1+ SWAP DO I LOAD LOOP ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               ( LOAD SCREEN FOR NEW FPLS )                                                                                                    0 OPEN #1 NFPS.BLK                                                                                                              0 OPEN #2 FPLS3.BLK                                             ;S                                                              129 LOAD                                                                                                                        146 LOAD                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        ( FPLS LOAD SCREEN )                                                                                                            50 LOAD                                        ( FPLS COMPILER )                                                                0 OPEN #1 FPLS.BLK   128 LOAD                ( THE SOURCE FILE )                                                                HEX                                                                                                                             LIMIT 700 0 SAVE FPLS.DAT                                                                                                       DECIMAL                                                                                                                                                                                                                                                                                                                                                                                         ( PAL LOAD SCREEN )                                                                                                             73 LIST                                  ( THE PALS VOCABULARY )                                                                0 OPEN #1 MORHD.BLK                    ( THE HDC PAL EQUATIONS )                                                                128 LOAD                                    ( COMPILE ALL PALS )                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                ( 8X300 CROSS ASSEMBLER  LOAD SCREEN               MCS 81MAR11 )                                                                LIMIT 1024 ERASE                           ( CLEAR TARGET AREA )                                                                119 124 THRU                            ( THE CP/M FILE READER )                                                                0 OPEN #1 8X300.BLK  130 LOAD            ( THE CROSS ASSEMBLER )                                                                0 OPEN #2 8X5.ASM       8XASM      #2 CROSS-ASSEMBLE  ( DOIT )                                                                                                                                                                                                                                                                  DECIMAL                                                                                                                                                                                         \       Software Difficulties with 8X300 Implementation         ;S                                                              ;S  THE TOP OF THIS SCREEN IS A LINE BUFFER                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     ( 8X300 CROSS ASSEMBLER )                                                                                                       DECIMAL                                                         119 CONSTANT BUF_SCR   58 CONSTANT MAXLINE                        0 VARIABLE SOR_BLK    0 VARIABLE SIN                            0 VARIABLE LN#                                                                                                                HEX                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             ( 8X300 CROSS ASSEMBLER )                                                                                                       : ASSEMBLE                                                          !CSP                                                          PAD 1+  BUF_SCR B/SCR * BLOCK  40  CMOVE ( XFER PAD TO BLOCK )  BUF_SCR LOAD   ?CSP  ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        ( 8X300 CROSS ASSEMBLER )                                                                                                       : PRINT PAD 1+ 40 TYPE ;                                                                                                        : NEWLINE  CR  1 LN# +!  LN# @ MAXLINE = IF                         0 LN# !  8 0 DO ( CR ) LOOP  ENDIF ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        ( 8X300 CROSS ASSEMBLER )                                                                                                       : XFER  ( C - )  ( ADD TO STRING AT PAD )                           PAD DUP C@ 1+ 2DUP SWAP C! + C! ;                                                                                           : GETLINE                                                         PAD DUP 50 BL FILL  0 SWAP C!  ( CLEAR PAD )                    BEGIN  SIN @ B/BUF = IF ( END OF BLOCK )                          1 SOR_BLK +!  0 SIN ! ENDIF ( NEXT BLOCK )                    SOR_BLK @ BLOCK SIN @ + 1 SIN +! C@ 7F AND                      DUP 20 < IF ( CTL )                                               DUP 0D = IF ( CR ) DROP 1 ELSE DUP 9 = IF ( TAB )               8 PAD C@ 8 MOD - 0 DO BL XFER LOOP DROP 0                       ELSE DROP 0 ENDIF ENDIF ELSE ( NOT CTL )                        XFER 0 ENDIF UNTIL ;                                                                                                        ( 8X300 CROSS ASSEMBLER )                                                                                                       : LINE   GETLINE PRINT ASSEMBLE NEWLINE ;                                                                                       : LINES   CR BEGIN SOR_BLK @ 0= ( END OF FILE )                     ?TERMINAL OR 0= WHILE LINE REPEAT ;                                                                                         : CROSS-ASSEMBLE  ( FILE - )   CR                                 @   SOR_BLK !  0 SIN !  LINES ;                                                                                               DECIMAL                                                                                                                                                                                                                                                                                                                                                                                         ( READLN                                           MCS 81MAR02 )                                                                : CMOVE ( CHR --- ) PAD DUP C@ 1+ 2DUP SWAP C! + C! ;                                                                           : DOTAB   8 PAD C@ 7 AND - 0 DO BL CMOVE LOOP ;                                                                                 : DOLINE PAD COUNT TYPE   CR   0 PAD C! ;                                                                                       : READLN   ( PTR ---  )   0 PAD C!   IN @ >R                        2@ DO      0 IN !                                               BEGIN   IN @ B/BUF - WHILE ( NOT END OF BUFFER )                  I BLOCK IN @ + C@ 127 AND DUP BL <                              IF ( CTL ) DUP 13 = IF DOLINE 0 PAD C!                            ELSE DUP 9 = IF DOTAB ENDIF ENDIF DROP                        ELSE ( CHR ) CMOVE ENDIF   1 IN +!  REPEAT                    LOOP R> IN ! ;                                              ( READLN                                           MCS 81MAR02 )                                                                INSTALL UNDEF XEC READLN                                                                                                        : RDLNS ( FID, BUF ---  )  DUP C/L BLANKS DUP 1+ ROT                2@ DO I BLOCK B/BUF OVER + SWAP DO                              I C@ 127 AND DUP BL < IF ( CTL ) DUP 13 =                       IF ( CR ) DROP 1 - OVER - OVER C! READLN                          DUP C/L BLANKS DUP 1+ ELSE DUP 9 =                            IF ( HT ) DROP 2DUP 1 - SWAP - 7 AND 8 - - ELSE DROP ENDIF      ENDIF ELSE OVER C! 1+ ENDIF LOOP ?TERMINAL IF LEAVE ENDIF       LOOP 1 - SWAP C! READLN  ;                                                                                                  : DOLINE   PAD COUNT TYPE CR ;                                                                                                  INSTALL DOLINE   AS READLN                                      ( XECWORD, INTERP                                  MCS 81MAR09 )                                                                : XECWORD                                                           HERE DUP C@ IF CONTEXT @ @ (FIND)                                 IF ( FOUND ) DROP EXECUTE ELSE 1 0 ?ERROR ENDIF               ELSE DROP ENDIF ;                                                                                                           : INTERP   ( ADDR, COUNT ---  )                                     0 HERE C!   OVER + SWAP DO                                      I C@ DUP BL =                                                   IF ( BLANK ) DROP XECWORD   0 HERE C!                           ELSE ( NOT ) HERE DUP C@ 1+ 2DUP SWAP C! + C!                   ENDIF LOOP XECWORD ;