/*SPLH*/ /*$TITLE='CP/M-68K 1.0--- ED'   */
ED:
DO;
    /* MODIFIED FOR .PRL OPERATION MAY, 1979 */
    /* MODIFIED FOR OPERATION WITH CP/M 2.0 AUGUST 1979 */
    /* MODIFIED FOR MP/M 2.0 JUNE 1981 */
    /* MODIFIED FOR CP/M 1.1 OCT  1981 */
    /* MODIFIED FOR CP/M-68K JULY 1982 BY H.CHAKI */
 /*  Command line to generate ED.68K
 [[ Assume all volume name is SYS:0.. ON EXORmacs]]
 (1)S-PL/H Compile and ASM on EXORmacs
    =SPLH EDL,,;A,S,X,NOV,NOF,MAR=1/80
    =SPLH EDS,,;A,S,X,NOV,NOF,MAR=1/80
    =ASM UT68K,,;
    [[ caution ]]
     EDL: main routine of ED utility in S-PL/H
     EDS: sub routine of ED utility in S-PL/H
     UT68K: standard interface routine in ASM
     A: assemble listing option
     S: symbol listing option
     X: xref listing option
     NOV: non save option
     NOF: non floatable option
     MAR: margin option [[ important ]]
 
  (2)LINK on EXORmacs
     =LINK EDL/EDS/UT68K,ED68K,ED68K;MIXRL=SPLHLIB.RO
     [[ caution ]]
     R option: generate relocatable object
 
  (3)XLINK on EXORmacs
     =XLINK ED68K.RO,ED68K.OX,O=ED68K.OL
 
  (4)Convert file on EXORmacs to send to VAX
     =CONV ED68K.OX,ED68K.OC
 
  (5)Send to VAX from EXORMACS
     =VAX
     VAX command
     S
     Source file
     ED68K.OC
 
  (6)Download to CP/M file from VAX
 
  (7)Re-convert file on CP/M
    A>RECONV
      input file :ED68K.OC
      output file :ED.68K
 
   end command line                 */
 
DECLARE
    MPMPRODUCT LITERALLY '01H', /* REQUIRES MP/M */
    CPM3       LITERALLY '30H'; /* REQUIRES 3.0 CP/M */
 
DECLARE PLM LABEL PUBLIC;  /* ENTRY POINT FOR PLM86 INTERFACE */
 
  /**************************************
   *                                    *
   *       B D O S   INTERFACE          *
   *                                    *
   **************************************/
 
 
  MON5: PROC(FN,IN) EXT;
         DCL FN BYTE;
         DCL IN POINTER;
  END;
 
 
 
 /*SPLH */ DCL DCHAKIP POINTER ;  /* END ADDR OF MEMORY ARRAY */
           DCL DCHAKIL LONG AT(@DCHAKIP);
 /*SPLH */ DCL MEMORY(100) BYTE EXT;
/* DECLARE CMDRV     BYTE    EXTERNAL;   /* COMMAND DRIVE      */
  DECLARE FCB (100) BYTE    EXTERNAL;   /* 1ST DEFAULT FCB    */
  DECLARE FCB16 (100) BYTE    EXTERNAL;   /* 2ND DEFAULT FCB    */
/* DECLARE PASS0     ADDRESS EXTERNAL;   /* 1ST PASSWORD PTR   */
/* DECLARE LEN0      BYTE    EXTERNAL;   /* 1ST PASSWD LENGTH  */
/* DECLARE PASS1     ADDRESS EXTERNAL;   /* 2ND PASSWORD PTR   */
/* DECLARE LEN1      BYTE    EXTERNAL;   /* 2ND PASSWD LENGTH  */
  DECLARE TBUFF (100) BYTE    EXTERNAL;   /* DEFAULT DMA BUFFER */
 
 
DECLARE
/*  BDISK     BYTE    EXTERNAL, /* BOOT DISK 0004H */
    MAXB      POINTER EXTERNAL, /* MAX BASE 0006H */
/*68K*/ MAXBL LONG AT(@MAXB),
    BUFF (128)BYTE    EXTERNAL, /* BUFFER 0080H */
    SECTSHF   LITERALLY '7',    /* SHL(1,SECTSHF) = SECTSIZE */
    SECTSIZE  LITERALLY '80H';  /* SECTOR SIZE */
 
BOOT: PROCEDURE  EXT;
    /* SYSTEM REBOOT */
    END BOOT;
/*SPLH*/ /*$EJECT   */
 
  /*  E D  :   T H E   C P / M   C O N T E X T    E D I T O R  */
 
    /*      COPYRIGHT (C) 1976, 1977, 1978, 1979, 1980, 1981
            DIGITAL RESEARCH
            BOX 579 PACIFIC GROVE
            CALIFORNIA 93950
 
            REVISED:
              07 APRIL 81  BY THOMAS ROLANDER
              21 JULY  81  BY DOUG HUSKEY
              29 OCT   81  BY DOUG HUSKEY
              10 NOV   81  BY DOUG HUSKEY
              31 JULY  82  BY H.CHAKI
    */
DECLARE COPYRIGHT(*) BYTE DATA
   (' COPYRIGHT (C) 1982, DIGITAL RESEARCH ');
 
DECLARE DATE(*) BYTE DATA ('12/81');
 
 /* COMMAND           FUNCTION
    -------           --------
     A            APPEND LINES OF TEXT TO BUFFER
     B            MOVE TO BEGINNING OR END OF TEXT
     C            SKIP CHARACTERS
     D            DELETE CHARACTERS
     E            END OF EDIT
     F            FIND STRING IN CURRENT BUFFER
     H            MOVE TO TOP OF FILE (HEAD)
     I            INSERT   CHARACTERS FROM KEYBOARD
                  UP TO NEXT <ENDFILE>
     J            JUXTAPOSITION OPERATION - SEARCH FOR FIRST STRING,
                  INSERT SECOND STRING, DELETE UNTIL THIRD STRING
     K            DELETE LINES
     L            SKIP LINES
     M            MACRO DEFINITION (SEE COMMENT BELOW)
     N            FIND NEXT OCCURRENCE OF STRING
                  WITH AUTO SCAN THROUGH FILE
     O            RE-EDIT OLD FILE
     P            PAGE AND DISPLAY (MOVES UP OR DOWN 24 LINES AND
                  DISPLAYS 24 LINES)
     Q            QUIT EDIT WITHOUT UPDATING THE FILE
     R<FILENAME>  READ FROM FILE <FILENAME> UNTIL <ENDFILE> AND
                  INSERT INTO TEXT
     S            SEARCH FOR FIRST STRING, REPLACE BY SECOND STRING
     T            TYPE LINES
     U            TRANSLATE TO UPPER CASE (-U CHANGES TO NO TRANSLATE)
     W            WRITE LINES OF TEXT TO FILE
     X<FILENAME>  TRANSFER (XFER) LINES TO FILE <FILENAME> 
     Z            SLEEP FOR 1/2 SECOND (USED IN MACROS TO STOP DISPLAY)
     <CR>         MOVE UP OR DOWN AND PRINT ONE LINE
 
 
    IN GENERAL, THE EDITOR ACCEPTS SINGLE LETTER COMMANDS WITH OPTIONAL
INTEGER VALUES PRECEDING THE COMMAND.  THE EDITOR ACCEPTS BOTH UPPER AND LOWER
CASE COMMANDS AND VALUES, AND PERFORMS TRANSLATION TO UPPER CASE UNDER THE FOL-
LOWING CONDITIONS.  IF THE COMMAND IS TYPED IN UPPER CASE, THEN THE DATA WHICH
FOLLOWS IS TRANSLATED TO UPPER CASE.  THUS, IF THE "I" COMMAND IS TYPED IN
UPPER CASE, THEN ALL INPUT IS AUTOMATICALLY TRANSLATED (ALTHOUGH ECHOED IN
LOWER CASE, AS TYPED).  IF THE "A" COMMAND IS TYPED IN UPPER CASE, THEN ALL
INPUT IS TRANSLATED AS READ FROM THE DISK.  GLOBAL TRANSLATION TO UPPER CASE
CAN BE CONTROLLED BY THE "U" COMMAND (-U TO NEGATE ITS EFFECT).  IF YOU ARE
OPERATING WITH AN UPPER CASE ONLY TERMINAL, THEN OPERATION IS AUTOMATIC.
SIMILARLY, IF YOU ARE OPERATING WITH A LOWER CASE TERMINAL, AND TRANSLATION
TO UPPER CASE IS NOT SPECIFIED, THEN LOWER CASE CHARACTERS CAN BE ENTERED.
 
     A NUMBER OF COMMANDS CAN BE PRECEDED BY A POSITIVE OR
     NEGATIVE INTEGER BETWEEN 0 AND 65535 (1 IS DEFAULT IF NO VALUE
     IS SPECIFIED).  THIS VALUE DETERMINES THE NUMBER OF TIMES THE
     COMMAND IS APPLIED BEFORE RETURNING FOR ANOTHER COMMAND.
         THE COMMANDS
                       C D K L T P U  <CR>
     CAN BE PRECEDED BY AN UNSIGNED, POSITIVE, OR NEGATIVE NUMBER,
     THE COMMANDS
                       A F J N W Z
     CAN BE PRECEDED BY AN UNSIGNED OR POSITIVE NUMBER,
     THE COMMANDS
                       E H O Q
     CANNOT BE PRECEDED BY A NUMBER.  THE COMMANDS
                       F I J M R S
     ARE ALL FOLLOWED BY ONE OR MORE STRINGS OF CHARACTERS WHICH CAN
     BE OPTIONALLY SEPARATED OR TERMINATED BY EITHER <ENDFILE> OR <CR>.
     THE <ENDFILE> IS GENERALLY USED TO SEPARATE THE SEARCH STRINGS
     IN THE S AND J COMMANDS, AND IS USED AT THE END OF THE COMMANDS IF
     ADDITIONAL COMMANDS FOLLOW.  FOR EXAMPLE, THE FOLLOWING COMMAND
     SEQUENCE SEARCHES FOR  THE STRING 'GAMMA', SUBSTITUTES THE STRING
     'DELTA', AND THEN TYPES THE FIRST PART OF THE LINE WHERE THE
     CHANGE OCCURRED, FOLLOWED BY THE REMAINDER OF THE LINE WHICH WAS
     CHANGED:
                 SGAMMA<ENDFILE>DELTA<ENDFILE>0TT<CR>
 
     THE CONTROL-L CHARACTER IN SEARCH AND SUBSTITUTE STRINGS IS
     REPLACED ON INPUT BY <CR><LF> CHARACTERS.  THE CONTROL-I KEY
     IS TAKEN AS A TAB CHARACTER.
 
        THE COMMANDS R & X MUST BE FOLLOWED BY A FILE NAME (WITH DEFAULT 
     FILE TYPE OF 'LIB') WITH A TRAILING <CR> OR <ENDFILE>.  THE COMMAND
     I IS FOLLOWED BY A STRING OF SYMBOLS TO INSERT, TERMINATED BY
     A <CR> OR <ENDFILE>.  IF SEVERAL LINES OF TEXT ARE TO BE INSERTED,
     THE I CAN BE DIRECTLY FOLLOWED BY AN <ENDFILE> OR <CR> IN WHICH
     CASE THE EDITOR ACCEPTS LINES OF INPUT TO THE NEXT <ENDFILE>.
     THE COMMAND 0T PRINTS THE FIRST PART OF THE CURRENT LINE,
     AND THE COMMAND 0L MOVES THE REFERENCE TO THE BEGINNING OF THE
     CURRENT LINE.  THE COMMAND 0P PRINTS THE CURRENT PAGE ONLY, WHILE
     THE COMMAND 0Z READS THE CONSOLE RATHER THAN WAITING (THIS IS USED
     AGAIN WITHIN MACROS TO STOP THE DISPLAY - THE MACRO EXPANSION
     STOPS UNTIL A CHARACTER IS READ.  IF THE CHARACTER IS NOT A BREAK
     THEN THE MACRO EXPANSION CONTINUES NORMALLY).
 
        NOTE THAT A POUND SIGN IS TAKEN AS THE NUMBER 65535, ALL
     UNSIGNED NUMBERS ARE ASSUMED POSITIVE, AND A SINGLE - IS ASSUMED -1
 
     A NUMBER OF COMMANDS CAN BE GROUPED TOGETHER AND EXECUTED
     REPETITIVELY USING THE MACRO COMMAND WHICH TAKES THE FORM
 
             <NUMBER>MC1C2...CN<DELIMITER>
 
     WHERE <NUMBER> IS A NON-NEGATIVE INTEGER N, AND <DELIMITER> IS
     <ENDFILE> OR <CR>.  THE COMMANDS C1 ... CN  FOLLOWING THE M ARE
     EXECUTED N TIMES, STARTING AT THE CURRENT POSITION IN THE BUFFER.
     IF N IS 0, 1, OR OMITTED, THE COMMANDS ARE EXECUTED UNTIL THE END
     IF THE BUFFER IS ENCOUNTERED.
 
     THE FOLLOWING MACRO, FOR EXAMPLE, CHANGES ALL OCCURRENCES OF
     THE NAME 'GAMMA' TO 'DELTA', AND PRINTS THE LINES WHICH
     WERE CHANGED:
 
                 MFGAMMA<ENDFILE>-5DIDELTA<ENDFILE>0LT<CR>
 
    (NOTE: AN <ENDFILE> IS THE CP/M END OF FILE MARK - CONTROL-Z)
 
    IF ANY KEY IS DEPRESSED DURING TYPING OR MACRO EXPANSION, THE
    FUNCTION IS CONSIDERED TERMINATED, AND CONTROL RETURNS TO THE
    OPERATOR.
 
    ERROR CONDITIONS ARE INDICATED BY PRINTING ONE OF THE CHARACTERS:
 
     SYMBOL                    ERROR CONDITION
     ------      ----------------------------------------------------
     GREATER     FREE MEMORY IS EXHAUSTED - ANY COMMAND CAN BE ISSUED
                 WHICH DOES NOT INCREASE MEMORY REQUIREMENTS.
     QUESTION    UNRECOGNIZED COMMAND OR ILLEGAL NUMERIC FIELD
     POUND       CANNOT APPLY THE COMMAND THE NUMBER OF TIMES SPECFIED
                 (OCCURS IF SEARCH STRING CANNOT BE FOUND)
     LETTER O    CANNOT OPEN <FILENAME>.LIB IN R COMMAND
 
     THE ERROR CHARACTER IS ALSO ACCOMPANIED BY THE LAST CHARACTER
     SCANNED WHEN THE ERROR OCCURRED.                      */
 
