FSESUBS 
PROC FSESUBS; 
  BEGIN 
  
  
# 
***       FSESUBS -- SUBROUTINES OF FULL SCREEN EDITOR. 
* 
*         COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
* 
*         FSESUBS PROVIDES SUBROUTINES WHICH ARE UNIVERSAL TO THE 
*         SINGLE AND MULTI-USER VERSIONS OF THE EDITOR, AND WHICH ARE 
*         ALSO REGARDED AS LIKELY TO BE UNIVERSAL TO ALL OVERLAYS IF
*         THE SINGLE-USER EDITOR WERE TO BE CONVERTED INTO AN OVERLAY 
*         STRUCTURE.  FSESUBS SPECIFICALLY INCLUDES THE INTERFACES BY 
*         WHICH THE WORKFILE MANAGER IS CALLED, AND INTERFACES FOR
*         MANAGEMENT OF THE AUDIT TRAIL AND OF INTERNAL FILE IMAGES.
# 
  
  DEF LISTCON #0#;
  
CONTROL EJECT;                         # UNIVERSAL DECLARES          #
  
*IFCALL SINGLE,COMFSGL
*IFCALL ONLY,COMFONL
*IFCALL MULTI,COMFMLT 
*CALL COMFFSE 
  
                             # EXTERNAL REF'S AND DEF'S    #
  
  
CONTROL IFEQ MULTI,1; 
  XREF ARRAY RENTSTK [1:MAXREENT];     # SUBROUTINE STACK  #
    BEGIN 
    ITEM RSTK;
    END 
  XREF ITEM RSTKPTR;
CONTROL FI; 
  
XDEF ITEM LINSIZ=BUFWIDP1;   # MAX LINE SIZ IN WORDS       #
  
XDEF
  BEGIN 
*CALL COMFXSB 
  END 
  
XREF
  BEGIN 
*CALL COMFXED 
*CALL COMFXSC 
*CALL COMFXTI 
*CALL COMFXFO 
*CALL COMFXVT 
*CALL COMFXWK 
  PROC ZEROWD;
  PROC WRITER;
  PROC ABORT; 
  PROC ENDRUN;
  PROC FASTCAI; 
  PROC FASTCNI; 
  FUNC LENGTH;
  PROC FASTCAO; 
  PROC FASTCNO; 
  PROC FASTRLC; 
  FUNC FASTLNB; 
  FUNC NOSWDSZ; 
  PROC MOVEWD;
  FUNC LINESZ;
  FUNC MOVELN;
  CONTROL IFEQ MULTI,1; 
    LABEL QQSINGLE; 
    PROC VOLUNTEER; 
    PROC FATALTRAP; 
    PROC SMFRCL;
    PROC SMFDLY;
  CONTROL FI; 
  CONTROL IFEQ SINGLE,1;
*CALL COMFXFL 
    PROC MESSAGE; 
    PROC CSETA; 
    PROC CSETN; 
    PROC WRITEC;
    PROC READC; 
    PROC EVICT; 
    PROC GETJN; 
    PROC RTIME; 
    PROC RETERN;
  CONTROL FI; 
  END                          # OF XREF #
  
                             # COMMON DATA AREAS #
  
*CALL COMFDS1 
*CALL COMFVD2 
*CALL COMFDS2 
  
*CALL COMFTAB 
PAGE                         # MINOR UTILITY ROUTINES      #
  
  
FUNC TRIMNAME(NAME) C(7); 
  BEGIN 
# 
**        TRIMNAME - CONVERT TRAILING BLANKS TO ZEROS.
* 
*         ENTRY  (NAME) - LEFT-JUSTIFIED STRING UP TO SEVEN CHARS.
* 
*         EXIT   (NAME) - CONVERTED.
# 
  ITEM NAME C(7), TMP1, NEWNAME C(7); 
  FOR TMP1=0 STEP 1 UNTIL 6 DO
    BEGIN 
    IF C<TMP1,1>NAME EQ " " THEN C<TMP1,1>NEWNAME=0;
    ELSE C<TMP1,1>NEWNAME=C<TMP1,1>NAME;
    END 
  TRIMNAME=NEWNAME; 
  END 
  
  
FUNC PADNAME(NAME) C(7);
  BEGIN 
# 
**        PADNAME - CONVERT TRAILING ZEROS TO BLANKS. 
* 
*         ENTRY  (NAME) - LEFT-JUSTIFIED STRING UP TO SEVEN CHARS.
* 
*         EXIT   (NAME) - CONVERTED.
# 
  ITEM NAME C(7), TMP1, NEWNAME C(7); 
  FOR TMP1=0 STEP 1 UNTIL 6 DO
    BEGIN 
    IF C<TMP1,1>NAME EQ 0 THEN C<TMP1,1>NEWNAME=" ";
    ELSE C<TMP1,1>NEWNAME=C<TMP1,1>NAME;
    END 
  PADNAME=NEWNAME;
  END 
  
  
FUNC MIN(A1,A2);
  BEGIN 
# 
**        MIN - COMPUTE LESSER OF TWO VALUES. 
* 
*         ENTRY  (A1) AND (A2) - VALUES TO CHOOSE.
* 
*         EXIT   (MIN) - LESSER INTEGER VALUE.
# 
  ITEM A1,A2; 
  IF A1 LQ A2 THEN MIN = A1;
  ELSE MIN = A2;
  END 
  
FUNC MAX(A1,A2);
  BEGIN 
# 
**        MAX - COMPUTE GREATER OF TWO VALUES.
* 
*         ENTRY  (A1) AND (A2) - VALUES TO CHOOSE.
* 
*         EXIT   (MAX) - GREATER INTEGER VALUE. 
# 
  ITEM A1,A2; 
  IF A1 GQ A2 THEN MAX = A1;
  ELSE MAX = A2;
  END 
  
  
PROC PUSHTEMP;
  BEGIN 
# 
**        PUSHTEMP - PRESERVE VALUE ON MISCELLANEOUS STACK. 
* 
*         ENTRY  (TEMP) - VALUE TO BE PRESERVED.
* 
*         EXIT   DATA STACK IS PUSHED.
* 
*         USES   DATAPTR, DATASTK.
# 
  IF DATAPTR GQ MAXDATA THEN
    BEGIN 
    FATAL(" REENTRANT DATA STACK OVERFLOWED.$");
    END 
  DATAPTR=DATAPTR+1;
  DATASTK[DATAPTR]=TEMP;
  END                          # OF PUSHTEMP       #
  
PROC POPTEMP; 
  BEGIN 
# 
**        POPTEMP - RETREIVE VALUE FROM MISCELLANEOUS STACK.
* 
*         ENTRY  DATA STACK ASSUMED TO HAVE DATA. 
* 
*         EXIT   (TEMP) - RETRIEVED VALUE.
* 
*         USES   DATAPTR, DATASTK 
# 
  IF DATAPTR LS 0 THEN FATAL(" REENTRANT DATA STACK UNDERFLOWED.$");
  TEMP=DATASTK[DATAPTR];
  DATAPTR=DATAPTR-1;
  END                          # OF POPTEMP        #
  
  
PROC STARTCMD;
  BEGIN 
# 
**        STARTCMD - INITIALIZE SYNTAX SCANNER FOR NEW COMMANDS.
* 
*         ENTRY  (CMDLINE) ALREADY FILLED IN WITH NEW STRING. 
* 
*         EXIT   (CMDLINE) TRIMMED. 
*                SCANPOS, TOKENPOS, CMDMARKER, KEYWDTYPE INITIALIZED. 
*                EXPANDAT INITIALIZED.
# 
  TRIM(CMDLIN,0); 
  SCANPOS=0;
  TOKENPOS=0; 
  CMDMARKER=0;
  KEYWDTYPE=1;
  EXPANDAT=-1;
  END                          # OF STARTCMD       #
  
  
FUNC TABFN(TABNUM); 
  BEGIN 
# 
**        TABFN - COMPUTE TAB COLUMN BY ORDINAL.
* 
*         ENTRY  (TABNUM) INTEGER ORDINAL OF TAB STOP.
* 
*         EXIT   (TABFN) COLUMN OFFSET. 
# 
  ITEM TABNUM;
  ITEM TMP1, TMP2;
  IF TABNUM LS 1 OR TABNUM GR TABSTOPS THEN TABFN=0;
  ELSE
    BEGIN 
    TMP2=TABNUM-1;
    TMP1=TMP2/7;
    TMP2=MOD(TMP2,7); 
    TABFN=B<TMP2*8,8>TABVCTWRD[TMP1+1]; 
    END 
  END                          # OF TABFN          #
  
  
PROC COPYTABS;
  IOBEGIN(COPYTABS) 
# 
**        COPYTABS - COPY/CONVERT TABS, TABVECTOR->VIRTERM. 
* 
*         ENTRY  TABVECTOR ALREADY SET UP.
* 
*         EXIT   TERMINAL CONFIGURED, VIRTERM DITTO.
* 
*         CALLS  VDTCTS, VDTSTS.
* 
*         USES   LINCTR, LINNUM1. 
# 
  VDTCTS;                    # CLEAR OLD TABS    #
  VDTSTS(0);                 # ALWAYS  #
  IF TABVCTWRD[1] EQ 0 THEN IORET 
  VDTSTS(TABFN(1)); 
  FOR LINCTR=2 STEP 1 UNTIL TABSTOPS DO 
    BEGIN 
    LINNUM1=TABFN(LINCTR);
    IF LINNUM1 NQ 0 THEN
      BEGIN 
      VDTSTS(LINNUM1);
      END 
    ELSE IORET
    END 
  
  IOEND  # COPYTABS # 
  
  
PROC MAKEFET(AFET,NAME,BUFFER,LENGTH);
  BEGIN 
# 
**        MAKEFET - INITIALIZE A FET. 
* 
*         ENTRY  AFET - FET TO BE INITIALIZED.
*                NAME - NAME OF FILE. 
*                BUFFER - THE CIRCULAR BUFFER.
*                LENGTH - LENGTH OF CIRCULAR BUFFER.
* 
*         NOTE   USES THEN RESTORES BASE ADDRESS FOR "FET" ARRAY. 
# 
  ARRAY AFET;;
  ITEM NAME C(7); 
  ARRAY BUFFER;;
  ITEM LENGTH;
  ITEM TMP,TMP2, NEWNAME C(7);
  
  ZEROWD(AFET,FETSIZ);
  TMP=LOC(FET); 
  P<FET>=LOC(AFET); 
  NEWNAME=TRIMNAME(NAME); 
  FETNAM=NEWNAME; 
  FETFIR=LOC(BUFFER); 
  FETIN=FETFIR; 
  FETOUT=FETFIR;
  FETLIM=FETFIR+LENGTH; 
  IF TRIMNAME(NAME) NQ 0 THEN 
   BEGIN
    FETCOD=1; 
    FETL=2; 
   END
  P<FET>=TMP; 
  
  END                          # OF MAKEFET        #
  
  
PROC TTLFN(PARM); 
  IOBEGIN(TTLFN)
