%CONSTINTEGER EMAS=10,IBMXA=12 %CONSTINTEGER HOST=IBMXA %CONSTSTRING(1) SNL = " " %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) ! %IF HOST=IBMXA %START %CONSTSTRING(1)USEP=":" ! %EXTERNALROUTINESPEC CHANGEFILESIZE%ALIAS"S#CHANGEFILESIZE"( %c %STRINGname FILE, %INTEGERname NEWSIZE, FLAG) %EXTERNALROUTINESPEC UCTRANSLATE %ALIAS "S#UCTRANSold"(%INTEGER ADDR,L) %EXTERNALSTRING(255)%FNSPEC UCSTRING(%STRING(255)S) %EXTERNALROUTINESPEC MOVE%ALIAS "S#MOVE"(%INTEGER LENGTH,FROM,TO) %EXTERNALROUTINESPEC PROMPT(%STRING(15) S) %EXTERNALSTRINGFNSPEC INTERRUPT %EXTERNALROUTINESPEC TOJOURNAL %ALIAS "S#TOJOURNAL"(%INTEGER FROM,LEN) %EXTERNALROUTINESPEC FINFO %ALIAS "S#FINFO"(%STRING(255) FILE, %INTEGER MODE, %RECORD(FRF) %NAME R, %INTEGERNAME FLAG) %EXTERNALROUTINESPEC REROUTECONTINGENCY %ALIAS "S#REROUTECONTINGENCY"( %c %INTEGER EP,CLASS, %LONGINTEGER MASK, %ROUTINE CLOSE(%INTEGER A,B), %INTEGERNAME FLAG) %EXTERNALROUTINESPEC SIGNAL %ALIAS "S#SIGNAL"(%INTEGER EP,CLASS, %c SUBCLASS, %INTEGERNAME FLAG) %EXTERNALROUTINESPEC CHERISH(%STRING(255) NAME) %externalintegerfnspec uinfi(%integer n) %EXTERNALSTRINGFNSPEC UINFS(%INTEGER N) %EXTERNALROUTINESPEC GETJOURNAL %ALIAS "S#GETJOURNAL"( %c %STRINGNAME FILE, %INTEGERNAME FLAG) %EXTERNALROUTINESPEC SENDFILE %ALIAS "S#SENDFILE"(%STRING(255) FILE, %STRING(16) DEVICE, %STRING(24) NAME, %INTEGER COPIES,FORMS, %INTEGERNAME FLAG) %EXTERNALROUTINESPEC sDESTROY %ALIAS "S#DESTROY"(%STRINGname FILE, %c %INTEGERNAME FLAG) %EXTERNALROUTINESPEC SETUSE %ALIAS "S#SETUSEold"(%STRING (255) FILE, %c %INTEGER MODE, VALUE) %EXTERNALROUTINESPEC DISCONNECT %ALIAS "S#DISCONNECTold"(%STRING(255) S, %c %INTEGERNAME FLAG) %EXTERNALROUTINESPEC RENAME %ALIAS "S#RENAME"(%STRING(255) OLDN,NEWN, %c %INTEGERNAME FLAG) %EXTERNALROUTINESPEC MODPDFILE %ALIAS "S#MODPDFILE"(%INTEGER EP, %c %STRING(255) PDFILE, %STRING(11) MEMBER, %STRING(255) INFILE, %INTEGERNAME FLAG) %EXTERNALINTEGERFNSPEC PARMAP %ALIAS "S#PARMAP" %EXTERNALROUTINESPEC SETPAR %ALIAS "S#SETPAR"(%STRING(255) S) %EXTERNALSTRINGFNSPEC SPAR %ALIAS "S#SPAR"(%INTEGER N) %EXTERNALROUTINESPEC NEWGEN %ALIAS "S#NEWGEN"(%STRING(255) S,T, %c %INTEGERNAME FLAG) %EXTERNALROUTINESPEC SETWORK %ALIAS "S#SETWORK"(%INTEGERNAME ADDR,FLAG) %EXTERNALROUTINESPEC SETFNAME %ALIAS "S#SETFNAME"(%STRING(255) NAME) %EXTERNALROUTINESPEC PSYSMES %ALIAS "S#PSYSMES"(%INTEGER ROOT,FLAG) %EXTERNALROUTINESPEC CONNECT %ALIAS "S#CONNECTold"(%STRING(255) S, %c %INTEGER ACCESS,MAXBYTES,PROTECTION, %RECORD(RF) %NAME R, %INTEGERNAME FLAG) %EXTERNALROUTINESPEC OUTFILE %ALIAS "S#OUTFILEold"(%STRING(255) NAME, %c %INTEGER LENGTH,MAXBYTES, PROTECTION, %INTEGERNAME CONAD,FLAG) %EXTERNALINTEGERMAPSPEC COMREG %ALIAS "S#COMREGmap"(%INTEGER I) !* %externalroutinespec fill %alias "S#FILL"(%integer length,from,fill) %externalroutinespec phex %alias "S#PHEX" (%integer n) %externalroutinespec itosnew %alias "S#ITOSnew"(%integer n,%stringname RES) %externalroutinespec itosold %alias "S#ITOS"(%integer value,places) %EXTERNAL %ROUTINE %spec CONSOURCE %ALIAS "S#CONSOURCE" (%STRING (31)FILE, %c %INTEGERNAME AD) %EXTERNAL %ROUTINE %spec CXDUMP %ALIAS "S#CXDUMP" (%INTEGER START, N, DF) %EXTERNAL %ROUTINE %spec DUMP %ALIAS "S#DUMP" (%INTEGER START, FINISH) %STRING (71) %FN %spec MESSAGE(%INTEGER N) %EXTERNAL %ROUTINE %spec FAILUREMESSAGE %ALIAS "S#FAILUREMESSAGE" %C (%INTEGER %NAME NMESS, %STRING %NAME FMST) %EXTERNAL %ROUTINE %spec PRINTMESS %ALIAS "S#PRINTMESS" (%INTEGER %NAME MESS) %EXTERNAL %ROUTINE %spec SSFMESSAGE (%STRING %NAME MSGTXT) %EXTERNAL %ROUTINE %spec SSERR %ALIAS "S#SSERR" (%INTEGER %NAME N) !* %externalroutinespec destroy(%string(255) s) %externalintegerfnspec outpos %EXTERNALSTRING(8)%FN %spec HTOS %ALIAS "S#HTOS" (%INTEGER VALUE,PLACES) %EXTERNALINTEGERFNspec SIZE OF %ALIAS "S#SIZEOF"(%NAME X) %EXTERNALROUTINEspec PRINT %ALIAS "S#PRINT"(%LONGREAL X, %INTEGER N,M) %EXTERNALROUTINEspec WRITE %ALIAS "S#WRITE"(%INTEGER VALUE,PLACES) %FINISH %ELSE %START %CONSTSTRING(1)USEP="." %EXTERNALROUTINESPEC CHANGEFILESIZE%ALIAS"S#CHANGEFILESIZE"(%STRING(31) FILE, %INTEGER NEWSIZE, %INTEGERNAME FLAG) %EXTERNALROUTINESPEC UCTRANSLATE %ALIAS "S#UCTRANSLATE"(%INTEGER ADDR,L) %EXTERNALSTRING(255)%FNSPEC UCSTRING(%STRING(255)S) %EXTERNALROUTINESPEC MOVE%ALIAS "S#MOVE"(%INTEGER LENGTH,FROM,TO) %EXTERNALROUTINESPEC PROMPT(%STRING(15) S) %EXTERNALSTRINGFNSPEC INTERRUPT %EXTERNALROUTINESPEC TOJOURNAL %ALIAS "S#TOJOURNAL"(%INTEGER FROM,LEN) %EXTERNALROUTINESPEC FINFO %ALIAS "S#FINFO"(%STRING(31) FILE, %INTEGER MODE, %RECORD(FRF) %NAME R, %INTEGERNAME FLAG) %EXTERNALROUTINESPEC REROUTECONTINGENCY %ALIAS "S#REROUTECONTINGENCY"(%INTEGER EP,CLASS, %LONGINTEGER MASK, %ROUTINE CLOSE(%INTEGER A,B), %INTEGERNAME FLAG) %EXTERNALROUTINESPEC SIGNAL %ALIAS "S#SIGNAL"(%INTEGER EP,CLASS,SUBCLASS, %INTEGERNAME FLAG) %EXTERNALROUTINESPEC CHERISH(%STRING(255) NAME) %EXTERNALSTRINGFNSPEC UINFS(%INTEGER N) %EXTERNALROUTINESPEC GETJOURNAL %ALIAS "S#GETJOURNAL"(%STRINGNAME FILE, %INTEGERNAME FLAG) %EXTERNALROUTINESPEC SENDFILE %ALIAS "S#SENDFILE"(%STRING(31) FILE, %STRING(16) DEVICE, %STRING(24) NAME, %INTEGER COPIES,FORMS, %INTEGERNAME FLAG) %EXTERNALROUTINESPEC DESTROY %ALIAS "S#DESTROY"(%STRING(31) FILE, %INTEGERNAME FLAG) %EXTERNALROUTINESPEC SETUSE %ALIAS "S#SETUSE"(%STRING (31) FILE, %INTEGER MODE, VALUE) %EXTERNALROUTINESPEC DISCONNECT %ALIAS "S#DISCONNECT"(%STRING(31) S, %INTEGERNAME FLAG) %EXTERNALROUTINESPEC RENAME %ALIAS "S#RENAME"(%STRING(31) OLDN,NEWN, %INTEGERNAME FLAG) %EXTERNALROUTINESPEC MODPDFILE %ALIAS "S#MODPDFILE"(%INTEGER EP, %STRING(31) PDFILE, %STRING(11) MEMBER, %STRING(31) INFILE, %INTEGERNAME FLAG) %EXTERNALINTEGERFNSPEC PARMAP %ALIAS "S#PARMAP" %EXTERNALROUTINESPEC SETPAR %ALIAS "S#SETPAR"(%STRING(255) S) %EXTERNALSTRINGFNSPEC SPAR %ALIAS "S#SPAR"(%INTEGER N) %EXTERNALROUTINESPEC NEWGEN %ALIAS "S#NEWGEN"(%STRING(31) S,T, %INTEGERNAME FLAG) %EXTERNALROUTINESPEC SETWORK %ALIAS "S#SETWORK"(%INTEGERNAME ADDR,FLAG) %EXTERNALROUTINESPEC SETFNAME %ALIAS "S#SETFNAME"(%STRING(40) NAME) %EXTERNALROUTINESPEC PSYSMES %ALIAS "S#PSYSMES"(%INTEGER ROOT,FLAG) %EXTERNALROUTINESPEC CONNECT %ALIAS "S#CONNECT"(%STRING(31) S, %INTEGER ACCESS,MAXBYTES, PROTECTION, %RECORD(RF) %NAME R, %INTEGERNAME FLAG) %EXTERNALROUTINESPEC OUTFILE %ALIAS "S#OUTFILE"(%STRING(31) NAME, %INTEGER LENGTH,MAXBYTES, PROTECTION, %INTEGERNAME CONAD,FLAG) %EXTERNALINTEGERMAPSPEC COMREG %ALIAS "S#COMREG"(%INTEGER I) %FINISH !* !* !* %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 %INTEGER SYSDICTB,SYSDICTA,PRIVDICTB,PRIVDICTA,TEMPDICTB,TEMPDICTA %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.(USEP).REST %THEN FILE = SSOWNER.USEP.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 FILEUSEDCOUNTIMP1 BEGP=BEGP+1 ->AGAIN %UNLESS BEGP>BEG_RP BEG==RECORD(BEG_RL) BEGP=BEG_LP ->START IMP1: END == BEG ENDP = BEGP TXTP = TXT_LP %CYCLE %IF CASEIND=0 %START %IF BYTEINTEGER(ENDP)#BYTEINTEGER(TXTP) %THEN %EXIT %FINISH %ELSE %START %IF CASE(BYTEINTEGER(ENDP))#CASE(BYTEINTEGER(TXTP)) %THENEXIT %FINISH 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 %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 BEGPBEG_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) !*********************************************************************** !* * !* LINESON * !* MOVES END AND ENDP FORWARD FROM CUR AND CURP UNTIL POSITIONED * !* AFTER COUNT NEWLINE CHAS. USES CHARSON IF PARAMETER WAS '*'. * !*********************************************************************** %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 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 !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.(USEP).REST %THEN FILE = SSOWNER.USEP.FILE I = 0 %WHILE IERR %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) LINEST=PARAM//1000000 PARAST=(PARAM-1000000*LINEST)//10000 LINEL=PARAM-100000*LINEST-1000*PARAST %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 CURPWAYOUT %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 CURPFIRST 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 ITOO 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 CURPMISS %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 CURP0 %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 0SGAPS %THEN INSERT SP(I) %AND NEEDED=NEEDED-1 %IF NEEDED<=0 %THEN %RESULT=LAST+1 %FINISH %FINISH I=I+1 %EXIT %UNLESS I0 %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=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 CURP31 %IF CURP>3)&(X'80'>>(J&7))=0 %THEN ->NOSYS %REPEAT %RESULT=1 NOSYS: ! SYSTEM DICTIONARY MISSING %FOR I=1,1,10 %CYCLE J=HASH(I) J=J-(J//PRIVDICTB)*PRIVDICTB %IF BYTEINTEGER(PRIVDICTA+J>>3)&(X'80'>>(J&7))=0 %THEN ->NOTPRIV %REPEAT %RESULT=2 NOTPRIV: %FOR I=1,1,10 %CYCLE J=HASH(I) J=J-(J//TEMPDICTB)*TEMPDICTB %IF BYTEINTEGER(TEMPDICTA+J>>3)&(X'80'>>(J&7))=0 %THEN %RESULT=0 %REPEAT %RESULT=3 %END %ROUTINE ENTER !*********************************************************************** !* ENTERS WORD "WORD" INTO PRIVATE DICTIONARY * !*********************************************************************** %INTEGER I,J %FOR I=1,1,10 %CYCLE J=HASH(I) J=J-(J//PRIVDICTB)*PRIVDICTB BYTEINTEGER(PRIVDICTA+J>>3)=BYTEINTEGER(PRIVDICTA+J>>3)!(X'80'>>(J&7)) %REPEAT %END %ROUTINE ENTERTEMP !*********************************************************************** !* ENTERS WORD "WORD" INTO TEMPORARY DICTIONARY * !*********************************************************************** %INTEGER I,J %FOR I=1,1,10 %CYCLE J=HASH(I) J=J-(J//TEMPDICTB)*TEMPDICTB BYTEINTEGER(TEMPDICTA+J>>3)=BYTEINTEGER(TEMPDICTA+J>>3)!(X'80'>>(J&7)) %REPEAT %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 SYSDICTA#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.USEP.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.(USEP).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.USEP.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->(USEP) %THEN TEMPF=SSOWNER.USEP.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 SYSDICTA=0; SYSDICTB=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 IED(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 DELETE %IF K=0 %THEN ->L31 %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 %IF K=0 %THEN ->L31 %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 %START %IF HOST=IBMXA %THEN SDESTROY(NEWF,J) %ELSE DESTROY(NEWF,J) %FINISH %ELSESTART !DONT NEED IT %IF NEWG=1 %THEN DISCONNECT(OLDF,J) %ELSE DISCONNECT(NEWF,J) %FINISH %IF CYF#"" %THEN DISCONNECT(NEWPDF,J) %IF SYSDICTA#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 %IF K=0 %THEN ->L31 %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 SYSDICTA=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 I=PARVAL//100000 J=(PARVAL-100000*I)//1000 K=PARVAL-100000*I-1000*J %IF I=0 %THEN I=SLINEST %IF J=0 %THEN J=SPARAST %IF K=0 %THEN K=SLINEL ->BAD %UNLESS 0NOPARAM 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