/*SPLH*/ /*$EJECT    */
 
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 
 
                  * * *  GLOBAL VARIABLES * * *
 
 
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
 
/* 68K */ DCL CHAKI(6) BYTE INIT(1,2,3,4,5,6); /*CHECK INIT FOR LINKER*/
 
/* SPLH*/    DECLARE /* LIT LITERALLY 'LITERALLY',
    DCL LIT 'DECLARE',
    PROC LIT 'PROCEDURE',
    ADDR LIT 'ADDRESS',      */
    CTLL LIT '0CH',
    CTLR LIT '12H',                /* REPEAT LINE IN INSERT MODE */
    CTLU LIT '15H',                /* LINE DELETE IN INSERT MODE */
    CTLX LIT '18H',                /* EQUIVALENT TO CTLU */
    CTLH LIT '08H',                /* BACKSPACE */
    TAB LIT '09H',                 /* TAB CHARACTER */
    LCA  LIT '110$0001B',          /* LOWER CASE A */
    LCZ  LIT '111$1010B',          /* LOWER CASE Z */
    ESC  LIT '1BH',                /* ESCAPE CHARACTER */
    ENDFILE LIT '1AH';             /* CP/M END OF FILE */
 
DECLARE
    TRUE LITERALLY '1', 
    FALSE LITERALLY '0',
    FOREVER LITERALLY 'WHILE TRUE',
    CTRL$C LITERALLY '3',
    CR LITERALLY '13',
    LF LITERALLY '10',
    WHAT LITERALLY '63';
 
DECLARE
    MAX POINTER,MAXL LONG AT(@MAX),/* .MEMORY(MAX)=0 (END) */
    MAXM POINTER,MAXML LONG AT(@MAXM),/* MINUS 1 */
    HMAX POINTER,HMAXL LONG AT(@HMAX);/* = MAX/2 */
 
DECLARE
    I  BYTE,                       /* USED BY COMMAND PARSING */
    ICHAKI BYTE;             /* BOUNDARY CONTROL FOR 68K*/
 
DECLARE
    US LITERALLY '8',              /* FILE FROM USER 0   */
    RO LITERALLY '9',              /* R/O FILE INDICATOR */
    SY LITERALLY '10',             /* SYSTEM FILE ATTRIBUTE */
    EX LITERALLY '12',             /* EXTENT NUMBER POSITION */
    UB LITERALLY '13',             /* UNFILLED BYTES */
    CK LITERALLY '13',             /* CHECKSUM */
    MD LITERALLY '14',             /* MODULE NUMBER POSITION */
    NR LITERALLY '32',             /* NEXT RECORD FIELD */
    FS LITERALLY '33',             /* FCB SIZE */
    RFCB (FS) BYTE                 /* READER FILE CONTROL BLOCK */
        INITIAL(0, /* FILE NAME */ '        ',
                   /* FILE TYPE */ 'LIB',0,0,0),
    RBP BYTE,                      /* READ BUFFER POINTER */
    XFCB (FS) BYTE                 /* XFER FILE CONTROL BLOCK */
        INITIAL(0, 'X$$$$$$$','LIB',0,0,0,0,0,0,0),
    XFCBE BYTE AT(@XFCB(EX)),      /* XFCB EXTENT */
    XFCBM BYTE AT(@XFCB(MD)),      /* MODULE NUMBER */
    XFCBR BYTE AT(@XFCB(NR)),      /* XFCB RECORD # */
    XFCBC BYTE AT(@XFCB(CK)),      /* XFCB CHECK SUM # */
    XFCBEXT BYTE INITIAL(0),       /* SAVE XFCB EXTENT FOR APPENDS */
    XFCBREC BYTE INITIAL(0),       /* SAVE XFCB RECORD FOR APPENDS */
    XBUFF (SECTSIZE) BYTE,         /* XFER BUFFER */
    XBP BYTE,                      /* XFER POINTER */
    XFERON BYTE PUBLIC INIT(FALSE),   /* TRUE IF XFER ACTIVE */
    READING BYTE INITIAL (FALSE),  /* TRUE IF READING RFCB */
 
    NBUF BYTE,                     /* NUMBER OF BUFFERS */
    BUFFLENGTH POINTER,            /* NBUF * SECTSIZE */
/*68K*/ BUFFLENGTHL LONG AT(@BUFFLENGTH),
    SFCB (FS) BYTE AT(@FCB),       /* SOURCE FCB = DEFAULT FCB */
    SDISK BYTE AT (@FCB),          /* SOURCE DISK */
    SBUFFADR POINTER,              /* SOURCE BUFFER ADDRESS */
/*68K*/ SBUFFADRL LONG AT(@SBUFFADR),
    SBUFF BASED SBUFFADR (128) BYTE, /* SOURCE BUFFER */
    PASSWORD (16) BYTE PUBLIC INIT(0), /* SOURCE PASSWORD */
 
    DFCB (FS) BYTE,                /* DEST FILE CONTROL BLOCK */
    DDISK BYTE AT (@DFCB),         /* DESTINATION DISK */
    DFUB BYTE AT(@DFCB(UB)),       /* UNFILLED BYTES IN LAST RECORD */
    DBUFFADR POINTER,              /* DESTINATION BUFFER ADDRESS */
/*68K*/ DBUFFADRL LONG AT(@DBUFFADR),
    DBUFF BASED DBUFFADR (128) BYTE, /* DEST BUFFER */
    NSOURCE POINTER,               /* NEXT SOURCE CHARACTER */
/*68K*/ NSOURCEL LONG AT(@NSOURCE),
    NDEST   POINTER,               /* NEXT DESTINATION CHAR */
/*68K*/ NDESTL LONG AT(@NDEST);
 
DECLARE
    NEWFILE BYTE INITIAL (FALSE),   /* NO SOURCE FILE */
    ONEFILE BYTE INITIAL (TRUE),    /* OUTPUT FILE = INPUT FILE */
    DTYPE  (3)  BYTE,                /* DESTINATION FILE TYPE */
/* 68K */ /* INIT-> DATA FOR LINK BUG */
    LIBFCB (12) BYTE PUBLIC DATA(0,'X$$$$$$$LIB'),/* DEFAULT LIB NAME */
    TEMPFL (3)  BYTE DATA('$$$'), /* TEMPORARY FILE TYPE */
    BACKUP (3)  BYTE DATA('BAK'); /* BACKUP FILE TYPE */
 
 
DECLARE
   PRINTSUPPR BYTE PUBLIC INIT(FALSE), /* TRUE IF PRINT SUPPRESSED */
   SYS BYTE INITIAL(0),        /* TRUE IF SYSTEM FILE */
   PROTECTION BYTE INITIAL(0); /* PASSWORD PROTECTION MODE */
 
DECLARE
   ERROR$CODE ADDRESS;
 
 
DECLARE
    COLUMN  BYTE PUBLIC,      /* CONSOLE COLUMN POSITION */
    SCOLUMN BYTE INITIAL(8),  /* STARTING COLUMN IN "I" MODE */
    TCOLUMN BYTE,             /* TEMP DURING BACKSPACE */
    QCOLUMN BYTE;             /* TEMP DURING BACKSPACE */
 
DECLARE DCNT BYTE PUBLIC;
 
 
 
/* COMMAND BUFFER */
 
DECLARE (MAXLEN,COMLEN) BYTE PUBLIC, COMBUFF(128) BYTE PUBLIC,
    (TCBP,CBP) BYTE PUBLIC;
 
/* MP/M PARSE FUNCTION CALL */
  DECLARE
    PARSE$FN STRUCTURE (
      BUFF$ADR  POINTER,
      FCB$ADR   POINTER);
 
DECLARE /* LINE COUNTERS */
    BASELINE LONG   ,        /* CURRENT LINE */
    RELLINE  LONG   ,        /* RELATIVE LINE IN TYPEOUT */
    LINESET  BYTE INITIAL (TRUE);/* TRUE IF LINE #'S PRINTED */
 
DECLARE
    LPP LIT '23',            /* LINES PER PAGE */
    FORWARD LIT '1',
    BACKWARD LIT '0',
    RUBOUT LIT '07FH',
    POUND LIT '23H',
    MACSIZE LIT '128',       /* MAX MACRO SIZE */
    SCRSIZE LIT '100',       /* SCRATCH BUFFER SIZE */
    COMSIZE LIT 'ADDRESS';   /* DETERMINES MAX COMMAND NUMBER*/
 
DCL MACRO(MACSIZE) BYTE,
    SCRATCH(SCRSIZE) BYTE,     /* SCRATCH BUFFER FOR F,N,S */
    (WBP, WBE, WBJ)  BYTE,     /* END OF F STRING, S STRING, J STRING */
    FLAG BYTE PUBLIC,(MP, MI, XP) BYTE,
    MT LONG   ;
 
DCL (START, RESTART, OVERCOUNT, OVERFLOW,
     DISK$FULL$ERR, DIR$FULL$ERR,/*RESET,*/ BADCOM) LABEL;
/*SPLH*/ DCL RESET LABEL PUBLIC;
DCL INSERTING BYTE,          /* TRUE IF INSERTING CHARACTERS */
    READBUFF  BYTE;          /* TRUE IF END OF READ BUFFER */
 
/* GLOBAL VARIABLES USED BY FILE PARSING ROUTINES */
DCL NCMD BYTE INITIAL(0),
    COMMAND$TAIL BYTE INITIAL(0FFH);
   
 
DECLARE
    EOS LITERALLY '0FFH';
 
 
DCL (DISTANCE, TDIST) LONG   ,
    (DIRECTION, CHAR) BYTE,
    ( FRONT, BACK, FIRST, LASTC) LONG;
 
 
DECLARE
    TRANSLATE BYTE INITIAL (FALSE),/* TRUE IF TRANSLATION TO UPPER CASE */
    UPPER BYTE INITIAL (FALSE);    /* TRUE IF GLOBALLY TRANLATING TO UC */
 
 
DECLARE VER ADDRESS;            /* VERSION NUMBER */
 
DECLARE
    ERR$MSG         POINTER INITIAL(0),
    INVALID (17)    BYTE DATA ('INVALID FILENAME$'),
    DIRFULL (15)    BYTE DATA ('DIRECTORY FULL$'),
    DISKFULL (10)   BYTE DATA ('DISK FULL$');
 