# 
**        TTLFN - PRINT OUT A ZERO-TERMINATED NAME. 
* 
*         ENTRY  (PARM) - NAME TO BE PRINTED. 
* 
*         CALLS  TTST.
# 
  ITEM TMP1;
  ITEM PARM;
  TMP1=0; 
  WHYLE C<TMP1,1>PARM NQ 0 AND TMP1 LQ 7 DO TMP1=TMP1+1;
  TTST(PARM,TMP1);
  WHYLE TMP1 LQ 7 DO
    BEGIN                            # WHILE NOT BLANK FILLED # 
    TMP1=TMP1+1;
    TTSTR(" $");
    END 
  IOEND                      # OF TTLFN          #
  
  
CONTROL IFEQ SINGLE,1;
  
  PROC SETCSET(WHICH);
    BEGIN 
# 
**        SETCSET - ISSUE CSET MACRO. 
* 
*         ENTRY  (WHICH) - INDICATES ASCII OR NORMAL. 
* 
*         USES   ORIGIN.
* 
*         CALLS  CSETA, CSETN.
# 
    ITEM WHICH B; 
    IF ORIGIN EQ TXOT THEN
      BEGIN 
      IF WHICH THEN CSETA;
      ELSE CSETN; 
      END 
    END                       # OF SETCSET        # 
  
CONTROL FI; 
PAGE                         # ABORT ROUTINES    #
  
  
PROC FATAL(STR);
  IOBEGIN(FATAL)
# 
**        FATAL - ABORT THE EDITOR WITH MESSAGE.
*         MORTAL - SIMILAR FOR PROBLEMS WITHIN TERMINAL I/O.
* 
*         FATAL IS THE PRINCIPAL ROUTINE TO ABORT AN EDIT SESSION 
*         FOR EITHER AN INTERNAL INCONSISTENCY OR A USER ERROR SO 
*         SEVERE THAT NO MEANINGFUL FUNCTION CAN BE SALVAGED.  TO 
*         PREVENT CIRCULAR (RECURSIVE) SUBROUTINE LINKAGES, THE 
*         WORKIO MODULE IS RESTRICTED TO INTERFACE VIA THE TRAGIC 
*         ROUTINE AND THE TERMIO MODULE IS RESTRICTED TO USE THE
*         MORTAL ENTRY POINT. 
* 
*         ENTRY  STR - THE ABORT MESSAGE. 
* 
*         EXIT   TO ABORT ROUTINE, WITH WORKFILE EVICTED. 
* 
*         USES   LINPTR1, P<FROM>.
* 
*         CALLS  TTSTR, TTLIN, MESSAGE, TTSYNC, VDTCLO, EVICT,
*                CHECKIO, FATALTRAP.
# 
  ITEM STR C(40); 
  ERRSTRING=STR;             # HANDLE PARM REENTRANTLY     #
  CONTROL IFEQ SINGLE,1;
    IF SCREENMODE THEN CLEARSCREEN; 
  CONTROL FI; 
  TTLIN(" FSE INTERNAL ERROR.$"); 
  TTLIN(ERRSTRING); 
  CONTROL IFEQ SINGLE,1;
    GOTO FATAL2;
  CONTROL FI; 
  
ENTRY PROC MORTAL(STR); 
  
  CONTROL IFEQ SINGLE,1;
    ITEM MSGBUF C(40)=0;
    ITEM TMP1;
    ERRSTRING=STR;
FATAL2: 
    FOR TMP1=0 STEP 1 UNTIL 37 DO 
      BEGIN 
      IF C<TMP1,1>STR NQ "$" THEN C<TMP1,1>MSGBUF=C<TMP1,1>STR; 
      ELSE TMP1=38; 
      END 
    MESSAGE(MSGBUF,3,1);
    TTSYNC; 
    VDTCLO(0);
    EVICT(FET,1); 
    ABORT;
  CONTROL FI; 
  CONTROL IFEQ MULTI,1; 
    IF NOT ABORTED THEN 
      BEGIN 
      ABORTED=TRUE; 
      CHECKIO;
      END 
    FATALTRAP;
  CONTROL FI; 
  IOEND                        # OF FATAL          #
  
  
PROC TRAGIC(STR); 
  IOBEGIN(TRAGIC) 
# 
**        TRAGIC - ABORT EDITOR DUE TO WORKFILE PROBLEM.
* 
*         TRAGIC IS USED BY WORKIO FOR SELF-ABORT SITUATIONS. BY
*         SETTING THE "ABORTED" FLAG, WE DIRECT "FATAL" TO IMMEDIATELY
*         EVICT THE WORKFILE WITHOUT FURTHER WORKIO CALLS.
* 
*         ENTRY  STR - ERROR MESSAGE. 
* 
*         EXIT   TO FATAL, WITH "ABORTED" SET.
# 
  ITEM STR C(80); 
  ABORTED=TRUE; 
  FATAL(STR); 
  IOEND                        # OF TRAGIC         #
PAGE                         # SUPPORT ROUTINES FOR INTERNAL CHARSET #
  
  
PROC COPYLIN(LIN1,LIN2);
  BEGIN 
# 
**        COPYLIN - COPY LINE IMAGE, INTERNAL CHARSET.
* 
*         ENTRY  LIN1 IS SOURCE, LIN2 IS TARGET.
# 
  ARRAY LIN1;;  ARRAY LIN2;;
  DUMB=LINESZ(LIN1);         # FIX EOL BITS      #
  DUMB=MOVELN(LIN1,LIN2);    # ACTUAL COPY       #
  END                         # OF COPYLIN        # 
  
  
PROC EXTENDC(TEXTLIN,X);
  BEGIN 
# 
**        EXTENDC - EXTEND INTERNAL LINE IMAGE TO DESIRED LENGTH. 
* 
*         ENTRY  TEXTLIN - TRIMMED LINE IMAGE.
*                X - LENGTH TO BE PADDED TO.
* 
*         MACROS SETCHAR. 
* 
*         CALLS  LENGTH.
# 
  ARRAY TEXTLIN[0:99]; ITEM TEXTLINE; 
  ITEM TMP1, TMP2, X; 
  IF X GQ LENGTH(TEXTLIN) THEN
    BEGIN 
    TMP1=LENGTH(TEXTLIN); 
    FOR TMP2=TMP1 STEP 1 UNTIL X
      DO SETCHAR(TEXTLINE,TMP2,CBLANK); 
    SETCHAR(TEXTLINE,X+1,CENDLINE); 
    END 
  END                         # OF EXTENDC       #
  
  
PROC LSHIFT(TEXTLIN,X,N); 
  BEGIN 
# 
**        LSHIFT - SHIFT INTERNAL LINE IMAGE LEFT.
* 
*         CHARACTER POSITION "X" GOES TO "X-N", X+1 TO X+1-N, ETC.
* 
*         ENTRY  TEXTLIN - INTERNAL LINE IMAGE. 
*                X - FIRST SHIFTABLE POSITION.
*                N - DISTANCE OF SHIFT. 
* 
*         MACROS GETCHAR, SETCHAR.
* 
*         CALLS  LENGTH, EXTENDC. 
# 
  ARRAY TEXTLIN[0:99]; ITEM TEXTLINE; 
  ITEM X,N,NN,I,L,C;
  IF N NQ 0 THEN
    BEGIN 
    EXTENDC(TEXTLIN,X-1); 
    L=LENGTH(TEXTLIN);
    NN=N; 
    IF X LS N THEN NN=X;
    FOR I=X STEP 1 UNTIL L DO 
      BEGIN 
      GETCHAR(TEXTLINE,I,C);
      SETCHAR(TEXTLINE,I-NN,C); 
      END 
    END 
  END                       # OF LSHIFT         # 
  
  
PROC RSHIFT(TEXTLIN,X,N); 
  BEGIN 
  # RSHIFT - RIGHT SHIFT LINE (MOVE X TO X+N, X+1 TO X+1+N, ETC.)  #
# 
**        RSHIFT - RIGHT SHIFT OF INTERNAL LINE IMAGE.
* 
*         RSHIFT MOVES POSITION "X" TO "X+N", "X+1" TO "X+1+N", ETC.
* 
*         ENTRY  SAME CONDITIONS AS LSHIFT ROUTINE. 
* 
*         MACROS GETCHAR, SETCHAR.
* 
*         CALLS  EXTENDC, LENGTH. 
# 
  ARRAY TEXTLIN[0:99]; ITEM TEXTLINE; 
  ITEM X,N,I,L,C; 
  IF N NQ 0 THEN
    BEGIN 
    EXTENDC(TEXTLIN,X-1); 
    L=LENGTH(TEXTLIN);
    EXTENDC(TEXTLIN,X+N); 
    IF L+N GR BUFCHAR THEN
      BEGIN 
      L=BUFCHAR-N;
      SETCHAR(TEXTLINE,L,CENDLINE); 
      END 
    FOR I=L STEP -1 UNTIL X DO
      BEGIN 
      GETCHAR(TEXTLINE,I,C);
      SETCHAR(TEXTLINE,I+N,C);
      END 
    SETCHAR(TEXTLINE,L+N,CENDLINE); 
    END 
  END                       # OF RSHIFT # 
  
  
PROC CONVIN(TEXTLINE,CHARTYPE); 
  BEGIN 
# 
**        CONVIN - CONVERT INPUT LINE TO INTERNAL FORMAT. 
* 
*         ENTRY  TMPLIN - ALREADY CONTAINS NOS-FORMAT LINE IMAGE. 
*                CHARTYPE - CHARACTER SET CONVERSION MODE.
*                           0 = 6 BIT DISPLAY,
*                           1 = 6 BIT DISPLAY,
*                           2 = 6/12 ASCII, 
*                           3 = 8/12 ASCII. 
* 
*         EXIT   TEXTLINE - CONTAINS INTERNAL FORMAT LINE IMAGE.
*                ZEROCOLIN - FORCED TRUE IF AND ONLY IF 6/12 AND
*                    A 00 COLON IS ENCOUNTERED.  OTHERWISE UNCHANGED. 
* 
*         CALLS  FASTCNI, FASTCAI, SLOWC8I. 
# 
  ARRAY TEXTLINE[0:99]; ITEM TEXT;
  ITEM CHARTYPE;
  ITEM TMP1;
  SWITCH CONVINSW CINORM,CINORM,CIASC,CI812;
  
  GOTO CONVINSW[CHARTYPE];
  
CINORM: 
  FASTCNI(TEXTLINE,TMPLIN,BUFWIDE,BUFWIDE2);
  RETURN; 
  
CIASC:  
  TMP1=0; 
  FASTCAI(TEXTLINE,TMPLIN,BUFWIDE,BUFWIDE2,TMP1); 
  IF TMP1 LAN 1 NQ 0 THEN ZEROCOLIN = TRUE; 
  IF TMP1 LAN 2 NQ 0 THEN 
    BEGIN                            # IF UNKNOWN CHARACTER(S) #
    ERRSTRING = "UNKNOWN CHARACTER(S) FOUND - CONVERTED TO @$"; 
    END 
  RETURN; 
  
CI812:  
  SLOWC8I(TEXTLINE,TMPLIN,BUFWIDE,BUFWIDE2);
  RETURN; 
  
  END                          # OF CONVIN        # 
  
  
PROC CONVOUT(TEXTLINE,CHARTYPE);
  BEGIN 
