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