/*68K*/ DCL DUMMYP POINTER,
            DUMMYL LONG AT(@DUMMYP);
        DCL DUMMYB BYTE;
/*SPLH*/  /*$EJECT     */
 
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 
 
               * * *  CP/M INTERFACE ROUTINES * * *
 
 
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
 
 
 /* IO SECTION */
 
READCHAR: PROCEDURE BYTE EXT;
    END READCHAR;
 
  CONIN: 
    PROCEDURE BYTE EXT;
    END CONIN;
 
PRINTCHAR: PROCEDURE(CHAR) EXT;
    DECLARE CHAR BYTE;
    END PRINTCHAR;
 
TTYCHAR: PROCEDURE(CHAR) EXT;
    DECLARE CHAR BYTE;
    END TTYCHAR;
 
BACKSPACE: PROCEDURE EXT;
    /* MOVE BACK ONE POSITION */
    END BACKSPACE;
 
PRINTABS: PROCEDURE(CHAR) EXT;
    DECLARE CHAR BYTE;
    END PRINTABS;
 
GRAPHIC: PROCEDURE(C) BYTE EXT;
    DECLARE C BYTE;
    /* RETURN TRUE IF GRAPHIC CHARACTER */
    END GRAPHIC;
 
PRINTC: PROCEDURE(C) EXT;
    DECLARE C BYTE;
    END PRINTC;
 
CRLF: PROCEDURE EXT;
    END CRLF;
 
PRINTM: PROCEDURE(A) EXT;
    DECLARE A POINTER;
    END PRINTM;
 
PRINT: PROCEDURE(A) EXT;
    DECLARE A POINTER;
    END PRINT;
 
READ: PROCEDURE(A) EXT;
    DECLARE A POINTER;
    END READ;
 
        /* USED FOR LIBRARY FILES */
OPEN: PROCEDURE(FCB) EXT;
     DECLARE FCB POINTER;
     END OPEN;
 
        /* USED FOR MAIN SOURCE FILE */
OPEN$FILE: PROCEDURE(FCB) ADDRESS EXT;
     DECLARE FCB POINTER;
     END OPEN$FILE;
 
CLOSE: PROCEDURE(FCB) EXT;
    DECLARE FCB POINTER;
    END CLOSE;
 
SEARCH: PROCEDURE(FCB) EXT;
    DECLARE FCB POINTER;
    END SEARCH;
 
DELETE: PROCEDURE(FCB) EXT;
    DECLARE FCB POINTER;
    END DELETE;
 
DISKREAD: PROCEDURE(FCB) BYTE EXT;
    DECLARE FCB POINTER;
    END DISKREAD;
 
DISKWRITE: PROCEDURE(FCB) BYTE EXT;
    DECLARE FCB POINTER;
    END DISKWRITE;
 
MAKE: PROCEDURE(FCB) EXT;
    DECLARE FCB POINTER;
    END MAKE;
 
RENAME: PROCEDURE(FCB) EXT;
    DECLARE FCB POINTER;
    END RENAME;
 
READCOM: PROCEDURE EXT;
    END READCOM;
 
BREAK$KEY: PROCEDURE BYTE EXT;
    END BREAK$KEY;
 
CSELECT: PROCEDURE BYTE EXT;
    /* RETURN CURRENT DRIVE NUMBER */
    END CSELECT;
 
SELECT: PROCEDURE(DISK) EXT;
    DECLARE DISK BYTE;
    /* SET DRIVE NUMBER */
    END SELECT;
 
SETDMA: PROCEDURE(A) EXT;
    DECLARE A POINTER;
    /* SET DMA ADDRESS */
    END SETDMA;
 
SET$ATTRIBU: PROCEDURE(FCB) EXT;
    DECLARE FCB POINTER;
    END SET$ATTRIBU;
 
                  /* THIS ROUTINE IS INCLUDED SOLELY FOR 
                     ENCONOMY OF SPACE OVER THE USE OF THE
                     EQUIVALENT (IN-LINE) CODE GENERATED BY
                     THE BUILT-IN FUNCTION */
MOVE:   PROC(C,S,D) EXT;
    DCL (S,D) POINTER,C BYTE;
    END MOVE;
 
WRITE$XFCB: PROCEDURE(FCB) EXT;
    DECLARE FCB POINTER;
    END WRITE$XFCB;
 
READ$XFCB: PROCEDURE(FCB) EXT;
    DECLARE FCB POINTER;
    END READ$XFCB;
 
  /* 0FF => RETURN BDOS ERRORS */
  RETURN$ERRO:
    PROCEDURE(MODE) EXT;
    DECLARE MODE BYTE;
    END RETURN$ERRO;
 
REBOOT: PROCEDURE EXT;
    END REBOOT;
 
  VERSION: PROCEDURE ADDRESS EXT;
    /* RETURNS CURRENT CP/M VERSION # */
    END VERSION;
 
PARSE: PROCEDURE EXT;
    END PARSE;
 
 
/*SPLH*/  /*$EJECT   */
 
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 
 
                  * * *  SUBROUTINES  * * *
 
 
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
 
 
  /*  INPUT / OUTPUT BUFFERING ROUTINES */
 
 
 
                  /* ABORT ED AND PRINT ERROR MESSAGE */
ABORT: PROCEDURE(A);
    DECLARE A POINTER;
    CALL PRINT(A);
    CALL CRLF;
    CALL REBOOT;
    END ABORT;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* FATAL FILE ERROR */
FERR: PROCEDURE;
    CALL CLOSE(@DFCB); /* ATTEMPT TO CLOSE FILE FOR LATER RECOVERY */
    CALL ABORT (@DIRFULL);
    END FERR;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* SET PASSWORD IF CPM 3*/
SETPASSWORD: PROCEDURE;
    IF LOW(VER) = CPM3 THEN
        CALL SETDMA(@PASSWORD);
    END SETPASSWORD;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* DELETE FILE AT AFCB */
DELETE$FILE: PROCEDURE(AFCB);
    DECLARE AFCB POINTER;
    CALL SETPASSWORD;
    CALL DELETE(AFCB);
    END DELETE$FILE;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* RENAME FILE AT AFCB */
RENAME$FILE: PROCEDURE(AFCB);
    DECLARE AFCB POINTER;
/*68K*/ DUMMYP=AFCB;DUMMYL=DUMMYL+16;
    CALL DELETE$FILE(DUMMYP);     /* DELETE NEW FILE */
    CALL SETPASSWORD;
    CALL RENAME(AFCB);
    END RENAME$FILE;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* MAKE FILE AT AFCB */
MAKE$FILE: PROCEDURE(AFCB);
    DECLARE AFCB POINTER;
    CALL DELETE$FILE(AFCB);     /* DELETE FILE */
    CALL SETPASSWORD;
    CALL MAKE(AFCB);
    END MAKE$FILE;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* FILL STRING @ S FOR C BYTES WITH F */
FILL:   PROC(S,F,C);
    DCL S POINTER,
        (F,C) BYTE,
        A BASED S BYTE;
        DO WHILE (C:=C-1)<>255;
        A = F;
/*68K*/ DUMMYP=S;DUMMYL=DUMMYL+1;S=DUMMYP;
        END;
    END FILL;
 
 
 
 
/*SPLH*/ /*$EJECT      */
 
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 
 
                * * *  FILE HANDLING ROUTINES  * * *
 
 
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
 
 
 
                  /* SET DESTINATION FILE TYPE TO TYPE AT A */
SETTYPE: PROCEDURE(AFCB,A);
    DECLARE (AFCB, A) POINTER;
/*68K*/ DUMMYP=AFCB;DUMMYL=DUMMYL+9;
    CALL MOVE(3,A,DUMMYP);
    END SETTYPE;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* SET DMA TO XFER BUFFER */
SETXDMA: PROCEDURE;
    CALL SETDMA(@XBUFF);
    END SETXDMA;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* FILL PRIMARY SOURCE BUFFER  */
FILLSOURCE: PROCEDURE;
    DECLARE I BYTE;
    ZN: PROCEDURE;
        NSOURCE = 0;
        END ZN;
 
     CALL ZN;
        DO I = 0 TO NBUF;
/*68K*/ DUMMYL=SBUFFADRL+NSOURCEL;
        CALL SETDMA(DUMMYP);
        IF (DCNT := DISKREAD(@FCB)) <> 0 THEN
            DO; IF DCNT > 1 THEN CALL FERR;
            SBUFF(NSOURCEL) = ENDFILE;
            I = NBUF;
            END;
        ELSE
            NSOURCEL= NSOURCEL+ SECTSIZE;
        END;
    CALL ZN;
    END FILLSOURCE;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* GET NEXT CHARACTER IN SOURCE FILE */
GETSOURCE: PROCEDURE BYTE;
    DECLARE B BYTE;
    IF NSOURCEL>= BUFFLENGTHL THEN CALL FILLSOURCE;
    IF (B := SBUFF(NSOURCEL)) <> ENDFILE THEN
        NSOURCEL= NSOURCEL+ 1;
    RETURN B;
    END GETSOURCE;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* TRY TO FREE SPACE BY ERASING BACKUP */
