Trailing-Edge
-
PDP-10 Archives
-
steco_19840320_1er_E35
-
10,5676/teco/source/tectek.mac
There are 3 other files named tectek.mac in the archive. Click here to see a list.
SUBTTL Introduction
; Copyright (c) 1980 Stevens Institute of Technology, Hoboken, New Jersey
; 07030.
; This software may be used and copied provided that this copyright notice
;is included, and provided that copies of all modifications are sent to:
;
; TECO Project
; Computer Center
; Stevens Institute of Technology
; Castle Point Station
; Hoboken, New Jersey 07030
;
;
; The information in this software is subject to change without notice
; and should not be construed as a commitment by Stevens Institute of
; Technology.
; Search needed universals
SEARCH TECUNV ; TECO universal file
; Generate the prologue
TECVER==200 ; Major version number
TECMIN==0 ; Minor version number
TECEDT==1067 ; Edit level
TECWHO==0 ; Last editor
PROLOGUE(TEK,<TECO Tektronix terminal support routines>) ; Generate the TITLE and other stuff
$CODE ; Put into code PSECT
SUBTTL Table of Contents
SUBTTL Revision History
COMMENT |
1000 Start of this version
1056 By: Nick Bush On: 21-November-1980
Add routines for Tektronix 4025.
Also fix an off by one case with Hazeltine 1420's.
Modules: TECHZL,TECTEK,TECDUM
1061 By: Nick Bush On: 18-December-1980
1) Finish and debug Tektronix 4025 support.
2) Add FW command.
3) Add capability of logging screen update info in log file.
Modules: TECUNV,TECTEK,TECSRH,TECTBL,TECECM,TECVID,TECERR
1067 By: Robert McQueen/Nick Bush On: 6-January-1981
The cost algorithms where wrong for a few cases (ANSII mode positioning
only). Fix them.
Modules: TECDEC,TECHEA,TECTEK
|
SUBTTL Macro definitions
; Macro to define a word of five characters
DEFINE TB(A<.CHNUL>,B<.CHNUL>,C<.CHNUL>,D<.CHNUL>,E<.CHNUL>)
< BYTE (7)A,B,C,D,E>
SUBTTL Tables -- Tektronix 4025
ND D$NLIN, ^D34 ; Number of lines to use (1-34)
CRTINI VT25
CRTENT INT,<PUSHJ P,T25INT> ; Initialize the terminal handling
CRTENT WID,^D79 ; 80 wide by
CRTENT LIN,D$NLIN ; whatever
CRTENT BCK,<TB(.CHCNH)> ; Back cursor (non-destructive)
CRTENT CIN,<PUSHJ P,T25CIN> ; Cost initialization
CRTENT CRP,<PUSHJ P,T25CRP> ; Cost of replace character
CRTENT CIC,<PUSHJ P,T25CIC> ; Cost of insert character
CRTENT CDC,<PUSHJ P,T25CDC> ; Cost of delete character
CRTENT CIL,<PUSHJ P,T25CIL> ; Cost of insert line
CRTENT CDL,<PUSHJ P,T25CDL> ; Cost of delete line
CRTENT CPP,<PUSHJ P,T25CPP> ; Cost of point to point move
CRTENT SPC,<[$STRING(<RIG^M^J>)]> ; Forward cursor (non-destructive)
CRTENT DBS,<TB(" ",.CHCNH)> ; String to delete a character
CRTENT DLF,<PUSHJ P,T25DLF> ; Routine to delete a line feed
CRTENT DVT,<PUSHJ P,T25DVT> ; Routine to delete a veritcal tab
CRTENT DFF,<PUSHJ P,T25DFF> ; Routine to delete a form feed
CRTENT CRB,<TB(.CHCNH)> ; String to cancel effect of rubout
CRTENT FIN,<PUSHJ P,T25FIN> ; String to put cursor home
CRTENT ERS,<[$STRING(<ERADOW^M^J>)]> ; String to home and erase screen
CRTENT DEL,<PUSHJ P,T25DEL> ; String to delete to end of line
CRTENT DSP,.CHSPC ; Destructive forward space
CRTENT INL,<PUSHJ P,T25INL> ; Routine to insert lines
CRTENT DLL,<PUSHJ P,T25DLL> ; Routine to delete lines
CRTENT DCH,<PUSHJ P,T25DCH> ; Routine to delete a character
CRTENT ICH,<PUSHJ P,T25ICH> ; Routine to insert a character
CRTENT TCH,<PUSHJ P,T25TCH> ; Routine to type a character
CRTENT XYP,<PUSHJ P,T25XY> ; XY positioning instruction
CRTENT CDE,<PUSHJ P,T25CDE> ; Routine to get cost to delete to end of line
CRTEND
SUBTTL Support routines -- 4025 -- Delete the end of line
;+
;.hl1 T25DEL
;This routine will delete to the end of the line.
;.literal
;
; Usage:
; MOVEI T1,# of characters to delete
; XCT $CRDEL(CRT)
;
;.end literal
;-
; Note that the 4025 does not have a real delete to end of line
;sequence. However, it does have a delete character operation. The
;delete to end of line can therefore be simulated by the delete character.
;Since the delete character takes at least 6 characters to work, we will
;delete up to 6 characters by spacing over them, and 7 or more by
;the delete character sequence.
;
T25DEL: SKIPN INSFLG ; In insert mode?
CAXL T1,^D7 ; Enough to make it worthwhile?
JRST .+2 ; If in insert mode, can't overwrite chars
PJRST SC$DEL ; No, use spacing over the characters
$SAVE <P1> ; Yes, save P1
MOVE P1,T1 ; Get the count
MOVEI T1,[$STRING(<DCH^D/P1/^M^J>)] ; Get the string
PJRST SC$STR ; Print it out
SUBTTL Support routines -- 4025 -- Cost to delete to end of line
;+
;.HL1 T25CDE
; This routine will return the cost of deleting to the end of line.
;.b.lit
; Usage:
; MOVE T1,Number of characters on line
; XCT $CRCDE(CRT)
; (return, cost in T1)
;
;.end lit
;-
T25CDE: CAXG T1,^D6 ; If only 6 chars, use num chars as cost
POPJ P, ; . . .
CAXLE T1,^D9 ; More than 10 chars?
SKIPA T1,[EXP ^D8] ; Yes, need 8 chars
MOVX T1,^D7 ; No, only 7 chars
POPJ P, ; Return
SUBTTL Support routines -- 4025 -- Initialization routine
;+
;.HL1 T25INT
;This routine will initialize the terminal handling routines for the
;specific terminal.
;.literal
;
; Usage:
; MOVEI CRT,CRT.block.address
; XCT $CRINT(CRT)
; (Return)
;
;.end literal
;-
; This will set up the terminal as follows:
; Workspace length D$NLIN.
; Margins 1,80
T25INT: SETZM INSFLG ; Flag not in insert mode
MOVX T4,D$NLIN ; Get the number of lines
MOVEI T1,[$STRING(<~COM^M^JMON HERAMAR1,80DOW^M^J>)]
PJRST SC$STR ; Output the initialization string
SUBTTL Support routines -- 4025 -- Reset terminal
;+
;.HL1 T25FIN
;This routine will reset the terminal to set up for exiting from
;TECO.
;.literal
;
; Usage:
; MOVEI CRT,CRT.block.address
; XCT $CRFIN(CRT)
; (Return)
;
;.end literal
;-
T25FIN: MOVEI T1,[$STRING(<COM~^M^J>)] ; Get the string to reset the character
PJRST SC$STR ; Output it
SUBTTL Support routines -- 4025 -- XY positioning
;+
;.hl1 H19XY
;This routine will do the positioning.
;.literal
;
; Usage:
; MOVE X,X.postion
; MOVE Y,Y.postion
; MOVE CRT,CRT.block.index
; XCT $CRXYP(CRT)
; (Return)
;
;.end literal
;-
T25XY: $SAVE <X,Y> ; Save X and Y
DMOVE T1,CURPOS ; Get the current position
DMOVEM X,CURPOS ; Save the current position
SUB T1+$OFSX,X ; Determine if it is an up/down/right/left by one
SUB T1+$OFSY,Y ; movement
SKIPE T1+$OFSX ; Is the X zero ?
SKIPN T1+$OFSY ; Or the Y ?
SKIPA ; Yes - Handle differently
JRST T25XYA ; No - Handle normally
JUMPN T1+$OFSX,T25XYX ; Just moving in the X direction
JUMPN T1+$OFSY,T25XYA ; Just moving in the Y direction
POPJ P, ; If we get here, we don't have to move at all
; Here if we are just moving in the X direction
T25XYX: SETZM INSFLG ; No longer in insert mode after this operation
JUMPL T1+$OFSX,T25XYA ; If going right, just go do it
CAXLE T1+$OFSX,^D6 ; For 6 or less columns, use backspaces
JRST T25XYA ; Otherwise use positioning op
$SAVE <CH> ; Save CH
MOVX CH,.CHCNH ; Get the backspace character
PUSHJ P,SC$IMG ; Output it
SOJG T1+$OFSX,.-1 ; Loop for enough positions
POPJ P, ; And return
; Here if we are not moving on the same line or same column.
; We must do the full addressing operation
T25XYA: SETZM INSFLG ; Not in insert mode now
SETZ T3, ; Assume plus X and plus Y
JUMPGE T1+$OFSX,.+2 ; Positive X?
AOJ T3, ; No, bump the index
JUMPGE T1+$OFSY,.+2 ; Positive Y?
ADDI T3,2 ; No, bump the index
MOVM X,T1+$OFSX ; Get the amount to move
MOVM Y,T1+$OFSY ; And the other
MOVE T1,ADRTBL(T3) ; Get the string
SKIPN X ; Any X movement?
MOVE T1,ADYTBL(T3) ; No, only Y movement
SKIPN Y ; Any Y movement?
MOVE T1,ADXTBL(T3) ; No, only X movement
PJRST SC$STR ; And output it
ADRTBL: EXP [$STRING(<LEF^D/X/UP^D/Y/^M^J>)]
EXP [$STRING(<RIG^D/X/UP^D/Y/^M^J>)]
EXP [$STRING(<LEF^D/X/DOW^D/Y/^M^J>)]
EXP [$STRING(<RIG^D/X/DOW^D/Y/^M^J>)]
ADYTBL: EXP [$STRING(<UP^D/Y/^M^J>)]
EXP [$STRING(<UP^D/Y/^M^J>)]
EXP [$STRING(<DOW^D/Y/^M^J>)]
EXP [$STRING(<DOW^D/Y/^M^J>)]
ADXTBL: EXP [$STRING(<LEF^D/X/^M^J>)]
EXP [$STRING(<RIG^D/X/^M^J>)]
EXP [$STRING(<LEF^D/X/^M^J>)]
EXP [$STRING(<RIG^D/X/^M^J>)]
SUBTTL Support routines -- 4025 -- Delete a line feed
;+
;.HL1 T25DLF
;This routine will send the character string to delete a line feed.
;.literal
;
; Usage:
; MOVE CRT,CRT.block.address
; XCT $CRDLF(CRT)
; (Return)
;.end literal
;-
T25DLF: MOVEI T1,[$STRING(<UP^M^J>)] ; Get the up cursor string
PJRST SC$STR ; Output it
SUBTTL Support routines -- 4025 -- Delete a vertical tab
;+
;.HL1 T25DVT
;This routine will send the character string to delete a vertical tab.
;.literal
;
; Usage:
; MOVE CRT,CRT.block.address
; XCT $CRDVT(CRT)
; (Return)
;
;.end literal
;-
T25DVT: MOVEI T1,[$STRING(<UP4^M^J>)] ; Get the string to delete 4 line feeds
PJRST SC$STR ; And print it
SUBTTL Support routines -- 4025 -- Delete a form feed
;+
;.HL1 T25DFF
;This routine will send the character string to delete a form feed.
;.literal
;
; Usage:
; MOVE CRT,CRT.block.address
; PUSHJ P,$CRDFF(CRT)
; (Return)
;
;.end literal
;-
T25DFF: MOVEI T1,[$STRING(<UP8^M^J>)] ; Get the string to delete 4 line feeds
PJRST SC$STR ; And print it
SUBTTL Support routines -- 4025 -- Insert character
;+
;.HL T25ICH
;This routine will cause a character to be inserted. It is called
;with the character. It is assumed that the positioning has been done
;before this routine is called.
;.literal
;
; Usage:
; MOVX CH,Character
; MOVEI CRT,CRT.block.address
; XCT $CRICH(CRT)
;
;.end literal
;-
T25ICH: SKIPE INSFLG ; In insert mode ?
PJRST SC$CHR ; Yes, Just type the character
$SAVE <T1> ; Save T1
MOVEI T1,[$STRING(<ICH;>)] ; Get the string to start insertion
PUSHJ P,SC$STR ; Type it
SETOM INSFLG ; Flag we are in insert character now
PJRST SC$CHR ; And type the character
SUBTTL Support routines -- 4025 -- Type a character
;+
;.HL1 T25TCH
;This routine will type a character on the terminal. It will first check
;to see if the terminal is in insert character mode and take it out if it
;is in insert character mode.
;.literal
;
; Usage:
; MOVX CH,Character
; MOVEI CRT,CRT.block.address
; XCT $CRTCH(CRT)
; (Return)
;
;.end literal
;-
T25TCH: SKIPN INSFLG ; In insert character mode ?
PJRST SC$CHR ; No - Type the character
PUSH P,CH ; Save CH
MOVX CH,.CHCRT ; Get the CR to end the insert
PUSHJ P,SC$IMG ; Output it
; Following two instructions might be necessary
SETZM CURPOS+$OFSX ; Clear the column
AOS CURPOS+$OFSY ; And bump the line number
POP P,CH ; Restore CH
PJRST SC$CHR ; And type the character
SUBTTL Support routines -- 4025 -- Delete N lines
;+
;.HL1 T25DLL
;This routine will cause N lines to be deleted from the screen. It is
;called with a repeat count.
;.literal
;
; Usage:
; MOVEI T1,Repeat.count
; MOVEI CRT,CRT.block.address
; XCT $CRDLL(CRT)
; (Return)
;
;.end literal
;-
T25DLL: $SAVE <P1> ; Save P1
SETZM INSFLG ; Not insert mode anymore
MOVE P1,T1 ; Get the number to delete
MOVEI T1,[$STRING(<DLI^D/P1/^M^J>)] ; Get the string
PJRST SC$STR ; And go output it
SUBTTL Support routines -- 4025 -- Insert N lines
;+
;.HL1 T25INL
;This routine will cause N lines to be inserted on the screen. It is
;called with a repeat count.
;.literal
;
; Usage:
; MOVEI T1,Repeat.count
; MOVEI CRT,CRT.block.address
; XCT $CRINL(CRT)
; (Return)
;
;.end literal
;-
T25INL: $SAVE <P1> ; Save P1
SETZM INSFLG ; No longer in insert mode
MOVE P1,T1 ; Get the count
MOVEI T1,[$STRING(<UPILI^D/P1/^M^J>)] ; Get the string
PUSHJ P,SC$STR ; Output it
SOJ P1, ; Decrement the count of lines
ADDM P1,CURPOS+$OFSY ; And fix up the position
POPJ P, ; And return
SUBTTL Support routines -- 4025 -- Delete a character
;+
;.HL1 T25DCH
;This routine will cause n characters to be deleted from the screen.
;It is assumed that all cursor positioning has been done before this
;routine is called.
;.literal
;
; Usage:
; MOVX T1,Number.of.character.to.delete
; MOVEI CRT,CRT.block.address
; XCT $CRDCH(CRT)
; (Return)
;
;.end literal
;-
T25DCH: $SAVE <P1> ; Save P1
MOVE P1,T1 ; Get the count
MOVEI T1,[$STRING(<DCH^D/P1/^M^J>)] ; Get the string
PJRST SC$STR ; And print it
SUBTTL Support routines -- 4025 -- Cost initialization routine
;+
;.hl 1 T25CIN
; This routine will return the initial cost word for the character
;by character comparison of a line.
;.b.lit
;
; Usage:
; MOVE CRT,CRTTYP
; XCT $CRCIN(CRT)
; (return, first array element in T1)
;
;.end literal
;-
CS$INS==1 ; Insert mode flag
T25CIN: MOVX T1,<INSVL.(0,CS$DEP)>!<INSVL.($OPACH,CS$OPR)> ; Get the default cost
SKIPE INSFLG ; In insert mode?
MOVX T1,<INSVL.(CS$INS)>!<INSVL.($OPACH,CS$OPR)> ; Yes, use the correct entry
POPJ P, ; Return
SUBTTL Support routines -- 4025 -- Replacement cost calculation
;+
;.hl 1 T25CRP
; This routine will return the cost of replacing a character in the
;line.
;.b.lit
;
; Usage:
; MOVE T1,CST entry
; MOVX X,[XWD -n,Column]
; MOVE Y,[XWD -n,Row]
; MOVE CRT,CRTTYP
; XCT $CRCRP(CRT)
; (return, T1=CST entry
;
;.end literal
;-
T25CRP: MOVE T2,T1 ; Get the old word
MOVX T1,<<INSVL.($OPRCH,CS$OPR)>!<INSVL.(1,CS$CST)>> ; Get the basic cost
TXNN T2,<INSVL.(CS$INS,CS$DEP)> ; Check if in insert mode
POPJ P, ; No, just return
; The 10 in may need to be only 1 if we can get out of insert mode without
;moving the cursor.
STORI. ^D10,T2,CSTCST,+T1 ; Yes, taking out takes 4 chars
POPJ P, ; Return the cost
SUBTTL Support routines -- 4025 -- Insert cost calculation
;+
;.hl 1 T25CIC
; This routine will return the cost of inserting a character in the
;line.
;.b.lit
;
; Usage:
; MOVE T1,CST entry
; MOVX X,[XWD -n,Column]
; MOVE Y,[XWD -n,Row]
; MOVE CRT,CRTTYP
; XCT $CRCIC(CRT)
; (return, T1=CST entry
;
;.end literal
;-
T25CIC: MOVE T2,T1 ; Get the old word
MOVX T1,<INSVL.(CS$INS,CS$DEP)>!<INSVL.($OPICH,CS$OPR)>!<INSVL.(1,CS$CST)>
TXNE T2,<INSVL.(CS$INS,CS$DEP)> ; Already in insert mode?
POPJ P, ; Yes, just return
STORI. 5,T2,CSTCST,+T1 ; No, must put in insert mode first
POPJ P, ; Return the cost
SUBTTL Support routines -- 4025 -- Delete cost calculation
;+
;.hl 1 T25CDC
; This routine will return the cost of deleting a character in the
;line.
;.b.lit
;
; Usage:
; MOVE T1,CST entry
; MOVX X,[XWD -n,Column]
; MOVE Y,[XWD -n,Row]
; MOVE CRT,CRTTYP
; XCT $CRCDC(CRT)
; (return, T1=CST entry
;
;.end literal
;-
T25CDC: $SAVE <P1,P2,P3> ; Save some room
LOAD. P1,CSTOPR,+T1 ; Get the last operation
LOAD. P2,CSTRPT,+T1 ; And the repeat count
SETZ P3, ; Get the basic cost
ANDX T1,CS$DEP ; Keep only dependant portion
TXO T1,<INSVL.($OPDCH,CS$OPR)>!<INSVL.(5,CS$CST)> ; Store the operation
CAXE P1,$OPDCH ; Was the last operation the same?
POPJ P, ; No, return now
AOJ P2, ; Add one to the repeat count
CAXN P2,2 ; Is this the second delete?
AOJ P3, ; Yes, bump the cost
CAXN P2,^D10 ; Is it the first that requires two digits?
AOJ P3, ; Yes, bump the cost
STOR. P3,CSTCST,+T1 ; Store the cost
POPJ P, ; And return
SUBTTL Support routines -- 4025 -- Insert line cost calculation
;+
;.hl 1 T25CIL
; This routine will return the cost of inserting a line in the
;screen.
;.b.lit
;
; Usage:
; MOVE T1,CST entry
; MOVX X,[XWD -n,Column]
; MOVE Y,[XWD -n,Row]
; MOVE CRT,CRTTYP
; XCT $CRCIL(CRT)
; (return, T1=CST entry
;
;.end literal
;-
T25CIL: LOAD. T2,CSTOPR,+T1 ; Get the previous operation
CAXE T2,$OPICH ; Already inserting?
JRST [MOVX T1,<<INSVL.($OPICH,CS$OPR)>!<INSVL.(7,CS$CST)>>
POPJ P,] ; Return a three for the initial cost
T25CID: LOAD. T2,CSTRPT,+T1 ; Get the number of inserts already done
ANDX T1,CS$OPR ; Keep only the operation
SETZ T3, ; Clear basic cost
CAIN T2,1 ; Going to first insert that needs a digit?
AOJ T3, ; Yes, count the first digit
CAIN T2,^D9 ; First that requires two digits?
AOJ T3, ; Yes, count that
STOR. T3,CSTCST,+T1 ; Store the cost
POPJ P, ; And return
SUBTTL Support routines -- 4025 -- Delete line cost calculation
;+
;.hl 1 T25CDL
; This routine will return the cost of deleting a line in the
;screen.
;.b.lit
;
; Usage:
; MOVE T1,CST entry
; MOVX X,[XWD -n,Column]
; MOVE Y,[XWD -n,Row]
; MOVE CRT,CRTTYP
; XCT $CRCDL(CRT)
; (return, T1=CST entry
;
;.end literal
;-
T25CDL: CFXN. T2,CSTOPR,+T1,$OPDCH ; Last operation a delete?
JRST T25CID ; Yes, go calculate any extra cost
MOVX T1,<<INSVL.($OPDCH,CS$OPR)>!<INSVL.(5,CS$CST)>> ; Get the initial cost
POPJ P, ; And return it
SUBTTL Support routines -- 4025 -- Move cost calculation
;+
;.hl 1 T25CPP
; This routine will return the cost of moving the cursor from
;one point to another.
;.b.lit
;
; Usage:
; MOVE T1,[XWD X pos,Y pos] ; Source position
; MOVE T2,[XWD X pos,Y pos]
; MOVE CRT,CRTTYP
; XCT $CRCPP(CRT)
; (return, T1= cost in characters)
;
;.end literal
;-
T25CPP: CAMN T1,T2 ; Really moving somewhere?
PJRST .RET0 ; No, return a zero
HRRZ T3,T1 ; Get the Y positions
HRRZ T4,T2 ; Of both
HLRZ T1,T1 ; Keep only the X position
HLRZ T2,T2 ; . . .
CAIE T3,(T4) ; Same line?
JRST T2CP.1 ; No, go check for same column
MOVE T3,T2 ; Get the destination column
SUB T2,T1 ; Get the dest-source positions
MOVE T4,T1 ; Get the destination column
MOVM T1,T2 ; Get the magnitude
JUMPL T2,T2CP.3 ; Skip if going backwards
; Here for either a forward cursor or an up cursor
T2CP.4: MOVEI T1,5 ; Assume simple case of one char
CAIE T2,1 ; Is it?
AOJ T1, ; No, need at least one more
T2CP.0: CAIL T2,^D10 ; Need two digits
AOJ T1, ; Yes, count the second
POPJ P, ; And return
; Here if position is on the same line before current position
; or is in the same column, but below the current line
T2CP.3: CAXG T1,^D6 ; Too many to send repeated LF's or backspaces
POPJ P, ; No, return the number of positions to move
MOVE T2,T1 ; Get the number of columns to move
MOVEI T1,6 ; Basic cost is 6
JRST T2CP.0 ; Go count the digits we need
; Here if new position is on a different line.
T2CP.1: CAIE T1,(T2) ; Same column?
JRST T2CP.2 ; No, try for home
SUB T4,T3 ; Yes, get the number to move
MOVM T1,T4 ; And the magnitude
JRST T2CP.4 ; No, go handle like forward cursor
; Here if not the same column or line
T2CP.2: MOVE T2,T1 ; Get the destination column
MOVEI T1,^D8 ; Get the basic cost
CAIL T3,^D9 ; Before line 10?
AOJ T1, ; No, takes another digit
CAIL T2,^D9 ; Before column 10
AOJ T1, ; No, another digit
POPJ P, ; All done
SUBTTL Low segment for TECTEK
$IMPURE
TEKBEG:!
INSFLG: BLOCK 1 ; Flag whether we are in insert mode (0 if not)
LOWVER(TEK,<.-TEKBEG>) ; Define the version number
SUBTTL End of TECTEK
END ; End of TECTEK