!
SYSTEMROUTINESPEC CHANGEFILESIZE(STRING (31) FILE, INTEGER NEWSIZE,
INTEGERNAME FLAG)
SYSTEMROUTINESPEC UCTRANSLATE(INTEGER ADDR,L)
EXTERNALSTRING (255)FNSPEC UCSTRING(STRING (255)S)
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 EDIT(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 LOOK(STRING (255) S)
INTEGER I
IF S="" THEN S = "T#LIST"
I = ED(1,S.",.NULL")
PRINTSTRING("LOOK ".S." finished.".SNL)
END ; ! LOOK
EXTERNALROUTINE RECALL(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 UCSTRING(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 = UCSTRING(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 UCSTRING(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 J=0 OR K=0 THEN ->L31
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
IF K=0 THEN ->L31
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
IF K=0 THEN ->L31
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
IF K=0 THEN ->L31
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