ERASE$BAK: PROCEDURE BYTE;
    DECLARE B BYTE;
    IF ONEFILE THEN 
        IF NEWFILE THEN DO;
            CALL SETTYPE(@DFCB,@BACKUP);
            CALL DELETE$FILE(@DFCB);
            CALL SETTYPE(@DFCB,@TEMPFL);
            IF DCNT <> 255 THEN
                RETURN TRUE;
            END;
    RETURN FALSE;
    END ERASE$BAK;
 
 
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* WRITE OUTPUT BUFFER UP TO (NOT INCLUDING)
                     NDEST  (LOW 7 BITS OF NDEST ARE 0  */
WRITEDEST: PROCEDURE;
    DECLARE (I,N) BYTE;
    ZN: PROCEDURE;
        NDEST = 0;
        END ZN;
/*68K*/ N=NDESTL/128-1;
    IF  N=   255 THEN RETURN;
    CALL ZN;
        DO I = 0 TO N;
RETRY:
/*68K*/ DUMMYL=DBUFFADRL+NDESTL;
        CALL SETDMA(DUMMYP);
        IF DISKWRITE(@DFCB) <> 0 THEN
            IF ERASE$BAK THEN
                GO TO RETRY;
            ELSE DO;
                CALL CLOSE(@DFCB);
                GO TO DISK$FULL$ERR;
                END;
        NDESTL= NDESTL+ SECTSIZE;
        END;
    CALL ZN;
    END WRITEDEST;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* PUT A CHARACTER IN OUTPUT BUFFER */
PUTDEST: PROCEDURE(B);
    DECLARE B BYTE;
    IF NDESTL>= BUFFLENGTHL THEN CALL WRITEDEST;
    DBUFF(NDESTL) = B;
    NDESTL= NDESTL+ 1;
    END PUTDEST;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* PUT A CHARACTER IN THE XFER BUFFER */
PUTXFER: PROCEDURE(C);
    DECLARE C BYTE;
    IF XBP >= SECTSIZE THEN /* BUFFER OVERFLOW */
        DO; 
RETRY:
        CALL SETXDMA;
        XFCBEXT = XFCBE;               /* SAVE FOR APPENDS */
        XFCBREC = XFCBR; 
        IF DISKWRITE(@XFCB) <> 0 THEN
            IF ERASE$BAK THEN
                GO TO RETRY;
            ELSE DO;
                CALL CLOSE(@XFCB);
                GO TO DISK$FULL$ERR;
                END;
        XBP = 0;
        END;
    XBUFF(XBP) = C; XBP = XBP + 1;
    END PUTXFER;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* EMPTY XFER BUFFER AND CLOSE FILE.
                     THIS ROUTINE IS ADDED TO ALLOW SAVING LIB
                     FILES FOR FUTURE EDITS - DH 10/18/81 */
CLOSE$XFER: PROCEDURE;
    DCL I BYTE;
 
        DO I = XBP TO SECTSIZE;
        CALL PUTXFER(ENDFILE);
        END;
    CALL CLOSE(@XFCB);
    END CLOSE$XFER;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* COMPARE XFCB AND RFCB TO SEE IF SAME */
COMPARE$XFER: PROCEDURE BYTE;
    DCL I BYTE;
 
    I = 12;
        DO WHILE (I:=I-1) <> -1;
        IF XFCB(I) <> RFCB(I) THEN
            RETURN FALSE;
        END;
    RETURN TRUE;
    END COMPARE$XFER;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* RESTORE XFER FILE EXTENT AND CURRENT 
                     RECORD, READ RECORD AND SET XFER POINTER
                     TO FIRST ENDFILE */
APPEND$XFER: PROCEDURE;
 
    XFCBE = XFCBEXT;
    CALL OPEN(@XFCB);
    XFCBR = XFCBREC;
    CALL SETXDMA;
    IF DISKREAD(@XFCB) = 0 THEN DO;
        XFCBR = XFCBREC;                /* WRITE SAME RECORD */
            DO XBP = 0 TO SECTSIZE;
            IF XBUFF(XBP) = ENDFILE THEN
                RETURN;
            END;
        END; 
    END APPEND$XFER;
/*SPLH*/ /*$EJECT    */
 
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 
 
                  * * *  END EDIT ROUTINE * * *
 
 
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
 
 
 
                  /* FINISH EDIT, CLOSE FILES, RENAME */
FINIS: PROCEDURE;
    MOVEUP: PROCEDURE(AFCB);
    DCL AFCB POINTER;
    /* SET SECOND FILENAME (NEW NAME) FOR RENAME FUNCTION */
/*68K*/ DUMMYP=AFCB;DUMMYL=DUMMYL+16;
    CALL MOVE(16,AFCB,DUMMYP);
    END MOVEUP;
 
    /* * * * * * * *  WRITE OUTPUT BUFFER  * * * * * * * * */
 
    /* SET UNFILLED BYTES - USED FOR ISIS-II COMPATIBILITY */
    /*  DFUB = 0 ; <<<< REMOVE FOR MP/M 2 , CP/M 3 */
/*68K*/ DUMMYB=NDESTL;
        DO WHILE (DUMMYB AND 7FH) <> 0;
        /* COUNTS UNFILLED BYTES IN LAST RECORD */
        /* DFUB = DFUB + 1; */
        CALL PUTDEST(ENDFILE);
 /*68K*/ DUMMYB=NDESTL;
        END;
    CALL WRITEDEST;
 
    /* * * * * *  CLOSE TEMPORARY DESTINATION FILE  * * * * * */
 
    CALL CLOSE(@DFCB);
    IF DCNT = 255 THEN CALL FERR;
    IF SYS THEN DO;
        DFCB(SY)=DFCB(SY) OR 80H;
        CALL SETPASSWORD;
        CALL SET$ATTRIBU(@DFCB);
        END;
 
    /* * * * * *  RENAME SOURCE TO BACKUP IF ONE FILE  * * * * * */
 
    IF ONEFILE THEN DO;
        CALL MOVEUP(@SFCB);
/*68K*/ DUMMYP=@SFCB;DUMMYL=DUMMYL+16;
        CALL SETTYPE(DUMMYP,@BACKUP);   /* SET NEW TYPE TO BAK */
        CALL RENAME$FILE(@SFCB);
        END;
 
    /* * * * * *  RENAME TEMPORARY DESTINATION FILE  * * * * * */
 
    CALL MOVEUP(@DFCB);
/*68K*/ DUMMYP=@DFCB; DUMMYL=DUMMYL+16;
    CALL SETTYPE(DUMMYP,@DTYPE);
    CALL RENAME$FILE(@DFCB);
 
    END FINIS;
 
 
 
/*SPLH*/ /*$EJECT    */
 
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 
 
                  * * *  COMMAND ROUTINES * * *
 
 
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
 
 
 
                  /* PRINT A CHARACTER IF NOT MACRO EXPANSION */
PRINTNMAC: PROCEDURE(CHAR);
    DECLARE CHAR BYTE;
    IF MP <> 0 THEN RETURN;
    CALL PRINTC(CHAR);
    END PRINTNMAC;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* RETURN TRUE IF LOWER CASE CHARACTER */
LOWERCASE: PROCEDURE(C) BYTE;
    DECLARE C BYTE;
    RETURN C >= LCA AND C <= LCZ;
    END LOWERCASE;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* TRANSLATE CHARACTER TO UPPER CASE */
UCASE: PROCEDURE(C) BYTE;
    DECLARE C BYTE;
    IF LOWERCASE(C) THEN RETURN C AND 5FH;
    RETURN C;
    END UCASE;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* GET PASSWORD AND PLACE AT FCB + 16 */
GETPASSWD:   PROC;
    DCL (I,C) BYTE;
 
    CALL CRLF;
    CALL PRINT(@('PASSWORD ? ','$'));
RETRY:
    CALL FILL(@PASSWORD,' ',8);
        DO I = 0 TO 7;
NXTCHR:
        IF (C:=UCASE(CONIN)) >= ' ' THEN 
            PASSWORD(I)=C;
        IF C = CR THEN
            GO TO EXIT1;
        IF C = CTLX THEN
            GOTO RETRY;
        IF C = CTLH THEN DO;
            IF I<1 THEN
                GOTO RETRY;
            ELSE DO;
/*68K*/  I=I-1;
                PASSWORD(I)=' ';
                GOTO NXTCHR;
                END;
            END;
        IF C = 3 THEN
            CALL REBOOT;
        END;
EXIT1:
    C = BREAK$KEY;     /* CLEAR RAW I/O MODE */
    END GETPASSWD;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* TRANSLATE TO UPERCASE IF TRANSLATE FLAG
                     IS ON (ALSO TRANSLATE ESC TO ENDFILE) */
UTRAN: PROCEDURE(C) BYTE;
    DECLARE C BYTE;
    IF C = ESC THEN C = ENDFILE;
    IF TRANSLATE THEN RETURN UCASE(C);
    RETURN C;
    END UTRAN;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* PRINT THE LINE NUMBER */
PRINTVALUE: PROCEDURE(V);
    /* PRINT THE LINE VALUE V */
    DECLARE (D,ZERO) BYTE,
        (K,V) LONG;
    K = 10000;
    ZERO = FALSE;
        DO WHILE K <> 0;
        D = (V/K); V = V MOD K;
        K = K / 10;
        IF ZERO OR  D <> 0 THEN
            DO; ZERO = TRUE;
            CALL PRINTC('0'+D);
            END; 
        ELSE
            CALL PRINTC(' ');
        END;
    END PRINTVALUE;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* PRINT LINE WITH NUMBER V */
PRINTLINE: PROCEDURE(V);
    DECLARE V LONG;
    IF NOT LINESET THEN RETURN;
    CALL PRINTVALUE(V);
    CALL PRINTC(':');
    CALL PRINTC(' ');
    IF INSERTING THEN 
        CALL PRINTC(' '); 
    ELSE
        CALL PRINTC('*');
    END PRINTLINE;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* PRINT CURRENT LINE (BASELINE) */
PRINTBASE: PROCEDURE;
    CALL PRINTLINE(BASELINE);
    END PRINTBASE;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* PRINT CURRENT LINE IF NOT IN A MACRO */
PRINTNMBASE: PROCEDURE;
    IF MP <> 0 THEN RETURN;
    CALL PRINTBASE;
    END PRINTNMBASE;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* GET NEXT CHARACTER FROM COMMAND TAIL */
GETCMD: PROC BYTE;
 
    IF BUFF(NCMD + 1) <> 0 THEN
        DO; NCMD=NCMD+1;            /* SPLH */
        RETURN BUFF(NCMD); END;     /* SPLH */
    ELSE
        RETURN CR;
    END GETCMD;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
          /* READ NEXT CHAR FROM COMMAND BUFFER */
READC: PROCEDURE BYTE;
    /* MAY BE MACRO EXPANSION */
    IF MP > 0 THEN
        DO;
        IF BREAK$KEY THEN GO TO OVERCOUNT;
        IF XP >= MP THEN
            DO; /* START AGAIN */
            IF MT <> 0 THEN
                DO; IF (MT:=MT-1) = 0 THEN
                    GO TO OVERCOUNT;
                END;
            XP = 0;
            END;
        RETURN UTRAN(MACRO((XP := XP + 1) - 1));
        END;
    IF INSERTING THEN RETURN UTRAN(READCHAR);
 
    /* GET COMMAND LINE */
    IF READBUFF THEN
        DO; READBUFF = FALSE;
        IF LINESET AND COLUMN = 0 THEN
            DO;
            IF BACK >= MAXML THEN
                CALL PRINTLINE(0); 
            ELSE
                CALL PRINTBASE;
            END; 
        ELSE
            CALL PRINTC('*');
        CALL READCOM; CBP = 0;
        CALL PRINTC(LF);
        COLUMN = 0;
        END;
    IF (READBUFF := CBP = COMLEN ) THEN 
        COMBUFF(CBP) = CR;
    RETURN UTRAN(COMBUFF((CBP := CBP +1) -1));
    END READC;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* GET UPPER CASE CHARACTER FROM COMMAND 
                     BUFFER OR COMMAND LINE */
GET$UC: PROC;
    IF COMMAND$TAIL THEN 
        CHAR = UCASE(GETCMD);
    ELSE
        CHAR = UCASE(READC);
    END GET$UC;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* PARSE FILE NAME 
                     THIS ROUTINE REQUIRES A ROUTINE TO GET 
                     THE NEXT CHARACTER AND PUT IT IN A BYTE
                     VARIABLE */
PARSE$FCB: PROC(FCBADR) BYTE;
    DCL FCBADR POINTER;
    DCL AFCB BASED FCBADR (33) BYTE;
    DCL DRIVE LIT 'AFCB(0)';
    DCL (I,FLAG,DELIMITER) BYTE;
 
 
    PUTC: PROC;
       I=I+1;      /*SPLH */
       AFCB(I) = CHAR; /* SPLH */
       FLAG = TRUE;
    END PUTC;
 
    DELIM: PROC BYTE;
       DCL DEL(*) BYTE DATA (CR,ENDFILE,' ,.=:<>_[]*?');
                         /*   0       1  234567890123   */
          DO DELIMITER = 0 TO LAST(DEL);
          IF CHAR = '?' OR CHAR = '*' THEN
             CALL ABORT(@('CANNOT EDIT WILDCARD FILENAME$'));
          IF CHAR = DEL(DELIMITER) THEN 
             RETURN (TRUE);
          END;
       RETURN (FALSE);
    END DELIM;
 
 
    FLAG = FALSE;
    CALL GET$UC;
    IF CHAR <> CR THEN 
        IF CHAR <> ENDFILE THEN DO;
                        /* INITIALIZE FCB TO SRCE FCB TYPE & DRIVE */
/*68K*/ DUMMYP=FCBADR; DUMMYL=DUMMYL+12;
            CALL FILL(DUMMYP,0,21);
/*68K*/ DUMMYP=FCBADR; DUMMYL=DUMMYL+1;
            CALL FILL(DUMMYP,' ',11);
                        /* CLEAR LEADING BLANKS */
                DO WHILE CHAR = ' ';
                CALL GET$UC;
                END;
                        /* PARSE LOOP */
                DO WHILE NOT DELIM;
                I = 0;
                    /* GET NAME */
                    DO WHILE NOT DELIM;
                    IF I > 8 THEN
                        GO TO ERR;              /* TOO LONG */
                    CALL PUTC;
                    CALL GET$UC;
                    END;
                IF CHAR = ':' THEN DO;
                    /* GET DRIVE FROM AFCB(1) */
                    IF I <> 1 THEN
                        GO TO ERR;              /* INVALID : */
                    IF (DRIVE := AFCB(1) - 'A' + 1) > 16 THEN
                        GO TO ERR;              /* INVALID DRIVE */
                    AFCB(1) = ' ';
                    CALL GET$UC;
                    END;
                IF CHAR = '.' THEN DO;
                    /* GET FILE TYPE */
                    I = 8;
                    CALL GET$UC;
                        DO WHILE NOT DELIM;
                        IF I > 11 THEN
                            GO TO ERR;          /* TOO LONG */
                        CALL PUTC;
                        CALL GET$UC;
                        END;
                    END;
                END;                            /* PARSE LOOP */
            /* DELIMITER MUST BE A COMMA OR SPACE */
            IF DELIMITER > 3 THEN   /* NOT A CR,ENDFILE,SPACE,COMMA */
                GO TO ERR;
            IF NOT FLAG THEN
                GO TO ERR;
            END;
 
    RETURN (FLAG);
 
ERR:
    CALL ABORT(@INVALID);
    RETURN (FALSE);
    END PARSE$FCB;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* COPY SOURCE FILENAME TO DESTINATION */
COPYDEST: PROCEDURE;
    CALL MOVE(16,@FCB,@DFCB);
    END COPYDEST;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* SET UP DESTINATION FCB */
SETDEST: PROCEDURE;
    DCL I BYTE;
 
    /* ONEFILE = TRUE; (INITIALIZED) */
    IF PARSE$FCB(@DFCB) THEN
        DO I=1 TO 11;
        IF FCB(I) <> DFCB(I) THEN 
            IF DFCB(1) <> ' ' THEN
                ONEFILE = FALSE;
        END;
    IF ONEFILE THEN
        CALL COPYDEST;
    CALL MOVE(3,@DFCB(9),@DTYPE);   /* SAVE DESTINATION TYPE */
    IF GETCMD <> CR THEN
        CALL ABORT(@INVALID);
    END SETDEST;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* SET READ LIB FILE DMA ADDRESS */
SETRDMA: PROCEDURE;
    CALL SETDMA(@BUFF);
    END SETRDMA;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* READ LIB FILE ROUTINE */
READFILE: PROCEDURE BYTE;
    IF RBP >= SECTSIZE THEN
        DO; CALL SETRDMA;
        IF DISKREAD(@RFCB) <> 0 THEN RETURN ENDFILE;
        RBP = 0;
        END;
    RETURN UTRAN(BUFF((RBP := RBP + 1) - 1));
    END READFILE;
 
 
 
 
/*SPLH*/ /*$EJECT   */
 
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 
 
                  * * *  INITIALIZATION  * * *
 
 
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
 
SETUP: PROCEDURE;
 
    /* * * * * * * * *  OPEN SOURCE FILE  * * * * * * * * */
 
 
    SFCB(EX), SFCB(MD), SFCB(NR) = 0;
    IF LOW(VER)=CPM3 THEN DO;
        CALL RETURN$ERRO(0FEH);            /* SET ERROR MODE */
        CALL SETPASSWORD;
        END;
    ERROR$CODE = OPEN$FILE (@FCB);
    IF LOW(VER)=CPM3 THEN DO;
        CALL RETURN$ERRO(0);               /* RESET ERROR MODE */
        IF LOW(ERROR$CODE) = 0FFH THEN 
            IF HIGH(ERROR$CODE) = 7 THEN DO;
            CALL GETPASSWD;
            CALL CRLF;
            CALL CRLF;
            CALL SETPASSWORD;               /* SET DMA TO PASSWORD */
            ERROR$CODE = OPEN$FILE(@FCB);
            END;
        END;
    DCNT=LOW(ERROR$CODE);
    IF ONEFILE THEN DO;
        IF ROL(FCB(RO),1) THEN
            CALL ABORT(@('FILE IS READ/ONLY$'));
        ELSE IF ROL(FCB(SY),1) THEN   /* SYSTEM ATTRIBUTE */
            DO;
            IF ROL(FCB(US),1) THEN
                DCNT = 255;          /* USER 0 FILE SO CREATE */
            ELSE
                SYS = TRUE;
            END;
        END;
 
    /* * * * * *  NEW FILE IF NO SOURCE FILE  * * * * * */
 
    IF DCNT = 255 THEN DO;
        IF NOT ONEFILE THEN
            CALL ABORT(@('FILE NOT FOUND$'));
        NEWFILE = TRUE;
        CALL PRINT(@('NEW FILE$'));
        CALL CRLF;
        END; 
 
    /* * * * * *  MAKE TEMPORARY DESTINATION FILE  * * * * * */
 
    CALL SETTYPE(@DFCB,@TEMPFL);
    DFCB(EX)=0;
    CALL MAKE$FILE(@DFCB);
    IF DCNT = 255 THEN
        CALL FERR;
    /* THE TEMP FILE IS NOW CREATED */
 
    /* NOW CREATE THE PASSWORD IF ANY */
    IF PROTECTION <> 0 THEN DO;
        DFCB(EX) = PROTECTION OR 1;  /* SET PASSWORD */
        CALL SETPASSWORD;
        CALL WRITE$XFCB(@DFCB);
        END;
    DFCB(EX),DFCB(32) = 0;  /* NEXT RECORD IS ZERO */
 
    /* * * * * * * * *  RESET BUFFER  * * * * * * * * */
 
    NSOURCE = BUFFLENGTH; 
    NDEST = 0;
    BASELINE = 1;           /* START WITH LINE 1 */
    END SETUP;
 
 
 
 
/*SPLH*/ /*$EJECT  */
 
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 
 
                  * * *  BUFFER MANAGEMENT * * *
 
 
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
 
 
 
                  /* DISTANCE IS THE NUMBER OF LINES PREFIX 
                     TO A COMMAND */
                  /* SET MAXIMUM DISTANCE (0FFFFH) */
SETFF: PROCEDURE;
    DISTANCE = 0FFFFH;
    END SETFF;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* RETURN TRUE IF DISTANCE IS ZERO */
DISTZERO: PROCEDURE BYTE;
    RETURN DISTANCE = 0;
    END DISTZERO;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* SET DISTANCE TO ZERO */
ZERODIST: PROCEDURE;
    DISTANCE = 0;
    END ZERODIST;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* CHECK FOR ZERO DISTANCE AND DECREMENT */
DISTNZERO: PROCEDURE BYTE;
    IF NOT DISTZERO THEN
        DO; DISTANCE = DISTANCE - 1;
        RETURN TRUE;
        END;
    RETURN FALSE;
    END DISTNZERO;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* SET MEMORY LIMITS OF COMMAND FROM 
                     DISTANCE AND DIRECTION */
SETLIMITS: PROC;
    DCL (I,K,L,M) LONG, (MIDDLE,LOOPING) BYTE;
    RELLINE = 1; /* RELATIVE LINE COUNT */
    IF DIRECTION = BACKWARD THEN
        DO; DISTANCE = DISTANCE+1; I = FRONT; L = 0; K = -1;
        END; 
    ELSE
        DO; I = BACK; L = MAXML; K = 1;
        END;
 
    LOOPING = TRUE;
        DO WHILE LOOPING;
            DO WHILE (MIDDLE := I <> L) AND
                MEMORY(M:=I+K) <> LF;
            I = M;
            END;
        LOOPING = (DISTANCE := DISTANCE - 1) <> 0;
        IF NOT MIDDLE THEN
            DO; LOOPING = FALSE;
            I = I - K;
            END; 
        ELSE DO;
            RELLINE = RELLINE - 1;
            IF LOOPING THEN 
                I = M;
            END;
        END;
 
    IF DIRECTION = BACKWARD THEN
        DO; FIRST = I; LASTC = FRONT - 1;
        END; 
    ELSE
        DO; FIRST = BACK + 1; LASTC = I + 1;
        END;
    END SETLIMITS;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* INCREMENT CURRENT POSITION */
INCBASE: PROCEDURE;
    BASELINE = BASELINE + 1;
    END INCBASE;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* DECREMENT CURRENT POSITION */
DECBASE: PROCEDURE;
    BASELINE = BASELINE - 1;
    END DECBASE;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* INCREMENT LIMITS */
INCFRONT: PROC; FRONT = FRONT + 1;
    END INCFRONT;
INCBACK: PROCEDURE; BACK = BACK + 1;
    END INCBACK;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* DECREMENT LIMITS */
DECFRONT: PROC; FRONT = FRONT - 1;
    IF MEMORY(FRONT) = LF THEN 
        CALL DECBASE;
    END DECFRONT;
DECBACK: PROC; BACK = BACK - 1;
    END DECBACK;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* MOVE CURRENT PAGE IN MEMORY IF MOVE FLAG 
                     TRUE OTHERWISE DELETE IT */
MEM$MOVE: PROC(MOVEFLAG);
    DECLARE (MOVEFLAG,C) BYTE;
    /* MOVE IF MOVEFLAG IS TRUE */
    IF DIRECTION = FORWARD THEN
        DO WHILE BACK < LASTC; CALL INCBACK;
        IF MOVEFLAG THEN
            DO;
            IF (C := MEMORY(BACK)) = LF THEN CALL INCBASE;
            MEMORY(FRONT) = C; CALL INCFRONT;
            END;
        END; 
    ELSE
        DO WHILE FRONT > FIRST; CALL DECFRONT;
        IF MOVEFLAG THEN
            DO; MEMORY(BACK) = MEMORY(FRONT); CALL DECBACK;
            END;
        END;
    END MEM$MOVE;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* FORCE A MEMORY MOVE */
MOVER: PROC;
    CALL MEM$MOVE(TRUE);
    END MOVER;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* RESET MEMORY LIMIT POINTERS, DELETING
                     CHARACTERS (USED BY D COMMAND) */
SETPTRS: PROC;
    CALL MEM$MOVE(FALSE);
    END SETPTRS;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* SET LIMITS AND FORCE A MOVE */
MOVELINES: PROC;
    CALL SETLIMITS;
    CALL MOVER;
    END MOVELINES;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* SET FRONT TO LOWER VALUE DELETEING
                     CHARACTERS (USED BY S AND J COMMANDS) */
SETFRONT: PROC(NEWFRONT);
    DCL NEWFRONT LONG;
 
        DO WHILE FRONT <> NEWFRONT;
        CALL DECFRONT;
        END;
    END SETFRONT;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* SET LIMITS FOR MEMORY MOVE */
SETCLIMITS: PROC;
    IF DIRECTION = BACKWARD THEN
        DO; LASTC = BACK;
        IF DISTANCE > FRONT THEN
            FIRST = 1; 
        ELSE 
            FIRST = FRONT - DISTANCE;
        END; 
    ELSE
        DO; FIRST = FRONT;
        IF DISTANCE >= MAXL- BACK THEN
            LASTC = MAXML;
        ELSE 
            LASTC = BACK + DISTANCE;
        END;
    END SETCLIMITS;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* READ ANOTHER LINE OF INPUT */
READLINE: PROCEDURE;
    DECLARE B BYTE;
    /* READ ANOTHER LINE OF INPUT */
    CTRAN: PROCEDURE(B) BYTE;
        DECLARE B BYTE;
        /* CONDITIONALLY TRANSLATE TO UPPER CASE ON INPUT */
        IF UPPER THEN RETURN UTRAN(B);
        RETURN B;
        END CTRAN;
    DO FOREVER;
    IF FRONT >= BACK THEN GO TO OVERFLOW;
    IF (B := CTRAN(GETSOURCE)) = ENDFILE THEN
        DO; CALL ZERODIST; RETURN;
        END;
    MEMORY(FRONT) = B;
    CALL INCFRONT;
    IF B = LF THEN
        DO; CALL INCBASE;
        RETURN;
        END;
    END;
    END READLINE;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* WRITE ONE LINE OUT */
WRITELINE: PROCEDURE;
    DECLARE B BYTE;
        DO FOREVER;
        IF BACK >= MAXML THEN /* EMPTY */
            DO; CALL ZERODIST; RETURN;
            END;
        CALL INCBACK;
        CALL PUTDEST(B:=MEMORY(BACK));
        IF B = LF THEN
            DO; CALL INCBASE;
            RETURN;
            END;
        END;
    END WRITELINE;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* WRITE LINES UNTIL AT LEAST HALF THE
                     THE BUFFER IS EMPTY */
WRHALF: PROCEDURE;
    CALL SETFF;
        DO WHILE DISTNZERO;
        IF HMAXL>= (MAXML- BACK ) THEN
            CALL ZERODIST; 
        ELSE
            CALL WRITELINE;
        END;
    END WRHALF;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* WRITE LINES DETERMINED BY DISTANCE 
                     CALLED FROM W AND E COMMANDS */
WRITEOUT: PROCEDURE;
    DIRECTION = BACKWARD; FIRST = 1; LASTC = BACK;
    CALL MOVER;
    IF DISTZERO THEN CALL WRHALF;
    /* DISTANCE = 0 IF CALL WRHALF */
        DO WHILE DISTNZERO;
        CALL WRITELINE;
        END;
    IF BACK < LASTC THEN
        DO; DIRECTION = FORWARD; CALL MOVER;
        END;
    END WRITEOUT;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* CLEAR MEMORY BUFFER */
CLEARMEM: PROCEDURE;
    CALL SETFF;
    CALL WRITEOUT;
    END CLEARMEM;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* CLEAR BUFFERS, TERMINATE EDIT */
TERMINATE: PROCEDURE;
    CALL CLEARMEM;
    IF NOT NEWFILE THEN
        DO WHILE (CHAR := GETSOURCE) <> ENDFILE;
        CALL PUTDEST(CHAR);
        END;
    CALL FINIS;
    END TERMINATE;
 
 
 
 
/*SPLH*/  /*$EJECT   */
 
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 
 
                  * * *  COMMAND PRIMITIVES  * * *
 
 
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
 
 
 
 
                  /* INSERT CHAR INTO MEMORY BUFFER */
INSERT: PROCEDURE;
    IF FRONT = BACK THEN GO TO OVERFLOW;
    MEMORY(FRONT) = CHAR; CALL INCFRONT;
    IF CHAR = LF THEN CALL INCBASE;
    END INSERT;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* READ A CHARACTER AND CHECK FOR ENDFILE
                     OR CR  */
SCANNING: PROCEDURE BYTE;
    RETURN NOT ((CHAR := READC) = ENDFILE OR
                   (CHAR = CR AND NOT INSERTING));
    END SCANNING;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* READ COMMAND BUFFER AND INSERT CHARACTERS
                     INTO SCRATCH 'TIL NEXT ENDFILE OR CR FOR
                     FIND, NEXT, JUXT, OR SUBSTITUTE COMMANDS
                     FILL AT WBE AND INCREMENT WBE SO IT 
                     ADDRESSES THE NEXT EMPTY POSITION OF SCRATCH */
COLLECT: PROCEDURE;
 
    SETSCR: PROCEDURE;
        SCRATCH(WBE) = CHAR;
        IF (WBE := WBE + 1) >= SCRSIZE THEN GO TO OVERFLOW;
        END SETSCR;
 
        DO WHILE SCANNING;
        IF CHAR = CTLL THEN
            DO; CHAR = CR; CALL SETSCR;
            CHAR = LF;
            END;
        IF CHAR = 0 THEN GO TO BADCOM;
        CALL SETSCR;
        END;
    END COLLECT;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* FIND THE STRING IN SCRATCH STARTING AT
                     PA AND ENDING AT PB */
FIND: PROCEDURE(PA,PB) BYTE;
    DECLARE (PA,PB) BYTE;
    DECLARE J LONG,
        (K, MATCH) BYTE;
    J = BACK ;
    MATCH = FALSE;
        DO WHILE NOT MATCH AND (MAXML> J);
        LASTC,J = J + 1; /* START SCAN AT J */
        K = PA ; /* ATTEMPT STRING MATCH AT K */
 /*SPLH*/   MATCH=(K=PB);
            DO WHILE (SCRATCH(K) = MEMORY(LASTC)) AND
 /*SPLH*/      (NOT (MATCH));
            /* MATCHED ONE MORE CHARACTER */
 /*SPLH*/   K = K + 1; LASTC = LASTC + 1;MATCH=(K=PB);
            END;
        END;
    IF MATCH THEN /* MOVE STORAGE */
        DO; LASTC = LASTC - 1; CALL MOVER;
        END;
    RETURN MATCH;
    END FIND;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* SET UP THE SEARCH STRING FOR F, N, AND
                     S COMMANDS  */
SETFIND: PROCEDURE;
    WBE = 0; CALL COLLECT; WBP = WBE;
    END SETFIND;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* CHECK FOR FOUND STRING IN F AND S COMMANDS */
CHKFOUND: PROCEDURE;
    IF NOT FIND(0,WBP) THEN /* NO MATCH */ GO TO OVERCOUNT;
    END CHKFOUND;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* PARSE READ / XFER LIB FCB */
PARSE$LIB: PROCEDURE(FCBADR) BYTE;
    DCL FCBADR POINTER;
    DCL AFCB BASED FCBADR (33) BYTE;
    DCL B BYTE;
 
    B = PARSE$FCB(FCBADR);
    IF AFCB(9) = ' ' THEN DO;
/*68K*/ DUMMYP=FCBADR; DUMMYL=DUMMYL+9;
        CALL MOVE(3,@LIBFCB(9),DUMMYP);
                          END;
    IF AFCB(1) = ' ' THEN DO;
/*68K*/ DUMMYP=FCBADR; DUMMYL=DUMMYL+1;
        CALL MOVE(8,@LIBFCB(1),DUMMYP);
                          END;
    RETURN B;
    END PARSE$LIB;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* PRINT RELATIVE POSITION */
PRINTREL: PROCEDURE;
    CALL PRINTLINE(BASELINE+RELLINE);
    END PRINTREL;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* TYPE LINES COMMAND */
TYPELINES: PROCEDURE;
    DCL I LONG;
    DCL C BYTE;
    CALL SETLIMITS;
    /* DISABLE THE * PROMPT */
    INSERTING = TRUE;
    IF DIRECTION = FORWARD THEN
        DO; RELLINE = 0; I = FRONT;
        END; 
    ELSE
        I = FIRST;
    IF (C := MEMORY(I-1)) = LF THEN  DO;
        IF COLUMN <> 0 THEN
            CALL CRLF;
        END;
    ELSE
        RELLINE = RELLINE + 1;
 
        DO I = FIRST TO LASTC;
        IF C = LF THEN
            DO;
            CALL PRINTREL;
            RELLINE = RELLINE + 1;
            IF BREAK$KEY THEN GO TO OVERCOUNT;
            END;
        CALL PRINTC(C:=MEMORY(I));
        END;
    END TYPELINES;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* SET DISTANCE TO LINES PER PAGE (LPP) */
SETLPP: PROCEDURE;
    DISTANCE = LPP;
    END SETLPP;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* SAVE DISTANCE IN TDIST */
SAVEDIST: PROCEDURE;
    TDIST = DISTANCE;
    END SAVEDIST;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* RESTORE DISTANCE FROM TDIST */
RESTDIST: PROCEDURE;
    DISTANCE = TDIST;
    END RESTDIST;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* PAGE COMMAND (MOVE N PAGES AND PRINT) */
PAGE: PROCEDURE;
    DECLARE I BYTE;
    CALL SAVEDIST;
    CALL SETLPP;
    CALL MOVELINES;
    I = DIRECTION;
    DIRECTION = FORWARD;
    CALL SETLPP;
    CALL TYPELINES;
    DIRECTION = I;
    IF LASTC = MAXML OR FIRST = 1 THEN
        CALL ZERODIST;
    ELSE 
        CALL RESTDIST;
    END PAGE;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* WAIT COMMAND (1/2 SECOND TIME-OUT) */
WAIT: PROCEDURE;
    DECLARE I BYTE;
        DO I = 0 TO 19;
        IF BREAK$KEY THEN GO TO RESET;
        CALL TIME(250);
        END;
    END WAIT;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* SET DIRECTION TO FORWARD */
SETFORWARD: PROCEDURE;
    DIRECTION = FORWARD;
    DISTANCE = 1;
    END SETFORWARD;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* APPEND 'TIL BUFFER IS AT LEAST HALF FULL */
APPHALF: PROCEDURE;
    CALL SETFF; /* DISTANCE = 0FFFFH */
        DO WHILE DISTNZERO;
        IF FRONT >= HMAXL THEN
            CALL ZERODIST; 
        ELSE
            CALL READLINE;
        END;
    END APPHALF;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* INSERT CR LF CHARACTERS */
INSCRLF: PROCEDURE;
    /* INSERT CR LF CHARACTERS */
    CHAR = CR; CALL INSERT;
    CHAR = LF; CALL INSERT;
    END INSCRLF;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* TEST IF INVALID DELETE OR
                     BACKSPACE AT BEGINNING OF INSERTING */
INS$ERROR$CHK: PROCEDURE;
    IF (TCOLUMN = 255) OR (FRONT = 1) THEN
        GO TO RESET;
    END INS$ERROR$CHK;
/*SPLH*/  /*$EJECT     */
 
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 
 
                  * * *  COMMAND PARSING * * *
 
 
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
 
 
 
 
                  /* TEST FOR UPPER OR LOWER CASE COMMAND
                     SET TRANSLATE FLAG (USED TO DETERMINE
                     IF FOLLOWING CHARACTERS SHOULD BE TRANSLATED
                     TO UPPER CASE */
TESTCASE: PROCEDURE;
    DECLARE T BYTE;
    TRANSLATE = TRUE;
    T = LOWERCASE(CHAR);
    CHAR = UTRAN(CHAR);
    TRANSLATE = UPPER OR NOT T;
    END TESTCASE;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* SET TRANSLATE TO FALSE AND READ NEXT 
                     CHARACTER */
READCTRAN: PROCEDURE;
    TRANSLATE = FALSE;
    CHAR = READC;
    CALL TESTCASE;
    END READCTRAN;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* RETURN TRUE IF COMMAND IS ONLY CHARACTER
                     NOT IN MACRO OR COMBINATION ON A LINE */
SINGLECOM: PROCEDURE(C) BYTE;
    DECLARE C BYTE;
    RETURN CHAR = C AND COMLEN = 1 AND MP = 0;
    END SINGLECOM;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* RETURN TRUE IF COMMAND IS ONLY CHARACTER
                     NOT IN MACRO OR COMBINATION ON A LINE, AND
                     THE OPERATOR HAS RESPONDED WITH A 'Y' TO A
                     Y/N REQUEST */
SINGLERCOM: PROCEDURE(C) BYTE;
    DECLARE (C,I) BYTE;
    IF SINGLECOM(C) THEN
        DO FOREVER; 
        CALL CRLF; CALL PRINTCHAR(C);
        CALL MON5(9,@('-(Y/N)',WHAT,'$'));
        I = UCASE(READCHAR); CALL CRLF;
        IF I = 'N' THEN GO TO START;
        IF I = 'Y' THEN 
            RETURN TRUE;
        END;
    RETURN FALSE;
    END SINGLERCOM;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* RETURN TRUE IF CHAR IS A DIGIT */
DIGIT: PROCEDURE BYTE;
    RETURN (I := CHAR - '0') <= 9;
    END DIGIT;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* RETURN WITH DISTANCE = NUMBER CHAR = 
                     NEXT COMMAND */
NUMBER: PROCEDURE;
    DISTANCE = 0;
        DO WHILE DIGIT;
/*68K*/ DISTANCE = DISTANCE*10+LINT(I);
        CALL READCTRAN;
        END;
    END NUMBER;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
                  /* SET DISTANCE TO DISTANCE RELATIVE TO
                     THE CURRENT LINE */
RELDISTANCE: PROCEDURE;
    IF DISTANCE > BASELINE THEN
        DO; DIRECTION = FORWARD;
        DISTANCE = DISTANCE - BASELINE;
        END; 
    ELSE
        DO; DIRECTION = BACKWARD;
        DISTANCE = BASELINE - DISTANCE;
        END;
    END RELDISTANCE;
 
 
 
/*SPLH*/ /*$EJECT   */
 
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 
 
                  * * *  MAIN PROGRAM * * *
 
 
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
 
 
PLM:              /* ENTRY OF MP/M-86 INTERFACE */  
 
 /* INITIALIZE THE SYSTEM */
 /* 68K INIT GLOBAL DATA FOR LINKER BUG */
     RFCB(0)=0;
     RFCB(1)=' ';
     RFCB(2)=' ';
     RFCB(3)=' ';
     RFCB(4)=' ';
     RFCB(5)=' ';
     RFCB(6)=' ';
     RFCB(7)=' ';
     RFCB(8)=' ';
     RFCB(9)='L';
     RFCB(10)='I';
     RFCB(11)='B';
     RFCB(12)=0;
     RFCB(13)=0;
     RFCB(14)=0;
     XFCB(0)=0;
     XFCB(1)='X';
     XFCB(2)='$';
     XFCB(3)='$';
     XFCB(4)='$';
     XFCB(5)='$';
     XFCB(6)='$';
     XFCB(7)='$';
     XFCB(8)='$';
     XFCB(9)='L';
     XFCB(10)='I';
     XFCB(11)='B';
     XFCB(12)=0;
     XFCB(13)=0;
     XFCB(14)=0;
     XFCB(15)=0;
     XFCB(16)=0;
     XFCB(17)=0;
     XFCB(18)=0;
     XFCBEXT=0;
     XFCBREC=0;
     XFERON=FALSE;
     READING=FALSE;
     PASSWORD(0)=0;
     NEWFILE=FALSE;
     ONEFILE=TRUE;
     PRINTSUPPR=FALSE;
     SYS=0;
     PROTECTION=0;
     SCOLUMN=8;
     LINESET=TRUE;
     NCMD=0;
     COMMAND$TAIL=0FFH;
     TRANSLATE=FALSE;
     UPPER=FALSE;
     ERR$MSG=0;
  /* 68K INIT END     */
EDCOMMAND: /* PAST LXI SP,STACK */
 
    VER = VERSION;
/*    IF LOW(VER) <> CPM3 OR HIGH(VER) <> MPMPRODUCT THEN DO;
      CALL PRINT (@('REQUIRES MP/M 2.0','$'));
      CALL MON1(0,0);
      END; */
 
    /* * * * * * * SET UP MEMORY BUFFER * * * * * * * * * */
/* 68K */ DCHAKIP=@MEMORY;
/* 68K */ DCHAKIL=DCHAKIL+8192; /* SET END ADDR OF MEMORY ARRAY*/
/* GET DYNAMICALLY MEMORY BUFFER */
/*68K */ DUMMYB=0;
/*68K */ DO WHILE (DCHAKIL<MAXBL) AND (DUMMYB<22) ;
/*68K */ /* NOT GET MEMORY OVER MAXBL,OVER 32K     */
/*68K */   DCHAKIL=DCHAKIL+1024;  /* GET 1KB */
/*68K */   DUMMYB=DUMMYB+1;
/*68K */ END;
/*68K */ DCHAKIL=DCHAKIL-1024;    /* SET MEMORY LENGTH */
 
    /* I/O BUFFER REGION IS 1/8 AVAILABLE MEMORY */
 /* NBUF = SHR(MAX := MAXB - .MEMORY,SECTSHF+3) - 1; */
/*68K*/
     DUMMYP=@MEMORY;
     MAXL=DCHAKIL-DUMMYL;
     NBUF=MAXL/1024 -1;
    /* NBUF IS NUMBER OF BUFFERS - 1 */
 /* BUFFLENGTH = SHL(DOUBLE(NBUF+1),SECTSHF+1);  */
/*68K*/ BUFFLENGTHL=(NBUF+1)*256;
    /* NOW SET MAX AS REMAINDER OF FREE MEMORY */
    IF BUFFLENGTHL+ 1024 > MAXL THEN
        DO; CALL PRINT(@('NO MEMORY$'));
        CALL BOOT;
        END;
    /* REMOVE BUFFER SPACE AND 00 AT END OF MEMORY VECTOR */
    MAXL= MAXL- BUFFLENGTHL- 1;
    /* RESET BUFFER LENGTH FOR I AND O */
 /* BUFFLENGTH = SHR(BUFFLENGTH,1); */
/*68K*/ BUFFLENGTHL=BUFFLENGTHL/2;
    SBUFFADRL= DCHAKIL- BUFFLENGTHL;
    DBUFFADRL= SBUFFADRL- BUFFLENGTHL;
    MEMORY(MAXL) = 0; /* STOPS MATCH AT END OF BUFFER */
    MAXML= MAXL- 1;
/*  HMAX = SHR(MAXM,1);      */
/*68K*/ HMAXL=MAXML/2;
 
    /* * * * * *  SET UP SOURCE & DESTINATION FILES  * * * * * */
 
    PARSE$FN.BUFF$ADR = @TBUFF(1);
    PARSE$FN.FCB$ADR = @FCB;
/* SPLH IF (LEN0 <> 0)  AND (LOW(VER) = CPM3) THEN DO;
      CALL PARSE;                /* PASSWORD IN FCB16
      CALL MOVE(8,@FCB16,@PASSWORD);
      END;                   COMMENT FOR S-PL/H       */
 
    IF FCB(1)=' ' THEN
        CALL ABORT(@('FILENAME REQUIRED$'));
    IF NOT PARSE$FCB(@SFCB) THEN     /* PARSE SOURCE FCB */
        CALL REBOOT;
 
    IF LOW(VER)=CPM3 THEN DO;
        CALL COPYDEST;               /* COPY SOURCE FCB TO DEST */
        CALL READ$XFCB(@DFCB);
        PROTECTION = DFCB(EX);       /* PASSWORD PROTECTION MODE */
        END;
    CALL SETDEST;                    /* PARSE DESTINATION FILE */
    COMMAND$TAIL = FALSE;            /* PARSE$FCB FROM ED COMMAND */
 
    /* SOURCE AND DESTINATION DISKS SET */
 
    /* IF SOURCE AND DESTINATION DISKS DIFFER, CHECK FOR
    AN EXISTING SOURCE FILE ON THE DESTINATION DISK - THERE
    COULD BE A FATAL ERROR CONDITION WHICH COULD DESTROY A
    FILE IF THE USER HAPPENED TO BE ADDRESSING THE WRONG
    DISK */
    IF (SDISK <> DDISK) OR NOT ONEFILE THEN
        DO;
        CALL SETDMA(@BUFF);
        CALL SEARCH(@DFCB);
        IF DCNT <> 255 THEN /* SOURCE FILE PRESENT ON DEST DISK */
            CALL ABORT(@('OUTPUT FILE EXISTS, ERASE IT$'));
        END;
 
 
 
RESTART:
    CALL SETUP;
    MEMORY(0) = LF;
    FRONT = 1; BACK = MAXML;
    COLUMN = 0;
    GO TO START;
 
OVERCOUNT: FLAG = POUND; GO TO RESET;
 
BADCOM: FLAG = WHAT; GO TO RESET;
 
OVERFLOW: /* ARRIVE HERE ON OVERFLOW CONDITION (I,F,S COMMAND) */
    FLAG = '>'; GO TO RESET;
 
DISK$FULL$ERR:
    FLAG = 'F';
    ERR$MSG = @DISKFULL;
    GO TO RESET;
 
DIR$FULL$ERR:
    FLAG = 'F';
    ERR$MSG = @DIRFULL;
 
RESET: /* ARRIVE HERE ON ERROR CONDITION */
    PRINTSUPPR = FALSE;
    CALL PRINT(@('BREAK "$'));
    CALL PRINTC(FLAG);
    CALL PRINTM(@('" AT $'));
    CALL PRINTC(CHAR);
    IF ERR$MSG <> 0 THEN DO;
        CALL PRINTC(TAB);
        CALL PRINT(ERR$MSG);
        ERR$MSG = 0;
        END;
    CALL CRLF;
 
 
START:
    READBUFF = TRUE;
    MP = 0;
 
 
 
/*SPLH*/ /*$EJECT     */
 
    DO FOREVER; /* OR UNTIL THE POWER IS TURNED OFF */
 
    /* **************************************************************
    SIMPLE COMMANDS (CANNOT BE PRECEDED BY DIRECTION/DISTANCE):
             E      END THE EDIT NORMALLY
             H      MOVE TO HEAD OF EDITED FILE
             I      INSERT CHARACTERS
             O      RETURN TO THE ORIGINAL FILE
             R      READ FROM LIBRARY FILE
             Q      QUIT EDIT WITHOUT CHANGES TO ORIGINAL FILE
       ************************************************************** */
 
 
 
    INSERTING = FALSE;
    CALL READCTRAN;
    FLAG = 'E';
    MI = CBP; /* SAVE STARTING ADDRESS FOR <CR> COMMAND */
    IF SINGLECOM('E') THEN
        DO; CALL TERMINATE;
            /* >>>>>>>> THIS CODE FORCES A SELECT OF THE DESTINATION 
            DRIVE WHEN THE EDIT ENDS  <<<<<<<<<<
            I THINK THE USER SHOULD HAVE A CHOICE IN THE MATTER
            SO I HAVE COMMENTED THE CODE OUT - DOUG 10/14/81
        IF SDISK <> DDISK THEN DO;
            IF DDISK <> 0 THEN 
                DDISK = DDISK - 1;   
            BDISK = (BDISK AND 0F0H) OR (DDISK AND 0FH); */
        CALL REBOOT;
        END; 
 
    ELSE IF SINGLECOM('H') THEN /* GO TO TOP */
        DO; CALL TERMINATE;
            NEWFILE = FALSE;
        IF ONEFILE THEN DO;
            /* PING - PONG DISKS */
            CHAR  = DDISK; 
            DDISK = SDISK; 
            SDISK = CHAR;
            END;
        ELSE DO;
            CALL SETTYPE(@DFCB,@DTYPE);
            CALL MOVE (16,@DFCB,@SFCB); /* SOURCE = DESTINATION */
            ONEFILE = TRUE;
            END;
        GO TO RESTART;
        END; 
 
    ELSE IF CHAR = 'I' THEN /* INSERT CHARACTERS */
        DO;
        IF (INSERTING := (CBP = COMLEN) AND (MP = 0)) THEN DO;
            TCOLUMN = 255;           /* TESTED IN INS$ERROR$CHK ROUTINE */
            DISTANCE = 0; 
            DIRECTION = BACKWARD;
            IF MEMORY(FRONT-1) = LF THEN 
                CALL PRINTBASE;
            ELSE 
                CALL TYPELINES;
            END;
        DO WHILE SCANNING;
            DO WHILE CHAR <> 0;
            IF CHAR=CTLU OR CHAR=CTLX OR CHAR=CTLR THEN
                /* LINE DELETE OR RETYPE */
                DO;
                /* ELIMINATE OR REPEAT THE LINE */
                IF CHAR = CTLR THEN
                    DO; CALL CRLF;
                    CALL TYPELINES;
                    END; 
                ELSE
                    /* LINE DELETE */
                    DO; CALL SETLIMITS; CALL SETPTRS;
                    IF CHAR = CTLU THEN
                        DO; CALL CRLF; CALL PRINTNMBASE;
                        END; 
                    ELSE
                        /* MUST BE CTLX */
                        DO WHILE COLUMN > SCOLUMN;
                        CALL BACKSPACE;
                        END;
                    END;
                END; 
            ELSE IF CHAR = CTLH THEN
                DO;
                CALL INS$ERROR$CHK;
                IF (TCOLUMN := COLUMN) > 0 THEN
                    CALL PRINTNMAC(' '); /* RESTORE AFT BACKSP */
                CALL DECFRONT;
                IF TCOLUMN > SCOLUMN THEN
                    DO; /* CHARACTER CAN BE ELIMINATED */
                    PRINTSUPPR = TRUE;
                    /* BACKSPACE CHARACTER ACCEPTED */
                    COLUMN = 0;
                    CALL TYPELINES;
                    PRINTSUPPR = FALSE;
                    /* COLUMN POSITION NOW RESET */
            /*68K*/ QCOLUMN = COLUMN;
                    IF QCOLUMN < SCOLUMN THEN
                        QCOLUMN = SCOLUMN;
                    COLUMN = TCOLUMN; /* ORIGINAL VALUE */
                        DO WHILE COLUMN > QCOLUMN;
                        CALL BACKSPACE;
                        END;
                    END;
                ELSE
                    DO;
                    IF MEMORY(FRONT-1) = CR THEN
                        CALL DECFRONT;
                    CALL CRLF;
                    CALL TYPELINES;
                    END;
                CHAR = 0;
                END; 
            ELSE IF CHAR = RUBOUT THEN
                DO; CALL INS$ERROR$CHK;
                CALL DECFRONT; CALL PRINTC(CHAR:=MEMORY(FRONT));
                CHAR = 0;
                END; 
            ELSE IF CHAR = LF AND MEMORY(FRONT-1) <> CR THEN
                DO;
                CALL PRINTC(CR);
                CALL INSCRLF;
                END;  
            ELSE
                /* NOT A SPECIAL CASE */
                DO; 
                IF NOT GRAPHIC(CHAR) THEN
                    DO; 
                    CALL PRINTNMAC('^');
                    CALL PRINTNMAC(CHAR + '@');
                    END;
                    /* COLUMN COUNT GOES UP IF GRAPHIC */
                    /* COMPUTE OUTPUT COLUMN POSITION */
                IF CHAR = CTLL AND NOT INSERTING THEN
                    CALL INSCRLF;
                ELSE DO;
                    IF MP = 0 THEN
                        DO; 
                        IF CHAR >= ' ' THEN
                            COLUMN = COLUMN + 1; 
                        ELSE IF CHAR = TAB THEN
                            COLUMN = COLUMN + (8 - (COLUMN AND 111B));
                        END;
                    CALL INSERT;
                    END;
                END;
            IF CHAR = LF THEN CALL PRINTNMBASE;
            IF CHAR = CR THEN
                CALL PRINTNMAC(CHAR:=LF); 
            ELSE 
                CHAR = 0;
            TCOLUMN = 0;
            END; /* OF WHILE CHAR <> 0 */
        END; /* OF WHILE SCANNING */
        IF CHAR <> ENDFILE THEN DO; /* MUST HAVE STOPPED ON CR */
            CALL INSCRLF;
            COLUMN = 0;
            END;
        IF INSERTING AND LINESET THEN CALL CRLF;
        END; 
 
 
    ELSE IF SINGLERCOM('O') THEN /* FORGET THIS EDIT */
        DO;
        CALL CLOSE(@SFCB);
        GO TO RESTART; 
        END; 
 
 
    ELSE IF CHAR = 'R' THEN
        DO; DECLARE I BYTE;
        /* READ FROM LIB FILE */
        CALL SETRDMA;
        IF (FLAG := PARSE$LIB(@RFCB)) THEN
            READING = FALSE;
        IF NOT READING THEN DO;
            IF NOT FLAG THEN 
                /* READ FROM XFER FILE */
                CALL MOVE(12,@XFCB,@RFCB);
            RFCB(12), RFCB(32) = 0; /* ZERO EXTENT, NEXT RECORD */
            RBP = SECTSIZE;
            CALL OPEN(@RFCB);
            READING = TRUE;
            END;
        
            DO WHILE (CHAR := READFILE) <> ENDFILE;
            CALL INSERT;
            END;
        READING = FALSE;
        CALL CLOSE (@RFCB);
        END; 
 
 
    ELSE IF SINGLERCOM('Q') THEN
        DO; 
        CALL DELETE$FILE(@DFCB);
        IF NEWFILE OR NOT ONEFILE THEN DO;
            CALL SETTYPE(@DFCB,@DTYPE);
            CALL DELETE$FILE(@DFCB);
            END;
        CALL REBOOT;
        END; 
 
 
    ELSE 
        /* MAY BE A COMMAND WHICH HAS AN OPTIONAL DIRECTION AND DISTANCE */
        DO; /* SCAN A SIGNED INTEGER VALUE (IF ANY) */
        DCL I BYTE;
 
        CALL SETFORWARD;
 
        IF CHAR = '-' THEN
            DO; CALL READCTRAN; DIRECTION = BACKWARD;
            END;
 
        IF CHAR = POUND THEN
            DO; CALL SETFF; CALL READCTRAN;
            END; 
 
        ELSE IF DIGIT THEN
            DO; CALL NUMBER;
            /* MAY BE ABSOLUTE LINE REFERENCE */
            IF CHAR = ':' THEN
                DO; CHAR = 'L';
                CALL RELDISTANCE;
                END;
            END; 
 
        ELSE IF CHAR = ':' THEN /* LEADING COLON */
            DO; CALL READCTRAN; /* CLEAR THE COLON */
            CALL NUMBER;
            CALL RELDISTANCE;
            IF DIRECTION = FORWARD THEN
                DISTANCE = DISTANCE + 1;
            END;
 
 
/*SPLH*/ /*$EJECT      */
 
        IF DISTZERO THEN 
            DIRECTION = BACKWARD;
        /* DIRECTION AND DISTANCE ARE NOW SET */
 
 
    /* **************************************************************
    MAY BE A COMMAND WHICH HAS DIRECTION AND DISTANCE SPECIFIED:
             B      BEGINNING/BOTTOM OF BUFFER
             C      MOVE CHARACTER POSITIONS
             D      DELETE CHARACTERS
             K      KILL LINES
             L      MOVE LINE POSITION
             P      PAGE UP OR DOWN (LPP LINES AND PRINT)
             T      TYPE LINES
             U      UPPER CASE TRANSLATE
             V      VERIFY LINE NUMBERS
            <CR>    MOVE UP OR DOWN LINES AND PRINT LINE
       ************************************************************** */
 
 
        IF CHAR = 'B' THEN
            DO; DIRECTION = 1 - DIRECTION;
            FIRST = 1; LASTC = MAXML; CALL MOVER;
            END; 
 
 
        ELSE IF CHAR = 'C' THEN
            DO; CALL SETCLIMITS; CALL MOVER;
            END; 
 
 
        ELSE IF CHAR = 'D' THEN
            DO; CALL SETCLIMITS;
            CALL SETPTRS; /* SETS BACK/FRONT */
            END; 
 
 
        ELSE IF CHAR = 'K' THEN
            DO; CALL SETLIMITS;
            CALL SETPTRS;
            END; 
 
 
       ELSE IF CHAR = 'L' THEN 
            CALL MOVELINES; 
 
 
       ELSE IF CHAR = 'P' THEN /* PAGE MODE PRINT */
            DO; 
            IF DISTZERO THEN
                DO; DIRECTION = FORWARD;
                CALL SETLPP; CALL TYPELINES;
                END; 
            ELSE
                DO WHILE DISTNZERO; CALL PAGE;
                CALL WAIT;
                END;
            END; 
 
 
        ELSE IF CHAR = 'T' THEN
            CALL TYPELINES; 
 
 
        ELSE IF CHAR = 'U' THEN
            UPPER = DIRECTION = FORWARD; 
 
 
        ELSE IF CHAR = 'V' THEN
            DO; /* 0V DISPLAYS BUFFER STATE */
            IF DISTZERO THEN
                DO; CALL PRINTVALUE(BACK-FRONT);
                CALL PRINTC('/');
                CALL PRINTVALUE(MAXML);
                CALL CRLF;
                END; 
            ELSE IF (LINESET := DIRECTION = FORWARD) THEN
                SCOLUMN = 8;
            ELSE
                SCOLUMN = 0;
            END;
 
 
 
        ELSE IF CHAR = CR THEN /* MAY BE MOVE/TYPE COMMAND */
            DO;
            IF MI = 1 AND MP = 0 THEN /* FIRST COMMAND */
                DO; CALL MOVELINES; CALL SETFORWARD; CALL TYPELINES;
                END;
            END; 
 
 
/*SPLH*/ /*$EJECT   */
 
        ELSE IF DIRECTION = FORWARD OR DISTZERO THEN
            DO;
 
    /* **************************************************************
    COMMANDS WHICH ALLOW ONLY A PRECEDING NUMBER:
             A      APPEND LINES
             F      FIND NTH OCCURRENCE
             M      APPLY MACRO
             N      SAME AS F WITH AUTOSCAN THROUGH FILE
             S      PERFORM N SUBSTITUTIONS
             W      WRITE LINES TO OUTPUT FILE
             X      TRANSFER (XFER) LINES TO TEMP FILE
             Z      SLEEP
       ************************************************************** */
 
 
 
        IF CHAR = 'A' THEN
            DO; DIRECTION = FORWARD;
            FIRST = FRONT; LASTC = MAXML; CALL MOVER;
            /* ALL STORAGE FORWARD */
            IF DISTZERO THEN CALL APPHALF;
            /* DISTANCE = 0 IF APPHALF CALLED */
                DO WHILE DISTNZERO;
                CALL READLINE;
                END;
            DIRECTION = BACKWARD; CALL MOVER;
            /* POINTERS REPOSITIONED */
            END; 
 
 
        ELSE IF CHAR = 'F' THEN
            DO; CALL SETFIND; /* SEARCH STRING SCANNED
            AND SETUP BETWEEN 0 AND WBP-1 IN SCRATCH */
                DO WHILE DISTNZERO; CALL CHKFOUND;
                END;
            END; 
 
 
        ELSE IF CHAR = 'J' THEN /* JUXTAPOSITION OPERATION */
            DO; DECLARE T LONG;
            CALL SETFIND; CALL COLLECT;
            WBJ = WBE; CALL COLLECT;
            /* SEARCH FOR STRING 0 - WBP-1, INSERT STRING WBP TO WBJ-1,
            AND THEN DELETE UP TO STRING WBJ TO WBE-1 */
            DO WHILE DISTNZERO; CALL CHKFOUND;
            /* INSERT STRING */ MI = WBP - 1;
                DO WHILE (MI := MI + 1) < WBJ;
                CHAR = SCRATCH(MI); CALL INSERT;
                END;
            T = FRONT; /* SAVE POSITION FOR DELETE */
            IF NOT FIND(WBJ,WBE) THEN GO TO OVERCOUNT;
            /* STRING FOUND, SO MOVE IT BACK */
            FIRST = FRONT -LINT(WBE - WBJ);
            DIRECTION = BACKWARD; CALL MOVER;
            /* NOW REMOVE THE INTERMEDIATE STRING */
            CALL SETFRONT(T);
            END;
        END; 
 
 
        ELSE IF CHAR = 'M' AND MP = 0 THEN /* MACRO DEFINITION */
            DO; XP = 255;
            IF DISTANCE = 1 THEN CALL ZERODIST;
                XP=XP+1;     /* SPLH */
                DO WHILE (MACRO(XP) := READC) <> CR;  /* SPLH */
                  XP=XP+1;   /* SPLH */
                END;
            MP = XP; XP = 0; MT = DISTANCE;
            END; 
 
 
        ELSE IF CHAR = 'N' THEN
            DO; /* SEARCH FOR STRING WITH AUTOSCAN */
            CALL SETFIND; /* SEARCH STRING SCANNED */
                DO WHILE DISTNZERO;
                /* FIND ANOTHER OCCURRENCE OF STRING */
                    DO WHILE NOT FIND(0,WBP); /* NOT IN BUFFER */
                    IF BREAK$KEY THEN GO TO RESET;
                    CALL SAVEDIST; CALL CLEARMEM;
                    /* MEMORY BUFFER WRITTEN */
                    CALL APPHALF;
                    DIRECTION = BACKWARD; FIRST = 1; CALL MOVER;
                    CALL RESTDIST; DIRECTION = FORWARD;
                    /* MAY BE END OF FILE */
                    IF BACK >= MAXML THEN GO TO OVERCOUNT;
                    END;
                END;
            END; 
 
 
        ELSE IF CHAR = 'S' THEN /* SUBSTITUTE COMMAND */
            DO; CALL SETFIND;
            CALL COLLECT;
            /* FIND STRING FROM 0 TO WBP-1, SUBSTITUTE STRING
            BETWEEN WBP AND WBE-1 IN SCRATCH */
                DO WHILE DISTNZERO;
                CALL CHKFOUND;
                /* FRONT AND BACK NOW POSITIONED AT FOUND
                STRING - REPLACE IT */
                CALL SETFRONT(FRONT - LINT(MI := WBP)); /* BACKED UP */
                    DO WHILE MI < WBE;
                    CHAR = SCRATCH(MI);
                    MI = MI + 1; CALL INSERT;
                    END;
                 END;
            END; 
 
 
        ELSE IF CHAR = 'W' THEN
            CALL WRITEOUT; 
 
 
        ELSE IF CHAR = 'X' THEN /* TRANSFER LINES */
            DO;
            FLAG = PARSE$LIB(@RFCB);
            XBP = 0;
            IF DISTZERO THEN  
                DO;             /* DELETE THE FILE */
                XFERON  = FALSE;
                CALL DELETE(@RFCB);
                IF DCNT = 255 THEN DO;
                    FLAG = 'O';
                    GO TO RESET;
                    END;
                END; 
            ELSE 
                DO;             /* TRANSFER LINES */
                DECLARE I LONG;
 
                IF XFERON AND COMPARE$XFER THEN
                    CALL APPEND$XFER;
                ELSE
                    DO;         
                    XFERON = TRUE;
                    CALL MOVE(12,@RFCB,@XFCB);
                    XFCBEXT, XFCBREC, XFCBE, XFCBR = 0;
                    CALL MAKE$FILE(@XFCB);
                    IF DCNT = 255 THEN 
                        GOTO DIR$FULL$ERR;
                    END;
                CALL SETLIMITS;
                    DO I = FIRST TO LASTC;
                    CALL PUTXFER(MEMORY(I));
                    END;
                CALL CLOSE$XFER;
                END;
            END; 
 
 
        ELSE IF CHAR = 'Z' THEN /* SLEEP */
            DO;
            IF DISTZERO THEN
                DO; IF READCHAR = ENDFILE THEN GO TO RESET;
                END;
                DO WHILE DISTNZERO; CALL WAIT;
                END;
            END; 
        ELSE IF CHAR <> 0 THEN /* NOT BREAK LEFT OVER FROM STOP */
        /* DIRECTION FORWARD, BUT NOT ONE OF THE ABOVE */
        GO TO BADCOM;
 
 
        END; 
        ELSE /* DIRECTION NOT FORWARD */
            GO TO BADCOM;
        END;
    END;
END;
