   -->        ( UX - change user areas of files )
( This is a FORTH program - for 8080 fig-FORTH - that accesses )
( a CP/M disk directory block directly, for the purpose of     )
( transferring files from one user area to another.  No file   )
( copying is done; the program only changes the first byte of  )
( the relevant directory entry.  Currently, the program is set )
( up to expect the directory in FORTH disk blocks 12 to 15,    )
( and this will have to be changed to suit the user's disk     )
( configuration {see line 1 of MOVUSR, line 2 of BKWD and line )
( 2 of UX}.  Each file is presented in turn, and the user types)
( <cr> for no change, D to delete, or a user number 0 to 31 to )
( which the file is to be transferred.  Typing B results in no )
( change to the current file, but the display backs up to the  )
( previous entry instead of continuing on to the next one.  A  )
( <cr> must terminate each entry.  The program returns to CP/M )
( when the last file has been processed.                       )
( UX - change user areas of files )                             
CODE CP7   H POP   L A MOV   H POP   D POP   B PUSH             
   A C MOV   BEGIN   D LDAX   127 ANI   A B MOV                 
   M A MOV   127 ANI   B CMP   0= NOT IF   0 H LXI              
   B POP   NEXT 1 - JMP   ENDIF   D INX   H INX                 
   C DCR   0= UNTIL   B POP   1 H LXI   NEXT 1 - JMP   C;       
: MOVUSR   ( n addr --- )   HERE 12 CMOVE   16 12 DO            
   I BLOCK   DUP 1024 + SWAP DO   I HERE 12 CP7 IF              
   DUP I C!   UPDATE   ENDIF   32 +LOOP LOOP DROP   ;           
: BKWD   ( blk buf off --- blk buf off -1 )   BEGIN             
   32 -   DUP 0< IF   3 PICK 12 = IF   32 +   ELSE              
   1024 +   >R   DROP   1 -   DUP BLOCK   R>   ENDIF ENDIF      
   2DUP + 12 + C@   0= UNTIL   32 -   -1   ;                    
: DSP1   ( addr --- )   CR   DUP C@   DUP 229 = IF              
   DROP 100 EMIT   ELSE .   ENDIF   DUP 1+ 8 TYPE               
   46 EMIT   9 + 3 TYPE   ."  ? " QUERY BL WORD   ;   -->       
( UX - change user areas of files )                             
: UX   ( f --- )   1 BLOCK DROP   IF DR1 ELSE DR0 ENDIF         
   12 BEGIN   DUP 16 < WHILE                                    
     DUP BLOCK   0 BEGIN   DUP 1024 < WHILE                     
       2DUP + 12 + C@   0= IF                                   
         2DUP + DSP1   HERE 1+ C@ IF                            
           HERE 1+ C@   66 = IF   BKWD   ELSE                   
           HERE 1+ C@   68 = IF   229    ELSE                   
           HERE NUMBER DROP   ENDIF   ENDIF                     
           DUP 0<   OVER 31 >  OR 0=   OVER 229 =   OR IF       
             >R 2DUP + R> SWAP MOVUSR   ELSE   DROP             
             ENDIF                                              
           ENDIF                                                
         ENDIF                                                  
       32 +   REPEAT                                            
     DROP DROP   1+   REPEAT   FLUSH   BYE   ;           ;S     
                                              