%CONST %INTEGER DIAGPRINT=0 %CONST %STRING (1) SNL= " " %RECORD %FORMAT FRF(%INTEGER CONAD,FILETYPE,DATASTART,DATEND,SIZE,RUP,EEP,MODE,USERS,ARCH, %STRING (6) TRAN, %STRING (8) DATE,TIME, %INTEGER COUNT,SPARE1,SPARE2) %RECORD %FORMAT RF(%INTEGER CONAD,FILETYPE,DATASTART,DATAEND) ! %CONST %STRING (1) USEP=":" ! %EXTERNAL %INTEGER %FN %SPEC EXIST %ALIAS "S#EXIST"(%STRING (255) PARAM) %EXTERNAL %ROUTINE %SPEC EMAS3(%STRING %NAME COM,PARM, %INTEGER %NAME FLAG) %EXTERNAL %ROUTINE %SPEC GET STRING %ALIAS "S#GETSTRING"(%STRING (255) QUALIFIER, %STRING %NAME VALUE) %EXTERNAL %ROUTINE %SPEC CHANGEFILESIZE %ALIAS "S#CHANGEFILESIZE"(%STRING (255) FILE, %INTEGER NEWSIZE, %INTEGER %NAME FLAG) %EXTERNAL %INTEGER %FN %SPEC CHECKNAME %ALIAS "S#CHECKNAME"(%STRING %NAME FILE, %INTEGER %NAME TYPE,QUAL) %EXTERNAL %ROUTINE %SPEC UCTRANSLATE %ALIAS "s#uctranslate"(%INTEGER ADDR,L) %EXTERNAL %ROUTINE %SPEC MOVE %ALIAS "s#move"(%INTEGER LENGTH,FROM,TO) %EXTERNAL %ROUTINE %SPEC PROMPT %ALIAS "s#prompt"(%STRING (255) S) %EXTERNAL %STRING %FN %SPEC INTERRUPT %ALIAS "s#interrupt" %EXTERNAL %ROUTINE %SPEC TOJOURNAL %ALIAS "S#TOJOURNAL"(%INTEGER FROM,LEN) %EXTERNAL %ROUTINE %SPEC FINFO %ALIAS "S#FINFO"(%STRING (255) FILE, %INTEGER MODE, %RECORD (FRF) %NAME R, %INTEGER %NAME FLAG) %EXTERNAL %ROUTINE %SPEC EMAS3TRAP(%INTEGER %NAME ID,PROT,FLAG) %EXTERNAL %ROUTINE %SPEC EMAS3 GIVE EVENT(%INTEGER %NAME CLASS,SUBCLASS) %EXTERNAL %ROUTINE %SPEC EMAS3 DISCARD TRAP(%INTEGER %NAME TRAPID,FLAG) %EXTERNAL %ROUTINE %SPEC EMAS3 SET TRAP(%INTEGER %NAME TRAPID,CLASS,SUBCLASS,FLAG) %EXTERNAL %ROUTINE %SPEC EMAS3 SIGNAL(%INTEGER %NAME CLASS,SUBCLASS) %EXTERNAL %ROUTINE %SPEC FSTATUS %ALIAS "S#FSTATUS"(%STRING (255) FILE, %INTEGER ACT,VAL, %INTEGER %NAME FLAG) %EXTERNAL %STRING %FN %SPEC UINFS %ALIAS "s#uinfs"(%INTEGER N) %EXTERNAL %ROUTINE %SPEC EMAS3 GETJOURNAL(%STRING %NAME FILE, %INTEGER %NAME FLAG) %EXTERNAL %ROUTINE %SPEC EMAS3 SENDFILE(%STRING %NAME FILE,DEVICE,NAME, %INTEGER %NAME COPIES,FORMS,FLAG) %EXTERNAL %ROUTINE %SPEC EMAS3 DESTROY(%STRING %NAME FILE, %INTEGER %NAME FLAG) %EXTERNAL %ROUTINE %SPEC EMAS3 DISCONNECT(%STRING %NAME S, %INTEGER %NAME FLAG) %EXTERNAL %ROUTINE %SPEC EMAS3 RENAME(%STRING %NAME OLDN,NEWN, %INTEGER %NAME FLAG) %EXTERNAL %ROUTINE %SPEC EMAS3 NEWGEN(%STRING %NAME S,T, %INTEGER %NAME FLAG) %EXTERNAL %ROUTINE %SPEC EMAS3 SETWORK(%INTEGER %NAME ADDR,FLAG) %EXTERNAL %ROUTINE %SPEC EMAS3 SETFNAME(%STRING %NAME NAME) %EXTERNAL %ROUTINE %SPEC EMAS3 SETRETURNCODE(%INTEGER %NAME N) %EXTERNAL %STRING %FN %SPEC FMESS %ALIAS "s#failuremessage"(%INTEGER N) %EXTERNAL %ROUTINE %SPEC EMAS3 CONNECT(%STRING %NAME S, %INTEGER %NAME ACCESS,MAXBYTES,PROTECTION,CONAD,FT,FDS,FDE, FLAG) %EXTERNAL %ROUTINE %SPEC EMAS3 OUTFILE(%STRING %NAME NAME, %INTEGER %NAME LENGTH,MAXBYTES,PROTECTION,CONAD,FLAG) %EXTERNAL %INTEGER %MAP %SPEC COMREG %ALIAS "S#COMREGmap"(%INTEGER I) !* !* !* %CONST %BYTE %INTEGER %ARRAY 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 %CONST %BYTE %INTEGER %ARRAY 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 %CONST %STRING (15) SYSDICTNAME="SUBSYS:EDITDICT" %CONST %STRING (11) PRIVDICTNAME=":E#EDITDICT" %CONST %STRING (6) %ARRAY PRT(0:2)= %C "Edit", "Look", "Recall" %CONST %INTEGER SSCHARFILETYPE= 3 %CONST %INTEGER MAXI= X'02000000'; !MAXIMUM INTEGER ALLOWED %CONST %BYTE %INTEGER %ARRAY SPS(-2:131)= %C NL(2),' '(132) %INTEGER %FN ED(%INTEGER EMODE, %STRING (255) IN,OUT) !*********************************************************************** !* VALUES OF EMODE: 0 = EDIT * !* 1 = LOOK * !* 2 = RECALL * !* Values of result 0 = failed (with message * !* 1 = completed * !* 2 = abandoned * !* 3 = completed without changes * !*********************************************************************** %RECORD %FORMAT CELL(%INTEGER LL,LP,RP,RL) %ROUTINE %SPEC INITIALISE(%INTEGER %NAME FLAG) %ROUTINE %SPEC INSERT %INTEGER %FN %SPEC FIND %INTEGER %FN %SPEC FINDB %ROUTINE %SPEC REPLACE %ROUTINE %SPEC DELETE %ROUTINE %SPEC PRINTTEXT %INTEGER %FN %SPEC CHARSON(%INTEGER N) %INTEGER %FN %SPEC LINESON(%INTEGER N) %INTEGER %FN %SPEC CHARSBACK(%INTEGER N) %INTEGER %FN %SPEC LINESBACK(%INTEGER N) %INTEGER %FN %SPEC READCSTRING %INTEGER %FN %SPEC NEWCELL %ROUTINE %SPEC ERMESS(%INTEGER NO,LETT) %INTEGER %FN %SPEC RETURNCELL(%INTEGER I) %ROUTINE %SPEC RETURNLIST(%RECORD (CELL) %NAME ONE,TWO) %ROUTINE %SPEC COPY(%INTEGER I) %ROUTINE %SPEC EXTENDWORK %INTEGER %FN %SPEC READTEXT %INTEGER %FN %SPEC READI(%INTEGER %NAME N) %ROUTINE %SPEC KILLPART %ROUTINE %SPEC EXTRACT(%INTEGER ADR) %ROUTINE %SPEC FORCLOSE(%INTEGER CLASS,SUBCLASS) %ROUTINE %SPEC EXIT(%INTEGER WHY) %ROUTINE %SPEC POSITION(%INTEGER I) %ROUTINE %SPEC HSAVE %ROUTINE %SPEC HRESTORE %INTEGER %FN %SPEC NEXT WORD %INTEGER %FN %SPEC INIT DICT %ROUTINE %SPEC SET HASHES %INTEGER %FN %SPEC LOOK UP %INTEGER %FN %SPEC MAPTXT(%INTEGER ADR) %INTEGER %FN %SPEC LAYOUT(%INTEGER PARAM,JUSTIFY) %ROUTINE %SPEC ENTER %ROUTINE %SPEC ENTERTEMP %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 %BYTE %INTEGER 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,WSEEN,FLAG,ETERMINATE,CASEIND,HALTERED, ALTERED,HCURP,HSET,BACK,CHANGED,NLC,INTSTOP,LINECOMPLETE,LCOMP,TRAPID,RESFLAG,CLASS,SUBCLASS %INTEGER SYSDICTB,SYSDICTA,PRIVDICTB,PRIVDICTA,TEMPDICTB,TEMPDICTA %BYTE %INTEGER %ARRAY %NAME CASE %CONST %BYTE %INTEGER %ARRAY 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) %CONST %INTEGER MAXHASH=10 %BYTE %INTEGER %ARRAY WORD(-1:31) %INTEGER %ARRAY HASH(0:MAXHASH) %STRING (6) SSOWNER %CONST %STRING (4) TEMPFILE= "T#EH" %STRING (7) PFN %STRING (15) PRSTRING %STRING (255) OLDF,NEWF %STRING (63) INT %SWITCH ED(0:31) %RECORD (CELL) %ARRAY LASTREC(0:6) %RECORD %FORMAT CFORM(%BYTE LETT,FLAGS,LEVEL,SWNO,ERRNO,LOOP, %SHORT COUNT, %INTEGER PAR) %RECORD (CFORM) %NAME CURCOM,LASTCOM %RECORD (RF) RR %RECORD (FRF) EHR %RECORD (CFORM) %ARRAY CLIST(0:99) ! ! VALUES FOR CLIST_FLAGS ! %CONST %INTEGER 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 ! %CONST %INTEGER 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 ! %CONST %INTEGER SYNTAXERROR= 0,INVALIDLOOP = 1,CHINLOOK = 2 ! %CONST %BYTE %INTEGER %ARRAY 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 ! %CONST %INTEGER %ARRAY 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 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!1 !!!!!!!!!!!!!!!!!!! INITIALISATION !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! INT=INTERRUPT; ! to clear interrupt PRSTRING=PRT(EMODE).":" COMREG(24)=0 CASEIND=1 CASE==ONECASE TRAPID=-1 SSOWNER=UINFS(1); ! set owner name %CYCLE I=0,1,6 LASTREC(I)_LP=0 %REPEAT %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") %RESULT=2 %FINISH EMAS3TRAP(TRAPID,1,RESFLAG) %IF RESFLAG#0 %START; ! this block when trap is sprung EMAS3 GIVE EVENT(CLASS,SUBCLASS) EMAS3 DISCARD TRAP(TRAPID,FLAG) FORCLOSE(CLASS,SUBCLASS); ! does not return %FINISH ! %IF TRAPID>=0 %START; !trap has been set %FOR I='W',1,'Y' %CYCLE EMAS3 SET TRAP(TRAPID,65,I,FLAG) %MONITOR %IF FLAG#0 %REPEAT %FINISH ! 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 EMAS3 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 WSEEN=0; ASL=0 OLDF=IN NEWF=OUT 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 %THEN %START; ! 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 INT=INTERRUPT UCTRANSLATE(ADDR(INT)+1,LENGTH(INT)) %IF INT="STOP" %THEN ->L31 CURCOM_COUNT<-CURCOM_COUNT+1 %IF CURCOM_COUNT>=CURCOM_PAR %THEN CURCOM_COUNT=0 %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) %IF TRAPID>=0 %THEN EMAS3 DISCARD TRAP(TRAPID,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 %THEN %START K=LINESON(CURCOM_PAR) CUR==END CURP=ENDP %FINISH %ELSE %START 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 %THEN %START K=CHARSON(CURCOM_PAR) CUR==END CURP=ENDP %FINISH %ELSE %START 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 %THEN %START END==BEG ENDP=BEGP %FINISH %ELSE %START BEG==CUR BEGP=CURP CUR==END CURP=ENDP K=LINESON(1) CUR==BEG CURP=BEGP %FINISH J=LINESBACK(0) %FINISH %ELSE %START; !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 %THEN %START J=LINESBACK(0) K=LINESON(CURCOM_PAR) %FINISH %ELSE %START 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 %THEN %START CUR==BEG CURP=BEGP ->L31 %FINISH BEG==CUR BEGP=CURP %FINISH %ELSE %START; !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 %THEN %START K=LINESON(CURCOM_PAR) %FINISH %ELSE %START 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 %THEN %START CUR==BEG CURP=BEGP ->L31 %FINISH DELETE %CONTINUE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ED(14): ! R NO. %IF BACK=0 %THEN %START BEG==CUR BEGP=CURP K=CHARSON(CURCOM_PAR) %FINISH %ELSE %START 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("Abandon EDIT all changes being lost?(Y or N):") 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 %IF NEWNEWF=1 %THEN %START EMAS3 DESTROY(NEWF,J) %FINISH %ELSE %START !DONT NEED IT %IF NEWG=1 %THEN EMAS3 DISCONNECT(OLDF,J) %ELSE EMAS3 DISCONNECT(NEWF,J) %FINISH %IF TRAPID>=0 %THEN EMAS3DISCARDTRAP(TRAPID,FLAG) %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 %THEN %START CUR==BEG CURP=BEGP ->L31 %FINISH BEG==CUR BEGP=CURP %FINISH %ELSE %START; !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 %THEN %START K=LINESON(CURCOM_PAR) %FINISH %ELSE %START 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 WSEEN=WSEEN+1 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) %THEN %START NEWF=OLDF %FINISH PRINTSTRING("All changes incorporated in ".NEWF.SNL) %IF J#0 %THEN PRINTSTRING("NB Separator *S* has been killed ") OLDF=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 PRINTSTRING(PRT(EMODE)." fails -".FMESS(FLAG)) %IF TRAPID>=0 %THEN EMAS3DISCARDTRAP(TRAPID,FLAG) %RESULT=0 %INTEGER %FN 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) !*********************************************************************** !* returns a list of cells from one to 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 %INTEGER %FN RETURNCELL(%INTEGER I) INTEGER(I)=ASL ASL=I %RESULT=INTEGER(I+12) %END; !OF RETURN CELL %INTEGER %FN READTEXT %INTEGER MARKER,CHAR,SKIPPEDCH %CONST %INTEGER CCHAR=1<<10!1<<12!1<<13; ! nl cr &ff only SKIPSYMBOL %WHILE NEXTSYMBOL<=' ' %IF NEXTSYMBOL='<' %THEN %START MARKER='>'; CHAR=0 %FINISH %ELSE %START READSYMBOL(MARKER) %RESULT=0 %UNLESS MARKER='.' %OR MARKER='/' %OR MARKER='?' ! %RESULT = 0 if no text found. CHAR=NEXTCH %IF CHAR=MARKER %THEN %START READCH(SKIPPEDCH) %IF NEXTCH#MARKER %THEN %RESULT=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 %IF MARKER='?' %OR (MARKER='>' %AND CHAR=0) %OR CHAR>=32 %OR (1<' %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 %INTEGER %FN READI(%INTEGER %NAME 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='*' %THEN %START J=1 K=MAXI %FINISH %ELSE %START 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 %INTEGER %FN MAPTXT(%INTEGER ADR) %STRING (15) OWNER %STRING (255) FILE,REST %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 %THEN %START ! 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>255 %THEN Q=255 BYTEINTEGER(D)=Q FILE=STRING(D) EMAS3 SETFNAME(FILE) %IF FILE=NEWF %THEN %START FLAG=266 ->ERR %FINISH %IF FILE=OLDF %THEN HOLE=CADOLD %ELSE %START EMAS3 CONNECT(FILE,0,0,0,RR_CONAD,RR_FILETYPE,RR_DATASTART,RR_DATAEND,FLAG) %IF FLAG#0 %THEN ->ERR; ! OPEN FAILS %UNLESS RR_FILETYPE=3 %THEN %START; ! INVALID FILE TYPE FLAG=267 ->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)) %THEN %EXIT %FINISH ENDP=ENDP+1 %IF ENDP>END_RP %START END==RECORD(END_RL) ENDP=END_LP %FINISH %IF TXTP=TXT_RP %THEN %RESULT=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 %INTEGER %FN 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 %FINISH %ELSE 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 %THEN %START ! 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 %INTEGER %FN 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 %THEN %RESULT=1; !HIT *S* OR *B* EXACTLY %REPEAT %RESULT=0; !HIT *B* OR *S* %END; !OF CHARS ON %INTEGER %FN 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 %RESULT=CHARSON(N) %IF N=MAXI 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 %INTEGER %FN 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 %THEN %RESULT=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 %INTEGER %FN LINESBACK(%INTEGER N) %INTEGER I %IF N=MAXI %THEN %RESULT=CHARSBACK(N) !QUICKER TO USE CHARS BACK BEG==CUR BEGP=CURP I=-1 %UNTIL I=N %CYCLE %IF BEGP=BEG_LP %THEN %START %IF INTEGER(BEG_LL+8)=0 %THEN %START %IF I=N-1 %THEN %RESULT=1 %ELSE %RESULT=0 %FINISH BEG==RECORD(BEG_LL) BEGP=BEG_RP %FINISH %ELSE BEGP=BEGP-1 %IF BYTEINTEGER(BEGP)=NL %THEN I=I+1 %REPEAT BEGP=BEGP+1 %IF BEGP>BEG_RP %THEN %START 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 %THEN %START CUR==BEG CURP=BEGP %RETURN %FINISH %IF BEGP=0 %OR BYTEINTEGER(BEGP)=NL %THEN %START %IF BEGP#0 %THEN %START END==BEG ENDP=BEGP+1 %IF ENDP>END_RP %THEN %START 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 %THEN %START 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 %THEN %START; !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 (255) FILE,CFILE %STRING (15) OWNER %INTEGER I,FLAG,COUNT,CONAD,L,MOD %RETURN %IF CURP=0; !ALREADY AT *B* OR *S* TXT==RECORD(ADR) BYTEINTEGER(TXT_LP)=TXT_RP-TXT_LP FILE=STRING(TXT_LP) FLAG=129 %AND ->ERR %IF FILE="" 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 CFILE=FILE DEVICE="" %UNLESS CFILE->OWNER.(USEP) %THEN CFILE=SSOWNER.USEP.CFILE I=0 %WHILE IERR %FINISH %REPEAT %FINISH %ELSE %START; ! 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 FLAG=CHECKNAME(FILE,2,2!16!x'80'!MOD<<2); ! char writable and must exist if mod#0 %IF FLAG#0 %THEN ->ERR %IF MOD#0 %THEN %START; !OPEN FILE -MOD I.E. APPEND TO END EMAS3 CONNECT(FILE,3,0,0,RR_CONAD,RR_FILETYPE,RR_DATASTART,RR_DATAEND,FLAG) %IF FLAG=218 %THEN %START; !FILE DOES NOT EXIST MOD=0 %FINISH %ELSE %START %IF FLAG#0 %THEN ->ERR; !SOME OTHER FAILURE COUNT=RR_DATAEND+COUNT; !NEW TOTAL LENGTH EMAS3 DISCONNECT(FILE,FLAG); !MIGHT NOT BE ROOM TO EXTEND CHANGEFILESIZE(FILE,COUNT,FLAG) ->ERR %IF FLAG#0 EMAS3 CONNECT(FILE,3,0,0,RR_CONAD,RR_FILETYPE,RR_DATASTART,RR_DATAEND,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 %THEN %START; ! CREATE A NEW FILE OR OVERWRITE EXISTING ONE EMAS3 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 EMAS3 DISCONNECT(FILE,FLAG) %IF DEVICE#"" %THEN %START EMAS3 SENDFILE(FILE,DEVICE,"EDITOUT",0,0,FLAG) %IF FLAG#0 %THEN PRINTSTRING("SEND fails -".FMESS(FLAG)) %FINISH %RETURN ERR: PRINTSTRING("OPEN fails -".FMESS(FLAG)) %END; !OF EXTRACT %ROUTINE REPLACE %IF BEGP#BEG_LP %THEN %START CUR==BEG CURP=BEGP SEPARATE %FINISH CUR==END CURP=ENDP %IF ENDP=END_LP %THEN NEW==RECORD(CUR_LL) %ELSE %START 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) %THEN %START 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 %INTEGER %FN LAYOUT(%INTEGER PARAM,JUSTIFY) !*********************************************************************** !* LAYS OUT A PARAGRAPH AS DEFINED BY PARAM AND-OR DEFAULTS * !*********************************************************************** %INTEGER %FN %SPEC 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 %BYTE %INTEGER %ARRAY CLINE(0:160) %INTEGER %FN %SPEC ADJUSTLINE(%INTEGER INITLENGTH) LINEST=PARAM//100000 PARAST=(PARAM-100000*LINEST)//1000 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 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='?' %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 %INTEGER %FN 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 CURPNOSYS %FOR I=1,1,10 %CYCLE J=HASH(I) J=J-(J//SYSDICTB)*SYSDICTB %IF BYTEINTEGER(SYSDICTA+J>>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 * !*********************************************************************** %STRING (50) MESS %INTEGER L,FILELENGTH,FLAG,I PFN="" %IF WHY>=0 %AND SYSDICTA#0 %THEN EMAS3 DISCONNECT(PRIVDICTNAME,FLAG) %IF NEWF=".NULL" %OR ((NEWG=1 %OR NEWF=":E#EHB") %AND CHANGED=0) %THEN %START !LOOK,RECALL,EDIT(A)(NO CHANGES) OR EDIT(A,.NULL) EMAS3 DISCONNECT(OLDF,FLAG) %IF NEWG=1 ETERMINATE=3 ETERMINATE=1 %IF WSEEN>0; ! "w" may have been done %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 EMAS3 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 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 PRINTSTRING("EDIT fails -".FMESS(FLAG)) SAVEEDIT: ! TRY TO SAVE EDITING IN E#EHA PFN=":E#EHA" EMAS3 OUTFILE(PFN,L,0,0,CADNEW,I) %IF I#0 %THEN %RETURN MESS="EDITed text will be saved in ".PFN.SNL %IF WHY#3 %THEN PRINTSTRING(MESS) %ELSE TOJOURNAL(ADDR(MESS),LENGTH(MESS)) NEWF=PFN NEWG=0 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 %THEN %START EMAS3 NEWGEN(NEWF,OLDF,FLAG) %IF FLAG#0 %THEN ->ABORT; !UNLIKELY FAILURE %FINISH %ELSE %START EMAS3 DISCONNECT(NEWF,FLAG) %FINISH ETERMINATE=1; !FOR EDITOR TERMINATION MESSAGE %RETURN ABORT:PRINTSTRING("EDIT fails -".FMESS(FLAG)) %END; !OF EXIT %ROUTINE CHECKFF(%INTEGER %NAME FLAG) !*********************************************************************** !* * !* CMODE NEWF NEWNEWF NEWG OLDF * !* OLDF=NEWF * !* NEWF exists * !* file 3 T#EH 0 1 NEWF* * !* NEWF does not exist * !* file 3 NEWF* 1 0 .NEW * !* OLDF#NEWF * !* NEWF exists * !* file 3 NEWF* 0 0 OLDF* * !* NEWF does not exist * !* file 3 NEWF* 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. 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". * !* 4. If 3 does not apply, then no further action is * !* required for "E" or "W" beyond constructing the edited * !* text in NEWF. * !* 5. NEWNEWF will be non-zero 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. * !* * !*********************************************************************** %INTEGER I,DOOUTFILE,CMODE,NEWSIZE %STRING (255) TEMPF,JUNK %STRING (15) OWNER %IF DIAGPRINT#0 %THEN PRINTSTRING("Oldf=".OLDF.", Newf=".NEWF) %AND NEWLINE FLAG=0 DOOUTFILE=0 %UNLESS NEWF=".NULL" %THEN %START ! Check for misuse of another users file ! It is not enough to rely on file protection: you could ! have WRITE access to another users ! file, but you still ! would not be able to change the overall file size. %IF NEWF->OWNER.(USEP).TEMPF %AND OWNER#"" %AND %NOT (OWNER->JUNK.(SSOWNER) %AND JUNK="") %THEN %C FLAG=258 %AND EMAS3 SETFNAME(NEWF) %ELSE %START ! We will try to connect ordinary files for writing, but PD file ! members for reading. 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. EMAS3 CONNECT(NEWF,CMODE,0,0,RR_CONAD,RR_FILETYPE,RR_DATASTART,RR_DATAEND,FLAG) %IF DIAGPRINT#0 %THEN PRINTSTRING("Newf=".NEWF) %AND NEWLINE FILEUSEDCOUNT=1 FILEUSED(1)<-NEWF; ! pam always returns fully pathed name ! Try to connect. %IF NEWF=OLDF %THEN %START; ! Editing a file onto itself. %IF FLAG=0 %THEN %START; ! Connected O.K. - File exists. ! For ordinary files %IF NEWF->OWNER.(USEP) %THEN NEWF=OWNER.USEP.TEMPFILE %ELSE NEWF=TEMPFILE ! we will use a temporary file NEWG=1; ! and do NEWGEN when finished. %FINISH %ELSE 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. %FINISH %ELSE %START; ! Editing from one file into ! another. %IF FLAG=0 %THEN %START; ! The destination file does exist. PRINTSTRING(NEWF." already exists") %IF 0#RR_FILETYPE#3 %THEN %START PRINTSTRING(" but is not a character file") FLAG=267 EMAS3 SETFNAME(NEWF) %FINISH NEWLINE DOOUTFILE=0; ! For editing into an ordinary ! file which does already exist, we ! do not need to create any new file. %FINISH %FINISH %IF FLAG=218 %START; ! The acceptable failue of file does not exist ! is no failure FLAG=0 PRINTSTRING(NEWF." is a new file".SNL) NEWNEWF=1; ! To indicate that a new NEWF has been created. %FINISH %FINISH %FINISH %IF FLAG=0 %THEN %START %IF OLDF#".NEW" %THEN %START EMAS3 CONNECT(OLDF,0,0,0,RR_CONAD,RR_FILETYPE,RR_DATASTART,RR_DATAEND,FLAG) !CONNECT FOR READING %IF FLAG=288 %AND NEWF=":E#EHB" %THEN OLDF=".NEW" %AND FLAG=0 %AND ->CRE TEMPF=OLDF %UNLESS TEMPF->(USEP) %THEN TEMPF=SSOWNER.USEP.TEMPF FILEUSEDCOUNT=FILEUSEDCOUNT+1 FILEUSED(FILEUSEDCOUNT)<-TEMPF %IF FLAG=0 %THEN %START CADOLD=RR_CONAD; !CONNECT ADDRESS OF OLDF %IF RR_FILETYPE#3 %THEN %START FLAG=267; !INVALID FILETYPE EMAS3 SETFNAME(OLDF) %FINISH %FINISH %FINISH %FINISH CRE: %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 %ELSE NEWSIZE=INTEGER(CADOLD)+2048 EMAS3 OUTFILE(NEWF,-NEWSIZE,-1,0,I,FLAG) %FINISH %END; !OF CHECKFF %INTEGER %FN 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! * !*********************************************************************** %ROUTINE %SPEC GOODCOMMAND(%INTEGER SYM,FLAG,PARAM) %ROUTINE %SPEC BADCOMMAND(%INTEGER SYM,ERRNO) %SWITCH SUB,STYPE(1:10) %INTEGER I,J,K,SYM,ERR,DEF,CFLAGS,PARVAL,LRPTR %BYTE %INTEGER %ARRAY 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&127); ! CLASSIFY SYMBOL %EXIT %UNLESS 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 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 %CONTINUE %IF 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 %THEN %RESULT=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&127) %IF J=MINUS %START; ! '- SIGNIFIES BACKWARDS %IF DEF&BACKWARDS=0 %THEN ->BAD CFLAGS=CFLAGS!BACKWARDS SKIPSYMBOL %AND K=NEXTSYMBOL %UNTIL K>' ' J=CHARTYPE(K&127) %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 ' %FINISH %ELSE %START; ! ' 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' %THEN %START %IF PARVAL>COMP %THEN PARVAL=COMP %CYCLE COMP=COMP-1,-1,COMP-PARVAL %IF CLIST(COMP)_FLAGS&TEXTPAR#0 %THEN 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 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 %CONST %STRING (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 %CONST %BYTE %INTEGER %ARRAY ECODE('V'&15:'Y'&15)=2,1,2,3 EXIT(ECODE(SUBCLASS&15)); ! TRY TO END TIDILY EMAS3 SIGNAL(CLASS,SUBCLASS) %END; ! OF FORCLOSE ! !----------------------------------------------------------------------- ! %ROUTINE INITIALISE(%INTEGER %NAME 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 CHECKFF(FLAG) %RETURN %IF FLAG#0 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" %THEN %START %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 ! !----------------------------------------------------------------------- ! %ROUTINE REMOVE(%STRING %NAME FILE) %STRING (6) ME %STRING (255) X,Y ME=UINFS(1) FILE=Y %IF FILE->X.(USEP).Y %AND X=ME %END ! !----------------------------------------------------------------------- ! %EXTERNAL %ROUTINE EDIT %ALIAS "c#edit" %INTEGER I,FAIL %STRING (255) IN,OUT,HOLD %CONST %STRING (11) %ARRAY TERMMESS(1:3)= %C "completed","abandoned","no changes" GET STRING("From;fileormem,char;?;call pamhelp",IN) ! REMOVE(IN) GET STRING("To;fileormem,write,uc;".IN.";call pamhelp",OUT) ! REMOVE(OUT) HOLD=IN %IF OUT#IN %START HOLD=IN.",".OUT %IF EXIST(IN)=0 %THEN printstring(IN." does not exist") %AND %RETURN %FINISH %IF OUT->("_") %START ! PRINTSTRING(" !!This version of EDIT will edit into E#EHB and then copy the editing back into !!the PD member on completion.") !! PRINTSTRING(" PD files can be converted to groups by use of !!the new EMAS-3 command ""PDTOGROUP ?"". !! !") I=ED(0,IN,":E#EHB") %IF I=3 %START EMAS3("copy",IN.",".OUT,FAIL) %AND I=0 %UNLESS IN=OUT EMAS3("destroy",":E#EHB",FAIL) %FINISH %IF I=1 %START EMAS3("copy",":E#EHB,".OUT,FAIL) %IF FAIL=0 %THEN EMAS3("destroy",":E#EHB",FAIL) %FINISH %FINISH %ELSE I=ED(0,IN,OUT) %IF 1<=I<=3 %START !STANDARD CLOSE + FULLMESSAGES PRINTCH(NL) PRINTSTRING("EDIT ".HOLD." ".TERMMESS(I)) PRINTCH(NL); !NEWLINE %FINISH EMAS3 SETRETURNCODE(0) %END; ! EDIT ! !----------------------------------------------------------------------- ! %EXTERNAL %ROUTINE LOOK %ALIAS "c#look" %INTEGER I %STRING (255) S GET STRING("File;fileormem,read;T#LIST;call pamhelp",S) ! REMOVE(S) I=ED(1,S,".NULL") PRINTSTRING("LOOK ".S." finished.".SNL) EMAS3 SETRETURNCODE(0) %END; ! LOOK ! !----------------------------------------------------------------------- ! %EXTERNAL %ROUTINE RECALL %ALIAS "c#recall" %INTEGER FLAG,I %STRING (11) FILE EMAS3 GETJOURNAL(FILE,FLAG) ! REMOVE(FILE) ->ERR %IF FLAG#0 I=ED(2,FILE,".NULL") ERR: EMAS3 SETRETURNCODE(FLAG) %END; !OF RECALL ! !----------------------------------------------------------------------- ! %END %OF %FILE