cdc:nos2.source:opl871:fsesubs
Table of Contents
FSESUBS
Table Of Contents
- [00006] - SUBROUTINES OF FULL SCREEN EDITOR.
- [00103] TRIMNAME - CONVERT TRAILING BLANKS TO ZEROS.
- [00122] PADNAME - CONVERT TRAILING ZEROS TO BLANKS.
- [00141] MIN - COMPUTE LESSER OF TWO VALUES.
- [00155] MAX - COMPUTE GREATER OF TWO VALUES.
- [00170] PUSHTEMP - PRESERVE VALUE ON MISCELLANEOUS STACK.
- [00189] POPTEMP - RETREIVE VALUE FROM MISCELLANEOUS STACK.
- [00206] STARTCMD - INITIALIZE SYNTAX SCANNER FOR NEW COMMANDS.
- [00226] TABFN - COMPUTE TAB COLUMN BY ORDINAL.
- [00248] COPYTABS - COPY/CONVERT TABS, TABVECTOR→VIRTERM.
- [00278] MAKEFET - INITIALIZE A FET.
- [00315] TTLFN - PRINT OUT A ZERO-TERMINATED NAME.
- [00339] SETCSET - ISSUE CSET MACRO.
- [00362] FATAL - ABORT THE EDITOR WITH MESSAGE.
- [00425] TRAGIC - ABORT EDITOR DUE TO WORKFILE PROBLEM.
- [00445] COPYLIN - COPY LINE IMAGE, INTERNAL CHARSET.
- [00458] EXTENDC - EXTEND INTERNAL LINE IMAGE TO DESIRED LENGTH.
- [00482] LSHIFT - SHIFT INTERNAL LINE IMAGE LEFT.
- [00515] RSHIFT - RIGHT SHIFT OF INTERNAL LINE IMAGE.
- [00550] CONVIN - CONVERT INPUT LINE TO INTERNAL FORMAT.
- [00596] CONVOUT - CONVERT INTERNAL LINE IMAGE TO NOS FORMAT.
- [00673] SLOWC8I - CONVERT 8/12 INPUT LINE TO INTERNAL CHARSET.
- [00707] SLOWC8O - CONVERT INTERNAL LINE IMAGE TO 8/12 FORMAT.
- [00742] GETLNUM - ANALYZE INTERNAL LINE IMAGE FOR SEQUENCE NUM.
- [00778] SETLNUM - FORMAT SEQUENCE NUMBER ONTO INTERNAL LINE.
- [00824] TRIMPAD - TRIM OFF TRAILING BLANKS, PAD SEQUENCE.
- [00860] TRIM - TRIM OFF TRAILING BLANKS.
- [00880] PAD - ADD TRAILING BLANKS TO INTERNAL LINE IMAGE.
- [01015] PUSH - PUSH CURRENT LINE/FILE ONTO STACK.
- [01035] POP - POP LINE/FILE POSITION FROM STACK.
- [01056] RELOCATE - INTERFACE TO UPDATE VECTOR OF RELOCATABLES.
- [01137] AUDITINS - AUDIT INTERFACE FOR INSZ.
- [01149] AUDITDEL - AUDIT INTERFACE FOR DELZ.
- [01162] AUDITREP - AUDIT INTERFACE FOR REPZ.
- [01175] AUDITNUM - FORMAT NUMERIC VALUE INTO AUDIT DESCRIPTOR.
- [01200] AUDITEVENT - FORMAT AND TRANSMIT DESCRIPTOR.
- [01231] AUDITTEXT - TRANSMIT TEXT LINE TO AUDIT TRAIL.
- [01251] AUDITCHECK - ISSUE CHECKPOINT TO AUDIT TRAIL.
- [01284] AUDITEND - ISSUE TERMINATOR TO AUDIT TRAIL.
- [01310] AUDITTRAIL - TRANSMIT LINE IMAGE TO AUDIT TRAIL.
- [01337] AUDITSYNCH - FLUSH STAGING BUFFER INTO WORKFILE.
- [01379] FORMFDL - FORMAT FILE DESCRIPTOR LINE.
- [01450] SCANFDL - ANALYZE FILE DESCRIPTOR LINE.
- [01505] OPENFILE - BRACKET AN INTERNAL FILE IMAGE.
- [01535] FORCEPAINT - FORCE A SCREEN PAINT.
- [01625] ACCESSFILE - ACCESS A FILE.
- [01725] CLOSEFILE - SAVE CURRENT FILE STATUS IN DESCRIPTOR LINE.
- [01779] GETCMD - READ COMMAND STRING FROM TERMINAL.
- [01796] PROMPT - ISSUE PROMPT TO TERMINAL AND INPUT LINE.
- [01822] DOJOIN - MERGE TWO ADJACENT WORKFILE LINES.
- [01941] DOSPLIT - SPLIT A WORKFILE LINE INTO TWO.
Source Code
- FSESUBS.txt
- 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
cdc/nos2.source/opl871/fsesubs.txt · Last modified: 2023/08/05 17:24 by Site Administrator