# 
**        CONVOUT - CONVERT INTERNAL LINE IMAGE TO NOS FORMAT.
* 
*         ENTRY  TEXTLINE - INTERNAL LINE IMAGE.
*                CHARTYPE - CHARACTER SET CONVERSION MODE.
*                           0 = 6 BIT DISPLAY,
*                           1 = 6 BIT DISPLAY,
*                           2 = 6/12 ASCII, 
*                           3 = 8/12 ASCII, 
*                           4 = 8/12 ASCII, IGNORE COLON CONVERSION.
*                ZEROCOLOUT - 7404 VERSUS 00 FORMAT FOR COLONS WHEN 
*                    6/12 CHARACTER SET DETECTED. 
* 
*         EXIT   TMPLIN - CONTAINS NOS LINE IMAGE.
* 
*         MACROS GETCHAR, SETCHAR.
* 
*         CALLS  LENGTH, FASTCAO, FASTCNO, NOSWDSZ, SLOWC8O.
# 
  ARRAY TEXTLINE[0:99]; ITEM TEXT;
  ITEM CHARTYPE;
  ITEM TMP1, TMP2, BOOL B;
  SWITCH CONVOUTSW CONORM,CONORM,COASC,CO812,COAINT;
  
  TMP1=LENGTH(TEXTLINE);
  IF TMP1 EQ 0 THEN 
    BEGIN                            # EMPTY LINE IS TWO BLANKS # 
    IF CHARTYPE NQ 3 THEN 
      BEGIN                          # IF DISPLAY OR 6/12 ASCII # 
      TMPLINE[0]=O"5555 0000 0000 0000 0000"; 
      END 
    ELSE
      BEGIN                          # 8/12 ASCII # 
      TMPLINE[0]=O"0040 0040 0000 0000 0000"; 
      END 
    RETURN; 
    END 
  IF CHARTYPE LS 3 THEN              # IF DISPLAY OR STANDARD ASCII # 
    BEGIN 
    GETCHAR(TEXT,TMP1-1,TMP2);
    IF TMP2 EQ CCOLON THEN
      BEGIN                          # TRAILING COLONS NEED A BLANK # 
      SETCHAR(TEXT,TMP1,CBLANK);
      TMP1=TMP1+1;
      SETCHAR(TEXT,TMP1,CENDLINE);
      END 
    END 
  GOTO CONVOUTSW[CHARTYPE]; 
  
COAINT: 
  BOOL = TRUE;                       # FORCE COLONS TO BE 7404B # 
  FASTCAO(TEXTLINE,TMPLIN,BUFWIDE,BUFWIDE2,BOOL); 
  RETURN; 
  
COASC:  
  BOOL=NOT ZEROCOLOUT;
  FASTCAO(TEXTLINE,TMPLIN,BUFWIDE,BUFWIDE2,BOOL); 
  RETURN; 
  
CONORM: 
  FASTCNO(TEXTLINE,TMPLIN,BUFWIDE,BUFWIDE2);
  TMP1=NOSWDSZ(BUFWIDE2,TMPLIN);     # PREVENT 66 BIT END OF LINE # 
  IF TMP1 GR 1 AND TMPLINE[TMP1-1] EQ 0 
    AND TMPLINE[TMP1-2] LAN O"00000000000000007700" NQ 0
    AND TMPLINE[TMP1-2] LAN O"00000000000000000077" EQ 0
    THEN TMPLINE[TMP1-2]=TMPLINE[TMP1-2] LOR O"00000000000000000055"; 
  RETURN; 
  
CO812:  
  SLOWC8O(TEXTLINE,TMPLIN,BUFWIDE,BUFWIDE2);
  RETURN; 
  
  END                          # OF CONVOUT        #
  
  
PROC SLOWC8I(TEXTLIN,BUFLIN,SIZE1,SIZE2); 
  BEGIN 
# 
**        SLOWC8I - CONVERT 8/12 INPUT LINE TO INTERNAL CHARSET.
* 
*         ENTRY  BUFLIN - NOS LINE IMAGE. 
*                SIZE1 - CAPACITY OF TEXTLIN IN WORDS.
*                SIZE2 - CAPACITY OF BUFLIN IN WORDS. 
* 
*         EXIT   TEXTLIN - INTERNAL LINE IMAGE. 
* 
*         MACROS SETCHAR, MOD.
* 
*         NOTE   ALGORITHM SENSITIVE TO INTERNAL FORMAT DEFINITION. 
# 
  ARRAY TEXTLIN [0:99]; ITEM TEXTLINE;
  ARRAY BUFLIN [0:99]; ITEM BUFLINE;
  ITEM SIZE1, SIZE2;
  ITEM TMP1, TMP2;
  
  SETCHAR(TEXTLINE,BUFCM1,CENDLINE);
  TMP1=0; 
  TMP2=CLETTERA;
  WHYLE TMP1/8 LQ SIZE1 AND TMP1/5 LQ SIZE2 AND TMP2 NQ CENDLINE DO 
    BEGIN 
    TMP2=B<MOD(TMP1,5)*12,12>BUFLINE[TMP1/5]; 
    IF TMP2 EQ 0 THEN TMP2=CENDLINE;
    ELSE TMP2=XLTXPINT[TMP2 LAN O"177"];
    SETCHAR(TEXTLINE,TMP1,TMP2);
    TMP1=TMP1+1;
    END 
  END                         # OF SLOWC8I        # 
  
  
PROC SLOWC8O(TEXTLIN,BUFLIN,SIZE1,SIZE2); 
  BEGIN 
# 
**        SLOWC8O - CONVERT INTERNAL LINE IMAGE TO 8/12 FORMAT. 
* 
*         ENTRY  TEXTLIN - INTERNAL LINE IMAGE. 
*                SIZE1, SIZE2 - SIMILAR TO "SLOWC8I" ROUTINE. 
* 
*         EXIT   BUFLIN - 8/12 FORMAT LINE IMAGE. 
* 
*         MACROS SETCHAR, GETCHAR.
* 
*         NOTE   ALGORITHM SENSITIVE TO INTERNAL FORMAT DEFINITION. 
# 
  ARRAY TEXTLIN [0:99]; ITEM TEXTLINE;
  ARRAY BUFLIN [0:99]; ITEM BUFLINE;
  ITEM SIZE1, SIZE2;
  ITEM TMP1, TMP2;
  
  SETCHAR(TEXTLINE,BUFCM1,CENDLINE);
  FOR TMP1=1 STEP 1 UNTIL SIZE2 DO BUFLINE[TMP1-1]=0; 
  TMP1=0; 
  TMP2=1; 
  WHYLE TMP1/8 LQ SIZE1 AND TMP1/5 LQ SIZE2 AND TMP2 NQ 0 DO
    BEGIN 
    GETCHAR(TEXTLINE,TMP1,TMP2);
    IF TMP2 EQ CENDLINE THEN TMP2=0;
    ELSE TMP2=XLTINTXP[TMP2] LAN O"3777"; 
    B<MOD(TMP1,5)*12,12>BUFLINE[TMP1/5]=TMP2; 
    TMP1=TMP1+1;
    END 
  
  END                         # OF SLOWC8O        # 
  
  
PROC GETLNUM; 
  BEGIN 
# 
**        GETLNUM - ANALYZE INTERNAL LINE IMAGE FOR SEQUENCE NUM. 
* 
*         GETLNUM IS USED TO RECOGNIZE A LINE NUMBER ON THE CURRENT 
*         LINE.  WE SET LINENO TO ITS BINARY VALUE.  WE ALSO SET
*         WIDTHFOUND TO THE NUMBER OF DIGITS.  NOTE THAT IF 
*         THERE IS NO NUMBER, WE RETURN WIDTHFOUND=0, LINENO=0. 
* 
*         ENTRY  (LIN) - ALREADY CONTAINS LINE IMAGE. 
* 
*         EXIT   LINENO, WIDTHFOUND ARE SET.
* 
*         MACROS GETCHAR. 
# 
  ITEM QUIT B;
  ITEM TMP2, TMP3;
  
  LINENO=0; 
  WIDTHFOUND=0; 
  QUIT=FALSE; 
  FOR TMP2=0 STEP 1 WHILE TMP2 LS NUMWIDTH AND NOT QUIT DO
    BEGIN 
    GETCHAR(LINE,TMP2,TMP3);
    IF TMP3 GQ CDIGIT0 AND TMP3 LQ CDIGIT9 THEN 
      BEGIN 
      LINENO=LINENO*10 + TMP3-CDIGIT0;
      WIDTHFOUND=WIDTHFOUND+1;
      END 
    ELSE QUIT=TRUE; 
    END 
  
  END                          # OF GETLNUM        #
  
  
PROC SETLNUM; 
  BEGIN 
# 
**        SETLNUM - FORMAT SEQUENCE NUMBER ONTO INTERNAL LINE.
* 
*         SETLNUM ADJUSTS THE WIDTH OF ANY EXISTING SEQUENCE
*         NUMBER, THEN PLACES THE NEW SEQUENCE NUMBER VALUE ON
*         THE LINE. 
* 
*         ENTRY  (LIN) - EXISTING INTERNAL FORMAT LINE IMAGE. 
*                (LINENO) - NEW SEQUENCE VALUE. 
* 
*         EXIT   (LIN) - FIXED UP.
* 
*         MACROS SETCHAR. 
* 
*         CALLS  GETLNUM, LSHIFT, RSHIFT. 
* 
*         NOTES  USES LINENO THEN RESTORES IT.
# 
  ITEM TMP1,TMP2,TMP3;
  
  IF NUMBERED[CURFILE] EQ 0 THEN RETURN;
  TMP2=LINENO;
  GETLNUM;                   # CHECK EXISTING NUMBER DIGITS          #
  LINENO=TMP2;               # RESTORE #
  IF WIDTHFOUND NQ NUMWIDTH THEN
    BEGIN 
    LSHIFT(LIN,WIDTHFOUND,WIDTHFOUND);
    RSHIFT(LIN,0,NUMWIDTH); 
    END 
  FOR TMP1=NUMWIDTH-1 STEP -1 UNTIL 0 DO
    BEGIN 
    TMP3=MOD(TMP2,10)+CDIGIT0;
    SETCHAR(LINE,TMP1,TMP3);
    TMP2=TMP2/10; 
    END 
  IF BLANKS NQ 0 THEN 
    BEGIN 
    GETCHAR(LINE,NUMWIDTH,TMP1);
    IF TMP1 NQ CBLANK THEN RSHIFT(LIN,NUMWIDTH,1);
    SETCHAR(LINE,NUMWIDTH,CBLANK);
    END 
  END                         # OF SETLNUM        # 
  
  
PROC TRIMPAD; 
  BEGIN 
# 
**        TRIMPAD - TRIM OFF TRAILING BLANKS, PAD SEQUENCE. 
* 
*         TRIMPAD TRIMS ALL TRAILING BLANKS FOR A LINE IMAGE IN 
*         THE INTERNAL CHARACTER SET, AND FOR SEQUENCE-NUMBERED 
*         FILES IT ALSO PADS A BLANK ON LINES CONSISTING ONLY OF
*         A SEQUENCE NUMBER.
* 
*         ENTRY  (LIN) - LINE IMAGE TO BE PROCESSED.
*                NUMBERED[CURFILE] - INDICATES SEQUENCE PADDING.
* 
*         EXIT   (LIN) - UPDATED. 
* 
*         MACROS SETCHAR. 
* 
*         CALLS  TRIM, PAD, GETLNUM.
* 
*         USES   WIDTHFOUND.
* 
*         NOTES  USES LINENO THEN RESTORES IT.
# 
  ITEM TMP1;
  IF NUMBERED[CURFILE] NQ 0 THEN
    BEGIN 
    TMP1=LINENO;
    GETLNUM;
    LINENO=TMP1;
    IF LENGTH(LIN) LS WIDTHFOUND+BLANKS THEN PAD(LIN);
    TRIM(LIN,WIDTHFOUND+BLANKS);
    END 
  ELSE SETCHAR(LINE,FASTLNB(LIN),CENDLINE); 
  END                          # OF TRIMPAD # 
  
  
