! [ START OF EDIT TEXT - ! ! ! **** **** Attend to this: **** **** ! You cannot use any piece of text which starts with X'00' in this ! editor: and if you put it in a file, you get trouble when you try ! MM' or (M)2. ! ! ! **** **** Private copy of IOCP console package: **** **** ! **** **** The same code should appear in ECCE. **** **** ! **** **** It is important to keep this code up **** **** ! **** **** to date. **** **** ! ! %SYSTEMROUTINESPEC CHANGEFILESIZE( %STRING(31)FILE, %INTEGER NEWSIZE, %INTEGERNAME FLAG) %SYSTEMROUTINESPEC UCTRANSLATE( %INTEGER ADDR,L) %CONSTSTRING(1)SNL=" " %ROUTINE MOVE( %INTEGER LENGTH,FROM,TO) *LB_LENGTH *JAT_14, *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 REROUTE CONTINGENCY(%INTEGER EP,CLASS, %LONGINTEGER MASK,%ROUTINE CLOSE(%INTEGER A,B),%INTEGERNAME FLAG) %SYSTEMROUTINESPEC SIGNAL(%INTEGER EP,CLASS,SUBCLASS,%INTEGERNAME FLAG) %EXTERNALSTRINGFNSPEC UINFS( %INTEGER N) %SYSTEMROUTINESPEC GETJOURNAL( %STRINGNAME FILE, %INTEGERNAME FLAG) %SYSTEMROUTINESPEC STOP %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 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) !* !* !* %CONSTSTRING(6) %ARRAY PRT(0:2)= %C "Edit", "Look", "Recall" %CONSTINTEGER SSCHARFILETYPE=3 %CONSTINTEGER MAXI=X'00200000'; !MAXIMUM INTEGER ALLOWED %CONSTBYTEINTEGERARRAY ROOT(0:2)= 59,78,58 !FOR MESSAGES %ROUTINESPEC ED( %INTEGER EMODE, %STRING(63)S) %OWNINTEGER ETERMINATE; !USED TO INDICATE STATUS FOR EDITOR MESS %OWNINTEGER WUSED; !TO SHOW THAT EDITOR COMMAND W HAS BEEN USED !OF RECALL %EXTERNALROUTINE PEDIT( %STRING(255)S) %STRING(31)S1,S2 %STRING(63)HOLDS %CONSTSTRING(9) %ARRAY TERMMESS(1:2)= %C "completed","abandoned" HOLDS = S; !FOR TERMINATE MESSAGE ETERMINATE = 0; !INITIALISE WUSED = 0; !W NOT YET USED %UNLESS S - > S1.(",").S2 %THEN S = S.",".S !EDIT(A) BECOMES EDIT(A,A) ED(0,S) %IF 1 <= ETERMINATE <= 2 %START !STANDARD CLOSE + FULLMESSAGES PRINTCH(NL); !NEWLINE PRINTSTRING("EDIT ".HOLDS." ".TERMMESS(ETERMINATE)) PRINTCH(NL); !NEWLINE %FINISH %RETURN; !NORMAL RETURN %END; ! EDIT %EXTERNALROUTINE LOOK( %STRING(255)S) %IF S = "" %THEN S = "T#LIST" ED(1,S.",.NULL") PRINTSTRING("LOOK ".S." finished.".SNL) %END; ! LOOK %EXTERNALROUTINE RECALL( %STRING(255)S) %INTEGER FLAG %STRING(11)FILE GETJOURNAL(FILE,FLAG) ->ERR %IF FLAG # 0 ED(2,FILE.",.NULL") ERR: %IF FLAG # 0 %THEN PSYSMES(58,FLAG) %END; !OF RECALL %ROUTINE ED( %INTEGER EMODE, %STRING(63)S) !VALUES OF EMODE: 0 = EDIT ! 1 = LOOK ! 2 = RECALL %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) %ROUTINESPEC COMM( %INTEGER C,P) %INTEGERFNSPEC NEWCELL %INTEGERFNSPEC RETURNCELL( %INTEGER I) %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) %INTEGERARRAY COM,PAR(0:99),LEV( - 1:99) %STRING(31) %ARRAY FILEUSED(1:20); !LIST OF FILES USED FOR INPUT %INTEGER FILEUSEDCOUNT; !COUNT OF FILES USED %RECORDFORMAT CELL( %INTEGER LL,LP,RP,RL) %RECORD(CELL) %NAME TOP,BOT,SET,CUR,BEG,END,TXT,NEW %INTEGER TOPA,BOTA,SETA,CURP,BEGP,ENDP,TXTP %INTEGER CADOLD,CADNEW,TMPNEW,OLDTYP %INTEGER WARNING,NEWG,ASL,WSP,WSE,LEVEL,COMP,I,J,K,NEWNEWF %INTEGER FLAG %INTEGER HCUR,HCURP,HSET,BACK,CHANGED,NLC,INTSTOP %INTEGER CH,CHHELD %INTEGER DEST,VALINT,ISIGN,LINECOMPLETE %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( - 25:25) %RECORD(CELL) %ARRAY LASTREC(7:13) %RECORD(FRF)EHR %RECORD(RF)RR %CONSTBYTEINTEGERARRAY C1( - 1:13)= %C 'W','Q','T','B','E','S','K','O', 'M','A','P','D','R','U','G' %CONSTBYTEINTEGERARRAY V1( - 1:13)= %C 25,15, 1, 2, 3, 16, 17, 21, 5, 7, 9, 11, 13, 19, 22 %ROUTINE RCH( %INTEGERNAME I) READCH(I) %UNTIL I = 10 %OR 32 <= I <= 126 !SKIP CONTROL CHAS %END; ! RCH %ROUTINE READSYMBOL( %INTEGERNAME I) %IF CHHELD # 0 %THENSTART I = CH CHHELD = 0 %FINISHELSE RCH(I) %END; ! READSYMBOL %INTEGERFN NEXTSYMBOL %IF CHHELD = 0 %THENSTART RCH(CH) CHHELD = 1 %FINISH %RESULT = CH %END; ! NEXTSYMBOL %ROUTINE SKIPSYMBOL %INTEGER I %IF CHHELD # 0 %THEN CHHELD = 0 %ELSE RCH(I) %END; ! SKIPSYMBOL !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE COMM( %INTEGER C,P) %IF COMP > 99 %THENSTART PRINTSTRING("TOO MANY COMMANDS".SNL); EXIT(0) STOP; !RETURN TO COMMAND LEVEL ! **** **** That seems a bit brutal. **** **** %FINISH LEV(COMP) = LEVEL COM(COMP) = C PAR(COMP) = P COMP = COMP + 1 %END; !OF COMM !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %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 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %INTEGERFN RETURNCELL( %INTEGER I) INTEGER(I) = ASL ASL = I %RESULT = INTEGER(I + 12) %END; !OF RETURN CELL !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %INTEGERFN READTEXT %INTEGER MARKER,CHAR 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 = NEXTSYMBOL %IF CHAR = MARKER %THENSTART SKIPSYMBOL %IF NEXTSYMBOL # MARKER %THENRESULT = 0 %FINISH %FINISH PROMPT(TOSTRING(MARKER).":") TXT == RECORD(NEWCELL) TXT_LL = 0 TXT_LP = WSP %UNTIL CHAR # MARKER %CYCLE SKIPSYMBOL %UNTIL CHAR = MARKER %CYCLE %IF WSP = WSE %THEN EXTENDWORK; ! FORCE EDIT:E IF FAIL ! **** Causes immediate exit BYTEINTEGER(WSP) = CHAR WSP = WSP + 1 READSYMBOL(CHAR) %UNTIL MARKER # '>' %OR(CHAR # NL %AND CHAR # ' ') %REPEAT CHAR = NEXTSYMBOL %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 J # 0 %THEN SKIPSYMBOL %ELSE J = 1 I = NEXTSYMBOL %REPEAT %IF K >= MAXI %THEN J = 0 ! You aren't allowed to specify +/- MAXI as a literal. MAXI ! is used internally to stand for '*'. %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 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) %IF ADDR(CUR_LL) = HCUR %AND HCURP < CURP %THENSTART HCUR = ADDR(NEW_LL) %FINISH %END; !OF SEPARATE %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 %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 = FIRST; !MASK(0)<<8 ! TEST CHAR DR0 = X'58000000' ! LENB; !STRING DESCRIPTOR DR1 = BEGP; !ADDRESS OF STRING *LB_B; !LOAD B REGISTER *LD_DR0; !LOAD DESCRIPTOR REGISTER *PUT_X'A300' !*SWNE_X'100' SCAN WHILE NOT EQUAL !CONDITION CODE NOW SET AS FOLLOWS !0 REF BYTE NOT FOUND !1 REF BYTE FOUND - ADDRESS IN BOTTOM OF DR *JCC_8,; !JUMP IF NOT FOUND *STD_DR0; !STORE DESCRIPTOR REGISTER BEGP = DR1; !POSSIBLE FIRST BYTE !NOW DEAL WITH SINGLE CHARACTER SEARCH %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,; !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 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 %IF BYTEINTEGER(ENDP) # BYTEINTEGER(TXTP) %THENEXIT %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 = BYTEINTEGER(TXT_RP); ! LAST CHARACTER TO BE FOUND %CYCLE %UNTIL 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 BYTEINTEGER(TXTP) # 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,RESETH CHANGED = 1; !TO INDICATE CHANGE MADE RESETH = 0 %IF ADDR(BEG_LL) = ADDR(END_LL) %THENSTART %IF BEGP = ENDP %THENRETURN %IF ADDR(BEG_LL) = HCUR %AND BEGP <= HCURP %THEN RESETH = 1 %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 %IF I = HCUR %THEN RESETH = 1 I = RETURNCELL(I) %REPEAT ! I is equal to ADDR (END_LL) at this point, so we can replace ! %IF ADDR(END_LL)=HCUR %AND HCURP= BEGP %THEN RESETH = 1 BEG_RP = BEGP - 1 %FINISH %FINISH CUR == END CURP = ENDP %IF RESETH = 1 %THENSTART HCUR = ADDR(CUR_LL) HCURP = CURP %FINISH %END; !OF DELETE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE PRINTTEXT %INTEGER I,J J = 0 %IF BEGP = BEG_LP %THENSTART %IF BEG_LL = TOPA %THEN PRINTSTRING("*T*".SNL) %IF BEG_LL = SETA %THEN PRINTSTRING("*S*".SNL) %FINISH %CYCLE %IF BEGP = CURP %AND ADDR(BEG_LL) = ADDR(CUR_LL) %THEN PRINTCH(94) %IF BEGP = ENDP %AND ADDR(BEG_LL) = ADDR(END_LL) %THENSTART %IF BEGP = 0 %THENSTART %IF ADDR(BEG_LL) = SETA %THEN PRINTSTRING("*S*".SNL) %IF ADDR(BEG_LL) = BOTA %THEN PRINTSTRING("*B*".SNL) %FINISH %RETURN %FINISH I = BYTEINTEGER(BEGP) PRINTCH(I) %IF I = NL %START NLC = NLC + 1 ! CHECK ON LINES 4,8,12 ETC %IF NLC & 3 = 0 %AND INTERRUPT = "STOP" %THENSTART INTSTOP = 1 %RETURN %FINISH %FINISH BEGP = BEGP + 1 %IF BEGP > BEG_RP %START BEG == RECORD(BEG_RL) BEGP = BEG_LP %FINISH %REPEAT %END; !OF PRINT TEXT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %INTEGERFN CHARSON( %INTEGER N) %INTEGER LEN END == CUR ENDP = CURP %WHILE ENDP # 0 %CYCLE LEN = END_RP - ENDP; !LENGTH LEFT IN THIS CELL %IF N <= LEN %START; !NEW POSITION IS IN THIS CELL ENDP = ENDP + N %RESULT = 1; !FOUND OK %FINISH; !TRY NEXT CELL N = N - (LEN + 1); !DECREMENT BY CHAS LEFT +CURRENT ONE END == RECORD(END_RL) ENDP = END_LP %IF N = 0 %THENRESULT = 1; !HIT *S* OR *B* EXACTLY %REPEAT %RESULT = 0; !HIT *B* OR *S* %END; !OF CHARS ON !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! %INTEGERFN LINES ON(%INTEGER N) ! %INTEGER I ! END == CUR ! ENDP = CURP ! I = 0 !L1: %IF I = N %THEN %RESULT = 1 ! %IF ENDP = 0 %THEN %RESULT = 0 ! %IF BYTE INTEGER(ENDP) = NL %THEN I = I+1 ! ENDP = ENDP+1 ! -> L1 %UNLESS ENDP > END_RP ! END == RECORD(END_RL) ! ENDP = END_LP ! -> L1 ! %END !OF LINES ON %INTEGERFN LINESON( %INTEGER COUNT) !*********************************************************************** !* * !* LINESON * !* MOVES END AND ENDP FORWARD FROM CUR AND CURP UNTIL POSITIONED * !* AFTER COUNT NEWLINE CHAS. USES CHARSON IF PARAMETER WAS '*'. * !* OTHERWISE USES SWNE(SCAN WHILE NOT EQUAL)INSTRUCTION TO LOCATE * !* EACH NL CHARACTER * !* * !*********************************************************************** %INTEGER LENE; !COUNT OF CHAS LEFT IN CURRENT SECTION %INTEGER B,DR0,DR1; !DR0 AND DR1 MUST STAY TOGETHER %IF COUNT = MAXI %THENRESULT = CHARSON(COUNT) !QUICKER TO USE CHARSON END == CUR ENDP = CURP AGAIN:%IF ENDP = 0 %THENRESULT = 0; !HIT *B* OR *S* BEFORE ENOUGH NLS LENE = END_RP - ENDP + 1; !CHAS LEFT IN CURRENT SECTION B = X'000A'; !MASK<<8 ! REF CHARACTER DR0 = X'58000000' ! LENE; !TYPE AND BOUND DR1 = ENDP; !START OF SCAN AREA *LB_B; !LOAD B REGISTER *LD_DR0; !LOAD DESCRIPTOR REGISTER *PUT_X'A300'; !SWNE_X'100' - SKIP WHILE NOT EQUAL - USING LENGTH FROM DR !CONDITION CODE NOW CONTAINS 0 IF CHARACTER NOT FOUND *JCC_8,; !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 N + LEN >= 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) %CONSTBYTEINTEGERARRAY SPS(0:131)= %C ' '(132) %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 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.(".").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 %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 %C ADDR(NEW_LL) # ADDR(TOP_LL) %THENSTART CHANGED = 1; !TO INDICATE CHANGE MADE 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 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %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) STOP; !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) * !*********************************************************************** %ROUTINESPEC ADJUSTTEMPFILE(%STRINGNAME NF,%STRING(255)S,%INTEGERNAME F) %STRING(50)MESS %INTEGER L,FILELENGTH,FLAG,I PFN = "" %IF NEWF = ".NULL" %OR((NEWG = 1 %OR CYF = OLDF) %AND %C CHANGED = 0) %THENSTART !LOOK,RECALL,EDIT(A)(NO CHANGES) OR EDIT(A,.NULL) ETERMINATE = 1 %RETURN %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->WRITE IT ! EXTEND fails. %IF NEWF = TEMPFILE %OR FLAG = 275 %OR FLAG = 276 %OR %C FLAG = 280 %OR 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 %THENRETURN MESS="EDITed text will be saved in ".PFN.SNL %IF WHY=0 %THEN PRINTSTRING(MESS) %ELSE TOJOURNAL(ADDR(MESS),LENGTH(MESS)) NEWF = PFN NEWG=0 CYF="" WRITE IT: ! 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(CUR_RL) %REPEAT %IF NEWG = 1 %THENSTART DISCONNECT(OLDF,FLAG) ADJUSTTEMPFILE(OLDF, "EDITed text will be inaccessible in"." this session or job. Log out and log in again and check that ".OLDF." contains the edited text. DO NOT carry on EDITing in this session.",I) %IF I # 0 %THEN ->ABORT %IF NEWG = 1 %THENSTART 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) ADJUSTTEMPFILE(CYF,"Unable to save EDITed file. ",I) %IF I # 0 %THEN ->ABORT %FINISHELSE DISCONNECT(NEWF,FLAG) %FINISH ETERMINATE = 1; !FOR EDITOR TERMINATION MESSAGE %RETURN ABORT:PSYSMES(59,FLAG) %RETURN %ROUTINE ADJUSTTEMPFILE( %STRINGNAME NF, %STRING(255)S, %INTEGERNAME GOFLAG) GOFLAG = 0 %IF FLAG # 0 %THENSTART PSYSMES(59,FLAG) %IF FLAG # 0 %THEN PRINTSTRING(S) %ELSESTART PRINTSTRING("Unable to copy EDITed text into ".NF.". It will be saved in ".PFN.".".SNL) RENAME(NEWF,PFN,FLAG) %IF FLAG # 0 %THEN GOFLAG = - 1 %ELSESTART NEWF = PFN NEWG = 0 %FINISH %FINISH %FINISH %END %END; !OF EXIT %ROUTINE CHECKOLDF( %INTEGERNAME FLAG) %IF OLDF = ".NEW" %THEN FLAG = 0 %ELSESTART !NOTHING TO DO CONNECT(OLDF,0,0,0,RR,FLAG); !CONNECT FOR READING %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 %END; !OF CHECKOLDF %ROUTINE CHECKNEWF( %INTEGERNAME FLAG) %INTEGER I,DOOUTFILE,CMODE %STRING(31)TEMPF,OWNER CYF = "" FLAG = 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 %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) ! 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. %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 ! CHECKOLDF. 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".SNL) %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 %C 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 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 %IF DOOUTFILE # 0 %THEN OUTFILE(NEWF, - 4096,X'40000',0,I,FLAG) %FINISH %FINISH %FINISH %END; !OF CHECKNEWF ! ! The following routine is used in the loop which scans and performs ! the commands in a line of input after they have been analysed and ! encoded into the arrays COM, PAR and LEV. It selects the next ! command in the sequence by adjusting the value of I to point to ! the new command in the three arrays. If trouble arose in handling ! the previous command then this routine finds a non-zero value in ! WARNING and moves on to the last command in the sequence, which ! will always be P1. Special provision is made for the end of a command ! sequence: in particular, the final P1 will be skipped if the previous ! command was also P. The result of the routine GO ON TO NEXT is ! indicated by setting the value of DEST - see below for a comment ! on the significance of DEST. %ROUTINE GOONTONEXT ! Assumes DEST=0 on entry. %IF WARNING = 1 %THENSTART WARNING = 0; ! Reset warning flag. I = COMP - 1; ! Move on to final command (which is P1). ! DEST = 0 is already true. %FINISHELSESTART I = I + 1; ! Move on to next command. %IF I >= COMP - 1 %THENSTART; ! Deal with end of sequence. %IF I >= COMP %OR(10 >= COM(I - 1) >= 9 %AND %C LEV(I - 2) <= 0) %OR(LEV(I - 1) < LEV(I - 2) = 1 %AND %C 10 >= COM(I - 2) >= 9) %THEN DEST = 2 ! %ELSE DEST = 0 which is already true. ! This terminates command processing if we are beyond the end of ! the command sequence OR if we are at the final P1 but the ! previous command was P. Otherwise it marks the final command ! as ready for processing. We know that it is P1 so we do not ! bother with the 'inspection'. %FINISHELSE DEST = 1; ! Mark command 'ready for inspection' ! if it is not at the end of the sequence. %FINISH %END ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!1 !!!!!!!!!!!!!!!!!!! INITIALISATION !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! CHHELD = 0 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! INIT: PRSTRING = INTERRUPT; !TO CLEAR INTERRUPT PRSTRING = PRT(EMODE).":" PROMPT(PRSTRING) COMREG(24) = 0; !SET RETURN CODE NEWNEWF = 0; !INDICATES NEW NEWF CREATED NEWG = 0; !INDICATES REQUIREMENT TO CALL NEWGEN BE WARNING = 0 FILEUSEDCOUNT = 0 LEV( - 1) = - 1 SSOWNER = UINFS(1); !SET OWNER NAME HCUR = 0 %CYCLE I=7,1,13 LASTREC(I)_LP = 0 %REPEAT OLDTYP = 3; !DEFAULT TYPE - CHARACTER SETPAR(S); ! STATICISE PARAMS %UNLESS PARMAP = 3 %THENSTART; ! WRONG NO OF PARAMS FLAG = 263 ->ERR %FINISH %IF EMODE=0 %THEN %START; ! 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") ETERMINATE=2 %RETURN %FINISH REROUTE CONTINGENCY(3,65,X'700000007'<<('W'-64),FORCLOSE,FLAG) ! FLAG NOT TESTED SINCE NO ! SENSIBLE ACTION SEEMS POSSIBLE %FINISH OLDF = SPAR(1); !FIRST PARAM NEWF = SPAR(2) CHECKNEWF(FLAG) ->ERR %IF FLAG # 0 CHECKOLDF(FLAG) ->ERR %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 CHECKNEWF and CHECKOLDF have been called, and provided they ! both return zero flags, 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. ! I = X'4000' SETWORK(I,FLAG) ->ERR %IF FLAG # 0 WSP = I + INTEGER(I + 4) WSE = I + INTEGER(I + 8) ASL = 0 BOT == RECORD(NEWCELL) TOP == RECORD(NEWCELL) BOTA = ADDR(BOT_LL) TOP_RL = BOTA TOPA = ADDR(TOP_LL) BOT_LL = TOPA CUR == BOT CURP = 0 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 %CYCLE; ! **** **** Start of the primary editor loop. COMP = 0 LEVEL = 0 HSET = 0 NLC = 0; !COUNT OF NEWLINES - USED BY PRINTTEXT INTSTOP = 0; !USED TO SHOW INT:STOP FOUND %IF WUSED = 1 %THEN WUSED = 0 %ELSESTART LINECOMPLETE = 0; ! 0 means "not complete" ! >0 means "complete and valid" ! <0 means "invalid". %UNTIL LINECOMPLETE # 0 %CYCLE READSYMBOL(I) I = I - 'a' + 'A' %IF 'a' <= I <= 'z'; ! ACCEPT LOWER CASE EDITOR ! COMMANDS %IF I = NL %THENSTART %IF COMP > 0 %AND LEVEL = 0 %THEN LINECOMPLETE = 1 !END OF COMMAND SEQUENCE - OBEY IT ->AGAIN %FINISH %IF I <= ' ' %THEN ->AGAIN %IF I = '(' %THENSTART LEVEL = LEVEL + 1 PROMPT("):") ->AGAIN %FINISH %IF I = ')' %THENSTART %IF LEVEL = 0 %THENSTART COMM(0,0) LINECOMPLETE = - 1 %FINISHELSESTART LEVEL = LEVEL - 1 %IF READI(J) = 0 %OR J <= 0 %THENSTART COMM( - 1,0) LINECOMPLETE = - 1 %FINISHELSESTART COMM(J,J) %IF LEVEL = 0 %THEN PROMPT(PRSTRING) %FINISH %FINISH ->AGAIN %FINISH K = - 1 %WHILE K <= 6 %AND I # C1(K) %CYCLE; ! Pick out W, Q, T, B, E, S, K, or O. K = K + 1 %REPEAT %IF K <= 6 %THENSTART %IF EMODE # 0 %AND V1(K) = 25 %THENSTART COMM( - 25,0) LINECOMPLETE = - 1 ! W NOT ALLOWED EXCEPT IN EDIT %FINISHELSE COMM(V1(K),0) ->AGAIN %FINISH %IF I = 'H' %THENSTART %IF COMP = 0 %THEN HSET = 1 COMM(18,0) ->AGAIN %FINISH %IF I = 'C' %THENSTART %IF READI(J) = 0 %OR J <= 0 %THENSTART COMM( - 2,0) LINECOMPLETE = - 1 %FINISHELSESTART %IF COMP # 0 %THENSTART %IF J > COMP %THEN J = COMP %CYCLE COMP=COMP - 1, - 1,COMP - J J = PAR(COMP) %IF J > MAXI %THEN J = RETURNCELL(J) %REPEAT %IF COMP = 0 %THEN LEVEL = 0 %ELSE %C LEVEL = LEV(COMP - 1) %IF LEVEL = 0 %THEN PROMPT(PRSTRING) %ELSE PROMPT("):") %FINISH %FINISH ->AGAIN %FINISH %IF I = 'F' %START SKIPSYMBOL %WHILE NEXTSYMBOL <= ' ' %IF NEXTSYMBOL = '<' %AND READTEXT # 0 %THEN COMM(24, ADDR(TXT_LL)) %ELSESTART COMM( - 24,0) LINECOMPLETE = - 1 %FINISH ->AGAIN %FINISH ! ! Deal with commands which take an endpoint or count. VALINT = 0; ! Becomes non-zero only if we get a numeric endpoint. ISIGN = + 1; ! Becomes -1 for a 'backwards endpoint', e.g. M-/D/ or A-4 %IF I = 'I' %THENSTART; ! I is special since its parameter MUST be text - ! a count is not allowed. %IF EMODE # 0 %THENSTART; ! Disallow I if not editing. COMM( - 3,0) LINECOMPLETE = - 1 %FINISHELSESTART J = 4; K = 13 SKIPSYMBOL %WHILE NEXTSYMBOL <= ' ' %FINISH %FINISHELSESTART ! Find K such that C1(K)=I, thus - ! I: M A P D R U G ! K: 7 8 9 10 11 12 13 ! V1(K)=J: 5 7 9 11 13 19 22 K = 7 %WHILE K <= 13 %AND C1(K) # I %CYCLE K = K + 1 %REPEAT %IF K > 13 %THENSTART; ! if character not recognised as a command. COMM(0,0) LINECOMPLETE = - 1 %FINISHELSESTART J = V1(K) %IF EMODE # 0 %AND K > 9 %THEN %C LINECOMPLETE = - 1 %ELSESTART SKIPSYMBOL %WHILE NEXTSYMBOL <= ' ' %IF NEXTSYMBOL = '-' %THENSTART; ! Deal with 'backward endpoint'. ISIGN = - 1 SKIPSYMBOL %UNTIL NEXTSYMBOL > ' ' %FINISH I = NEXTSYMBOL ! Look for a numeric endpoint or count %IF '0' <= I <= '9' %OR I = '*' %OR(ISIGN = + 1 %C %AND I = '+') %THENSTART %IF READI(I) # 0 %THENSTART COMM(J + 1,ISIGN * I) VALINT = - 1 %FINISHELSE LINECOMPLETE = - 1; ! for an invalid number. %FINISHELSESTART %IF K = 13 %THEN LINECOMPLETE = - 1 ! G MUST have a number - ! text not allowed. %FINISH %FINISH %IF LINECOMPLETE # 0 %THEN COMM( - J,0) ! Report any faults picked ! up so far. %FINISH %FINISH %IF VALINT = 0 %AND LINECOMPLETE = 0 %THENSTART ! still looking ! for text endpoint. %IF NEXTSYMBOL = '''' %THENSTART; ! A ' symbol is valid. SKIPSYMBOL %IF LASTREC(K)_LP # 0 %THEN %C COPY(ADDR(LASTREC(K)_LL)) %ELSE LINECOMPLETE = - 1 %FINISHELSESTART; ! Otherwise look for actual text. %IF READTEXT # 0 %THEN LASTREC(K) = TXT %ELSE %C LINECOMPLETE = - 1 %FINISH %IF LINECOMPLETE = 0 %THEN COMM(J, ISIGN * ADDR(TXT_LL)) %ELSE COMM( - J + 1,0) ! **** **** Using negative addresses to mean something **** **** ! **** **** special is a bit dubious - they can be **** **** ! **** **** confused with public addresses. **** **** %FINISH !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! AGAIN: %REPEAT; ! %UNTIL LINE COMPLETE#0 %IF LINECOMPLETE < 0 %THENSTART; ! FOR INVALID LINES. PROMPT(PRSTRING) !FAULT DURING COMMAND INPUT SKIPSYMBOL %WHILE NEXTSYMBOL # NL; !SKIP REST OF LINE %FINISH %FINISH; ! OF CODE FOR WUSED#1. COMM(10,1); !PLANT A P1 AT END OF CHAIN %IF HSET = 0 %THENSTART HCUR = ADDR(CUR_LL) HCURP = CURP %FINISH I = 0 ! DEST=0 means 'command ready to process' ! DEST=1 means 'command ready for inspection' (it might be a loop count) ! DEST=2 means 'all done' - escape from command processing loop. %UNTIL DEST # 1 %CYCLE %UNTIL DEST # 1 %CYCLE DEST = 0 %IF LEV(I) < LEV(I - 1) %AND COM(I) > 0 %THENSTART ! We have just completed one iteration of a loop ! and found a plausible count. %IF COM(I) = 1 %THENSTART ! Just finished the last iteration. COM(I) = PAR(I); ! Reset count ready for next loop. GOONTONEXT %FINISHELSESTART COM(I) = COM(I) - 1; ! Decrement loop count. LEVEL = LEV(I) I = I - 1 %UNTIL LEVEL >= LEV(I - 1); ! Scan back to start of loop. ! Command is now ready to perform. It can't be a loop count ! so it doesn't need inspection: so DEST should be set to ! to zero - but it already is. %FINISH %FINISH %REPEAT ! DEST may be 0 or 2. %WHILE DEST = 0 %CYCLE ->ED(COM(I)) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ED(1): ! T CUR == RECORD(TOP_RL) CURP = CUR_LP ->L34 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ED(2): ! B CUR == BOT CURP = 0 ->L34 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ED(3): ! E EXIT(0) REROUTE CONTINGENCY(0,0,0,FORCLOSE,FLAG) %RETURN !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ED(4): ! I ->L32 %IF MAPTXT(PAR(I)) = 0 %IF LEV(I) > 0 %THEN COPY(PAR(I)) %ELSE PAR(I) = 0 INSERT ->L34 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ED(5): ! M TEXT BACK = 0 %IF PAR(I) < 0 %THEN BACK = 1 ->L32 %IF MAPTXT(PAR(I)) = 0 %IF BACK = 0 %THEN K = FIND %ELSE K = FINDB CUR == BEG CURP = BEGP %IF K = 0 %THEN ->L31 %ELSE ->L34 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ED(6): ! M NO. %IF PAR(I) > 0 %THENSTART K = LINESON(PAR(I)) CUR == END CURP = ENDP %FINISHELSESTART K = LINESBACK(PAR(I)) CUR == BEG CURP = BEGP %FINISH %IF K = 0 %THEN ->L31 %ELSE ->L34 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ED(7): ! A TEXT BACK = 0 %IF PAR(I) < 0 %THEN BACK = 1 ->L32 %IF MAPTXT(PAR(I)) = 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 ->L34 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ED(8): ! A NO. %IF PAR(I) >= 0 %THENSTART K = CHARSON(PAR(I)) CUR == END CURP = ENDP %FINISHELSESTART K = CHARSBACK(PAR(I)) CUR == BEG CURP = BEGP %FINISH %IF K = 0 %THEN ->L31 %ELSE ->L34 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ED(9): ! P TEXT ->L32 %IF MAPTXT(PAR(I)) = 0 %IF PAR(I) > 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 ->L32; !INT:STOP FOUND ->L34 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ED(10): ! P NO. %IF PAR(I) > 0 %THENSTART J = LINESBACK(0) K = LINESON(PAR(I)) %FINISHELSESTART K = LINESBACK(PAR(I)) J = LINESON(1) %FINISH PRINTTEXT %IF INTSTOP = 1 %THEN ->L32; !INT: STOP FOUND ->L34 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ED(11): ! D TEXT ->L32 %IF MAPTXT(PAR(I)) = 0 %IF PAR(I) > 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 ->L34 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ED(12): ! D NO. ->ED( - 11) %IF PAR(I) = 0 J = LINESBACK(0) %IF PAR(I) > 0 %THENSTART K = LINESON(PAR(I)) %FINISHELSESTART END == BEG ENDP = BEGP K = LINESBACK(PAR(I)) %FINISH DELETE ->L34 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ED(13): ! R TEXT ->L32 %IF MAPTXT(PAR(I)) = 0 %IF PAR(I) > 0 %THEN K = FIND %ELSE K = FINDB %IF K = 0 %THENSTART CUR == BEG CURP = BEGP ->L31 %FINISH DELETE ->L34 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ED(14): ! R NO. %IF PAR(I) >= 0 %THENSTART BEG == CUR BEGP = CURP K = CHARSON(PAR(I)) %FINISHELSESTART K = CHARSBACK(PAR(I)) END == CUR ENDP = CURP %FINISH DELETE ->L34 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ED(15): ! Q PROMPT("QUIT:") READSYMBOL(J) %IF J = 'Y' %OR J = 'Q' %OR J = 'y' %OR J = 'q' %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 ETERMINATE = 2; !FOR EDIT MESSAGE %RETURN %FINISH PROMPT(PRSTRING) ->L34 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ED(16): ! S %IF SETA # 0 %THEN KILLPART SETA = NEWCELL TXT == RECORD(SETA) INSERT SET == TXT ->L34 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ED(17): ! K %IF SETA # 0 %THENSTART CUR == SET KILLPART %FINISHELSE ->L25 ->L34 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ED(18): ! H ->L34 %IF HCUR = 0 CUR == RECORD(HCUR) CURP = HCURP ->L34 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ED(19): ! U TEXT ->L25 %IF SETA = 0 ->L32 %IF MAPTXT(PAR(I)) = 0 %IF PAR(I) > 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 ->L34 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ED(20): ! U NO. ->ED( - 20) %IF PAR(I) = 0 ->L25 %IF SETA = 0 J = LINESBACK(0) %IF PAR(I) > 0 %THENSTART K = LINESON(PAR(I)) %FINISHELSESTART END == BEG ENDP = BEGP K = LINESBACK(PAR(I)) %FINISH REPLACE ->L34 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ED(21): ! O %IF SETA # 0 %THENSTART CUR == RECORD(SETA) CURP = 0 %FINISHELSE ->L25 ->L34 ED(23): !G NO !POSITION AT CHARACTER NO IN CURRENT LINE, SPACE !FILLING IF NECESSARY POSITION(PAR(I)) ->L34 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ED(24): EXTRACT(PAR(I)); !F ->L34 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ED(25): !W - WELD %IF NEWF # ".NULL" %START; !IGNORE IF EDIT TO .NULL EXIT(0); !CLOSE FILES %IF NEWF = TEMPFILE %THENSTART %IF CYF = "" %THEN NEWF = OLDF %ELSESTART %IF PFN = "" %THEN NEWF = CYF %ELSERETURN %FINISH %FINISH PRINTSTRING("All changes incorporated in ".NEWF) PRINTCH(NL); !NEWLINE WUSED = 1 S = NEWF.",".NEWF; !EDIT (A,B) BECOMES EDIT(B,B) ->INIT; !AND START AGAIN %FINISH ->L34 ED(0): PRINTSTRING("SYNTAX ?".SNL); ->L341 ED( - 1): PRINTSTRING("LOOP NO. ?".SNL); ->L341 ED( - 2): PRINTSTRING("C NO. ?".SNL); ->L341 ED( - 3): %IF EMODE # 0 %THENSTART PRINTSTRING("I") ->NOTLOOK %FINISH PRINTSTRING("I TEXT ?".SNL); ->L341 ED( - 4): ED( - 5): ED( - 6): ED( - 7): ED( - 8): ED( - 9): ED( - 10): ED( - 12): PRINTCH(C1((( - COM(I)) >> 1) + 5)) %IF COM(I) & 1 # 0 %THEN ->PSNO PRINTSTRING(" TEXT ?".SNL) ->L341 ED( - 11): PRINTCH('D') ->CHOOSE ED( - 13): PRINTCH('R') ->CHOOSE ED( - 19): PRINTCH('U') ->CHOOSE ED( - 22): PRINTCH('G') ! CHOOSE: %IF EMODE # 0 %THEN ->NOTLOOK PSNO: PRINTSTRING(" NO. ?".SNL) ->L341 ED( - 18): PRINTSTRING("U TEXT ?".SNL); ->L341 ED( - 24): PRINTSTRING("F ?".SNL); ->L341 ED( - 25): PRINTSTRING("W") ->NOTLOOK L25: PRINTSTRING("NO *S* ?".SNL); ->L341 NOTLOOK: PRINTSTRING(" not valid when '".PRT(EMODE)."'ing".SNL) ->L341 L31: L341: I = COMP - 1; ->LOOPE; ! Go on to final P1. L32: DEST = 2; ->LOOPE; !No more commands at all. L34: GOONTONEXT LOOPE: %REPEAT %REPEAT I = 0 %UNTIL I = COMP %CYCLE %IF PAR(I) > MAXI %THEN J = RETURNCELL(PAR(I)) I = I + 1 %REPEAT %REPEAT; ! **** **** End of the primary editor loop **** **** ERR: COMREG(24) = FLAG; !RETURN CODE PSYSMES(ROOT(EMODE),FLAG) %RETURN %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 REROUTE CONTINGENCY(0,0,0,FORCLOSE,FLAG);! CANCELL REROUTE EXIT(SUBCLASS-'V'); ! TRY TO END TIDILY SIGNAL(3,CLASS,SUBCLASS,FLAG) %END; ! OF FORCLOSE %END; !OF ED %ENDOFFILE