.TITLE TECO TECO-11 .NLIST TTM .LIST TOC,MEB,BEX .SBTTL TECO-11 ; PDP-11 TECO ; A BRUTE FORCE TRANSLATION BY HANK MAURER ; ( 1-JUNE-1973 THROUGH 4-JUNE-1973 ) ; (WITH I/O ARRANGEMENTS BY BOB HARTMAN) ; (AT FORD OF COLOGNE, WEST GERMANY) ; [SLIGHT MODIFICATIONS BY MARK BRAMHALL OF DEC] ; [FOR CORE EXPANSION AND HIGH/LOW SEGS] ; ; OF OS/8 TECO WHICH COMES FROM A PROGRAM ; ORIGINALLY WRITTEN BY RUSSELL HAMM, WAY BACK WHEN ; MODIFIED FOR OS/8 BY THE O.M.S.I. CREW ; SPEEDED UP, SHORTENED AND MADE PDP-10 ; COMPATIBLE BY RICHARD LARY OF DEC ; WITH ASSISTANCE FROM MARIO DENOBILI OF THE P?S ; LAST EDIT ON 27-OCT-75 BY MARK BRAMHALL VERSON = 20. ;VERSION NUMBER .RADIX 10 .IRP N,<\VERSON> .RADIX 8 .LIST .IDENT /V'N/ .NLIST .ENDM .SBTTL INTERNAL GLOBALS ; ENTRY POINT AND VERSION NUMBER .GLOBL TECO, VERSON ; READ/WRITE (R5 OFFSET) AREA SIZE .GLOBL RWSIZE ; SPECIAL ACCESS TO TECO'S ROUTINES .GLOBL IOERR .GLOBL IOERRS .GLOBL SIZE .GLOBL .VVV.V .GLOBL .YYY.Y ; VARIOUS GLOBAL OFFSETS ARE DEFINED LATER... .SBTTL ASSEMBLY CHARACTERISTICS ; DUE TO THE NATURE OF THE DIFFERENT MACRO ASSEMBLERS... ; THE CODE BELOW DETERMINES IF THIS ASSEMBLER HAS THE AUTOMATIC ; DEFINITION OF THE REGISTERS (R0-R5,SP,PC) AND, IF IT DOES, ; DISABLES BOTH THAT AUTOMATIC REGISTER DEFINITION AND THE ; AUTOMATIC GENERATION OF UNDEFINED SYMBOLS AS EXTERNAL GLOBALS. .IF NDF D$$ABL .IF DF R0 D$$ABL = 1 ;DO THE ".DSABL REG,GBL" .IFF D$$ABL = 0 ;DON'T DO THE ".DSABL REG,GBL" .ENDC .ENDC .IF NE D$$ABL .DSABL REG,GBL ;ONLY IF REQUIRED... .ENDC .SBTTL ASSEMBLY PARAMETERS ; IF THE SYMBOL "E$$TXT" IS DEFINED AS NON-ZERO, THEN ALL ERROR ; CALLS (INCLUDING THOSE FROM 'TECOIO') PASS AN ASCIZ ; STRING TO EXPLAIN THE ERROR. IF THE SYMBOL "E$$TXT" IS ; DEFINED AS ZERO, THEN NO ASCIZ STRINGS NEED BE PASSED ; AND NO EXPLANATIONS ARE EVER GIVEN. ; ; FURTHERMORE, IF THE SYMBOL "E$$TXT" IS DEFINED AS 1, THEN ALL ; ERROR MESSAGES IN TECO WILL BE UPPER AND LOWER CASE. IF ; THE SYMBOL "E$$TXT" IS DEFINED AS -1, THEN ALL MESSAGES ; WILL BE UPPER CASE ONLY. ; ; THE DEFAULT IS FOR "E$$TXT" TO BE DEFINED AS 1. .IIF NDF E$$TXT, E$$TXT=1 ;DO THE DEFAULT E$$TXT = E$$TXT ;LIST THE SYMBOL .GLOBL E$$TXT ;AND GLOBALIZE IT .IF GT E$$TXT .ENABL LC .ENDC .SBTTL READ/WRITE AREAS USED BY TECO ; THERE ARE FOUR DIFFERENT READ/WRITE AREAS: ; ; 1) THE MAIN READ/WRITE AREA (TECO'S CRITICAL DATA) ; ; LENGTH: DEFINED (FOR 'TECOIO') BY THE TECO DEFINED ; GLOBAL "RWSIZE". THIS IS THIS AREA'S SIZE ; IN BYTES. ; WHERE: 'TECOIO' DETERMINES WHERE THIS AREA IS AND ; POINTS TO IT BY SETTING R5 TO POINT TO ITS START. ; SETUP: THIS WHOLE AREA MUST BE CLEARED TO ALL ZEROS ; EXCEPT FOR THE FOLLOWING ITEMS: ; TECOSP (SEE AREA #2) ; TECOPD, PDL, SCHBUF (SEE AREA #3) ; TXSTOR, QRSTOR, ZMAX, QMAX, CURFRE ; (SEE AREA #4) ; [NOTE: THE ABOVE ITEMS ARE DEFINED BY TECO AS ; GLOBAL OFFSET VALUES FROM R5.] ; ; 2) THE SP STACK AREA (FOR TECO AND 'TECOIO' USAGE) ; ; LENGTH: WHATEVER SEEMS REASONABLE (200(8) BYTES SEEMS ; A GOOD GUESS). ; WHERE: 'TECOIO' INITIALLY SETS THE STACK POINTER (SP) ; TO POINT TO THE END OF THIS AREA +2. IN ADDITION, ; 'TECOIO' SETS "TECOSP" TO ALSO POINT TO THE END ; OF THIS AREA +2 (I.E. SP STACK RESET VALUE). ; SETUP: NONE NEEDED. ; ; 3) THE PUSH-DOWN LIST AND SEARCH/FILENAME BUFFER ; ; LENGTH: WHATEVER SEEMS REASONABLE (100(8) BYTES FOR ; THE PUSH-DOWN LIST AND ANOTHER 100(8) BYTES FOR ; THE SEARCH/FILENAME BUFFER SEEM GOODLY NUMBERS). ; NOTE THAT THESE TWO AREAS ARE COMBINED INTO ONE ; AREA. TECO DEPENDS ON THE FACT THAT THIS IS ; TRUE! FURTHERMORE, THE PUSH-DOWN LIST MUST BE ; THE LOWER IN ADDRESS SPACE OF THESE TWO COMBINED ; AREAS. ; 'TECOIO' MUST GLOBALIZE THE SEARCH/FILENAME ; BUFFER'S LENGTH VIA THE SYMBOL "SCHSIZ". .GLOBL SCHSIZ ; WHERE: 'TECOIO' POINTS TO THIS AREA BY SETTING: ; "TECOPD" AND "PDL" TO POINT TO THE AREA'S ; START (PUSH-DOWN LIST). ; "SCHBUF" TO POINT INTO THE MIDDLE OF THE ; AREA (SEARCH BUFFER START). ; SETUP: THE BYTE POINTED TO BY "SCHBUF" MUST BE SETUP ; TO BE -1. ALL OTHER BYTES NEED NOT BE SET UP. ; ; 4) THE TEXT AND Q-REGISTER DATA AREA ; ; LENGTH: 'TECOIO' INITIALLY DEFINES THE LENGTH OF THIS ; AREA, BUT THIS AREA'S SIZE IS CAPABLE OF BEING ; EXPANDED (IF YOUR ENVIORNMENT ALLOWS IT). THE ; AREA'S LENGTH IS REFLECTED BY THE SUM OF "ZMAX" ; PLUS "QMAX" PLUS "CURFRE". THE AREA IS ORGANIZED ; SUCH THAT TEXT STORAGE COMES FIRST (LOWEST IN ; ADDRESS SPACE), THE Q-REGISTER STORAGE COMES ; NEXT, AND THE FREE SPACE (IF ANY) COMES LAST. ; "ZMAX", "QMAX", AND "CURFRE" REFLECT THE SIZES ; OF THESE AREAS RESPECTIVELY. ; WHERE: 'TECOIO' SETS UP TWO POINTERS TO THIS AREA: ; "TXSTOR" POINTS TO AREA'S START ; (TEXT START). ; "QRSTOR" POINTS TO AREA'S MIDDLE ; (Q-REGISTER START). ; NOTE THAT TECO MAY SHUFFLE THE TEXT AND Q-REGISTER ; AREAS WITHIN THIS WHOLE AREA THUS CHANGING "QRSTOR" ; AS WELL AS THE MAXIMUMS. ; ONE OF THE 'TECOIO' SUBROUTINE CALLS IS FOR ; EXPANDING THIS AREA. WHEN 'TECOIO' EXPANDS THE ; AREA (BY ADDING TO ITS END), 'TECOIO' MUST UPDATE ; (BY ADDING TO) "CURFRE" TO REFLECT THE ADDITION. ; SETUP: NONE NEEDED. .SBTTL DOCUMENTATION OF 'TECOIO' SUBROUTINES ; NOTE THAT, UNLESS A REGISTER IS SPECIFICALLY MENTIONED AS ; OUTPUT FROM A SUBROUTINE, IT MUST BE PRESERVED! .GLOBL CLSFIL ;JSR PC,CLSFIL ; NOTE: CLOSES OUTPUT FILE AND DOES THE EB RENAMING IF NEEDED. ; ; IF NO ERROR THEN CARRY BIT IS CLEAR. ; SEE ERROR NOTES IF ERROR. .GLOBL DATE ;JSR PC,DATE ; OUT: R0 = TODAY'S DATE IN SYSTEM INTERNAL FORM .GLOBL GETBUF ;JSR PC,GETBUF ; IN: R0 = POINTER TO BUFFER START ; R1 = MAXIMUM SIZE OF TRANSFER ; R2 = (1/4)*ZMAX(R5) ; ; OUT: IF NO ERROR THEN CARRY BIT IS CLEAR AND ; ZZ(R5) HAS BEEN UPDATED (ADDED TO) TO INDICATE THE AMOUNT ; TRANSFERED INTO THE BUFFER ; FFFLAG(R5) HAS BEEN SET TO: ; -1 IF BUFFER ENDED WITH A FORM FEED ; 0 IF BUFFER ENDED WITHOUT A FORM FEED ; EOFLAG(R5) HAS BEEN SET TO: ; -1 IF FURTHER CALLS WOULD BE FUTILE (I.E. EOF) ; 0 IF FURTHER CALLS MIGHT OBTAIN MORE DATA ; SEE ERROR NOTES IF ERROR. ; ; NOTE: THIS CALL IS MADE FOR 'YANKS' AND 'APPENDS'. ; IF THE CALL IS FOR 'YANK' THEN: ; R0 => START OF TEXT BUFFER ; R1 = CURRENT SIZE OF TEXT BUFFER ; IF THE CALL IS FOR 'APPEND' THEN: ; R0 => FREE TEXT BUFFER AREA ; R1 = REMAINING SPACE IN TEXT BUFFER ; (R1 IS ALWAYS >= 256. FOR THIS CALL) ; THE BUFFER IS FILLED UNTIL: ; 1) FORM FEED FOUND (FORM FEED IS NOT STORED IN THE BUFFER) ; 2) LINE FEED FOUND AND ZZ(R5)>=(3/4)*ZMAX(R5) ; 3) ZZ(R5)>=ZMAX(R5)-128. .GLOBL GETFLS ;JSR PC,GETFLS ; IN: R2 = 'B-'R FOR EB CALL ; = 'I-'R FOR EI CALL ; = 'R-'R FOR ER CALL ; = 'W-'R FOR EW CALL ; THE "DEV:[P,PN]FILE.EXT" STRING IS IN THE SEARCH/FILENAME ; BUFFER (STARTING AT SCHBUF(R5)) AND IS TERMINATED ; WITH A BYTE OF -1 ; ; OUT: IF NO ERROR THEN CARRY BIT IS CLEAR. ; SEE ERROR NOTES IF ERROR. .GLOBL GEXIT ;JMP GEXIT ; NOTE: THIS IS THE WAY TECO EXITS TO THE OPERATING SYSTEM TO ; "GO" .GLOBL INDERR ;JSR PC,INDERR ; NOTE: THIS CALL IS MADE IF AN ERROR OCCURS DURING THE PROCESSING ; OF AN INDIRECT COMMAND FILE. .GLOBL INPSAV ;JSR PC,INPSAV ; NOTE: SAVE STATUS OF CURRENTLY OPEN INPUT FILE. ; SEE ERROR NOTES IF ERROR. .GLOBL KILFIL ;JSR PC,KILFIL ; NOTE: CLOSES AND KILLS OUTPUT FILE. ; ; IF NO ERROR THEN CARRY BIT IS CLEAR. ; SEE ERROR NOTES IF ERROR. .GLOBL LISTEN ;JSR PC,LISTEN ; IN: R0 = 0 MEANS DELIMITERS ARE: ESCAPE, DELETE, CTRL/U, CTRL/G ; R0 <> 0 MEANS ANYTHING IS A DELIMITER (SINGLE CHARACTER MODE) ; ; OUT: R0 = RETURNED CHARACTER (001 <= CHARACTER <= 177) ; ; NOTE: IT IS THE RESPONSIBILITY OF 'LISTEN' TO APPEND A LINE ; FEED TO A CARRIAGE RETURN (IF THE SYSTEM DOESN'T) ; IT IS ALSO THE RESPONSIBILITY OF 'LISTEN' TO ECHO ; THE TYPED CHARACTERS (IF THE SYSTEM DOESN'T) .GLOBL NOCTLO ;JSR PC,NOCTLO ; NOTE: 'NOCTLO' CANCELS ANY CTRL/O EFFECT CURRENTLY IN PROGRESS .GLOBL OUTSAV ;JSR PC,OUTSAV ; NOTE: SAVE STATUS OF CURRENTLY OPEN OUTPUT FILE. ; SEE ERROR NOTES IF ERROR. .GLOBL PRINT ;JSR PC,PRINT ; IN: R3 = POINTER TO STRING OF CHARACTERS TO PRINT ; R4 = NUMBER OF CHARACTERS TO PRINT (0 <= R4 <= 32767.) ; ; NOTE: JUST LIKE 'TYPE', 'PRINT' IS RESPONSIBLE FOR ANY CHARACTER ; CONVERSIONS (IF SYSTEM DOESN'T DO IT FOR YOU) .GLOBL PUTBUF ;JSR PC,PUTBUF ; IN: R0 = POINTER TO BUFFER START ; R1 = NUMBER OF CHARACTERS TO OUTPUT ; R2 = -1 MEANS END BUFFER WITH FORM FEED ; = 0 MEANS DON'T ADD FORM FEED TO BUFFER ; ; OUT: IF NO ERROR THEN CARRY BIT IS CLEAR. ; SEE ERROR NOTES IF ERROR. .GLOBL SIZER ;JSR PC,SIZER ; IN: R1 = AMOUNT TO EXPAND THE TEXT & Q-REG AREA ; ; OUT: IF AREA CAN (AND HAS BEEN) EXPANDED THE AMOUNT DESIRED, ; THEN EXIT WITH THE CARRY CLEAR AND "CURFRE" UPDATED. IF ; THE AREA CANNOT BE EXPANDED THAT AMOUNT, THEN EXIT WITH ; THE CARRY SET AND "CURFRE" UNTOUCHED. ; .GLOBL SIZERB ; NOTE: THIS IS THE AMOUNT TO CALL SIZER WITH WHEN A 'GETBUF' CALL ; DOES NOT RETURN WITH THE FORM FEED FLAG SET. .GLOBL SWITCH ;JSR PC,SWITCH ; OUT: R0 = VALUE OF SWITCH REGISTER .GLOBL TEXIT ;JMP TEXIT ; NOTE: THIS IS THE WAY TECO EXITS TO THE OPERATING SYSTEM .GLOBL TIME ;JSR PC,TIME ; OUT: R0 = TIME OF DAY IN SYSTEM INTERNAL FORM .GLOBL TYPE ;JSR PC,TYPE ; IN: R0 = CHARACTER TO OUTPUT TO TERMINAL ; ; NOTE: ANY CHARACTER CONVERSIONS (TAB'S, ETC.) ARE TO BE DONE BY ; 'TYPE' (IF THE SYSTEM DOESN'T) .GLOBL WATCH ;JSR PC,WATCH ; IN: R0 = 0 MEANS CLEAR THE SCOPE (WE WON'T CALL AGAIN) ; <> 0 MEANS DISPLAY R0 LINES & KEEP SCOPE BUSY ; ; NOTE: YOU CAN ALSO KEEP SCOPE BUSY AT ANY STALL TIME OF COURSE ; THE NUMBER OF LINES TO WATCH IS ALWAYS AVAILABLE IN NWATCH(R5) .GLOBL XITNOW ;JSR PC,XITNOW ; NOTE: IF 'TECOIO' CONDITIONED THE TERMINAL NON-NORMALLY FOR ; TECO, THEN THIS IS THE TIME TO UNCONDITION IT. SHOULD ; INPUT AND/OR OUTPUT BE REQUESTED AGAIN BY TECO (ONLY ; HAPPENS IN CASE OF AN I/O ERROR), YOU MUST DETECT THE ; FACT THAT YOU UNCONDITIONED THE TERMINAL AND RE-CONDITION ; IT. ;ERROR NOTES: ; ON ERROR EXITS SET: ; CARRY BIT ON (I.E. "BCS" BRANCHES) ; R0 = RAD50 OF ERROR CODE ; R2 = POINTER TO ASCIZ TEXT OF ERROR (OR 0 FOR NO TEXT) .SBTTL GENERAL PDP-11 DEFINITIONS ; GENERAL REGISTERS R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 .SBTTL CHARACTER DEFINITIONS NUL = 000 ;ASCII NULL BEL = 007 ;ASCII BELL (CONTROL/G) TAB = 011 ;ASCII HORIZONTAL TAB LF = 012 ;ASCII LINE FEED VT = 013 ;ASCII VERTICAL TAB FF = 014 ;ASCII FORM FEED CR = 015 ;ASCII CARRIAGE RETURN ESC = 033 ;ASCII ESCAPE (ALSO CALLED ALTMODE) SPACE = 040 ;ASCII SPACE LAB = '< ;ASCII LEFT ANGLE BRACKET RAB = '> ;ASCII RIGHT ANGLE BRACKET DEL = 177 ;ASCII DELETE (ALSO CALLED RUBOUT) .SBTTL SPECIAL Q-REGISTERS ; AUXILIARY REGISTER FOR Q-REG PUSH/POP AUXQRG = <'Z-'A+1>+<'9-'0+1>+1 ; COMMAND REGISTER CMDQRG = AUXQRG+1 .SBTTL MACROS .MACRO SORT TABLE,ENTRY JSR R4,SORT'ENTRY .WORD TABLE .ENDM SORT .MACRO PUSH A,B,C,D,E JSR R4,PUSH .NARG $$$$$$ .BYTE $$$$$$,A $$$$$$ = A-2 .IRP OFFSET, .IF NB $$$$$$ = $$$$$$+2 .IF NE $$$$$$-OFFSET .ERROR ; OFFSET IS OUT OF ORDER .ENDC .ENDC .ENDM .ENDM PUSH .MACRO PUSHP A,B,C,D,E JSR R4,PUSHP .NARG $$$$$$ .BYTE $$$$$$,A $$$$$$ = A-2 .IRP OFFSET, .IF NB $$$$$$ = $$$$$$+2 .IF NE $$$$$$-OFFSET .ERROR ; OFFSET IS OUT OF ORDER .ENDC .ENDC .ENDM .ENDM PUSHP .MACRO POP A,B,C,D,E JSR R4,POP .NARG $$$$$$ .BYTE $$$$$$,A+2 $$$$$$ = A+2 .IRP OFFSET, .IF NB $$$$$$ = $$$$$$-2 .IF NE $$$$$$-OFFSET .ERROR ; OFFSET IS OUT OF ORDER .ENDC .ENDC .ENDM .ENDM POP .MACRO SKPSET CHR JSR R4,SKPSET .WORD CHR .ENDM SKPSET .MACRO TSTNXT CHR JSR R4,TSTNXT .WORD CHR .ENDM TSTNXT .MACRO SIZE AREA JSR R4,SIZE .IF IDN , .WORD ZMAX .IFF .IF DIF , .ERROR ; AREA IS ILLEGAL IN SIZE CALL .ENDC .WORD QMAX .ENDC .ENDM SIZE .MACRO OFFSET LABEL,AMT LABEL = $$$$$$ .GLOBL LABEL .LIST LABEL = LABEL .NLIST .IF NB $$$$$$ = AMT*2+$$$$$$ .IFF $$$$$$ = 1*2+$$$$$$ .ENDC .ENDM OFFSET .MACRO .TABLE KIND,A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q .IF NB .NARG $$$$$$ .IF NE $$$$$$&1 .LIST .ODD .NLIST .ENDC .BYTE -1 .ENDC .IRP CHR, .IF NB .BYTE ''CHR .ENDC .ENDM .LIST .'KIND: .NLIST .IRP CHR, .IF NB .WORD KIND''CHR .ENDC .ENDM .ENDM .TABLE .MACRO CMDCHR VAL .IRP NUM,<\> $$'NUM: .CSECT TECOCH . = VAL*2+TECOCH .SBTTL COMMAND CHARACTER VAL .NLIST .WORD $$'NUM .LIST .ENDM .CSECT TECORO .ENDM CMDCHR .MACRO MESSAG TEXT .CSECT TECOER $$$$$$ = . .NLIST BEX .ASCIZ TEXT .LIST BEX .CSECT TECORO .ENDM MESSAG .MACRO ERROR NUM,TEXT,STRING .IF NDF $E$'NUM $E$'NUM: .ENDC $$$$$$ = .-$E$'NUM .IF GE $$$$$$-400 JMP $E$'NUM .MEXIT .ENDC .IF NE $$$$$$ BR $E$'NUM .MEXIT .ENDC .IF NE E$$TXT .IF NB JSR R4,ERRORS .RAD50 /NUM/ MESSAG .WORD $$$$$$ $$$$$$ = 0 .MEXIT .ENDC $$$$$$ = 0 .IRPC CHR, $$$$$$ = $$$$$$*40+<''CHR-<'A-1>> .ENDM .IF EQ $$$$$$&077740-<'N-<'A-1>*40+'A-<'A-1>*40+0> JSR R4,ERRORA $$$$$$ = 1. .IRPC CHR, .IF EQ $$$$$$-3. .BYTE ''CHR-<'A-1> .ENDC $$$$$$ = $$$$$$+1. .ENDM .NCHR $$$$$$, .IF EQ $$$$$$-17. .IRPC CHR, .IF EQ $$$$$$-2. .BYTE ''CHR .ENDC $$$$$$ = $$$$$$-1. .ENDM .MEXIT .ENDC .IF EQ $$$$$$-24. .IRPC CHR, .IF EQ $$$$$$-6. .BYTE ''CHR-100 .ENDC $$$$$$ = $$$$$$-1. .ENDM .MEXIT .ENDC .ERROR ; NUM ERROR IN ILLEGAL FORMAT!! .BYTE '? .MEXIT .ENDC .IF EQ $$$$$$&076037-<'I-<'A-1>*40+0*40+'C-<'A-1>> JSR R4,ERRORC $$$$$$ = 1. .IRPC CHR, .IF EQ $$$$$$-2. .BYTE ''CHR-<'A-1>*5 .ENDC $$$$$$ = $$$$$$+1. .ENDM .NCHR $$$$$$, .IF EQ $$$$$$-21. .IRPC CHR, .IF EQ $$$$$$-12. .BYTE ''CHR .ENDC $$$$$$ = $$$$$$-1. .ENDM .MEXIT .ENDC .IF EQ $$$$$$-30. .IRPC CHR, .IF EQ $$$$$$-18. .BYTE ''CHR-100 .ENDC $$$$$$ = $$$$$$-1. .ENDM .MEXIT .ENDC .ERROR ; NUM ERROR IN ILLEGAL FORMAT!! .BYTE '? .MEXIT .ENDC .IFTF JSR R4,ERRMSG .RAD50 /NUM/ .IFT MESSAG .WORD $$$$$$ .ENDC .ENDM ERROR .SBTTL INITIALIZE TECO'S CODE,DISPATCH,MESSAGE SECTIONS ; INITIALLY DEFINE THE SECTIONS .CSECT TECORO .CSECT TECOCH .CSECT TECOER ; THIS INITIALLY LOADS THE COMMAND DISPATCH TABLE .CSECT TECOCH TECOCH: ;WE NEED A LABEL AT OFFSET=0 .REPT '_+1 ;FOR WHOLE COMMAND SET... .NLIST .WORD ERROR ;DISPATCH TO "ILLEGAL COMMAND" .LIST .ENDR ; NOW BACK TO THE CODE SECTION .CSECT TECORO .SBTTL DEFINE THE OFFSETS FROM R5 $$$$$$ = 0;OFFSETS START AT ZERO... OFFSET SCANP ;COMMAND LINE EXECUTION POINTER OFFSET MPDL ;MACRO FLAG (SAVED "PDL") OFFSET QCMND ;COMMAND LINE OR MACRO Q REG NUMBER OFFSET ITRST ;ITERATION START OFFSET ITRCNT ;ITERATION COUNT OFFSET NOPR ;ARITHMETIC OPERATOR OFFSET NACC ;EXPRESSION ACCULMULATOR OFFSET NFLG ;NUMBER FLAG OFFSET N ;NUMBER OFFSET M ; ARGUMENTS OFFSET OFLG ;OPERATOR FLAG OFFSET CFLG ;COMMA FLAG OFFSET CLNF ;COLON FLAG OFFSET QFLG ;QUOTED STRING FLAG OFFSET OSCANP ;BACKUP FOR "SCANP" OFFSET QUOTE ;QUOTE CHARACTER (NORMALLY ESCAPE) OFFSET QNMBR ;CURRENT Q REG NUMBER OFFSET QLENGT ;COMMAND LINE LENGTH OFFSET CNDN ;COUNTER FOR " NESTING OFFSET NP ;VALUE OF CURRENT NUMBER OFFSET PST ;CHARACTER POSITION AT SEARCH START OFFSET TEMP ;GENERAL TEMPORARY READ/WRITE WORD OFFSET TFLG ;TRACE FLAG AND STOP INDICATOR OFFSET PCNT ;PAREN PUSH COUNTER OFFSET REPFLG ;REPLACE FLAG CLRSIZ = $$$$$$;END OF EACH COMMAND CLEAR AREA OFFSET FFFLAG ;FORM FEED FLAG OFFSET P ;CURRENT TEXT POINTER (.) OFFSET QBASE ;COMMAND LINE Q REG BASE OFFSET OFFSET NMRBAS ;RADIX OFFSET ERRPOS ;ERROR POSITION OFFSET PDL ;PUSH-DOWN LIST POINTER OFFSET LSCHSZ ;-(LENGTH) OF LAST SKIPPED QUOTED STRING OFFSET EHELP ;EDIT HELP LEVEL OFFSET ESFLAG ;EDIT SEARCH FLAG OFFSET ETYPE ;EDIT TYPEOUT FLAG OFFSET EOFLAG ;END-OF-FILE FLAG OFFSET NWATCH ;NUMBER OF LINES TO DISPLAY ON SCOPE OFFSET ROFLAG ;NON-ZERO IF DELETE OR CTRL/U (FOR SCOPE) OFFSET INDIR ;NON-ZERO IF PROCESSING INDIRECT COMMAND FILE OFFSET INPNTR ;@INPNTR(R5) IS NON-ZERO IF INPUT FILE ACTIVE OFFSET OUPNTR ;@OUPNTR(R5) IS NON-ZERO IF OUTPUT FILE ACTIVE OFFSET TXSTOR ;TEXT BUFFER BIAS OFFSET ZZ ;TEXT BUFFER SIZE IN USE OFFSET ZMAX ;TEXT BUFFER SIZE OFFSET QRSTOR ;Q REG BUFFER BIAS OFFSET QZ ;Q REG BUFFER SIZE IN USE OFFSET QMAX ;Q REG BUFFER SIZE OFFSET CURFRE ;CURRENT FREE SPACE IN BYTES OFFSET QARRAY,;Q REGISTER ARRAY OFFSET QPNTR ;COMMAND Q REGISTER OFFSET OFFSET QLCMD ;SIZE OF LAST COMMAND OFFSET TECOSP ;SP STACK RESET VALUE OFFSET TECOPD ;PDL RESET VALUE OFFSET SCHBUF ;SEARCH BUFFER POINTER RWSIZE = $$$$$$ ;SIZE OF AREA IN BYTES .SBTTL SCAN .CMD.R: DEC QZ(R5) ;REMOVE LAST CHARACTER DEC QPNTR(R5) ; ENTERED INTO COMMAND MOV QZ(R5),R3 ;GET POINTER TO END+1 ADD QRSTOR(R5),R3 ; AND MAKE IT ABSOLUTE MOV QPNTR(R5),R4 ;NOW GET SIZE OF THE COMMAND RTS PC ;AND EXIT .ENABL LSB .CSMDQ: INC CNDN(R5) ;INTO ONE MORE CONDITIONAL LEVEL BR SCAN ;AND CONTINUE SCANNING CMDCHR <'?> ;"?" IS THE TRACE FLIP/FLOP COMB TFLG(R5) ;SO FLIP THE FLOP 10$: RTS PC ;AND EXIT 20$: CMP (SP),#.CMD.C ;END OF COMMAND; MAIN CALL? BNE 30$ ;NOPE, SO MUST BE AN ERROR CMP MPDL(R5),PDL(R5) ;YES, IN MACRO? BNE 30$ ;NO (OR UNTERMINATED MACRO) POP ITRST,QCMND,MPDL,SCANP ;YES, RESTORE ALL ITEMS MOV QCMND(R5),R0 ;GET COMMAND Q REG NUMBER JSR PC,SETCMD ;AND (RE)SET COMMAND .CSMD: ;JUST SKIP NEXT CHARACTER SCAN: MOV (R5),R0 ;GET CURRENT COMMAND POINTER CMP R0,QLENGT(R5) ;END OF THIS COMMAND? BHIS 20$ ;YES, CHECK FOR A MACRO ADD QBASE(R5),R0 ;NO, ADD BASE OF COMMAND Q REG ADD QRSTOR(R5),R0 ;AND MAKE ABSOLUTE POINTER MOVB (R0),R0 ;GET NEXT CHARACTER INC (R5) ;THEN BUMP POINTER ONE AHEAD TRACE: TST TFLG(R5) ;TRACING? BEQ 10$ ;NOPE BMI 40$ ;NO, BUT STOP US NOW JMP TYPE ;YES, SO ANNOUNCE CHARACTER 30$: TST (SP)+ ;PURGE THE RETURN ADDRESS MOV #100000,ERRPOS(R5) ;SIGNAL FIRST CHARACTER CHECKING TST MPDL(R5) ;WITHIN MACRO? BEQ .CMD.D ;NO, BACK TO MAIN EDIT LEVEL ERROR UTM,<"Unterminated macro">;YES, MUST BE UNTERMINATED 40$: ERROR XAB,<"Execution aborted">;NO, BUT STOP US NOW .DSABL LSB .SBTTL COMMAND INPUT .ENABL LSB .CMDSP: CMP TEMP(R5),#BEL ;PRECEEDED BY A BELL? BNE 30$ ;NO, SO NORMAL JSR PC,.CMD.R ;REMOVE 1ST BELL AND GET POINTER, COUNT BEQ TECO ;NOTHING, SO RESTART US JSR PC,CRLF ;SOMETHING, SO RETURN CARRIAGE 10$: DEC R4 ;ONE LESS IN COUNT NOW BMI 20$ ;ONLY ONE LINE WAS IN COMMAND CMPB -(R3),#LF ;BACKED UP TO A LINE FEED? BNE 10$ ;NO, KEEP GOING INC R3 ;YES, SO CORRECT POINTER 20$: COM R4 ;NEGATE AND DECREMENT COUNT ADD QPNTR(R5),R4 ;FORM THE POSITIVE PRINT COUNT JSR PC,PRINT ;PRINT THE LINE BR .CMD.W ;AND CONTINUE .CMDBL: MOV #100000,ERRPOS(R5) ;FLAG THIS AS A BELL CMP R0,TEMP(R5) ;2ND BELL? BNE .CMD.Z ;NOPE, SO NORMAL JSR PC,.CMD.R ;REMOVE 1ST BELL AND GET COUNT MOV R4,QLCMD(R5) ;NOW SAVE THE COUNT AS LAST COMMAND COUNT BR TECO ;AND RESTART US .CMDQM: MOV ERRPOS(R5),R4 ;GET ERROR POSITION BLE .CMD.Y ;IF NONE, THEN NORMAL CHARACTER JSR PC,CRLF ;RESTORE CARRIAGE MOV QBASE(R5),R3 ;GET BASE OF LAST COMMAND ADD QRSTOR(R5),R3 ;NOW MAKE POINTER ABSOLUTE JSR PC,PRINT ;AND PRINT THE ERRING LINE MOV #'?,R0 ;END LINE WITH JSR PC,TYPE ; A "?" BR TECO ;AND RESTART US .CMDST: TST QPNTR(R5) ;WAS THIS THE 1ST THING TYPED? 30$: BNE .CMD.Y ;NOPE, SO NORMAL JSR PC,LISTEN ;YES, SO GET NEXT AS Q REG NAME JSR PC,.CMD.S ;AND VALIDATE IT AND SUM IT MOV QLCMD(R5),R0 ;GET LAST COMMAND'S SIZE ADD R0,QZ(R5) ;INCREASE Q REG AREA SIZE BY THAT MOV R0,QPNTR(R5) ;AND PLACE IT IN COMMAND Q REG JSR PC,QADJ ;NOW ADJUST SELECTED REG TO THAT SIZE MOV R2,R3 ;SAVE OFFSET TO SELECTED Q REG MOV #CMDQRG,R0 ;NOW SET TO SUM THE JSR PC,QSUMX ; COMMAND Q REG ADD QRSTOR(R5),R3 ;ABS POINTER TO SELECTED Q REG ADD QRSTOR(R5),R2 ;ABS POINTER TO COMMAND Q REG MOV (R1),R1 ;GET SIZE OF DATA TO MOVE BEQ TECO ;MOVE NOTHING? 40$: MOVB (R2)+,(R3)+ ;MOVE THE DATA DEC R1 ;LOOP FOR BNE 40$ ; ALL .DSABL LSB .ENABL LSB TECO: MOV TECOSP(R5),SP ;SET UP OUR SP STACK JSR PC,NOCTLO ;NO CONTROL/O PLEASE JSR PC,CRLF ;RESTORE CARRIAGE MOV TECOPD(R5),PDL(R5) ;NOW SET UP THE PUSH-DOWN LIST .CMD.D: CMP SP,TECOSP(R5) ;IS SP STACK OK? BNE 40$ ;NOPE CMP PDL(R5),TECOPD(R5) ;WAS LAST COMMAND UNTERMINATED? BNE 40$ ;YEP, GO GIVE ERROR MOV #CMDQRG,R0 ;INDICATE THE COMMAND Q REG JSR PC,QREFR0 ;REFERENCE IT JSR PC,QADJ ; AND ADJUST TO 0 SIZE MOV R5,R1 ;GET OFFSET POINTER MOV #CLRSIZ/2,R2 ;LOAD A COUNT OF HOW MANY TO CLEAR 10$: CLR (R1)+ ;NOW CLEAR OUR VARIABLES DEC R2 ;LOOP BNE 10$ ; AROUND JSR PC,IREST ;RESTORE QUOTE TO 33 (ESCAPE) MOV NWATCH(R5),R0 ;DO WE HAVE TO WATCH? BEQ 20$ ;NO, DON'T CALL HIM TST ROFLAG(R5) ;YES, BUT WAS THERE ANY CHANGE ? BNE 20$ ;NO, DO NOT FIDDLE SCOPE JSR PC,WATCH ;WELL, DO IT! 20$: TST INDIR(R5) ;PROCESSING INDIRECT COMMANDS? BNE .CMD.W ;YES, SO NO ANNOUNCEMENTS MOV #'*,R0 ;NO, SO SET UP TO ANNOUNCE US 30$: JSR PC,NOCTLO ;NO CONTROL/O PLEASE JSR PC,TYPE ;AND TYPE A CHARACTER .CMD.W: CLR TEMP(R5) ;AVOID DOUBLE CHARACTER INDICATIONS .CMD.X: MOV ERRPOS(R5),R0 ;SELECT INPUT MODE JSR PC,LISTEN ;AND GET A CHARACTER CLR ROFLAG(R5) ;ENABLE WATCH AT NEXT PROMPT SORT ..CMD ;SORT OUT SPECIAL CHARACTERS .CMD.Y: CLR ERRPOS(R5) ;NO ERROR POSITION IF STORING .CMD.Z: CLR QLCMD(R5) ;NO LAST COMMAND IF STORING ANYTHING MOV #.CMD.X,-(SP) ;SET THE RETURN ADDRESS MOV R0,TEMP(R5) ;SAVE CHARACTER ABOUT TO BE STORED .CMDAX: MOV QZ(R5),R1 ;GET OUR CURRENT SIZE MOV QMAX(R5),R2 ;AND OUR MAXIMUM SIZE DEC R2 ;ADJUSTED FOR NEW CHARACTER CMP R1,R2 ;CAN WE DO THIS? BHIS 50$ ;NO, GO GIVE ERROR INC QZ(R5) ;INDICATE 1 MORE IN COMMAND INC QPNTR(R5) ; Q REGISTER ADD QRSTOR(R5),R1 ;GET POSITION TO STORE IN MOVB R0,(R1) ;AND STORE CHARACTER SUB QRSTOR(R5),R1 ;BACK TO RELATIVE AGAIN ADD #100.,R1 ;FUDGE BY 100. MORE CHARACTERS SIZE QREGS ;GET ROOM FOR THOSE CHARACTERS BCS 70$ ;ALL IS STILL O.K. MOV #BEL,R0 ;IF NOT, THEN RING THE BELL JMP TYPE ;FOR A WARNING, THEN CONTINUE 40$: ERROR UTC,<"Unterminated command"> 50$: ERROR MEM,<"Memory overflow"> .CMDRO: MOV #30$,-(SP) ;SET RETURN ADDRESS FROM RUBBING OUT 60$: INC ROFLAG(R5) ;IF IT ALL VANISHES, DO NOT WATCH TST QPNTR(R5) ;ANYTHING LEFT TO REMOVE? BEQ TECO ;NO, SO RESTART US JSR PC,.CMD.R ;REMOVE A CHARACTER AND GET POINTER MOVB (R3),R0 ;TO GET CHARACTER REMOVED 70$: RTS PC ;NOW EXIT .CMDCU: JSR PC,60$ ;REMOVE 1 CHARACTER FROM BUFFER CMP R0,#LF ;LINE FEED JUST REMOVED? BNE .CMDCU ;NOPE, KEEP REMOVING INC QZ(R5) ;YEP, SO PUT IT INC QPNTR(R5) ; BACK IN COMMAND JSR PC,CRLF ;RESTORE CARRIAGE BR .CMD.W ;AND CONTINUE .DSABL LSB .SBTTL INTERPRETER .ENABL LSB .CMDAM: CMP R0,TEMP(R5) ;2ND ESCAPE? BNE .CMD.Y ;NOPE, SO NORMAL CHARACTER JSR PC,.CMDAX ;YES, SO STORE THE FINAL ESCAPE MOV QPNTR(R5),QLCMD(R5) ; AND SAVE COMMAND AS LAST TST INDIR(R5) ;PROCESSING INDIRECT OCMMANDS? BNE 10$ ;YES, SO NO CARRIAGE RESTORE JSR PC,CRLF ;NO, SO RESTORE THE CARRIAGE 10$: MOV #CMDQRG,R0 ;SET UP TO REFERENCE JSR PC,SETCMD ; THE COMMAND REGISTER 20$: JSR PC,SCAN ;SCAN THE COMMAND .CMD.C: JSR PC,UPPERC ; AND FORCE UPPER CASE 30$: MOV R0,R1 ;COPY THE CHARACTER CLR R0 ;LEAVE R0 (THE AC...) CLEAR ASL R1 ;WE NEED A WORD INDEX JSR PC,@TECOCH(R1) ;DISPTACH TO COMMAND TST NFLG(R5) ;NUMBER? BMI 20$ ;YES, SO JUST CONTINUE CLR N(R5) ;NO, SO CLEAR THE ARGUMENT CLR NFLG(R5) ;AND RESET NUMBER FLAG BR 20$ ;AND CONTINUE CMDCHR <'^> ;^ MEANS NEXT IS CONTROL/CHARACTER TST (SP)+ ;POP THE RETURN ADDRESS JSR PC,SCNUPP ;AND GET NEXT FORCING UPPER CASE BIC #-77-1,R0 ;BUT MAKE IT A CONTROL/CHARACTER BR 30$ ;AND CONTINUE WITH IT .DSABL LSB CMDCHR <'L> ;"L" IS THE LINE MOVER JSR PC,GETN ;GET THE NUMBER OF LINES .VVV.V: MOV TXSTOR(R5),R2 ;GET TEXT POINTER BIAS MOV P(R5),R1 ;GET THE CURRENT . ADD R2,R1 ;AND MAKE THAT ABSOLUTE MOV #FF,R3 ;SPEED UP THE COMPARES TST R0 ;WHICH DIRECTION BLE 30$ ;<=0 IS BACKWARDS ADD ZZ(R5),R2 ;>0 IS FORWARDS; SO GET END OF TEXT 10$: CMP R1,R2 ;PAST END OF TEXT YET? BHIS 20$ ;YES, SO STOP THE MOVE CMPB R3,(R1)+ ;NOPE, IS THIS A FORM FEED? BLO 10$ ;NO, HIGHER, KEEP MOVING CMPB -1(R1),#LF ;YES, OR LOWER, SO CHECK IT BLO 10$ ;CONTINUE ON LOWER THAN LINE FEED DEC R0 ;GOT ONE, MORE TO GO? BGT 10$ ;KEEP GOING 20$: SUB TXSTOR(R5),R1 ;GET THE NEW . MOV R1,P(R5) ;AND STORE IT RTS PC ;THEN EXIT 30$: CMP R1,R2 ;TOO LOW? BLOS 20$ ;YES, SO QUIT CMPB R3,-(R1) ;NO, IS THIS A FORM FEED? BLO 30$ ;NOPE, HIGHER, KEEP GOING CMPB (R1),#LF ;YEP, OR LOWER, SO CHECK IT BLO 30$ ;CONTINUE ON LOWER THAN LINE FEED INC R0 ;GET ONE, MORE? BLE 30$ ;STILL ARE MORE TO GO INC R1 ;DONE, CORRECT . BR 20$ ;AND GO SET NEW . .ENABL LSB CMDCHR ;"<" STARTS AN ITERATION .CSMI: PUSH ITRST,ITRCNT ;SAVE ITERATION START AND COUNT MOV (R5),ITRST(R5) ;SET ITERATION START POINT CLR ITRCNT(R5) ;GUESS AT "INFINITE" ITERATION INC NFLG(R5) ;WAS THERE A NUMBER? BNE 10$ ;NO, SO IT IS "INFINITE" MOV N(R5),ITRCNT(R5) ;YES, USE THAT VALUE THEN BLE .SCH.I ;UNLESS <=0, WHICH IS A NOP BR 10$ ;EXIT RESTORING QUOTE CMDCHR ;">" ENDS AN ITERATION DEC ITRCNT(R5) ;GO AROUND AGAIN? BEQ .CSMO ;YES, SO END US MOV ITRST(R5),R4 ;NO, SO GET RESET SCAN POINTER BEQ 20$ ;ERROR IF NO PLACE TO RESTART MOV R4,(R5) ;ELSE REALLY RESET SCAN POINTER CMDCHR ;ESCAPES COME HERE CMDCHR <''> ;END OF CONDITIONALS COME HERE 10$: CLR NFLG(R5) ;USE UP ANY NUMBER JMP IREST ;AND RESTORE NORMAL QUOTE 20$: ERROR BNI,<" not in iteration"> CMDCHR <';> ;";" IS SPECIAL ITERATION END TST ITRST(R5) ;ARE WE IN ITERATION? BEQ 40$ ;NO, ERROR INC NFLG(R5) ;ARGUMENT? BNE 50$ ;GIVE ERROR IF NONE TST N(R5) ;SUCCESSFUL? BMI 10$ ;YES, SO JUST CONTINUE .SCH.I: MOV ITRST(R5),-(SP) ;SAVE ITERATION START POINT 30$: SKPSET '> ;GO TO MATCHING > MOV #30$,-(SP) ;GUESS AT RE-CALLING SKPSET CMP 2(SP),ITRST(R5) ;MATCH THIS START POINT? BNE .CSMO ;NO, POP AND CONTINUE CMP (SP)+,(SP)+ ;YES, POP START AND ADDRESS JSR PC,TRACE ; BUT TRACE THE > IF TRACING .CSMO: POP ITRCNT,ITRST ;POP THE COUNT AND START BR 10$ ;GO RESET QUOTE CHARACTER 40$: ERROR SNI,<"; not in iteration"> 50$: ERROR NAS,<"No arg before ;"> .DSABL LSB CMDCHR <'M> ;"M" IS THE MACRO COMMAND JSR PC,QREF ;REFERENCE A Q REGISTER PUSH SCANP,MPDL,QCMND,ITRST ;NOW PUSH ALL OLD DATA MOV R2,MPDL(R5) ;SAVE PDL AT MACRO'S START CLR (R5) ;START MACRO OFF AT RELATIVE 0 CLR ITRST(R5) ;NOT INTO ANY ITERATION YET MOV QNMBR(R5),R0 ;THIS IS THE Q REG WITH THE MACRO IN IT JMP SETCMD ;GO OFF AND START THE MACRO .ENABL LSB CMDCHR <'=> ;"=" IS THE NUMBER PRINTER INC NFLG(R5) ;ANY NUMBER? BNE 20$ ;HE'S IN ERROR IF NOT MOV NMRBAS(R5),-(SP) ;SAVE CURRENT RADIX CLR NMRBAS(R5) ;SET RADIX=DECIMAL INITIALLY TSTNXT '= ;IS IT REALLY "=="? ADC NMRBAS(R5) ;C=1 IF SO, SET RADIX=OCTAL JSR R4,ZEROD ;THIS DOES THE REAL WORK .WORD TYPE ;OUTPUT TO TERMINAL MOV (SP)+,NMRBAS(R5) ;RESTORE THE PREVIOUS RADIX CRLF: MOV #CR,R0 ;TYPE JSR PC,TYPE ; RETURN MOV #LF,R0 ; THEN 10$: JMP TYPE ; LINE FEED CMDCHR ;FORM FEED MOV #FF,R0 ;SET TO TYPE A BR 10$ ;SO DO IT ALREADY 20$: ERROR NAE,<"No arg before ="> .DSABL LSB .ENABL LSB CMDCHR <'\> ;"\" IS NUMBER INSERTER/GETTER INC NFLG(R5) ;WAS THERE AN ARGUMENT? BNE 20$ ;NO, SO GET A NUMBER FROM TEXT JSR R4,ZEROD ;YES, SO INSERT IT INTO TEXT .WORD .BSL.I 10$: RTS PC ;AND EXIT 20$: JSR PC,NCOM ;SET UP NUMBER PROCESSOR JSR PC,GETXTP ;GET CHAR FROM TEXT BCC 10$ ;NOTHING THERE SUB #'+,R0 ;PLUS SIGN? BEQ 30$ ;YES, IGNORE IT CMP R0,#'--'+ ;MINUS SIGN? BNE 40$ ;NOPE MOV R0,NOPR(R5) ;YES, SET MINUS OPERATOR 30$: INC P(R5) ;BUMP . 40$: JSR PC,GETXTP ;GET CHARACTER FROM TEXT BCC 10$ ;EXIT IF NO MORE JSR PC,NUMER ;CHECK FOR NUMERIC BCC 10$ ;NOT A NUMBER MOV R0,R1 ;MOVE DIGIT OVER TO HERE JSR PC,.BSL.N ;NUMBER, SO USE IT BR 30$ ;AND CONTINUE CMDCHR <'!> ;"!" IS THE COMMENT DELIMITER CMP (R0)+,(R0)+ ;MAKE R0 = 4 (SKIP 2 WORDS) CMDCHR <'A-100> ;CTRL/A IS THE TEXT PRINTER MOV R0,R2 ;SAVE DETERMINATION CLR NFLG(R5) ;USE UP ANY NUMBER MOV R1,R4 ;GET CHARACTER (*2) THAT CALLED US ASR R4 ;NOW MAKE NORMAL CHARACTER 50$: JSR PC,SCAN ;SCAN TEXT CMP R0,R4 ;END? BEQ 10$ ;YES, SO EXIT ADD R2,PC ;CHECK DETERMINATION JSR PC,TYPE ;CTRL/A CHARS GET TYPED BR 50$ ;AND LOOP .DSABL LSB .ENABL LSB CMDCHR <'"> ;'"' IS THE CONDITIONAL INC NFLG(R5) ;ANY ARGUMENT? BNE 10$ ;THERE HAD BETTER BE SORT ..CND,C ;AND SPECIAL SORT ERROR ICC,<'Illegal " character'> 10$: ERROR NAQ,<'No arg before "'> ;NO .CNDC: ADD #RAD50-NUMER,R2 ;"C" IS A-Z,0-9,.,$ .CNDD: ADD #NUMER-ALPHA,R2 ;"D" IS 0-9 .CNDA: ADD #ALPHA-ALPHAN,R2 ;"A" IS A-Z .CNDR: ADD #ALPHAN,R2 ;"R" IS A-Z,0-9 MOV R3,R0 ;SET UP TEST CHARACTER JSR PC,(R2) ;AND GO CHECK IT BCS 40$ ;CARRY SET IS SUCCESS BR 20$ ;ELSE FAILURE .CNDN: TST R3 ;SET CC'S BNE 40$ ;"N" IS OK IF <> BR 20$ ;ELSE NOT OK .CNDG: NEG R3 ;"G" IS OK IF > BVS 20$ ;TRAP -32768. CASE .CNDS: ;"S" IS SUCCESSFUL (-1) .CNDT: ;"T" IS TRUE (-1) .CNDL: TST R3 ;SET CC'S BPL 20$ ;"L" IS NO GOOD IF >= BR 40$ ;ELSE OK .CNDF: ;"F" IS FALSE (0) .CNDU: ;"U" IS UNSUCCESSFUL (0) .CNDE: TST R3 ;SET CC'S BEQ 40$ ;"E" IS OK IF = 20$: CLR CNDN(R5) ;INTO 1 LEVEL OF CONDITIONAL SKIP 30$: SKPSET '' ;SKIP TO A ' DEC CNDN(R5) ;DID IT MATCH OUR "? BPL 30$ ;NO, SKIPSOME MORE JSR PC,TRACE ;YES, TRACE FINAL ' IF TRACING 40$: JMP IREST ;RESTORE QUOTE AND EXIT .DSABL LSB CMDCHR <':> ;":" IS THE SEARCH MODIFIER MOV #-1,CLNF(R5) ;SET COLON FLAG TSTNXT ': ;DOUBLE COLON? SBC CLNF(R5) ;YES MEANS FLAG=-2 RTS PC ;AND EXIT .ENABL LSB CMDCHR <'U-100> ;CTRL/U IS Q REG TEXT INSERT JSR PC,QREF ;REFERENCE THE Q REG JSR PC,QSKPR ;NOW SKIP THE QUOTED STRING MOV (R5),R0 ;GET SCAN POINTER DEC R0 ;LESS 1 FOR QUOTE CHAR SUB OSCANP(R5),R0 ;NOW HAVE LENGTH JSR PC,QADJ ;ADJUST Q REG TO ITS NEW SIZE CLR NFLG(R5) ;USE UP ANY NUMBER MOV OSCANP(R5),R0 ;GET INSERT STRING START ADD QBASE(R5),R0 ;AND ADD IN OFFSET ADD QRSTOR(R5),R0 ;NOW MAKE IT ABSOLUTE BR 10$ ;AND GO INSERT IT IN Q REG CMDCHR <'U> ;"U" IS Q REG NUMBER SETTER JSR PC,QREF ;REFERENCE THE Q REG INC NFLG(R5) ;ANY NUMBER? BNE 40$ ;THERE MUST BE TST (R1)+ ;SKIP THE SIZE MOV N(R5),(R1) ;AND SET THE NUMBER RTS PC ;THEN EXIT CMDCHR <'X> ;"X" IS Q REG TEXT INSERT JSR PC,QREF ;REFERENCE THE Q REG JSR PC,NLINES ;GET NUMBER OF CHARACTERS JSR PC,QADJ ;ADJUST Q REG TO ITS NEW SIZE MOV M(R5),R0 ;GET START OF TEXT ADD TXSTOR(R5),R0 ;AND MAKE IT ABSOLUTE 10$: ADD QRSTOR(R5),R2 ;MAKE POINTER TO Q REG ABSOLUTE MOV (R1),R1 ;NOW GET SIZE OF Q REG BEQ 30$ ;NO SIZE IS FAST EXIT 20$: MOVB (R0)+,(R2)+ ;ELSE MOVE BYTES INTO Q REG DEC R1 ;MORE? BNE 20$ ;YES 30$: RTS PC ;ELSE EXIT 40$: ERROR NAU,<"No arg before U"> ;NOPE .DSABL LSB .ENABL LSB CMDCHR <'F> ;"F" IS PREFIX FOR SPECIAL SEARCHES SORT ..FFF,S ;AND SORT ON IT ERROR IFC,<"Illegal F character"> CMDCHR <'R-100> ;CTRL/R IS STRING REPLACEMENT .FFFS: MOV #-1,REPFLG(R5) ;SET REPLACE FLAG CMDCHR <'S> ;"S" IS SEARCH JSR PC,SEARCH ;SEARCH FOR THE STRING 5$: TST REPFLG(R5) ;REPLACEMENT? BEQ 15$ ;NOPE MOVB R1,-(SP) ;YES, SO SAVE SUCCESS/FAILURE FLAG JSR PC,QSKP ;AND SKIP THE 2ND STRING MOVB (SP)+,R1 ;RESTORE SUCCESS/FAILURE FLAG BEQ 10$ ;NO REPLACEMENT IF FAILURE MOV PST(R5),R0 ;GET START OF FOUND STRING SUB P(R5),R0 ;AND NOW ITS -(LENGTH) MOV PST(R5),P(R5) ;THEN UPDATE . JSR PC,.SCH.R ;DO REPLACEMENT MOV #-1,R1 ;RESTORE SUCCESS FLAG 10$: CLR REPFLG(R5) ;CLEAR REPLACE FLAG 15$: JSR PC,IREST ;RESTORE ESCAPE AS QUOTE MOVB R1,R0 ;GET REAL NUMBER IN R0 JSR PC,NCOM ;INIT THE NUMBER PROCESSOR TST CLNF(R5) ;WAS THERE A ":" THERE? BMI 35$ ;YES, SO JUST RETURN FLAG CLR CLNF(R5) ;ELSE SET FLAG TO FALSE MOV ITRST(R5),R4 ;IN AN ITERATION? BEQ 20$ ;NOPE TSTNXT <';> ;YES, IS SEARCH CHECKED FOR? BCS 30$ ;CHECKED FOR, SO RETURN VALUE CLR NFLG(R5) ;NOT CHECKED, EAT UP THE NUMBER TST N(R5) ;WAS SEARCH SUCCESSFUL BMI 40$ ;ALL O.K., SO JUST CONTINUE .IF NE E$$TXT JSR PC,NOCTLO ;CANCEL ANY CTRL/O MESSAG <"Srch fail in iter"> MOV #$$$$$$,R3 ;GET MESSAGE POINTER .CSECT TECOER . = .-1 ;BACK OVER ZERO BYTE $$$$$$ = .-$$$$$$ ;NOW FIND THE MESSAGE LENGTH .CSECT TECORO MOV #$$$$$$,R4 ;GET MESSAGE SIZE JSR PC,PRINT ;SO WE CAN PRINT A WARNING .ENDC JMP .SCH.I ;ELSE GET OUT OF ITERATION 20$: CLR NFLG(R5) ;USE UP THE NUMBER TST N(R5) ;SUCCESSFUL? BPL 25$ ;NOPE MOV ESFLAG(R5),R0 ;YES, GET EDIT SEARCH FLAG BEQ 35$ ;=0, SO EXIT JMP .SCH.V ;ELSE GO PRINT SOMETHING 25$: ERROR SRH,<"Search failure for">,STRING 30$: DEC (R5) ;MAKE SURE WE SEE THE ";" 35$: CLR CLNF(R5) ;CLEAR COLON FLAG 40$: RTS PC ;THEN EXIT .FFFN: CLR R0 ;INSURE "N" TYPE SEARCH MOV #-1,REPFLG(R5) ;AND DO A REPLACE BR 45$ ;NOW JOIN UP CMDCHR <'_> ;"_" IS DESTRUCTIVE SEARCH MOV #60$-55$,R0 ;SET TO SKIP BUFFER DUMP CMDCHR <'N> ;"N" IS THE PAGING SEARCH 45$: MOV R0,TEMP(R5) ;SAVE DETERMINATION JSR PC,SEARCH ;AND SEARCH 50$: BMI 5$ ;SUCCESS(-1) OR BACKWARDS FAIL(177400) MOV R2,-(SP) ;SAVE THE SEARCH COUNTER ADD TEMP(R5),PC ;CHECK DETERMINATION 55$: MOV TXSTOR(R5),R0 ;GET BUFFER START MOV ZZ(R5),R1 ; AND ITS LENGTH MOV FFFLAG(R5),R2 ; AND FORM FEED FLAG JSR PC,PUTBUF ;PUT OUT THE BUFFER BCS IO.ERR ;ERROR FROM 'TECOIO' 60$: JSR PC,.YYY.Y ;NOW YANK IN A PAGE OF TEXT MOV (SP)+,R2 ;RESTORE SEARCH COUNTER BIC R1,R1 ;PRE-INDICATE A FAILURE BCS 5$ ;NO DATA READ, SAY FAILUE TST TFLG(R5) ;IS SOMEONE TRYING TO STOP US? BMI 65$ ;YES, SO STOP ALREADY JSR PC,.SURCH ;ELSE CONTINUE SEARCHING BR 50$ ;NOW CHECK FOR FAILURE 65$: ERROR XAB,<"Execution aborted">;STOP US WITH THIS ERROR .DSABL LSB .FFFR: JSR PC,QSKPR ;SKIP THE INSERT STRING MOV LSCHSZ(R5),R0 ;GET -(LENGTH) OF LAST FOUND STRING JSR PC,.FFF.R ;AND BACK UP . TO THERE MOV LSCHSZ(R5),R0 ;GET -(LENGTH) AGAIN BR .SCH.R ;AND DO THE INSERT CMDCHR <'G> ;"G" IS GET Q REG INTO TEXT JSR PC,QREF ;REFERENCE THE Q REG CLR NFLG(R5) ;USE UP ANY NUMBER MOV R2,-(SP) ;SAVE OFFSET TO Q REG MOV (R1),R0 ;AND GET Q REG'S SIZE MOV R0,-(SP) ;SAVE INSERT LENGTH COM (SP) ;MAKE IT -(LENGTH)-1 BR .GGG.I ;NOW REALLY INSERT IT .ENABL LSB CMDCHR <'I> ;"I" IS INSERT TEXT INC NFLG(R5) ;NUMBER TO INSERT? BNE 10$ ;NOPE TSTNXT ESC ;MUST HAVE AN ESCAPE AFTER IT BCC 10$ ;NONE, SO REGULAR INSERT MOV N(R5),R0 ;YES, SO GET THE NUMBER .BSL.I: BIC #-177-1,R0 ;MAKE INTO A VALID CHARACTER MOV R0,-(SP) ;AND SAVE IT MOV #1,R0 ;ADJUST TEXT UP BY JSR PC,ADJ ; 1 CHARACTER MOV P(R5),R1 ;GET . ADD TXSTOR(R5),R1 ;MAKE ABSOLUTE MOVB (SP)+,(R1) ;AND STORE NEW CHARACTER INC P(R5) ;BUMP . RTS PC ;AND EXIT CMDCHR <'I-100> ;TAB IS SPECIAL FORM OF "I" CLR QFLG(R5) ;INSURE NO QUOTE SPECIALS DEC (R5) ;AND INCLUDE THE TAB IN TEXT 10$: JSR PC,QSKPR ;SKIP THE QUOTED STRING CLR R0 ;AND INDICATE NO BIAS .SCH.R: MOV OSCANP(R5),R3 ;GET STRING START MOV R3,-(SP) ;AND SAVE START ADD QBASE(R5),(SP) ;START NOW REAL SUB (R5),R3 ;NOW HAVE -(LENGTH)-1 SUB R3,R0 ;NOW HAVE (LENGTH)+1+(BIAS) DEC R0 ;NOW HAVE (LENGTH)+(BIAS) MOV R3,-(SP) ;SAVE INSERT -(LENGTH)-1 .GGG.I: JSR PC,ADJ ;ADJUST TEXT BUFFER SIZE MOV (SP)+,R3 ;RESTORE INSERT -(LENGTH)-1 INC R3 ;NOW MAKE INTO -(LENGTH) MOV R3,LSCHSZ(R5) ;SAVE TEXTUAL -(LENGTH) MOV (SP)+,R2 ;RESTORE STARTING POINT ADD QRSTOR(R5),R2 ;MAKE THE START ABSOLUTE NEG R3 ;NOW MAKE LENGTH A +(LENGTH) BEQ 30$ ;JUST EXIT IF NO LENGTH MOV P(R5),R1 ;ELSE GET . ADD R3,P(R5) ;THEN UPDATE . TO INSERT'S END ADD TXSTOR(R5),R1 ;AND MAKE . ABOLUTE 20$: MOVB (R2)+,(R1)+ ;DO THE REAL INSERTION DEC R3 ; FOR THE BNE 20$ ; WHOLE LENGTH 30$: RTS PC ;THEN EXIT .DSABL LSB .ENABL LSB CMDCHR <'P> ;"P" IS PAGE WRITER .SBTTL COMMAND CHARACTER "PW TSTNXT 'W ;REALLY "PW"? ROR TEMP(R5) ;SAVE THE DETERMINATION TST CFLG(R5) ;M,N?? BMI 60$ ;YES JSR PC,GETN ;NOPE, GET A NUMBER MOV R0,R4 ;AND SAVE IT 10$: MOV TXSTOR(R5),R0 ;WRITE FROM HERE MOV ZZ(R5),R1 ; AND WRITE THIS MUCH MOV FFFLAG(R5),R2 ; AND WRITE WITH OPTIONAL FORM FEED TST TEMP(R5) ;"P" OR "PW" COMMAND? BPL 20$ ;IF "P", THEN FORM FEED IS OPTIONAL MOV #-1,R2 ;IF "PW", THEN ALWAYS A FORM FEED 20$: JSR PC,PUTBUF ;DUMP THE BUFFER IO.ERR: BCS IOERR ;ERROR FROM 'TECOIO' TST TEMP(R5) ;"PW"? BMI 30$ ;YES, SO NO YANK JSR PC,.YYY.Y ;SIMULATE THE YANK 30$: DEC R4 ;AGAIN? BNE 10$ ;YES 40$: CLC ;ENSURE CARRY=0 ON EXIT 50$: RTS PC ;NO, EXIT 60$: JSR PC,NLINES ;MAKE M,N INTO CHARACTERS MOV R0,R1 ;COUNT GOES HERE MOV M(R5),R0 ;START FROM HERE ADD TXSTOR(R5),R0 ; MAKE IT ABSOLUTE CLR R2 ;NEVER A FORM FEED JSR PC,PUTBUF ;AND PUT IT BCC 50$ ;ALL O.K., EXIT IOERR: ;I/O ERRORS COME HERE .IF NE E$$TXT MOV SP,R4 ;INDICATE NO STRING .ENDC IOERRS: ;I/O ERROR WITH STRING COMES HERE JSR R2,ERRMIO ;SAVE TEXT POINTER AND SAY ERROR CMDCHR <'A> ;"A" IS APPEND INC NFLG(R5) ;UNLESS THERE IS A NUMBER BNE 80$ ;AND THERE IS NOT MOV N(R5),R0 ;GET THE NUMBER ADD P(R5),R0 ;INDEXED BY . JSR PC,BZCHK ;CHECK IT BEQ 70$ ;AT Z, SO LOOP TO PRODUCE ERROR ADD TXSTOR(R5),R0 ;THEN MAKE IT ABSOLUTE MOVB (R0),R0 ;AND GET THE CHARACTER JMP NCOM ;AND COMPUTE AS IF NUMBER 70$: ERROR POP,<"Pointer off page">;OUT OF TEXT AREA 80$: MOV ZZ(R5),R1 ;GET CURRENT TEXT SIZE ADD #256.+1,R1 ;INSURE ADDITION OF ONE LINE SIZE TEXT ; INTO TEXT BUFFER BCS .YYY.R ;O.K., SO READ IT IN ERROR MEM,<"Memory overflow"> ;COULDN'T DO IT CMDCHR <'Y> ;"Y" IS YANK IN A BUFFER INC NFLG(R5) ;ANY ARGUMENT? BEQ 100$ ;YES, SOMEONE MADE AN ERROR .YYY.Y: JSR PC,.YYY.C ;ELSE SIZE UP THE TEXT BUFFER .YYY.R: CMP #0,EOFLAG(R5) ;SET CARRY=1 IF "EOFLAG"=-1 BCS 50$ ;EXIT C=1 IF END-OF-FILE 90$: MOV ZZ(R5),R0 ;GET END OF CURRENT BUFFER MOV ZMAX(R5),R1 ;GET MAX SIZE MOV R1,R2 ;COPY THE MAX VALUE ASR R2 ; AND FIND THE ASR R2 ; MAX*(1/4) VALUE DEC R1 ;MAX LESS 1 FOR SAFETY SUB R0,R1 ;FIND REAL ROOM LEFT ADD TXSTOR(R5),R0 ;MAKE POINTER ABSOLUTE JSR PC,GETBUF ;GET SOME DATA BCS IOERR ;I/O TYPE ERROR, DIE TST FFFLAG(R5) ;O.K., DID IT END WITH FORM FEED? BNE 40$ ;YES, ALL DONE, EXIT CARRY=0 TST EOFLAG(R5) ;NO, ANY POINT IN TRYING FOR MORE? BNE 40$ ;NO POINT, SO DONE MOV #SIZERB,R1 ;YEP, GET (TRIAL) AMOUNT TO EXPAND CMP R1,CURFRE(R5) ;HAVE WE ALREADY GOT THAT AMOUNT? BLOS 40$ ;IF SO THEN NO POINT IN ASKING FOR MORE JSR PC,SIZER ;ELSE CALL THE MEMORY SIZING ROUTINE BCS 40$ ;IT FAILED, SO JUST EXIT JSR PC,.YYY.S ;WE GOT IT, RE-SHUFFLE THE AREAS BR 90$ ;AND RECALL OURSELVES 100$: ERROR NAY,<"No arg before Y"> ;PROTECT DUMB MISTAKES .DSABL LSB CMDCHR <'E> ;"E" IS SPECIAL COMMANDS MOV NFLG(R5),R2 ;SAVE THE NUMBER FLAG CLR NFLG(R5) ;NO NUMBER SORT ..EEE,S ;AND SORT ERROR IEC,<"Illegal E character"> .EEEB: ;R0 GETS <0 FOR EB ('B-'R) .EEEI: ;R0 GETS <0 FOR EI ('I-'R) .EEER: ;R0 GETS =0 FOR ER .EEEW: SUB #'R,R0 ;R0 GETS >0 FOR EW MOVB #-1,@SCHBUF(R5) ;FORCE NULL STRINGS TO NULL JSR PC,GETSCH ;GET STRING AS SEARCH ARGUMENT JSR PC,GETFLS ;AND DO THE CORRECT THING BIC R4,R4 ;INSURE R4=0 MEANING STRING BCS IOERRS ;ERROR JMP IREST ;RESTORE QUOTE AND EXIT .ENABL LSB 10$: JSR PC,.YYY.R ;THEN READ IN SOME MORE DATA BCS .EEEF ;END-OF-FILE, SO DONE 20$: TST @OUPNTR(R5) ;IS THERE AN OUTPUT FILE? BEQ 50$ ;NO, SO ALL DONE MOV TXSTOR(R5),R0 ;FROM BEGINNING MOV ZZ(R5),R1 ; TO END MOV FFFLAG(R5),R2 ; WITH OPTIONAL FORM FEED JSR PC,PUTBUF ;WRITE BUFFER BCS IOERR ;AN ERROR, STOP 30$: JSR PC,.YYY.C ;CLEAR OUT THE BUFFER TST @INPNTR(R5) ;IS ANY INPUT NOW ACTIVE? BNE 10$ ;YES, SO READ NEXT PAGE IN .EEEF: JSR PC,CLSFIL ;CLOSE THE OUTPUT FILE 40$: BCS IOERR ;DIE ON ANY ERROR 50$: JMP IREST ;ELSE RESTORE QUOTE AND EXIT .EEEK: JSR PC,KILFIL ;CLOSE AND KILL OUTPUT FILE BR 40$ ;AND ERROR CHECK .EEEP: JSR PC,INPSAV ;SAVE INPUT FILE STATUS BR 40$ ;AND ERROR CHECK .EEEA: JSR PC,OUTSAV ;SAVE OUTPUT FILE STATUS BR 40$ ;AND ERROR CHECK .EEEG: MOV #GEXIT,-(SP) ;EXIT FROM TECO SOON BR 60$ ;AFTER FINISHING UP .EEEX: MOV #TEXIT,-(SP) ;EXIT FROM TECO SOON 60$: JSR PC,XITNOW ;WE WILL BE EXITING SOON .EEEC: JSR PC,20$ ;PAGE OUT THE REST OF THE FILE JMP .YYY.C ;THEN EXIT CLEARING BUFFER .DSABL LSB .ENABL LSB .SCH.V: MOV R0,-(SP) ;SAVE TYPEOUT DETERMINATION MOV #1,R0 ;FAKE AN ARGUMENT OF 1 BR 10$ ;NOW JOIN THE VERIFY CODE CMDCHR <'V> ;"V" IS VERIFY CLR -(SP) ;SAVE NULL TYPEOUT DETERMINATION JSR PC,GETN ;GET THE NUMERIC ARGUMENT 10$: MOV R0,-(SP) ;AND SAVE THAT ARGUMENT MOV #1,N(R5) ;CALCULATE THE (1-N)T SUB (SP),N(R5) ; PART OF VERIFY MOV #-1,NFLG(R5) ;FAKE ARGUMENT EXISTANCE JSR PC,@'T*2+TECOCH ;NOW DO THE (1-N)T PART MOV 2(SP),R0 ;GET TYPEOUT DETERMINATION BLE 30$ ;NOTHING SPECIAL CMP R0,#SPACE ;USE LINE FEED? BHIS 20$ ;NOPE MOV #LF,R0 ;YES 20$: JSR PC,TYPE ;NOW TYPE THE CHARACTER 30$: MOV (SP)+,N(R5) ;SET ARGUMENT FOR (N)T PART OF V MOV #-1,NFLG(R5) ;FAKE ARGUMENT EXISTANCE TST (SP)+ ;AND POP THAT TYPEOUT DETERMINATION CMDCHR <'T> ;"T" IS THE PRINTER JSR PC,NLINES ;FIND NUMBER OF CHARACTERS MOV M(R5),R3 ;GET STARTING POINT ADD TXSTOR(R5),R3 ;AND MAKE ABSOLUTE MOV R0,R4 ;MOVE COUNT INTO HERE JMP PRINT ;AND PRINT IT .DSABL LSB CMDCHR <'W-100> ;CTRL/W IS SCOPE WATCH INC NFLG(R5) ;ARGUMENT? BNE 10$ ;NOPE MOV N(R5),NWATCH(R5) ;YES, SO GET IT 10$: MOV NWATCH(R5),R0 ;GET AMOUNT TO WATCH JMP WATCH ;AND WATCH THE SCOPE CMDCHR <'O-100> ;CTRL/O MEANS OCTAL RADIX INC R0 ;MAKE A NON-ZERO CMDCHR <'D-100> ;CTRL/D MEANS DECIMAL RADIX MOV R0,NMRBAS(R5) ;SET THE RADIX RTS PC ERROR: ERROR ILL,<"Illegal command"> ;ILLEGAL COMMANDS COME HERE .ENABL LSB CMDCHR <'N-100> ;CTRL/N IS EOF FLAG MOV EOFLAG(R5),R0 ;GET END-OF-FILE FLAG BR 40$ ;AND COMPUTE AS A NUMBER CMDCHR <'B-100> ;CTRL/B IS TODAY'S DATE JSR PC,DATE ;GET DATE BR 40$ ;AND COMPUTE AS A NUMBER CMDCHR <'S-100> ;CTRL/S IS -(LENGTH) OF LAST STRING MOV LSCHSZ(R5),R0 ;GET -(LENGTH) OF LAST BR 40$ ;AND COMPUTE AS A NUMBER CMDCHR <'F-100> ;CTRL/F IS SWITCH REGISTER VALUE JSR PC,SWITCH ;GET SWITCH REGISTER BR 40$ ;AND COMPUTE AS A NUMBER CMDCHR <'H-100> ;CTRL/H IS TIME OF DAY JSR PC,TIME ;GET TIME OF DAY BR 40$ ;AND COMPUTE AS A NUMBER CMDCHR <'H> ;"H" MEANS ALL (0,Z) CLR N(R5) ;SIMULATE THE "B" (OR 0) JSR PC,10$ ;NOW SIMULATE THE COMMA CMDCHR <'Z> ;"Z" MEANS END OF TEXT MOV ZZ(R5),R0 ;GET END OF TEXT VALUE BR 40$ ;AND COMPUTE AS A NUMBER CMDCHR <'.> ;"." IS CURRENT POSITION MOV P(R5),R0 ;GET . BR 40$ ;AND COMPUTE AS A NUMBER CMDCHR <',> ;"," IS THE M,N SEPARATOR INC NFLG(R5) ;WAS THERE A "M"? BNE 20$ ;THERE SHOULD HAVE BEEN 10$: MOV N(R5),M(R5) ;SAVE "M" CLR N(R5) ;NOW CLEAR "N" AGAIN MOV #-1,CFLG(R5) ;AND INDICATE A COMMA CMDCHR ;IGNORE NULLS CMDCHR ;IGNORE LINE FEED CMDCHR ;IGNORE VERTICAL TAB CMDCHR ;IGNORE CARRIAGE RETURN CMDCHR ;IGNORE SPACE(S) RTS PC ;NOW RETURN 20$: ERROR NAC,<"No arg before ,"> ;NO CMDCHR <'T-100> ;CTRL/T MEANS VALUE OF NEXT INPUT CHARACTER INC NFLG(R5) ;IS THERE AN ARGUMENT? BNE 30$ ;NO, SO GET INPUT AS NUMERIC VALUE MOV N(R5),R0 ;YES, GET THE ARGUMENT AND JMP TYPE ; TYPE ITS VALUE ON TERMINAL 30$: MOV SP,R0 ;SINGLE CHARACTER MODE JSR PC,LISTEN ;GET A CHARACTER BR 40$ ;AND COMPUTE AS A NUMBER CMDCHR <'^-100> ;CTRL/^ MEANS VALUE OF NEXT CHARACTER JSR PC,SCAN ;GET NEXT CHARACTER 40$: BR NCOM ;AND COMPUTE AS A NUMBER CMDCHR <'V-100> ;CTRL/V MEANS VERSION NUMBER MOV #VERSON,R0 ;GET VERSION NUMBER BR NCOM ;AND COMPUTE AS A NUMBER CMDCHR <'Z-100> ;CTRL/Z MEANS SIZE OF Q REGS MOV QZ(R5),R0 ;GET SIZE OF Q REGS BR NCOM ;AND COMPUTE AS A NUMBER CMDCHR <'E-100> ;CTRL/E MEANS FORM FEED FLAG MOV FFFLAG(R5),R0 ;GET FORM FEED FLAG VALUE BR NCOM ;AND COMPUTE AS A NUMBER CMDCHR <'Q> ;"Q" IS VALUE IN Q REGISTER JSR PC,QREF ;REFERENCE Q REG AS SPECIFIED BR 50$ ;NOW GET ITS VALUE CMDCHR <'%> ;"%" IS ADD TO Q REG VALUE JSR PC,QREF ;REFERENCE Q REG AS SPECIFIED JSR PC,GETN ;GET THE NUMBER ALSO 50$: TST (R1)+ ;SKIP THE OFFSET WORD ADD (R1),R0 ;AND ADD FOR A NEW VALUE MOV R0,(R1) ;THEN STORE IT AWAY BR NCOM ;AND COMPUTE AS A NUMBER CMDCHR <'&> ;"&" IS LOGICAL 'AND' MOV #OP$AND-OP$OR,R0 ;SET FOR 'AND' CMDCHR <'#> ;"#" IS LOGICAL OR ADD #OP$OR-OP$DIV,R0 ;SET FOR 'OR' CMDCHR <'/> ;"/" IS DIVISION ADD #OP$DIV-OP$MUL,R0 ;SET FOR DIVIDE CMDCHR <'*> ;"*" IS MULTIPLICATION ADD #OP$MUL-OP$SUB,R0 ;SET FOR MULTIPLY CMDCHR <'-> ;"-" IS SUBTRACTION TST (R0)+ ;SET FOR SUBTRACT CMDCHR <'+> ;"+" IS ADDITION 60$: MOV R0,NOPR(R5) ;SAVE THE OPERATOR DISPTACH MOV N(R5),NACC(R5) ;SAVE CURRENT NUMBER IN ACCULMULATOR CLR NP(R5) ;NO DIGITS FOUND NOW MOV #-1,OFLG(R5) ;INDICATE OPERATOR PENDING CLR NFLG(R5) ;BUT NO NUMBER PENDING RTS PC ;AND RETURN CMDCHR <'(> ;"(" IS START OF NEW EXPRESSION TST OFLG(R5) ;OPERATOR PENDING? BNE 70$ ;YES JSR PC,NCOM ;NO, INITIALIZE US 70$: INC PCNT(R5) ;COUNT AS ANOTHER PAREN PUSH PUSHP NOPR,NACC ;SAVE ACCULMULATOR BR 60$ ;THEN SET UP AS IF "+" .DSABL LSB .ENABL LSB CMDCHR <')> ;")" IS END OF EXPRESSION TST NFLG(R5) ;ANYTHING BEFORE THIS? BPL 10$ ;BADNESS IF NOT DEC PCNT(R5) ;CAN WE POP A PAREN? BMI 10$ ;NO, ERROR POP NACC,NOPR ;RESTORE OPERATOR MOV N(R5),R0 ;GET VALUE INSIDE PARENS BR 30$ ;AND TREAT AS A NUMBER 10$: ERROR NAP,<"No arg before )"> CMDCHR <'0> ;THE DIGITS CMDCHR <'1> CMDCHR <'2> CMDCHR <'3> CMDCHR <'4> CMDCHR <'5> CMDCHR <'6> CMDCHR <'7> CMDCHR <'8> CMDCHR <'9> ASR R1 ;FORM NON-WORD-INDEX FROM CHARACTER .BSL.N: SUB #'0,R1 ;AND MAKE INTO BINARY DIGIT INC NFLG(R5) ;ANY DIGIT BEFORE THIS? BNE 60$ ;NO, SO INITIALIZE US MOV NP(R5),R0 ;YES, SO GET OLD NUMBER ASL R0 ;TIMES 2 ASL R0 ;TIMES 4 NOW TST NMRBAS(R5) ;RADIX? BNE 20$ ;OCTAL ADD NP(R5),R0 ;DECIMAL 20$: ASL R0 ;TIMES 8. OR 10. BY NOW ADD R1,R0 ;AND ADD IN NEW DIGIT MOV R0,NP(R5) ;SAVE THE NUMBER 30$: ADD NOPR(R5),PC ;DISPATCH ON OPERATOR BR 40$ ;+ OP$SUB: NEG R0 ;- 40$: ADD NACC(R5),R0 ;FORM RESULT 50$: MOV R0,N(R5) ;SAVE THE RESULT MOV #-1,NFLG(R5) ;AND INDICATE A NUMBER CLR OFLG(R5) ;BUT NO OPERATOR RTS PC ;THEN EXIT 60$: MOV R1,R0 ;COPY FIRST DIGIT MOV R1,NP(R5) ;SAVE IT IN NUMBER ACCUMULATOR BR 70$ ;ENTER PROCESSING CMDCHR <'B> ;"B" IS ZERO NCOM: CLR NP(R5) ;USUALLY WE SET NP TO 0 70$: TST OFLG(R5) ;OPERATOR? BNE 30$ ;YES CLR NACC(R5) ;NO, SO INITIALIZE US CLR NOPR(R5) BR 30$ ;AND CONTINUE OP$AND: MOV NACC(R5),R1 ;GET MASK COM R1 ;MAKE INTO AN 'AND' MASK BIC R1,R0 ;AND DO THE 'AND' BR 50$ OP$OR: BIS NACC(R5),R0 ;DO THE 'OR' BR 50$ OP$MUL: CLR R1 ;CLEAR THE HIGH ORDER MOV #16.+1,R2 ;NUMBER OF BITS(+1) IN A WORD 80$: CLC ;CLEAR THE DUMB CARRY ROR R1 ;SHIFT HIGH ORDER INTO ROR R0 ; LOW ORDER BCC 90$ ;NO NEED TO ADD HERE... ADD NACC(R5),R1 ;ADD INTO HIGH ORDER 90$: DEC R2 ;MORE? BGT 80$ ;YES BR 50$ ;NO OP$DIV: MOV R0,R2 ;SET THE DIVISOR MOV NACC(R5),R0 ;AND THE DIVIDEND MOV #50$,-(SP) ;STACK RETURN ADDRESS DIVD: CLR R1 ;CLEAR THE REMAINDER MOV #16.,R3 ;NUMBER OF BITS IN A WORD 100$: ASL R0 ;SHIFT THE DIVIDEND ROL R1 ; INTO THE REMAINDER CMP R2,R1 ;CAN WE SUBTRACT? BHI 110$ ;NOPE SUB R2,R1 ;YEP INC R0 ;AND COUNT IN ANSWER 110$: DEC R3 ;MORE? BGT 100$ ;YES RTS PC ;NO, EXIT .DSABL LSB CMDCHR <'_-100> ;THE COMPLEMENT OPERATOR (UNARY) TST NFLG(R5) ;IS THERE A NUMBER? BPL 10$ ;THERE SHOULD HAVE BEEN COM N(R5) ;DO A COMPLEMENT RTS PC ;AND LEAVE 10$: ERROR NAB,<"No arg before "<'_-100>> .ENABL LSB .EEET: MOV #ETYPE,R0 ;"ET" IS EDIT TYPEOUT BR 10$ ;GO TO COMMON CODE .EEEH: MOV #EHELP,R0 ;"EH" IS EDIT HELP BR 10$ ;GO TO COMMON CODE .EEES: MOV #ESFLAG,R0 ;"ES" IS EDIT SEARCH 10$: ADD R5,R0 ;MAKE POINTER ABSOLUTE INC R2 ;ARGUMENT? BEQ 20$ ;YES MOV (R0),R0 ;NO, RETURN VALUE BR NCOM ;AND COMPUTE AS A NUMBER 20$: MOV N(R5),(R0) ;SET THE NEW VALUE RTS PC ;AND EXIT .DSABL LSB .ENABL LSB CMDCHR <'J> ;"J" IS MOVE POINTER CLR NFLG(R5) ;USE UP THE NUMBER MOV N(R5),R0 ;NOW GET THE NUMBER BR 10$ ;AND GO SET . CMDCHR <'R> ;"R" IS MOVE POINTER CHARACTERS JSR PC,GETN ;GET THE NUMBER OF CHARACTERS NEG R0 ;THIS IS THE REVERSE MOVE BR .FFF.R ;GO JOIN COMMON CODE CMDCHR <'C> ;"C" IS MOVE POINTER CHARACTERS JSR PC,GETN ;GET THE NUMBER OF CHARACTERS .FFF.R: ADD P(R5),R0 ;CALCULATE NEW . 10$: JSR PC,BZCHK ;CHECK FOR VALIDITY MOV R0,P(R5) ;SET NEW . RTS PC ;AND EXIT CMDCHR <'D> ;"D" IS DELETE CHARACTERS TST CFLG(R5) ;IS FORM M,ND ? BMI 20$ ;YES, SO PRETEND IT IS M,NK JSR PC,GETN ;GET THE NUMBER OF CHARACTERS MOV R0,R1 ;AND SAVE THAT NUMBER BPL 30$ ;>0 IS FORWARD DELETE JSR PC,.FFF.R ;<0 IS BACKWARD (-ND = -NC ND) MOV R1,R0 ;RESTORE THE DELETE COUNT BR ADJ ;NOW DELETE CMDCHR <'K> ;"K" IS THE LINE DELETER 20$: JSR PC,NLINES ;GET THE NUMBER OF LINES MOV M(R5),P(R5) ;STARTING FROM HERE 30$: NEG R0 ;DELETE THIS MANY (<0 IS DELETE) ;BR ADJ ;NOW DO IT .DSABL LSB .SBTTL ADJUST TEXT AREA ROUTINE ; R0 = 0 MEANS NO ADJUSTMENT ; R0 < 0 MEANS SHRINK AREA BY ABS(R0) ; R0 > 0 MEANS ENLARGE AREA BY R0 ; (R0,R1,R2,R3 ARE CLOBBERED) .ENABL LSB ADJ: MOV P(R5),R2 ;GET . MOV ZZ(R5),R3 ;AND GET END OF TEXT MOV R0,R1 ;COPY THE CHANGE AMOUNT BMI 40$ ;<0 MEANS SHRINK AREA BEQ 20$ ;=0 MEANS NO CHANGE ADD R3,R1 ;NOW HAVE NEW SIZE SIZE TEXT ;CHECK OUT THE SIZE BCC 30$ ;WE CAN'T DO IT MOV R1,ZZ(R5) ;UPDATE THE BUFFER SIZE MOV TXSTOR(R5),R0 ;GET ABSOLUTE POINTER BIAS EXPAND: CMP R2,R3 ;ANYTHING TO DO? BEQ 20$ ;NO, FAST EXIT ADD R0,R1 ;MAKE NEW ZZ ABSOLUTE ADD R0,R2 ;MAKE . ABSOLUTE ADD R0,R3 ;MAKE OLD ZZ ABSOLUTE MOVB (R2),R0 ;SAVE CHARACTER AT . CLRB (R2) ;THEN FLAG THAT SPOT 10$: MOVB -(R3),-(R1) ;MOVE A BYTE UP FROM END BNE 10$ ;CANNOT BE END OF NON-ZERO CMP R3,R2 ;REACHED . YET? BHI 10$ ;NOPE, SO CONTINUE MOVB R0,(R2) ;YES, RESTORE CHARACTER AT . MOVB R0,(R1) ; AND RESTORE MOVED NULL BYTE 20$: RTS PC ;AND EXIT 30$: ERROR MEM,<"Memory overflow"> ;SORRY... 40$: MOV R2,R1 ;COPY . TO HERE SUB R0,R2 ;NOW FIND END OF THE DELETE CMP R2,R3 ;IS DELETE TOO BIG? BHI 70$ ;YEP ADD R0,ZZ(R5) ;SET NEW DATA SIZE MOV TXSTOR(R5),R0 ;GET BUFFER BIAS SHRINK: CMP R2,R3 ;ANYTHING TO DO? BEQ 60$ ;NO, FAST EXIT ADD R0,R1 ;MAKE . ABSOLUTE ADD R0,R2 ;MAKE END OF DELETE ABSOLUTE ADD R0,R3 ;MAKE END OF BUFFER ABSOLUTE MOVB -(R3),R0 ;SAVE END OF BUFFER BYTE CLRB (R3) ;THEN FLAG END OF BUFFER 50$: MOVB (R2)+,(R1)+ ;MOVE A BYTE DOWN BNE 50$ ;CANNOT BE END IF NON-ZERO CMP R2,R3 ;END OF BUFFER REACHED? BLOS 50$ ;NOT YET MOVB R0,-(R1) ;RESTORE END OF BUFFER BYTE MOVB R0,(R3) ; AND RESTORE THIS ALSO 60$: RTS PC ;NOW EXIT 70$: ERROR DTB,<"Delete too big"> .DSABL LSB .SBTTL SORT ; INVOKED VIA "SORT" MACRO ; R0 = CHARACTER TO SORT ; (R1 IS CLOBBERED) SORTC: MOV N(R5),R3 ;GET ARGUMENT CLR R2 ;SET UP FOR THE "ADD" CHAIN SORTS: JSR PC,SCNUPP ;GET CHARACTER TO SORT ON SORT: MOV (R4)+,R1 ;GET TABLE ADDRESS 10$: CMPB R0,-(R1) ;GET A MATCH? BHI 10$ ;NO, KEEP GOING BLO 20$ ;NO, TOO FAR SUB -(R4),R1 ;YES, FIND NET CHANGE (<0) COM R1 ;MAKE THAT 0,1,2, ETC. ASL R1 ;NOW TIMES 2 FOR WORD ADDRESSING ADD (R4),R1 ;FIND POINTER INTO THE TABLE MOV (R1),R4 ;SET A NEW RETURN ADDRESS 20$: RTS R4 ;AND EXIT CMDCHR <'O> ;"O" IS GOTO LABEL CLR NFLG(R5) ;USE UP ANY NUMBER JSR PC,QSKP ;SKIP THE QUOTED STRING MOV QUOTE(R5),-(SP) ;SAVE ENDING QUOTE CHARACTER MOV OSCANP(R5),-(SP) ;SAVE TAG'S POINTER MOV ITRST(R5),(R5) ;START SEARCH AT ITERATION START 10$: SKPSET '! ;SKIP UNTIL A ! JSR PC,TRACE ;TRACE THE ! IF TRACING MOV (SP),R4 ;GET BACK THE TAG'S START ADD QBASE(R5),R4 ;AND ADD IN Q REG OFFSET ADD QRSTOR(R5),R4 ;THEN MAKE ABSOLUTE 20$: JSR PC,SCAN ;SCAN THE FOUND TAG CMP R0,#'! ;END OF TAG? BEQ 40$ ;YES CMPB R0,(R4)+ ;NO, MATCH? BEQ 20$ ;CONTINUE UNTIL END IF MATCH 30$: JSR PC,SCAN ;SCAN FOR TAG'S END IF NO MATCH CMP R0,#'! ;END OF TAG? BNE 30$ ;NOT YET... BR 10$ ;AND FIND NEXT TAG 40$: CMPB (R4)+,2(SP) ;BOTH ENDS MATCH? BNE 10$ ;NOPE, SO FIND NEXT TAG CMP (SP)+,(SP)+ ;YES, DUMP START & QUOTE RTS PC ;AND EXIT .SBTTL SKIP OVER COMMAND ; INVOKED VIA "SKPSET" MACRO ; (R0,R1,R2,R3,"TEMP" ARE CLOBBERED) .ENABL LSB SKPSET: JSR PC,IREST ;RESTORE ESCAPE AS QUOTE MOV (R4)+,TEMP(R5) ;SAVE SPECIAL CHARACTER MOVB TFLG(R5),TEMP+1(R5) ;SAVE TRACE FLAG CLRB TFLG(R5) ;THEN DISABLE TRACE DURING SKIP 10$: JSR PC,SCNUPP ;GET NEXT CHARACTER 20$: CMPB R0,TEMP(R5) ;IS IT THE SPECIAL CHARACTER? BEQ 50$ ;YES, SO EXIT MOV #10$,-(SP) ;STACK A RETURN ADDRESS SORT ..CSM ;SORT ON SPECIAL SKIPPERS RTS PC ;NON-SPECIALS ARE IGNORED .CSMU: JSR PC,SCAN ;IGNORE NEXT CHARACTER BR .CSMQ ;AND 1 QUOTED STRING .CSMF: JSR PC,SCNUPP ;GET "F" MODIFIER CMP R0,#'R ;"FR"? BEQ .CSMQ ;YES, ONLY SKIP 1 STRING .CSM2Q: JSR PC,QSKP ;IGNORE 1 QUOTED STRING .CSMQ: JSR PC,QSKP ;IGNORE 1 QUOTED STRING IREST: MOV #ESC,R0 ;SET TO RESTORE QUOTE AS ESCAPE BR 30$ ;GO DO IT QCHK: TST QFLG(R5) ;QUOTE FLAG? BEQ 40$ ;NOPE JSR PC,SCAN ;YES, SO GET THE QUOTE CHARACTER 30$: MOV R0,QUOTE(R5) ;AND SET QUOTE CHARACTER CLR QFLG(R5) ;NOW CLEAR THE QUOTE FLAG 40$: RTS PC ;AND EXIT .CSMY: MOV #.CSMQ,-(SP) ;IGNORE A STRING QUOTED ON BR 30$ ; THIS CHARACTER .CSME: SORT ..CSME,S ;IS IT EB, EI, ER, EW ? RTS PC ;NO CMDCHR <'@> ;"@" IS QUOTE FLAG SETTER .CSMA: MOV #-1,QFLG(R5) ;@ FOUND; SET QUOTE FLAG RTS PC ;EXIT .CSMUA: JSR PC,SCNUPP ;GET CHARACTER AFTER ^ BIC #-77-1,R0 ; THEN FORCE CONTROL CHARACTER TST (SP)+ ;JUNK THE RETURN ADDRESS BR 20$ 50$: MOVB TEMP+1(R5),TFLG(R5) ;RESTORE THE TRACE FLAG RTS R4 ;AND EXIT .DSABL LSB .SBTTL ERROR MESSAGE PROCESSOR .IF NE E$$TXT .ENABL LSB ERRORA: MOVB (R4)+,R0 ;GET 3RD RAD50 CHARACTER ADD (PC)+,R0 ;NOW FORM "NA?" .RAD50 /NA / MESSAG <"No arg before "<-1>> MOV #$$$$$$,-(SP) ;STACK MESSAGE POINTER BR 10$ ;AND GO TO COMMON PROCESSING ERRORC: MOVB (R4)+,R0 ;GET 2ND RAD50 CHARACTER ASL R0 ;MAKE INTO ASL R0 ; REAL ASL R0 ; 2ND CHARACTER ADD (PC)+,R0 ;NOW FORM "I?C" .RAD50 /I C/ MESSAG <"Illegal "<-1>" character"> MOV #$$$$$$,-(SP) ;STACK MESSAGE POINTER 10$: MOVB (R4)+,R4 ;GET LAST/MIDDLE CHARACTER BR ERRMIO ;AND GO TO COMMON PROCESSING .DSABL LSB ERRORS: MOV (R4)+,R0 ;GET RAD50 OF ERROR CODE MOV (R4)+,-(SP) ;SAVE THE TEXT POINTER CLR R4 ;THEN FLAG FOR FOLLOWING STRING BR ERRMIO ;NOW DO IT .ENDC ERRMSG: MOV (R4)+,R0 ;GET RAD50 OF ERROR CODE .IF NE E$$TXT MOV (R4)+,-(SP) ;SAVE THE TEXT POINTER .ENDC ERRMIO: MOV #50,R2 ;SET TO DIVIDE BY 50 CLR -(SP) ;FLAG END OF CHARACTERS 10$: JSR PC,DIVD ;DIVIDE BY 50 MOV R1,-(SP) ; AND SAVE REMAINDER TST R0 ; ANY ANSWER LEFT? BNE 10$ ; LOOP IF SO... JSR PC,NOCTLO ;CANCEL ANY ^O IF EFFECT JSR PC,CRLF ;RESTORE CARRIAGE MOV #'?-<'A-1>,R0 ;NOW SET FOR PRINTING A "?" 20$: ADD #'A-1,R0 ;MAKE A CHARACTER CMP R0,#'Z ;REALLY ALPHABETIC? BLOS 30$ ;YES, SO TYPE IT ADD #'0-36-<'A-1>,R0 ;NO, SO CONVERT TO NUMERIC 30$: JSR PC,TYPE ; AND TYPE IT MOV (SP)+,R0 ;GET NEXT BNE 20$ ; IF ANY... MOV (R5),ERRPOS(R5) ;SAVE ERRING "SCANP" MOV EHELP(R5),R3 ;GET EDIT HELP LEVEL DEC R3 ;LESS 1 .IF NE E$$TXT BEQ 80$ ;IF "EH"=1 THEN ONLY RAD50 MOV (SP)+,R1 ;GET THE STRING POINTER BEQ 80$ ;IF ANY... MOV #TAB,R0 ;START WITH A TAB 40$: JSR PC,TYPE 50$: MOVB (R1)+,R0 ;GET STRING CHARACTER BGT 40$ ; IF MORE... BEQ 60$ ; OR THE STRING'S END MOVB R4,R0 ;ELSE GET LAST/MIDDLE CHARACTER BR 40$ ;AND PRINT IT, THEN CONTINUE 60$: TST R4 ;IS A QUOTED STRING TO COME? BNE 80$ ;NO, FINAL END MOV SCHBUF(R5),R1 ;YES, GET THE STRING'S POINTER MOV #SPACE,R0 ;START WITH A JSR PC,TYPE ; SPACE MOV #'",R0 ;THEN THE LEADING " 70$: BIC #-177-1,R0 ;INSURE NO PARITY BIT ON JSR PC,TYPE ;NOW TYPE A CHARACTER MOVB (R1)+,R0 ;THEN FETCH A STRING CHARACTER BPL 70$ ;AND PRINT IT CMPB R0,#-1 ;IF SPECIAL, THEN THE END? BNE 70$ ;NOW THE END YET MOV #'",R0 ;SET THE CLOSING " JSR PC,TYPE ; AND THEN TYPE THAT 80$: .ENDC TST INDIR(R5) ;IS AN INDIRECT FILE ACTIVE? BEQ 90$ ;NO, SO DON'T TELL "TECOIO" ANYTHING JSR PC,INDERR ;YES, TELL "TECOIO" ABOUT THE ERROR 90$: DEC R3 ;CHECK HELP LEVEL BLE 100$ ;UNLESS "EH">=3 THEN EXIT JMP .CMDQM ;NOW DO THE ? 100$: JMP TECO ;RESTART TECO .SBTTL Q REGISTER REFERENCE ; RETURNS: R0 = 0 ; R1 = POINTER TO Q REG SIZE ; R2 = OFFSET TO BASE OF Q REG ; "QNMBR" SET AS SPECIFIED .ENABL LSB QREF: JSR PC,SCNUPP ;GET NEXT CHARACTER .CMD.S: JSR PC,ALPHAN ;MUST BE ALPHANUMERIC BCC 40$ ; BUT IT IS NOT CMP R0,#'A ;IS IT ALPHA? BLO 10$ ;NOPE, IT IS NUMERIC ADD #13-'A-<1-'0>,R0 ;YEP, RANGE IS 13-44 10$: ADD #1-'0,R0 ;RANGE IS 1-12 QREFR0: MOV R0,QNMBR(R5) ;SAVE THE Q REG NUMBER .SBTTL GET SUM OF Q REGISTER IN "QNMBR" (QSUMY) QSUMY: MOV QNMBR(R5),R0 ;GET THE Q REG NUMBER .SBTTL GET SUM OF Q REGISTER IN R0 (QSUMX) QSUMX: MOV #QARRAY,R1 ;GET OFFSET TO Q REG ARRAY ADD R5,R1 ;NOW FIND IT FOR REAL CLR R2 ;START OFFSET OF REG AT 0 BR 30$ ;AND ENTER COUNTING LOOP 20$: ADD (R1)+,R2 ;SUM THE TOTAL OFFSE TST (R1)+ ;AND SKIP THE VALUE SPOT 30$: DEC R0 ;MORE? BGT 20$ ;YES, LOOP RTS PC ;NO, EXIT 40$: ERROR IQR,<"Illegal Q-reg"> ;BAD Q REG SPECIFIED .DSABL LSB CMDCHR <'[> ;"[" IS Q-REG PUSH JSR PC,QREF ;REFERENCE THE Q-REGISTER MOV QNMBR(R5),-(SP) ;SAVE NUMBER OF THAT REGISTER MOV (R1),R4 ;SAVE SIZE OF THAT REGISTER MOV #AUXQRG,QNMBR(R5) ;NOW SET THE AUX Q-REG'S NUMBER JSR PC,QSUMY ;SUM UP THE AUX Q-REG MOV (R1),R0 ;GET ITS CURRENT SIZE ADD R4,R0 ;ADD IN THE REF'D Q-REG'S SIZE ADD #4,R0 ;AND ADD IN 4 FOR GOODNESS JSR PC,QADJ ;NOW ADJUST(UP) ITS SIZE ADD (R1),R2 ;GET POINTER TO ITS END+1 MOV R2,R4 ;AND SAVE THAT POINTER MOV (SP)+,R0 ;GET BACK REF'D Q-REG NUMBER JSR PC,QSUMX ;AND SUM UP THAT Q-REG ADD QRSTOR(R5),R2 ;ABS PTR TO REF'D Q-REG ADD QRSTOR(R5),R4 ;ABS PTR TO AUX Q-REG END+1 CMP (R1)+,(R1)+ ;SKIP OVER THE SIZE/VALUE MOVB -(R1),-(R4) ;SAVE MSB OF VALUE AND MOVB -(R1),-(R4) ; LSB OF VALUE MOVB -(R1),-(R4) ;SAVE MSB OF SIZE AND MOVB -(R1),-(R4) ; LSB OF SIZE MOV (R1),R1 ;NOW GET SIZE INTO HERE BEQ 20$ ;NO SIZE, ALL DONE 10$: MOVB (R2)+,-(R4) ;MOVE 1 DATA BYTE DEC R1 ;CONTINUE? BNE 10$ ;YES 20$: RTS PC ;ELSE EXIT .ENABL LSB 10$: ERROR CPQ,<"Can't pop Q-reg"> ;CAN'T POP THAT FAR CMDCHR <']> ;"]" IS Q-REG POP JSR PC,QREF ;REFERENCE THE Q-REGISTER MOV #AUXQRG,R0 ;GET NUMBER OF AUX Q-REG JSR PC,QSUMX ;AND SUM IT UP MOV (R1),-(SP) ;SAVE ITS CURRENT SIZE BEQ 10$ ;NO SIZE, TOO MANY POP'S ADD (R1),R2 ;ELSE INDEX TO ITS END+1 ADD QRSTOR(R5),R2 ;MAKE THE POINTER ABSOLUTE MOVB -(R2),-(SP) ;SET MSB OF REG'S VALUE SWAB (SP) ;NOW PUT IT UP TO MSB MOVB -(R2),(SP) ; AND SET LSB OF REG'S VALUE MOVB -(R2),R0 ;SET MSB OF REG'S NEW SIZE SWAB R0 ; SWITCH IT TO HIGH BYTE BISB -(R2),R0 ; AND GET LSB OF SIZE JSR PC,QADJ ;ADJUST REF'D Q-REG TO THAT SIZE SUB (R1)+,2(SP) ;FIND NEW SIZE FOR AUX Q-REG MOV (SP)+,(R1) ;SET REF'D Q-REG'S NEW VALUE MOV -(R1),R3 ;GET NEW SIZE INTO HERE MOV R2,R4 ;SAVE POINTER TO ITS START MOV #AUXQRG,QNMBR(R5) ;GET AUX Q-REG # AGAIN JSR PC,QSUMY ;AND SUM IT UP NOW ADD (R1),R2 ;INDEX TO ITS END+1 ADD QRSTOR(R5),R2 ;MAKE POINTER ABSOLUTE ADD QRSTOR(R5),R4 ;MAKE REF'D Q-REG PTR ABS ALSO SUB #4,R2 ;BACK OVER SAVED VALUE/SIZE 20$: DEC R3 ;MORE DATA? BMI 30$ ;NO, ALMOST DONE MOVB -(R2),(R4)+ ;YES, MOVE 1 DATA BYTE BR 20$ ;AND LOOP... 30$: MOV (SP)+,R0 ;GET NEW AUX Q-REG SIZE SUB #4,R0 ; CORRECTING FOR THE FUDGE ;BR QADJ ;ADJUST IT (DOWN) AND EXIT .DSABL LSB .SBTTL Q REGISTER SIZE ADJUST ROUTINE ; R0 = NEW SIZE OF Q REGISTER IN "QNMBR" ; RETURNS: R0 = 0 ; R1 = POINTER TO NEW Q REG SIZE ; R2 = OFFSET TO THIS Q REG ; (R3,R4 ARE CLOBBERED) .ENABL LSB QADJ: MOV R0,R4 ;COPY THE NEW Q REG SIZE JSR PC,QSUMY ;AND SUM CURRENT Q REG OFFSET MOV QZ(R5),R3 ;GET END OF ALL Q REGS MOV R1,R0 ;COPY Q REG SIZE POINTER MOV R4,R1 ;AND GET WORKING COPY OF NEW SIZE ADD (R0),R2 ;POINTER TO CURRENT END OF Q REG SUB (R0),R1 ;SIZE CHANGE (NEW-OLD) BLO 20$ ;NEW < OLD BEQ 10$ ;NEW = OLD ADD R3,R1 ;NEW > OLD; GET NEW QZ SIZE QREGS ;CHECK OUT THE SIZE BCC 30$ ;WE CAN'T DO IT MOV R4,(R0) ;SET NEW Q REG SIZE MOV R1,QZ(R5) ;SET NEW TOTAL Q REG SIZE MOV QRSTOR(R5),R0 ;GET Q REG AREA POINTER JSR PC,EXPAND ;NOW EXPAND THE Q-REGS 10$: MOV QCMND(R5),R0 ;GET COMMAND Q REG NUMBER MOV #QSUMY,-(SP) ;SET FOR COMMAND SETUP JUST IN CASE SETCMD: MOV R0,QCMND(R5) ;SET COMMAND Q REG NUMBER JSR PC,QSUMX ;AND SUM UP FOR THAT REGISTER MOV R2,QBASE(R5) ;STORE THE BASE OFFSET MOV (R1),QLENGT(R5) ; AND THE LENGTH RTS PC ;THEN EXIT 20$: MOV R4,(R0) ;SET NEW Q REG SIZE ADD R1,QZ(R5) ;LOWER THE TOTAL Q REG SIZE ADD R2,R1 ;POINT TO THE END OF DELETE MOV QRSTOR(R5),R0 ;GET Q REG AREA POINTER JSR PC,SHRINK ;NOW SHRINK THE Q-REGS BR 10$ ;ALL DONE 30$: ERROR MEM,<"Memory overflow"> ;NO GO .DSABL LSB .SBTTL GENERAL SUBROUTINES GETXTP: MOV P(R5),R0 ;GET . CMP R0,ZZ(R5) ;TOO FAR? BHIS 10$ ;YES [BHIS=BCC] ADD TXSTOR(R5),R0 ;NO, MAKE ABSOLUTE MOVB (R0),R0 ;AND GET CHARACTER SEC ;OK [CARRY SET] 10$: RTS PC ;EXIT SCNUPP: JSR PC,SCAN ;SCAN FIRST UPPERC: CMP R0,#140 ;ALREADY OK? BLO 10$ ;YES BIC #40,R0 ;NO, SO CORRECT IT 10$: RTS PC ;AND EXIT .ENABL LSB 10$: MOV R0,-(SP) ;MOVE CO-ROUTINE RETURN TO STACK MOVB (R4)+,R0 ;GET ITEM COUNT MOVB (R4)+,R1 ;GET STARTING OFFSET ADD R5,R1 ;MAKE THAT ABSOLUTE MOV PDL(R5),R2 ;GET THE CURRENT PUSH-DOWN POINTER JSR PC,@(SP)+ ;AND CO-ROUTINE IT MOV R2,PDL(R5) ;UPDATE THE PUSH-DOWN POINTER MOV (SP)+,R0 ;RESTORE R0 FROM THE 'JSR R0' RTS R4 ;AND FINAL EXIT PUSH: TST PCNT(R5) ;HAVE PAREN'S BEEN PUSHED? BNE 50$ ;YES, ERROR PUSHP: JSR R0,10$ ;DO THE COMMON THING 20$: CMP R2,SCHBUF(R5) ;OVERFLOW? BHIS 40$ ;YES, ERROR MOV (R1)+,(R2)+ ;NO, SO PUSH AN ITEM DEC R0 ;AND BNE 20$ ; LOOP RTS PC ;THEN CO-ROUTINE RETURN POP: JSR R0,10$ ;DO THE COMMON THING 30$: MOV -(R2),-(R1) ;POP AN ITEM DEC R0 ;AND BNE 30$ ; LOOP RTS PC ;THEN CO-ROUTINE RETURN 40$: ERROR PDO,<"Push-down list overflow"> 50$: ERROR MRP,<"Missing )"> ;MISSING RIGHT PAREN .DSABL LSB .ENABL LSB QSKPR: MOV #IREST,-(SP) ;RESTORE ESCAPE AS QUOTE LATER QSKP: JSR PC,QCHK ;CHECK FOR A QUOTE CHARACTER MOV (R5),OSCANP(R5) ;AND SAVE "SCANP" 10$: JSR PC,SCAN ;NOW SCAN CMP R0,QUOTE(R5) ;MATCH? BNE 10$ ;NOPE 20$: RTS PC ;NOW EXIT BZCHK: CMP R0,ZZ(R5) ;TOO BIG? BLOS 20$ ;NOPE ERROR POP,<"Pointer off page">;YEP .DSABL LSB .ENABL LSB 10$: MOV #1,R0 ;PRETEND WE SAW A ONE JSR PC,NCOM ;AND COMPUTE ON IT GETN: MOV N(R5),R0 ;GET THE NUMBER INC NFLG(R5) ;REALLY THERE? BNE 10$ ;NOPE RTS PC ;YES .DSABL LSB .ENABL LSB TERMS: CMP R0,#FF+1 ;TERMINATOR TEST BHIS 20$ ;TOO BIG, RETURN C=0 10$: CMP #LF-1,R0 ;SET CARRY ON LOW RANGE 20$: RTS PC ;AND EXIT NUMER: CMP R0,#'9+1 ;NUMERIC TEST BHIS 30$ ;RETURN CARRY CLEAR IF HIGH CMP #'0-1,R0 ;SET CARRY ON LOW RANGE 30$: RTS PC ;AND EXIT RAD50: CMP R0,#'. ;.? BEQ 10$ ;YES CMP R0,#'$ ;$? BEQ 10$ ;YES ALPHAN: JSR PC,NUMER ;CHECK FOR NUMERIC FIRST BCS 40$ ;EXIT IF SO ALPHA: JSR PC,UPPERC ;CHECK FOR ALPHABETIC CMP R0,#'Z+1 ;ALPHABETIC TEST BHIS 40$ ;RETURN C=0 IF TOO HIGH CMP #'A-1,R0 ;SET CARRY ON LOW RANGE 40$: RTS PC ;AND EXIT TSTNXT: MOV (R5),R0 ;GET COMMAND POINTER CMP R0,QLENGT(R5) ;END OF COMMAND? BHIS 50$ ;YES, SO EXIT ADD QBASE(R5),R0 ;NO, ADD COMMAND OFFSET ADD QRSTOR(R5),R0 ;AND MAKE ABSOLUTE MOVB (R0),R0 ;FETCH CHARACTER JSR PC,UPPERC ;AND MAKE UPPER CASE CMP R0,(R4) ;MATCH? BNE 50$ ;NO, EXIT INC (R5) ;YES, BUMP POINTER TST (R4)+ ;SKIP ARGUMENT SEC ;INDICATE ALL OK (C=1) RTS R4 ;AND EXIT 50$: TST (R4)+ ;SKIP ARGUMENT (C=0) RTS R4 ;AND EXIT .DSABL LSB NLINES: INC CFLG(R5) ;WAS THERE A COMMA? BEQ 10$ ;YES MOV P(R5),M(R5) ;NO, SO SAVE . IN "M" JSR PC,@'L*2+TECOCH ;AND MOVE . FORWARD "N" LINES MOV P(R5),N(R5) ;"N" IS THE NEW . MOV M(R5),P(R5) ;RESTORE THE ORIGINAL . 10$: CLR NFLG(R5) ;USE UP THE NUMBER MOV N(R5),R0 ;GET NTH CHARACTER POSITION CMP R0,M(R5) ;IS IT AFTER MTH CHARACTER? BHIS 20$ ;YES MOV M(R5),N(R5) ;NO, SO SWITCH MOV R0,M(R5) ; N AND M MOV N(R5),R0 ;AND GET NTH POSITION AGAIN 20$: JSR PC,BZCHK ;IN RANGE? SUB M(R5),R0 ;FIND DISTANCE BETWEEN N AND M RTS PC ;THEN EXIT ZEROD: MOV (R4)+,TEMP(R5) ;PICKUP OUTPUT ROUTINE ADDRESS MOV R4,(SP) ;THEN SET THE RETURN ADDRESS MOV N(R5),-(SP) ;GET NUMBER BPL 10$ ;IT IS + TST NMRBAS(R5) ;IT IS -, BUT IS RADIX OCTAL? BNE 10$ ;IF OCTAL, THEN NO SIGN MOV #'-,R0 ;IF DECIMAL, THEN SIGNED JSR PC,@TEMP(R5) ;OUTPUT MINUS SIGN NEG (SP) ;AND MAKE + 10$: MOV (SP)+,R0 ;RESTORE THE NUMBER MOV #8.,R2 ;RADIX = 8? TST NMRBAS(R5) ;THIS TELLS US... BNE 20$ ;YES TST (R2)+ ;NO, RADIX = 10. 20$: JSR PC,DIVD ;NOW DIVIDE MOV R1,-(SP) ;SAVE REMAINDER TST R0 ;MORE TO GO? BNE 20$ ;YES 30$: MOV (SP)+,R0 ;GET BACK A DIGIT CMP R0,#9. ;DIGIT OR RETURN ADDRESS? BHI 40$ ;RETURN ADDRESS ADD #'0,R0 ;DIGIT JSR PC,@TEMP(R5) ;OUTPUT IT BR 30$ ;AND LOOP 40$: JMP (R0) ;EXIT .ENABL LSB GETSCH: MOV R0,-(SP) ;NOW SAVE THE ARGUMENT JSR PC,QCHK ;SET UP FOR ANY QUOTED STRING MOV SCHBUF(R5),R4 ;GET SEARCH BUFFER START MOV #SCHSIZ-1,R3 ; AND ITS SIZE 10$: CLR R2 ;GET INPUT FROM SCAN 20$: TST R2 ;WHERE DO THEY COME FROM? BNE 40$ ;A Q-REG IF NON-0 JSR PC,SCAN ;PICKUP A CHARACTER TO SEARCH FOR CMP R0,QUOTE(R5) ;END OF SEARCH STRING? BEQ 80$ ;YES CMP R0,#'Q-100 ;CTRL/Q? BNE 50$ ;NOPE JSR PC,SCAN ;YES, SO GET NEXT LITERALLY BR 70$ ;AND STORE IT IN SEARCH BUFFER 30$: TST R2 ;^E - ARE WE IN Q-REG FETCH? BNE 60$ ;YES, USE AS NORMAL ^E TSTNXT 'Q ;NO, IS IT Q-REG FETCH? MOV #'E-100+200,R0 ;RESTORE IT AS CTRL/E BCC 70$ ;NO, ENTER IT AS SPECIAL JSR PC,QREF ;YES, REFERENCE THE Q-REG ADD QRSTOR(R5),R2 ;MAKE SOURCE ABSOLUTE MOV (R1),R1 ;GET THE COUNT IN R1 40$: DEC R1 ;ANYTHING LEFT IN Q-REG? BMI 10$ ;NO, GO CLEAR FLAG MOVB (R2)+,R0 ;YES, GET A BYTE 50$: CMP R0,#'E-100 ;CTRL/E? BEQ 30$ ;YES CMP R0,#'N-100 ;CTRL/N? BEQ 60$ ;YES, THAT IS SPECIAL CMP R0,#'S-100 ;CTRL/S? BEQ 60$ ;YES, THAT IS SPECIAL CMP R0,#'X-100 ;CTRL/X? BNE 70$ ;NOPE, SO NORMAL SEARCH CHARACTER 60$: BIS #200,R0 ;FLAG THE SPECIAL CHARACTERS 70$: MOVB R0,(R4)+ ;STORE IN SEARCH BUFFER MOVB #-1,(R4) ; AND MARK END OF BUFFER DEC R3 ;MORE ROOM? BGT 20$ ;YES, SO CONTINUE ERROR STL,<"String too long">,STRING 80$: MOV (SP)+,R2 ;RESTORE THE ARGUMENT RTS PC ;AND EXIT .DSABL LSB .ENABL LSB SEARCH: JSR PC,GETN ;GET THE NUMBER JSR PC,GETSCH ;NOW BUILD THE SEARCH ARGUMENT .SURCH: MOV #1,-(SP) ;GUESS AT FORWARD TYPE SEARCH MOV R2,-(SP) ;SAVE HIT COUNTER, CHECK ITS SIGN BPL 10$ ;POSITIVE, MOVE . BY +1 EACH FAILURE NEG 2(SP) ;NEGATIVE, MOVE . BY -1 EACH FAILURE NEG (SP) ;AND GET A POSITIVE HIT COUNTER 10$: CLR LSCHSZ(R5) ;SET LAST STRING SIZE TO 0 MOV P(R5),R1 ;GET . ADD TXSTOR(R5),R1 ;AND MAKE IT ABSOLUTE ADD TXSTOR(R5),ZZ(R5) ;NOW MAKE END OF TEXT ABSOLUTE ALSO 20$: MOV R1,R3 ;GET STARTING POINT MOV SCHBUF(R5),R4 ;AND SEARCH STRING START MOV #-1,R2 ;SET CTRL/N INDICATOR INITIALLY .SUR.N: INC R2 ;FAILURE, BUT REVERSE SENSE? BNE 50$ ;O.K., A REAL FAILURE .SUR.C: CMP R3,ZZ(R5) ;END OF TEXT? BLO 40$ ;NOPE CMPB (R4),#-1 ;YEP, BUT DOES IT MATCH END OF STRING? BEQ 80$ ;YES, SO ALL DONE (FOUND) TST 2(SP) ;NO, SEARCHING BACKWARDS?? BMI 50$ ;IF BACKWARDS THEN MOVE . IF POSSIBLE 30$: CLRB 2(SP) ;INDICATE FAILURE (0 OR 177400) CMP CLNF(R5),#-2 ;SPECIAL TYPE SEARCH? BEQ 110$ ;YES, SO KEEP . CLR R3 ;NO, SO .=0 BR 100$ ;AND EXIT 40$: MOVB (R4)+,R0 ;GET A STRING CHARACTER BMI 70$ ;IT WAS A SPECIAL CMPB R0,(R3)+ ;MATCH? BNE .SUR.N ;NO, FAILURE .SUR.Y: INC R2 ;SUCCESS, BUT REVERSE SENSE? BNE .SUR.C ;O.K., SO CONTINUE 50$: ADD 2(SP),R1 ;NOPE, MOVE . ONE POSITION CMP CLNF(R5),#-2 ;SPECIAL SEARCH? BEQ 30$ ;YES, ALWAYS INDICATE FAILURE 60$: CMP R1,TXSTOR(R5) ;NO, IS . TOO SMALL NOW?? BHIS 20$ ;. IS O.K., KEEP SEARCHING BR 30$ ;. IS TOO SMALL, SEARCH FAILS 70$: INCB R0 ;WAS SPECIAL THE END FLAG? BNE .SUR.S ;NOPE, REAL SPECIAL 80$: MOV R1,PST(R5) ;SAVE (ABS) STARTING POSITION MOV R1,R4 ;COPY (ABS) START AGAIN TO SUB R3,R4 ;GET "START"-"END" = -("LENGTH") MOV R3,R1 ;SET NEXT START IF FORWARDS TST 2(SP) ;IS SEARCH GOING FORWARDS?? BPL 90$ ;YES, SO NEW START IS SET ADD R4,R1 ;NO, BACKWARDS, SO GO BACK AND ADD R4,R1 ; BACK AGAIN FOR NEW START 90$: DEC (SP) ;SEARCH ANOTHER TIME?? BGT 60$ ;YES, SO SEARCH AGAIN ALREADY MOV R4,LSCHSZ(R5) ;NO, DONE, STORE -("LENGTH") SUB TXSTOR(R5),R3 ;MAKE ENDING . RELATIVE SUB TXSTOR(R5),PST(R5) ;MAKE STARTING . RELATIVE MOV #-1,2(SP) ;INDICATE SUCCESS (-1) 100$: MOV R3,P(R5) ;SET . CORRECTLY 110$: SUB TXSTOR(R5),ZZ(R5) ;MAKE END OF TEXT RELATIVE MOV (SP)+,R2 ;RESTORE THE HIT COUNTER MOV (SP)+,R1 ;SET CC'S AND RETURN INDICATOR RTS PC ;AND EXIT .DSABL LSB .SUR.S: CMPB R0,#'S-100+200+1 ;WAS SPECIAL CTRL/S? BEQ 30$ ;YES (IT IS CTRL/S) BHI 50$ ;NO (IT IS CTRL/X) CMPB R0,#'E-100+200+1 ;NO, IS IT CTRL/E? BEQ 40$ ;YES MOV #-1,R2 ;NO (IT IS CTRL/N) BR .SUR.C ;SET REVERSE FLAG AND CONTINUE 10$: MOVB (R3)+,R0 ;GET A TEXT CHATACTER JSR PC,@(SP)+ ;GO TEST CHARACTER 20$: INC R4 ;BUMP SEARCH BUFFER POINTER BCS .SUR.Y ;MADE IT BR .SUR.N ;NO GO 30$: MOVB (R3)+,R0 ;GET A TEXT CHARACTER JSR PC,ALPHAN ;ALPHANUMERIC? BCC .SUR.Y ;NO, SO OK BR .SUR.N ;YES, SO NO 40$: CMPB (R4),#'S ;CTRL/E AND "S"? BEQ 60$ ;YES MOV #ALPHA,-(SP) ;SET FOR A CMPB (R4),#'A ;A? BEQ 10$ ;YES MOV #NUMER,(SP) ;SET FOR D CMPB (R4),#'D ;D? BEQ 10$ ;YES MOV #TERMS,(SP) ;SET FOR L CMPB (R4),#'L ;L? BEQ 10$ ;YES MOV #RAD50,(SP) ;SET FOR C CMPB (R4),#'C ;C? BEQ 10$ ;YES MOV #ALPHAN,(SP) ;SET FOR R CMPB (R4),#'R ;R? BEQ 10$ ;YES TST (SP)+ ;NO, POP ADDRESS CMPB (R4),#'X ;X? BNE .SUR.N ;NOTHING, SAY NO MATCH INC R4 ;CTRL/E & X MEAN ANY MATCH 50$: INC R3 ;CTRL/X IS ANY MATCH BR .SUR.Y ;INDICATE SUCCESS 60$: MOV R3,-(SP) ;SAVE POINTER TO TEXT 70$: CMP R3,ZZ(R5) ;END OF TEXT? BHIS 80$ ;YES, QUIT MOVB (R3)+,R0 ;NO, GET CHARACTER CMP R0,#SPACE ;SPACE? BEQ 70$ ;YES CMP R0,#TAB ;TAB? BEQ 70$ ;YES 80$: DEC R3 ;CORRECT TEST POINTER CMP (SP)+,R3 ;AND CHECK FOR NON-NULL BR 20$ ;NOW EXIT .SBTTL SIZING (SHUFFLING) ROUTINE .ENABL LSB SIZE: MOV R0,-(SP) ;SAVE R0 MOV (R4)+,R0 ;GET OFFSET TO MAX TO CHANGE CMP R1,#077740 ;IS REQUEST AT ALL REASONABLE? BHIS 90$ ;NOPE [BHIS=BCC => FAILURE] MOV R1,-(SP) ;SAVE R1 MOV R2,-(SP) ; AND SAVE R2 MOV R0,R2 ;SAVE THE MAX'S OFFSET VALUE ADD R5,R0 ;MAKE R0 ABS PTR TO MAX SUB (R0),R1 ;FIND CHANGE AMOUNT BLO 80$ ;ALREADY DONE [BLO=BCS => OK] ADD #40,R1 ;FUDGE UP REQUEST A LITTLE MOV R3,-(SP) ;SAVE R3 SUB #ZMAX,R2 ;GET WHICH AREA IS CHANGING MOV R2,-(SP) ;0=>TEXT; <>0=>QREGS JSR R4,50$ ;SEE IF CURRENT FREE DOES IT MOV #QMAX,R2 ;NO, SO GET OTHER AREA'S MAX MOV QZ(R5),R3 ; AND CURRENT IN USE TST (SP) ;QREGS ARE OTHER AREA IF 0 BEQ 10$ ;WE ARE CHANGING TEXT MOV #ZMAX,R2 ;ELSE GET REAL OTHER AREA'S MOV ZZ(R5),R3 ; MAX AND CURRENT IN USE 10$: NEG R3 ;GET -(IN USE) ADD R5,R2 ;ABS PTR TO OTHER MAX ADD (R2),R3 ;FREE = MAX -(IN USE) SUB #400.,R3 ;FIND THE PUNISH AMOUNT BLOS 30$ ;NOT ENOUGH FREE TO PUNISH SUB R3,(R2) ;ELSE PUNISH THE OTHER MAX ADD R3,CURFRE(R5) ;AND UPDATE FREE SPACE TST (SP) ;WHICH AREA ARE WE CHANGING BEQ 20$ ;IF TEXT, THEN JUST PUNISHED QREGS MOV R0,-(SP) ;SAVE MAX POINTER MOV R1,-(SP) ;SAVE DELTA AMOUNT MOV QRSTOR(R5),R0 ;GET THE REGION'S BIAS SUB R3,QRSTOR(R5) ;CORRECT THE BASE ADDRESS CLR R2 ;START OF 0 OFFSET NEG R3 ;FIND -(PUNISH) MOV R3,R1 ;AND MOVE DATA TO THERE MOV QMAX(R5),R3 ;SET THE UPPER LIMIT JSR PC,SHRINK ;NOW SHRINK IT MOV (SP)+,R1 ;RESTORE DELTA AMOUNT MOV (SP)+,R0 ;RESTORE MAX POINTER 20$: JSR R4,50$ ;WILL FREE SPACE DO IT NOW? 30$: CMP R4,#110$ ;IS THIS THE SPECIAL CALL? BEQ 40$ ;YES, DON'T REALLY SIZE JSR PC,SIZER ;ASK WHOEVER FOR MORE PLEASE BCC 20$ ;WE GOT IT! TST (SP)+ ;DUMP THE AREA DETERMINATION BR 70$ ;AND EXIT (C=0) 40$: MOV CURFRE(R5),R1 ;CHANGE REQUEST AMOUNT TO THIS BR 20$ ;AND TRY AGAIN (WON'T FAIL!) 50$: CMP R1,CURFRE(R5) ;DO WE HAVE ENOUGH FREE? BHI 100$ ;NO, SO RETURN SUB R1,CURFRE(R5) ;YES, CORRECT FREE COUNT MOV (SP)+,R4 ;RESTORE THE R4 VALUE ADD R1,(R0) ;AND CORRECT THE MAX TST (SP) ;WHICH AREA IS CHANGING? BNE 60$ ;QREGS, SO VERY EASY MOV QRSTOR(R5),R0 ;TEXT, SO GET OLD BEG PTR ADD R1,QRSTOR(R5) ;UPDATE QREG PTR MOV QMAX(R5),R3 ;GET MAX VALUE ADD R3,R1 ;FIND THE NEW MAX CLR R2 ;START MOVE AT OFFSET 0 JSR PC,EXPAND ;NOW GO DO THE EXPANSION 60$: COM (SP)+ ;DUMP AREA FLAG AND CARRY=1 70$: MOV (SP)+,R3 ;RESTORE R3 80$: MOV (SP)+,R2 ; AND R2 MOV (SP)+,R1 ; AND R1 90$: MOV (SP)+,R0 ; AND R0 100$: RTS R4 ;FINALLY EXIT .YYY.C: CLR P(R5) ;.=0 CLR ZZ(R5) ;NO MORE TEXT CLR FFFLAG(R5) ;AND NO MORE FORM FEED .YYY.S: MOV #077736,R1 ;SET A VERY HIGH REQUEST VALUE SIZE TEXT ;AND SIZE UP TEXT 110$: RTS PC ;THIS ALWAYS WORKS!! .DSABL LSB .SBTTL CHARACTER LIST FOR " COMMANDS .TABLE .CND,A,C,D,E,F,G,L,N,R,S,T,U .SBTTL CHARACTER LIST FOR E COMMANDS .TABLE .EEE,A,B,C,F,G,H,I,K,P,R,S,T,W,X .SBTTL COMMAND CHARACTER LIST .BYTE -1 .BYTE DEL .BYTE '? .BYTE '* .BYTE SPACE .BYTE ESC .BYTE 'U-100 .BYTE BEL .TABLE .CMD .WORD .CMDBL .WORD .CMDCU .WORD .CMDAM .WORD .CMDSP .WORD .CMDST .WORD .CMDQM .WORD .CMDRO .SBTTL CHARACTER LIST FOR "SKPSET" .ODD .BYTE -1 .BYTE '_ .BYTE '^ .BYTE '] .BYTE '[ .BYTE 'X .BYTE 'U .BYTE 'S .BYTE 'Q .BYTE 'O .BYTE 'N .BYTE 'M .BYTE 'I .BYTE 'G .BYTE 'F .BYTE 'E .BYTE '@ .BYTE '> .BYTE '< .BYTE '% .BYTE '" .BYTE '! .BYTE '^-100 .BYTE 'U-100 .BYTE 'R-100 .BYTE 'I-100 .BYTE 'A-100 .TABLE .CSM .WORD .CSMY ;CTRL/A .WORD .CSMQ ;TAB .WORD .CSM2Q ;CTRL/R .WORD .CSMU ;CTRL/U .WORD .CSMD ;CTRL/^ .WORD .CSMY ;! .WORD .CSMDQ ;" .WORD .CSMD ;% .WORD .CSMI ;< .WORD .CSMO ;> .WORD .CSMA ;@ .WORD .CSME ;E (EB, EI, ER, EW) .WORD .CSMF ;F (FR, FS, FN) .WORD .CSMD ;G .WORD .CSMQ ;I .WORD .CSMD ;M .WORD .CSMQ ;N .WORD .CSMQ ;O .WORD .CSMD ;Q .WORD .CSMQ ;S .WORD .CSMD ;U .WORD .CSMD ;X .WORD .CSMD ;[ .WORD .CSMD ;] .WORD .CSMUA ;^ .WORD .CSMQ ;_ .ODD .BYTE -1 .BYTE 'W .BYTE 'R .BYTE 'I .BYTE 'B .TABLE .CSME .WORD .CSMQ ;EB .WORD .CSMQ ;EI .WORD .CSMQ ;ER .WORD .CSMQ ;EW .SBTTL F CHARACTER LIST .TABLE .FFF,N,R,S .SBTTL FINAL FIXUPS... .CSECT TECOER .EVEN .END