PROC TRIM(ALIN,MINIMUM);
  BEGIN 
# 
**        TRIM - TRIM OFF TRAILING BLANKS.
* 
*         ENTRY  ALIN - LINE IMAGE TO PROCESS.
*                MINIMUM - MINIMUM LENGTH TO RESPECT. 
* 
*         EXIT   ALIN - UPDATED.
* 
*         MACROS SETCHAR. 
* 
*         CALLS  FASTLNB. 
# 
  ARRAY ALIN[0:99]; ITEM ALINE; 
  ITEM MINIMUM; 
  SETCHAR(ALINE,MAX(MINIMUM,FASTLNB(ALIN)),CENDLINE); 
  END                          # OF TRIM #
  
  
PROC PAD(ALIN); 
  BEGIN 
# 
**        PAD - ADD TRAILING BLANKS TO INTERNAL LINE IMAGE. 
* 
*         ENTRY  ALIN - LINE IMAGE TO PROCESS.
* 
*         EXIT   ALIN - PADDED TO MAXIMUM WIDTH.
* 
*         MACROS SETCHAR. 
* 
*         CALLS  LENGTH.
# 
  ARRAY ALIN [0:99]; ITEM ALINE;
  ITEM TMP1,TMP2,TMP3;
  ARRAY CHARMASKS [0:7]; ITEM MASK=[
    O"03777777777777777777",
    O"00017777777777777777",
    O"00000077777777777777",
    O"00000000377777777777",
    O"00000000001777777777",
    O"00000000000007777777",
    O"00000000000000037777",
    O"00000000000000000177"]; 
  TMP2=LENGTH(ALIN);
  TMP3=TMP2/8;
  TMP2=MASK[TMP2 LAN 7];
  ALINE[TMP3]=(ALINE[TMP3] LAN (LNO TMP2)) LOR (ALLBLANKS LAN TMP2);
  FOR TMP1=TMP3+1 STEP 1 UNTIL BUFWID DO ALINE[TMP1]=ALLBLANKS; 
  SETCHAR(ALINE,BUFCHAR,CENDLINE);
  END                         # OF PAD  # 
PAGE                         # BASIC IO ROUTINES #
  
# 
**        WORKIO INTERFACE ROUTINES.
* 
*         THE WORKIO ENTRY POINTS (POS,FWD,BAK,INS,DEL,REP) ALL NEED
*         ADDITIONAL PROCESSING FOR MOST EDITOR OPERATIONS, SO THE
*         EDITOR CONTAINS SEVERAL INTERFACE ROUTINES.  THOSE NAMED
*         WITH "X" APPEAR IN THE SCREEN MODULE AND SYNCHRONIZE THE
*         SCREEN.  "Y" ENTRY POINTS PERFORM SECRET CHANGES WITHOUT
*         FLAGGING EITHER FILE BRACKET AS CHANGED.  "Z" ENTRY POINTS
*         PERFORM POINTER VECTOR RELOCATION AND FLAG THE CURRENT FILE 
*         BRACKET AS CHANGED.  NOTE THAT THE "X" INTERFACES USE "Z".
* 
*         "Z" INTERFACES ALSO PERFORM AUDIT TRAIL MAINTENANCE WHEN
*         THE "UNDO" FACILITY IS ENABLED. "TMPLINE" IS USED FOR THIS. 
* 
*         THUS ALL INTERFACES EXCEPT "Y" REQUIRE "CURFILE" SETUP AS 
*         AN IMPLIED PARAMETER UPON ENTRY.
* 
*         LINEBUF IS A BASED ARRAY WHICH IS POINTED TO THE DESIRED
*         LINE BUFFER FOR WORKIO.  REDEFINITION OF LINEBUF IS 
*         RESTRICTED IN THAT IT MUST POINT TO "LIN" ANY TIME THE
*         MULTI-USER EDITOR CODE REACHES AN INTERNAL SWAP EVENT.  THE 
*         RESULT OF THIS RESTRICTION IS THAT LINEBUF ALMOST ALWAYS
*         IS POINTED AT "LIN", EXCEPT FOR SPECIAL SEQUENCES (AUDIT
*         TRAIL FOR UNDO) WHICH ARE KNOWN TO NOT PERMIT INTERNAL SWAP.
*         ALSO, THE POS ENTRY TO WORKIO WILL NOT COPY TEXT INTO THE 
*         LINE BUFFER IF THE LINE ORDINAL IN NEWCURL IS COMPLEMENTED. 
# 
  
PROC POSZ(PARM);
  IOBEGIN(POSZ) 
  ITEM PARM;
  NEWCURL=PARM; 
  POS;
  IOEND                       # OF POSZ # 
  
  
PROC FWDZ;
  IOBEGIN(FWDZ) 
  FWD;
  IOEND                       # OF FWDZ # 
  
  
PROC BAKZ;
  IOBEGIN(BAKZ) 
  BAK;
  IOEND                       # OF BAKZ # 
  
  
PROC INSZ;
  IOBEGIN(INSZ) 
  AUDITINS;                  # AUDIT INSERTION   #
  CHANGED[CURFILE] = 1 LAN (LNO LOCKED[CURFILE]) ;
  INS;
  RELOCATE(+1); 
  IOEND                       # OF INSZ # 
  
  
PROC DELZ;
  IOBEGIN(DELZ) 
  AUDITDEL;                  # AUDIT DELETION    #
  CHANGED[CURFILE] = 1 LAN (LNO LOCKED[CURFILE]) ;
  DELETEDONE=TRUE;
  RELOCATE(-1); 
  DEL;
  POSZ(CURRENT);
  IOEND                       # OF DELZ           # 
  
  
PROC REPZ;
  IOBEGIN(REPZ) 
  AUDITREP;                  # AUDIT REPLACE     #
  CHANGED[CURFILE] = 1 LAN (LNO LOCKED[CURFILE]) ;
  REP;
  IOEND                       # OF REPZ           # 
  
  
PROC INSY;
  IOBEGIN(INSY) 
  INS;
  RELOCATE(+1); 
  IOEND                       # OF INSY # 
  
  
PROC DELY;
  IOBEGIN(DELY) 
  DELETEDONE=TRUE;
  RELOCATE(-1); 
  DEL;
  POSZ(CURRENT);
  IOEND                       # OF DELY           # 
  
  
PROC REPY;
  IOBEGIN(REPY) 
  REP;
  IOEND                       # OF REPY           # 
  
  
PAGE                         # BASIC ROUTINES FOR POSITION STACK     #
  
  
PROC PUSH;
  BEGIN 
# 
**        PUSH - PUSH CURRENT LINE/FILE ONTO STACK. 
* 
*         ENTRY  CURRENT - LINE POSITION TO SAVE. 
*                CURFILE - FILE ASSOCIATION TO SAVE.
* 
*         EXIT   STACKPTR, REGLINE, STKFILE - UPDATED.
# 
  IF STACKPTR GQ MAXSTACK THEN
    BEGIN 
    FATAL(" FILE POSITION STACK OVERFLOWED.$"); 
    END 
  STACKPTR=STACKPTR+1;
  REGLINE[STACKPTR]=CURRENT;
  STKFILE[STACKPTR]=CURFILE;
  END                         # OF PUSH # 
  
  
PROC POP; 
  IOBEGIN(POP)
# 
**        POP - POP LINE/FILE POSITION FROM STACK.
* 
*         ENTRY  REGLINE, STACKPTR, STKFILE - CONTAIN SAVED POSITION. 
* 
*         EXIT   LIN, CURRENT, CURFILE - RESTORED POSITION/TEXT.
*                STACKPTR - UPDATED.
# 
  IF STACKPTR LS 0 THEN 
    BEGIN 
    FATAL(" FILE POSITION STACK UNDERFLOWED (1).$");
    END 
  POSZ(REGLINE[STACKPTR]);
  CURFILE=STKFILE[STACKPTR];
  STACKPTR=STACKPTR-1;
  IOEND                       # OF POP  # 
  
  
PROC RELOCATE(PARM);
  BEGIN 
  ITEM PARM;
# 
**        RELOCATE - INTERFACE TO UPDATE VECTOR OF RELOCATABLES.
* 
*         ENTRY  PARM - RELOCATION FACTOR.
*                CURRENT - RELOCATION THRESHHOLD. 
* 
*         EXIT   REGSTACK - UPDATED.
* 
*         CALLS  FASTRLC. 
# 
  FASTRLC(REGSTACK,MAXREG+1,CURRENT,PARM);
  END                         # OF RELOCATE       # 
  
  
