!
%SYSTEMROUTINESPEC CHANGEFILESIZE(%STRING(31) FILE, %INTEGER NEWSIZE,
%INTEGERNAME FLAG)
%SYSTEMROUTINESPEC UCTRANSLATE(%INTEGER ADDR,L)
%CONSTSTRING(1) SNL = "
"
%ROUTINE MOVE(%INTEGER LENGTH,FROM,TO)
*LB_LENGTH
*JAT_14,<L99>
*LDTB_X'18000000'
*LDB_ %B
*LDA_FROM
*CYD_0
*LDA_TO
*MV_ %L= %DR
L99:%END; !OF MOVE
%EXTERNALROUTINESPEC PROMPT(%STRING(15) S)
%EXTERNALSTRINGFNSPEC INTERRUPT
%SYSTEMROUTINESPEC TOJOURNAL(%INTEGER FROM,LEN)
%RECORDFORMAT FRF(%INTEGER CONAD,FILETYPE,DATASTART,DATEND,SIZE,RUP,EEP,MODE,
USERS,ARCH, %STRING(6) TRAN, %STRING(8) DATE,TIME, %INTEGER COUNT,SPARE1,
SPARE2)
%RECORDFORMAT RF(%INTEGER CONAD,FILETYPE,DATASTART,DATAEND)
%SYSTEMROUTINESPEC FINFO(%STRING(31) FILE, %INTEGER MODE,
%RECORD(FRF) %NAME R, %INTEGERNAME FLAG)
%SYSTEMROUTINESPEC REROUTECONTINGENCY(%INTEGER EP,CLASS, %LONGINTEGER MASK,
%ROUTINE CLOSE(%INTEGER A,B), %INTEGERNAME FLAG)
%SYSTEMROUTINESPEC SIGNAL(%INTEGER EP,CLASS,SUBCLASS, %INTEGERNAME FLAG)
%EXTERNALROUTINESPEC CHERISH(%STRING(255) NAME)
%EXTERNALSTRINGFNSPEC UINFS(%INTEGER N)
%SYSTEMROUTINESPEC GETJOURNAL(%STRINGNAME FILE, %INTEGERNAME FLAG)
%SYSTEMROUTINESPEC SENDFILE(%STRING(31) FILE, %STRING(16) DEVICE,
%STRING(24) NAME, %INTEGER COPIES,FORMS, %INTEGERNAME FLAG)
%SYSTEMROUTINESPEC DESTROY(%STRING(31) FILE, %INTEGERNAME FLAG)
!%SYSTEMROUTINESPEC CLEARUSE(%STRING(31) S,%INTEGERNAME FLAG)
%SYSTEMROUTINESPEC SETUSE(%STRING (31) FILE, %INTEGER MODE, VALUE)
%SYSTEMROUTINESPEC DISCONNECT(%STRING(31) S, %INTEGERNAME FLAG)
%SYSTEMROUTINESPEC RENAME(%STRING(31) OLDN,NEWN, %INTEGERNAME FLAG)
%SYSTEMROUTINESPEC MODPDFILE(%INTEGER EP, %STRING(31) PDFILE,
%STRING(11) MEMBER, %STRING(31) INFILE, %INTEGERNAME FLAG)
%SYSTEMINTEGERFNSPEC PARMAP
%SYSTEMROUTINESPEC SETPAR(%STRING(255) S)
%SYSTEMSTRINGFNSPEC SPAR(%INTEGER N)
%SYSTEMROUTINESPEC NEWGEN(%STRING(31) S,T, %INTEGERNAME FLAG)
%SYSTEMROUTINESPEC SETWORK(%INTEGERNAME ADDR,FLAG)
%SYSTEMROUTINESPEC SETFNAME(%STRING(40) NAME)
%SYSTEMROUTINESPEC PSYSMES(%INTEGER ROOT,FLAG)
%SYSTEMROUTINESPEC CONNECT(%STRING(31) S, %INTEGER ACCESS,MAXBYTES,
PROTECTION, %RECORD(RF) %NAME R, %INTEGERNAME FLAG)
%SYSTEMROUTINESPEC OUTFILE(%STRING(31) NAME, %INTEGER LENGTH,MAXBYTES,
PROTECTION, %INTEGERNAME CONAD,FLAG)
%SYSTEMINTEGERMAPSPEC COMREG(%INTEGER I)
!*
!*
!*
%CONSTBYTEINTEGERARRAY ONECASE(0:255) = 0,
1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16,
17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32,
33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48,
49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64,
65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80,
81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96,
65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80,
81, 82, 83, 84, 85, 86, 87, 88, 89, 90,123,124,125,126,127,128,
129,130,131,132,133,134,135,136,137,138,139,140,141,142,143,144,
145,146,147,148,149,150,151,152,153,154,155,156,157,158,159,160,
161,162,163,164,165,166,167,168,169,170,171,172,173,174,175,176,
177,178,179,180,181,182,183,184,185,186,187,188,189,190,191,192,
193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,208,
209,210,211,212,213,214,215,216,217,218,219,220,221,222,223,224,
225,226,227,228,229,230,231,232,233,234,235,236,237,238,239,240,
241,242,243,244,245,246,247,248,249,250,251,252,253,254,255
%CONSTBYTEINTEGERARRAY TWOCASE(0:255) = 0,
1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16,
17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32,
33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48,
49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64,
65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80,
81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96,
97, 98, 99,100,101,102,103,104,105,106,107,108,109,110,111,112,
113,114,115,116,117,118,119,120,121,122,123,124,125,126,127,128,
129,130,131,132,133,134,135,136,137,138,139,140,141,142,143,144,
145,146,147,148,149,150,151,152,153,154,155,156,157,158,159,160,
161,162,163,164,165,166,167,168,169,170,171,172,173,174,175,176,
177,178,179,180,181,182,183,184,185,186,187,188,189,190,191,192,
193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,208,
209,210,211,212,213,214,215,216,217,218,219,220,221,222,223,224,
225,226,227,228,229,230,231,232,233,234,235,236,237,238,239,240,
241,242,243,244,245,246,247,248,249,250,251,252,253,254,255
%CONSTSTRING(15)SYSDICTNAME="SUBSYS.EDITDICT"
%CONSTSTRING(10) PRIVDICTNAME="E#EDITDICT"
%CONSTSTRING(6) %ARRAY PRT(0:2) = %C
"Edit", "Look", "Recall"
%CONSTINTEGER SSCHARFILETYPE = 3
%CONSTINTEGER MAXI = X'02000000'; !MAXIMUM INTEGER ALLOWED
%CONSTBYTEINTEGERARRAY SPS(-2:131) = %C
NL(2),' '(132)
%CONSTBYTEINTEGERARRAY ROOT(0:2) = 59,78,58
!FOR MESSAGES
%INTEGERFNSPEC ED(%INTEGER EMODE, %STRING(63) S)
%EXTERNALROUTINE PEDIT(%STRING(255) S)
%INTEGER I
%STRING(31) S1,S2
%STRING(63) HOLDS
%CONSTSTRING(9) %ARRAY TERMMESS(1:2) = %C
"completed","abandoned"
HOLDS = S; !FOR TERMINATE MESSAGE
%UNLESS S->S1.(",").S2 %THEN S = S.",".S
!EDIT(A) BECOMES EDIT(A,A)
I = ED(0,S)
%IF 1<=I<=2 %START
!STANDARD CLOSE + FULLMESSAGES
PRINTCH(NL); !NEWLINE
PRINTSTRING("EDIT ".HOLDS." ".TERMMESS(I))
PRINTCH(NL); !NEWLINE
%FINISH
%RETURN; !NORMAL RETURN
%END; ! EDIT
%EXTERNALROUTINE PLOOK(%STRING(255) S)
%INTEGER I
%IF S="" %THEN S = "T#LIST"
I = ED(1,S.",.NULL")
PRINTSTRING("LOOK ".S." finished.".SNL)
%END; ! LOOK
%EXTERNALROUTINE PRECALL(%STRING(255) S)
%INTEGER FLAG,I
%STRING(11) FILE
GETJOURNAL(FILE,FLAG)
->ERR %IF FLAG#0
I = ED(2,FILE.",.NULL")
ERR: %IF FLAG#0 %THEN PSYSMES(58,FLAG)
%END; !OF RECALL
%INTEGERFN ED(%INTEGER EMODE, %STRING(63) S)
!***********************************************************************
!* VALUES OF EMODE: 0 = EDIT *
!* 1 = LOOK *
!* 2 = RECALL *
!***********************************************************************
%RECORDFORMAT CELL(%INTEGER LL,LP,RP,RL)
%ROUTINESPEC INITIALISE(%INTEGERNAME FLAG)
%INTEGERFNSPEC MAPTXT(%INTEGER I)
%ROUTINESPEC INSERT
%INTEGERFNSPEC FIND
%INTEGERFNSPEC FINDB
%ROUTINESPEC REPLACE
%ROUTINESPEC DELETE
%ROUTINESPEC PRINTTEXT
%INTEGERFNSPEC CHARSON(%INTEGER N)
%INTEGERFNSPEC LINESON(%INTEGER N)
%INTEGERFNSPEC CHARSBACK(%INTEGER N)
%INTEGERFNSPEC LINESBACK(%INTEGER N)
%INTEGERFNSPEC READCSTRING
%INTEGERFNSPEC NEWCELL
%ROUTINESPEC ERMESS(%INTEGER NO,LETT)
%INTEGERFNSPEC RETURNCELL(%INTEGER I)
%ROUTINESPEC RETURNLIST(%RECORD(CELL)%NAME ONE,TWO)
%ROUTINESPEC COPY(%INTEGER I)
%ROUTINESPEC EXTENDWORK
%INTEGERFNSPEC READTEXT
%INTEGERFNSPEC READI(%INTEGERNAME N)
%ROUTINESPEC KILLPART
%ROUTINESPEC EXTRACT(%INTEGER ADR)
%ROUTINESPEC FORCLOSE(%INTEGER CLASS,SUBCLASS)
%ROUTINESPEC EXIT(%INTEGER WHY)
%ROUTINESPEC POSITION(%INTEGER I)
%ROUTINESPEC HSAVE
%ROUTINESPEC HRESTORE
%INTEGERFNSPEC NEXT WORD
%INTEGERFNSPEC INIT DICT
%ROUTINESPEC SET HASHES
%INTEGERFNSPEC LOOK UP
%STRING(31) %ARRAY FILEUSED(1:20); !LIST OF FILES USED FOR INPUT
%INTEGER FILEUSEDCOUNT; !COUNT OF FILES USED
%RECORD(CELL) %NAME TOP,BOT,SET,CUR,BEG,END,TXT,NEW,HTOP,HBOT,HCUR,SCUR
%BYTEINTEGER SLINEL,SLINEST,SPARAST
%INTEGER TOPA,BOTA,SETA,CURP,BEGP,ENDP,TXTP
%INTEGER CADOLD,CADNEW,TMPNEW,NEWG,ASL,WSP,WSE,LEVEL,COMP,I,J,K,NEWNEWF
%INTEGER FLAG,ETERMINATE,CASEIND,HALTERED,ALTERED,HCURP,HSET,BACK,CHANGED,
NLC,INTSTOP,LINECOMPLETE,LCOMP
%BYTEINTEGERARRAYNAME CASE
%LONGINTEGER SYSDICT,PRIVDICT,TEMPDICT
%CONSTBYTEINTEGERARRAY SPELLCH(0:127)=0(45),0(3),0(10),0(7),
'A','B','C','D','E','F','G','H',
'I','J','K','L','M','N','O','P',
'Q','R','S','T','U','V','W','X',
'Y','Z',0(6),
'A','B','C','D','E','F','G','H',
'I','J','K','L','M','N','O','P',
'Q','R','S','T','U','V','W','X',
'Y','Z',0(5);
%CONSTINTEGER MAXHASH=10
%BYTEINTEGERARRAY WORD(-1:31)
%INTEGERARRAY HASH(0:MAXHASH)
%STRING(6) SSOWNER
%CONSTSTRING(4) TEMPFILE = "T#EH"
%STRING(5) PFN
%STRING(15) PRSTRING
%STRING(31) NEWPDF,NEWPDM
%STRING(63) OLDF,NEWF,CYF
%SWITCH ED(0:31)
%RECORD(CELL) %ARRAY LASTREC(0:6)
%RECORDFORMAT CFORM(%BYTE LETT,FLAGS,LEVEL,SWNO,ERRNO,LOOP,%HALF COUNT,
%INTEGER PAR)
%RECORD(CFORM) %NAME CURCOM,LASTCOM
%RECORD(RF) RR
%RECORD(FRF) EHR
%RECORD(CFORM) %ARRAY CLIST(0:99)
!
! VALUES FOR CLIST_FLAGS
!
%CONSTINTEGER BACKWARDS = 1,NUMPAR = 2,TEXTPAR = 4,FILEPAR = 8,ERROR = 128,
NOTINLOOK = 128,SPECIAL = 64,ALLPAR = NUMPAR!TEXTPAR!FILEPAR, NEEDSS=32,
STOP SPELL=16
!
! VALUES FOR ARRAY CHARTYPE
!
%CONSTINTEGER NL = 10,COMMAND = 1,TEXTCHAR = 2,NUMCHAR = 3,FILECHAR = 4,
FILEEND = 5,MINUS = 6,LOOPSTART = 7,LOOPEND = 8,NONNULL = 9,SPACE = 32
!
! VALUES OF ERROR MESSAGES
!
%CONSTINTEGER SYNTAXERROR = 0,INVALIDLOOP = 1,CHINLOOK = 2
!
%CONSTBYTEINTEGERARRAY CHARTYPE(0:127) = 0(10),NL,0(14),NL,0(6),
SPACE,NONNULL(6),{!,",#,$,%,&}
TEXTCHAR,{'} LOOPSTART,{(} LOOPEND,{)}
NUMCHAR(2),{*+} NONNULL,{,} MINUS,
TEXTCHAR(2),{.,/} NUMCHAR(10),{0-9}
NONNULL(2),{:;} FILECHAR,{<} NONNULL,{=} FILEEND,{>}
TEXTCHAR,{?}
NONNULL,{@} COMMAND(9),{A-I}
COMMAND,{J - JUSTIFY}
COMMAND,{K}
COMMAND,{L - LAYOUT}
COMMAND(2),{MN}
COMMAND(7),{O-U} NONNULL,{V}
COMMAND(3){WXY},
COMMAND{Z},NONNULL(5),
NONNULL,{@} COMMAND(9),{A-I}
COMMAND,{J - JUSTIFY}
COMMAND,{K}
NONNULL,{L -RESERVED FOR LAYOUT}
COMMAND(2),{MN}
COMMAND(7),{O-U} NONNULL,{V}
COMMAND(3){WXY},
COMMAND{Z},NONNULL(4),
0{ERASE}
!
! COMMAND DEFINITION IS SW FOR NO OR NUMBERPARAM<<24!SW FOR TEXT<<16
! ! LASTREC POINTER<<12! FLAG BITS
!
%CONSTINTEGERARRAY COMDEF('A':'Z') = %C
{A} 8<<24!7<<16!0<<12!ALLPAR!BACKWARDS!STOP SPELL,
{B} 2<<24!STOP SPELL,
{C} NUMPAR!SPECIAL,
{D} 12<<24!11<<16!1<<12!ALLPAR!BACKWARDS!NOTINLOOK!STOP SPELL,
{E} 3<<24,
{F} 24<<16!FILEPAR,
{G} 23<<24!NUMPAR!NOTINLOOK!STOP SPELL,
{H} 18<<24!SPECIAL!STOP SPELL,
{I} 4<<16!2<<12!FILEPAR!TEXTPAR!NOTINLOOK!STOP SPELL,
{J} 28<<24!NUMPAR!NOTINLOOK!STOP SPELL,
{K} 17<<24!NEEDSS!STOP SPELL,
{L} 27<<24!NUMPAR!NOTINLOOK!STOP SPELL,
{M} 6<<24!5<<16!3<<12!ALLPAR!BACKWARDS!STOP SPELL,
{N} 31<<24,
{O} 21<<24!NEEDSS!STOP SPELL,
{P} 10<<24!9<<16!4<<12!ALLPAR!BACKWARDS,
{Q} 15<<24,
{R} 14<<24!13<<16!5<<12!ALLPAR!BACKWARDS!NOTINLOOK!STOP SPELL,
{S} 16<<24,
{T} 1<<24!STOP SPELL,
{U} 20<<24!19<<16!6<<12!ALLPAR!BACKWARDS!NOTINLOOK!NEEDSS!STOP SPELL,
{V} -1,
{W} 25<<24!NOTINLOOK!STOP SPELL,
{X} 29<<24,
{Y} 30<<24,
{Z} 26<<24
%ON %EVENT 12 %START; ! EVENT 12 FOR FRCED ENDING
%RESULT=2
%FINISH
%INTEGERFN NEWCELL
!***********************************************************************
!* *
!* NEWCELL *
!* THIS FUNCTION RETURNS THE ADDRESS OF A NEW, EMPTY CELL. ASL *
!* CONTAINS THE ADDRESS OF THE NEXT CELL TO BE USED AND IF IT IS *
!* ZERO MEANS THAT MORE SPACE IS NEEDED. SPACE IS OBTAINED FROM THE *
!* WORKFILE IN 1 PAGE UNITS (256 CELLS) AND IF EXTEND WORK FAILS *
!* THEN AN EDIT:E IS INVOKED. THIS IS NOT LIKELY TO OCCUR VERY *
!* OFTEN. *
!* *
!***********************************************************************
%INTEGER I,J,K
%RECORD(CELL) %NAME CLEAR
I = ASL
%IF I=0 %START; !GET SOME MORE SPACE
I = (WSP+3)&X'FFFFFFFC'; !WORD ALIGN
J = I+4096
%IF J>WSE %THEN EXTENDWORK; ! ABANDON IF NO ROOM LEFT
! **** Causes immediate exit
WSP = J
K = 0
%WHILE J>I %CYCLE; !ALL BUT LAST RECORD
J = J-16
INTEGER(J) = K; !EACH CELL POINTS TO NEXT
K = J
%REPEAT
%FINISH
ASL = INTEGER(I); !ASL POINTS TO NEXT ONE
CLEAR == RECORD(I)
CLEAR = 0; !CLEAR THE CELL
%RESULT = I
%END; !OF NEWCELL
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE RETURNLIST(%RECORD(CELL)%NAME ONE,TWO)
%RECORD(CELL)%NAME WORK
%INTEGER I
WORK==ONE
%WHILE WORK\== TWO %CYCLE
I=WORK_RL
%MONITOR %AND %EXIT %IF I=0
WORK==RECORD(RETURNCELL(ADDR(WORK)))
%REPEAT
%END
%INTEGERFN RETURNCELL(%INTEGER I)
INTEGER(I) = ASL
ASL = I
%RESULT = INTEGER(I+12)
%END; !OF RETURN CELL
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%INTEGERFN READTEXT
%INTEGER MARKER,CHAR,SKIPPEDCH
SKIPSYMBOL %WHILE NEXTSYMBOL<=' '
%IF NEXTSYMBOL='<' %THENSTART
MARKER = '>'; CHAR = 0
%FINISHELSESTART
READSYMBOL(MARKER)
%RESULT = 0 %UNLESS MARKER='.' %OR MARKER='/' %OR MARKER='?'
! %RESULT = 0 if no text found.
CHAR = NEXTCH
%IF CHAR=MARKER %THENSTART
READCH(SKIPPEDCH)
%IF NEXTCH#MARKER %THENRESULT = 0
%FINISH
%FINISH
PROMPT(TOSTRING(MARKER).":")
TXT == RECORD(NEWCELL)
TXT_LL = 0
TXT_LP = WSP
%UNTIL CHAR#MARKER %CYCLE
READCH(SKIPPEDCH)
%UNTIL CHAR=MARKER %CYCLE
%IF WSP=WSE %THEN EXTENDWORK; ! FORCE EDIT:E IF FAIL
! **** Causes immediate exit
BYTEINTEGER(WSP) = CHAR
WSP = WSP+1
READCH(CHAR) %UNTIL MARKER#'>' %OR(CHAR#NL %AND CHAR#' ')
%REPEAT
CHAR = NEXTCH
%REPEAT
TXT_RP = WSP-1
TXT_RL = 0
%IF LEVEL=0 %THEN PROMPT(PRSTRING) %ELSE PROMPT("):")
%RESULT = 1
%END; !READ TEXT
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%INTEGERFN READI(%INTEGERNAME N)
%INTEGER J,I,SIGN,K
READSYMBOL(I) %UNTIL I>' '
%IF I='-' %THEN SIGN = -1 %ELSE SIGN = +1
%UNLESS '-'#I#'+' %THEN READSYMBOL(I)
%IF I='*' %THENSTART
J = 1
K = MAXI
%FINISHELSESTART
J = 0
K = 0
%WHILE '0'<=I<='9' %CYCLE
K = 10*K+I-'0'
%IF K>=MAXI %THEN %RESULT=0
! You aren't allowed to specify +/- MAXI as a literal. MAXI
! is used internally to stand for '*'.
%IF J#0 %THEN SKIPSYMBOL %ELSE J = 1
I = NEXTSYMBOL
SKIP SYMBOL %AND I =NEXT SYMBOL %WHILE I=' '
%REPEAT
%FINISH
N = K*SIGN
%RESULT = J
%END; !OF READ I
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%INTEGERFN MAPTXT(%INTEGER ADR)
%STRING(31) OWNER,REST
%STRING(31) FILE
%INTEGER HOLE,FLAG,I,D,Q
ADR = IMOD(ADR); !MOVE BACK HELD AS -ADDRESS
TXT == RECORD(ADR)
D = TXT_LP
Q = BYTEINTEGER(D)
%IF Q=0 %THENSTART
! If the leftmost byte is zero, the following bytes are assumed
! to be a file name.
Q = TXT_RP-D; ! This is the length of the file name.
%IF Q>31 %THEN Q = 31
BYTEINTEGER(D) = Q
FILE = STRING(D)
%IF FILE=NEWF %THENSTART
FLAG = 266
->ERR
%FINISH
%IF FILE=OLDF %THEN HOLE = CADOLD %ELSESTART
CONNECT(FILE,0,0,0,RR,FLAG)
%IF FLAG#0 %THEN ->ERR; ! OPEN FAILS
%UNLESS RR_FILETYPE=3 %THENSTART; ! INVALID FILE TYPE
FLAG = 267
SETFNAME(FILE)
->ERR
%FINISH
HOLE = RR_CONAD
! STANDARDISE FILENAME
%UNLESS FILE->OWNER.(".").REST %THEN FILE = SSOWNER.".".FILE
I = 1
%WHILE I<=FILEUSEDCOUNT %AND FILEUSED(I)#FILE %CYCLE
I = I+1
%REPEAT
! ADD NAME TO LIST (DON'T BOTHER BEYOND 20 - NOT LIKELY)
%IF FILEUSEDCOUNT<I<=20 %THENSTART
FILEUSEDCOUNT = I
UCTRANSLATE(ADDR(FILE)+1,LENGTH(FILE))
FILEUSED(I) = FILE
%FINISH
%FINISH
BYTEINTEGER(D) = 0; !FOR RE-USE
D = HOLE+INTEGER(HOLE+4)
TXT_LP = D
TXT_RP = HOLE+INTEGER(HOLE)-1
%FINISH
%RESULT = 0 %IF TXT_RP<D
%RESULT = 1
ERR: PSYSMES(31,FLAG); !OPEN FAILS
%RESULT = 0; !FAILURE
%END; !OF MAP TXT
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE SEPARATE
!***********************************************************************
!* *
!* SEPARATE *
!* CREATE A NEW CELL WHICH STARTS AT CUR_LP AND ENDS AT CURP-1. *
!* ALSO ALTER CURRENT CELL TO START AT CURP *
!* *
!***********************************************************************
NEW == RECORD(NEWCELL)
INTEGER(CUR_LL+12) = ADDR(NEW_LL)
NEW_LL = CUR_LL
NEW_LP = CUR_LP
NEW_RP = CURP-1
CUR_LP = CURP
CUR_LL = ADDR(NEW_LL)
NEW_RL = ADDR(CUR_LL)
ALTERED=ALTERED+1; ! LIST ALTERED SINCE "HSAVE"
%END; !OF SEPARATE
%ROUTINE HSAVE
!***********************************************************************
!* SAVE THE CURRENT STATE OF THE FILE BY COPYING THE LINKED LIST *
!* THE COPY IS SKIPPED IF THE LIST HAS NOT BEEN ALTERED SINCE *
!* THE LAST CALL OF HSAVE *
!***********************************************************************
%INTEGER I,J
%RECORD(CELL)%NAME WORK,LAST,COPY
%IF HALTERED<ALTERED %START; ! LIST ALTERED SINCE LAST COPY
RETURN LIST(RECORD(HTOP_RL),HBOT); ! LEAVING HTOP&HBOT
!
! NOW FORM A COPY OF THE LIST
!
I=TOP_RL; LAST==HTOP
%CYCLE
COPY==RECORD(I); ! CELL TO BE COPIED
%EXIT %IF COPY==BOT; ! LIST END REACHED
J=NEWCELL; LAST_RL=J; ! NEWCELL LINKED IN
WORK==RECORD(J)
WORK_LL=ADDR(LAST)
WORK_LP=COPY_LP
WORK_RP=COPY_RP
I=COPY_RL
%IF COPY==CUR %THEN HCUR==WORK %AND SCUR==CUR %AND HCURP=CURP
LAST==WORK
%REPEAT
%IF CUR==BOT %THEN HCUR==HBOT %AND SCUR==CUR %AND HCURP=CURP
HBOT_LL=ADDR(LAST)
LAST_RL=ADDR(HBOT)
HALTERED=ALTERED
%RETURN
%FINISH
!
! LIST NOT ALTERED BUT CURSER MAY HAVE MOVED. IF CURSER NOT THE SAME
! CELL AS WHEN COPY MADE(CUR##SCUR) A FULL SEARCH IS NEEDED. REMEMBER
! THAT MULTIPLE INSERTS OF THE SAME PIECE OF TEXT CAN RESULT IN MULTIPLE
! IDENTICAL CELLS!
!
%IF SCUR\==CUR %THEN %START; ! IN A DIFFERENT CELL
COPY==TOP
WORK==HTOP
%CYCLE
%EXIT %IF COPY==CUR
COPY==RECORD(COPY_RL)
WORK==RECORD(WORK_RL)
%REPEAT
HCUR==WORK
SCUR==CUR
%FINISH
HCURP=CURP
%END
%ROUTINE HRESTORE
!***********************************************************************
!* RESTORE FILE TO STATE IT WAS WHEN HSAVE WAS LAST CALLED *
!***********************************************************************
%INTEGER I,J
%RECORD(CELL)%NAME WORK,LAST,COPY
SETA=0; ! KILL OLD SEPERATOR
RETURN LIST(RECORD(TOP_RL),BOT); ! LEAVING TOP&BOT
!
LAST==TOP
I=HTOP_RL
%CYCLE
COPY==RECORD(I); ! CELL FROM SAVED LIST
%EXIT %IF COPY==HBOT
J=NEWCELL
LAST_RL=J
WORK==RECORD(J)
WORK_LL=ADDR(LAST)
WORK_LP=COPY_LP
WORK_RP=COPY_RP
I=COPY_RL
%IF WORK_LP=WORK_RP=0 %THEN SET==WORK %AND SETA=J
%IF COPY==HCUR %THEN CUR==WORK %AND SCUR==WORK %AND CURP=HCURP
LAST==WORK
%REPEAT
%IF HCUR==HBOT %THEN CUR==BOT %AND SCUR==BOT %AND CURP=HCURP
LAST_RL=BOTA
BOT_LL=ADDR(LAST)
ALTERED=HALTERED
%END
%ROUTINE INSERT
!***********************************************************************
!* *
!* INSERT *
!* LINKS TXT INTO FILE AT CURP MAKING ADDITIONAL CELL IF NEC BY *
!* CALL OF SEPARATE. NO REPLY *
!* *
!***********************************************************************
%INTEGER NEW,PREVIOUS,AC
%UNLESS TXT_LP=TXT_RP=0 %THEN CHANGED = 1; !IF NOT JUST *S* TO INDICATE CHANGE MADE
ALTERED=ALTERED+1; ! LIST ALTERED SINCE "HSAVE"
%IF CURP#CUR_LP %THEN SEPARATE
AC = ADDR(CUR_LL)
PREVIOUS = INTEGER(AC)
NEW = ADDR(TXT_LL)
INTEGER(AC) = NEW
INTEGER(PREVIOUS+12) = NEW
INTEGER(NEW) = PREVIOUS
INTEGER(NEW+12) = AC
%END; !OF INSERT
!%INTEGERFN FIND
!%INTEGER I
! BEG==CUR
! BEGP=CURP
! I=BYTE INTEGER(TXT_LP)
!L3: %IF BEGP=0 %THEN %RESULT=0
!L2: %IF BYTE INTEGER(BEGP)=I %THEN ->L1
!L6: BEGP=BEGP+1
! ->L2 %UNLESS BEGP>BEG_RP
! BEG==RECORD(BEG_RL)
! BEGP=BEG_LP
! ->L3
!L1: END==BEG
! ENDP=BEGP
! TXTP=TXT_LP
!L5: ENDP=ENDP+1
! ->L4 %UNLESS ENDP>END_RP
! END==RECORD(END_RL)
! ENDP=END_LP
!L4: %IF TXTP=TXT_RP %THEN %RESULT=1
! TXTP=TXTP+1
! %IF ENDP=0 %THEN %START
! BEG==END
! BEGP=0
! %RESULT=0
! %FINISH
! %IF BYTE INTEGER(ENDP)=BYTE INTEGER(TXTP) %THEN ->L5
! ->L6
!%END
!OF FIND
%INTEGERFN FIND
!***********************************************************************
!* *
!* FIND *
!* THIS FUNCTION IS CALLED BY MANY COMMANDS TO FIND TEXT DEFINED BY *
!* TXT IT SETS BEG AND BEGP TO THE START OF THE TEXT AND END AND *
!* ENDP TO THE END OF THE TEXT. IF THE TEXT IS NOT FOUND THEN BEG *
!* AND BEGP ARE LEFT POINTING AT *S* OR *B* AS APPROPRIATE *
!* THE FUNCTION USES THE MACHINE CODE INSTRUCTIONS SWNE AND CPS. *
!* SWNE IS USED TO FIND THE FIRST CHARACTER OF THE REQUESTED TEXT. *
!* IF THERE IS ENOUGH ROOM IN THE CURRENT RECORD THEN CPS IS USED *
!* TO TEST FOR THE REST OF THE TEXT. IF NOT THEN FOR SIMPLICITY AN *
!* IMP VERSION IS USED. *
!* ALL IMP VERSIONS SHOULD EXCHANGE THE ALL IMP VERSION OF FIND FOR *
!* THIS ONE *
!* *
!***********************************************************************
%INTEGER LENB,TLEN,FIRST,TLP,B
%INTEGER DR0,DR1,ACC0,ACC1; !DR0-DR1 AND ACC0-ACC1 MUST STAY AS PAIRS
BEG == CUR
BEGP = CURP
TLP = TXT_LP; !ADDR OF START OF TEXT
TLEN = TXT_RP-TLP+1; !NO OF CHAS TO BE TESTED
FIRST = BYTEINTEGER(TLP); !FIRST CHAR TO BE FOUND
START:%IF BEGP=0 %THENRESULT = 0; !HIT *B* OR *S*
AGAIN:LENB = BEG_RP-BEGP+1; !NUMBER LEFT IN CURRENT RECORD
!LOOK FOR FIRST CHARACTER
!SWNE INS REQUIRES B REGISTER TO CONTAIN MASK IN BITS 16-23
!AND REF BYTE IN BITS 24-31. DR MUST CONTAIN A DESCRIPTOR
!TO THE STRING TO BE SEARCHED
B = (32*CASEIND)<<8!FIRST; !MASK<<8 ! TEST CHAR
DR0 = X'58000000'!LENB; !STRING DESCRIPTOR
DR1 = BEGP; !ADDRESS OF STRING
*LB_B; !LOAD B REGISTER
*LD_DR0; !LOAD DESCRIPTOR REGISTER
*SWNE_ %L= %DR
!CONDITION CODE NOW SET AS FOLLOWS
!0 REF BYTE NOT FOUND
!1 REF BYTE FOUND - ADDRESS IN BOTTOM OF DR
*JCC_8,<FIRSTNOTFOUND>; !JUMP IF NOT FOUND
*STD_DR0; !STORE DESCRIPTOR REGISTER
BEGP = DR1; !POSSIBLE FIRST BYTE
!NOW DEAL WITH SINGLE CHARACTER SEARCH
%IF CASEIND#0 %THEN ->IMP1
%IF TLEN=1 %THEN ->FOUND; !FIRST AND ONLY CHARACTER MATCHED OK
!NOW NEED TO COMPARE REST OF TEXT
!IF ENOUGH TEXT IN CURRENT SECTION USE CPS INSTRUCTION ELSE
!USE IMP VERSION
%IF BEG_RP-BEGP+1<TLEN %THEN ->IMP1
!JUMP IF TOO LONG
!CPS(COMPARE STRINGS) INSTRUCTION REQUIRES DESCRIPTORS TO TWO
!STRINGS IN DR AND ACC
DR0 = X'58000000'!(TLEN-1); !NO NEED TO TEST FIRST CHAR AGAIN
DR1 = TLP+1; !START OF STRING TO BE TESTED
ACC0 = DR0
ACC1 = BEGP+1; !POSSIBLE SECOND CHARACTER
*LD_DR0; !LOAD DESCRIPTOR REGISTER
*LSD_ACC0; !SET ACS TO 64 AND LOAD
*PUT_X'A500'
!*CPS_X'100' COMPARE STRINGS
!CONDITION CODE NOW 0 IF STRINGS EQUAL
*JCC_8,<FOUND>; !JUMP IF EQUAL
!INCREMENT BEGP AND TRY ALL OVER AGAIN
BEGP = BEGP+1; !CANNOT HIT END OF SEGMENT BECAUSE STRING CONTAINS AT LEAST 2 CHAS
->AGAIN; !TRY AGAIN
FOUND: !THIS IS EXIT FOR SIMPLE CASE WHERE ALL TEXT IN ONE SEGMENT
END == BEG
ENDP = BEGP+TLEN
%IF ENDP>END_RP %THENSTART; ! END OF TEXT EXACTLY AT END OF SEGMENT
END == RECORD(END_RL)
ENDP = END_LP
%FINISH
TXTP = TXT_RP; !WHY?
%RESULT = 1; !SUCCESS
FIRSTNOTFOUND: !NEED TO GET NEXT BLOCK
BEG == RECORD(BEG_RL)
BEGP = BEG_LP
->START; !TO INCLUDE CHECK FOR *B* AND *S*
IMP1: END == BEG
ENDP = BEGP
TXTP = TXT_LP
%CYCLE
%IF CASE(BYTEINTEGER(ENDP))#CASE(BYTEINTEGER(TXTP)) %THENEXIT
ENDP = ENDP+1
%IF ENDP>END_RP %START
END == RECORD(END_RL)
ENDP = END_LP
%FINISH
%IF TXTP=TXT_RP %THENRESULT = 1
!SUCCESS
TXTP = TXTP+1
%IF ENDP=0 %START; !HIT *B* OR *S*
BEG == END
BEGP = 0
%RESULT = 0; !NOT FOUND
%FINISH
%REPEAT
BEGP = BEGP+1
%IF BEGP>BEG_RP %START
BEG == RECORD(BEG_RL)
BEGP = BEG_LP
->START; !TRY ALL OVER AGAIN
%FINISH
->AGAIN
%END; !OF FIND
%INTEGERFN FINDB
!***********************************************************************
!* *
!* FINDB *
!* MOVE BACK FROM CURRENT POSITION TO TEXT. IF O.K. LEAVE END AND *
!* ENDP AT END OF TEXT AND BEG AND BEGP AT START OF TEXT. IF NOT *
!* RESULT=0 AND END,ENDP,BEG AND BEGP ALL AT *T* OR *S* *
!* *
!***********************************************************************
%INTEGER LAST
END == CUR
ENDP = CURP
LAST = CASE(BYTEINTEGER(TXT_RP)); ! LAST CHARACTER TO BE FOUND
%CYCLE
%UNTIL CASE(BYTEINTEGER(ENDP))=LAST %CYCLE
%IF ENDP=END_LP %START
%IF INTEGER(END_LL+8)=0 %START; !HIT *T* OR *S*
BEG == END
BEGP = ENDP
%RESULT = 0
%FINISH
END == RECORD(END_LL)
ENDP = END_RP
%FINISHELSE ENDP = ENDP-1
%REPEAT
BEG == END
BEGP = ENDP
TXTP = TXT_RP; ! LAST CHAR OF REQUIRED TEXT
%UNTIL CASE(BYTEINTEGER(TXTP))#CASE(BYTEINTEGER(BEGP)) %CYCLE
%IF TXTP<=TXT_LP %THENSTART
! GOT HERE SO TEXT MATCHES. MOVE ENDP FORWARD 1 CHAR
ENDP = ENDP+1
%IF ENDP>END_RP %START; !OFF END OF CELL
END == RECORD(END_RL)
ENDP = END_LP
%FINISH
%RESULT = 1; !SUCCESS
%FINISH
BEGP = BEGP-1
%IF BEGP<BEG_LP %THENSTART
%IF INTEGER(BEG_LL+8)=0 %THENSTART; ! *T* OR *S*
BEGP = BEG_LP
%RESULT = 0
%FINISH
BEG == RECORD(BEG_LL)
BEGP = BEG_RP
%FINISH
TXTP = TXTP-1
! NO GOOD - TRY AGAIN
%REPEAT
%REPEAT
%END; !OF FINDB
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE DELETE
!***********************************************************************
!* *
!* DELETE *
!* DELETES TEXT FROM BEGP TO ENDP. NO REPLY. *
!* The character at BEGP is deleted, but the character at ENDP is not. *
!* *
!***********************************************************************
%INTEGER I
CHANGED = 1; !TO INDICATE CHANGE MADE
ALTERED=ALTERED+1; ! LIST ALTERED SINCE "HSAVE"
%IF ADDR(BEG_LL)=ADDR(END_LL) %THENSTART
%IF BEGP=ENDP %THENRETURN
%IF BEGP=BEG_LP %THENSTART
BEG_LP = ENDP
%FINISHELSESTART
END == RECORD(NEWCELL)
END_RL = BEG_RL
INTEGER(END_RL) = ADDR(END_LL)
END_RP = BEG_RP
END_LP = ENDP
END_LL = ADDR(BEG_LL)
BEG_RL = ADDR(END_LL)
BEG_RP = BEGP-1
%FINISH
%FINISHELSESTART
I = BEG_RL
%WHILE I#ADDR(END_LL) %CYCLE
I = RETURNCELL(I)
%REPEAT
! I is equal to ADDR (END_LL) at this point
BEG_RL = I
END_LL = ADDR(BEG_LL)
END_LP = ENDP
%IF BEGP=BEG_LP %THENSTART
END_LL = BEG_LL
%UNLESS END_LL=0 %THEN INTEGER(END_LL+12) = I
I = RETURNCELL(ADDR(BEG_LL))
%FINISHELSESTART
BEG_RP = BEGP-1
%FINISH
%FINISH
CUR == END
CURP = ENDP
%END; !OF DELETE
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE PRINTTEXT
%INTEGER I,J
J = 0
%IF BEGP=BEG_LP %THENSTART
%IF BEG_LL=TOPA %THEN PRINTSTRING("*T*".SNL)
%IF BEG_LL=SETA %THEN PRINTSTRING("*S*".SNL)
%FINISH
%CYCLE
%IF BEGP=CURP %AND ADDR(BEG_LL)=ADDR(CUR_LL) %THEN PRINTCH(94)
%IF BEGP=ENDP %AND ADDR(BEG_LL)=ADDR(END_LL) %THENSTART
%IF BEGP=0 %THENSTART
%IF ADDR(BEG_LL)=SETA %THEN PRINTSTRING("*S*".SNL)
%IF ADDR(BEG_LL)=BOTA %THEN PRINTSTRING("*B*".SNL)
%FINISH
%RETURN
%FINISH
I = BYTEINTEGER(BEGP)
PRINTCH(I)
%IF I=NL %START
NLC = NLC+1
! CHECK ON LINES 4,8,12 ETC
%IF NLC&3=0 %AND INTERRUPT="STOP" %THENSTART
INTSTOP = 1
%RETURN
%FINISH
%FINISH
BEGP = BEGP+1
%IF BEGP>BEG_RP %START
BEG == RECORD(BEG_RL)
BEGP = BEG_LP
%FINISH
%REPEAT
%END; !OF PRINT TEXT
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%INTEGERFN CHARSON(%INTEGER N)
%INTEGER LEN
END == CUR
ENDP = CURP
%WHILE ENDP#0 %CYCLE
LEN = END_RP-ENDP; !LENGTH LEFT IN THIS CELL
%IF N<=LEN %START; !NEW POSITION IS IN THIS CELL
ENDP = ENDP+N
%RESULT = 1; !FOUND OK
%FINISH; !TRY NEXT CELL
N = N-(LEN+1); !DECREMENT BY CHAS LEFT +CURRENT ONE
END == RECORD(END_RL)
ENDP = END_LP
%IF N=0 %THENRESULT = 1; !HIT *S* OR *B* EXACTLY
%REPEAT
%RESULT = 0; !HIT *B* OR *S*
%END; !OF CHARS ON
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! %INTEGERFN LINES ON(%INTEGER N)
! %INTEGER I
! END == CUR
! ENDP = CURP
! I = 0
!L1: %IF I = N %THEN %RESULT = 1
! %IF ENDP = 0 %THEN %RESULT = 0
! %IF BYTE INTEGER(ENDP) = NL %THEN I = I+1
! ENDP = ENDP+1
! -> L1 %UNLESS ENDP > END_RP
! END == RECORD(END_RL)
! ENDP = END_LP
! -> L1
! %END
!OF LINES ON
%INTEGERFN LINESON(%INTEGER COUNT)
!***********************************************************************
!* *
!* LINESON *
!* MOVES END AND ENDP FORWARD FROM CUR AND CURP UNTIL POSITIONED *
!* AFTER COUNT NEWLINE CHAS. USES CHARSON IF PARAMETER WAS '*'. *
!* OTHERWISE USES SWNE(SCAN WHILE NOT EQUAL)INSTRUCTION TO LOCATE *
!* EACH NL CHARACTER *
!* *
!***********************************************************************
%INTEGER LENE; !COUNT OF CHAS LEFT IN CURRENT SECTION
%INTEGER B,DR0,DR1; !DR0 AND DR1 MUST STAY TOGETHER
%IF COUNT=MAXI %THENRESULT = CHARSON(COUNT)
!QUICKER TO USE CHARSON
END == CUR
ENDP = CURP
AGAIN:%IF ENDP=0 %THENRESULT = 0; !HIT *B* OR *S* BEFORE ENOUGH NLS
LENE = END_RP-ENDP+1; !CHAS LEFT IN CURRENT SECTION
B = X'000A'; !MASK<<8 ! REF CHARACTER
DR0 = X'58000000'!LENE; !TYPE AND BOUND
DR1 = ENDP; !START OF SCAN AREA
*LB_B; !LOAD B REGISTER
*LD_DR0; !LOAD DESCRIPTOR REGISTER
*PUT_X'A300'; !SWNE_X'100' - SKIP WHILE NOT EQUAL - USING LENGTH FROM DR
!CONDITION CODE NOW CONTAINS 0 IF CHARACTER NOT FOUND
*JCC_8,<NEXTSECT>; !GET NEXT SECTION
!DR NOW CONTAINS POINTER TO FIRST NL CHAR FOUND
*STD_DR0; !PUT DR BACK IN DR0-DR1
ENDP = DR1+1; !POINTS TO ONE BYTE AFTER NL
%IF ENDP>END_RP %START
END == RECORD(END_RL)
ENDP = END_LP
%FINISH
COUNT = COUNT-1
%IF COUNT=0 %THENRESULT = 1; !SUCCESSFUL
->AGAIN
NEXTSECT:END == RECORD(END_RL)
ENDP = END_LP
->AGAIN
%END; !OF LINESON
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%INTEGERFN CHARSBACK(%INTEGER N)
%INTEGER LEN
BEG == CUR
BEGP = CURP
%CYCLE
LEN = BEGP-BEG_LP; !LENGTH LEFT IN THIS CELL
%IF LEN-N>=0 %START; !N IS NEGATIVE
BEGP = BEGP-N
%RESULT = 1
%FINISH
BEGP = BEG_LP; !POINT TO START OF CELL
N = N-(LEN+1); ! ALL THIS CELL AND LAST CHAR OF NEXT CE
%IF INTEGER(BEG_LL+8)=0 %THENRESULT = 0
!*T* OR *S*
BEG == RECORD(BEG_LL); !THE NEXT CELL
BEGP = BEG_RP; !POINT TO LAST BYTE IN IT
%REPEAT
%END; !OF CHARS BACK
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%INTEGERFN LINESBACK(%INTEGER N)
%INTEGER I
%IF N=MAXI %THENRESULT = CHARSBACK(N)
!QUICKER TO USE CHARS BACK
BEG == CUR
BEGP = CURP
I = -1
%UNTIL I=N %CYCLE
%IF BEGP=BEG_LP %THENSTART
%IF INTEGER(BEG_LL+8)=0 %THENSTART
%IF I=N-1 %THENRESULT = 1 %ELSERESULT = 0
%FINISH
BEG == RECORD(BEG_LL)
BEGP = BEG_RP
%FINISHELSE BEGP = BEGP-1
%IF BYTEINTEGER(BEGP)=NL %THEN I = I+1
%REPEAT
BEGP = BEGP+1
%IF BEGP>BEG_RP %THENSTART
BEG == RECORD(BEG_RL)
BEGP = BEG_LP
%FINISH
%RESULT = 1
%END; !OF LINES BACK
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE POSITION(%INTEGER N)
%INTEGER I
N = N-1; !POINT TO BEFORE CHARACTER N
%IF N<0 %THEN N = 0
%IF N>132 %THEN N = 132
I = LINESBACK(0); ! START OF CURRENT LINE
I = 0; ! POSITION IN LINE
%CYCLE
%IF I=N %THENSTART
CUR == BEG
CURP = BEGP
%RETURN
%FINISH
%IF BEGP=0 %OR BYTEINTEGER(BEGP)=NL %THENSTART
%IF BEGP#0 %THENSTART
END == BEG
ENDP = BEGP+1
%IF ENDP>END_RP %THENSTART
END == RECORD(END_RL)
ENDP = END_LP
%FINISH
%FINISH
CUR == BEG
CURP = BEGP
TXT == RECORD(NEWCELL)
TXT_LL = 0
TXT_LP = ADDR(SPS(0))
TXT_RP = TXT_LP+N-I-1
TXT_RL = 0
INSERT
%RETURN
%FINISH
BEGP = BEGP+1
I = I+1
%IF BEGP>BEG_RP %THENSTART
BEG == RECORD(BEG_RL)
BEGP = BEG_LP
%FINISH
%REPEAT
%END; ! POSITION
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE KILLPART
%INTEGER DUMMY
ALTERED=ALTERED+1; ! LIST ALTERED SINCE "HSAVE"
INTEGER(SET_LL+12) = SET_RL; !POINT RL OF LOWER CELL TO HIGHER CELL
INTEGER(SET_RL) = SET_LL; !POINT LL OF UPPER CELL TO LOWER CELL
%IF ADDR(CUR_LL)=SETA %THENSTART; !IF CURSOR POSITIONED AFTER *S* THEN CORRECT IT
CUR == RECORD(CUR_RL)
CURP = CUR_LP
%FINISH
DUMMY = RETURNCELL(SETA); !FREE SET CELL - IGNORE RESULT
SETA = 0
%END; !OF KILL PART
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE EXTRACT(%INTEGER ADR)
!THIS PUTS TEXT FROM POINTER TO *S* OR *B*
!INTO FILE <FILENAME>
!BEFORE OUTPUTTING TO A FILE IT CHECKS THAT THE FILE HAS NOT BEEN
!USED SO FAR DURING THIS EDIT SESSION FOR INPUT.
%STRING(16) DEVICE
%STRING(31) FILE,OWNER,REST
%INTEGER I,FLAG,COUNT,CONAD,L,MOD
%RETURNIF CURP=0; !ALREADY AT *B* OR *S*
TXT == RECORD(ADR)
BYTEINTEGER(TXT_LP) = TXT_RP-TXT_LP
FILE = STRING(TXT_LP)
UCTRANSLATE(ADDR(FILE)+1,LENGTH(FILE))
%IF FILE->FILE.("-MOD") %THEN MOD = 1 %ELSE MOD = 0
%IF CHARNO(FILE,1)#'.' %START; !MUST BE A FILENAME
%UNLESS FILE->OWNER.(".").REST %THEN FILE = SSOWNER.".".FILE
I = 0
%WHILE I<FILEUSEDCOUNT %CYCLE
I = I+1
%IF FILEUSED(I)=FILE %START
FLAG = 266; !FILE CURRENTLY IN USE
->ERR
%FINISH
%REPEAT
%FINISHELSESTART; ! OUTPUT TO DEVICE
DEVICE <- FILE
FILE = TEMPFILE
%FINISH
L = CUR_RP-CURP+1; ! DETERMINE LENGTH OF OUTPUT FILE
COUNT = L
BEG == RECORD(CUR_RL)
%WHILE BEG_LP#0 %CYCLE
COUNT = COUNT+BEG_RP-BEG_LP+1
BEG == RECORD(BEG_RL)
%REPEAT
%IF MOD#0 %THENSTART; !OPEN FILE -MOD I.E. APPEND TO END
CONNECT(FILE,3,0,0,RR,FLAG)
%IF FLAG=218 %THENSTART; !FILE DOES NOT EXIST
MOD = 0
%FINISHELSESTART
%IF FLAG#0 %THEN ->ERR; !SOME OTHER FAILURE
%IF RR_FILETYPE#3 %THENSTART
FLAG = 267
SETFNAME(FILE)
->ERR
%FINISH
COUNT = RR_DATAEND+COUNT; !NEW TOTAL LENGTH
DISCONNECT(FILE,FLAG); !MIGHT NOT BE ROOM TO EXTEND
CHANGEFILESIZE(FILE,COUNT,FLAG)
->ERR %IF FLAG#0
CONNECT(FILE,3,0,0,RR,FLAG)
->ERR %IF FLAG#0
I = RR_CONAD+RR_DATAEND; !START PUTTING NEW TEXT HERE
INTEGER(RR_CONAD) = COUNT; !TOTAL LENGTH
INTEGER(RR_CONAD+8) = (COUNT+4095)&X'FFFFF000'
%FINISH
%FINISH
%IF MOD=0 %THENSTART; ! CREATE A NEW FILE OR OVERWRITE EXISTING ONE
OUTFILE(FILE,COUNT+32,0,0,CONAD,FLAG); ! CREATE OUTPUT FILE
%IF FLAG#0 %THEN ->ERR
INTEGER(CONAD) = COUNT+32
I = CONAD+32
INTEGER(CONAD+12) = SSCHARFILETYPE
%FINISH
MOVE(L,CURP,I)
I = I+L
BEG == RECORD(CUR_RL)
%WHILE BEG_LP#0 %CYCLE
COUNT = BEG_RP-BEG_LP+1
MOVE(COUNT,BEG_LP,I)
I = I+COUNT
BEG == RECORD(BEG_RL)
%REPEAT
DISCONNECT (FILE, FLAG)
%IF FILE=TEMPFILE %THENSTART
SENDFILE(FILE,DEVICE,"EDITOUT",0,0,FLAG)
%IF FLAG#0 %THEN PSYSMES(1000,FLAG)
%FINISH
%RETURN
ERR: PSYSMES(31,FLAG)
%END; !OF EXTRACT
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE REPLACE
%IF BEGP#BEG_LP %THENSTART
CUR == BEG
CURP = BEGP
SEPARATE
%FINISH
CUR == END
CURP = ENDP
%IF ENDP=END_LP %THEN NEW == RECORD(CUR_LL) %ELSESTART
SEPARATE
%IF ADDR(BEG_LL)=ADDR(END_LL) %THEN BEG == NEW
%FINISH
%IF ADDR(BEG_LL)#ADDR(BOT_LL) %AND ADDR(NEW_LL)#ADDR(TOP_LL) %THENSTART
CHANGED = 1; !TO INDICATE CHANGE MADE
ALTERED=ALTERED+1; ! LIST ALTERED SINCE "HSAVE"
CUR_LL = BEG_LL
INTEGER(BEG_LL+12) = NEW_RL
BEG_LL = SET_LL
INTEGER(SET_LL+12) = ADDR(BEG_LL)
NEW_RL = SETA
SET_LL = ADDR(NEW_LL)
%FINISH
%END; !OF REPLACE
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE COPY(%INTEGER I)
TXT == RECORD(NEWCELL)
MOVE(16,I,ADDR(TXT_LL))
%END; !OF COPY
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%INTEGERFN LAYOUT(%INTEGER PARAM,JUSTIFY)
!***********************************************************************
!* LAYS OUT A PARAGRAPH AS DEFINED BY PARAM AND-OR DEFAULTS *
!***********************************************************************
%INTEGERFNSPEC JUST(%INTEGER FIRST,LAST,DESIRED,SS)
%INTEGER LINEL,LINEST,PARAST,I,J,K,PTOPP,SYM,LINE,FIRSTPOS,N,SCURP
%RECORD(CELL)%NAME PTOP,PBOT,SCUR
%BYTEINTEGERARRAY CLINE(0:160)
%INTEGERFNSPEC ADJUSTLINE(%INTEGER INITLENGTH)
*LSS_PARAM; *IMDV_1000; *IMDV_100
*ST_LINEST; *LSS_%TOS; *ST_PARAST
*LSS_%TOS; *ST_LINEL
%IF LINEL=0 %THEN LINEL=SLINEL
%IF LINEST=0 %THEN LINEST=SLINEST
%IF PARAST=0 %THEN PARAST=SPARAST
SLINEL=LINEL; SLINEST=LINEST; SPARAST=PARAST
TXT==RECORD(NEWCELL)
TXT_LP=ADDR(SPS(-2))
TXT_RP=TXT_LP+1; ! RECORD DEFINING DOUBLE NL
!
! STAGE 1 DEFINE THE PARAGRAPH AND DEAL WITH NULLS
!
I=FIND
CUR==BEG; CURP=BEGP
!
! REMOVE ANY TRAILING SPACES BEFORE INSERT SEPERATOR
!
END==CUR; ENDP=CURP
%CYCLE
%IF CHARSBACK(1)=0 %THEN %EXIT
%IF BYTEINTEGER(BEGP)#' ' %THEN %EXIT
DELETE
%REPEAT
CUR==END; CURP=ENDP
TXT=0; INSERT; ! INSERT PSEUDO SEPARATOR
PBOT==TXT; ! TO MARK THE END
CUR==PBOT
CURP=CUR_RP; ! BEFOR PSEUDO SEP
TXT==RECORD(NEWCELL)
TXT_LP=ADDR(SPS(-2))
TXT_RP=TXT_LP+1
I=FINDB
PTOP==END; PTOPP=ENDP; ! TOP OF PARAGRAPH
CUR==PTOP; CURP=PTOPP
I=RETURN CELL(ADDR(TXT))
! SKIP EMPTY PARAGRAPHS
!
! CYCLE TO DEAL WITH EACH LINE IN PARAGRAPH
!
LINE=0
%CYCLE
LINE=LINE+1
%IF LINE=1 %THEN I=PARAST %ELSE I=LINEST
J=I-1
CLINE(J)=' ' %AND J=J-1 %WHILE J>=1;! SPACE LH MARGIN
FIRSTPOS=I; ! NEEDED LATER
%EXIT %IF CUR==PBOT; ! REACHED PSEUDOSEP
SCUR==CUR; SCURP=CURP; ! NEEDED FOR DELETE
!
! DISCARD ANY REDUNDANT SPACES ON FRONT OF LINE. ALSO A NL IF LEFT
! FROM ADJUSTMENT OF PREVIOUS LINE
!
%CYCLE
I=BYTEINTEGER(CURP)
%EXIT %UNLESS I=' ' %OR I=NL
%IF CURP<CUR_RP %THEN CURP=CURP+1 %ELSE %START
CUR==RECORD(CUR_RL)
CURP=CUR_LP
->WAYOUT %IF CUR==PBOT
%FINISH
%REPEAT
!
! COPY IN ENOUGH OF THE LINE
!
N=FIRST POS
%CYCLE
SYM=BYTEINTEGER(CURP)
CLINE(N)=SYM %AND N=N+1 %UNLESS %C
JUSTIFY#0 %AND N>FIRST POS %AND CLINE(N-1)=' '=SYM
%IF CURP<CUR_RP %THEN CURP=CURP+1 %ELSE %START
CUR==RECORD(CUR_RL)
CURP=CUR_LP
%FINISH
%WHILE SYM=NL %AND N>FIRST POS+1 %AND CLINE(N-2)=' ' %CYCLE
N=N-1
CLINE(N-1)=NL; ! REMOVE TRAILING SPACES
%REPEAT
%IF SYM=NL %OR N>LINEL+1 %OR CUR==PBOT %THEN %EXIT
%REPEAT
J=ADJUST LINE(N-1); ! MAY RECURSE
I=FIRST POS
%IF I<LINEST %THEN I=LINEST; ! FOR REVERSE INDENTING ON LINE 1
%IF JUSTIFY#0 %AND CUR##PBOT %THEN J=JUST(I,J-1,LINEL,0);! J= NL POSN
!
! OUTPUT THE ADJUSTED LINE AND DELETE ORIGINAL
!
BEG==SCUR; BEGP=SCURP
END==CUR; ENDP=CURP
DELETE
%EXIT %IF J<=FIRSTPOS
TXT==RECORD(NEWCELL)
TXT_LP=WSP
%FOR I=1,1,J %CYCLE
BYTEINTEGER(WSP)=CLINE(I)
WSP=WSP+1
%REPEAT
TXT_RP=WSP-1
INSERT
%REPEAT
WAYOUT:
SCUR==RECORD(PBOT_LL)
SCUR_RL=PBOT_RL
CUR==RECORD(PBOT_RL)
CUR_LL=PBOT_LL
CURP=CUR_LP
I=RETURN CELL(ADDR(PBOT))
I=CHARSON(2)
CUR==END; CURP=ENDP
%RESULT=I
%INTEGERFN ADJUSTLINE(%INTEGER LAST)
!***********************************************************************
!* MORES WORDS TO OR FROM THE LAST LINE TO IMPROVE FIT *
!* PARAMETER LAST EXCLUDES NL OR OVERFLOWING CHAR 'SYM' WHICH *
!* IS IN THE BUFFER *
!***********************************************************************
%INTEGER I,J,K,XCURP
%RECORD(CELL)%NAME XCUR
%IF CUR==PBOT %THEN %RESULT=LAST
%IF SYM=NL %AND LINEL<=LAST<=LINEL+1 %THEN %RESULT=LAST
%IF LAST<LINEL %THEN ->TOO SHORT
!
! LINE IS TOO SHORT TRY TO FIND EARLIER BREAK
!
I=LAST+1
%WHILE I>FIRSTPOS %CYCLE
%EXIT %IF CLINE(I)=' '
I=I-1
%REPEAT
%IF I=FIRSTPOS %START; ! NO BREAKPOINTS!
CLINE(LAST+1)=NL
%RESULT=LAST+1
%FINISH
J=CHARSBACK(LAST-I+1)
CLINE(I)=NL
CURP=BEGP; CUR==BEG
%RESULT=I
TOO SHORT: ! TRY TO ADD WORD FROM NEXT LINE
XCUR==CUR; XCURP=CURP; ! IN CASE IT WONT FIT
J=BYTEINTEGER(CURP)
%WHILE J=' ' %OR J=NL %CYCLE
%IF CURP<CUR_RP %THEN CURP=CURP+1 %ELSE %START
CUR==RECORD(CUR_RL)
CURP=CUR_LP
%IF CUR==PBOT %THEN ->MISS
%FINISH
J=BYTEINTEGER(CURP)
%REPEAT
I=LAST+1
%CYCLE
J=BYTEINTEGER(CURP)
%EXIT %IF J=' ' %OR J=NL
CLINE(I)=J
%IF I>LINEL %THEN ->MISS
I=I+1
%IF CURP<CUR_RP %THEN CURP=CURP+1 %ELSE %START
CUR==RECORD(CUR_RL); CURP=CUR_LP
CLINE(LAST)=' ' %AND %RESULT=I-1 %IF CUR==PBOT; ! END OF PARA REACHED
%FINISH
%REPEAT
CLINE(LAST)=' '
CLINE(I)=NL
SYM=NL
%RESULT=ADJUSTLINE(I)
MISS: ! WONT FIT
CUR==XCUR; CURP=XCURP
%RESULT=LAST
%END
%INTEGERFN JUST(%INTEGER FIRST,LAST,DESIRED,SS)
!***********************************************************************
!* JUSTIFY RIGHT MARGIN BY DOUBLING UP SPACES. NO ATTEMPT TO ADD *
!* EXTRA SPACES BETWEEN SENTENCES AS THIS INFO IS NOT READILY *
!* AVAILABLE. RECURSES IF ONE PASS INSUFFICENT *
!***********************************************************************
%ROUTINESPEC INSERT SP(%INTEGER AFTER)
%INTEGER GAPS,NEEDED,I,FLIP,SGAPS,SYM
NEEDED=DESIRED-LAST; GAPS=0; SGAPS=0
%RESULT=LAST+1 %IF NEEDED<=0
%FOR I=FIRST+1,1,LAST %CYCLE
%IF CLINE(I)=' ' %START
SYM=CLINE(I-1)
%IF SYM#' ' %THEN GAPS=GAPS+1
%IF SYM='.' %OR SYM=',' %OR SYM=';' %OR SYM='!' %C
%OR SYM='?' %THEN SGAPS=SGAPS+1
%FINISH
%REPEAT
%RESULT=LAST+1 %IF GAPS=0; ! NO GAPS= ONE WORD LIN!?!
!
%IF SS=0 %AND SGAPS>0 %START; ! FIRST FEW EXTRA SPACES AFTR'.' ETC
I=FIRST+1
%CYCLE
%IF CLINE(I)=' ' %START
SYM=CLINE(I-1)
%IF SYM='.' %OR SYM=',' %OR SYM=';' %OR SYM='?' %C
%OR SYM='!' %START
INSERT SP(I)
SGAPS=SGAPS-1
NEEDED=NEEDED-1
%IF 0<NEEDED>SGAPS %THEN INSERT SP(I) %AND NEEDED=NEEDED-1
%IF NEEDED<=0 %THEN %RESULT=LAST+1
%FINISH
%FINISH
I=I+1
%EXIT %UNLESS I<LAST %AND SGAPS>0
%REPEAT
%FINISH
FLIP=1
%IF LINE&1#0 %THEN FLIP=-1
%IF FLIP>0 %THEN I=FIRST+1 %ELSE I=LAST
%CYCLE
%IF CLINE(I)=' ' %AND CLINE(I-1)#' ' %START
INSERT SP(I)
I=I+FLIP
NEEDED=NEEDED-1
%IF NEEDED<=0 %THEN %RESULT=LAST+1
%FINISH
I=I+FLIP
%EXIT %UNLESS FIRST<I<LAST
%REPEAT
%RESULT=JUST(FIRST,LAST,DESIRED,1)
%ROUTINE INSERT SP(%INTEGER AFTER)
%INTEGER K
%FOR K=LAST+2,-1,AFTER+1 %CYCLE
CLINE(K)=CLINE(K-1)
%REPEAT
LAST=LAST+1
%END
%END; ! OF FN JUST
%END
%INTEGERFN INIT DICT
!***********************************************************************
!* INITIALISES BIT DESCRIPTORS FOR SYS&PRIV DICTS *
!***********************************************************************
%CONSTINTEGER MAXPDICT=X'4000'-X'20'
%INTEGER I,CONAD
CONNECT(SYSDICTNAME,0,0,0,RR,I)
%IF I=0 %START
CONAD=RR_CONAD
%IF RR_FILETYPE#4 %THEN I=267
SYSDICT=CONAD+INTEGER(CONAD+4)
SYSDICT=SYSDICT!(INTEGER(CONAD)-INTEGER(CONAD+4))*X'800000000'
%FINISH %ELSE SYSDICT=-1
%IF I#0 %THEN SETFNAME(SYSDICTNAME) %AND PSYSMES(ROOT(EMODE),I)
CONNECT(PRIVDICTNAME,3,0,0,RR,I)
%IF I=218 %START; ! DOES NOT EXIST
OUTFILE(PRIVDICTNAME,MAX PDICT,0,0,CONAD,I)
%IF I=0 %THEN %START
INTEGER(CONAD+12)=4
INTEGER(CONAD)=MAXPDICT;! SET AS SMAP FILE
CHERISH(PRIVDICTNAME)
RR_CONAD = CONAD
RR_FILETYPE = 4
RR_DATASTART = 32
RR_DATAEND = MAXPDICT
%FINISH
%FINISH
%RESULT=I %UNLESS I=0
%IF RR_FILETYPE#4 %THEN SETFNAME(PRIVDICTNAME) %AND %RESULT=267
CONAD=RR_CONAD
PRIVDICT=CONAD+INTEGER(CONAD+4)
PRIVDICT=PRIVDICT!(INTEGER(CONAD)-INTEGER(CONAD+4))*X'800000000'
WSP=(WSP+3)&(-4)
TEMPDICT=X'0000800000000000'+WSP
%IF WSP+4096>=WSE %THEN EXTENDWORK
%CYCLE I=0,1,1023
INTEGER(WSP)=0
WSP=WSP+4
%REPEAT; ! CLEAR 4K OF TEMP DICTIONARY
%RESULT=0
%END
%INTEGERFN NEXT WORD
%INTEGER CH,L
%IF CURP=0 %THEN %RESULT=0; ! AT *B* ETC
CH=BYTEINTEGER(CURP)&127
!
! FIRST MOVE BACK TO START OF WORD
!
!
! NOW MOVE ON PAST ANY SEPERATORS
!
%WHILE SPELLCH(CH)>0 %CYCLE
%IF CHARSBACK(1)=0 %THEN %EXIT
CUR==BEG; CURP=BEGP
CH=BYTEINTEGER(CURP)&127
%REPEAT
%CYCLE
CH=BYTE INTEGER(CURP)&127
%EXIT %IF 65<=SPELLCH(CH)<=90; ! INITIAL LETTER
%IF CURP<CUR_RP %THEN CURP=CURP+1 %ELSE %START
CUR==RECORD(CUR_RL)
CURP=CUR_LP
%RESULT=0 %IF CURP=0
%FINISH
%REPEAT
L=1
%CYCLE
CH=BYTE INTEGER(CURP)&127
%EXIT %IF SPELLCH(CH)=0
WORD(L)=SPELLCH(CH)
L=L+1
%EXIT %IF L>31
%IF CURP<CUR_RP %THEN CURP=CURP+1 %ELSE %START
CUR==RECORD(CUR_RL)
CURP=CUR_LP
%EXIT %IF CURP=0
%FINISH
%REPEAT
%IF L=2 %THEN %RESULT=NEXT WORD; ! IGNORE THE SINGLE LETTERS
WORD(0)=L-1
WORD(-1)=WORD(0)
%RESULT=1
%END
%ROUTINE SET HASHES
%INTEGER I,J
%CONSTINTEGERARRAY HCONSTS(0:56)=0,1,
997, 47, 2897, 19, 937, 2203,
311, 1019, 23, 3041, 823, 227,
2239, 211, 3181, 197, 3889,
191, 2447, 179, 2153, 167, 163,
3121, 2213, 149, 139, 2551, 131,
3947, 113, 2707, 107, 103, 3109, 97,
2647, 83, 79, 3797, 71, 2333,
61, 3517, 53, 43, 3821, 37,
31, 29, 17, 13, 11,
7, 5;
HASH(I)=0 %FOR I=1,1,MAXHASH
%FOR I=1,1,MAXHASH %CYCLE
%FOR J=1,1,WORD(0) %CYCLE
HASH(I)=HASH(I)+WORD(J)*HCONSTS(J+2*I)
%REPEAT
%REPEAT
%END
%INTEGERFN LOOKUP
!***********************************************************************
!* LOOK UP THE WORD RESULT=1 IF IN SYSDICT,=2 IF IN PRIVATE DICT *
!* =0 IF NOT KNOWN *
!***********************************************************************
%INTEGER I,J
I=ADDR(HASH(1))
*LD_SYSDICT
*JCC_7,<NO SYS>
*LCT_I
*LSS_(%CTB+0); ! HASH(1)
*IMDV_SYSDICT; ! REMAINDER DIVIDE
*LB_(%DR+%TOS); ! FIRST BIT TO B
*LSS_(%CTB+1)
*IMDV_SYSDICT
*ADB_(%DR+%TOS)
*LSS_(%CTB+2)
*IMDV_SYSDICT
*ADB_(%DR+%TOS)
*LSS_(%CTB+3)
*IMDV_SYSDICT
*ADB_(%DR+%TOS)
*LSS_(%CTB+4)
*IMDV_SYSDICT
*ADB_(%DR+%TOS)
*LSS_(%CTB+5)
*IMDV_SYSDICT
*ADB_(%DR+%TOS)
*LSS_(%CTB+6)
*IMDV_SYSDICT
*ADB_(%DR+%TOS)
*LSS_(%CTB+7)
*IMDV_SYSDICT
*ADB_(%DR+%TOS)
*LSS_(%CTB+8)
*IMDV_SYSDICT
*ADB_(%DR+%TOS)
*LSS_(%CTB+9)
*IMDV_SYSDICT
*ADB_(%DR+%TOS)
*STB_J
%RESULT=1 %IF J=10; !ALL 10 BITS SET =WORD IN DICT
NOSYS: ! SYSTEM DICTIONARY MISSING
*LD_PRIVDICT
*LCT_I
*LSS_(%CTB+0); ! HASH(1)
*IMDV_PRIVDICT; ! REMAINDER DIVIDE
*LB_(%DR+%TOS); ! FIRST BIT TO B
*LSS_(%CTB+1)
*IMDV_PRIVDICT
*ADB_(%DR+%TOS)
*LSS_(%CTB+2)
*IMDV_PRIVDICT
*ADB_(%DR+%TOS)
*LSS_(%CTB+3)
*IMDV_PRIVDICT
*ADB_(%DR+%TOS)
*LSS_(%CTB+4)
*IMDV_PRIVDICT
*ADB_(%DR+%TOS)
*LSS_(%CTB+5)
*IMDV_PRIVDICT
*ADB_(%DR+%TOS)
*LSS_(%CTB+6)
*IMDV_PRIVDICT
*ADB_(%DR+%TOS)
*LSS_(%CTB+7)
*IMDV_PRIVDICT
*ADB_(%DR+%TOS)
*LSS_(%CTB+8)
*IMDV_PRIVDICT
*ADB_(%DR+%TOS)
*LSS_(%CTB+9)
*IMDV_PRIVDICT
*ADB_(%DR+%TOS)
*STB_J
%RESULT=2 %IF J=10
*LD_TEMPDICT
*LCT_I
*LSS_(%CTB+0); ! HASH(1)
*IMDV_TEMPDICT; ! REMAINDER DIVIDE
*LB_(%DR+%TOS); ! FIRST BIT TO B
*LSS_(%CTB+1)
*IMDV_TEMPDICT
*ADB_(%DR+%TOS)
*LSS_(%CTB+2)
*IMDV_TEMPDICT
*ADB_(%DR+%TOS)
*LSS_(%CTB+3)
*IMDV_TEMPDICT
*ADB_(%DR+%TOS)
*LSS_(%CTB+4)
*IMDV_TEMPDICT
*ADB_(%DR+%TOS)
*LSS_(%CTB+5)
*IMDV_TEMPDICT
*ADB_(%DR+%TOS)
*LSS_(%CTB+6)
*IMDV_TEMPDICT
*ADB_(%DR+%TOS)
*LSS_(%CTB+7)
*IMDV_TEMPDICT
*ADB_(%DR+%TOS)
*LSS_(%CTB+8)
*IMDV_TEMPDICT
*ADB_(%DR+%TOS)
*LSS_(%CTB+9)
*IMDV_TEMPDICT
*ADB_(%DR+%TOS)
*STB_J
%RESULT=3 %IF J=10
%RESULT=0
%END
%ROUTINE ENTER
!***********************************************************************
!* ENTERS WORD "WORD" INTO PRIVATE DICTIONARY *
!***********************************************************************
%INTEGER I
I=ADDR(HASH(1))
*LD_PRIVDICT
*LCT_I
*LB_1
*LSS_(%CTB+0); ! HASH(1)
*IMDV_PRIVDICT; ! REMAINDER DIVIDE
*STB_(%DR+%TOS); ! FIRST BIT TO B
*LSS_(%CTB+1)
*IMDV_PRIVDICT
*STB_(%DR+%TOS)
*LSS_(%CTB+2)
*IMDV_PRIVDICT
*STB_(%DR+%TOS)
*LSS_(%CTB+3)
*IMDV_PRIVDICT
*STB_(%DR+%TOS)
*LSS_(%CTB+4)
*IMDV_PRIVDICT
*STB_(%DR+%TOS)
*LSS_(%CTB+5)
*IMDV_PRIVDICT
*STB_(%DR+%TOS)
*LSS_(%CTB+6)
*IMDV_PRIVDICT
*STB_(%DR+%TOS)
*LSS_(%CTB+7)
*IMDV_PRIVDICT
*STB_(%DR+%TOS)
*LSS_(%CTB+8)
*IMDV_PRIVDICT
*STB_(%DR+%TOS)
*LSS_(%CTB+9)
*IMDV_PRIVDICT
*STB_(%DR+%TOS)
%END
%ROUTINE ENTERTEMP
!***********************************************************************
!* ENTERS WORD "WORD" INTO TEMPORARY DICTIONARY *
!***********************************************************************
%INTEGER I
I=ADDR(HASH(1))
*LD_TEMPDICT
*LCT_I
*LB_1
*LSS_(%CTB+0); ! HASH(1)
*IMDV_TEMPDICT; ! REMAINDER DIVIDE
*STB_(%DR+%TOS); ! FIRST BIT TO B
*LSS_(%CTB+1)
*IMDV_TEMPDICT
*STB_(%DR+%TOS)
*LSS_(%CTB+2)
*IMDV_TEMPDICT
*STB_(%DR+%TOS)
*LSS_(%CTB+3)
*IMDV_TEMPDICT
*STB_(%DR+%TOS)
*LSS_(%CTB+4)
*IMDV_TEMPDICT
*STB_(%DR+%TOS)
*LSS_(%CTB+5)
*IMDV_TEMPDICT
*STB_(%DR+%TOS)
*LSS_(%CTB+6)
*IMDV_TEMPDICT
*STB_(%DR+%TOS)
*LSS_(%CTB+7)
*IMDV_TEMPDICT
*STB_(%DR+%TOS)
*LSS_(%CTB+8)
*IMDV_TEMPDICT
*STB_(%DR+%TOS)
*LSS_(%CTB+9)
*IMDV_TEMPDICT
*STB_(%DR+%TOS)
%END
%ROUTINE EXTENDWORK
!***********************************************************************
!* *
!* ROUTINE NO LONGER ATTEMPTS TO EXTEND WORK FILE. IT SIMPLY *
!* SIMULATES EDIT:E. THIS SHOULD NOW BE SAFE SINCE THIS ROUTINE IS *
!* NOT CALLED AT CRITICAL PLACES SUCH AS FROM WITHIN EXIT ITSELF. *
!* *
!***********************************************************************
PRINTSTRING("
WORKSPACE FULL
EDIT:E INVOKED".SNL)
EXIT(0)
%SIGNAL %EVENT 12,1; !RETURN TO COMMAND LEVEL
%END; !OF EXTEND WORK
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE EXIT(%INTEGER WHY)
!***********************************************************************
!* TERMINATES THE EDIT. WHY=0 FOR NORMAL STOP *
!* WHY=1 FOR INT:W *
!* WHY=2 FOR INT:X *
!* WHY=3 FOR INT:Y (LINE BREAK NO OUTPUT POSSIBLE) *
!* why=-1 for command W *
!***********************************************************************
%INTEGERFNSPEC SAVETEMPFILE(%STRINGNAME NF, %INTEGER F)
%STRING(50) MESS
%INTEGER L,FILELENGTH,FLAG,I
PFN = ""
%IF WHY>=0 %AND SYSDICT#0 %THEN DISCONNECT(PRIVDICTNAME,FLAG)
%IF NEWF=".NULL" %OR((NEWG=1 %OR CYF=OLDF) %AND CHANGED=0) %THENSTART
!LOOK,RECALL,EDIT(A)(NO CHANGES) OR EDIT(A,.NULL)
DISCONNECT(OLDF,FLAG) %IF NEWG=1
DISCONNECT(NEWPDF,FLAG) %IF CYF#""
ETERMINATE = 1
-> EXOUT
%FINISH
KILLPART %IF SETA#0
FILELENGTH = 0
CUR == RECORD(TOP_RL)
%WHILE CUR_LP#0 %CYCLE
FILELENGTH = FILELENGTH+CUR_RP-CUR_LP+1
CUR == RECORD(CUR_RL)
%REPEAT
L = FILELENGTH+32; ! L HAS LENGTH OF FILE REQUIRED
%IF WHY>0 %THEN ->SAVEEDIT
OUTFILE(NEWF,L,0,0,CADNEW,FLAG)
%IF FLAG=0 %THEN ->WRITEIT
! EXTEND fails.
%IF NEWF=TEMPFILE %OR FLAG=275 %OR FLAG=276 %OR FLAG=280 %OR %C
FLAG=308 %OR FLAG=309 %THEN ->ABORT
! 275 File system full
! 276 No free descriptors in file index
! 280 User individual file limit exceeded
! 308 User total limit exceeded
! 309 Too many files connected
PSYSMES(59,FLAG)
SAVEEDIT: ! TRY TO SAVE EDITING IN E#EHA
PFN = "E#EHA"
OUTFILE(PFN,L,0,0,CADNEW,I)
%IF I#0 %THEN -> EXOUT
MESS = "EDITed text will be saved in ".PFN.SNL
%IF WHY#3 %THEN PRINTSTRING(MESS) %ELSE %C
TOJOURNAL(ADDR(MESS),LENGTH(MESS))
NEWF = PFN
NEWG = 0
CYF = ""
WRITEIT: ! WRITE EDITING INTO FILE
TMPNEW = CADNEW
INTEGER(TMPNEW) = FILELENGTH+32
INTEGER(TMPNEW+4) = 32
INTEGER(TMPNEW+12) = 3; !TYPE=CHARACTER
TMPNEW = TMPNEW+32
CUR == RECORD(TOP_RL)
%WHILE CUR_LP#0 %CYCLE
I = CUR_RP-CUR_LP+1
MOVE(I,CUR_LP,TMPNEW)
TMPNEW = TMPNEW+I
CUR == RECORD(RETURN CELL(ADDR(CUR)))
%REPEAT
%IF NEWG=1 %THENSTART
DISCONNECT(OLDF,FLAG)
%IF FLAG#0 %START
%IF SAVETEMPFILE(OLDF,FLAG)#0 %THEN ->ABORT
%FINISH %ELSE %START; ! FLAG 0 DISCONNECT OK
SETUSE (TEMPFILE, -1, 0)
NEWGEN(TEMPFILE,OLDF,FLAG)
%IF FLAG#0 %THEN ->ABORT; !UNLIKELY FAILURE
%FINISH
%FINISHELSESTART
%IF CYF#"" %THENSTART
MODPDFILE(2,NEWPDF,NEWPDM,"",FLAG)
MODPDFILE(1,NEWPDF,NEWPDM,NEWF,FLAG)
%IF FLAG#0 %THEN %START
%IF SAVETEMPFILE(CYF,FLAG) #0 %THEN ->ABORT
%FINISH
DISCONNECT(NEWPDF,FLAG)
%FINISHELSE DISCONNECT(NEWF,FLAG)
%FINISH
ETERMINATE = 1; !FOR EDITOR TERMINATION MESSAGE
-> EXOUT
ABORT:PSYSMES(59,FLAG)
EXOUT:
I = 1
%WHILE I<=FILEUSEDCOUNT %CYCLE
DISCONNECT (FILEUSED(I),FLAG)
I = I + 1
%REPEAT
%RETURN
%INTEGERFN SAVETEMPFILE(%STRINGNAME NF, %INTEGER FLAG)
PSYSMES(59,FLAG)
PRINTSTRING("Unable to copy EDITed text into ".NF)
PFN = "E#EHA"
RENAME(NEWF,PFN,FLAG)
%IF FLAG=0 %THEN PRINTSTRING("
It has been saved in ".PFN.".".SNL) %ELSE PRINTSTRING("
Unable to save editing".SNL)
%RESULT=FLAG
%END
%END; !OF EXIT
%ROUTINE CHECKFF(%INTEGERNAME FLAG)
%INTEGER I,DOOUTFILE,CMODE,NEWSIZE
%STRING(31) TEMPF,OWNER
CYF = ""
FLAG = 0
DOOUTFILE = 0
%UNLESS NEWF=".NULL" %THENSTART
! Check for misuse of another user's file.
! It is not enough to rely on file protection: you could
! have WRITE access to another user's file, but you still
! would not be able to change the overall file size.
%IF NEWF->OWNER.(".").TEMPF %AND OWNER#SSOWNER %THEN %C
FLAG = 258 %AND SETFNAME(NEWF) %ELSESTART
! We will try to connect ordinary files for writing, but PD file
! members for reading.
%IF NEWF->NEWPDF.("_").NEWPDM %THEN CMODE = 0 %ELSE CMODE = 3
DOOUTFILE = -1; ! For most EDITs we will need to
! create a new file (temporary or
! permanent). In those cases
! where no new file is needed
! we reset DO OUTFILE to zero to
! suppress the file creation.
%IF CMODE=0 %THEN CONNECT(NEWPDF,3,0,0,RR,FLAG)
! **** **** I have a note that that should say **** ****
! %IF ... %THEN %START
! CONNECT (...)
! %IF FLAG=0 %THEN DISCONNECT (NEWPDF,I)
! %FINISH
! **** **** but I can't remember why. Check this **** ****
! **** **** before implementing it. **** ****
!
%IF FLAG=0 %THEN CONNECT(NEWF,CMODE,0,0,RR,FLAG)
FILEUSEDCOUNT=1
FILEUSED(1)<-SSOWNER.".".NEWF
! Try to connect.
%IF NEWF=OLDF %THENSTART; ! Editing a file onto itself.
%IF FLAG=0 %THENSTART; ! Connected O.K. - File exists.
%IF CMODE=3 %THENSTART; ! For ordinary files
NEWF = TEMPFILE; ! we will use a temporary file
NEWG = 1; ! and do NEWGEN when finished.
SETUSE (OLDF, -1, 0)
%FINISH; ! For PD file members, we will use
! a temporary file - see below.
! It might be a good idea to
! DISCONNECT the member at this point
! since it will be reCONNECTed in
! CHECKFF. This might also cure
! BR42 (whatever that was).
%FINISHELSE OLDF = ".NEW"; ! If FLAG was non-zero
! we assume for the moment that
! it is because NEWF does not
! exist, and since OLDF=NEWF we
! must be editing to create a new
! file. If the non-zero FLAG was
! for any other reason, that will be
! detected later.
%FINISHELSESTART; ! Editing from one file into
! another.
%IF FLAG=0 %THENSTART; ! The destination file does exist.
PRINTSTRING(NEWF." already exists")
%IF RR_FILETYPE#3 %THEN %START
PRINTSTRING(" but is not a character file")
FLAG=267
SETFNAME(NEWF)
%FINISH
NEWLINE
%IF CMODE=3 %THEN DOOUTFILE = 0; ! For editing into an ordinary
! file which does already exist, we
! do not need to create any new file.
! For PD file members, we will need
! to create a temporary file - see
! below.
%FINISH
%FINISH
%IF(CMODE=3 %AND FLAG=218) %OR(CMODE=0 %AND FLAG=288) %THENSTART
! The 'acceptable' failures from CONNECT are 'file does not exist'
! for an ordinary file, and 'member does not exist' for a PD file
! member.
FLAG = 0; ! This is no failure.
PRINTSTRING(NEWF." is a new ")
%IF CMODE=0 %THEN PRINTSTRING("member".SNL) %ELSE %C
PRINTSTRING("file".SNL)
NEWNEWF = 1; ! To indicate that a new NEWF has been created.
%FINISH
%IF FLAG=0 %THENSTART; ! New file validated.
%IF CMODE=0 %THENSTART; ! If it's a PD file member, we must
CYF = NEWF; ! use a temporary file and remember
NEWF = TEMPFILE; ! to copy it into the member at the end.
%FINISH
%FINISH
%FINISH
%FINISH
%IF FLAG=0 %THEN %START
%IF OLDF#".NEW" %THEN %START
CONNECT(OLDF,0,0,0,RR,FLAG); !CONNECT FOR READING
TEMPF=OLDF
%UNLESS TEMPF->(".") %THEN TEMPF=SSOWNER.".".TEMPF
FILEUSEDCOUNT=FILEUSEDCOUNT+1
FILEUSED(FILEUSEDCOUNT)<-TEMPF
%IF FLAG = 0 %THENSTART
CADOLD = RR_CONAD; !CONNECT ADDRESS OF OLDF
%IF RR_FILETYPE # 3 %THENSTART
FLAG = 267; !INVALID FILETYPE
SETFNAME(OLDF)
%FINISH
%FINISH
%FINISH
%FINISH
%IF FLAG=0 %AND DOOUTFILE#0 %THEN %START
! Create the file to ensure it can be constructed, but
! don't connect it.
%IF OLDF=".NEW" %THEN NEWSIZE = 4096 %C
%ELSE NEWSIZE = INTEGER(CADOLD)+2048
OUTFILE(NEWF, - NEWSIZE,-1,0,I,FLAG)
%FINISH
%END; !OF CHECKFF
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!1
!!!!!!!!!!!!!!!!!!! INITIALISATION !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!1
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
PRSTRING = INTERRUPT; !TO CLEAR INTERRUPT
PRSTRING=PRT(EMODE).":"
COMREG(24)=0
CASEIND = 1
CASE == ONECASE
SSOWNER = UINFS(1); !SET OWNER NAME
%CYCLE I = 0,1,6
LASTREC(I)_LP = 0
%REPEAT
%IF EMODE=0 %THENSTART; ! GENUINE EDIT
FINFO("E#EHA",1,EHR,FLAG)
%IF FLAG#218 %START; ! ALREADY EXISTS
PRINTSTRING("
Former editing is saved in file E#EHA. Rename or destroy before
attempting any further EDITs")
%RESULT = 2
%FINISH
REROUTECONTINGENCY(3,65,X'F0000000F'<<('V'-64),FORCLOSE,FLAG)
! TRAP UPPER&LOWER CASE VERSIONS
! OF INT:W,INT:X & INT:Y
! FLAG NOT TESTED SINCE NO
! SENSIBLE ACTION SEEMS POSSIBLE
%FINISH
I = 128*X'1000'; ! 2 SEGMENTS FOR WORK FILE
SYSDICT=0
WORD(0)=0; ! NO WORDS FOR DICT LOOKUP YET
SETWORK(I,FLAG)
->ERR %IF FLAG#0
WSP = I+INTEGER(I+4)
WSE = I+INTEGER(I+8)
COMP=0
SLINEST=1; SPARAST=6; SLINEL=72; ! SET LAYOUT DEFAULTS
ASL = 0
INITIALISE(FLAG)
%IF FLAG#0 %THEN ->ERR
LASTCOM==CLIST(0); ! SO NOT UNASSIGNED ON IMMEDIATE ERROR
%CYCLE; ! **** **** Start of the primary editor loop.
LINECOMPLETE = READCSTRING
%IF LINECOMPLETE<0 %THENSTART; ! FOR INVALID LINES.
PROMPT(PRSTRING)
!FAULT DURING COMMAND INPUT
SKIPSYMBOL %WHILE NEXTSYMBOL#NL; !SKIP REST OF LINE
%FINISH
%IF HSET=0 %THEN HSAVE
I = 0
%WHILE I<COMP %CYCLE
LASTCOM == CURCOM %UNLESS I=0 %OR CURCOM_SWNO=0
! REMEMBER FOR FINAL P1
! BUT NOT IF REPEAT COMMAND
CURCOM == CLIST(I)
I = I+1
J=CURCOM_FLAGS
%IF J&NEEDSS#0 %AND SETA=0 %THEN ERMESS(3,CURCOM_LETT) %C
%AND I=COMP-1 %AND %CONTINUE
BACK = J&BACKWARDS
%IF J&STOP SPELL#0 %THEN WORD(0)=0;! DESTROY "CURRENT" WORD
%IF J&ERROR=0 %THEN ->ED(CURCOM_SWNO)
ERMESS(CURCOM_ERRNO,CURCOM_LETT)
I=COMP-1
%CONTINUE
ED(0): ! LOOP TEST
%IF INTERRUPT="STOP" %THEN ->L31
CURCOM_COUNT<-CURCOM_COUNT+1
%IF CURCOM_COUNT>=CURCOM_PAR %THEN CURCOM_COUNT=0 %C
%ELSE I=CURCOM_LOOP
%CONTINUE
ED(1): ! T
CUR == RECORD(TOP_RL)
CURP = CUR_LP
%CONTINUE
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
ED(2): ! B
CUR == BOT
CURP = 0
%CONTINUE
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
ED(3): ! E
EXIT(0)
REROUTE CONTINGENCY(0,0,0,FORCLOSE,FLAG)
%RESULT = ETERMINATE
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
ED(4): ! I
%EXIT %IF MAPTXT(CURCOM_PAR)=0
COPY(CURCOM_PAR)
INSERT
%CONTINUE
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
ED(5): ! M TEXT
%EXIT %IF MAPTXT(CURCOM_PAR)=0
%IF BACK=0 %THEN K = FIND %ELSE K = FINDB
CUR == BEG
CURP = BEGP
%IF K=0 %THEN ->L31 %ELSE %CONTINUE
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
ED(6): ! M NO.
%IF BACK=0 %AND CURCOM_PAR>0 %THENSTART
K = LINESON(CURCOM_PAR)
CUR == END
CURP = ENDP
%FINISHELSESTART
K = LINESBACK(CURCOM_PAR)
CUR == BEG
CURP = BEGP
%FINISH
%IF K=0 %THEN ->L31 %ELSE %CONTINUE
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
ED(7): ! A TEXT
%EXIT %IF MAPTXT(CURCOM_PAR)=0
%IF BACK=0 %THEN K = FIND %ELSE K = FINDB
%IF K=0 %START; !FAILURE
CUR == BEG
CURP = BEGP
->L31
%FINISH
CUR == END
CURP = ENDP
%CONTINUE
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
ED(8): ! A NO.
%IF BACK=0 %THENSTART
K = CHARSON(CURCOM_PAR)
CUR == END
CURP = ENDP
%FINISHELSESTART
K = CHARSBACK(CURCOM_PAR)
CUR == BEG
CURP = BEGP
%FINISH
%IF K=0 %THEN ->L31 %ELSE %CONTINUE
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
ED(9): ! P TEXT
%EXIT %IF MAPTXT(CURCOM_PAR)=0
%IF BACK=0 %START; !P/TEXT/
%IF FIND=0 %THENSTART
END == BEG
ENDP = BEGP
%FINISHELSESTART
BEG == CUR
BEGP = CURP
CUR == END
CURP = ENDP
K = LINESON(1)
CUR == BEG
CURP = BEGP
%FINISH
J = LINESBACK(0)
%FINISHELSESTART; !P-/TEXT/
K = FINDB; !DOES NOT MATTER IF IT FAILS SINCE BEG L
END == CUR; !SAVE CUR AND CURP
ENDP = CURP
CUR == BEG
CURP = BEGP
K = LINESBACK(0); !PRINT FROM START OF LINE CONTAINING TEX
CUR == END; !RESTORE CUR AND CURP
CURP = ENDP
K = LINESON(1); !MOVE END TO AFTER END OF LINE
%FINISH
PRINTTEXT
%IF INTSTOP=1 %THEN %EXIT; !INT:STOP FOUND
%CONTINUE
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
ED(10): ! P NO.
! OMIT FINAL P1 IF POSSIBLE
%IF I=COMP %AND LASTCOM_LETT='P' %THEN %CONTINUE
%IF BACK=0 %AND CURCOM_PAR>0 %THENSTART
J = LINESBACK(0)
K = LINESON(CURCOM_PAR)
%FINISHELSESTART
K = LINESBACK(CURCOM_PAR)
J = LINESON(1)
%FINISH
PRINTTEXT
%IF INTSTOP=1 %THEN %EXIT; !INT: STOP FOUND
%CONTINUE
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
ED(11): ! D TEXT
%EXIT %IF MAPTXT(CURCOM_PAR)=0
%IF BACK=0 %START; !D/TEXT/
%IF FIND=0 %THENSTART
CUR == BEG
CURP = BEGP
->L31
%FINISH
BEG == CUR
BEGP = CURP
%FINISHELSESTART; !D-/TEXT/
%IF FINDB=0 %START; !FAILURE TO FIND TEXT
CUR == BEG
CURP = BEGP
->L31
%FINISH
END == CUR
ENDP = CURP
%FINISH
DELETE
%CONTINUE
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
ED(12): ! D NO.
J = LINESBACK(0)
%IF CURCOM_PAR=0 %START; ! D0 IS NOOP
CUR == BEG
CURP=BEGP
%CONTINUE
%FINISH
%IF BACK=0 %THENSTART
K = LINESON(CURCOM_PAR)
%FINISHELSESTART
END == BEG
ENDP = BEGP
K = LINESBACK(CURCOM_PAR)
%FINISH
DELETE
%CONTINUE
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
ED(13): ! R TEXT
%EXIT %IF MAPTXT(CURCOM_PAR)=0
%IF BACK=0 %THEN K = FIND %ELSE K = FINDB
%IF K=0 %THENSTART
CUR == BEG
CURP = BEGP
->L31
%FINISH
DELETE
%CONTINUE
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
ED(14): ! R NO.
%IF BACK=0 %THENSTART
BEG == CUR
BEGP = CURP
K = CHARSON(CURCOM_PAR)
%FINISHELSESTART
K = CHARSBACK(CURCOM_PAR)
END == CUR
ENDP = CURP
%FINISH
DELETE
%CONTINUE
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
ED(15): ! Q
%IF EMODE=0 %AND CHANGED#0 %START;! EDIT AND CHANGES MADE
PROMPT("QUIT:")
READSYMBOL(J)
PROMPT(PRSTRING)
%FINISH %ELSE J='Q'
%UNLESS 'Q'#ONE CASE(J)#'Y' %START
!%IF NEWF#".NULL" %THEN CLEARUSE(NEWF,J)
!CHANGE TO READ
! The DESTROY on the next line is only necessary if CYF="".
%IF NEWNEWF=1 %THEN DESTROY(NEWF,J) %ELSESTART
!DONT NEED IT
%IF NEWG=1 %THEN DISCONNECT(OLDF,J) %ELSE DISCONNECT(NEWF,J)
%FINISH
%IF CYF#"" %THEN DISCONNECT(NEWPDF,J)
%IF SYSDICT#0 %THEN DISCONNECT(PRIVDICTNAME,J)
J = 1
%WHILE J<=FILEUSEDCOUNT %CYCLE
DISCONNECT (FILEUSED(J),FLAG)
J = J + 1
%REPEAT
%RESULT = 2
%FINISH
%CONTINUE
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
ED(16): ! S
%IF SETA#0 %THEN KILLPART
SETA = NEWCELL
TXT == RECORD(SETA)
INSERT
SET == TXT
%CONTINUE
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
ED(17): ! K
CUR == SET
KILLPART
%CONTINUE
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
ED(18): ! H
HRESTORE
%CONTINUE
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
ED(19): ! U TEXT
%EXIT %IF MAPTXT(CURCOM_PAR)=0
%IF BACK=0 %START; !U/TEXT/
%IF FIND=0 %THENSTART
CUR == BEG
CURP = BEGP
->L31
%FINISH
BEG == CUR
BEGP = CURP
%FINISHELSESTART; !U-/TEXT/
%IF FINDB=0 %START
CUR == BEG
CURP = BEGP
->L31
%FINISH
END == CUR
ENDP = CURP
%FINISH
REPLACE
%CONTINUE
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
ED(20): ! U NO.
J = LINESBACK(0)
%IF CURCOM_PAR=0 %START; ! U0 IS NOOP
CUR == BEG
CURP=BEGP
%CONTINUE
%FINISH
%IF BACK=0 %THENSTART
K = LINESON(CURCOM_PAR)
%FINISHELSESTART
END == BEG
ENDP = BEGP
K = LINESBACK(CURCOM_PAR)
%FINISH
REPLACE
%CONTINUE
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
ED(21): ! O
CUR == RECORD(SETA)
CURP = 0
%CONTINUE
ED(23): !G NO
!POSITION AT CHARACTER NO IN CURRENT LINE, SPACE
!FILLING IF NECESSARY
POSITION(CURCOM_PAR)
%CONTINUE
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
ED(24): EXTRACT(CURCOM_PAR); !F
%CONTINUE
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
ED(25): !W - WELD
%IF NEWF#".NULL" %START; !IGNORE IF EDIT TO .NULL
J=SETA
%IF SETA#0 %THEN KILL PART
K=CURP-CUR_RP-1
%WHILE CUR\==TOP %CYCLE
K=K+CUR_RP-CUR_LP+1
CUR==RECORD(CUR_LL)
%REPEAT
EXIT(-1); !CLOSE FILES
%IF NEWF=TEMPFILE %THENSTART
%IF CYF="" %THEN NEWF = OLDF %ELSESTART
%IF PFN="" %THEN NEWF = CYF %ELSERESULT = 2
%FINISH
%FINISH
PRINTSTRING("All changes incorporated in ".NEWF.SNL)
%IF J#0 %THEN PRINTSTRING("NB Separator *S* has been killed
")
S = NEWF.",".NEWF; !EDIT (A,B) BECOMES EDIT(B,B)
RETURN LIST(HTOP,HBOT);! HSAVE LIST
J=RETURN CELL(ADDR(HBOT))
INITIALISE(FLAG)
%IF FLAG#0 %THEN ->ERR
J=CHARSON(K)
CUR==END
CURP=ENDP
%FINISH
%CONTINUE
ED(26): ! Z = FLIP CASE DEPENDENCY
%IF CASEIND=0 %START
CASEIND=1; CASE== ONE CASE
%FINISH %ELSE %START
CASEIND=0; CASE==TWO CASE
%FINISH
%CONTINUE
ED(27): ! L=LAYOUT
%IF LAYOUT(CURCOM_PAR,0)=0 %THEN ->L31
%CONTINUE
ED(28): ! J=JUSTIFY
%IF LAYOUT(CURCOM_PAR,1)=0 %THEN ->L31
%CONTINUE
ED(29): ! X=MOVE TO NEXT WRONGLY SPELT WRD
%IF SYSDICT=0 %START
J=INIT DICT
%IF J#0 %THEN ERMESS(4,0) %AND ->L31
%FINISH
%CYCLE
J=NEXT WORD
->L31 %UNLESS J>0; ! *B* ETC
SET HASHES
J=LOOK UP
%REPEAT %UNTIL J=0
J=CHARSBACK(WORD(-1)); ! IN FRONTY OF BUM WORD
CUR==BEG; CURP=BEGP
%CONTINUE
ED(30): ! Y="YES WORD IS SPELT CORRECTLY"
%IF WORD(0)=0 %THEN ERMESS(5,0) %AND ->L31
ENTER
J=CHARSON(WORD(0))
CURP=ENDP; CUR==END
%CONTINUE
ED(31): ! N="NO IGNORE WRONG WORD"
%IF WORD(0)=0 %THEN ERMESS(5,0) %AND ->L31
ENTER TEMP; ! SO IGNORED WORDS QUERIED ONCE
J=CHARSON(WORD(0))
CURP=ENDP; CUR==END
%CONTINUE
L31:
I = COMP-1; ! Go on to final P1.
%REPEAT
%REPEAT; ! **** **** End of the primary editor loop **** ****
ERR: COMREG(24) = FLAG; !RETURN CODE
PSYSMES(ROOT(EMODE),FLAG)
%RESULT = 0
%INTEGERFN READCSTRING
!***********************************************************************
!* READS A COMMAND STRING INTO ARRAY CLIST *
!* LEVEL=0 OUTER LEVEL NORMAL TYPED COMMANDS *
!* LEVEL>0 NESTED COMMANDS BETWEEN BRACKETS *
!* CAN NOT USE RECURSION AS THE C COMMAND CAN CHANGE LEVELS! *
!***********************************************************************
%ROUTINESPEC GOODCOMMAND(%INTEGER SYM,FLAG,PARAM)
%ROUTINESPEC BADCOMMAND(%INTEGER SYM,ERRNO)
%SWITCH SUB,STYPE(1:10)
%INTEGER I,J,K,SYM,ERR,DEF,CFLAGS,PARVAL,LRPTR
%BYTEINTEGERARRAY LOOPBACK(0:40)
%RECORD(CFORM) %NAME CURRCOMP
%ON %EVENT 9 %START; ! INPUT ENDED
PRINTSTRING("Input Ended ")
EXIT(1)
%SIGNAL %EVENT 12,2
%FINISH
! INITIALISE FOR A NEW COMMAND LINE
LCOMP=COMP; ! PREVIOS STRING RETAINED FOR REPEAT
COMP = 0; LEVEL = 0; HSET = 0; ! NO H COMMAND SEEN YET
NLC = 0; ! COUNT OF NEWLINES O-P
INTSTOP = 0; LINECOMPLETE = 0
->NORMAL
REENTER: ! FOR PSEUDO RECURSIVE ENTRY
LEVEL = LEVEL+1
PROMPT("):")
LOOPBACK(LEVEL) = COMP
!
NORMAL:
%UNTIL LINECOMPLETE#0 %CYCLE; ! UNTIL END OF COMMAND
%CYCLE
SYM = ONECASE(NEXT SYMBOL)
J = CHARTYPE(SYM); ! CLASSIFY SYMBOL
%EXITUNLESS J=0 %OR J=SPACE
SKIP SYMBOL
%REPEAT
ERR = SYNTAXERROR; ! MOST COMMON ERROR
->STYPE(J); ! SWITCH ON SYMBOL CLASS
STYPE(NUMCHAR): ! DIGIT OUT OF CONTEXT
%IF COMP=0 %AND LCOMP>1 %AND READI(I)>0 %AND NEXTSYMBOL=NL %START
CURRCOMP==CLIST(LCOMP-2)
%IF CURRCOMP_LETT=']' %THEN COMP=LCOMP-1 %ELSE %C
CURRCOMP==CLIST(LCOMP-1) %AND COMP=LCOMP
CURRCOMP=0
CURRCOMP_LETT=']'
CURRCOMP_PAR=I
%CONTINUE
%FINISH
STYPE(TEXTCHAR): ! ?. ETC OUT OF CONTEXT
STYPE(FILECHAR):
STYPE(FILEEND): ! < & > OUT OF CONTEXT
STYPE(MINUS): ! - OUT OF CONTEXT
STYPE(NONNULL): ! INVALID SYMBOL
SUB(LOOPSTART):
SUB(LOOPEND): ! PARENS INSTEAD OF PARAMS
SUB(MINUS):
SUB(NONNULL): ! WRONG CH STARTS PARAM
SUB(FILEEND):
SUB(COMMAND): ! COMMAND FOLLOWS COMMAND
SKIP SYMBOL
BAD: BADCOMMAND(SYM,ERR)
GOOD COMMAND('P',NUMPAR,1); ! STILL NEED A P1
LINECOMPLETE = -1
%CONTINUE
STYPE(NL): ! NEWLINE
SKIP SYMBOL
%CONTINUEIF LEVEL>0 %OR COMP=0;! IGNORE IN A LOOP OR BEFORE FIRST
GOODCOMMAND('P',NUMPAR,1); ! P1 AT END
LINECOMPLETE = 1
%CONTINUE
STYPE(LOOPEND): ! ) FOUND
SKIP SYMBOL
->BAD %IF LEVEL=0; ! INVALID AT OUTER LEVEL
->BAD %IF LOOPBACK(LEVEL)>=COMP
%IF READI(I)>0 %START
GOODCOMMAND(SYM,0,I)
CURRCOMP_LOOP = LOOPBACK(LEVEL)
LEVEL = LEVEL -1
->BACKUP
%FINISH
ERR = INVALIDLOOP
->BAD
STYPE(LOOPSTART): ! '('
SKIP SYMBOL
->REENTER; ! PSEUDO RECURSION
BACKUP: ! FOR PSEUDO RETURN
%IF LEVEL=0 %THEN PROMPT(PRSTRING)
%IF I<0 %THENRESULT = I
%CONTINUE
STYPE(COMMAND): ! VALID COMMAND LETTER
SKIP SYMBOL
DEF = COMDEF(SYM); ! DEFINITION FROM TABLE
LRPTR=DEF>>12&15; ! PTR TO RELEVANT ALT OF LASTREC
CFLAGS = DEF&(STOP SPELL!NEEDSS); PARVAL=0; ! NO FLAGS AS YET
%IF EMODE#0 %AND DEF&NOTINLOOK#0 %THEN ERR = CHINLOOK %AND ->BAD
! ATTEMPT TO CHANGE WHILE LOOKING
%IF DEF&ALLPAR=0 %THEN ->NOPARAM; ! REQUIRES NO PARAMAETERS
%CYCLE
K = NEXTSYMBOL
->BAD %IF K=NL %AND LEVEL=0
%EXIT %IF K>' '
SKIPSYMBOL
%REPEAT
J = CHARTYPE(K)
%IF J=MINUS %START; ! '- SIGNIFIES BACKWARDS
%IF DEF&BACKWARDS=0 %THEN ->BAD
CFLAGS = CFLAGS!BACKWARDS
SKIPSYMBOL %AND K = NEXTSYMBOL %UNTIL K>' '
J = CHARTYPE(K)
%FINISH
->SUB(J); ! SWITCH ON FIRST PARAMETER CH
SUB(NUMCHAR): ! NUMERIC PARAM (INCLUDES *)
->BAD %IF DEF&NUMPAR=0; ! NOT ALLOWED
->BAD %IF READI(PARVAL)=0; ! NOT VALID
%IF (SYM='L' %OR SYM='J') %AND PARVAL#0 %START
*LSS_PARVAL; *IMDV_1000; *IMDV_100
*ST_I; *LSS_%TOS; *ST_J
*LSS_%TOS; *ST_K
%IF I=0 %THEN I=SLINEST
%IF J=0 %THEN J=SPARAST
%IF K=0 %THEN K=SLINEL
->BAD %UNLESS 0<I<K %AND 0<J<K %AND K<=132 %AND J<=50
%FINISH
CFLAGS = CFLAGS!NUMPAR
->NOPARAM
SUB(TEXTCHAR): ! TEXT PARAMETER
->BAD %IF DEF&TEXTPAR=0; ! TEXT PARAM NOT ALLOWED
%IF K#'''' %START; ! NOT A SINGLE QUOTE
->BAD %IF READTEXT=0; ! NOT GIVEN CORRECTLY
LASTREC(LRPTR) = TXT; ! SAVE PARAM FOR FUTURE '
%FINISHELSESTART; ! ' PARAM. RECOVER PREVIOUS TEXT
SKIPSYMBOL
->BAD %UNLESS LASTREC(LRPTR)_LP#0
COPY(ADDR(LASTREC(LRPTR)))
%FINISH
PARVAL = ADDR(TXT)
CFLAGS = CFLAGS!TEXTPAR
->NOPARAM
SUB(FILECHAR): ! '<'
->BAD %IF DEF&FILEPAR=0
->BAD %IF READTEXT=0
CFLAGS = CFLAGS!FILEPAR
PARVAL = ADDR(TXT)
NOPARAM: ! PARAM NOT REQUIRED OR FOUND OK
%IF DEF&SPECIAL#0 %START; ! SPECIAL ACTIONS HERE
%IF SYM='H' %THEN HSET = 1
%IF SYM='C' %THENSTART
%IF PARVAL>COMP %THEN PARVAL = COMP
%CYCLE COMP = COMP-1,-1,COMP-PARVAL
%IF CLIST(COMP)_FLAGS&TEXTPAR#0 %THEN %C
J = RETURNCELL(CLIST(COMP)_PAR)
%REPEAT
%IF COMP=0 %THEN LEVEL = 0 %ELSE LEVEL = CLIST(COMP-1)_LEVEL
%IF LEVEL=0 %THEN PROMPT(PRSTRING) %ELSE PROMPT("):")
%CONTINUE
%FINISH
%FINISH
GOODCOMMAND(SYM,CFLAGS,PARVAL)
%REPEAT
%RESULT = LINECOMPLETE
%ROUTINE GOODCOMMAND(%INTEGER SYM,FLAGS,PARAM)
!***********************************************************************
!* RECORD A GOOD COMMAND
!***********************************************************************
%INTEGER LAB,I
%IF COMP>99 %START
PRINTSTRING("TOO MANY COMMANDS".SNL)
EXIT(0); ! FORCE EDIT E
%SIGNAL %EVENT 12,3
%FINISH
%IF COMP=0 %AND LCOMP>0 %START; ! THROW PREVIOUS COMMAND STRING
I = 0
%UNTIL I=LCOMP %CYCLE
CUR COM==CLIST(I)
%IF CURCOM_FLAGS&(TEXTPAR!FILEPAR)#0 %THEN %C
J = RETURNCELL(CURCOM_PAR)
I = I+1
%REPEAT
LCOMP=0
%FINISH
%IF 'A'<=SYM<='Z' %THEN LAB = COMDEF(SYM)>>16 %ELSE LAB = 0
%IF FLAGS&(TEXTPAR!FILEPAR)=0 %THEN LAB = LAB>>8
CURRCOMP == CLIST(COMP)
COMP = COMP+1
CURRCOMP = 0
CURRCOMP_LETT = SYM
CURRCOMP_FLAGS = FLAGS
%IF FLAGS&ERROR=0 %THEN CURRCOMP_PAR = PARAM %ELSE CURRCOMP_ERRNO = PARAM
CURRCOMP_LEVEL = LEVEL
CURRCOMP_SWNO <- LAB; ! TO BE REVISED
%END
%ROUTINE BADCOMMAND(%INTEGER SYM,ERRNO)
GOODCOMMAND(SYM,ERROR,ERRNO)
%END
%END
%ROUTINE ERMESS(%INTEGER NO,LETT)
!***********************************************************************
!* OUTPUTS AN ERROR MESSAGE
!***********************************************************************
%STRING(60) A,B,C
%CONSTSTRING(36)%ARRAY ETEXT(0:5)=
"Syntax error in command string",
"Invalid loop repetition count",
"## not allowed when '&&'ing",
"Separator S not set for ##",
"Cannot create private lexicon",
"No word set up for Y command"
A=ETEXT(NO)
%IF A->B.("##").C %THEN A=B.TOSTRING(LETT).C
%IF A->B.("&&").C %THEN A=B.PRT(EMODE).C
PRINTSTRING(A.SNL)
%END
%ROUTINE FORCLOSE(%INTEGER CLASS,SUBCLASS)
!***********************************************************************
!* THIS IS CALLED AFTER A SYSTEM CONTINGENCY. INVOKE EXIT *
!* TO TRY TO SALVAGE EDITING BEFORE PASSING BACK TO SUBSYSTEM *
!***********************************************************************
%INTEGER FLAG
%CONSTBYTEINTEGERARRAY ECODE('V'&15:'Y'&15)=2,1,2,3;
REROUTECONTINGENCY(0,0,0,FORCLOSE,FLAG); ! CANCELL REROUTE
EXIT(ECODE(SUBCLASS&15)); ! TRY TO END TIDILY
SIGNAL(3,CLASS,SUBCLASS,FLAG)
%END; ! OF FORCLOSE
%ROUTINE INITIALISE(%INTEGERNAME FLAG)
!***********************************************************************
!* THIS ROUTINE HAS INITIALISING THAT IS ALSO REQUIRED AFTER W *
!***********************************************************************
PROMPT(PRSTRING)
NEWNEWF = 0; !INDICATES NEW NEWF CREATED
NEWG = 0; !INDICATES REQUIREMENT TO CALL NEWGEN BE
ETERMINATE = 0; !INITIALISE
FILEUSEDCOUNT = 0
SETPAR(S); ! STATICISE PARAMS
%UNLESS PARMAP=3 %THEN FLAG=263 %AND %RETURN;! WRONG NO OF PARAMS
OLDF = SPAR(1); !FIRST PARAM
NEWF = SPAR(2)
CHECKFF(FLAG)
%RETURN %IF FLAG#0
!
! CMODE NEWF CYF NEWNEWF NEWG OLDF
! OLDF=NEWF
! NEWF exists
! member 0 T#EH NEWF* 0 0 NEWF*
! file 3 T#EH null 0 1 NEWF*
! NEWF does not exist
! member 0 T#EH NEWF* 1 0 .NEW
! file 3 NEWF* null 1 0 .NEW
! OLDF#NEWF
! NEWF exists
! member 0 T#EH NEWF* 0 0 OLDF*
! file 3 NEWF* null 0 0 OLDF*
! NEWF does not exist
! member 0 T#EH NEWF* 1 0 OLDF*
! file 3 NEWF* null 1 0 OLDF*
!
! (NEWF* and OLDF* are the original values of NEWF and OLDF).
!
! After CHECKFF has been called, and provided it
! returns a zero flag, then:
! 1. The file whose name is the final value of NEWF exists and is
! usable. This is the file in which the edited text must be
! constructed when "E" or "W" is requested.
! 2. If OLDF # ".NEW" then the file whose name is the final value
! of OLDF exists and is usable. This is the file containing the
! text to be edited. If OLDF is ".NEW", then there is no such
! text.
! 3. CYF is non-null if and only if NEWF* specified a member of
! a partitioned file. In that case, NEWPDF will have the
! partitioned file name, and NEWPDM will have the member name.
! On "E" or "W", after the edited text has been constructed in
! NEWF, then NEWF must be copied into NEWPDF_NEWPDM.
! 4. If NEWG # 0, then after the edited text has been constructed
! in NEWF, we must do NEWGEN(NEWF,OLDF) to complete the
! processing of "E" or "W".
! 5. If 3 or 4 does not apply, then no further action is required
! for "E" or "W" beyond constructing the edited text in NEWF.
! 6. NEWNEWF will be non-zero if and only if NEWF* did not exist
! before the editor was entered. It is used in handling "Q"
! to determine whether NEWF needs to be DESTROYed.
!
BOT == RECORD(NEWCELL)
TOP == RECORD(NEWCELL)
HTOP==RECORD(NEWCELL)
HBOT==RECORD(NEWCELL)
HTOP_RL=ADDR(HBOT)
HBOT_LL=ADDR(HTOP)
BOTA = ADDR(BOT_LL)
TOP_RL = BOTA
TOPA = ADDR(TOP_LL)
BOT_LL = TOPA
CUR == BOT
CURP = 0
ALTERED=0
CHANGED=0; ! NEEDS RESETIING AFTER INSERTING FILE
SETA = 0
%IF OLDF#".NEW" %THENSTART
%IF INTEGER(CADOLD)>INTEGER(CADOLD+4) %START
!FILE CONTAINS SOMETHING
TXT == RECORD(NEWCELL)
TXT_LP = CADOLD+INTEGER(CADOLD+4)
TXT_RP = CADOLD+INTEGER(CADOLD)-1
INSERT
%IF EMODE#2 %START; !MOVE CURSOR TO *T* EXCEPT FOR RECALL
CUR == RECORD(TOP_RL)
CURP = CUR_LP
%FINISH
%FINISH
%FINISH
CHANGED = 0; !USED TO DETERMINE WHETHER FILE HAS BEEN
ALTERED=0; ! TO DETERMINE WHEN TO COPY LIST
HALTERED=-1; ! FORCE COPY BEFORE 1ST COMMAND
HSAVE
%END
%END; !OF ED
%ENDOFFILE