PAGE                         # AUDIT TRAIL ROUTINES        #
  
  
# 
**        AUDIT TRAIL FACILITY. 
* 
*         AUDIT TRAIL ROUTINES PRESERVE THE CURRENT POSITION AND THE
*         "LIN" BUFFER.  "TMPLIN" IS USED WIDELY. 
* 
*         FOR AN INSERTION, THE AUDIT RECORD IS A SINGLE DESCRIPTOR 
*         LINE WITH "I" TYPE AND THE FLOAT POSITION.
* 
*         FOR A DELETION, WE WRITE THE OLD VERSION OF THE LINE THEN A 
*         DESCRIPTOR WITH "D" TYPE, FILE ID, AND FILE POSITION. 
* 
*         FOR A REPLACEMENT, WE WRITE THE OLD VERSION OF THE LINE AND 
*         AN "R" DESCRIPTOR, FILE ID, AND FILE POSITION.
* 
*         TO CHECK POINT A MAJOR STOPPING POINT, WE WRITE A "C" 
*         DESCRIPTOR.  THIS INCLUDES FILE ID'S FOR BOTH OPEN
*         BRACKETS, AND SPLIT SCREEN DIMENSIONS.
* 
*         TO TERMINATE A SERIES OF MAJOR STOPPING POINTS, WE WRITE
*         A "E" DESCRIPTOR.  THIS HAS NO PARAMETERS ON IT.
* 
*         THIS AUDIT TRAIL FORMAT IS VIABLE ONLY WHEN SCANNED IN
*         REVERSE ORDER, AND WHEN IT IS ASSURED TO REPRESENT ALL
*         CHANGES.  THIS IMPLIES THAT THE "AUDITOFF" FLAG CAN BE SET
*         TO DISABLE THE FACILITY, BUT IN ORDER TO CLEAR THE FLAG AND 
*         RE-ENABLE THE FACILITY, IT IS MANDATORY TO ISSUE AN "END" 
*         DESCRIPTOR AS DESCRIBED IN THE PREVIOUS PARAGRAPH.  THE 
*         UNDO INTERPRETER MUST NOT GO BEYOND THIS POINT. 
* 
*         NOTE THAT ENTRY POINTS AUDITEVENT AND AUDITNUM AND AUDITTEXT
*         ARE USED ONLY BY AUDIT ROUTINES.  ENTRY POINTS AUDITINS,
*         AUDITDEL, AND AUDITREP ARE INTENDED TO BE USED ONLY BY INSZ,
*         DELZ, AND REPZ.  AUDITCHECK AND AUDITSYNCH ARE THE ENTRY
*         POINTS SUITABLE FOR GENERAL USAGE.  AUDITTRAIL IS USED ONLY 
*         BY AUDIT ROUTINES.  AUDITTRAIL AND AUDITSYNCH ARE THE ONLY
*         ROUTINES TO ACTUALLY MANIPULATE THE AUDIT BUFFERING AREA. 
* 
*         ROUTINES WHICH CALL AUDITTRAIL MUST SET UP THE BASE 
*         ADDRESS FOR LINEBUF, AND RESTORE IT.  SUCH ROUTINES 
*         CURRENTLY RESTORE THAT BASE ADDRESS BY ASSUMING THE 
*         CORRECT ADDRESS IS "LIN" RATHER THAN BY ACTUALLY
*         SAVING AND RESTORING.  THUS, WE IMPOSE A GENERAL
*         RESTRICTION THAT ANY EDITOR CODE WHICH CAUSES AUDITABLE 
*         WORKFILE CHANGES MUST USE "LIN" AS THE ADDRESS OF LINEBUF.
* 
*         THE AUDIT TRAIL IS STAGED THRU A DEDICATED MEMORY BUFFER. 
*         AUDITSYNCH PURGES THIS BUFFER INTO THE AUDIT BRACKET OF 
*         THE WORKFILE, SO ANY ROUTINE THAT NEEDS TO ACCESS THE 
*         AUDIT TRAIL (I.E, THE UNDO FACILITY) MUST CALL AUDITSYNCH.
*         THE STAGING AREA PROVIDES PERFORMANCE OPTIMIZATION BY 
*         DEFERRING AND BATCHING WORKFILE ACCESSES. 
* 
*         ALL AUDIT ROUTINES, WHICH ARE ALLOWED TO BE CALLED FROM 
*         OUTSIDE OF OTHER AUDIT ROUTINES, INSPECT THE AUDITOFF 
*         FLAG TO SEE IF THE FACILITY IS DISABLED.  ROUTINES WHICH
*         ARE LOCAL TO THE AUDIT FACILITY DO NOT CHECK THIS FLAG, 
*         BOTH FOR EFFICIENCY AND TO ASSURE THAT STAGED DATA CAN
*         BE HANDLED RIGOROUSLY.
# 
  
  
PROC AUDITINS;
  IOBEGIN(AUDITINS) 
# 
**        AUDITINS - AUDIT INTERFACE FOR INSZ.
* 
*         NOTE   REFER TO FACILITY HEADER.
# 
  IF AUDITOFF THEN IORET
  AUDITEVENT(CLETTERI); 
  IOEND                       # OF AUDITINS       # 
  
  
PROC AUDITDEL;
  IOBEGIN(AUDITDEL) 
# 
**        AUDITDEL - AUDIT INTERFACE FOR DELZ.
* 
*         NOTE   REFER TO FACILITY HEADER.
# 
  IF AUDITOFF THEN IORET
  AUDITTEXT;
  AUDITEVENT(CLETTERD); 
  IOEND                       # OF AUDITDEL       # 
  
  
PROC AUDITREP;
  IOBEGIN(AUDITREP) 
# 
**        AUDITREP - AUDIT INTERFACE FOR REPZ.
* 
*         NOTE   REFER TO FACILITY HEADER.
# 
  IF AUDITOFF THEN IORET
  AUDITTEXT;
  AUDITEVENT(CLETTERR); 
  IOEND                       # OF AUDITREP       # 
  
  
PROC AUDITNUM(POS,NUM); 
  BEGIN 
# 
**        AUDITNUM - FORMAT NUMERIC VALUE INTO AUDIT DESCRIPTOR.
* 
*         ENTRY  NUM, POS - VALUE AND CHARACTER POSITION. 
* 
*         EXIT   TMPLIN - CONTAINS FORMATTED VALUE. 
* 
*         MACROS SETCHAR. 
* 
*         NOTE   REFER TO FACILITY HEADER.
# 
  ITEM POS, NUM, TMP2, TMP3, TMP4;
  TMP2=NUM; 
  FOR TMP3=9 STEP -1 UNTIL 0 DO 
    BEGIN 
    TMP4=CDIGIT0+MOD(TMP2,10);
    TMP2=TMP2/10; 
    SETCHAR(TMPLINE,POS+TMP3,TMP4); 
    END 
  SETCHAR(TMPLINE,POS+10,CBLANK); 
  END                       # OF AUDITNUM       # 
  
  
PROC AUDITEVENT(PARM);
  IOBEGIN(AUDITEVENT) 
# 
**        AUDITEVENT - FORMAT AND TRANSMIT DESCRIPTOR.
* 
*         ENTRY  PARM - TYPE OF DESCRIPTOR. 
* 
*         EXIT   DESCRIPTOR TRANSMITTED TO AUDIT TRAIL. 
* 
*         MACROS SETCHAR. 
* 
*         CALLS  AUDITNUM, AUDITTRAIL.
* 
*         USES   TMPLIN, P<LINEBUF>.
* 
*         NOTE   REFER TO FACILITY HEADER.
# 
  ITEM PARM;
  
  SETCHAR(TMPLINE,0,PARM);
  # END OF PARAMETER USAGE #
  AUDITNUM(1,CURFILE);
  AUDITNUM(12,FDLF(CURFILE)); 
  AUDITNUM(23,CURRENT-TOPF(CURFILE)); 
  SETCHAR(TMPLINE,34,CENDLINE); 
  P<LINEBUF>=LOC(TMPLIN); 
  AUDITTRAIL; 
  P<LINEBUF>=LOC(LIN);
  IOEND                       # OF AUDITEVENT     # 
  
  
PROC AUDITTEXT; 
  IOBEGIN(AUDITTEXT)
# 
**        AUDITTEXT - TRANSMIT TEXT LINE TO AUDIT TRAIL.
* 
*         ENTRY  CURRENT - POINTS TO OLD LINE IMAGE IN WORKFILE.
* 
*         CALLS  POSZ, AUDITTRAIL.
* 
*         USES   TMPLIN, P<LINEBUF>.
* 
*         NOTE   REFER TO FACILITY HEADER.
# 
  P<LINEBUF>=LOC(TMPLIN); 
  POSZ(CURRENT);              # READ OLD VERSION  # 
  AUDITTRAIL; 
  P<LINEBUF>=LOC(LIN);
  IOEND                       # OF AUDITTEXT      # 
  
  
PROC AUDITCHECK;
  IOBEGIN(AUDITCHECK) 
# 
**        AUDITCHECK - ISSUE CHECKPOINT TO AUDIT TRAIL. 
* 
*         ENTRY  AUDITUSED - INDICATES IF ANYTHING AUDITED SINCE
*                    LAST CHECKPOINT. 
* 
*         EXIT   AUDITUSED - CLEAR TO SHOW CHECKPOINT IS MOST 
*                    RECENT AUDIT ENTRY.
* 
*         MACROS SETCHAR. 
* 
*         CALLS  AUDITNUM, AUDITTRAIL.
* 
*         USES   TMPLIN, P<LINEBUF>.
* 
*         NOTE   REFER TO FACILITY HEADER.
# 
  IF AUDITOFF THEN IORET
  IF NOT AUDITUSED THEN IORET 
  SETCHAR(TMPLINE,0,CLETTERC);
  AUDITNUM(1,FDLF(1));
  AUDITNUM(12,FDLF(2)); 
  AUDITNUM(23,NUMROWS[2]);
  SETCHAR(TMPLINE,34,CENDLINE); 
  P<LINEBUF>=LOC(TMPLIN); 
  AUDITTRAIL; 
  P<LINEBUF>=LOC(LIN);
  AUDITUSED=FALSE;
  IOEND                       # OF AUDITCHECK     # 
  
  
PROC AUDITEND;
  IOBEGIN(AUDITEND) 
# 
**        AUDITEND - ISSUE TERMINATOR TO AUDIT TRAIL. 
* 
*         EXIT   AUDITUSED - CLEAR TO SHOW CHECKPOINT IS MOST 
*                    RECENT AUDIT ENTRY.
* 
*         MACROS SETCHAR. 
* 
*         CALLS  AUDITTRAIL.
* 
*         USES   TMPLIN, P<LINEBUF>.
* 
*         NOTE   REFER TO FACILITY HEADER.
# 
  IF AUDITOFF THEN IORET
  SETCHAR(TMPLINE,0,CLETTERE);
  SETCHAR(TMPLINE,1,CENDLINE);
  P<LINEBUF>=LOC(TMPLIN); 
  AUDITTRAIL; 
  P<LINEBUF>=LOC(LIN);
  AUDITUSED=FALSE;
  IOEND                       # OF AUDITEND     # 
  
  
PROC AUDITTRAIL;
  IOBEGIN(AUDITTRAIL);
# 
**        AUDITTRAIL - TRANSMIT LINE IMAGE TO AUDIT TRAIL.
* 
*         ENTRY  P<LINEBUF> - POINTS TO INTERNAL LINE IMAGE.
* 
*         EXIT   LINE IMAGE IS STAGED IN BUFFER.
*                AUDITUSED - SET TO SHOW SOMETHING AUDITED SINCE
*                    MOST RECENT CHECKPOINT.
*                AUDITNEXT - UPDATED. 
* 
*         CALLS  LINESZ, MOVELN, AUDITSYNCH.
* 
*         USES   P<TOO>.
* 
*         NOTE   REFER TO FACILITY HEADER.
# 
  ITEM TMP1;                 # USE INSTANTLY     #
  TMP1=LINESZ(LINEBUF);      # MEASURE TEXT, FIX EOL BITS  #
  IF TMP1 GQ AUDITSIZE-AUDITNEXT THEN AUDITSYNCH;    # ASSURE ROOM   #
  P<TOO>=LOC(AUDITWORD[AUDITNEXT]); 
  AUDITNEXT=AUDITNEXT+MOVELN(LINEBUF,TOO);       # QUEUE THIS RECORD #
  AUDITUSED=TRUE; 
  IOEND                       # OF AUDITTRAIL     # 
  
  
PROC AUDITSYNCH;
  IOBEGIN(AUDITSYNCH);
# 
**        AUDITSYNCH - FLUSH STAGING BUFFER INTO WORKFILE.
* 
*         EXIT   CURA(AUDITCTL), AUDITNEXT - UPDATED. 
* 
*         USES   P<LINEBUF> WITH RESTORATION. 
*                "TEMP" WITH RESTORATION. 
* 
*         CALLS  PUSHTEMP, POPTEMP, PUSH, POP, POSZ, INS, 
*                RELOCATE.
* 
*         NOTE   REFER TO FACILITY HEADER.
*                REQUIRES WORKIO CAPABILITY TO POSITION FILE WITH 
*                NO COPY OF LINE IMAGE. 
# 
  PUSHTEMP; 
  TEMP=LOC(LINEBUF);         # SAVE    #
  PUSHTEMP; 
  PUSH; 
  P<LINEBUF>=0; 
  POSZ(CURA(AUDITCTL));      # INVISIBLY         #
  TEMP=0; 
  WHYLE TEMP LS AUDITNEXT DO
    BEGIN 
    P<LINEBUF>=LOC(AUDITWORD[TEMP]);   # TAKE DIRECTLY FROM QUEUE    #
    TEMP=TEMP+LINESZ(LINEBUF);         # MEASURE, FIX EOL BITS       #
    INS;
    RELOCATE(+1); 
    END 
  CURA(AUDITCTL)=CURRENT; 
  P<LINEBUF>=0; 
  POP;                       # INVISIBLY         #
  POPTEMP;
  P<LINEBUF>=TEMP;           # RESTORE #
  POPTEMP;
  AUDITNEXT=0;
  IOEND                       # OF AUDITSYNCH     # 
PAGE                         # FILE MANAGEMENT   #
  
  
PROC FORMFDL(FILEPARM); 
  BEGIN 
# 
**        FORMFDL - FORMAT FILE DESCRIPTOR LINE.
* 
*         FORMFDL CREATES A FILE DESCRIPTOR LINE BASED ON THE CURRENT 
*         ATTRIBUTES OF A FILE IMAGE WHICH IS ONE OF THE TWO BRACKETED
*         FILES.  THE FORMAT OF THE FDL IS- CHARACTER POSITION 0 =
*         FILE NAME, 8 = YES/NO FOR THE WRITE LOCKOUT, 10 = YES/NO FOR
*         CHANGES MADE, 12 = YES/NO FOR 6/12 ASCII CHARACTER SET, 14 =
*         YES/NO FOR NUMBERED MODE, 16 = SIZE OF FILE, AND 27 = 
*         CURRENT POSITION IN FILE.  IF THIS FORMAT IS TO BE CHANGED, 
*         CODE MUST ALSO BE CHANGED IN THE "GET STATUS" COMMAND AND IN
*         THE SESSION RESUMPTION LOGIC OF FSEMAIN.
* 
*         ENTRY  FILEPARM - WHICH FILE BRACKET TO SUMMARIZE.
* 
*         EXIT   LIN - CONTAINS DESCRIPTOR TEXT.
* 
*         MACROS SETCHAR. 
* 
*         CALLS  FORMNUM(INTERNAL). 
# 
  
  ITEM FILEPARM, TMP1,TMP2,TMP3,TMP4; 
  
  PROC FORMNUM(PARM); 
    BEGIN 
    ITEM PARM;
    TMP4=PARM;
    FOR TMP1=9 STEP -1 UNTIL 0 DO 
      BEGIN 
      C<TMP1,1>TMP3=MOD(TMP4,10)+O"33"; 
      TMP4=TMP4/10; 
      END 
    FOR TMP1=0 STEP 1 UNTIL 9 DO
      BEGIN 
      TMP4=C<TMP1,1>TMP3; 
      TMP4=XLTDSPINT[TMP4]; 
      SETCHAR(LINE,TMP2,TMP4);
      TMP2=TMP2+1;
      END 
    SETCHAR(LINE,TMP2,CBLANK);
    TMP2=TMP2+1;
    END 
  
  
  # START OF FORMFDL #
  
  TMP2=0; 
  FOR TMP1=0 STEP 1 UNTIL 6 DO
    BEGIN 
    C<0,7>TMP3=PADNAME(FILENAM[FILEPARM]);
    TMP3=C<TMP1,1>TMP3; 
    TMP3=XLTDSPINT[TMP3]; 
    SETCHAR(LINE,TMP2,TMP3);
    TMP2=TMP2+1;
    END 
  FOR TMP2=7 STEP 1 UNTIL 15 DO SETCHAR(LINE,TMP2,CBLANK);
  SETCHAR(LINE,8,LOCKED[FILEPARM]+CDIGIT0); 
  SETCHAR(LINE,10,CHANGED[FILEPARM]+CDIGIT0); 
  SETCHAR(LINE,12,ASCII[FILEPARM]+CDIGIT0); 
  SETCHAR(LINE,14,INITNMBR[FILEPARM]+CDIGIT0);
  TMP2=16;
  FORMNUM(BOTF(FILEPARM)-TOPF(FILEPARM)-1); 
  FORMNUM(CURF(FILEPARM)-TOPF(FILEPARM)); 
  SETCHAR(LINE,TMP2,CENDLINE);
  
  END                            # OF FORMFDL     # 
  
  
PROC SCANFDL(NAME); 
  BEGIN 
# 
**        SCANFDL - ANALYZE FILE DESCRIPTOR LINE. 
* 
*         ENTRY  LIN - CONTAINS FDL TEXT. 
* 
*         EXIT   NAME - FILE NAME.
*                SCNFDLOCK, SCNFDCHNG, SCNFDASCI, SCNFDNUMB,
*                SCNFDSIZE, SCNFDCURF - UPDATED.
* 
*         USES   TMPLIN.
*                CMDLIN, SCANPOS, KEYWDTYPE - WITH RESTORATION. 
* 
*         CALLS  COPYLIN, TOKEN.
* 
*         NOTE   CALLER MUST NON-REENTRANTLY USE SCNFDXXXX. 
# 
  ITEM NAME C(7); 
  ITEM HOLDSCAN, HOLDSEARCH;
  
  COPYLIN(CMDLIN,TMPLIN); 
  HOLDSCAN=TOKENPOS;
  HOLDSEARCH=KEYWDTYPE; 
  COPYLIN(LIN,CMDLIN);
  SCANPOS=0;
  KEYWDTYPE=0;
  TOKEN;
  NAME=TOKENSYM;
  KEYWDTYPE=1;
  TOKEN;
  SCNFDLOCK=TOKENVAL; 
  TOKEN;
  SCNFDCHNG=TOKENVAL; 
  TOKEN;
  SCNFDASCI=TOKENVAL; 
  TOKEN;
  SCNFDNUMB=TOKENVAL LAN 1; 
  SCNFDINIT=TOKENVAL/2; 
  TOKEN;
  SCNFDSIZE=TOKENVAL; 
  TOKEN;
  SCNFDCURF=TOKENVAL; 
  
  COPYLIN(TMPLIN,CMDLIN); 
  SCANPOS=HOLDSCAN; 
  KEYWDTYPE=HOLDSEARCH; 
  TOKEN;
  
  END                     #  OF SCANFDL     # 
  
  
PROC OPENFILE;
# TITLE OPENFILE - BRACKET AN INTERNAL FILE IMAGE. #
  
  IOBEGIN(OPENFILE) 
  
# 
**        OPENFILE - BRACKET AN INTERNAL FILE IMAGE.
* 
*         OPENFILE GETS THE REQUESTED FILE INTO ONE OF THE INTERNAL 
*         FILE BRACKETS, BY HOOK OR BY CROOK.  VALUES OF THE
*         CHARPARM AND GETPARM ENTRIES CAN FORCE DISPOSAL OF AN 
*         EXTANT INTERNAL FILE IMAGE WITH A FRESH FILE BUILD. 
*         FOR CASES WHERE ANY INTERNAL IMAGE IS UNACCEPTABLE, THE 
*         RESULTS OF THE FIRST OPENFILE ARE COMPARED WITH THE ENTRY 
*         CONDITIONS, AND OPENFILE MIGHT THEN BE CALLED ONCE MORE.
* 
*         ENTRY  READNAM - FILE NAME. 
*                FILNUM - BRACKET TO OPEN INTO. 
*                CHARPARM - CHARACTER SET PREFERENCE. 
*                GETPARM - PREFERENCE FOR INTERNAL/LOCAL/PERMANENT. 
* 
*         EXIT   DESIRED FILE IS IN BRACKET.  OTHER BRACKET MAY 
*                BE NULLED OUT IF OTHER BRACKET WAS SAME AS THIS
*                BRACKET, AND THE CURRENT BRACKET REQUIRES NULLOUT. 
* 
*         CALLS  ACCESSFILE, FORCEPAINT, POPTEMP, PUSHTEMP. 
* 
*         USES   TEMP WITH RESTORATION. 
# 
  
  PROC FORCEPAINT;
# TITLE FORCEPAINT - FORCE A SCREEN PAINT. #
  
  BEGIN  # FORCEPAINT # 
  
# 
**        FORCEPAINT - FORCE A SCREEN PAINT.
* 
*         PROC FORCEPAINT 
* 
*         ENTRY  FILENAM[1-2] - SETUP.
* 
*         EXIT   SCREEN REPAINTED.
* 
*         CALLS  PAINTSPLIT.
* 
*         USES   CURSPLIT.
# 
  
    ITEM ONE        I=1;             # SPLIT ONE #
    ITEM TWO        I=2;             # SPLIT TWO #
  
    IF SCREENMODE THEN
      BEGIN 
      IF LASTNAME[1] EQ FILENAM[FILNUM] THEN
        BEGIN 
        TITLE1LINE[0]=NULLIN; 
        CURSPLIT = = ONE; 
        PAINTSPLIT; 
        CURSPLIT = = ONE; 
        END 
      IF LASTNAME[2] EQ FILENAM[FILNUM] THEN
        BEGIN 
        TITLE2LINE[0]=NULLIN; 
        CURSPLIT = = TWO; 
        PAINTSPLIT; 
        CURSPLIT = = TWO; 
        END 
      END 
  
    END  # FORCEPAINT # 
  
  
  # MAIN OPENFILE CODE STARTS HERE #
  
  
  CONTROL IFEQ MULTI,1; 
  IF GETPARM GQ 2 THEN GOTO QQSINGLE;  # IF GET/READ WILL BE NEEDED # 
  CONTROL FI; 
  
  ACCESSFILE;                        # ACCESS THE FILE #
  
  CONTROL IFEQ SINGLE,1;
  SCNFDINIT = 0;                     # PRESET NOT INITIAL FILE #
  IF GETPARM GQ 2 THEN               # IF GET OR READ PARAMETER # 
    BEGIN 
    FORCEPAINT; 
    IF FILNUM NQ 0 THEN 
      BEGIN                          # IF FILE IS IN A BRACKET #
      FOR FILNUM=1 STEP 1 UNTIL 2 DO
        BEGIN                        # REMOVE BRACKETS FOR OLD FILE # 
        IF FDLF(FILNUM) EQ FDLF(CURFILE) THEN 
          BEGIN 
          SCNFDINIT == INITFILE[FILNUM];   # CLEAR/SET INITIAL FILE # 
          FILENAM[FILNUM]="ZZZNULL";
          LOCKED[FILNUM]=1; 
          CLOSEFILE;                 # CLOSE OLD FILE # 
          END 
        END 
      FILNUM = 0;                    # INDICATE FILE ACCESS NEEDED #
      END 
    END 
  IF FILNUM EQ 0 THEN 
    BEGIN                            # IF FILE ACCESS NEEDED #
    FILNUM = CURFILE; 
    ADDFILE;                         # ACCESS THE FILE #
    END 
  CONTROL FI; 
  
  IF ASCII[FILNUM] NQ CHARPARM AND CHARPARM NQ 0 THEN 
    BEGIN                            # IF CHARACTER SET CHANGED # 
    FORCEPAINT; 
    PUSHTEMP; 
    FOR TEMP = 1 STEP 1 UNTIL 2 DO   # IF SPLIT IS USED THEN RESET #
      BEGIN 
      IF FDLF(TEMP) EQ FDLF(FILNUM) THEN ASCII[TEMP]=CHARPARM;
      END 
    POPTEMP;
    END 
  
  IOEND  # OPENFILE # 
  
  
PROC ACCESSFILE;
  IOBEGIN(ACCESSFILE) 
# 
**        ACCESSFILE - ACCESS A FILE. 
* 
*        ACCESSFILE ATTEMPTS TO LOGICALLY OPEN A FILE BY IDENTIFYING
*        IT AS ALREADY OPEN IN ONE OR BOTH FILE BRACKETS, OR AS 
*        AVAILABLE FOR QUICK OPEN FROM THE FILE DIRECTORY LINES.  IF
*        THESE METHODS FAIL, THE MULTI-USER EDITOR PASSES CONTROL TO
*        THE SINGLE-USER EDITOR VIA *QQSINGLE*, WHEREUPON THE SINGLE- 
*        USER EDITOR WILL WORK IT-S WAY TO THIS POINT BY REPROCESSING 
*        THE SAME COMMAND.  THE SINGLE-USER EDITOR NOTES THAT THE FILE
*        WAS NOT FOUND BY ZEROING THE FILE NUMBER.  *OPENFILE* WILL 
*        RECOGNIZE THAT AS AN INDICATION THAT *ADDFILE* MUST BE CALLED
*        TO GET AND/OR READ THE FILE. 
* 
*         ENTRY  SEE OPENFILE.
* 
*         EXIT   IF FILE FOUND, ALL FILE BRACKET STRUCTURES UPDATED.
*                IF NOT, MULTI-USER EDITOR EXITS TO SINGLE-USER EDITOR, 
*                        SINGLE-USER RETURNS ZERO IN FILNUM.
* 
*         CALLS  ADDFILE, CLOSEFILE, NOPOP, PADNAME, POP, POPTEMP,
*                POSZ, PUSH, PUSHTEMP, QQSINGLE, SCANFDL. 
# 
  ITEM NAME1 C(7), NAME2 C(7);  # USE INSTANTLY # 
  
  CURFILE=FILNUM; 
  
  NAME1=PADNAME(READNAM); 
  NAME2=PADNAME(FILENAM[FILNUM]); 
  IF NAME2 NQ " " AND NAME1 NQ NAME2 THEN CLOSEFILE;
  
  PUSHTEMP; 
  FOR TEMP=1 STEP 1 UNTIL 2 DO
    BEGIN 
    NAME1=PADNAME(READNAM);  # RECOMPUTE SINCE REENTERED   #
    NAME2=PADNAME(FILENAM[TEMP]); 
    IF NAME1 EQ NAME2 THEN
      BEGIN 
      IF TEMP NQ FILNUM THEN
        BEGIN 
        FILEATTR[FILNUM] = FILEATTR[TEMP];
        TOPF(FILNUM) = TOPF(TEMP);
        BOTF(FILNUM) = BOTF(TEMP);
        CURF(FILNUM) = CURF(TEMP);
        FDLF(FILNUM) = FDLF(TEMP);
        END 
      POSZ(CURF(FILNUM)); 
      POPTEMP;
      IORET 
      END 
    END 
  POPTEMP;
  
  FILNUM=FILNUM LXR 3;       # REVERSE VALUE #
  NAME1=PADNAME(FILENAM[FILNUM]); 
  IF NAME1 NQ " " THEN CLOSEFILE;      # ASSURES FDL UP TO DATE # 
  FILNUM=FILNUM LXR 3;       # RESTORE VALUE #
  
  PUSH; 
  POSZ(TOPC(FILECTL)+1);
  LINENO=BOTC(FILECTL); 
  WHYLE CURRENT LS BOTC(FILECTL) DO 
    BEGIN 
    # ONCE SCANFDL IS CALLED MUST USE RESULTS INSTANTLY # 
    SCANFDL(NAME2); 
    NAME1=PADNAME(READNAM);  # RECOMPUTE SINCE REENTERED   #
    IF NAME2 EQ NAME1 THEN
      BEGIN 
      FILENAM[FILNUM]=TRIMNAME(NAME2);
      INITFILE[FILNUM]=SCNFDINIT; 
      LOCKED[FILNUM]=SCNFDLOCK; 
      CHANGED[FILNUM]=SCNFDCHNG;
      ASCII[FILNUM]=SCNFDASCI;
      NUMBERED[FILNUM]=SCNFDNUMB; 
      TOPF(FILNUM)=LINENO;
      BOTF(FILNUM)=LINENO+1+SCNFDSIZE;
      CURF(FILNUM)=TOPF(FILNUM)+SCNFDCURF;
      FDLF(FILNUM)=CURRENT; 
      POSZ(CURF(FILNUM)); 
      NOPOP;
      IORET 
      END 
    LINENO=LINENO+1+SCNFDSIZE;
    # END OF INSTANTANEOUS COMPUTATION #
    FWDZ; 
    END 
  POP;
  
  CONTROL IFEQ SINGLE,1;
  FILNUM = 0;                        # INDICATE FILE ACCESS NEEDED #
  CONTROL FI; 
  CONTROL IFEQ MULTI,1; 
  GOTO QQSINGLE;                     # EXIT TO SINGLE-USER EDITOR # 
  CONTROL FI; 
  
 IOEND                        # OF ACCESSFILE     # 
  
  
PROC CLOSEFILE; 
  IOBEGIN(CLOSEFILE)
# 
**        CLOSEFILE - SAVE CURRENT FILE STATUS IN DESCRIPTOR LINE.
* 
*         ENTRY  FILNUM - BRACKET TO CLOSE. 
*                ALL BRACKET STRUCTURES CONTAIN VALID STATUS. 
* 
*         EXIT   FILE DESCRIPTOR LINE UPDATED INTO FILE DIRECTORY.
* 
*         CALLS  PUSH, POP, POSZ, REPY, FORMFDL.
* 
*         NOTE   IF BOTH BRACKETS OPEN TO SAME FILE, CERTAIN
*                ATTRIBUTES MUST BE MERGED. 
# 
  PUSH; 
  POSZ(FDLF(FILNUM)); 
  IF FDLF(1) EQ FDLF(2) THEN
    BEGIN 
    INITFILE[1]=INITFILE[1] LOR INITFILE[2];
    LOCKED[1]=LOCKED[1] LOR LOCKED[2];
    CHANGED[1]=CHANGED[1] LOR CHANGED[2]; 
    INITFILE[2]=INITFILE[1];
    LOCKED[2]=LOCKED[1];
    CHANGED[2]=CHANGED[1];
    END 
  FORMFDL(FILNUM);
  REPY; 
  PUSHTEMP; 
  IF FILENAM[FILNUM] NQ "ZZZNULL" THEN
    BEGIN 
    FOR TEMP=2 STEP 1 UNTIL 4 DO
      BEGIN 
      NONTRIVFILE[FILNUM,TEMP]=NONTRIVFILE[FILNUM,TEMP-1];
      END 
    NONTRIVFILE[FILNUM,1]=FDLF(FILNUM); 
    END 
  ELSE
    BEGIN 
    FOR TEMP=1 STEP 1 UNTIL 4 DO
      BEGIN 
      IF NONTRIVFILE[1,TEMP] EQ FDLF(FILNUM)
        THEN NONTRIVFILE[1,TEMP]=0; 
      IF NONTRIVFILE[2,TEMP] EQ FDLF(FILNUM)
        THEN NONTRIVFILE[2,TEMP]=0; 
      END 
    END 
  POPTEMP;
  POP;
  
  IOEND                         # OF CLOSEFILE   #
PAGE                         # MISC IO ROUTINES  #
  
  
PROC GETCMD;
  IOBEGIN(GETCMD) 
# 
**        GETCMD - READ COMMAND STRING FROM TERMINAL. 
* 
*         EXIT   CMDLIN - TERMINAL INPUT LINE, CONVERTED TO 
*                    INTERNAL CHARSET FROM 6/12 ASCII.
* 
*         CALLS  PROMPT, CONVIN.
* 
*         NOTE   SHOULD BE USED ONLY IN LINE-EDITING. 
# 
  PROMPT(QCCKWRD);
  CONVIN(CMDLIN,2); 
  IOEND                        # OF GETCMD         #
  
  
PROC PROMPT(STR); 
  IOBEGIN(PROMPT) 
# 
**        PROMPT - ISSUE PROMPT TO TERMINAL AND INPUT LINE. 
* 
*         ENTRY  STR - PROMPT STRING, 6/12 ASCII CHARSET. 
* 
*         EXIT   TMPLIN - INPUT FROM TERMINAL.
* 
*         CALLS  TTLIN, TTSYNC, VDTRDC, VDTDRN$.
* 
*         NOTE   SHOULD BE USED ONLY IN LINE-EDITING. 
# 
  ITEM STR C(10); 
  CONTROL IFEQ SINGLE,1;
    IF INTERACT THEN TTLIN(STR);
    ELSE TTLIN(NULLWRD);
  CONTROL FI; 
  CONTROL IFEQ MULTI,1; 
    TTLIN(STR); 
  CONTROL FI; 
  TTSYNC; 
  VDTRDC(TMPLIN,BUFWID2P1); 
  IOEND                       # OF PROMPT         # 
  
  
PROC DOJOIN(SETJUMP); 
  IOBEGIN(DOJOIN) 
# 
**        DOJOIN - MERGE TWO ADJACENT WORKFILE LINES. 
* 
*         ENTRY  CURRENT - POINTS AT FIRST WORKFILE LINE. 
*                CHRPTR3 - CHARACTER POSITION TO MERGE AT.
*                SETJUMP - IF NONZERO, REMOVE LEADING SPACES ON SECOND
*                          LINE TO BE JOINED IF AUTOINDENTING.
*                NUMBERED[CURFILE] - INDICATES SEQUENCE MODE. 
* 
*         EXIT   LIN - COPY OF WHAT IS MERGED IN FILE.
* 
*         MACROS GETCHAR, SETCHAR.
* 
*         CALLS  BAKZ, CONCAT, COPYLIN, DELX, EXTENDC, FWDZ, LSHIFT,
*                POP, POPTEMP, PUSH, PUSHTEMP, REPX, TRIMPAD. 
* 
*         USES   TTYLIN.
# 
  ITEM SETJUMP; 
  ITEM TMP1, TMP2;           # USE INSTANTLY      # 
  
  IF CURRENT LS BOTF(CURFILE)-1 THEN # CAN DO IT         #
    BEGIN 
    PUSHTEMP; 
    IF AUTOINDENT THEN TEMP = SETJUMP; ELSE TEMP = 0; 
    # END OF NON-REENTRANT PARAMETER USAGE #
    FWDZ;                    # READ SECOND HALF  #
    IF EDITFIELD LS LENGTH(LIN) THEN
      BEGIN 
      SETCHAR(LINE,EDITFIELD,CENDLINE);  # KILL PROTECTED    #
      TRIMPAD;
      END 
    TMP1 = 0; 
    IF TEMP NQ 0 THEN 
      BEGIN                  # IF HONORING *SET JUMP YES* # 
      GETCHAR(LINE,TMP1,TMP2);
      WHYLE TMP2 EQ CBLANK DO      # COUNT LEADING BLANKS # 
        BEGIN 
        TMP1 = TMP1 + 1;
        GETCHAR(LINE,TMP1,TMP2);
        END 
      TMP1 = MAX(0,TMP1-1); 
      TEMP = 1; 
      END 
    IF NUMBERED[CURFILE] NQ 0 THEN TMP1 = TMP1 + NUMWIDBLK; 
    IF TMP1 GR 0 THEN LSHIFT(LIN,TMP1,TMP1);
    IF NUMMARKS GR 0 THEN 
      BEGIN                  # IF MARKS ACTIVE #
      IF REGLINE[MARKREG] EQ CURRENT THEN 
        BEGIN                # IF FIRST MARKED LINE # 
        IF MRKCHAR[0] GQ 0 THEN 
          BEGIN              # IF MARK WORD ACTIVE #
          TEMP = TEMP LOR 2;
          MRKCHAR[0] = MAX(0, MRKCHAR[0]-TMP1); 
          END 
        END 
      IF REGLINE[MARKREG+1] EQ CURRENT THEN 
        BEGIN                # IF LAST MARKED LINE #
        IF MRKCHAR[1] GQ 0 THEN 
          BEGIN              # IF MARK WORD ACTIVE #
          TEMP = TEMP LOR 4;
          MRKCHAR[1] = MAX(-1, MRKCHAR[1]-TMP1);
          END 
        END 
      END 
    COPYLIN(LIN,TTYLIN);
    BAKZ;                    # REPOSITION AND READ LIN     #
    IF EDITFIELD LS LENGTH(LIN) THEN
      BEGIN 
      SETCHAR(LINE,EDITFIELD,CENDLINE);  # KILL PROTECTED    #
      TRIMPAD;
      END 
    IF CHRPTR3 GQ LENGTH(LIN) THEN
      BEGIN                  # IF CURSOR IS BEYOND END OF LINE #
      IF TEMP LAN 1 NQ 0 THEN 
        BEGIN                # IF HONORING *SET JUMP YES* # 
        GETCHAR(TTYLINE,0,TMP2);   # CHECK FOR LEADING BLANK #
        IF TMP2 EQ CBLANK THEN
          BEGIN              # IF THERE IS A LEADING BLANK #
          LSHIFT(TTYLIN,1,1); 
          IF TEMP LAN 2 NQ 0 AND MRKCHAR[0] GR 0 THEN 
            MRKCHAR[0] = MRKCHAR[0] - 1;
          IF TEMP LAN 4 NQ 0 AND MRKCHAR[1] GQ 0 THEN 
            MRKCHAR[1] = MRKCHAR[1] - 1;
          END 
        END 
      EXTENDC(LIN,CHRPTR3-1);      # LENGTHEN TO CURSOR POSITION #
      END 
    IF TEMP LAN 2 NQ 0 THEN 
      BEGIN                  # IF FIRST MARK ADJUSTMENT # 
      REGLINE[MARKREG] = CURRENT; 
      MRKCHAR[0] = MRKCHAR[0] + LENGTH(LIN);
      END 
    IF TEMP LAN 4 NQ 0 THEN 
      BEGIN                  # IF LAST MARK ADJUSTMENT #
      REGLINE[MARKREG+1] = CURRENT; 
      MRKCHAR[1] = MRKCHAR[1] + LENGTH(LIN);
      IF MRKCHAR[1] LS 0 THEN 
        BEGIN                # IF NO PLACE TO PUT MARK #
        MRKCHAR[1] = 0; 
        RSHIFT(TTYLIN,0,1); 
        SETCHAR(TTYLINE,0,CBLANK);
        END 
      END 
    CONCAT(LIN,TTYLIN); 
    SETCHAR(LINE,EDITFIELD,CENDLINE);  # CLEAR END OF LINE #
    TRIMPAD;
    REPX;                    # STORE CONCATENATED LINES    #
    PUSH; 
    FWDZ;                    # DELETE SECOND HALF          #
    DELX; 
    POP;                     # LEAVE POSITION AT JOINED    #
    POPTEMP;
    END 
  IOEND                       # OF DOJOIN         # 
  
  
PROC DOSPLIT(TRUNCATE); 
  IOBEGIN(DOSPLIT)
# 
**        DOSPLIT - SPLIT A WORKFILE LINE INTO TWO. 
* 
*         ENTRY  LIN - THE LINE TO SPLIT. 
*                TRUNCATE - IF 1, TRIM TRAILING BLANKS FROM BOTH LINES. 
*                           IF 2, TRIM TRAILING BLANKS FROM BOTH LINES, 
*                                 AND ADD LEADING BLANKS TO SECOND LINE 
*                                 TO MATCH FIRST LINE IF AUTOINDENTING. 
*                CURRENT - FILE POSITION. 
*                CHRPTR3 - CHARACTER POSITION.
*                NUMBERED[CURFILE] - INDICATES SEQUENCE MODE. 
* 
*         EXIT   LIN, CURRENT - UPDATED.
*                WORKFILE CHANGED.
* 
*         MACROS GETCHAR, SETCHAR.
* 
*         CALLS  COPYLIN, INSX, POPTEMP, PUSHTEMP,
*                REPX, RSHIFT, TRIMPAD. 
* 
*         USES   TTYLIN.
# 
  ITEM TRUNCATE;
  ITEM TMP1, TMP2;           # USE INSTANTLY     #
  
  PUSHTEMP; 
  TEMP=TRUNCATE;
  # END OF NON-REENTRANT PARAMETER USAGE #
  TTYLINE[0]=NULLIN;         # DEFAULT NEW LINE  #
  IF EDITFIELD LS LENGTH(LIN) THEN
    BEGIN 
    SETCHAR(LINE,EDITFIELD,CENDLINE);    # KILL PROTECTED    #
    TRIMPAD;
    END 
  FOR TMP1=CHRPTR3 STEP 1 UNTIL LENGTH(LIN) DO
    BEGIN                     # COPY SECOND HALF  # 
    GETCHAR(LINE,TMP1,TMP2);
    SETCHAR(TTYLINE,TMP1-CHRPTR3,TMP2); 
    END 
  SETCHAR(LINE,CHRPTR3,CENDLINE); 
  IF TEMP GR 0 THEN TRIMPAD;
  REPX;                      # STORE FIRST HALF  #
  TMP1 = 0; 
  IF AUTOINDENT AND TEMP EQ 2 THEN
    BEGIN                    # IF HONORING *SET JUMP YES* # 
    GETCHAR(LINE,TMP1,TMP2);
    WHYLE TMP2 EQ CBLANK DO  # COUNT LEADING BLANKS # 
      BEGIN 
      TMP1 = TMP1 + 1;
      GETCHAR(LINE,TMP1,TMP2);
      END 
    END 
  COPYLIN(TTYLIN,LIN);
  IF NUMBERED[CURFILE] NQ 0 THEN TMP1 = TMP1 + NUMWIDBLK; 
  IF TMP1 GR 0 THEN 
    BEGIN                    # IF LEADING BLANKS REQUIRED # 
    RSHIFT(LIN,0,TMP1); 
    FOR TMP2=0 STEP 1 UNTIL TMP1-1 DO SETCHAR(LINE,TMP2,CBLANK);
    END 
  IF TEMP GR 0 THEN TRIMPAD;
  IF NUMMARKS EQ 0
    THEN INSX;               # IF NO MARKS ACTIVE # 
  ELSE
    BEGIN                    # IF MARKS ACTIVE #
    TEMP = TMP1;
    INSX; 
    IF REGLINE[MARKREG] EQ CURRENT-1 THEN 
      BEGIN                  # IF SPLIT OF FIRST MARKED LINE #
      IF MRKCHAR[0] GQ CHRPTR3 THEN 
        BEGIN                # IF SPLIT LEFT OF FIRST MARK #
        REGLINE[MARKREG] = CURRENT; 
        MRKCHAR[0] = MRKCHAR[0] - CHRPTR3 + TEMP; 
        END 
      END 
    IF REGLINE[MARKREG+1] EQ CURRENT-1 THEN 
      BEGIN                  # IF SPLIT OF LAST MARKED LINE # 
      IF MRKCHAR[1] LS 0 THEN REGLINE[MARKREG+1] = CURRENT; 
      ELSE IF MRKCHAR[1] GQ CHRPTR3 THEN
        BEGIN                # IF SPLIT LEFT OF LAST MARK # 
        REGLINE[MARKREG+1] = CURRENT; 
        MRKCHAR[1] = MRKCHAR[1] - CHRPTR3 + TEMP; 
        END 
      END 
    END 
  POPTEMP;
  
  IOEND                       # OF DOSPLIT        # 
PAGE                                 # KEYWORD MATCHER #
  
  
PROC MATCHKEY(PARM);
  BEGIN 
# 
*         MATCHKEY - MATCH KEYWORD BY ABBREVIATION RULES. 
* 
*         MATCHKEY MATCHES THE KEYWORD IN TOKENSYM AGAINST THE
*         KEYWORD TABLE, FOR A SPECIFIED SECTION OF THE TABLE,
*         AND HONORING THE ABBREVIATION RULES OF ALL CHARACTERS,
*         THREE CHARACTERS, OR ONE CHARACTER. 
* 
*         ENTRY  KEYWDTYPE - WHICH SECTION OF TABLE TO SEARCH.
*                TOKENSYM - KEYWORD TO MATCH. 
*                TOKENLEN - LENGTH OF KEYWORD.
* 
*         EXIT   PARM - LENGTH OF ACCEPTED ABBREVIATION.
*                KEYWDNDX - WHERE MATCHED IN TABLE. 
# 
  ITEM PARM;
  ITEM TMP1;
  
  FOR PARM=TOKENLEN STEP -1 UNTIL 4 DO
    BEGIN 
    FOR TMP1=FIRSTKEYWD[KEYWDTYPE] STEP 1 
      UNTIL LASTKEYWD[KEYWDTYPE] DO 
      BEGIN 
      IF C<0,PARM>TOKENSYM EQ KEYWORD[TMP1] THEN GOTO KEYFOUND; 
      END 
    END 
  
  PARM=3; 
  FOR TMP1=FIRSTKEYWD[KEYWDTYPE] STEP 1 
    UNTIL LASTKEYWD[KEYWDTYPE] DO 
    BEGIN 
    IF C<0,3>TOKENSYM EQ C<0,3>KEYWORD[TMP1] THEN GOTO KEYFOUND;
    END 
  
  PARM=2; 
  FOR TMP1=FIRSTKEYWD[KEYWDTYPE] STEP 1 
    UNTIL LASTKEYWD[KEYWDTYPE] DO 
    BEGIN 
    IF C<0,2>TOKENSYM EQ C<0,2>KEYWORD[TMP1]
      AND C<2,1>KEYWORD[TMP1] EQ " " THEN GOTO KEYFOUND;
    END 
  
  PARM=1; 
  FOR TMP1=FIRSTKEYWD[KEYWDTYPE] STEP 1 
    UNTIL LASTKEYWD[KEYWDTYPE] DO 
    BEGIN 
    IF C<0,1>TOKENSYM EQ C<0,1>KEYWORD[TMP1] THEN GOTO KEYFOUND;
    END 
  
  RETURN; 
  
KEYFOUND: 
  KEYWDNDX=TMP1;
  
  END                                # OF MATCHKEY #
  
  
END TERM
