Trailing-Edge
-
PDP-10 Archives
-
mit_emacs_170_teco_1220
-
emacs/crtsty.mid
There are no other files named crtsty.mid in the archive.
.SYMTAB 8009. ; -*-MIDAS-*-
TITLE CRTSTY - STY program for unsupported CRTs
; (c) Copyright 1979 by Ken Harrenstien and Earl Killian.
comment ~
Operation:
CRTSTY is a program which provides ITS display support for
terminals which ITS does not support itself. A brief overview of ITS
display support is called for here. When a program sends output to a
terminal it is interpreted by the ITS Main Program (MP) Level TTY routines.
In addition to straight text to be displayed a program may output
special character sequences to perform useful operations on the
displayed output. These character sequences are called "^P codes".
The ITS MP Level interprets ^P codes (and certain ASCII format effectors
such as CR, LF, etc.) and deposits in the terminal's output buffer
"%TD codes" - an internal representation of the operations to be
performed on the display. Finally at output interrupt level the ITS
interrupt routines read %TD codes from the output buffer and send the
terminal specific codes necessary to operate on the display.
Normal ITS terminal output:
----------- ------------- ---------- ------------- ------------
| | | ITS | | ITS | | ITS | | |
| Program |--->| Main Prog |--->| Output |--->| Interrupt |--->| Terminal |
| | | | Level | | | Buffer | | | Level | | | |
----------- | ------------- | ---------- | ------------- | ------------
| | | |
^P codes %TD codes %TD codes Terminal codes
Thus the only terminals directly supported by ITS are those
small number which the ITS Interrupt Level knows about. However it
is possible to indirectly support other terminals; this is what CRTSTY
does. The CRTSTY program runs in a separate process and basically
replaces the ITS Interrupt Level in the above diagram. It does this
via the STY device which allows it to read from the output buffer of
the TTY associated with the STY. Thus CRTSTY is able to read ITS %TD
codes and translate them into terminal codes for the supported terminal.
Finally CRTSTY outputs the terminal codes to the terminal, again going
through the ITS MP Level, ITS output buffer, and ITS Interrupt Level.
However it outputs in a special mode called "super image ouput mode"
which prevents MP Level and Interrupt Level from doing anything but
passing what CRTSTY sends verbatim.
CRTSTY operation:
----------- ------------- ---------- ---------- ----------
| | | ITS | | ITS | | Pseudo | | |
| Program |--->| Main Prog |--->| Output |--->| TTY |--->| CRTSTY |--->
| | | | Level | | | Buffer | | | Device | | | | |
----------- | ------------- | ---------- | ---------- | ---------- |
| | | | |
^P codes %TD codes %TD codes %TD codes Terminal codes
------------- ---------- ------------- ------------
| ITS | | ITS | | ITS | | |
--->| Main Prog |--->| Output |--->| Interrupt |--->| Terminal |
| Level | | | Buffer | | | Level | | | |
------------- | ---------- | ------------- | ------------
| | |
Terminal codes Terminal codes Terminal codes
Add some stuff about what CRTSTY does when it gets the %TD codes.
Explain its "never do today what you can put off until tomorrow" attitude.
~
comment ~
Creating a new version of CRTSTY
After editing this file, to create a new CRTSTY executable under 20x
(Tops-20, Twenex), get the following files accessible:
CRTSTY.MID.nnn (ITS MC:SYSENG;CRTSTY >)
SYSTEM.MID.nnn (ITS MC:SYSENG;SYSTEM >)
MACROS.MID.nnn (ITS MC:KSC;MACROS >)
Then do:
@midas crtsty
@iddt
CRTSTY.EXE;L
PURIFY;G
That should do it. (You can try running the EXE file from MIDAS, just
to see if it works, before PURIFYing it.)
~
comment ~
CRTSTY Internal Structure
Conceptually, CRTSTY is composed of two separate processes
which sit astride two data streams, to form four interlocked
modules.
%TOFCI bits
|
SIMULATION | SUPPORT
|---------------| | |---------------|
PYO channel | "SMO" | | | "TYI" | TYIC channel
input <<=======|sbout< <smoget|=======|tyiput< <tyiget|============<< keybd
| out| | | | input
PROGRAM STY |---------------| IDEAL |---------------| TTY
| in | "SMI" | | "TYO" | output
output >>=======|styinc> >======|=======|td.xxx> >tr.tyo|============>> display
PYI channel | | | | | TYOC channel
|---------------| | |---------------|
|
|
%TD codes
Note well the possible confusion wherein "output" to the STY is
input from the TTY to the program, and vice versa.
In the very center one sees the "IDEAL" virtual terminal, using %TOFCI
bits on input and %TD codes on output. By using this virtual terminal
concept it is possible to simulate and support any pair of real terminals
freely, since each will be "plug compatible" with every other.
In general, only the output stream is of interest, since keyboard
input is usually passed along to the program with no modification or
special action. However, note that the SMO and TYI modules as
implemented are actually co-routines; each believes it is driving the
other. SMI on the other hand does drive TYO directly; in fact the
channel between them is one of execution paths rather than actual data,
wherein SMI decides what TD.XXX routines to invoke.
The SIMULATE component's task is to fake the program into believing
that its TTY is some particular terminal, primarily by scanning the
output stream for display commands and translating them into %TD codes.
This is useful when dealing with programs which were written with one
particular terminal in mind, as is often the case on non-ITS systems.
By default this component simulates an ITS "Soft" TTY. Since a Soft
TTY is merely the ITS virtual terminal specification, identical or
almost so to CRTSTY's virtual terminal, this contrives to be
transparent!
The SUPPORT component's task is to translate the virtual-terminal
%TD-code display commands into specific output sequences for the
particular terminal type actually being used. It is also sometimes
responsible, in the TYI module, for implementing various keyboard input
features that try to compensate for whatever mis-features the terminal
has. A prime example of this is the underscore/DEL exchange for
keyboards which have these chars on the same key, wrong side up (i.e.
they expect you to hold down SHIFT every time you rubout something).
~
subttl History
comment ~
Historical:
Historically derived from TEKSTY, munged by DPR, RZ, MOON, CBF,
EAK, and KLH. Current version nearly a complete KLH rewrite (with
exception of command parsing). TEKSTY was a version of STY (written by PJ?)
hacked up by JLK and RLB.
Date FN2 Who What
(Note KLH doesn't pay much attention to this nonsense)
3/20/78 394 EAK fix auto-nl bug again
3/28/78 400 EAK add TM.AX and TM.AY entries to HP's
3/31/78 402 EAK put check in MOVCUR for fast return if no movement
3/31/78 403 CBF remove my version of the NIH5200
4/05/78 407 EAK fix Concept 100 initialization to set tabs correctly
4/07/78 416 EAK Purified CRTSTY
4/08/78 417 EAK Fixed bug in SCRDCP
4/12/78 421 CBF Added DTI terminal
4/16/78 422 EAK Fixed bug in TEK4025
4/26/78 423 EAK Added home entry to TEK4025
4/28/78 435 EAK Fixed some OMRON bugs
5/06/78 436 EAK Increased OMRON InsLine and DelLine padding
5/11/78 437 EAK Switched to winning version of ASCNT macro
5/16/78 439 KLH Added DM3025 as per FURST's specifications
5/16/78 440 CBF Changed some timings and 1 bug in DM3025 definition
5/16/78 443 EAK Fixed some paddings in DM3025
5/22/78 448 EAK Restored C100 editing functions
5/22/78 449 EAK Fixed FOX absolute move bug and NOABS flag
5/22/78 450 CBF Made TR.AMC definitions for FOX, OWL, HP2645 and HP2640
5/22/78 452 EAK Changed C100 padding on basis of experimentation
5/28/78 454 RJL Added control _ and control ^ to c100 on function keys
5/31/78 459 RJL Added esc n function keys, padding on formfeed and
fixed init bug in C100
6/02/78 480 EAK Changed insert/delete line/character entries to take
argument instead of assuming 1
7/03/78 507 EAK Finally debugged the TEK4025 code. The terminal is
a real crock, and the manual is impossible.
7/19/78 520 KLH Hacked TRMBEG macro and CORFLS routine so that
several terminal definitions can share same page.
7/24/78 521 EAK Added some stuff to TEK4025 code.
8/01/78 527 EAK Fixed a bug in TEK4025 code. Also made definition
macros barf if arguments are blank.
8/02/78 530 EAK Created two new zone tables and modified some terminal
definitions to use them.
8/06/78 564 EAK Put in redundent movement optimizer.
8/11/78 572 KLH Finished EAK's mods and added smart CLEOL hackery!
8/12/78 RWK Made VT52 alternate keypad work right, made it %TOFCI
and put in timeout for ESC (SEL). Fixed FEEP code.
8/14/78 608 EAK Changed the world to use arguments for relative
movement functions.
8/17/78 615 EAK Redid ORDNRY to fix bugs, provide better control
character output.
8/20/78 633 EAK Fixed some bugs in movement optimizer and ORDNRY.
8/20/78 634 EAK Added a TR.WRP entry for the HP terminals.
8/20/78 635 EAK Hacked the HP terminal definitions somewhat.
8/20/78 638 EAK Added the Tektronix 4027. It is almost identical
to the 4025, but lacks for move up.
8/20/78 639 EAK Fixed a bug in CLEOL-less terminal bug in ORDNRY.
8/20/78 641 EAK Hacked 4027 CLEOL to used DCH at 60cps or slower.
8/21/78 644 EAK Fixed bug in SIMEOL so that it will clear the last
character position on a line.
8/21/78 646 EAK Moved screen image updating from ORDNRY to SCHO.
8/21/78 647 EAK Removed hackery from 4025 since not all of them
have it.
8/21/78 656 EAK Added TRMTOO and associated hackery.
8/22/78 657 EAK Fixed bug in FTLINT.
8/23/78 660 CBF Added H1500A cause Hazeltine changed RP's CR to an NL
8/23/78 661 CBF Added T1061
8/23/78 662 CBF Changed TK4027 to always use DWN instead of LF
This may also have to be done to the 4025
8/23/78 663 RWK Fixed a %CLPND bug in ORDNRY.
8/23/78 664 EAK Added DBUFC for debugging.
8/27/78 667 EAK Changed FRCEOL to not output CLEOL unless its
really needed.
9/01/78 668 EAK Fixed a bug I introduced into FRCEOL.
9/01/78 669 EAK Added more smarts to SMEOL on terminal with CLEOL.
9/03/78 670 EAK Added a CHO routine for the Concept 100. Also,
turned off character insert/delete.
9/05/78 671 CBF Add the BEE3 for CMR
9/07/78 679 EAK Fixed some VT100 stuff after playing with one.
9/08/78 680 EAK Added some scroll region optimizations for the VT100.
9/08/78 681 EAK Added Infoton 4380 support. Also added sample
terminal definition.
9/09/78 683 RWK Made -> key on VT52 into [BREAK] instead of [FORM]
9/09/78 684 RWK Added [ENTER] key hackery to VT52 stuff
9/09/78 686 RWK Made code for [ENTER] stuff available to any terminal
and added code to flush it from core for those that
don't use it.
9/09/78 691 RWK Added terminal-specific interactive ([ENTER])
capability. Intended for re-initing terminal
parameters, etc.
9/09/78 691 RWK Added Alarm mode toggle as an [ENTER] command
9/09/78 692 RWK Started adding the DELPHI terminal type. (An
intelligent protocol between DELPHI UNIX and ITS
including a mini-FTP for people here TA'ing 6.031)
9/09/78 694 RWK Spec'd out the FTP portion of DELPHI type.
9/09/78 699 RWK Added log file hackery
9/09/78 703 RWK Fixed a bug in VT52 sail graphics.
9/09/78 705 RWK More DELPHI hacking.
9/12/78 706 EAK Added a VT100 absolute movement cost calculator.
9/12/78 708 EAK Fixed two bugs in log file stuff.
9/13/78 709 EAK Fixed two bugs in Teleray 1061 code before demo today.
9/13/78 717 EAK Debugged Teleray 1061 support.
9/13/78 718 EAK Fixed bug in VTCHO.
9/15/78 719 CBF Hacked Adds 980 a bit.
9/17/78 724 EAK Hacked log file stuff a little more.
9/20/78 727 CBF Fixed BADSPC up a little.
9/20/78 729 EAK Tidied up OMRON code.
9/20/78 731 EAK Removed GRAFIX hack per request.
9/20/78 736 EAK Changed around a lot of the command line parsing.
Still needs an awful lot of work.
9/24/78 738 RWK Fixed a bug in the CRTSTY-escape code.
9/27/78 739 CBF Made TK4027 use the obscure hardware CLEOL.
10/12/78 751 EAK Added stuff to flush initialization code after
startup.
10/20/78 766 EAK Created terminal type SOFT and reorganized lots
of the TD routines. In the process HOMCLR went
away; TDCLR and TDEOF now conspire to do it's job.
10/20/78 767 EAK Fixed up TK40XX insert line at top code a little.
10/20/78 770 EAK Added basic windowing stuff.
10/21/78 777 EAK Added insert/delete line/character simulation.
10/23/78 780 KLH Changed the terminal definition table to be BLT'd
into the TB array at initialization. Redid STY
input.
10/24/78 790 KLH Added NLS LP simulation.
10/24/78 792 EAK Redid screen dumping stuff a little.
10/24/78 793 EAK Added some TNX conditionals.
10/25/78 794 MMCM Added Soroc IQ 120.
10/25/78 797 EAK Added some more TNX stuff. Changed WARN to use ORDNRY.
10/27/78 804 CBF Added RPVT52, it's sick.
10/27/78 807 KLH Added H1510.
10/28/78 808 EAK Added %TDWIN stuff. Created TE.WIN entries for the
VT100 and Concept 100.
10/30/78 809 EAK Hacked insert/delete line/character to work better
in windows. Also added .TRFIN to be called before
CRTSTY quits.
10/30/78 810 EAK Added ACT-IV. Changed log file's home to be CRASH.
11/01/78 811 EAK More fixes for insert/delete line/char in windows.
Added .TPSCR, the scroll count for the terminal
(corresponds to TTYROL in ITS). Also, changed screen
image to live right after variables to save a page
on occaisions.
11/01/78 812 EAK Reorganized TD subroutines. Added some more TNX
conditionals.
11/03/78 814 EAK Redid TD.(DLF ILP DLP ICP DCP) yet again. %FNxxx
no longer need to be specified in terminal definitions.
SIMEOL now calls TD.DLF instead of ORDNRY.
11/06/78 819 EAK Replaced PAD subroutine with PAD UUO. Changed all
the TR.TYI handlers to conform to KLH's new scheme.
11/07/78 821 EAK Added @ITS command line option.
11/08/78 822 EAK Changed NOWARN to NO WARN, NOLOGIN to NO LOGIN, and
NOBELL to NO BELL. Also changed SCREOL, SCREOS,
and SCRILP to work with windowing.
11/09/78 824 RWK Fixed bugs in ENTER code.
11/09/78 827 EAK Reorganized more of the initialization code to make
it more modular and make it easier to conditionalize
it for TNX. Also changed C100 padding to be closer
to reality, making it pretty hairy.
11/10/78 828 EAK Changed NOABS to NO ABS, and NOTABS to NO TABS.
Hacked TPCBS stuff. Moved lots of code around
to make groupings more logical. PAD UUO now rounds up.
11/10/78 830 EAK Changed SCRICP to work with windowing. Commented
out DBUFC (not worth the buffer space it takes).
11/14/78 834 EAK Added a wrap optimizer to the I4380.
11/16/78 837 EAK Removed %FLCNL and added CCHO in its place. CCHO
hacks scrolling when typing in the last column of the
last line. Added redisplay command to ACT stuff.
11/16/78 838 EAK Changed SCRDLP to work with windowing.
11/21/78 852 KLH Re-did some LP support/simulation stuff.
11/21/78 853 GSB Added TX.VBL entry for Concept 100 and also changed
its TR.CHO to hack underscores to avoid lossage.
11/21/78 854 EAK Fixed a bug in C1CHO and hacked it a bit.
11/24/78 8?? KLH decides to give up and start writing garbage in here.
11/24/78 880 KLH Made TYI and SMI modules into co-routines, re-did
most TR.TYI entries to take advantage of new
capabilities. Added more doc, clarified structure.
Fixed several bugs in term defs (ACs not saved).
11/26/78 883 EAK Changed TD.SCR to TD.SU. Added SCROLL command line
option.
11/27/78 888 KLH Fixed bug in TD.ILP/DLP/ICP/DCP routines, added
TD.SD (scroll down), redid terminal subttl's.
11/27/78 892 EAK Undid KLH's undo of my undo to KLH's undo of my .TPSCR
stuff. Also fixed a bug in .TPSCR where cursor isn't
updated updated correctly when .TPSCR<>1.
11/27/78 897 EAK Changed SCRDCP to hack windowing.
Began TR.TYI changes to improve co-routine setup.
11/29/78 899 KLH Completed most TR.TYI changes, also changed STY
interrupt vectoring similarly. Fixed SCREOL bug.
Added ACT-V.
11/30/78 900 EAK Removed HP2640 definition, moved much of its stuff
into the HP2645. Eventually I'd like to make HPINIT
see what name was used to invoke the HP code and do
some stuff conditional on that name being HP2640.
11/30/78 901 EAK Redid VT52 input co-routine and timeout stuff.
Timeout stuff is now available to all terminals.
11/30/78 902 EAK Hacked REDISP stuff a little.
12/01/78 903 RWK Put [HELP] back in the ASKQUE routine. This is easier
to type on a VT52 (and I expect other TTY's too) than
[BACK-NEXT]H or [TOP]H
12/01/78 906 RWK Put in table of TOP characters. What existed was
useless.
12/01/78 909 EAK HP2645 bug fix.
12/02/78 912 EAK Fixed up simulator output co-routine initialization.
12/03/78 914 EAK Added some 20X PTY code.
12/04/78 915 KLH Added for LP mouse simulation.
12/05/78 917 EAK Random changes all over.
12/06/78 918 EAK CT64 bug fix.
12/06/78 919 EAK ADM2 bug fix.
12/06/78 920 EAK Fixed initialization bug introduced in 917.
12/06/78 921 EAK Changes to %PITTY interrupts.
12/07/78 922 CBF Minor fix to RPVT52, fixed JTRMSLS to list several
terminals per line again, and put in VT100 padding.
12/07/78 926 KLH Added DATAPOINT, tried to document some hair.
12/08/78 928 KLH Added XLOG, improved CCHO, removed SCRLCOUNT=0
check. Scroll stuff really needs to be fixed.
12/08/78 929 EAK Put back detached check in RLTINT; it is needed
because %PITTY doesn't go off reliably.
12/08/78 930 EAK Added SLEEP macro. Reversed PG$MSK convention.
12/08/78 931 EAK More TNX modifications.
12/14/78 943 KLH Added DATALOSER (still needs work), condensed
TMCDEF etc macros, TB entries now have labels for DDT.
Changed TR.INI default, dbgsw setting.
12/14/78 944 KLH Fixed a CLEOL bug.
12/14/78 947 KLH Changed Dm2500 i/c and i/l code to use cleverness.
12/17/78 950 RWK Put the ASKHLP routine (from ASKQUE) inside the IFN ITS
12/22/78 953 KLH Fixed DEFINI bug, changed LP's .TRINI back owing to
problems with hacking TYIGET before interrupts enabled.
1/03/79 954 BYRON Minor adjustment to C100 padding.
1/29/79 960 CBF Changed OMRON to -%TOLID if > 300 baud.
2/25/79 962 CBF Added MIME52 for Emery. Essentially VT52 with line i/d
2/28/79 964 EAK Changed C1CHO3 to use repeat character horizontal.
Also changed OSMAP a little.
3/01/79 966 GSB&EAK Hacked C1CHO some more.
3/02/79 967 EAK Added STYIP for hacky optimizations.
3/03/79 968 EAK Added TRANSLUCENT option for C100. Completely redid
C1CHO. Also started WHOLINE option.
3/05/79 970 EAK Moved OSMAP code into OSINIT, TTYINI, STYINI.
Changed HPINIT to use BUFC while sending terminal
reset.
3/11/79 971 EAK Fixed up TKILP.
3/11/79 972 EAK Added WHO1/WHO2/WHO3 hacking to WHOLINE stuff.
3/11/79 973 EAK Added JTMU, NMPGS, and NSWPGS hackery to WHOLINE.
3/11/79 974 EAK Fixed screwed up %F flag definitions.
3/12/79 976 EAK Added I400.
3/13/79 977 CBF Added I100. (This is support your local Infoton week)
3/13/79 978 CBF Added ADS100 for Macrak and hacked MIME52 for Emery
3/14/79 979 EAK Fixed I400 bugs, changed C1CHO to hack last column
better.
3/15/79 980 EAK More I400 work.
3/16/79 981 EAK Changed XITEX to use NUL for padding.
3/17/79 982 EAK Fixed formatting bug in WRTLOG.
3/18/79 983 EAK Fixed TDORS problem with WHOLINE.
3/24/79 984 EAK C100 window hacking.
3/25/79 985 EAK Added optimization to TDDLP.
3/26/79 986 EAK Hacked C100 insert/delete character subroutines.
3/26/79 989 EAK Random hacking.
3/30/79 990 EAK Added TR.NRM to make wrapping work. Also changed
%FNxxx computation in SETUP3 and TD.WIN. It is now
possible to have, for example, a TE.ICP entry which
isn't used because of a %FNICP in TP.FLG (but that
can be overriden by a CID in the command line).
Also added %PIATY interrupt handler and DMOVE/DMOVEM
macros.
3/31/79 991 CBF VT100 hacking.
3/31/79 992 EAK Rewrote ORDNRY, SCHO, CCHO to be faster.
3/31/79 993 EAK Added TE.EIM and TE.LIM.
4/01/79 994 EAK Fixed bug in %PIATY interrupt handler.
4/03/79 999 EAK Numerous changes to everything. Mostly completing the
TNX SUPDUP code.
4/09/79 1000 EAK More changes for TNX SUPDUP code. Sort of hacky
at the moment.
4/09/79 1001 EAK Wrote FINI, QUIT, and PROCED. Flushed C1FINI.
4/10/79 1002 EAK Fixed bug %TOLID/%TOCID bug in SETUP4.
4/12/79 1003 EAK Added more command character hackery. Hacked CC.FWD.
4/20/79 1004 CBF Added VDM1 for Jerry Pournelle
4/22/79 1005 CBF Added H19
4/22/79 1007 RWK Added TH6416 for NEAL (he wrote it, this is a merge)
4/24/79 1008 EAK Fixed H2000 bug.
4/24/79 1009 EAK Added some %TX code to SWSMO. Hacked ENTER/CMDCHR.
4/25/79 1010 EAK Fixed bug in H19DEC.
4/27/79 1011 EAK Added %FNEOL+%FNEOS to Xitex's TP.FLG.
4/28/79 1013 EAK Reduced padding for Teleray 1061. TNX hackery.
5/10/79 1015 EAK Changed VT100 definition a fair amount.
5/17/79 1017 EAK Added CLEOL padding to T1061.
5/18/79 1018 EAK Fixed NO BELL, added VT100 visbel.
5/28/79 1019 EAK Added ANNARB and ADI60.
5/29/79 1020 EAK Added tabs to ANNARB support.
5/30/79 1021 EAK Added TEL3 for ELL.
6/10/79 1022 EAK Added TLC for AUTHOR.
6/12/79 1023 EAK Added PGA,GYRO's DD5200 code.
6/18/79 1024 EAK Added SOL20 for LEWIS! and DEVON.
6/18/78 1025 EAK Changed C1EOL and C1EOS to use Clear All.
6/18/78 1026 EAK Added I200 for MACRAK.
6/19/79 1027 EAK Changed SOL20 for DEVON.
6/20/79 1028 EAK Added VT52 simulation.
6/21/79 1029 EAK Added TNX JERR1 uuo for reporting JSYS failure returns.
6/22/79 1030 EAK Added real TYITOG for TNX, added SIBEBUG stuff.
6/22/79 1032 EAK Added more TNX error handling code.
6/25/79 1034 EAK Debugged TNX PTY and INT code. TNX&STY&INT doesn't
work because SIBE doesn't appear to work on PTY
channels! TNX&INT doesn't work because .TICTI
doesn't leave interrupt character in input buffer!
6/26/79 1036 EAK Stopped using IVORY in favor of SECTIONs.
7/05/79 1037 EAK Fixed bug in TNX NET STYINI, CHNTAB definition,
changed IQ120 to use CCHO, and fixed missing
TE.EOL in SOL20 definition.
7/09/79 1038 EAK Added C1TYI.
7/10/79 1039 EAK CID option tells C100 support to use fixes for
insert/delete character.
7/11/79 1040 EAK Changed SIMULATE default for TNX&STY to VT52.
7/20/79 1043 EAK Merged in HARV's TUBE1.5.
7/21/79 1044 EAK Added automatic login on TNX PTYs and open TTY:
instead of TTYnnn.
7/21/79 1045 EAK Added ICMASK so DM2500 and T1061 input handlers can
hack meta bits.
7/22/79 1046 DCH Added MIME.
7/23/79 1047 EAK Added NO LOGIN option for TNX&STY.
7/27/79 1048 EAK Fixed H19 per MT's request.
7/28/79 1049 EAK Fixed SOL20 and TUBE1.5 per requests.
7/28/79 1050 EAK Moved VTABS to utility section, added TYODEC utility.
7/31/79 1052 EAK Merge several insert/delete lines in VT52 simulation.
8/01/79 1053 EAK Added PURIFY routine for TNX.
8/12/79 1055 EAK Added code to handle too many insert/delete
lines/characters.
8/14/79 1056 EAK Added fair share to wholine, updated option listing,
change ICP to be to SUPDUP socket, made TNX TYIPUF and
SMOPUF better, and added %FSPD to H19 flags.
8/16/79 1057 CBF Added HP2621 from HP2645 definition
8/16/79 1058 EAK Added more comments, fixed %PIATY bug, hacked FRCV
to handle non-existant receive fork. Added REINIT
and NO FLUSH.
8/16/79 1059 EAK Divided INT conditional into TINT and SINT for
TTY and STY. Got TTY input interrupts to work.
8/21/79 1065 EAK Add ITS network code. Still needs work.
8/22/79 1066 EAK Added TNX WHOLINE code. Fixed up VT52 simulator.
8/23/79 1067 EAK Added a few .XCREFs.
8/31/79 1069 EAK Added load average to TNX WHOLINE.
9/04/79 1075 KLH Fixed bug in LP, TDDLP. Cvtted LP to TNX.
Added TYIPUC routine to centralize cmd-char check.
9/05/79 1081 KLH Put in kludge code to make SIBE work with TINT.
Added IBUFIP.
9/09/79 1084 EAK Added IQ140 for JAC.
9/11/79 1085 EAK Fixed IBUFIP.
9/12/79 1086 EAK Lots of little changes all over. Fixed TM.NLs
that used TYN instead of TYO. Re-ordered JCOPTs
and :CRTSTY ? listing. Renamed CLEOS to
STEOS and added NO CLEOL and NO CLEOS. Moved MOVC20
label to right place. Bummed an instruction from
CC.TAB. Deleted H200 and H2LOSE CLEOL routines.
9/13/79 1087 CBF Added Perkin-Elmer Bantam
9/27/79 1088 EAK Added chaosnet code.
10/01/79 1089 CBF Made DM2500 cancel modes at initialization time
10/13/79 1090 CBF Added IBM 3101.
10/23/79 1091 EAK Fixed bugs in IBM 3101.
11/02/79 1092 EAK Conditionalized stuff in VTTYI on ITS\NET.
11/12/79 1093 EAK Added VT52 absolute positioning hack to VT52 simulation
12/03/79 1094 HIC Fixed some bugs in BANTAM support. Still needs work.
12/11/79 1095 EAK Added AAB for AQE (another Ann Arbor!). Also
changed TR.NRM to be just for horizontal wrapping.
12/13/79 1096 EAK Added %TDRSU/%TDRSD code. Not tested yet.
12/20/79 1100 RWK Added TE.SU entry for H19, made TE.INI reset auto-CR
and turn on the cursor! Flushed losing DELPHI spec
which was never finished and useless now anyway.
Added TX.WE, TX.WB, TX.WI, and TR.WHO, and gave H19 a
TR.WHO to use the 25'the line.
12/21/79 1101 EAK Changed around new wholine stuff. Fixed several bugs
in it (probably introduced a few). TP.WHO kludge
eliminated in favor of TR.WI.
1/13/80 1109 EAK Added %TDRSU/%TDRSD code.
1/24/80 1110 EAK Fixed a 20X TT%PGM bug.
1/29/80 1111 EAK Turn on %TPRSC when %TOLID turned on. Fixed bug
at XDLP4 that caused random lossage sometimes.
1/30/80 1112 EAK Added TR.FIN for H19 to prevent cursor from
being left on status line.
1/30/80 1113 EAK Fixed bug in STYIP that prevented one character of
the input stream from being read!
2/07/80 1114 EAK H19 wholine bug fix.
3/30/80 1122 CBF Installed RLL's first cut at VT132.
4/18/80 1125 EAK Added gross padding to VT132.
5/07/80 1127 EAK Increased C100 insert/delete line padding a bit.
5/23/80 1129 EAK Changed IQ140 insert/delete codes for JAC.
5/25/80 1130 EAK Fixed H19 25th line problems with 20X SUPDUP version.
6/08/80 1133 CBF Added TVI912 for DBK, put IQ120,140 in alpha order.
6/21/80 1138 CBF Added AJ510 for GNU, installed BKD's Cromem 3101
Had to up MAXTRMs from 80.! Set it to 120.
6/27/80 1142 EAK Added CSK's VT05 code and removed RLJFN from PURIFY.
7/12/80 1144 CBF Couldn't resist the amusement of adding DWARME's ACT-II
commented out due to CRTSTY lossage
7/30/80 1150 CBF Added VIP7800 for MAXB
8/5/80 1152 CBF The problem with the ACT-II and the VIP7800 was due
to Midas limits on constants. EAK made a new version
on MC which fixes it. In celebration I added, KTM2
for MAXB, DG200 for JJK and INtertec-S for JWP.
ACT-II & VIP7800 should work now also.
9/8/80 1162 RLL Added support for the AAA (Ann Arbor Ambassador)
terminal. There is no padding, but that might
change when it's tried out on the terminal.
9/9/80 1167 EAK Fixed up AAA support a bit. Added TYOANS & TYNANS
UUOs.
11/1/80 1176 CBF Added ADM-31 for Stever
12/30/80 1187 EAK Fixed bug in TDICP.
1/4/81 1188 EAK Added AUTONL option.
1/6/81 1189 EAK Fixed bug in TD.IC.
1/7/81 1192 RWK Fixed up AAA, added padding to CLEOS, and made it
always use absolute positioning, since as near as I can
tell the move forward and backwards commands don't work
in random cases. Sounds unbelievable, and I'll try
hacking it some other time.
1/9/81 1193 EAK Fixed but in WHOOUT that caused H19 wholines and
SMEOL to lose together.
1/14/81 1197 RWK Hacked up on AAA. Will try the Move Horizontal Relative
command instead of the Forward Cursor, and see if that
works. Made it set mode to ensure clear screen actually
clears, even if there are protected fields. Determined
that the clear-screen command cannot work at 9600 baud
since it does not home up until after the padding is
done and it puts characters at the cursor as it moves
the cursor (or some such lossage). I.e. if you make it
pad for 2 seconds, the screen clears, the cursor frobs
away at the bottom of the screen while padding happens,
a few characters are placed partway up the screen, and
then finally the rest make it to the top. Probably a
bug in the ucode, not an inherent flaw....
Probably the padding needs to be adjusted according to
the screen size.
2/4/81 1198 BEE Fixed AAA to set the screen size correctly. Also why is
the tab setting commented out?
3/6/81 1208 EAK Fixed H19 problem with CRTSTY --> prompt and
redisplay.
3/7/81 1209 EAK Wasn't good enough; another try.
3/15/81 1210 EAK Fixed up ITS network code to install a SCRTSTY.
5/5/81 1219 EAK Added KTM3 for ELF.
8/21/81 1236 LRH Added VISBEL to KTM3 and comments for ADM2
8/21/81 1237 LRH Fixed bug caused by code added in 1236
9/9/81 1238 CBF Added ADDS viewpoint, changed ADS100 to make it work?
11/8/81 1242 GNU Fixed VT132 enter/exit insert (reversed), standout.
11/8/81 1243 EAK Added ADDS25 for RMS (EMACS user request).
11/9/81 1244 GNU Added ENTER C to send control chars user can't make.
Also fixed VT100 VISBEL.
11/19/81 1246 CBF,EAK Added ISC800 for FJW.
11/21/81 1248 EAK Worked on Ambassador code a little.
12/25/81 1250 CHIRON Cleaned up some Chaos code. Can now use TINT&CHAOS
without spurious error messages. When Chaos
host breaks connection, CRTSTY handles it
properly. Added ADM5 terminal (per best
documents available). Attempted to make Chaos
code interupt driven (CHAOS&SINT&TINT), but
Twenex seems wedged.
1/6/82 1254 CHIRON Fixed ADM5 Definition.
3/27/82 1257 RWK Visibel for AAA
3/27/82 1259 RWK JRTR6F was making caller skip instead of self, so
:AAA ... would kill itself rather than assume AAA.
3/27/82 1260 RWK AAA -- Fixed standout mode to work with inverse video,
made wholine use it.
4/4/82 1264 RWK AAA: Fixed wholine to use standout mode on all of the
wholine, including the part initially drawn. Make
VISBEL not un-invert it.
4/21/82 1270 CHIRON Fixed ADM5 definition to be 80x24. Users are
should run with auto-NL off, and perhaps tell CRTSTY
to only use 79 columns.
4/27/82 1271 LRH Changed KTM-3 bell code to use new bell character.
8/16/82 1272 CBF Added Lunar for Moon's terminal.
History: ; This is here for the TAGS package to find where to
; add new history entries
~
subttl Things-to-do
comment ~ To Be Done (someday)?:
Not all of these things are, of course, realistic, hence "?".
!!!!! Make JCL option reader recognize partial matches.
With so many cmds, this is more impt now.
Flush SPEED, recognize 120, 1200, etc. directly.
in SUPDUP, allow host name in JCL without "HOST" spec.
Command reader should list commands in response to "?".
New command if SUPDUP: EXEC, to run inferior exec.
New command: BREAK, to send break.
New JCL option: META.
Enable META-bit processing. Escape becomes meta-^@.
On SRI-KL, default SUPDUP options are DM2500, META, etc.
Add support for %TOOVR terminals.
Make tabstop setter more general, have "set-tab" terminal-table entry
as well as "clear-tab" (or "clear-all-tabs") or something.
MOVCUR Optimizer - variable-size tab calculations?
Figure how to have efficient distinction between
a) neither atomic nor simulate exist.
b) atomic commands, no simulate
c) no atomic, uses simulate.
d) atomic cmds exist, but shorter simulate also exists.
(assmption is that a longer-than-atomic simulate will never want
to exist!)
Separate universal term flags into LH of F, dependent flags into RH
(or define mask range for them)
Store line sum counts in front of SCREEN? For easier check-EOL-ing;
not hard to do, but saving may be trivial.
Must remember MODE that terminal is in; some terms have many different
modes with different ways of exiting each. (upon entry to mode, store
vector to getting out of mode?)
CRTSTY test program? either routine in CRTSTY, or program using ^P
codes? (or program feeding it software codes directly? 2 sty's in a row...)
see KLH;CRTEST >
Detach sty when tty disappears. May need more ITS support.
Check %TANJS bit of STYGET call? Or somehow detect when the ^Z sent to
STY isn't getting a hactrn; this could be a big loss if it
hangs up crtsty forever.
Debug script file. normal feedthru chars all on one line, all 2xx
chars given as:
<crlf> <octal> <name of %TD> | <oct>..<oct> move h,v -> nh,nv
(chars sent) (description)
~
subttl Definitions
IF1 {
its==1
10x==1
20x==1
.insrt system
} ; IF1
ifndef sty, sty==0 ; STY device output
ifndef net, net==0 ; NET device output (i.e. a TELNET or SUPDUP)
ife sty\net, sty==its ? net==1-sty
ifndef tint, tint==its ; TTY interrupt driven
ifndef sint, sint==its ; STY interrupt driven
ifn net,{
ifndef arpa, arpa==1
ifndef chaos, chaos==1
}
ife net, arpa==0 ? chaos==0
ifndef sibebug, sibebug==10x
ifndef histohack, histohack==0
F=:0 ; AC of flags
A=:1 ; A-E are used for arguments and return values.
B=:2 ; In general these ACs are preserved across subroutine calls.
C=:3
D=:4
E=:5
Z=:6 ; Random MOVCUR AC
CP=:7 ; Cursor motion hack stack
V=:10 ; "Actual" current vertical position
H=:11 ; "Actual" current horizontal position
VH==:V ; VH refers to the pair V,H
NV=:12 ; "New" virtual positions
NH=:13 ; "New" virtual positions
NVH==:NV ; NVH refers to the pair NV,NH
T1=:14 ; temporaries, not saved by UUOs, subroutines, or macros
T2=:15 ; ...
; 16 unused!
P=:17 ; PDL pointer
.XCREF F,A,B,C,D,E,V,H,NV,NH,T1,T2,P
; ACs for .I/.F
A0==:T1
A1==:T2
IFN ITS,{
; I/O channel assignments.
tyon==:2 ; Console terminal output during startup
pbout==.iot tyon,a ; hack for reducing conditionals
tyic==:3 ; Input from supported terminal
tyoc==:4 ; Output to supported terminal (Superimage)
ifn net, icpch==:5 ; ICP channel, PYI/PYO must be ICPCH+2/ICPCH+3
pyi==:7 ; Input from sty (some program outputting to TTY)
pyo==:10 ; Output to sty (some program reading typein from TTY)
dsko==:12 ; channel for various disk outputs.
} ; IFN ITS
; F flag values, LH (see TRMFLG for RH values)
; These flags used for setting bucky-bit input.
%imeta==400000 ; For input, metize next char
%itop== 200000 ; topify next char
%ictrl==100000 ; controlify
%imtc==%imeta+%itop+%ictrl
%ipesc== 40000 ; Indicate ESC key seen (preceding current)
%ipesq== 20000 ; Indicates ESC-? (for VT terms)
%ipcts== 10000 ; for ^S/^Q hacking by RPVT52
%clpnd== 4000 ; 1 => CLEOL pending
%icm==: 2000 ; insert character mode
IFN TNX, IF1 EXPUNGE DTI
ifndef maxver,maxver==70. ; max value for vertical screen size (SHEIGHT)
ifndef maxhor,maxhor==140. ; max value for horizontal screen size (SWIDTH)
IFE ITS\.ITS,{
;NOW COME THE BITS OF THE CHARACTER ITSELF:
%TXTOP==:4000 ;"TOP" KEY.
%TXSFL==:2000 ;"SHIFT-LOCK" KEY.
%TXSFT==:1000 ;"SHIFT" KEY.
%TXMTA==:400 ;"META" KEY.
%TXCTL==:200 ;"CONTROL" KEY.
%TXASC==:177 ;THE ASCII PART OF THE CHARACTER.
%TNPRT==:0 ;PRINTING TTY.
%TNDP==:1 ;TTY USES DATAPOINT CURSOR CTL CODES.
%TNODP==:2 ;TTY IS A LOSING DATAPOINT.
%TNIML==:3 ;TTY USES IMLAC CURSOR CODES.
%TNTEK==:4 ;TEKTRONIX 4000 SERIES
%TNTV==:5 ;TTY IS A KNIGHT TV DISPLAY.
%TNMEM==:6 ;TTY IS A MEMOWRECK.
%TNSFW==:7 ;"SOFTWARE" TTY THAT WANTS I.T.S. CURSOR-MOTION CODES.
%TNTRM==:10 ;TTY IS A TERMINET.
%TNESC==:11 ;TTY WANTS ASCII STANDARD ESCAPE SEQUENCES. (E.G. VT52)
%TNDTM==:12 ;DATAMEDIA
%TNMAX==:13
;TTYOPT WORD DESCRIBES CHARACTERISTICS OF THE PARTICULAR
;TERMINAL ATTACHED TO EACH LINE.
;LEFT HALF BITS ARE:
%TO==:1,,525252 ;BIT TYPEOUT MASK
%TOALT==:200000 ;4.8 => STANDARDIZE ALTMODES.
%TOCLC==:100000 ;4.7 => CONVERT LOWER CASE TO UPPER.
%TOERS==:40000 ;4.6 => THIS TTY CAN SELECTIVELY ERASE.
%TOHDX==:20000 ;4.5 => THIS TTY IS HALF-DUPLEX.
$TOHDX==:370100
%TOMVB==:10000 ;4.4 => THIS TTY CAN BACKSPACE.
%TOSAI==:4000 ;4.3 => THIS TTY HAS SAIL CHAR SET ON OUTPUT.
%TOSA1==:2000 ;4.2 INIT %TSSAI OF NEW JOBS.
%TOOVR==:1000 ;4.1 => THIS TTY CAN OVERPRINT SUCCESSFULLY.
%TOMVU==:400 ;3.9 => THIS TTY CAN MOVE CURSOR UP (I.E. IT'S A DISPLAY).
%TOMOR==:200 ;3.8 => DO **MORE** PROCESSING ON THIS TTY
;(ACTUALLY JUST USED TO INIT %TSMOR FOR NEW JOBS).
%TOROL==:100 ;3.7 SIMILARLY, INIT %TSROL FOR NEW JOBS.
%TORAW==:40 ;3.6 => SUPPRESS CURSOR MOTION OPTIMIZATION.
%TOLWR==:20 ;3.5 => THIS TTY HAS LOWER CASE KEYBOARD.
%TOFCI==:10 ;3.4 => KEYBOARD CAN GENERATE FULL 12-BIT CHARACTER SET
%TOIML==:4 ;3.3 => SPACE, BS DON'T EQUAL ^PF, ^PB; ALSO ^PC SENDS ^L.
%TOLID==:2 ;3.2 => %TDILP, %TDDLP WORK (INSERT AND DELETE LINES)
%TOCID==:1 ;3.1 => %TDICP, %TDDCP WORK (INSERT AND DELETE CHARACTERS)
;RIGHT HALF:
%TP==:707252 ;BIT TYPEOUT MASK
%TPPLF==:100000
$TPPLF==:170300 ;3-BIT FIELD SAYING HOW TO PAD LF.
;0 - DON'T. 1 - MEMOWRECK, 2741. 2 - TERMINET.
%TPPCR==:10000
$TPPCR==:140300 ;3-BIT FIELD SAYING HOW TO PAD CR.
;7 - UNUSED. 6 - MEMOWRECK. 5 - 2741. 4 - EXECUPORT.
;0 - DON'T. 1 - NORMAL. 2 - DOUBLE.
;ON DATAPOINTS, = # CHARS PADDING NEEDED FOR ALL CURSOR MOTION.
;4 IS RIGHT FOR 2400 BAUD; 3, FOR 1200.
;ON TERMINETS, 0 => NO PADDING, ELSE a,2,3,4,5
;ARE PADDING FOR SPEEDS 10,15,30,60,120 CPS.
%TPPCW==:6 ;FOR MEMO WRECK.
%TPPTB==:1000
$TPPTB==:110300 ;3 BIT FIELD SAYING HOW MUCH PADDING NEEDED AFTER TAB.
;0 => TABS NOT ALLOWED; ELSE 1 +<# PADDING CHARS NEEDED>
;BUT ON A DISPLAY, TABS ARE NEVER PADDED AND THIS FIELD IS
;1 TO USE TABS, 2 TO USE ABSOLUTE CURSOR POSITIONING,
;3 TO USE BOTH, 0 TO USE NEITHER.
%TPMTA==:400 ;1.9 => treat bit 1.8 of input characters as the meta bit.
%TPPRN==:200 ;1.8 => INTERCHANGE () WITH [] ON INPUT
%TPTEL==:100 ;1.7 => HANDLE CR-LF ON INPUT AS CR, FOR TELNET PROTOCOL
%TPCBS==:40 ;1.6 => ENABLE SPECIAL HANDLING OF CONTROL BACK SLASH ON INPUT
;(THE "INTELLIGENT TERMINAL PROTOCOL").
%TP11T==:20 ;1.5 => PDP-11 TV TTY. REFLECTS %TY11T.
;NOT SETTABLE BY USER.
%TPORS==:10 ;1.4 => OUTPUT RESET ON THIS TTY SHOULD REALLY DO SOMETHING.
%TPRSC==:4 ;1.3 => THIS TTY SUPPORTS %TDRSU, %TDRSD
} ; IFE ITS\.ITS
subttl Macros
; Make use of some winning macros.
ifn its, .insrt syseng;$call macro
%%%asc==:1 ; use winning ASCNT
ifn .its, .insrt ksc;macros >
ife .its, .insrt macros
call=:<pushj p,> ; saves typing
return=:<popj p,>
;pjrst==:jrst ; CALL FOO ? RETURN
paoja==:aoja ; ADDI AC,1 ? CALL FOO ? RETURN
.xcref call,return,pjrst
define movx #ac,con
ife con򽸱, movei ac,con ? .stop
ife con&777777, movsi ac,(con) ? .stop
move ac,[con]
termin
IFNDEF KA,KA==1-20X
IFN KA,{
IF1 {
define dmove ac,m
ac ? m
termin
equals dmovem,dmove
equals fltr,dmove
} ; IF1
IF2 {
define dmove #ac,m
ifn m&20000000, .err DMOVE macro can't hack indirection
move ac,m
move ac+1,m+1
termin
define dmovem #ac,m
ifn m&20000000, .err DMOVEM macro can't hack indirection
movem ac,m
movem ac+1,m+1
termin
define fltr #ac,m
move ac,m
fsc ac,233
termin
} ; IF2
} ; IFN KA
IFN ITS,{
; Use this output macro until have UUO or routine.
define stro ch,&string&
move t1,[440700,,[ascii string]]
movx t2,.length string
$call siot,[#ch,t1,t2]
.lose %lsfil
termin
define say &string&
stro tyon,string
termin
define saycr *string*
stro tyon, string
termin
} ; IFN ITS
IFN TNX,{
define say &string&
hrroi a,[asciz string]
psout
termin
define saycr *string*
hrroi a,[asciz string
]
psout
termin
} ; IFN TNX
; SLEEP - Macro to sleep <argument> tenths of a second. Clobbers A.
IFN ITS,{
define sleep t
movx a,t*3.
.sleep a,
termin
} ; IFN ITS
IFN TNX,{
define sleep t
movx a,t*100.
disms
termin
} ; IFN TNX
IFN TNX, .lose=:haltf
IFN 0,{
.defmac ivar ; tell @ that IVAR defines its argument
.defmac mvar ; tell @ that MVAR defines its argument
.defmac tvar ; tell @ that TVAR defines its argument
.defmac svar ; tell @ that SVAR defines its argument
}
define inform a,b,c,d,e,f,g
printx a!b!c!d!e!f!g
termin
define section name
$sect
loc name
define $sect
name==.
termin
termin
; Start off with SECTION MAINVAR.
define $sect
mainvar==.
termin
init==26000 ; leave 11K for variables and screen image
initvar==34000 ; leave 2K for initialization section
main==36000 ; leave 1K for initialization variable section
fipg==:init/pg$siz
fivpg==:initvar/pg$siz
fmpg==:main/pg$siz
IFN 0,{
define mvar v1,v2,v3,v4
irp v,,[v1,v2,v3,v4]
irps s,c,[v]
s=:mainvar
ifse [c][] mainvar==mainvar+1 ? .istop
irpnc <.length "s">+1,<.length "v">-<.length "s">-2,1,l,,[v]
mainvar==mainvar+<l>
termin
.istop
termin
termin
termin
}
.ELSE {
equals mvar,.scalar ; .SCALAR is presumably faster, so use it in
; place of MVAR since it occurs most often
}
define ivar v1,v2,v3,v4
irp v,,[v1,v2,v3,v4]
irps s,c,[v]
s=:initvar
ifse [c][] initvar==initvar+1 ? .istop
irpnc <.length "s">+1,<.length "v">-<.length "s">-2,1,l,,[v]
initvar==initvar+<l>
termin
.istop
termin
termin
termin
equals tvar,mvar
equals svar,mvar
subttl Part I - Initialization
subttl Start up
patch: pat: block 40 ; patch area
debug: 0 ; set positive for any runtime debug switching
SECTION INIT
IFN ITS,{
; Use PURIFYG to purify CRTSTY before dumping.
purify: move a,[<sipg-fipg>,,sipg] ; flush screen image pages
$call corblk,[#0,#%jself,a] ; ...
.lose %lssys
move a,[-<lipg-fipg+1>,,fipg] ; purify INIT pages
$call corblk,[#%cbndr,#%jself,a]
.lose %lssys
move a,[-<lmpg-fmpg+1>,,fmpg] ; purify MAIN pages
$call corblk,[#%cbndr,#%jself,a]
.lose %lssys
IFN STY,{
.value [asciz ": Purified, now dump...
:PDUMP DSK:SYSBIN;CRTSTY BIN"]
}
IFN NET,{
.value [asciz ": Purified, now dump...
:PDUMP DSK:SYSBIN;SCRTSTY BIN"]
}
} ; IFN ITS
IFN TNX,{
purtab: -sipg,,ss%cpy\ss%rd\ss%exe\0 ; MAINVAR pages
-<lipg-fipg+1>,,ss%rd\ss%exe\fipg ; INIT pages
-<livpg-fivpg+1>,,ss%cpy\ss%rd\ss%exe\fivpg ; INITVAR pages
-<lmpg-fmpg+1>,,ss%rd\ss%exe\fmpg ; MAIN pages
-<512.-<lmpg+1>>,,ss%rd\<lmpg+1> ; symbol table pages
0
purify: move p,[-lpdl,,pdl-1] ; set PDL pointer so can use error UUO
movei a,.fhslf ; SEVEC arg: A = process handle
move b,[1,,crtsty] ; SEVEC arg: B = length,,address
sevec ; set entry vector
move a,[gj%sht+.fvers] ; GTJFN arg: A = bits,,default version
IFE STY,{
ifn 20x, hrroi b,[asciz "CRTSTY.EXE"]
ifn 10x, hrroi b,[asciz "CRTSTY.SAV"]
}
IFN STY,{
ifn 20x, hrroi b,[asciz "PCRTSTY.EXE"]
ifn 10x, hrroi b,[asciz "PCRTSTY.SAV"]
}
; GTJFN arg: B = filename
gtjfn ; get JFN to CRTSTY save file
jerr1 [asciz "Unable to assign JFN - "]
hrli a,.fhslf ; SSAVE arg: A = fork handle,,JFN
movei b,purtab ; SSAVE arg: B = table address
movei c,0 ; SSAVE arg: C = flag bits
ssave ; dump ourself
haltf
} ; IFN TNX
lpdl==100 ; Length of PDL
mvar pdl(lpdl) ; PDL
; CRTSTY starts here.
crtsty: move p,[-lpdl,,pdl-1] ; initialize PDL pointer
movei f,0 ; initialize flags
call osinit ; operating system dependent initialization
call commnd ; parse command line to get terminal type,
; TTY no., etc.
jrst logout ; error in command line
call ttyini ; open TTY, initialize some options
call commnd ; parse command line again, this time
; for rest of options
jrst logout ; error in command line
call ttyoin ; TTY output initialization
skipe jvtsw ; VT specified?
jrst [ call vtsu ; see if can identify terminal type
jrst logout
jrst .+1 ]
skipn trmadr ; Now identified a terminal?
jrst [ say "No terminal type specified! "
call badtrm
jrst logout ]
call setup3 ; random initialization
call scrini ; initialize screen image
call styini ; open STY
IFN NET,{
call netini
}
call smoini ; initialize simulator output co-routine
jrst setup7
subttl Operating system initialization
IFN ITS,{
osinit: move a,[-lipdl,,ipdl-1] ; initialize interrupt PDL
movem a,intpdp ; ...
setzm iocvec ; no IOC error handler yet
move a,[-24.,,[
.roption ? tlo %opint+%opopc ; turn on new style ints
.roption ? movem option
.rmask ? movei %piioc ; enable interrupts
.rmsk2 ? movei 0 ; ...
.rdf1 ? movei 0 ; and set defer words
.rdf2 ? movei 0 ; ...
.rcnsl ? movem cnsl ; get console TTY no.
.runame ? movem uname
.rjname ? movem jname
.ruind ? movem uind
.rxuname ? movem xuname
.rxjname ? movem xjname
]]
$call usrvar,[#%jself,a]
.lose %lssys
.i ttynum=cnsl ; default TTY supported to our console
$call open,[#tyon,[sixbit/tty/]][][#.uao]
.lose %lsfil ; Normal unit output to TTY
hlrz a,uname ; get LH of uname
cain a,-1 ; not logged in?
jrst [ saycr "You must log in to use CRTSTY"
jrst logout]
move e,xjname ; JRTR6F arg: sixbit name
call jrtr6f ; is XJNAME some terminal name?
setz a, ; No, so zap...
hrrzm a,trmadr ; yes, set terminal to use.
move a,option ; get OPTION variable
tlnn a,%opcmd ; command for us?
jrst [ skipe trmadr ; No, barf unless terminal selected by xjname.
jrst .+1
saycr "Usage is :CRTSTY <terminal name> <options>. Do :CRTSTY ? for help."
jrst logout]
move a,[cmd,,cmd+1] ; clear command line buffer
setzm cmd ; ...
blt a,cmd+<lcmd+4>/5-2 ; ...
movsi a,(ascii "
") ; put CR at end of command line buffer
movem a,cmd+<lcmd+4>/5-1 ; ...
.break 12,[5,,cmd] ; get command line from superior
call wrtlog ; Write log file entry with cmd line.
ifn histohack, call histo
move b,[squoze 0,%TDMAX] ; Find highest software code
.eval b,
.lose %lssys
caile b,%tdmax ; see if system has same ideas we do.
jrst [ saycr "Warning: Some display codes may not work.
Send mail to BUG-CRTSTY@MC about this!"
jrst .+1]
move a,[squoze 0,LUBLK] ; find length of a user-var block
.eval a,
.lose %lssys
movem a,lublk
imul a,uind ; find position from start of user-var storage
movem a,myuind ; save in case later need
movei a,syspg
movem a,syspno
move a,[squoze 0,TIME]
movei b,0
call itsmap
movem a,time
move a,[squoze 0,APRC]
move b,myuind
call itsmap
movem a,aprc
move a,[squoze 0,SUPPRO]
move b,myuind
call itsmap
movem a,suppro
return
} ; IFN ITS
IFN TNX,{
osinit: reset ; initialize system's data for this fork
; (this does an automatic CIS so that's not
; needed below)
movei a,.fhslf ; RPCAP arg: fork handle
rpcap ; read our capabilities
; results: B = possible capabilities,
; C = enabled capabilities
tlo c,(sc%ctc\sc%gtb) ; turn on control-C intercept and
epcap ; GETAB capabilities
gjinf ; get job specific information
movem a,ldir ; directory no. logged in under
movem d,cnsl ; GJINF val: terminal no. associated with
; this job (or -1 if detached)
setom ttynum ; default to using TTY: instead of TTYnnn:
move t1,[chntab,,chntab+1] ; zero channel table
setzm chntab ; ...
blt t1,chntab+35. ; ...
movei a,.fhslf ; SIR arg: process handle
move b,[levtab,,chntab] ; SIR arg: level table,,channel table
sir ; set channel and level table addresses
eir ; enable interrupt system
setzm siiset ; no superimage input yet
; Get command line.
IFN 20X,{
movei a,0 ; RSCAN arg: 0 to read last string
rscan ; put command line in input buffer
jerr1 [asciz "Error reading command line - "]
movn c,a
; skip over 1st word of command line
os1: aojge c,os9 ; nothing more to read?
pbin ; get next character
cain a,^J ; LF?
jrst os9 ; yes, no real command line
caie a,40 ; space?
jrst os1 ; no, keep going
movei a,.priin ; SIN arg: A = source designator
move b,[440700,,cmd] ; SIN arg: B = B.P.
; SIN arg: C = -count
sin ; read command line into command buffer
movei a,^M ; replace LF at end of string with CR
dpb a,b ; ...
} ; IFN 20X
IFN 10X,{
movei a,.priin ; BKJFN arg: A = JFN
bkjfn ; backup one character in input stream
jrst os0 ; can't, oh well
pbin ; get last character typed
cain a,37 ; CR?
jrst os9 ; yes, no command line
os0: move b,[10700,,cmd-1] ; byte pointer to command line buffer
os1: pbin ; get next character
cain a,37 ; CR?
jrst os2 ; yes, we're done
cain a,177 ; RUBOUT?
jrst [ camn b,[10700,,cmd-1] ; yes, nothing to rubout?
jrst [ movei a,^G ; nothing, PBOUT arg: character
pbout ; feep at user
jrst os1 ] ; keep reading
ldb a,b ; get character rubbed out
pbout ; echo it back
add b,[70000,,0] ; decrement byte pointer
jumpge b,os1 ; ...
sub b,[430000,,1] ; ...
jrst os1 ] ; keep reading
idpb a,b ; put character into command line buffer
jrst os1 ; keep reading
os2: movei a,^M ; deposit an actual CR, instead of 37
idpb a,b ; ...
} ; IFN 10X
IFN STY,{
move a,[sixbit/ptypar/] ; SYSGT arg: SIXBIT table name
sysgt ; get PTY information
; results: A = first word of table,
; B = table no.
jumpe b,[ ; no PTYPAR table?
saycr "System lacks PTYs"
jrst logout
]
hlrzm a,syspty ; no. of PTYs in system
hrrzm a,firpty ; TTY no. of first PTY
} ; IFN STY
IFN ARPA,{
setzm lskt ; local relative socket no.
}
return
os9: saycr "Usage is CRTSTY <terminal name> <options>. Do CRTSTY ? for help."
jrst logout
} ; IFN TNX
subttl Output entry to CRTSTY log file
IFN ITS,{
wrtlog: movei a,logint ; where to go if we get an IOC error
movem a,iocvec
sretry: syscal open,[ %clbit,,100000\.uao ? %climm,,dsko
[sixbit /DSK/]
[sixbit /CRTSTY/] ? [sixbit /LOG/] ? [sixbit /CRASH/]
%clerr,,a] ; get the error code
jrst [ cain a,%enafl ; file locked?
jrst [ movei a,5 ; sleep a bit
.sleep a,
jrst sretry ] ; and try again
caie a,%ensfl ; file not found?
$call lose,[#%lsfil,#sretry] ; unknown error, hassle
syscal open,[ %clbit,,.uao ? %climm,,dsko ? [sixbit /DSK/]
[sixbit /CRTSTY/] ? [sixbit /LOG/]
[sixbit /CRASH/]]
.lose %lsfil
jrst .+1]
$call fillen,[#dsko][a] ; find end of file
.lose %lsfil
$call access,[#dsko,a] ; and start there
.lose %lsfil
.rdatim a, ; get date and time
move e,b ; hack the date first
rot e,12. ; make MMDDYY
movei b,"/ ; separate by /'s
call timprt ; print the time
.iot dsko,[40] ; separate by a space
move e,a ; hack the time now
movei b,": ; separate by :'s
call timprt ; print it
.iot dsko,[40] ; space again
move a,uind ; get job no.
caige a,100
.iot dsko,[40]
caige a,10
.iot dsko,[40]
call numout
.iot dsko,[40]
move e,[.fnam1]
call sixout ; output FN1 if strange.
.iot dsko,[40]
move e,[.fnam2]
call sixout
.iot dsko,[40]
move e,xuname
call sixout ; print it
.iot dsko,[40]
$call stlget,[#tyon][a,e] ; get the host
caia
jumpn e,log1
move a,cnsl ; get terminal no.
lshc a,-3 ; convert to sixbit
lsh a,3 ; ...
lshc a,3 ; ...
movsi e,'T00(a) ; convert to device name
log1: call sixout ; print it
.iot dsko,[40]
.iot dsko,[40]
move a,[440700,,cmd] ; BP to the command buffer
logcmd: ildb b,a ; get a char
caie b,^M ; end of line?
cain b,^C ; Another form of end of line
jrst logcls ; yes, close up the line
caie b,^_ ; still another form of end of the line
cain b,0 ; yet another
jrst logcls ; so close up the line
.iot dsko,b ; no, output it
jrst logcmd ; and do another
logcls: .iot dsko,[^M] ; new line
.iot dsko,[^J]
logint: .close dsko,
setzm iocvec ; remove IOC error handler
return
numout: push p,b
idivi a,10
caile a,0
call numout
addi b,"0
.iot dsko,b
pop p,b
return
sixout: movei b,6
call prtdig ; print a character
sojg b,.-1
return
; SIXDO - output sixbit in E cleverly to disk; always outputs
; at least one char (a blank if word 0).
sixdo: movei d,0
lshc d,6
addi d,40
.iot dsko,d
jumpn e,sixdo
return
timprt: call prt2dg ; print two digits
.iot dsko,b ; and the delimiter
call prt2dg ; print two more digits
.iot dsko,b ; and the delimiter
pjrst prt2dg ; and the final portion
prt2dg: call prtdig
prtdig: movei d,0
lshc d,6
addi d,40
.iot dsko,d
return
} ; IFN ITS
IFN ITS&HISTOHACK,{
histch==17
histo: $call open,[#histch,[sixbit/DSK/],[sixbit/.CHAR/],[sixbit/.COUNT/]][][#.bio]
.lose %lsfil
movsi t1,-256.
.iot histch,t1
.close histch,
$call open,[#histch,[sixbit/DSK/],[sixbit/.CHAR/],[sixbit/.COUNT/]][][#.uio+100000]
.lose %lsfil
$call corblk,[#%cbndw+%cbndr,#%jself,#histpg,#histch,#0]
.lose %lssys
move t1,[counts+0,,counts+1]
setzm counts+0
blt t1,counts+256.-1
return
}
subttl Command line processing
lcmd==:120. ; length of command line buffer
ivar cmd(<lcmd+4>/5) ; command line buffer
ltoken==:20. ; option buffer length
ivar token(<ltoken+4>/5) ; option buffer
commnd: move a,[440700,,cmd] ; initialize pointer to the command buffer
movem a,cmdp
hllz f,f ; Clear terminal flags.
cloop: skipa a,[1] ; Set yes/no state to YES.
clpno: movns a ; come here to reverse state.
call jclf ; pick up next token
jrst popj1 ; EOF, return2 from COMMND for winnage
move d,token ; get 1st word of token
camn d,[asciz /NO/] ; requesting opposite state?
jrst clpno ; Yes, negate state & get next field.
movsi b,-njopts
cl1: move c,jcoptb(b) ; Find match - get addr of name
came d,(c) ; Match?
jrst cl7 ; nope, try another
hlrz c,c
call (c) ; Execute matching rtn.
return ; return1 from COMMND to indicate error
jrst cloop ; Continue loop
cl7: aobjn b,cl1 ; Drop thru if fail to match...
move e,[440700,,token] ; didn't match a JCL opt, try as terminal.
call jrtrmf ; Check out.
jrst bad
skipe b,trmadr ; won, but was something already spec'd?
cain b,(c)
caia ; No, or specifying same thing, OK.
jrst [saycr "Terminal already specified!"
return]
hrrzm c,trmadr ; first spec of terminal.
jrst cloop ; Continue if won...
IFN ITS,{
bad: .iot tyon,[""]
move a,tokp
move b,tokl
$call siot,[#tyon,a,b]
.lose %lsfil
} ; IFN ITS
IFN TNX,{
bad: movei a,""
pbout
move a,tokp
psout
} ; IFN TNX
saycr |" is not a valid terminal name or option.
|
help: skiple trmadr ; if he specified a good terminal,
jrst lstopt ; don't list them
say "Usage is :CRTSTY <terminal name> <options>
Terminals are:"
call jtrmls
say "
"
lstopt: say "Options are:
; Terminal description:
HEIGHT <no. of lines on the screen>,
WIDTH <no. of columns per line>,
SPEED <bps>, ISPEED <bps>, OSPEED <bps>,
NO ABS, NO TABS, NO BELL, NO CLEOL, NO CLEOS, NO LID, NO CID,
SCRLCOUNT <no. of lines>
; ITS options (same meaning as with TCTYP):
GLASS, SAIL, SCROLL
; CRTSTY options:
[NO] INVERSE, VISBEL, WHOLINE, ALARM <idle mins>,
[NO] SMEOL, STEOS,
NO LOGIN, LOGIN <uname>,
NO WARN, SOFTOK, SLAVE, NO SII, NO ATTACH, DEBUG,
BUFFER <size>,
TTY <terminal no. to use>,
SIMULATE <terminal>"
IFN NET,{
say ",
HOST <name>"
}
say "
"
return
badtrm: say "Terminal id may be one of:"
pjrst jtrmls
subttl JCL option routines & dispatch table
comment |
JCL options are defined very easily; for example,
to define an option FOO, we just put in
jcopt /FOO/,<label> ; comment
where <label> is the address of the routine that will handle the
option, when invoked. Typically it can just set a flag, but it
may ask for more arguments by calling JNUMB or 7PARM or 6PARM.
Routines are free to use all of acs A-E, but note that in many cases
E is used to return a value. (someday perhaps this will become A).
Note that upon entry to the routine, ac A is set to a value
signifying either YES or NO. It will be NO if the previous "option"
was "NO", YES otherwise; all routines which set tri-state (yes/no/default)
switches should simply store this value.
+1 = YES
0 = default
-1 = NO
|
blkini jcblk ; initialize/define block for JCL option table.
define jcopt &name&,rtn ; and define macro to add entries.
blkadd jcblk,[rtn,,[asciz name]
]
termin
jcopt /?/,jrhelp
jrhelp==help
jcopt /TERM/,jrterm ; Specify terminal type.
jrterm: call 7parm ; Get asciz param in next field.
return
move b,e ; Save BP, and
call 6parmt ; get 6bit version also.
camn e,[sixbit /VT/] ; Generic-VT command?
pjrst jrvt ; Yes, go identify VT
move e,b ; Nope, restore BP to asciz name
call jrtrmf ; and identify terminal type.
jrst [ say "Unknown terminal type! "
pjrst badtrm ]
skipe trmadr
camn c,trmadr
caia
jrst [saycr "Terminal already specified!"
return ]
hrrzm c,trmadr ; Won, store term idx.
pjrst popj1
jcopt /VT/,jrvt ; Identify VT type and use as term ID.
ivar jvtsw ; nonzero if loser wants use to guess which VT
jrvt: setom jvtsw ; set switch to do the hack at setup time
pjrst popj1
jcopt /LINEL/,jrwidt ; Specify line length (width of screen)
jcopt /WIDTH/,jrwidt ; Ditto
ivar jwidth ; specified line length
jrwidt: call jnumb ; get numeric argument into e
return
caile e,10. ; make some trivial checks
caile e,maxhor
jrst [saycr "Ridiculous screen width"
return]
movem e,jwidth ; and save it
pjrst popj1
jcopt /PAGEL/,jrpagl ; Specify page length (height of screen)
jcopt /HEIGHT/,jrpagl ; ditto
ivar jheight ; specified height
jrpagl: call jnumb ; Get nmber in next field
return
caile e,5 ; Make some checks
caile e,maxver
jrst [saycr "Ridiculous height"
return]
movem e,jheight ; Well, it passes! Save it.
pjrst popj1
jcopt /SPEED/,jrspd ; Specify actual speed of terminal
jrspd: call jnumb
return
movem e,ospeed
movem e,ispeed
pjrst popj1
jcopt /OSPEED/,jrospd
jrospd: call jnumb
return
movem e,ospeed
pjrst popj1
jcopt /ISPEED/,jrispd
jrispd: call jnumb
return
movem e,ispeed
pjrst popj1
jcopt /AUTONL/,jranl
ivar janl
jranl: movem a,janl
pjrst popj1
jcopt /ABS/,jrabs ; Suppress use of absolute move.
ivar jabs
jrabs: movem a,jabs ; set switch to prevent absolute cursor
; positioning
pjrst popj1
jcopt /TABS/,jrtab ; Say term has no tabs.
mvar jtab ; positive: use tabs, negative: don't,
; zero: default
jrtab: movem a,jtab ; set switch to prevent tabbage
pjrst popj1
jcopt /BELL/,jrbell ; Don't use audible bell.
mvar jbell ; positive for no audible bell
jrbell: movem a,jbell
pjrst popj1
jcopt /CLEOL/,jrclel
ivar jcleol
jrclel: movem a,jcleol
pjrst popj1
jcopt /CLEOS/,jrcles
ivar jcleos
jrcles: movem a,jcleos
pjrst popj1
jcopt /LID/,jrlid
ivar jlid
jrlid: movem a,jlid
pjrst popj1
jcopt /CID/,jrcid
ivar jcid
jrcid: movem a,jcid
pjrst popj1
jcopt /SCRLCOUNT/,jrscrc
ivar jscrcnt
jrscrc: call jnumb
return
movem e,jscrcnt
pjrst popj1
; ITS options:
jcopt /SAIL/,jrsail
ivar jsail ; if positive do :TCTYP SAIL
jrsail: movem a,jsail
pjrst popj1
jcopt /SCROLL/,jrscr
ivar jscrol ; if positive do :TCTYP SCROLL
jrscr: movem a,jscrol
pjrst popj1
jcopt /GLASS/,jglass ; Claim it's a "glass tty" rather than a full display
ivar glassw ; positive to be glass tty, not display
jglass: movem a,glassw
pjrst popj1
; CRTSTY options:
jcopt /INVERSE/,jrinv ; Use inverse video hacking.
mvar jinvrs ; use inverse video on display
jrinv: movem a,jinvrs
pjrst popj1
jcopt /TRANSLUCENT/,jrtran
ivar jtrans ; positive for C100 translucent option
jrtran: movem a,jtrans
pjrst popj1
jcopt /VISBEL/,jrvbel ; Use a visible bell.
mvar visbel ; positive for visible bell
jrvbel: movem a,visbel
pjrst popj1
IFN STY,{
jcopt /WHOLINE/,jrwho
mvar wholin ; positive: hack a wholine
jrwho: movem a,wholin
pjrst popj1
} ; IFN STY
IFN TINT&SINT,{
jcopt /ALARM/,jralrm ; Set # idle mins after which to feep when output resumed.
jralrm: call jnumb ; Get number
return
jumpl e,[saycr "Impossible alarm time"
return ]
imuli e,ticspm ; clock tics per minute.
skipn e
movei e,ticspm ; Default to 1 minute.
movem e,feepmx ; store specified # ticks.
pjrst popj1
} ; IFN TINT&SINT
jcopt /SMEOL/,jrsmel ; Use "Smart CLEOL".
ivar jsmeol
jrsmel: movem a,jsmeol
pjrst popj1
jcopt /STEOS/,jrstes ; Use "Stupid CLEOS".
ivar jsteos
jrstes: movem a,jsteos
pjrst popj1
jcopt /TPCBS/,jrtmp
mvar tpcbs ; if negative don't use %TPCBS
; only meaningful when simulating software
; TTYs
jrtmp: movem a,tpcbs
pjrst popj1
IFN ITS&STY,{
jcopt /LOGIN/,jrlgin ; Specify login name to use.
ivar juname ; uname to LOGIN as
jrlgin: movem a,juname
jumpl a,popj1 ; if NO LOGIN then don't read uname
call 6parm ; Get 6bit parm into E
return
movem e,juname ; save name to use.
pjrst popj1
} ; IFN ITS&STY
IFN TNX&STY,{
jcopt /LOGIN/,jrlgin
ivar jlogin
jrlgin: movem a,jlogin
pjrst popj1
} ; IFN TNX&STY
jcopt /WARN/,jrwarn ; Don't send warning message
ivar jwarn ; if nonzero don't show warning message
jrwarn: movem a,jwarn
pjrst popj1
IFN ITS,{
jcopt /SOFTOK/,jrsoft ; proceed even if TTY is software type.
ivar jsftok ; if nonzero then OK to go ahead even if TTY is software type.
jrsoft: movem a,jsftok
pjrst popj1
} ; IFN ITS
jcopt /SII/,jrsii
ivar jsii ; superimage input
jrsii: movem a,jsii
pjrst popj1
IFN ITS,{
jcopt /ATTACH/,jrattc
ivar jattach
jrattc: movem a,jattach
pjrst popj1
} ; IFN ITS
jcopt /FLUSH/,jrflsh
ivar jflush
jrflsh: movem a,jflush
pjrst popj1
jcopt /DEBUG/,jdebug
jdebug: movem a,debug
pjrst popj1
jcopt /BUFFER/,jrbuff ; Specify buffer size to use
jrbuff: call jnumb ; Get number in next field
return
caig e,1 ; See if reasonable.
jrst [ saycr "Unreasonable buffer size"
return]
movem e,buffmx ; remember specified buff size.
pjrst popj1
jcopt /TTY/,jrtty ; Specify TTY no. to support
ivar ttynum ; TTY no. of terminal to support
jrtty: call jnumb
return
movem e,ttynum
pjrst popj1
jcopt /SIMULATE/,jrsim ; Simulate a terminal.
jrsim: call 7parm ; Get asciz terminal name
return
call jrtrmf ; Find index
return
skipn .trsmi(c) ; See if has simulate capability.
jrst [ saycr "No simulate code exists for that terminal"
return]
movem c,simadr ; Save addr of simulator definition
pjrst popj1
IFN NET,{
jcopt /HOST/,jrhost
mvar hstnam(8.)
jrhost: call jclf
jrst [ saycr "Host name missing."
return ]
push p,[440700,,hstnam]
skipg tokl
jrst jrhst2
jrhst1: ildb t1,tokp
idpb t1,(p)
sosle tokl
jrst jrhst1
jrhst2: movei t1,0
idpb t1,(p)
pop p,t1
pjrst popj1
} ; IFN NET
IFN ITS,{
jcopt /@ITS/,jrits
ivar jatits
jrits: movem a,jatits
pjrst popj1
IFN STY,{
jcopt /SLAVE/,jrslav ; open terminal as slave, don't ^Z or login
mvar jslave ; want to permit use as slave console?
jrslav: movem a,jslave
pjrst popj1
} ; IFN STY
} ; IFN ITS
; Here expand the string block for JCL options table...
jcoptb: jcblk
njopts==.-jcoptb
subttl Terminal name parsing & listing
; JRTRMF - Find terminal name.
; E/ BP to uppercase ASCIZ terminal name string.
; Returns .+1 if failed, else .+2 with
; C/ index to terminal definition - (address of table)
jrtrmf: pushae p,[a,b,d,e]
movsi c,-nterms ; AOBJN thru term table
jrtrm2: move d,trmtab(c) ; Get pointer to a term def block
move d,.tpnam(d) ; get addr of asciz string for names
hrli d,440700 ; Make BP to it
jrtrm4: ildb a,d ; Get char from term def string
ildb b,e ; and from arg string
cain a,(b)
jumpn a,jrtrm4 ; if matched, continue.
jumpe a,[jumpe b,jrtrm8 ; If both strings counted out, won...
jrst jrtrm6] ; else failed; def string gone.
jumpe b,[cain a,", ; If arg string out, and def string hit ","
jrst jrtrm8 ; then also won.
jrst .+1]
; No luck, move up to next name in term def string.
move e,(p) ; Restore BP to arg string.
jrtrm5: cain a,",
jrst jrtrm4 ; Hit "," so try next name now.
ildb a,d
jumpn a,jrtrm5
jrtrm6: aobjn c,jrtrm2 ; try another terminal.
jrst jrtrm9 ; failed.
jrtrm8: move c,trmtab(c) ; Win, return address of term def block.
aos -4(p) ; Win return.
jrtrm9: popae p,[e,d,b,a]
return
; JRTR6F - Search for SIXBIT terminal name in E. Skip with ptr in A if win.
; Clobbers A,B,C.
jrtr6f: movsi c,-nterms ; AOBJN thru term table
jrtr62: move a,trmtab(c) ; get pointer to a terminal def block
hlrz b,.tpnam(a) ; get pointer to sixbit name.
camn e,(b) ; this one matches?
aosa (p) ; won, skip on return.
aobjn c,jrtr62 ; drop thru if failed.
return
jtrmls: push p,a ; termtab pointer
push p,b ; byte pointer
push p,c ; character
push p,d ; hpos
movei d,0
movsi c,-nterms
jtrml3: move b,trmtab(c) ; get addr of term def block
move b,.tpnam(b) ; get addr of asciz string of term names
hrli b,440700
jtrml5: jumpe d,jtrml6
say ", "
addi d,2
caig d,64.
jrst jtrml4
jtrml6: say "
"
movei d,0
jtrml4: ildb a,b
jumpe a,jtrml7
pbout
addi d,1 ; inc hpos
jrst jtrml4
jtrml7: aobjn c,jtrml3
jumpe d,jtrml8
say "
"
jtrml8: popae p,[d,c,b,a] ; restore regs
return
; SIXO types out the SIXBIT value in A.
sixo: push p,b
move b,a
sixo2: movei a,0
lshc a,6
addi a,40
pbout
jumpn b,sixo2
pop p,b
return
subttl Command line parsing subroutines
; JCLF - reads JCL field into TOKEN and skips;
; doesn't skip if nothing there.
; This routine is a horrible mess and should be rewritten. -EAK
ivar cmdp ; Holds BP into JCL
ivar tokl
ivar tokp
jclf: pushae p,[a,b,d]
move a,[token,,token+1] ; clear token buffer
setzm token ; ...
blt a,token+<ltoken+4>/5-1 ; ...
move a,cmdp
move c,[440700,,token]
movei d,ltoken-1 ; max length count for option
jcl1: move e,a
ildb b,a ; pick up JCL character
jumpe b,[
move a,e
jrst jclp ]
caie b,^C ; ^C or CR?
cain b,^M
jrst [ move a,e
jrst jclp ]
cain b,40 ; space?
jrst jcl1 ; yeah, continue to scan for option
jcl2: jumpe d,jcl3 ; room in option word
cail b,"a ; lower case alpha?
trz b,040 ; make into upper case
idpb b,c ; deposit character of option
subi d,1
jcl3: move e,a ; save command line pointer
ildb b,a ; get next command line character
caie b,^C ; control C or
cain b,^M ; or control M of command line?
jrst [ move a,e ; restore pointer to ^M
jrst jclx ] ; and return option word
caie b,40
cain b,",
jrst jclx
jrst jcl2 ; process nonspace
; otherwise return result found
jclx: movei b,ltoken-1 ; max option length
sub b,d ; return length in b
movem b,tokl ; and in TOKL
move c,[440700,,token] ; and option pointer in c
movem c,tokp ; and in TOKP
aos -3(p) ; Skip on win return.
jclp: movem a,cmdp ; restore updated BP
popae p,[d,b,a]
return
; get parameter into sixbit in e
7parm: call jclf ; get next field
jrst [ saycr "Argument missing"
return ]
move e,tokp
pjrst popj1
6parm: call 7parm
return
aos (p) ; Have result, so always skip after convert.
6parmt: pushae p,[a,b,c,d]
move c,[440700,,token] ; enter here with option in TOKEN
move d,[440600,,e]
movei e,0
6parm2: ildb a,c ; Get char from arg
jumpe a,6parm7 ; end if hit null
trz a,40
trze a,100 ; cvt to 6bit
tro a,40
idpb a,d ; deposit in e
tlne d,770000 ; done when ptr hits end.
jrst 6parm2
6parm7: popae p,[d,c,b,a]
return ; return with result in e
; JNUMB - Command line number parser, reads next field as number.
; Skips if wins, with # in E.
jnumb: call jclf ; get the next jcl field
jrst [ saycr "Numeric argument missing"
return]
pushae p,[a,b,c,d]
move c,[440700,,token] ; pointer to the options string
setzb a,e ; clear oct/dec accumulators
jnumb3: ildb b,c ; pick up a character
jumpe b,jnumb7
cail b,"0 ; is it less than zero?
caile b,"9 ; or not less than nine?
jrst jnumb2 ; then must be a terminator
imuli e,10. ; multiply previous by 10
addi e,-"0(b) ; and add in the new digit
lsh a,3 ; also build up an octal value
addi a,-"0(b) ; and put it in here
jrst jnumb3 ; and get next digit
jnumb5: say "Number in bad format"
jrst jnumb8
jnumb2: cain b,40 ; space?
jrst jnumb7 ; yes, then must be decimal
cain b,".
jrst jnumb7 ; no. ending in period is also decimal
cain b,"'
move e,a ; no. ending in ' is octal
jnumb7: aos -4(p)
jnumb8: popae p,[d,c,b,a]
return ; and return it in e
subttl Set up TTY
IFN ITS,{
; Open TTY with terminal to support. Find out various things about it.
ttyini: move a,ttynum ; TTY no. to support
lshc a,-3 ; convert to device name
lsh a,3
lshc a,3
movsi a,'T00(a)
$call open,[#tyic,a][][#.uai+%tiful+%tiint+%tinwt]
jrst [ say "Specified TTY not available."
jrst logout ]
$call open,[#tyoc,a][][#.uao+%tjsio]
.lose %lsfil
move a,[squoze 0,TORM] ; Now want to map TORM+(our TTY)
move b,ttynum ; add in # of TTY as proper index
call itsmap
movem a,torm ; Save address in our map
move a,[-4,,[
sixbit /msk2/ ? tro 1_tyic ; enable interrupts
sixbit /df2/ ? tro 1_tyic ; but defer them
]]
$call usrvar,[#%jself,a]
.lose %lssys
$call ttyset,[#tyic,[030303,,030303],[030303,,030303]]
.lose %lsfil ; Set to defaults (interrupt, activate on all)
move a,[-6,,[
sixbit /tctyp/ ? movem tctyp
sixbit /ispeed/ ? movem ispeed
sixbit /ospeed/ ? movem ospeed
]]
$call ttyvar,[#tyic,a] ; get TCTYP, OSPEED, and ISPEED
.lose %lsfil
skipg jatits ; @ITS specified?
return ; no, that's it
move a,[-10.,,[
sixbit /tctyp/ ? movem b
sixbit /ttyopt/ ? movem c
sixbit /width/ ? movem jwidth
sixbit /height/ ? movem jheight
sixbit /ttyrol/ ? movem jscrcnt
]]
$call ttyvar,[#tyoc,a]
.lose %lsfil
aos jwidth ; correct for ITS lossage
skipn a,trmadr
skipe a,tctypt(b)
movem a,trmadr
tlne c,%tofci
tro f,%ffci
tlne c,%tosai
tro f,%fsail
tdnn c,[%tolid,,%tprsc]
setom jlid
tlnn c,%tocid
setom jcid
return
; Table of CRTSTY terminal types, indexed by TCTYP.
tctypt: offset 0-.
%tnprt:: 0 ; random printing terminal
%tndp:: dp ; Datapoint
%tnodp:: dpluz ; Datapoint loser
%tniml:: 0 ; Imlac (no longer actually used)
%tntek:: 0 ; Tektronix storage scope
%tntv:: soft ; TV
%tnmem:: 0 ; Memowreck
%tnsfw:: soft ; Software TTY
%tntrm:: 0 ; Terminet
%tnesc:: vt52 ; VT52
%tndtm:: dm25 ; Datamedia 2500
%tnray:: t1061 ; Teleray 1061
%tnhds:: c100 ; Concept 100
%tnh19:: h19 ; Heath 19
%tnaaa:: aaa ; Ann Arbor Ambassador
%tnmax::
offset 0
} ; IFN ITS
IFN TNX,{
ivar ttynam(2) ; asciz name of terminal to support
ttyini: move b,ttynum ; DEVST arg: device designator:
camn b,[-1]
jrst [ move a,[asciz "TTY:"]
movem a,ttynam
jrst ttyin1 ]
hrli b,.dvdes+.dvtty ; device code,,unit no.
hrroi a,ttynam ; DEVST arg: destination descriptor
devst ; convert terminal no. to terminal name
jerr1 ttyerr
movei b,": ; add a colon for the GTJFN
idpb b,a ; ...
movei b,0 ; terminate string with a null
idpb b,a ; ...
ttyin1: movsi a,(gj%sht) ; GTJFN arg: bits
hrroi b,ttynam ; GTJFN arg: source designator (filename)
gtjfn ; get JFN for specified TTY
jerr1 ttyerr
movem a,ttyjfn ; save TTY JFN
move b,[8._30.+of%rd+of%wr] ; OPENF arg: byte size and control bits
openf ; open terminal in binary mode
jerr1 ttyerr
.i icmask=177
IFN 20X,{
; MTOPR arg: A = JFN
movei b,.morsp ; MTOPR arg: B = opcode (read speed)
mtopr ; read terminal speed
; result: input speed,,output speed
jumple c,ttyin2 ; ignore a 0 or -1 result
hrrzm c,ospeed
hlrzm c,ispeed
ttyin2:
} ; IFN 20X
IFN TINT,{
move a,[ttylev,,ttyivi] ; set up CHNTAB entry for terminal interrupts
movem a,chntab+ttychn ; ...
move a,[.ticti,,ttychn] ; ATI arg: terminal code,,channel no.
ati ; all characters should interrupt on TTYCHN
move a,[ttylev,,tyirlt] ; set up CHNTAB entry for time-out interrupts
movem a,chntab+timchn ; ...
} ; IFN TINT
return
ttyerr: asciz "Error opening TTY - "
} ; IFN TNX
vtsu: pushae p,[a,b] ; save ACs
say "
Identifying VT type: "
ifn its,.reset tyic, ; make sure input flushed
IFN TNX,{
move a,ttyjfn ; CFIBF arg: A = JFN
cfibf ; flush input
} ; IFN TNX
movei a,33 ; send "identify-yourself" command to VT
call bufc ; ...
movei a,"Z ; ...
call bufc ; ...
call obfsnd
call finish
sleep 10. ; sleep for 1 second - plenty time
call tbin
caie a,33 ; first char should be ESC
jrst vtsu1 ; not escape? lose.
call tbin
caie a,"/ ; second char should be /
jrst vtsu1 ; not /? lose.
call tbin
; Now check term type
movei b,0 ; Clear term-type
cain a,"A ; VT50?
movei b,vt50
caie a,"H ; VT50H?
cain a,"J
movei b,vt50h
caie a,"K ; VT52?
cain a,"L
movei b,vt52
jumple b,vtsu1
hrrzm b,trmadr ; identified, store idx.
hlrz a,.tpnam(b)
move a,(a) ; get sixbit form.
call sixo
saycr ""
popae p,[b,a]
pjrst popj1
vtsu1: saycr " Unable to identify terminal as a VT type."
popae p,[b,a]
return
subttl Setup - Set variables
setup3: move b,trmadr ; Last-minute check to make sure idx legal.
movsi a,-nterms ; check to make sure it's legal.
su3.1: came b,trmtab(a)
aobjn a,su3.1
jumpge a,[say " Bug - bad TRM address?? "
.lose 0 ]
IFE TNX&STY,{
skipn c,simadr
movei c,soft ; If no explicit simulator, use SOFT!!
}
.ELSE {
skipe c,simadr
jrst su3.3
movei c,vt52 ; If no explicit simulator, use VT52!!
IFDEF RTCHR,{
movei a,.priin
rtchr
erjmp su3.3
movei c,soft ; unless VTS present, in which case use SOFT
}
su3.3:
}
movem c,simadr
movsi a,-nterms
su3.2: came c,trmtab(a)
aobjn a,su3.2
jumpge a,[say " Bug - bad SIM address?? "
.lose 0 ]
IFN ITS,{
; Check for potential lossage if TTY is software.
move a,trmadr
caie a,soft
skiple jsftok
jrst su3.3
move b,tctyp ; check - software TTY controlling us?
caie b,%tnsfw ; ...
jrst su3.3 ; nope, go ahead
saycr |
Foo! You are on a "software" terminal, either because you are already
using CRTSTY or are using a SUPDUP network server; CRTSTY cannot work.
If you know what you're doing, use "SOFTOK" in the command line. (but
you can't say we didn't warn you)|
jrst logout
su3.3:
} ; IFN ITS
call trmblt ; Now move terminal table into TB.
tdo f,.tpflg+tb ; set necessary flags for type.
skipn ospeed ; speed known?
trnn f,%fspd ; no, will we lose by not knowing the speed?
jrst su3.4 ; no
saycr "Terminal's speed is unknown. Please use the SPEED command
(or the OSPEED and ISPEED commands) to tell CRTSTY the line
speed in bits per second."
jrst logout
su3.4:
; initialize screen dimensions
setzm tvmin ; terminal window starts at 1st line of screen
skipn a,jheight ; if command line specified height, use that
move a,.tpvsz+tb ; else use standard for type
jumpe a,[
saycr "You must specify a screen height for this terminal"
jrst logout
]
movem a,sheight ; set screen height
movem a,theight ; and terminal window height
subi a,1 ; convert height to maximum vertical coordinate
movem a,svmax ; set screen vertical maximum
movem a,tvmax ; terminal window ends at last line of screen
setzm thmin ; terminal window starts at 1st column of screen
skipn a,jwidth ; was a command line width specified?
move a,.tphsz+tb ; no, use standard for type
jumpe a,[
saycr "You must specify a screen width for this terminal"
jrst logout
]
movem a,swidth ; store width
movem a,twidth
subi a,1 ; subtract 1 to get maximum horz coordinate
movem a,shmax ; ...
movem a,thmax
skipe a,jscrcnt ; SCRLCOUNT specified?
movem a,.tpscr+tb ; yes, use it instead of terminal default
skipge .tpscr+tb ; make sure we've got a SCRLCOUNT
jrst [ saycr "You must specify a SCRLCOUNT for this terminal"
jrst logout
]
move a,.trcho+tb
skipl janl
jrst su3.5
cain a,ccho
movei a,scho
cain a,ccho0
movei a,scho0
caie a,scho
cain a,scho0
jrst su3.7
say "NO "
jrst su3.6
su3.5: skipg janl
jrst su3.7
cain a,scho
movei a,ccho
cain a,scho0
movei a,ccho0
caie a,ccho
cain a,ccho0
jrst su3.7
su3.6: saycr "AUTONL ignored"
setzm janl ; print warning
su3.7: movem a,.trcho+tb
move a,[movei a,nutcst] ; "impossible" movement cost calculator
skipge jabs ; NO ABS?
movem a,.tcabs+tb ; yes, make absolute positioning cost
; "impossible"
skipge jtab ; NO TABS?
movem a,.tctab+tb ; yes, make tab cost "impossible"
move a,speed ; speed 120cps or lower?
caile a,120. ; ...
skiple jsmeol ; or user specify SMEOL?
tro f,%fsmeol ; yes, turn on smart CLEOL
skipge jsmeol ; user specify NO SMEOL?
trz f,%fsmeol ; yes, turn off smart CLEOL
skiple jsteos ; STEOS specified?
tro f,%fcsel ; yes, turn on hack
skipge jsteos ; NO STEOS specified?
trz f,%fcsel ; yes, turn off hack
skiple jcleol ; CLEOL specified?
trz f,%fneol ; yes
skipge jcleol ; NO CLEOL specified?
trz f,%fneol ; yes
skiple jcleos ; CLEOS specified?
trz f,%fneos ; yes
skipge jcleos ; NO CLEOS specified?
trz f,%fneos ; yes
skiple jlid ; LID specified?
trz f,%fnilp+%fndlp ; yes
skipge jlid ; NO LID specified?
tro f,%fnilp+%fndlp ; yes
skiple jcid ; CID specified?
trz f,%fnicp+%fndcp ; yes
skipge jcid ; NO CID specified?
tro f,%fnicp+%fndcp ; yes
; Now compute what functions are usable. Someday this may have to become
; a terminal dependent routine.
irp x,,[eol,eos,clr,su,sd,ilp,dlp,dcp]
skipn .te!x+tb
tro f,%fn!x
termin
skipn .teicp+tb
skipe .teeim+tb
caia
tro f,%fnicp
movem f,.tpflg+tb
pjrst @.trwi+tb ; initialize window variables
; SWI - Default window initialization.
swi: setzb a,b ; TDWIN1 args: A = minimum vertical,
; B = minimum horizontal
IFN STY,{
skiple wholin ; WHOLINE specified?
movei a,1 ; use second line as minimum vertical
} ; IFN STY
dmove c,smax ; TDWIN1 args: C = maximum vertical,
; D = maximum horizontal
pjrst tdwin1 ; calculate capabilities in window
; TRMBLT - snarf terminal table into TB for fast impure reference.
; Takes term idx from TRMADR, and sets up .TRSMI and .TRSMO
trmblt: pushae p,[a,b]
skipn b,trmadr ; Get term idx
jrst [ say "Bug - bad TRMADR!! "
.lose]
movsi a,(b)
hrri a,tb
blt a,tb+ltb-1 ; Snarf its table.
skipe b,simadr ; Get simulator idx
skipn a,.trsmi(b) ; and dispatch for it
jrst [say "Bug - bad SIMADR!! "
.lose]
movem a,.trsmi+tb
move a,.trsmo(b)
movem a,.trsmo+tb
move a,.trsmf(b)
movem a,.trsmf+tb
popae p,[b,a]
return
subttl Set up STY
; STYINI - Open/Initialize STY. The TB array and AC F are referenced;
; i.e. TRMBLT and SETUP3 must have been executed.
IFN ITS&STY,{
styini: $call open,[#pyi,[sixbit/STY/]][?a][#10+.uii]
; don't-hang input from sty
jrst [ caie a,%efldv ; device full?
$call lose,[#%lsfil,#styini] ; no, lose
saycr "Can't get a STY! Probably too many in use right now."
jrst logout ]
$call open,[#pyo,[sixbit/STY/]][][#10+.uio]
; image,unit,output to sty
.lose %lsfil ; "don't-hang" here means echo feep when
; buffer full, rather than hanging.
move a,[-4,,[
sixbit /msk2/ ? tro 1_pyi ; enable interrupts
sixbit /df2/ ? tro 1_pyi ; but defer them
]]
$call usrvar,[#%jself,a]
.lose %lssys
call setup4
move b,[-12.,,[
sixbit /height/ ? move tcmxv
sixbit /width/ ? move tcmxh
sixbit /tctyp/ ? move tctyp
sixbit /ttycom/ ? movei 0
sixbit /ttyopt/ ? move ttyopt
sixbit /ttyrol/ ? move ttyrol
]]
$call ttyvar,[#pyi,b]
.lose %lsfil
move b,[-4.,,[
sixbit /ispeed/ ? move ispeed
sixbit /ospeed/ ? move ospeed
]]
$call ttyvar,[#pyi,b] ; set ispeed/ospeed separately
jfcl ; to ignore error if ITS can't encode values
; in 4 bits
.suset [.rioc+pyi,,a] ; IOCHNM word for PYI channel
ldb a,[$tiidx,,a] ; get TTY no. for STY we opened
movem a,stynum ; ...
move a,[squoze 0,TTYSTS]
move b,stynum ; add in # of STY as proper index
call itsmap
movem a,ttysts ; Save address in our map
move a,[squoze 0,TTYOAC] ; Now want to map TTYOAC+(our STY)
move b,stynum ; add in # of STY as proper index
call itsmap
movem a,ttyoac ; Save address in our map
return
} ; IFN ITS&STY
IFN ITS&NET,{
mvar frnhst
mvar chaosp
styini: skipn hstnam ; HOST <name> specified?
jrst [ saycr "HOST <name> required."
jrst logout ]
move a,syspno ; HSTMAP arg: A = page no. for mapping
movei b,dsko ; HSTMAP arg: B = channel no.
call netwrk"hstmap ; load in the HOSTS2 data base
.value
movei a,hstnam ; HSTLOOK arg: pointer to host name
call netwrk"hstlook ; get host number into A, network number into
; TT
jrst [ saycr "Unrecognized host name."
jrst logout ]
movem a,frnhst ; stash host number
cain tt,netwrk"nw%arp ; ARPAnet?
jrst styin2 ; yes
styin1: setom chaosp
movei a,pyi ; CHACON arg: A = channel no.
move b,frnhst ; CHACON arg: B = host no.
movei c,[asciz "SUPDUP"] ; CHACON arg: C = contact name
movei d,5 ; CHACON arg: D = window size
call netwrk"chacon ; open connection
jrst netluz
jrst styin3
styin2: movei a,icpch ; first of 4 pins (channels) to ICP with
move b,frnhst ; host to ICP to
move c,icpskt ; contact socket
move d,[40+.uai,,40+.uao] ; modes (8 bit)
call netwrk"arpicp ; do it all
jrst netluz ; lost
styin3:
IFN 0,{
move a,frnhst ; HSTSIX arg: A = host no.
call netwrk"hstsix ; get short name of host
.value
movem a,hstsix' ; save for command prompt
} ; IFN 0
call netwrk"hstunmap ; unmap HOSTS2
move a,[-4,,[
sixbit /msk2/ ? tro 1_pyi ; enable interrupts
sixbit /df2/ ? tro 1_pyi ; but defer them
]]
$call usrvar,[#%jself,a]
.lose %lssys
return
netluz:
; .iot tyon,[^P] ; IOC error on NET. Go to fresh line
; .iot tyon,["A] ; ...
call netwrk"analyze ; and type the error message
.value
jrst logout
putchr: .iot tyon,t1
return
} ; IFN ITS&NET
IFN TNX&STY,{
styini: call getpty ; get a PTY
IFN SINT,{
move a,[ptylev,,styivi] ; set up CHNTAB entry for PTY output
movem a,chntab+ptychn+1 ; interrupts
move a,smijfn ; MTOPR arg: JFN
move b,[mo%oir+<ptychn_18.>+.moapi] ; MTOPR arg: function code
mtopr ; assign PTY interrupt channel
} ; IFN SINT
call setup4
move t1,tctyp ; find terminal type we're simulating
movei b,.ttidl ; STTYP arg: B = termainal type
cain t1,%tnesc ; simulating VT52?
movei b,.ttv52 ; yes, tell TNX we're a VT52 instead
IFDEF .TTSUP,{
caie t1,%tnsfw ; simulating a ITS software terminal?
jrst nosup ; no
movei b,.ttsup ; yes, tell TNX we're a SUPDUP terminal
move t1,[441000,,ibuff]
movem t1,ibufip
nosup:
}
move a,ptyttd ; STTYP arg: A = terminal designator
sttyp ; set PTY's TTY's terminal type
move b,tcmxv ; get terminal height
lsh b,25. .see tt%len ; shift into position
move t1,tcmxh ; get terminal width
movsi t1,1(t1) .see tt%wid ; add 1 and shift into position
add b,t1 ; add to STPAR word
move t1,ttyopt ; terminal have tabs?
trne t1,%tpptb*7 ; ...
tlo b,(tt%tab) ; yes, tell TNX about it
tdo b,[tt%lca\tt%pgm] ; turn on display mode and lowercase
; STPAR arg: A = terminal designator
; STPAR arg: B = terminal mode word
stpar ; set height, width, capabilities, etc.
IFDEF STCHR,{
move b,[tc%mov+tc%bs+tc%hom+tc%clr+tc%scl+tc%lid+tc%cid+tc%met+tc%scr]
move c,ttyopt
tlnn a,%tomvu
tlc b,(tc%mov)
tlnn a,%tomvb
tlc b,(tc%bs\tc%mov)
tlnn a,%toers
tlc b,(tc%scl)
trnn a,%tprsc
tlc b,(tc%lid)
tlnn a,%tocid
tlc b,(tc%cid)
tlnn a,%tofci
tlc b,(tc%met)
tlnn a,%toovr
tlc b,(tc%ovr)
skipn ttyrol
tlc b,(tc%scr)
stchr
erjmp .+1
}
return
ivar devnam(2) ; PTY device name for GTJFN
getpty: movei d,0 ; start at first PTY
getpt1: caml d,syspty ; any more?
jrst [ saycr "No PTYs available"
jrst logout
]
move a,d ; DVCHR arg: device designator:
hrli a,.dvdes+.dvpty ; device type,,unit no.
dvchr ; get characteristics of this PTY
tlnn b,(dv%av) ; is it available?
aoja d,getpt1 ; no
move b,a
hrroi a,devnam
devst ; convert device designator to a name
aoja d,getpt1
movei b,": ; add a colon for the GTJFN
idpb b,a ; ...
movei b,0 ; terminate with a null
idpb b,a ; ...
movsi a,(gj%sht)
hrroi b,devnam
gtjfn
aoja d,getpt1 ; not available
movem a,smijfn ; save PTY JFN
movem a,smojfn
move b,[8._30.+of%rd+of%wr]
openf ; open PTY
jrst [ move a,smijfn ; RLJFN arg: JFN
rljfn ; PTY not available, release JFN for it
jfcl
aoja d,getpt1 ; try next one
]
add d,firpty ; turn PTY no. into TTY no.
addi d,.ttdes ; turn TTY no. into device designator
movem d,ptyttd ; ...
return
} ; IFN TNX&STY
IFN TNX&NET,{
.mosnd==:21 ; send all currently buffered bytes
ifn arpa, .moain==:24 ; assign INS/INR and FSM PSI channels
ifn chaos,{
.moacn==:24 ; assign input/output interrupt channels
IOX4==:600220 ; End of file error message
} ; ifn chaos
ivar hstbfr(10)
styini: skipn hstnam ; HOST <name> specified?
jrst [ saycr "HOST <name> required."
jrst logout ]
IFN CHAOS,{
call chaicp
IFE ARPA, jerr1 icperr
IFN ARPA,{
jrst [ caie a,gjfx16 ; no such device? (chaosnet not supported)
cain a,gjfx18 ; no such filename? (host not on chaosnet)
jrst styin1 ; either, try ARPAnet
jerr1 icperr ; chaosnet supported, and host known, report
; error
]
} ; IFN ARPA
IFN SINT,{
move a,[ntilev,,styivi]
movem a,chntab+ntichn
move a,smijfn ; MTOPR arg: A = JFN
movei b,.moacn ; MTOPR arg: B = function code
move c,[-1,,ntichn] ; MTOPR arg: C = output channel,,input channel
mtopr ; assign input interrupt channel
} ; IFN SINT
return
} ; IFN CHAOS
IFN ARPA,{
styin1: call arpicp
jerr1 icperr
setzm inscnt
move a,[inslev,,insint]
movem a,chntab+inschn
move a,[netlev,,netint]
movem a,chntab+netchn
movei a,.fhslf ; AIC arg: A = fork handle
movsi b,(1_<35.-inschn>\1_<35.-netchn>)
; AIC arg: B = channels to activate
aic ; activate INSCHN and NETCHN
move a,smijfn ; MTOPR arg: A = JFN
movei b,.moain ; MTOPR arg: B = function code
movsi c,(inschn_30.\77_24.\netchn_18.)
mtopr ; assign INS/INR and state change interrupt
; channels
return
} ; IFN ARPA
icperr: asciz "Error connecting to foreign host - "
} ; IFN TNX&NET
IFN TNX&NET,{
IFN CHAOS,{
chaicp: move a,[ascii "CHA:"]
movem a,hstbfr+0
move a,[100700,,hstbfr]
move b,[440700,,hstnam]
call icp3
move b,[440700,,[asciz ".SUPDUP"]]
call icp3
movei b,0
idpb b,a
movsi a,(gj%sht)
hrroi b,hstbfr
gtjfn
return
movem a,smijfn
movem a,smojfn
; OPENF arg: A = JFN
move b,[8._30.\of%rd\of%wr] ; OPENF arg: B = byte size, data
; mode, control bits
openf ; open receive connection in immediate return
; mode
return ; should release JFN
aos (p)
return
} ; IFN CHAOS
IFN ARPA,{
arpicp: move a,[ascii "NET:"]
movem a,hstbfr+0
move a,[100700,,hstbfr]
movei b,2 ; get next local socket no.
addb b,lskt ; ...
subi b,2 ; ...
call icp2
movei b,".
idpb b,a
move b,[440700,,hstnam]
call icp3
movn b,icpskt
call icp2
call icp1
movsi a,(gj%sht)
hrroi b,hstbfr
gtjfn
return
movem a,smijfn ; GTJFN result: OPENF arg: A = JFN
move b,[32._30.\of%rd] ; OPENF arg: B = byte size, control bits
openf ; ICP to foreign connection socket
jerr1 icperr
; BIN arg: A = JFN
bin ; get foreign socket no.
movem b,fskt ; save for later
; GDSTS arg: A = JFN
gdsts ; get foreign host no.
; GDSTS result: B = connection state,
; C = host no., D = socket no.
hrroi a,hstnam ; CVHST arg: A = B.P.
move b,c ; CVHST arg: B = host no.
cvhst ; get official host name
jfcl ; OK if didn't write anything
move a,smijfn ; CLOSF arg: A = JFN
closf
return
move a,[100700,,hstbfr]
movei b,2 ; get next local socket no.
addb b,lskt ; ...
subi b,2 ; ...
call icp2
movei t1,".
idpb t1,a
move b,[440700,,hstnam]
call icp3
movn b,fskt
call icp2
call icp1
movsi a,(gj%sht)
hrroi b,hstbfr
gtjfn
return
movem a,smojfn
movsi a,(gj%sht)
hrroi b,hstbfr
gtjfn
return
movem a,smijfn ; OPENF arg: A = JFN
move b,[8._30.\6_26.\of%rd] ; OPENF arg: B = byte size, data
; mode, control bits
openf ; open receive connection in immediate return
; mode
return
move a,smojfn ; OPENF arg: A = JFN
move b,[8._30.\5_26.\of%wr] ; OPENF arg: B = byte size, data
; mode, control bits
openf ; open send connection in buffered send mode
return
aos (p)
return
icp1: movei b,";
idpb b,a
movei b,"T
idpb b,a
movei b,0
idpb b,a
return
icp2: movei c,8.
nout
.lose
return
} ; IFN ARPA
icp3a: idpb t1,a
icp3: ildb t1,b
jumpn t1,icp3a
return
} ; IFN TNX&NET
IFN NET,{
IAC==:255.
DONT==:254.
DO==:253.
WONT==:252.
WILL==:251.
SB==:250.
GA==:249.
EL==:248.
EC==:247.
AYT==:246.
AO==:245.
IP==:244.
BRK==:243.
DM==:242.
;NOP==:241.
SE==:240.
SUPDUP==:21.
IFN ARPA,{
icpskt: 137 ; SUPDUP socket
; maybe eventually use new TELNET and DO SUPDUP
}
netini:
IFN 0,{
movei a,IAC
call sbout
movei a,DO
call sbout
movei a,SUPDUP
call sbout
call smofrc
move a,smijfn
netin1: bin
caie b,IAC
jrst netin9
bin
cain b,NOP
jrst netin1
caie b,WILL
jrst netin9
bin
caie b,SUPDUP
jrst netin9
} ; IFN 0
call setup4
IFN ITS,{
move a,[440600,,spdblk]
movei b,lspdblk*6
$call siot,[#pyo,a,b]
.lose %lssys
.nets pyo,
netin2: .iot pyi,a
jumpl a,logout ; EOF, connection was refused
cain a,%tdnop
jrst netin3
.iot tyon,a
jrst netin2
} ; IFN ITS
IFN TNX,{
move a,smojfn
move b,[440600,,spdblk]
movni c,lspdblk*6
sout
movei b,.mosnd
mtopr
netin2: move a,smijfn
bin
cain b,%tdnop
jrst netin3
movei a,.priin
bout
jrst netin2
} ; IFN TNX
netin3: return
} ; IFN NET
; SETUP4 - ...
setup4: .i tcmxv=wheight
.i tcmxh=wwidth-1
setzm smarts
move t1,.tpscr+tb
movem t1,ttyrol
move t1,simadr
cain t1,vt52
jrst [ movei t1,%tnesc
movem t1,tctyp
move a,[%toers+%tomvb+%tomvu+%tolwr+%tolid,,3*%tpptb]
jrst su4.1 ]
caie t1,soft ; simulating an ITS Software-TTY?
jrst [ movei t1,%tnprt ; No, tell ITS it's a "printing" TTY.
movem t1,tctyp ; ...
move a,[%tomor+%tolwr,,%tpors] ; and use these flags.
jrst su4.2 ]
movei t1,%tnsfw
movem t1,tctyp
move a,[%toers+%tomvb+%tomvu+%tomor+%tolwr+%tolid+%tocid,,%tpors+%tpcbs+%tprsc]
skipge tpcbs ; NO TPCBS?
trz a,%tpcbs ; yes
su4.1: trne f,%fsail
tlo a,%tosai
trne f,%ffci
tlo a,%tofci
skiple glassw
tlz a,%tomvu+%toers ; GLASS option, don't claim to be a display
trnn f,%fnilp ; terminal support insert and delete line?
trne f,%fndlp ; ...
tdz a,[%tolid,,%tprsc] ; no, turn off %TOLID
trnn f,%fnicp ; terminal support insert and delete character?
trne f,%fndcp ; ...
tlz a,%tocid ; no, turn off %TOCID
su4.2: skiple jsail ; SAIL specified?
tlo a,%tosa1 ; yes, do :TCTYP SAIL
skiple jscrol ; SCROLL specified?
tlo a,%torol ; yes, do :TCTYP SCROLL
movem a,ttyopt
return
subttl Setup - Finally attach, login, and begin hacking
setup7:
IFN ITS&STY,{
setom cmdchr
}
.ELSE {
movei t1,^^
movem t1,cmdchr
} ; IFE ITS&STY
setzb h,v ; Initialize both sets of cursor coords
dmove nvh,wmin
xct .trini+tb ; Initialize terminal (must clear screen,
; reset window, leave insert mode)
; See "Notes about Terminal-table entries"!!
ifn sty,call whoini
call obfsnd ; ensure everything out
skipge jsii ; NO SII specified?
jrst su7.1 ; yes, definitely don't do it
skipg jsii ; SII specified?
skipg debug ; and DEBUG not specified?
call sii ; then do it
su7.1:
IFN ITS,{
.close tyon, ; don't need this any more
IFN NET,{
skiple jattach ; ATTACH specified?
call attach ; yes, do it
} ; IFN NET
IFN STY,{
skipge jattach ; NO ATTACH specified?
jrst su7.2 ; yes, definitely don't attach
skipg jattach ; ATTACH specified?
skipg debug ; no, don't attach if debugging
call attach ; make ourselves top-level
su7.2: skiple jslave ; SLAVE specified?
jrst logi3 ; yes, don't even ^Z
login: setzm ibufpt ; clear "flag" to hang on
.suset [.sadf2,,[1_pyi]] ; now undefer STY interrupts
movei a,^Z
call tyiput
skipn ibufpt ; wait until got going. (typing out login msg)
.hang ; the CALL STYINC will trip this.
.suset [.sidf2,,[1_pyi]] ; now defer interrupts again
; (couldn't use stack if STY
; interrupts weren't deferred)
move a,juname ; NO LOGIN specified?
aoje a,logi3 ; yes
move e,[440600,,juname] ; byte pointer to login name
skipe juname ; if login name already specified,
jrst logi1 ; just use it.
move e,[440600,,xuname] ; else if xuname begins with punctuation,
ildb a,e ; (hack for compatibility with old stuff)
caile a,17 ; see if punctuation, (40-57), if so use rest.
move e,[440600,,xuname] ; isn't punctuation, use whole xuname.
logi1: ildb a,e
jumpe a,logi2
addi a,40 ; convert to ascii
call tyiput
tlne e,770000 ; Stop when run out.
jrst logi1
logi2: movei a,33 ; send out $U to terminate login
call tyiput
movei a,"U
call tyiput
logi3:
} ; IFN STY
} ; IFN ITS
IFN TNX&STY,{
movei a,^C
call tyiput
skipge jlogin ; NO LOGIN specified?
jrst logi3 ; yes, skip this cruft
movei a,500. ; DISMS arg: no. of milliseconds
disms ; wait for ^C to be acted upon or else login
; command gets lost
ivar lname(10.)
hrroi a,lname
move b,ldir
dirst
jrst logi3
irpc X,,[LOGIN ]
movei a,"X
call tyiput
termin
push p,[350700,,lname]
ldb a,(p)
logi1: call tyiput
ildb a,(p)
jumpn a,logi1
movei a,40
call tyiput
movei a,^M
call tyiput
logi3:
} ; IFN TNX&STY
jrst setup8
IFN ITS,{
sii: move a,[-2,,[
sixbit /ttycom/ ? movsi %tcrfs ; refuse com links to
; supported TTY
; sixbit /ttysts/ ? movsi %tssii ; turn on super-image input
]]
$call ttyvar,[#tyic,a]
.lose %lsfil
$call ttyset,[#tyic,[030303,,030303],[030303,,030303],[%tssii,,0]]
.lose %lsfil ; just until TTYVAR can hack TTYSTS
return
attach: skipge @suppro ; top-level?
jrst attac4 ; yes, skip the nonsense
move a,option ; DDT superior?
tlnn a,%opddt ; ...
jrst [ saycr "Superior isn't DDT; can't attach."
return ]
$call usrvar,[#%jssup,[sixbit/suppro/]][a]
.lose %lssys
jumpge a,[
saycr "Superior isn't top-level; can't attach."
return ] ; if superior isn't top-level then forget it
;; We have a top-level superior which claims to be DDT.
.value [asciz ":attach "]
; The following code is will be unnecessary when we can specify the
; ATTACH call control bits with :ATTACH. Control bit 1.3 will P
; us only after we've become top-level.
skipl @suppro
.hang
attac3: $call usrvar,[#%jself,[sixbit/jname/],[sixbit/hactrn/],?a]
; change our JNAME to HACTRN to
; insure DDT has vanished
jrst [ caie a,%eexfl ; failed, "file already exists" error?
$call lose,[#%lssys,#attac3] ; no, lose
movei a,1 ; wait a while
.sleep a, ; ...
jrst attac3 ; and try again
]
;; We are a top-level job. Change our name to reflect the
;; supportted terminal. This also allows the user to login
;; as FOO instead of FOO0.
attac4: hlrz a,.tpnam+tb ; get sixbit name of terminal
move a,(a) ; ...
move t1,[-6,,[
sixbit /mask/ ? tdo [ftl%pi+%pitty+%piaty]
sixbit /tty/ ? tlo %tbint
sixbit /sname/ ? move a
]]
$call usrvar,[#%jself,t1] ; enable interrupts on fatal
.lose %lssys ; conditions and missing TTY
; set SNAME to terminal name
attac5: $call usrvar,[#%jself,[sixbit/jname/],a,?b]
; try to set jname to term name
jrst [ caie b,%eexfl ; failed, "already exists" error?
$call lose,[#%lssys,#attac5]
aoja a,attac5 ; yes, bump and try again
]
return
} ; IFN ITS
; STDWRN - semi-standard warning routine.
; A - ASCNT ptr to string to display as warning message.
; UNDELW - Entry pt for standard warning msg about DEL/underscore switch.
undlcw: xct .teclr+tb ; Another entry pt to clear screen normally.
undelw: move a,[ascnt " Warning: interchanged Underscore and Delete keys."]
stdwrn: skipge jwarn
return
pushae p,[nh,nv]
move nv,wheight
lsh nv,-1 ; Put message halfway down screen.
add nv,wvmin
move nh,whmin
call frcmov ; Move cursor there.
call td.bow ; Switch to standout mode.
call warn ; output warning message.
call td.rst ; Reset standout mode.
popae p,[nv,nh]
return
warn: skipge jwarn ; Send warning message only if switch allows.
return
pushae p,[b,c]
move c,a
hrli c,440700
hlrz b,a
jumpe b,warn4
warn2: ildb a,c
cain a,^M
jrst [ movei nh,0
jrst warn3 ]
cain a,^J
aoja nv,warn3
call ordnry
warn3: sojg b,warn2
warn4: call obfsnd ; make sure obuff completely empty
call finish
sleep 10. ; let user see message for at least a second
popae p,[c,b]
return
IFN ITS,{
; ITSMAP - Map an ITS location into address space.
; Arguments:
; A SQUOZE variable name.
; B offset
; Result:
; A pointer in our address space to location.
itsmap: .eval a,
.lose %lssys
add a,b
idivi a,pg$siz
$call corblk,[#%cbndr,#%jself,syspno,#%jsnum+0,a]
.lose %lssys
move a,syspno
lsh a,pg$log
add a,b
aos syspno
return
ivar syspno ; next page to use for mapping
} ; IFN ITS
; TRMFLS - flush unneeded terminal pages.
trmfls: move b,trmadr
move c,simadr
caie c,vt52
cain c,soft ; Note kludge to avoid always saving SOFT.
move c,b
movsi d,-nterms
hlrz a,pagtab ; Get 1st page
trmfl2: came b,trmtab(d)
camn c,trmtab(d)
call trmfl4 ; hit protected entry, hack it.
aobjn d,trmfl2 ; drop thru when done,
movei d,nterms-1 ; faking out pagtab reference.
hrrz e,pagtab(d)
aoja e,trmfl5
; hit one of protected entries, flush pages bypassed so far.
; A has first page to start flushing at.
trmfl4: hlrz e,pagtab(d) ; Find 1st page of protected
trmfl5: subi e,(a) ; Find # pages to flush
jumple e,trmfl6 ; jump if none.
movn e,e
hrl a,e ; Now have page AOBJN
call corfls
trmfl6: hrrz a,pagtab(d) ; Now find last page protected,
addi a,1 ; and use that+1 as 1st page to flush next.
return
; TRMEND macro deposits data here.
ifndef maxtrm, maxtrm==120. ; Gads! (Gadzooks! -CBF 21Jun80)
trmtab: block maxtrm ; address of terminal table
pagtab: block maxtrm ; <first page>,,<last page>
constants
SECTION MAIN
IFN ARPA,{
mvar inscnt
mvar supres
} ; IFN ARPA
IFN ITS,{
; ITS variables for CRTSTY
mvar option ; our OPTION
mvar uname ; our UNAME
mvar jname ; our JNAME
mvar uind ; our UIND (user index)
mvar xuname ; our XUNAME
mvar xjname ; our XJNAME
mvar cnsl ; our CNSL
mvar buffct ; negative number of chars left to put
mvar lublk
; Pointers to system variables.
mvar time ; holds address of system time variable
mvar myuind ; Holds internal ITS user index of this job.
mvar aprc ; holds addr indirected thru for direct APRC user-var check.
mvar suppro ; holds address of SUPPRO user-variable
mvar torm ; holds addr indirected thru for direct TORM+Tnm check.
; TORM(I) holds # chars free in output buffer.
IFN STY,{
mvar stynum ; holds # of STY opened. Used to index TTYSTS, TTYOAC in sys.
mvar ttyoac ; holds addr indirected thru for direct TTYOAC+Snm check.
; TTYOAC(I) is -1 if output inactive.
mvar ttysts ; holds addr indirected thru for direct TTYSTS+Snm check.
; TTYSTS(I) sign bit indicates terminal is free.
} ; IFN STY
} ; IFN ITS
IFN TNX,{
mvar ldir ; login directory no.
mvar cnsl
mvar ttyjfn
mvar smijfn
mvar smojfn
mvar oldtiw ; old terminal interrupt word
mvar oldmod ; old JFN mode word
IFN STY,{
mvar syspty
mvar firpty
mvar ptyttd
} ; IFN STY
IFN ARPA,{
mvar lskt
mvar fskt
} ; IFN ARPA
IFE TINT\SINT,{
mvar rcvfrk
}
} ; IFN TNX
SECTION MAINVAR
spdblk: -<lspdblk-1>,,0
tctyp: block 1
ttyopt: block 1
tcmxv: block 1
tcmxh: block 1
ttyrol: block 1
smarts: block 1
ispeed: block 1 ; input speed variable (in bps)
ospeed: block 1 ; output speed variable (in bps)
lspdblk==:.-spdblk
SECTION MAIN
mvar feepmx ; If pos, holds # clock ticks of inactivity to cause feep.
mvar feeptm ; Countdown to see if should feep when output appears.
mvar ofeptm ; "old-feeptm" check to help canonicalize feeptm.
mvar speed ; output speed in characters per second
mvar buffmx ; negative number of chars put out before .listen
; All set up, now operate at interrupt level.
setup8: call trmfls ; OK, now flush core pages of unused terms
move a,[<fipg-fmpg>,,fipg]
IFN ITS&NET,{ ; keep ANALYZE around
skiple jflush
call corfls
}
IFE ITS&NET,{
skipl jflush ; NO FLUSH specified?
call corfls ; no, do it
}
IFN ITS,{
IFE TINT&SINT, .err No interrupts?
; Enable remaining interrupts: realtime and input.
move a,[600000,,[clkfrm]]
.realt a, ; Set clock frame
jfcl
move a,[-2,,[
.simask,,[%pirlt] ; enable .realt interrupt
.sadf2,,[1_pyi+1_tyic] ; undefer tyi, pyi ints
]]
.suset a
; Now do all the work at interrupt level.
IFE STY,{
jfcl ; hang around forever
.hang ; ...
} ; IFE STY
IFN STY,{
skipg jslave ; supposed to be slave?
jrst noslav
jfcl ; slave, so hang forever
.hang
noslav: skipl @ttysts ; Wait until TTY becomes free
.hang
.suset [.sidf2,,[<1_tyic>\<1_pyi>]] ; disable interrupts
jrst quit
} ; IFN STY
} ; IFN ITS
IFN TNX,{
IFE TINT\SINT,{
move t1,[iftlev,,iftint] ; create inferior fork termination
movem t1,chntab+.icift ; handler
movei a,.fhslf ; AIC arg: A = fork handle
movx b,1_<35.-.icift> ; AIC arg: B = channel mask
aic ; activate inferior fork termination
; interrupt
irp x,,[f,nv,nh,v,h,p]
movem x,acblk+x ; pass ACs to simulation input process
termin
movsi a,(cr%map\cr%st\cr%acs) ; CFORK arg: LH A = control bits
hrr a,.trsmi+tb ; RH A = start address
movei b,acblk ; CFORK arg: B = AC block address
cfork ; create simulation input fork sharing our
; address space
jerr1 [asciz "Error creating inferior fork - "]
; don't use stack until TYIINI!
movem a,rcvfrk ; CFORK result: A = fork handle
; RPCAP arg: A = fork handle
rpcap ; read process capabilities
; result: B = possible capabilities,
; C = enabled capabilities
tlo b,(sc%sup) ; allow simulation input fork to interrupt
tlo c,(sc%sup) ; us
epcap ; set process capabilities
jrst tyiini ; goto terminal input co-routine
} ; IFE TINT\SINT
IFN TINT&SINT,{
movei a,.fhslf ; AIC arg: A = fork handle
move b,[<1_<35.-ttychn>>\<1_<35.-timchn>>\<1_<35.-smichn>>]
; AIC arg: B = channel mask
aic ; enable TTY, timer, and PTY interrupts
movei a,.fhslf ; STIW arg: A = fork handle
movx b,1_<35.-.ticti> ; STIW arg: B = terminal interrupt word
movei c,0 ; STIW arg: C = deferred interrupt word
stiw ; interrupt on all characters
wait ; do everything at interrupt level
} ; IFN TINT&SINT
IFN TINT#SINT,{
IFN TINT,{
movei a,.fhslf ; AIC arg: A = fork handle
move b,[<1_<35.-ttychn>>\<1_<35.-timchn>>]
; AIC arg: B = channel mask
aic ; enable TTY interrupts
movei a,.fhslf ; STIW arg: A = fork handle
movx b,1_<35.-.ticti> ; STIW arg: B = terminal interrupt word
movei c,0 ; STIW arg: C = deferred interrupt word
stiw ; interrupt on all characters
jrst @.trsmi+tb ; goto simulation input co-routine
}
IFN SINT,{
.err This combination doesn't work. ACs and stack get mixed up.
movei a,.fhslf ; AIC arg: A = fork handle
move b,[1_<35.-smichn>] ; AIC arg: B = channel mask
aic ; enable PTY interrupts
jrst tyiini ; goto terminal input co-routine
}
} ; IFN TINT#SINT
} ; IFN TNX
; CORFLS - Remove unneeded pages from address space.
; Argument:
; A -<no. pages>,,<first page>
IFN ITS,{
corfls: $call corblk,[#0,#%jself,a]
.lose %lssys
return
} ; IFN ITS
IFN 20X,{
corfls: pushae p,[b,c] ; save ACs
hlre c,a ; PMAP arg: control bits,,repeat count
movn c,c ; ...
tlo c,(pm%cnt) ; set repeat count control bit
move b,a ; PMAP arg: process handle,,page no.
hrli b,.fhslf ; ...
seto a, ; PMAP arg: source of -1 to unmap
pmap ; remove specified pages
popae p,[c,b] ; restore ACs
return
} ; IFN 20X
IFN 10X,{
corfls: pushae p,[b,d] ; save ACs
move d,a ; copy argument
corf1: move b,d ; PMAP arg: process handle,,page no.
hrli b,.fhslf ; ...
seto a, ; PMAP arg: source of -1 to unmap
pmap ; remove one page
aobjn d,corf1
popae p,[d,b] ; restore ACs
return
} ; IFN 10X
IFN TINT\SINT,{
frcv: rrcv:
return
}
IFE TINT\SINT,{
IFN TNX,{
mvar acblk(20)
; FRCV - Freeze receive fork.
frcv: skipn a,rcvfrk ; FFORK arg: A = fork handle
return ; there might not be a receive fork
ffork ; freeze fork
; RFACS arg: A = fork handle
movei b,acblk ; RFACS arg: B = AC block address
rfacs ; read fork ACs
irp x,,[f,nv,nh,v,h]
move x,acblk+x ; get interesting ACs from inferior
termin
return
; RRCV - Resume receive fork.
rrcv:
irp x,,[f,nv,nh,h,v]
movem x,acblk+x ; pass interesting ACs back to inferior
termin
move a,rcvfrk ; SFACS arg: A = fork handle
movei b,acblk ; SFACS arg: B = address of AC block
sfacs ; set fork ACs
; RFORK arg: A = fork handle
rfork ; resume fork
return
} ; IFN TNX
} ; IFE TINT\SINT
IFN ITS&NET,{
$$ARPA==1 ; support both Arpa and Chaos nets
$$CHAOS==1 ; ...
$$HOSTNM==1
$$SYMLOOK==1
$$ICP==1
$$HSTSIX==1
$$ANALYZE==1
T==:T1 ; define NETWRK ACs
TT==:T2 ; ...
.XCREF T,TT
.INSRT SYSTEM;CHSDEF >
.INSRT SYSENG;NETWRK >
} ; IFN ITS&NET
subttl Part II - UUOs, Interrupts, I/O, etc.
subttl UUO dispatch
tmploc 41,{
call uuoh ; UUO handler
}
; UUOH - UUO handler.
uuoh: ldb t1,[$opcod,,40] ; get opcode
caig t1,nuuo ; ensure within bounds
jrst @uuotab(t1) ; dispatch if so
IFN ITS,{
iluuo: .suset [.sipirqc,,[%piilo]] ; give illegal operation interrupt
return ; if we're continued just ignore UUO
} ; IFN ITS
IFN TNX,{
iluuo: pushae p,[a,b] ; save ACs
movei a,.fhslf ; IIC arg: A = fork handle
movx b,1_<35.-.icili> ; IIC arg: B = channel mask
iic ; give illegal instruction interrupt
popae p,[b,a] ; restore ACs
return ; if we're continued just ignore UUO
} ; IFN TNX
uuotab: iluuo ; opcode 0 - illegal
utyo ; opcode 1 - one or two character typeout
utyn ; opcode 2 - TYO n times
uzout ; opcode 3 - ASCIZ typeout
uzoutn ; opcode 4 - ZOUT n times
upad ; opcode 5 - padding UUO
utyoan ; opcode 6 - TYOANS -- ANSI sequence UUO
utynan ; opcode 7 - TYNANS -- ANS sequence UUO with
; argument
IFN TNX, ujerr1 ; opcode 10 - error reporting UUO
.ELSE iluuo
iluuo ; opcode 11 - unassigned UUO (for patching)
nuuo==:.-uuotab
; UUO Opcode definition
tyo=:1_27. ; TYO is opcode 1
tyn=:2_27. ; TYN is opcode 2
zout=:3_27. ; ZOUT is opcode 3
zoutn=:4_27. ; ZOUTN is opcode 4
pad=:5_27. ; PAD is opcode 5
tyoans=:6_27. ; TYOANS is opcode 6
tynans=:7_27. ; TYNANS is opcode 7
ifn tnx, jerr1=:10_27. ; JERR1 is opcode 10
.xcref tyo,tyn
IFN ITS,{ ; define how UUOs reference AC and E
..u001==:0 ; TYO - EA
..u002==:0 ; TYN - EA
..u005==:1 ; PAD - C(EA)
..u006==:0 ; TYOANS - EA
..u007==:0 ; TYNANS - EA
} ; IFN ITS
subttl Interrupt vectoring
IFN ITS,{
ftl%pi==%pipdl+%pimpv+%piilo+%pilos+%pipar
; define fatal interrupts:
; PDL Overflow, Memory Protect Violation,
; Illegal Operation, .LOSE, parity error
lipdl==7*5 ; enough for 7 levels
mvar ipdl(lipdl) ; Interrupt stack
mvar intpdp ; Interrupt stack pointer
tmploc 42,{
-lintblk,,intblk ; new interrupt vectoring
}
SECTION MAINVAR ; switch to impure so can clobber TTYVEC and
; STYVEC
intblk: intpdp ; stack pointer (separate from P!)
; Synchronous interrupts:
ftl%pi ? 0 ; fatal interrupts
-1 ? -1 ; defer everything
ftlint
%piioc ? 0 ; IOC error (on disk channel maybe)
-1 ? -1 ; may be fatal, so defer everything
iocint
%pitty ? 0 ; trying to use TTY and don't have it
-1 ? -1 ; defer everything
detint
; Asynchronous interrupts:
0 ? 1_tyic ; terminal input interrupts
%pirlt+%piaty ? 1_tyic+1_pyi ; defer STY input interrupts and self
; (this includes realtime interrupts)
ttyvec: ttyivi ; TTY input interrupt vector
%pirlt ? 0 ; realtime interrupts
%pirlt+%piaty ? 1_tyic+1_pyi ; defer same stuff as terminal input
rltvec: rltint ; realtime interrupt vector
0 ? 1_pyi ; STY input interrupts
%piaty ? 1_pyi ; defer self
styvec: styivi ; initial dispatch; clobbered.
%piaty ? 0 ; screen smashed
%piaty ? 1_pyi ; defer self and output
piaty
lintblk==.-intblk
SECTION MAIN
dismis: $call dismis,intpdp ; dismiss interrupt
.lose %lssys
} ; IFN ITS
IFN TNX,{
; LEVTAB - Table indexed by priority minus 1 to get place to store PC.
levtab: lev1pc ; level 1: errors (highest priority)
lev2pc ; level 2: TTY input
lev3pc ; level 3: PTY input (lowest priority)
mvar lev1pc,lev2pc,lev3pc
; CHNTAB - Table indexed by channel no. LH of each word is priority level
; for that channel. The RH contains the address of the interrupt routine.
; CHNTAB is set up at initialization.
mvar chntab(36.)
ife tint\sint, iftlev==:1 ; priority level for .ICIFT interrupts
IFN TINT,{
timchn==:0 ; timer interrupts (same level as TTY
; interrupts)
ttychn==:1 ; channel no. for TTY interrupts
ttylev==:2 ; priority level for TTY interrupts
if2 ttyvec==:chntab+ttychn ; clobber TTYVEC to redirect TTY input
; interrupts
} ; IFN TINT
IFN STY&SINT,{
ptychn==:2 ; channel no. for PTY interrupts
; PTYCHN is output interrupt channel (unused),
smichn==:ptychn+1 ; PTYCHN+1 is input interrupt channel
ptylev==:3 ; priority level for PTY interrupts
if2 styvec==:chntab+ptychn+1 ; clobber STYVEC to redirect STY input
; interrupts
} ; IFN STY&STINT
IFN ARPA,{
inschn==:2 ; channel no. for INS/INR interrupts
inslev==:3 ; priority level for INS/INR interrupts
netchn==:3 ; channel no. for network state changes
netlev==:1 ; priority level for network interrupts
} ; IFN ARPA
IFN CHAOS&SINT,{
ntichn==:3
smichn==:ntichn
ntilev==:3
if2 styvec==:chntab+ntichn ; clobber STYVEC to redirect STY input
; interrupts
} ; IFN CHAOS&SINT
ticspm==:60.*1000. ; no. of timer ticks per minute
dismis: debrk
; TNXHNG - crock to poorly simulate .HANG
tnxhng: push p,a
sleep 10 ; sleep for a sec.
pop p,a
sos (p) ; return to instr prev. to call
return
} ; IFN TNX
subttl Miscellaneous interrupt handlers
IFN ITS,{
mvar iocvec ; address of IOC error handler
; %PIIOC interrupt, probably on disk channel.
iocint: skipe iocvec ; IOC handler exist?
$call dismis,[intpdp,iocvec] ; yes, jump to it
; fall through to FTLINT
; Fatal interrupts - MPV, PDL OV, etc.
; It's up to chance whether the following msg will be seen by
; the screwed up luser, but we'll try anyway...
ftlint:
IFN STY,{
jsr detsty ; detach tree connected to STY
}
stro tyoc,"
Ugh! CRTSTY hit a fatal interrupt... please mail details (how you did
it, etc.) to BUG-CRTSTY@MC.
"
.value ; and lose, badly. Leave job around.
; %PITTY interrupt - come here when try to use non-ex TTY.
; Probably indicates job has been detached.
detint: skipge @suppro ; top-level?
jrst detin1 ; yes, detach tree connected to STY and logout
;; We're not top-level so we shouldn't have gotten the interrupt
;; (%PITTY is only enabled for top-level CRTSTYs). Perhaps we've
;; been reowned??
.suset [.sipirqc,,[%pitty]] ; let superior figure it out
jrst dismis ; ...
;; We're top-level and trying to use a non-existant TTY.
detin1:
IFN STY,{
jsr detsty ; detach tree connected to STY if possible
; fall through to LOGOUT
}
logout: .logout ; logout if top-level
skiple debug
.value [asciz /: Debug halt
/]
.logout 1,
IFN STY,{
; DETSTY - routine to detach STY if possible.
SECTION MAINVAR
detsty: 0 ? jrst detst0 ; called via JSR.
SECTION MAIN
detst0: $call detach,#pyi,,#4 ; detach tree connected to STY and kill
; it if no action within an hour
jfcl ; ok if error (e.g. no job at other end)
jrst @detsty
}
clkfrm==5*60. ; no. of 60ths per clock tick
ticspm==60.*60./clkfrm ; no. of ticks per minute for ALARM
mvar ltime ; time of last tick
mvar rsttim ; -1 if we should do a .REALT to reset our
; clock rate.
; RLTINT - Standard realtime interrupt handler (realtime interrupts are
; vectored to TYIRLT when a terminal input timeout is needed). Realtime
; interrupts serve two purposes: (1) for periodic checks of detachment,
; and (2) to implement the ALARM feature.
rltint:
;; Check to see if top-level and detached. If so, act as if a
;; %PITTY interrupt happened; i.e. detach tree connected to STY
;; and logout.
skipl @aprc ; detached?
jrst rlti1 ; no
skipge @suppro ; detached, top-level?
jrst detin1 ; detached and top-level, do %PITTY stuff
;; Not detached and top-level. Hack ALARM stuff.
rlti1: push p,a ; save AC
move a,@time ; get time of this tick
movem a,ltime ; remember it for later
skipe rsttim ; maybe reset time
jrst [ move a,[600000,,[clkfrm]] ; yes, reset to normal
.realt a,
setzm rsttim ; note we've reset
jrst .+1 ]
; Check for ALARM timeout.
move a,ofeptm ; Get old countdown
came a,feeptm ; Same as current?
move a,feepmx ; No, TYI or SMO interfered, so reset to max.
sosge a ; OK, count down some more.
seto a, ; canonicalize over-run to -1.
movem a,feeptm ; and set new count-down,
movem a,ofeptm ; saving copy for check next time.
IFN STY,{
move a,whotim
camg a,@time
.suset [.siifpir,,[1_pyi]]
} ; IFN STY
pop p,a ; restore AC
jrst dismis
; %PIATY interrupt.
piaty: call redisp ; REDISP bashes registers, but that's ok
; because all other interrupts defer %PIATY
; and nothing is happening at main program
; level
jrst dismis
} ; IFN ITS
IFN TNX,{
IFE TINT\SINT,{
; .ICIFT interrupt handler.
iftint: push p,a ; save AC
push p,b
push p,c
ifn CHAOS,{
move a,smojfn ;GDSTS arg: A = File Handle
gdsts ;Check to see if Chaos connection still there
jumpe b,chbrk1 ;Nope, we gone.
} ;ifn CHAOS
hrrz a,rcvfrk ;get receive fork handle
rfsts ;read the status
tlnn a,2 ;voluntary termination?
jrst iftin1 ;nope, then let it go...
hrroi a,[asciz "Inferior fork unexpectedly terminated."]
esout
pop p,c
pop p,b
pop p,a ; restore AC
haltf
jrst .-1
iftin1: pop p,c
pop p,b
pop p,a
jrst dismis
} ;IFE TINT\SINT
; JERR1 uuo - report error with error code in A.
ujerr1: pushae p,[a,b,c] ; save ACs
move b,a ; save error code
hrro a,40 ; ESOUT arg: A = string pointer
esout ; output argument to UUO
movei a,.priou ; ERSTR arg: A = JFN
hrli b,.fhslf ; ERSTR arg: B = fork handle,,error code
movei c,0 ; ERSTR arg: C = byte count,,0
erstr ; output error message
jfcl ; return1: undefined error code
jfcl ; return2: string size out of bounds, or bad
; JFN
popae p,[c,b,a] ; restore ACs
haltf ; stop
jrst .-1
logout: skipg debug
reset
haltf
jrst .-1
chalos: jumpe b,chbrok ;If zero, BIN detected EOF
movei a,.fhslf ;GETER arg: A = fork handle
GETER ;get the last error message
hrrzm a,a ;Clear AC left
caie a,IOX4 ;Hit EOF packet from chaos?
jerr1 [asciz "Chaos Net trouble - "] ;Nope, must be fairly fatal
chbrok: ;Reached EOF, time to punt.
IFE TINT\SINT, call frcv ;If we have a receiver fork, freeze it
chbrk1: move a,[ascnt "Host broke connection"]
call ascout ;Inform user
pjrst quit ;quit.
IFN ARPA,{
; INS/INR interrupts.
insint: aosle inscnt
setom supres
debrk
; Network state change interrupts.
netint: pushae p,[a,b,c,d]
move a,smojfn
gdsts
lsh b,-40
caie b,7
jrst [ call frcv
move a,[ascnt "Host broke connection"]
call ascout
pjrst quit ]
popae p,[d,c,b,a]
debrk
} ; IFN ARPA
} ; IFN TNX
subttl TTY Output
SECTION INIT
ttyoin: skipn a,ospeed ; get output speed in bits per second
movei a,9600. ; assume 9600
cain a,110. ; 110 bps?
movei a,100. ; yes, fix so will be 10cps
idivi a,10. ; convert from BPS to CPS
movem a,speed ; save cps in SPEED
; Initialize terminal output
skipn b,buffmx ; Buffer size already specified?
move b,speed ; no, get # chars at a time to allow.
caile b,obufmx ; force down to fit if too big.
movei b,obufmx
caig b,5 ; likewise force up if too small.
movei b,5
movem b,obuflm ; establish this as output buff limitation.
movem b,obufct ; Set up cnt for obuff.
IFN ITS,{
move a,[squoze 0,TOBS] ; Find max # chars in ITS output buffer
.eval a,
.lose %lssys
lsh b,-1 ; get .5 of our buff limit
subi a,(b) ; and find # chars TORM will indicate
; when ITS has obuflm/2 chars buffered.
movem a,tormin ; Store as minimum TORM to output on.
} ; IFN ITS
move a,[441000,,obuff] ; initialize output buffer pointer
movem a,obufpt ; ...
.i padc=177 ; initialize pad character
; terminal output initialized, ready to go
return
SECTION MAIN
; BUFC buffers a character for output to the terminal.
; A contains the character to output. No ACs are clobbered.
bufc:
ifn histohack,{
move t1,a
andi t1,377
aos counts(t1)
}
idpb a,obufpt ; put character into output buffer
sosle obufct ; buffer full?
return ; no, we're done
pjrst obfsnd ; yes, send buffer
mvar obufpt ; BP for depositing into buffer
mvar obufct ; # of chars still free in buffer
mvar obuflm ; # chars of buffer to be used.
obufmx==250. ; max size of buffer
mvar obuff(<obufmx+3>/4+1)
; OBFSND - Empty our output buffer.
IFN ITS,{
; Note that the ITS symbol TOBS => max chars in output buffer
; currently has value of 260. (404 octal)
obfsnd: move t2,obuflm ; Compare initial count with current, to
sub t2,obufct ; make sure something to output...
jumple t2,[return] ; Nope.
move t1,tormin ; Get # minimum chars room in ITS output
caml t1,@torm ; buffer to wait for, and wait..
.hang ; until TORM attains minimum.
move t1,[441000,,obuff] ; pointer to beginning of buffer
movem t1,obufpt ; reset B.P.
addm t2,obufct ; reset count
$call siot,[#tyoc,t1,t2] ; Send!
.lose %lsfil
return
mvar tormin ; minimum no. characters in ITS output buffer to hang on
} ; IFN ITS
IFN TNX,{
obfsnd: push p,c
move c,obufct
sub c,obuflm
jumpe c,obfs1
push p,a
push p,b
move a,ttyjfn
move b,[441000,,obuff]
movem b,obufpt ; reset BP here
sout
move c,obuflm
movem c,obufct ; reset count
pop p,b
pop p,a
obfs1: pop p,c
return
} ; IFN TNX
; FINISH - Wait until output reaches terminal. Maybe it should call
; OBFSND first??
IFN ITS,{
finish: $call finish,#tyoc
.lose %lsfil
return
} ; IFN ITS
IFN TNX,{
finish: push p,a ; save AC
move a,ttyjfn ; DOBE arg: JFN
dobe ; dimiss until output buffer empty
pop p,a ; restore AC
return
} ; IFN TNX
subttl TTY output UUOs
; UUO to output an ASCIZ string. The effective address is a ptr to an ASCIZ
; string of 7 bit bytes which are output.
uzout: push p,a ; save ACs
push p,b ; ...
move b,40 ; get effective address of UUO:
; ptr to asciz str
hrli b,440700 ; convert ptr to BP
ildb a,b ; get first character of string
jumpe a,uz2 ; terminate on zero byte
uz1: call @.trtyo+tb ; output character
ildb a,b ; get next character of string
jumpn a,uz1 ; terminate on zero byte
uz2: pop p,b ; restore ACs
pop p,a ; ...
return
; UUO to output an ASCIZ string N times. The effective address is a ptr to
; an ASCIZ string of 7 bit bytes which are output. A contains N.
uzoutn: jumpe a,[return]
push p,a ; save ACs
push p,b ; ...
push p,c ; ...
move c,a
uzn1: move b,40 ; get effective address of UUO:
; pointer to asciz string
hrli b,440700 ; convert ptr to BP
ildb a,b ; get first character of string
jumpe a,uzn3 ; terminate on zero byte
uzn2: call @.trtyo+tb ; output character
ildb a,b ; get next character of string
jumpn a,uzn2 ; terminate on zero byte
sojg c,uzn1
uzn3: pop p,c ; restore ACs
pop p,b ; ...
pop p,a ; ...
return
; Character output UUO:
; TYO <immediate value> - The 18 bit address is considered to be
; two 9-bit fields, each of which will be output to the TTY
; in unit mode. If the first is 0, only the second (rightmost)
; field will be sent.
tyoesc=tyo+<33_9.> ; TYOESC CH sends a 033 before sending CH.
tyo16=tyo+<16_9.> ; TYO16 CH sends a 016 before sending CH.
tyo174=tyo+<174_9.> ; TYO174 CH sends a 174 before sending CH.
tyo176=tyo+<176_9.> ; TYO176 CH sends a 176 before sending CH.
.xcref tyoesc
utyo: push p,a ; save AC
hrrz a,40 ; get effective address of UUO:
; one or two bytes to output
trnn a,777000 ; is high byte nonzero?
jrst utyo1 ; no, goto BUFC to output low byte
rot a,-9. ; nonzero high byte, rotate to make it low
call @.trtyo+tb ; output high byte
rot a,9. ; restore low byte
utyo1: call @.trtyo+tb
pop p,a ; restore AC
return
tynesc=tyn+<33_9.> ; TYNESC CH sends a 033 before sending CH.
tyn16=tyn+<16_9.> ; TYN16 CH sends a 016 before sending CH.
tyn174=tyn+<174_9.> ; TYN174 CH sends a 174 before sending CH.
tyn176=tyn+<176_9.> ; TYN176 CH sends a 176 before sending CH.
.xcref tynesc
; UUO to output its effective address as one or two bytes N times. N is
; passed in A (which UUOH saves on the stack and then clobbers).
utyn: push p,a ; save ACs
push p,b ; ...
skipn b,a ; pick up numeric argument
jrst utyn3 ; do nothing in N=0
hrrz a,40 ; get effective address of UUO
utyn1: trnn a,777000 ; is high byte nonzero?
jrst utyn2
rot a,-9. ; nonzero high byte, rotate to make it low
call @.trtyo+tb ; output high byte
rot a,9. ; restore low byte
utyn2: call @.trtyo+tb ; output low byte
sojg b,utyn1 ; do N times
utyn3: pop p,b ; restore ACs
pop p,a ; ...
return
mvar padc ; pad character
; PAD - Send padding characters.
upad: move t1,@40 ; get no. of seconds to pad for
push p,a ; save ACs
push p,b ; ...
fltr a,speed ; get no. of characters output in a second
fmpr a,t1 ; get no. of pad chars
IFN KA,{
muli a,400 ; fix
ash b,-243(a) ; ...
}
IFE KA,{
fix b,a
}
jumpe b,upad2 ; return if no padding required
upad1: move a,padc ; type pad character
call @.trtyo+tb ; ...
sojn b,upad1
upad2: pop p,b ; restore ACs
pop p,a ; ...
return
; TYODEC - Output decimal no.
; Argument:
; A No. (unchanged)
tyodec: push p,a ; save argument
call tyod1 ; output no., clobbering argument
pop p,a ; restore argument
return
tyod1: push p,b ; save AC
idivi a,10. ; get last digit
jumpe a,.+2 ; if other digits zero then just print last
call tyod1 ; print other digits
movei a,"0(b) ; convert to ASCII
pop p,b ; restore AC
pjrst @.trtyo+tb ; print digit
utyoan: push p,a ; save AC
movei a,33
call @.trtyo+tb
movei a,"[ ; ]
call @.trtyo+tb
hrrz a,40 ; get effective address of UUO: termination
; character of ANS sequence
call @.trtyo+tb
pop p,a ; restore AC
return
utynan: push p,a ; save AC
movei a,33
call @.trtyo+tb
movei a,"[ ; ]
call @.trtyo+tb
move a,(p)
caie a,1
call tyodec
hrrz a,40 ; get effective address of UUO: termination
; character of ANS sequence
call @.trtyo+tb
pop p,a ; restore AC
return
subttl TTY Input
ifn tnx, mvar icmask ; input character mask
; TBIN - Get next TTY input character; -1 if none.
; Arguments:
; None
; Result:
; A Character
IFN ITS,{
tbin: .iot tyic,a
return
} ; IFN ITS
IFN TNX,{
IFN TINT, mvar tbinlc ; Save last input char for ridiculous
; crock to get around outrageous SIBE bug.
tbin: push p,b ; save AC
move a,ttyjfn ; SIBE arg: A = JFN
sibe ; TTY input available?
jrst [ ; BIN arg: A = JFN
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;; CROCKLUDGECROCKLUDGECROCKLUDGE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
IFN TINT,{ cain b,15 ; CROCK CROCK If "# chars available"
came b,tbinlc ; happens to = ^M which is = last char,
caia
jrst [seto a, ; Then totally ignore!
pop p,b ? return]
}
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
bin ; get input character
IFN TINT, movem b,tbinlc ;;;;;;;;;;;;;;;;;;;;;CROCKCROCKCROCK
move a,b ; result: character
and a,icmask ; AND with either 177 or 377
pop p,b ; restore AC
return ]
IFE TINT,seto a, ; no TTY input, return -1
IFN TINT,setob a,tbinlc ; CROCKCROCK
pop p,b ; restore AC
return
} ; IFN TNX
; TBINW - Get next TTY input character. Waits if no input available.
; Arguments:
; None
; Result:
; A Character
IFN ITS,{
tbinw: $call iot,[#tyic,a][][#%tinwt]
.lose %lsfil
return
} ; IFN ITS
IFN TNX,{
tbinw: push p,b ; save AC
move a,ttyjfn ; BIN arg: A = JFN
bin ; input character from TTY
move a,b ; return character in A
and a,icmask ; AND with 177 or 377
pop p,b ; restore AC
return
} ; IFN TNX
subttl STY Output
; SBOUT - Output character to pseudo TTY.
; Argument:
; A Character.
IFN ITS,{
sbout: .iot pyo,a ; output character to STY
ifn net,.nets pyo,
return
} ; IFN ITS
IFN TNX,{
sbout: pushae p,[a,b] ; save ACs
move b,a ; BOUT arg: byte
move a,smojfn ; BOUT arg: JFN
bout ; output character to PTY
IFN NET,{
; MTOPR arg: A = JFN
movei b,.mosnd ; MTOPR arg: B = function code
mtopr ; send bytes buffered so far
} ; IFN NET
popae p,[b,a] ; restore ACs
return
} ; IFN TNX
; SMOFRC
IFE NET,{
smofrc: return
}
IFN NET,{
IFN ITS,{
smofrc: .nets pyo,
return
} ; IFN ITS
IFN TNX,{
smofrc: pushae p,[a,b]
move a,smojfn
movei b,.mosnd
mtopr
popae p,[b,a]
return
} ; IFN TNX
} ; IFN NET
subttl TTY input co-routine
ltyipdl==35. ; terminal input co-routine PDL length
mvar tyipdl(ltyipdl) ; terminal input co-routine PDL
; TYIPUF - Address pushed onto top of stack to catch over POPJing.
IFN ITS,{
tyipuf: .suset [.sipirqc,,[%pipdl]]
jrst tyipuf
}
IFN TNX,{
mvar sava(2)
tyipuf: dmovem a,sava
movei a,.fhslf
movx b,1_<35.-.icpov>
iic
jrst .-1
}
IFE TINT,{
; TYIINI - Initialize terminal input co-routine.
tyiini: move p,[-ltyipdl,,tyipdl-1]
push p,[tyipuf]
jrst @.trtyi+tb
TYIGET==:TBINW
tyitog: call tbin
jumpge a,[return]
sleep 2 ; 1/5 second
pjrst tbin
} ; IFE TINT
IFN TINT,{
mvar tyip ; terminal input co-routine PDL pointer
; TTYIVI - First TTY input interrupt comes here. Initializes
; TTY input interrupt vector and TTY input co-routine.
ttyivi: pushae p,[a,t1,t2] ; must do same things as TTYINT here
movem p,tyip ; save current PDL pointer
move p,[-ltyipdl,,tyipdl-1] ; set up terminal input co-routine
; PDL pointer
push p,[tyipuf] ; hack to catch over POPJing
movei t1,ttyint ; set TTY input interrupt vector
skipe feepmx ; to TTYINT if not feeping and TTYINF
movei t1,ttyinf ; if feeping
hrrm t1,ttyvec ; ...
jrst @.trtyi+tb ; and off we go to TYI co-routine.
; TTYINF/TTYINT - entry points for TTY input interrupt.
; Note that the handler actually triggers co-routines!
ttyinf: aos feeptm ; reset feep timer
ttyint: pushae p,[a,t1,t2] ; save ACs
exch p,tyip ; switch to input co-routine stack
; fall through to TYIGET
; TYIGET - Called by TTY input co-routine to get next character.
; If no character is available TYIGET dismisses and will be re-
; entered by an input interrupt when the next character is typed.
tyiget: call tbin ; read next character, if any
jumpge a,[return] ; go one, return it
; no more input, dismiss input interrupt
exch p,tyip ; switch back to old stack
popae p,[t2,t1,a] ; restore ACs
jrst dismis
; TYIRLT - Timer interrupt handler when hacking time outs on terminal input.
tyirlt: pushae p,[a,t1,t2] ; save ACs, must be the same as in TTYINT!!
exch p,tyip ; switch to terminal input co-routine
seto a, ; return -1 from TYIGET to indicate timeout
return ; happened
; TYITOG - Get a character like TYIGET, but return -1 if the character
; doesn't arrive within 1/6 of a second.
IFN ITS,{
tyitog: movei a,tyirlt ; set %PIRLT handler to our routine to hack
movem a,rltvec ; timeouts
move a,[600000,,[10.]] ; timeout in 1/6 second
.realt a,
call tyiget ; get character
move t1,ltime ; get previous time
sub t1,@time ; -1*<time since last ran feep counter>
addi t1,clkfrm ; A gets time to go in current feep frame
jumple t1,tyito1 ; if time is here or past, do it now!
move t2,[600000,,t1] ; interrupt at that new time
.realt t2,
setom rsttim ; flag to return to normal rate after next tick
jrst tyito2
tyito1: .suset [.sipirqc,,[%pirlt]] ; give the interrupt
move a,[600000,,[clkfrm]] ; restore the normal timing
.realt a, ; ...
tyito2: movei t1,rltint ; set %PIRLT handler back to feep handler
movem t1,rltvec ; ...
return
} ; IFN ITS
IFN 20X,{
.timel==:1
.timal==:5
tyitog: move a,[.fhslf,,.timel] ; TIMER arg: A = fork handle,,function code
movei b,167. ; TIMER arg: B = milliseconds until interrupt
movei c,timchn ; TIMER arg: C = channel no.
timer ; give interrupt in 1/6 second
jerr1 [asciz "Error setting timeout - "]
call tyiget ; get character
push p,a ; save character
move a,[.fhslf,,.timal] ; TIMER arg: A = fork handle,,function code
movei c,timchn ; TIMER arg: C = channel no. (stupid system
; checks channel even when not used)
timer ; remove pending timer requests
jerr1 [asciz "Error clearing timeout - "]
pop p,a ; restore character
return
} ; IFN 20X
} ; IFN TINT
; TYIPUT - Terminal input subroutine to hand a character to the simulator
; output co-routine.
; Argument:
; A Character (with %TX bits?).
; TYIPUC - Variant which checks for "command escape" char before
; passing along to SMO.
tyipuc: camn a,cmdchr ; Entry point to check for cmd char
pjrst enter ; Aha, a command! Go do it.
tyiput: exch p,smop ; save terminal input co-routine PDL pointer
; and restore simulator output co-routine PDL
; pointer
return ; return from SMOGET call
mvar cmdchr ; command character
subttl Simulator output co-routine
lsmopdl==25. ; simulator output co-routine PDL length
mvar smop ; simulator output co-routine PDL pointer
mvar smopdl(lsmopdl) ; simulator output co-routine PDL
SECTION INIT
; SMOINI - Set up simulator output co-routine.
smoini: movem p,smop ; save our PDL pointer
move p,[-lsmopdl,,smopdl-1] ; set up simulator output co-routine
; PDL pointer
push p,[smopuf] ; hack to catch over POPJing
pjrst @.trsmo+tb ; start simulator output co-routine
; (control returns to our caller when the
; the co-routine does CALL SMOGET to get
; the first terminal input character)
SECTION MAIN
IFN ITS,{
smopuf: .suset [.sipirqc,,[%pipdl]]
jrst smopuf
}
IFN TNX,{
smopuf: dmovem a,sava
movei a,.fhslf
movx b,1_<35.-.icpov>
iic
jrst .-1
}
; SMOGET - Simulator output subroutine to get a character from the terminal
; input co-routine.
; Value:
; A Character (with %TX bits?).
smoget: exch p,smop ; save simulator output co-routine PDL pointer
; and restore terminal input co-routine PDL
; pointer
return ; return from TYIPUT call
subttl STY input interrupt handler (output to TTY)
comment |
Note carefully that the PDL is set up during SETUP, before
interrupts are turned on, to point at a STYINC macro invocation within
an input loop routine.
As far as the STY input side is concerned, interrupts and
dismisses all take place inside STYIN5/STYINT. Anything at main
program level or anothr interrupt loop must not clobber the return
address on the PDL! STY input interrupt level, however, need not
worry about saving anything, since it is the most heavily invoked
and the burden of AC saving is thereby decreed to rest upon all other
interrupt levels.
Interrupts are vectored to STYINT normally, to STYINF if
the ALARM option was requested by user.
|
IFN SINT,{
; STYIVI - PYI initial interrupt vector dispatch & initialization.
styivi: setzm ibufct ; Ensure that first STYINC will ask for chars.
IFN ITS&NET,{
movei t1,arpint
skipe chaosp
movei t1,chaint
}
IFN TNX&CHAOS,{
movei t1,chaint
}
IFE NET,{
movei t1,styint
}
skipe feepmx
movei t1,styinf
hrrm t1,styvec
jrst @.trsmi+tb ; and off we go into SMI loop!
styinf: aosg feeptm ; Bump feep timer and check it...
call td.bel ; Uh-oh, timed-out and must feep.
jrst styint
}; IFN SINT
IFN ITS,{
IFN STY,{
styint: move t1,ibufip ; 8-bit BP pointing to start of buffer
movem t1,ibufpt
movei a,ibufln
$call siot,[#pyi,t1,a]
.lose %lsfil
subi a,ibufln-1 ; Find -<#-1> chars read.
jumpg a,styin5 ; jump out if none read.
movnm a,ibufct ; else store magnitude,
return ; and return, letting macro ILDB char.
; Note that on return, IBUFCT will actually hold
; one less than actual # chars in buffer, to simulate
; the SOSGE that we bypassed.
; STYIN5 is called by the STYINC macro when the buffer
; becomes empty. It "invokes" STYINT to read more chars from
; the system's buffer if any exist there, and tries hard to avoid
; dismissing (i.e. finalizing) too quickly.
styin5: skipl @ttyoac ; our buffer's empty; is system's?
jrst styint ; no, gobble more from it.
call obfsnd ; Empty - force out our stuff so far,
skipa ? skipa ? .hang ; and block momentarily.
skipl @ttyoac ; Still empty?
jrst styint ; no, hurray!
move t1,whotim
camg t1,@time
call whoout
call @.trsmf+tb ; Sigh, empty, finalize
jrst dismis
} ; IFN STY
IFN NET,{
styin5: styint:
skipe chaosp ; chaosnet?
jrst chaint ; yes, hack it
; the above should be replaced by changing the interrupt vector to point to
; either ARPINT or CHAINT.
arpint: $call whyint,[#pyi][t1,t1,t2]
.lose %lsfil
jumpl t1,[
tlz t1,400000
.reset pyi, ; tell system to forget INS
aosle inscnt
setom supres
jrst .+1 ]
caie t1,%nsinp ; input available
cain t1,%nscli ; CLS received, data available for input
jrst styin6
cain t1,%nsopn ; no input?
jrst styin7 ; nope
cain t1,%nscls ; closed
.lose 0 ; yes, tell loser
.lose 0
styin6: jumpn t2,styin9 ; %NSINP and no input??
styin7: call @.trsmf+tb
jrst dismis
chaint: $call whyint,[#pyi][t1,t1,t2]
.lose %lsfil
hlrz t2,t2 ; get input packet count
cain t1,%csopn ; connection open?
jrst styin8 ; yes, get input
caie t1,%cscls
cain t1,%cslos
sojg t2,styin8 ; get input unless only LOS or CLS
; jrst netlzi ; connection not open, go analyze
netlzi: $call open,[#tyon,[sixbit/tty/]][][#.uao]
.lose %lssys
movei a,pyi
jrst netluz
styin8: jumpe t2,styin7 ; if no input, don't do anything
movei t2,ibufln ; on chaosnet, ask for bufferful and use
; don't hang mode
styin9: move t1,ibufip ; 8-bit BP pointing to start of buffer
movem t1,ibufpt
movem t2,ibufct
$call siot,[#pyi,t1,ibufct][][#10] ; don't hang mode on chaosnet
.lose %lsfil
subm t2,ibufct
sos ibufct ; subtract one from IBUFCT to simulate the
; SOSGE that we bypassed.
return ; and return, letting macro ILDB char.
} ; IFN NET
; STYIP - Peek at next character in STY input buffer.
; Result:
; A character; -1 if none.
IFN STY,{
styip: skipg ibufct
jrst [ skipge a,@ttyoac
return
call styint
aos ibufct ; undo SOS done in STYINT!
jrst .+1 ]
move a,ibufpt
ildb a,a
return
} ; IFN STY
IFE STY,{
styip: skipg ibufct
jrst [ seto a,
return ]
move a,ibufpt
ildb a,a
return
} ; IFE STY
; STYINC - Get-char macro. If nec, slurp in a bufferfull to process.
; Note that, because it may invoke STYIN5 which can invoke
; various screen finalizations, no AC can be considered truly safe
; where STYINC appears.
define styinc ac
sosge ibufct ; See if characters left
call styin5 ; No, must slurp another bufferfull.
ildb ac,ibufpt ; some left, get character
termin
} ; IFN ITS
IFN TNX&<1-SIBEBUG>,{
ifn chaos, chaint: ;entry point for chaos "interrupt" and
styint: ;psuedo-tty "interrupt".
IFE STY,{
move a,smijfn ; SIBE arg: JFN
sibe
jrst styi1
} ; IFE STY
IFN STY,{ ; SIBE always skips on PTY channels!
move a,ptyttd
sobe
jrst styi1
move a,smijfn
} ; IFN STY
; call obfsnd
; dobe
; sibe
; jrst styi1
call @.trsmf+tb
IFN SINT,{
debrk
}; IFN SINT
IFE SINT,{
move a,smijfn
bin
IFN CHAOS, erjmp chalos
move a,ibufip
movem a,ibufpt
idpb b,a
setzm ibufct
return
}; IFE SINT
styi1:
ifn sty,move a,smijfn
caile b,ibufln
movei b,ibufln
movem b,ibufct
movn c,b
move b,ibufip
movem b,ibufpt
sin
IFN CHAOS, erjmp chalos
sos ibufct ; subtract one to simulate SOSGE that we
; bypassed
return
styip: skipg ibufct
jrst [ move a,smijfn
sibe
jrst [ call styi1
aos ibufct ; undo SOS IBUFCT in STYI1!
jrst styip1
]
seto a,
return
]
styip1: move a,ibufpt
ildb a,a
return
; STYINC - Get-char macro. If necessary, slurp in a bufferfull to process.
; Note that, because it may invoke STYINT which can invoke
; various screen finalizations, no AC can be considered truly safe
; where STYINC appears.
define styinc ac
sosge ibufct ; See if chars left
call styint ; No, must slurp another bufferfull.
ildb ac,ibufpt ; some left, get char
termin
} ; IFN TNX&<1-SIBEBUG>
IFE SIBEBUG,{
; CROCK LIVES HERE! Use 7-bit chars instead of 8-bit if
; TNX&STY, to avoid getting random 8th bit!!!
; Goddam fucking screwed-up TNX TTY "support"!!!
; Here is defined the "initial BP" into IBUFF.
SECTION MAINVAR
IFN TNX&STY, ibufip: 440700,,ibuff ; TNX&STY uses 7 bits for now
SECTION MAIN
IFE TNX&STY, ibufip: 441000,,ibuff ; else normal 8 bits.
mvar ibufct ; # chars left to read in buffer
mvar ibufpt ; 8-bit BP reading from buffer
ibufln==400. ; Length of buffer in 8-bit bytes.
mvar ibuff(<ibufln+3>/4)
} ; IFE SIBEBUG
IFN SIBEBUG,{
define styinc ac
call styixx
ifn ac-a, move ac,a
termin
styixx: skipl a,styirr
jrst [ setom styirr
return ]
move a,smijfn
sibe
jrst styix1
call @.trsmf+tb
move a,smijfn
styix1: bin
move a,b
return
styip: skipl a,styirr
return
move a,smijfn
sibe
jrst [ push p,b
bin
move a,b
movem a,styirr
pop p,b
return ]
seto a,
return
SECTION MAINVAR
styirr: -1
SECTION MAIN
} ; IFN SIBEBUG
; FPSET - Feep Set. Start ALARM feeping.
fpset: skipg t1,feepmx ; get time specified in ALARM option
movei t1,ticspm ; Default to 1 minute if unspecified.
movem t1,feeptm
movem t1,ofeptm
IFN TINT,{
movei t1,ttyinf ; Clobber TYI and SMO interrupt vectors.
hrrm t1,ttyvec
}
IFN SINT,{
movei t1,styinf
hrrm t1,styvec
}
return
; FPRSET - Feep Reset. Stop ALARM feeping.
fprset:
IFN TINT,{
movei t1,ttyint ; Reset TYI and SMO interrupt vectors.
hrrm t1,ttyvec
}
IFN SINT,{
movei t1,styint
hrrm t1,styvec
}
return
subttl Part III - Simulation
comment ~
Three kinds of window limits are used. The first set defines the terminal
screen. The lower limits are always zero and the upper limits are given by
SVMAX and SHMAX. These are set at start up and never changed. For
convenience SWIDTH and SHEIGHT are SHMAX-0+1 and SVMAX-0+1 respectively.
The second set defines the current "hardware" or "terminal" window. These
are TVMIN, THMIN, TVMAX, and THMAX. These are initialized to 0, 0, SVMAX,
and SHMAX. These are set every time a set window command is sent to the
terminal (only a few terminals have a set window command). For convenience
TWIDTH and THEIGHT are always THMAX-THMIN+1 and TVMAX-TVMIN+1 respectively.
Finally the third set is the current software window. It is what ITS (or
whatever) thinks the current window is. These are WVMIN, WHMIN, WVMAX, and
WHMAX. Thus a %TDEOL means erase from here to WHMAX. If WHMAX=THMAX then
the terminal's atomic CLEOL can be used to accomplish this. Otherwise the
%TDEOL will have to be simulated; using the terminal's CLEOL would clear out
to THMAX, which would be more than intended. For convenience WWIDTH and
WHEIGHT are always WHMAX-WHMIN+1 and WVMAX-WVMIN+1 respectively.
~
SECTION MAINVAR
sheight: block 1 ; screen height (no. lines on screen)
swidth: block 1 ; screen width (no. of characters per screen line)
smax:: ; SMAX refers to the pair SVMAX,SHMAX
svmax: block 1 ; maximum vertical screen position (SHEIGHT-1)
shmax: block 1 ; maximum horizontal screen position (SWIDTH-1)
tmin:: ; TMIN refers to the pair TVMIN,THMIN
tvmin: block 1 ; first line of terminal window
thmin: block 1 ; first column of terminal window
tmax:: ; TMAX refers to the pair TVMAX,THMAX
tvmax: block 1 ; last line of terminal window
thmax: block 1 ; last column of terminal window
theight: block 1 ; terminal window height (TVMAX-TVMIN+1)
twidth: block 1 ; terminal window width (THMAX-THMIN+1)
wmin:: ; WMIN refers to the pair WVMIN,WHMIN
wvmin: block 1 ; first line of window
whmin: block 1 ; first column of window
wmax:: ; WMAX refers to the pair WVMAX,WHMAX
wvmax: block 1 ; last line of window
whmax: block 1 ; last column of window
wheight: block 1 ; window height (WVMAX-VVMIN+1)
wwidth: block 1 ; window width (WHMAX-WHMIN+1)
wsave: block 4 ; save area for WVMIN,WHMIN,WVMAX,WHMAX
SECTION MAIN
subttl Screen Image
blchar==:40 ; "blank" char value
; Screen image tables and routines
SECTION INIT
; SCRINI - Initialize Screen image. This uses SHEIGHT and SWIDTH and so
; must be called after SETUP3.
scrini: pushae p,[a,b,c]
IFN ITS,{
move b,sheight ; get no. of lines
imul b,swidth ; multiply by width to get no. of characters
addi b,screen ; add in start of screen image
addi b,pg$siz-1 ; add PG$SIZ-1 to so LSH will round up
lsh b,-pg$log ; get last page no. needed
subi b,sipg ; get no. of pages needed
jumpe b,scini1
hrloi b,-1(b)
eqvi b,sipg ; now have page AOBJN
$call corblk,[#%cbndw,#%jself,b,#%jsnew]
.lose %lssys
} ; IFN ITS
scini1: movn a,sheight
hrlz a,a ; Set up aobjn for no. of lines.
move b,[screen(nh)]
move c,[screen(h)]
scini2: movem b,scrntb(a)
movem c,scrtab(a)
add b,swidth
add c,swidth
aobjn a,scini2 ; Fill out addresing table.
move a,swidth ; now get total # wds in screen-image buffer
imul a,sheight ; like so.
movem a,scrlen
addi a,screen-1 ; Find address of last word usd.
movem a,scrlst ; Store for BLT.
movei a,blchar ; clear first character position
movem a,screen ; ...
move a,[screen,,screen+1] ; clear rest of screen image
blt a,@scrlst ; ...
popae p,[c,b,a]
return
SECTION MAIN
; SCRDLF - Update screen image after a erase character operation.
scrdlf: movei t1,blchar
movem t1,@scrntb(nv)
return
; SCREOL - Update screen image after a CLEOL operation.
screol: push p,nh ; save horizontal position
movei t1,@scrntb(nv) ; pointer to current character position
movei t2,blchar ; clear current character position
movem t2,(t1) ; ...
hrli t1,(t1) ; make BLT AC of form address,,address+1
addi t1,1 ; ...
move nh,thmax ; pointer to last character position of line
movei t2,@scrntb(nv) ; ...
cail t2,(t1) ; already cleared whole line?
blt t1,(t2) ; no, clear rest of line
pop p,nh ; restore horizontal position
return
; SCREOS - Update screen image after a CLEOS operation.
screos: pushae p,[nv,nh] ; save current position
scres1: call screol ; erase to end of line
move nh,thmin ; move to beginning of line
camge nv,tvmax ; done?
aoja nv,scres1 ; no, move to next line and do erase again
popae p,[nh,nv] ; restore current position
return
; SCRICP - Update screen image after a insert characters operation.
; Argument:
; A No. of characters inserted.
scricp: jumple a,[return] ; NOP if no. of characters is zero
push p,nh ; save horizontal position
move nh,thmax ; start at end of line
scric1: sub nh,a ; move back by no. of characters inserted
; to get position of next character to move
camge nh,(p) ; passed point of insertion?
jrst scric2 ; yes, character movement done
move t1,@scrntb(nv) ; get next character
add nh,a ; add no. inserted to get its new position
movem t1,@scrntb(nv) ; and put it there
soja nh,scric1 ; backup and do some more
scric2: pop p,nh ; restore horizontal position
movei t1,@scrntb(nv) ; get pointer to first character position
movei t2,blchar ; clear first character position
movem t2,(t1) ; ...
caig a,1 ; only one character position to clear?
return ; yes, we're done
movei t2,1(t1) ; create BLT pointer of form addr,,addr+1
hrl t2,t1 ; ...
add t1,a ; add no. of characters to get stopping
; address
blt t2,-1(t1) ; clear inserted positions
return
; SCRDCP - Update screen image after a delete characters operation.
; Argument:
; A No. of characters deleted
scrdcp: jumple a,[return] ; NOP if zero characters deleted
push p,nh ; save horizontal position
; Copy characters
movei t1,@scrntb(nv) ; form BLT AC of form <curpos>+n,,<curpos>
add nh,a ; ...
hrli t1,@scrntb(nv) ; ...
move nh,thmax ; get pointer to last character position to
sub nh,a ; copy, i.e. n characters before end of line
movei t2,@scrntb(nv) ; ...
cail t2,(t1) ; don't copy anything if deleting all the
; characters on the line (or more)
blt t1,(t2) ; copy characters from <curpos>+n to <curpos>
; Clear n character positions at the end of the line.
movei a,blchar ; clear last character position
movem a,1(t2) ; ...
hrli t2,1(t2) ; create BLT pointer of form addr,,addr+1
addi t2,2 ; ...
move nh,thmax ; get pointer to end of line to use as stop
movei t1,@scrntb(nv) ; address
cail t1,(t2) ; already cleared all we have to?
blt t2,(t1) ; no, clear to end of line
pop p,nh ; restore horizontal position
return
; SCRILP - Update screen image after a insert line operation.
; Argument:
; A No. of lines inserted.
scrilp: jumple a,[return] ; NOP if no. of lines is zero
pushae p,[a,b,nh] ; save ACs
move b,tvmax ; start at bottom and work backwards
scril1: sub b,a ; get line no. to copy from
camge b,nv ; passed position of insert?
jrst scril2 ; yes, done copying
move nh,thmin ; put pointer to beginning of line
movsi t1,@scrntb(b) ; to copy from in LH of BLT AC
add b,a ; put pointer to beginning of line
hrri t1,@scrntb(b) ; to copy to in RH of BLT AC
move nh,thmax ; copy until reach end of destination line
blt t1,@scrntb(b) ; ...
soja b,scril1 ; move up one line and do it again
; Now clear the "inserted" lines.
scril2: addi b,1 ; move to next line
move nh,thmin ; pointer to beginning of line
movei t1,@scrntb(b) ; ...
movei t2,blchar ; clear first character
movem t2,(t1) ; ...
hrl t1,t1 ; make BLT AC of address,,address+1
addi t1,1 ; ...
move nh,thmax ; clear until reach last character of line
blt t1,@scrntb(b) ; ...
sojg a,scril2 ; loop back for rest of inserted lines
popae p,[nh,b,a] ; restore ACs
return
; SCRDLP - Update screen image after a delete line operation.
; Argument:
; A No. of lines deleted.
scrdlp: jumple a,[return] ; NOP if no. of lines is zero
pushae p,[nh,nv] ; save ACs
scrdl1: add nv,a ; get line no. to copy from
camle nv,tvmax ; about to copy from non-existant line?
jrst scrdl2 ; yes, done copying
move nh,thmin ; put pointer to beginning of line
movsi t1,@scrntb(nv) ; to copy from in LH of BLT AC
sub nv,a ; put pointer to beginning of line
hrri t1,@scrntb(nv) ; to copy to in RH of BLT AC
move nh,thmax ; copy until reach end of destination line
blt t1,@scrntb(nv) ; ...
aoja nv,scrdl1 ; move down one line and do it again
; Now clear the "inserted" lines.
scrdl2: sub nv,a ; move to first line to clear
scrdl3: move nh,thmin ; pointer to beginning of line
movei t1,@scrntb(nv) ; ...
movei t2,blchar ; clear first character
movem t2,(t1) ; ...
hrl t1,t1 ; make BLT AC of address,,address+1
addi t1,1 ; ...
move nh,thmax ; clear until reach last character of line
blt t1,@scrntb(nv) ; ...
camge nv,tvmax ; cleared last line?
aoja nv,scrdl3 ; no, keep going
popae p,[nv,nh] ; restore ACs
return
; SCRSD - Update screen image after a scroll down operation.
; Argument:
; A No. of scroll downs.
scrsd: pushae p,[a,nv]
imul a,.tpscr+tb
move nv,tvmin
call scrilp
popae p,[nv,a]
return
; SCRSU - Update screen image after a scroll up operation.
; Argument:
; A No. of scroll ups.
scrsu: pushae p,[a,nv]
imul a,.tpscr+tb
move nv,tvmin
call scrdlp
popae p,[nv,a]
return
; SCRxTB - Screen Vertical index table. Indexed by NV
; to get index into SCREEN that starts specified line.
; i.e. to access position indexed by current NH, NV, use
; @SCRNTB(NV).
mvar scrntb(maxver+1) ; Holds vectors into SCREEN, indexed by NH
mvar scrtab(maxver+1) ; Holds vectors into SCREEN, indexed by H
mvar scrlen ; Holds length in words of screen image
mvar scrlst ; Holds address of last word used (for BLT)
subttl CRTSTY Virtual Terminal
; FORCE - Perform pending CLEOL and cursor movement if any.
force: tlne f,%clpnd ; CLEOL pending?
call frcel1 ; yes, do it
; fall through to FRCMOV
; FRCMOV - Perform pending cursor movement.
frcmov: cain h,(nh) ; horizontal position correct?
caie v,(nv) ; vertical correct also?
pjrst @.trmov+tb ; no, move the cursor
return ; both correct, return right away
; TD.WIN - Set window.
; Arguments:
; A first line of window
; B first column of window
; C last line of window
; D last column of window
td.win: camn a,wvmin ; if new minimum vertical
came b,whmin ; or new minimum horizontal
jrst tdwin0 ; different from old then do it
camn c,wvmax ; if new maximum vertical
came d,whmax ; or new maximum horizontal
jrst tdwin0 ; different from old then do it
return ; otherwise no change, do nothing
tdwin0: call frceol ; force any pending CLEOL
xct .tewin+tb
tdwin1: dmovem a,wmin ; set WVMIN and WHMIN
dmovem c,wmax ; set WVMAX and WHMAX
.i wheight=wvmax-wvmin+1
.i wwidth=whmax-whmin+1
trz f,%fnclr+%fneos+%fneol+%fnsu+%fnsd+%fnilp+%fndlp+%fnicp+%fndcp
tdo f,.tpflg+tb
came a,tvmin
tro f,%fnclr+%fnsu+%fnsd
came b,thmin
tro f,%fneos+%fnclr+%fnsu+%fnsd+%fnilp+%fndlp
came c,tvmax
tro f,%fneos+%fnclr+%fnsu+%fnsd
came d,thmax
tro f,%fneol+%fneos+%fnclr+%fnsu+%fnsd+%fnilp+%fndlp
camn c,tvmax
jrst tdwin2
trnn f,%fnilp
trne f,%fndlp
tro f,%fnilp+%fndlp
tdwin2: camn d,thmax
return
trnn f,%fnicp
trne f,%fndcp
tro f,%fnicp+%fndcp
return
; TD.MOV - Move cursor to specified position.
; Arguments:
; A Vertical position.
; B Horizontal position.
td.mov: dmove nvh,a
add nv,wvmin ; convert from window relative position
add nh,whmin ; to absolute one
camle nv,wvmax ; too big?
move nv,wvmax ; yes, set to biggest possible
camle nh,whmax ; too big?
move nh,whmax ; yes, set to biggest possible
return
; TD.DLF - Delete Forward (character) without moving cursor.
td.dlf: movei t1,blchar ; character position already clear?
camn t1,@scrntb(nv) ; ...
return ; yes, no need to do anything
skipn .tedel+tb ; terminal have character delete?
pjrst simdlf ; no, simulate
call frcmov ; move cursor to position
xct .tedel+tb ; erase character position
pjrst scrdlf ; update screen image if .TEDEL didn't
return
; SIMDLF - TD.DLF simulation.
simdlf: push p,a ; save AC
call frcmov ; force cursor movement
movei a,blchar ; delete character by overprinting
call @.trcho+tb ; with space
pop p,a ; restore AC
return
SECTION MAINVAR
ceolp::
ceolpv: block 1 ; Position of pending-CLEOL
ceolph: block 1 ; ...
SECTION MAIN
; TD.EOL - Clear to EOL (End of Line).
; Arguments:
; None
td.eol: tlnn f,%clpnd ; CLEOL already pending?
jrst tdeol1 ; no
came nv,ceolpv ; yes, are we trying to CLEOL on same line?
jrst [ call frcel1 ; no, finish previous CLEOL
jrst tdeol1 ] ; and then do this one
caml nh,ceolph ; same line, is current pos AFTER a pending
; CLEOL position?
return ; yes, ignore this redundant CLEOL
tlz f,%clpnd ; clear CLEOL pending flag
tdeol1: trnn f,%fsmeol ; want to hack smart CLEOL?
pjrst frcel2 ; no, force out CLEOL
dmovem nvh,ceolp ; save current position
tlo f,%clpnd ; and say CLEOL is pending
return
; FRCEOL - Force out CLEOL. Note that %CLPND must be
; cleared before executing .TEEOL because some EOL routines
; may use ORDNRY for output (which checks for %CLPND etc)
frceol: tlnn f,%clpnd ; CLEOL pending?
return ; no, we're done
; fall through
; FRCEL1 - Do the pending CLEOL (assumes there is a CLEOL pending).
frcel1: pushae p,[nh,nv] ; save current position
dmove nvh,ceolp ; get position to start CLEOL
tlz f,%clpnd ; clear CLEOL pending flag
call frcel2 ; actually do it
popae p,[nv,nh] ; restore cursor position
return
; FRCEL2 - Actually do a CLEOL.
frcel2: trne f,%fneol ; atomic CLEOL available?
pjrst simeol ; no, simulate
; If rest of line is already blank, ignore CLEOL.
push p,nh ; save horizontal position
movei t1,blchar ; space for blankness testing
frcel3: came t1,@scrntb(nv) ; blank?
jrst frcel4 ; no, we really have to CLEOL
camge nh,whmax ; reached end?
aoja nh,frcel3 ; no, test rest of line
pop p,nh ; restore horizontal position
return
frcel4: pop p,nh ; restore horizontal position
call frcmov ; move cursor first if necessary
xct .teeol+tb ; clear to end of line
pjrst screol ; update screen image if .TEEOL didn't
return
; SEOL - PJRST SEOL is equivalent to CALL SIMEOL ? AOS (P) ? RETURN.
; Meant to be called by terminal CLEOL handlers when they want to punt.
seol: aos (p) ; take skip return
; Routine to simulate Clear-to-EOL by spaces. Used by
; terminals with no CLEOL or line del/ins!
simeol: push p,nh ; save horizontal position
smeol1: call td.dlf ; erase character position
camge nh,whmax ; erased last position?
aoja nh,smeol1 ; no, keep going
pop p,nh ; restore horizontal position
return
; TD.EOF - Clear to EOF (End of Screen).
; Arguments:
; None
td.eof: camn nv,wvmax ; on last line of screen?
pjrst td.eol ; yes, then CLEOS is equivalent to CLEOL
came nh,whmin
jrst tdeof1
camn nv,wvmin
pjrst tdclr1
tdeof1: trne f,%fcsel ; OK to do real CLEOS?
pjrst td.eol ; No, do CLEOL instead.
trne f,%fneos
pjrst simeos
tlne f,%clpnd ; CLEOL pending? (clear flag ahead of time)
jrst [ camge nv,ceolpv ; if cursor above CLEOL loc,
jrst .+1 ; the CLEOS will wipe it out.
camn nv,ceolpv ; Hmm, if on same line,
camle nh,ceolph ; and cursor precedes CLEOL pos, also win
call frcel1 ; else (sigh) do it.
jrst .+1]
tlz f,%clpnd
call frcmov
xct .teeos+tb
pjrst screos
return
; SEOS - PJRST SEOS is equivalent to CALL SIMEOS ? AOS (P) ? RETURN.
; Meant to be called by terminal CLEOS handlers when they want to punt.
seos: aos (p) ; take skip return
; SIMEOS - Simulate Clear-to-EOS with many Clear-to-EOLs.
simeos: pushae p,[nh,nv] ; save desired cursor position
trne f,%fneol ; CLEOL work?
jrst seos2 ; no
seos1: call td.eol ; clear to end of current line
move nh,whmin ; CR so next CLEOL zaps whole line
camge nv,wvmax ; if not on last line
aoja nv,seos1 ; then move to next one and clear it
jrst seos4 ; that's all
seos2: ; no CLEOL - try other hacks before punting all the way to spaces
trne f,%fndlp ; insert/delete line?
jrst seos1 ; no, punt to spaces
camg nh,whmin ; first column?
jrst seos3 ; yes, use insert/delete right away
call td.eol ; clear rest of this line
move nh,whmin ; CR
caml nv,wvmax ; if last line,
jrst seos4 ; then we're done
addi nv,1 ; else LF
seos3: push p,a
move a,wvmax
subi a,(nv) ; Find # of lines to delete
addi a,1
call frcmov
xct .tedlp+tb ; flush em.
call scrdlp
pop p,a
seos4: popae p,[nv,nh]
return
; TD.CLR - Clear Screen.
; Arguments:
; None
td.clr: dmove nvh,wmin ; move to beginning of the current window
tdclr1: trne f,%fnclr ; atomic clear in our arsenal?
jrst tdeof1 ; no, simulate by doing CLEOS
xct .teclr+tb ; clear screen
call screos ; update screen image if .TECLR didn't
dmove vh,tmin ; clearing the screen homes
tlz f,%clpnd ; no CLEOL pending after a clear screen!
return
; TD.SCR - Scroll window in either direction.
; Arguments:
; A # lines to scroll; pos scrolls up, neg scrolls down.
td.scr: jumpge a,td.su ; If pos let TD.SU handle it.
movn a,a ; get magnitude.
call td.sd
movn a,a
return
; TD.SD - Scroll window down.
; A # lines to scroll down.
td.sd: pushae p,[nh,nv]
trne f,%fnsd ; Do we have atomic scroll down?
jrst tdsd1 ; No, simulate.
dmove nvh,wmin ; move to first line of current window
call frcmov ; ...
xct .tesd+tb ; scroll down
call scrsd ; update screen image if .TESD didn't
jrst tdsd2
tdsd1: dmove nvh,wmin ; move to first column of first line of
; current window
call td.ilp ; and insert specified no. of lines
tdsd2: popae p,[nv,nh] ; restore current position
return
; TD.SU - Scroll up.
; Arguments:
; A No. of lines to scroll
td.su: jumple a,[return] ; nothing to do?
pushae p,[nh,nv] ; save current position
trne f,%fnsu ; atomic scroll up in our arsenal?
jrst tdsu1 ; no, simulate
move nv,wvmax ; move to last line of current window
movei nh,0 ; ...
call frcmov ; ...
xct .tesu+tb ; scroll up
call scrsu ; update screen image if .TESU didn't
addi v,-1(a) ; update cursor position
jrst tdsu2
tdsu1: dmove nvh,wmin ; move to first column of first line of
; current window
call td.dlp ; and delete specified no. of lines
tdsu2: popae p,[nv,nh] ; restore current position
return
; Arguments:
; A Scroll count.
; B No. of lines in region.
td.rsd: jumpe a,[return] ; nop if no movement
jumpe b,[return] ; nop if null region
movei c,(nv) ; TD.WIN arg: maximum vertical
addi c,-1(b) ; is current position plus region size - 1
caml c,wvmax ; if at or below bottom line, then use
pjrst td.ilp ; simple insert line
push p,wvmax ; save current window bottom
push p,a ; save scroll count
dmove a,wmin ; TD.WIN args: minimum vertical, minimum
; horizontal
move d,whmax ; TD.WIN arg: maximum horizontal
call td.win ; set window
pop p,a ; get count
call td.ilp ; insert n lines in window
dmove a,wmin ; TD.WIN arg: minimum vertical, minimum
; horizontal
pop p,c ; TD.WIN arg: maximum vertical
move d,whmax ; TD.WIN arg: maximum horizontal
pjrst td.win ; set window to what it used to be
; Arguments:
; A Scroll count.
; B No. of lines in region.
td.rsu: jumpe a,[return] ; nop if no movement
jumpe b,[return] ; nop if null region
movei c,(nv) ; TD.WIN arg: maximum vertical
addi c,-1(b) ; is current position plus region size - 1
caml c,wvmax ; if at or below line, then use simple
pjrst td.dlp ; delete line
push p,wvmax ; save current window bottom
push p,a ; save scroll count
dmove a,wmin ; TD.WIN args: minimum vertical, minimum
; horizontal
move d,whmax ; TD.WIN arg: maximum horizontal
call td.win ; set window
pop p,a ; get count
call td.dlp ; delete n lines in window
dmove a,wmin ; TD.WIN arg: minimum vertical, minimum
; horizontal
pop p,c ; TD.WIN arg: maximum vertical
move d,whmax ; TD.WIN arg: maximum horizontal
pjrst td.win ; set window to what it used to be
; TD.ILP - Insert Line Position.
; Argument:
; A No. of lines to insert.
td.ilp: jumple a,[return] ; nothing to do?
movei t1,(nv) ; calculate where current line will be
addi t1,(a) ; moved to by insertion
camle t1,wvmax ; past end of window?
pjrst td.eof ; yes, then this is equivalent to CLEOS
trne f,%fnilp ; able to use insert lines?
pjrst similp ; no, simulate
move t1,wvmax ; last line of the terminal's window the same
camn t1,tvmax ; as our software window?
jrst tdilp1 ; yes, a simple insert will do
; Last line of terminal window is not the same as the last line of the
; software window. Therefore the lines to be inserted must be balanced
; by deleting lines at the end of the window.
push p,nv ; save current vertical position
move nv,t1 ; move n lines before end of window
subi nv,-1(a) ; subtracting from wvmax, so -1.
call force ; force CLEOL and cursor movement
xct .tedlp+tb ; delete n lines
call scrdlp ; update screen image if .TEDLP didn't
pop p,nv ; restore vertical position
tdilp1: call force ; force CLEOL and cursor movement
xct .teilp+tb ; insert n lines
pjrst scrilp ; update screen image if .TEILP didn't
return
; SIMILP
similp: pushae p,[nv,b,a]
move nv,wvmax
simil1: move nh,whmin
sub nv,(p)
camge nv,-2(p)
jrst simil3
movn b,wwidth
movs b,b
hrri b,@scrntb(nv)
add nv,(p)
call td.eol
simil2: move a,(b)
call ordnry
aobjn b,simil2
soja nv,simil1
simil3: add nv,(p)
simil4: camge nv,-2(p)
jrst simil5
call td.eol
soja nv,simil4
simil5: popae p,[a,b,nv]
return
; TD.DLP - Delete Line Position.
; Argument:
; A No. of lines to delete.
td.dlp: jumple a,[return] ; nothing to do?
movei t1,(nv) ; calculate line no. which will be moved
addi t1,(a) ; to current line by deletion
camle t1,wvmax ; past end of window?
pjrst td.eof ; yes, then this is equivalent to CLEOS
trne f,%fndlp ; able to use delete lines?
pjrst simdlp ; no, simulate
call force ; force CLEOL and cursor movement
xct .tedlp+tb ; delete n lines
call scrdlp ; update screen image if .TEDLP didn't
move t1,wvmax ; last line of the terminal's window the same
camn t1,tvmax ; as our software window?
return ; yes, we're done
; Last line of terminal window is not the same as the last line of the
; software window. Therefore the deleted lines must be balanced with
; lines inserted at the end of the window.
push p,nv ; save current vertical position
move nv,t1 ; move n lines before last line of window
subi nv,-1(a) ; subtracting from wvmax, so -1...
call frcmov ; force cursor movement
xct .teilp+tb ; insert n lines
call scrilp ; update screen image if .TEILP didn't
pop p,nv ; restore vertical position
return
; SIMDLP
simdlp: pushae p,[nv,b,a]
simdl1: move nh,whmin
add nv,(p)
camle nv,wvmax
jrst simdl3
movn b,wwidth
movs b,b
hrri b,@scrntb(nv)
sub nv,(p)
call td.eol
simdl2: move a,(b)
call ordnry
aobjn b,simdl2
aoja nv,simdl1
simdl3: sub nv,(p)
call td.eof
popae p,[a,b,nv]
return
td.ic: caml nh,whmax ; if last column
pjrst ordnry ; then just use simple typeout
push p,a ; save character
cail a,40 ; if not 40-176
cail a,177 ; ...
jrst tdic2 ; then use general method
; the above test is losing, but should work
; 99.9% of the time
skipn .teeim+tb ; if insert mode not available
jrst tdic2 ; use general method
movei a,1 ; 1 character
move t1,whmax ; last column of software window the same as
camn t1,thmax ; the last column of the terminal's window?
pjrst tdic1 ; yes, a simple insert will do
; Last column of terminal window is not the same as the last column
; of the software window. Therefore the characters to be inserted
; must be balanced by deleting characters at the end of the window.
push p,nh ; save current horizontal position
move nh,t1 ; move to last column
call force ; force CLEOL and cursor movement
xct .tedcp+tb ; delete n characters
call scrdcp ; update screen image if .TEDCP didn't
pop p,nh ; restore horizontal position
tdic1: call force ; force cursor movement
tlon f,%icm ; insert character mode on?
xct .teeim+tb ; no, turn it on
call scricp ; update screen image
pop p,a ; restore character
call @.trtyo+tb ; insert it
movem a,@scrtab(v) ; update screen image
aos h,nh ; increment H and NH (since they're the same,
; can do it in one instruction)
return
tdic2: movei a,1 ; TD.ICP arg: A = insert count
call td.icp ; insert 1 space
pop p,a ; restore character
pjrst ordnry ; type it
; TD.ICP - Insert Character Position.
; Argument:
; A No. of characters to insert.
td.icp: jumple a,[return] ; nothing to do?
movei t1,(nh) ; calculate column that current character
addi t1,(a) ; will be moved to by insertion
camle t1,whmax ; past end of window?
pjrst td.eol ; yes, then this is equivalent to CLEOL
trne f,%fnicp ; able to use insert characters?
pjrst simicp ; no, simulate
move t1,whmax ; last column of software window the same as
camn t1,thmax ; the last column of the terminal's window?
pjrst xicp ; yes, a simple insert will do
; Last column of terminal window is not the same as the last column
; of the software window. Therefore the characters to be inserted
; must be balanced by deleting characters at the end of the window.
push p,nh ; save current horizontal position
move nh,t1 ; move n characters before last column
subi nh,-1(a) ; subtracting from whmax, so -1...
call force ; force CLEOL and cursor movement
xct .tedcp+tb ; delete n characters
call scrdcp ; update screen image if .TEDCP didn't
pop p,nh ; restore horizontal position
; fall through to XICP
xicp: call force ; force cursor movement
skipn t1,.teicp+tb ; insert n characters directly?
jrst xicp1 ; no, use insert character mode
xct t1 ; insert n characters
pjrst scricp ; update screen image if .TEICP didn't
return
xicp1: tlon f,%icm ; insert character mode on?
xct .teeim+tb ; no, turn it on
tyn 40 ; type n spaces
add h,a ; update actual cursor position
pjrst scricp ; update screen image
mvar siline(maxhor)
; SIMICP
simicp: pushae p,[nh,a]
add a,nh
camle a,whmax
jrst simic2
movsi t1,@scrntb(nv)
hrri t1,siline(a)
move a,whmax
blt t1,siline(a)
call td.eol
add nh,(p)
simic1: move a,siline(nh)
caml nh,whmax
jrst simic3
call ordnry
jrst simic1
simic2: call td.eol
jrst simic4
simic3: call ordnry
simic4: popae p,[a,nh]
return
; TD.DCP - Delete Character Position.
; Argument:
; A No. of characters to delete.
td.dcp: jumple a,[return] ; nothing to do?
movei t1,(nh) ; calculate column no. which will be moved
addi t1,(a) ; to current position by deletion
camle t1,whmax ; past end of window?
pjrst td.eol ; yes, then this is equivalent to CLEOL
trne f,%fndcp ; able to use delete characters?
pjrst simdcp ; no, simulate
call force ; force CLEOL and cursor movement
xct .tedcp+tb ; delete n characters
call scrdcp ; update screen image if .TEDCP didn't
move t1,whmax ; last column of software window the same as
camn t1,thmax ; the last column of the terminal's window?
return ; yes, we're done
; Last char of terminal window is not the same as the last character
; of the software window. Therefore the deleted characters must be
; balanced with characters inserted at the end of the window.
push p,nh ; save current horizontal position
move nh,t1 ; move n characters before last column
subi nh,-1(a) ; subtracting from whmax, so -1.
call xicp ; insert n characters
pop p,nh ; restore horizontal position
return
; SIMDCP
simdcp: pushae p,[nh,b,a]
add nh,a
camle nh,whmax
jrst simdc3
movsi t1,@scrntb(nv)
sub nh,a
hrri t1,siline(nh)
movn b,a
add b,whmax
blt t1,siline(b)
call td.eol
sub b,nh
simdc1: move a,siline(nh)
call ordnry
sojg b,simdc1
simdc2: popae p,[a,b,nh]
return
simdc3: call td.eol
jrst simdc2
; TD.BEL - Ding bell.
td.bel: skipl jbell ; skip if don't want audible.
xct .txbel+tb ; want feep, send out.
skiple visbel ; and return unless want visible bell.
xct .txvbl+tb ; do a visible bell.
return
; TD.BOW - Enter Black-on-White mode (Standout).
td.bow: skipe .txso+tb ; terminal support standout mode?
tloe f,%fbow ; yes, already in standout mode?
return ; unsupported or already in it, ignore request
call force ; force CLEOL and cursor movement
xct .txso+tb ; enter standout mode
return
; TD.RST - Reset BOW (standout) mode to normal. In future may
; apply to other modes as well.
td.rst: tlzn f,%fbow ; already in standout mode?
return ; no, ignore request
call force ; force CLEOL and cursor movement
xct .txsor+tb ; exit standout mode
return
; TD.QOT - Send device-dependent data.
; Argument:
; A Byte to output.
td.qot: call force ; force CLEOL and cursor movement
pjrst @.trtyo+tb ; out it goes.
subttl Ordinary character output
; ORDNRY - Output a character.
; Argument:
; A Character.
ordnry: tlne f,%clpnd ; CLEOL pending?
jrst ordn2 ; yes, special hacking
; No pending CLEOL.
ordn0: camn a,@scrntb(nv) ; character already there?
jrst ordn1 ; yes, just update cursor position
cain h,(nh) ; cursor where it's supposed to be?
caie v,(nv) ; (do test inline for speed)
call @.trmov+tb ; no, move it before outputting character
call @.trcho+tb ; output character
ordn1: camge nh,whmax ; last column?
addi nh,1 ; no, advance one position
return
; There is a pending CLEOL.
ordn2: came nv,ceolpv ; on same line as pending CLEOL?
jrst ordn9 ; no, do CLEOL and output character normally
camle nh,ceolph ; NH less than or equal to EOL position?
jrst ordn5 ; no, must insure positions between
; CEOLPH and NH are clear
; NH <= CEOLPH.
ordn3: camn a,@scrntb(nv) ; character already there?
jrst ordn4 ; yes, just update cursor position
cain h,(nh) ; cursor where it's supposed to be?
caie v,(nv) ; (do test inline for speed)
call @.trmov+tb ; no, move it before outputting character
call @.trcho+tb ; output character
ordn4: caml nh,whmax ; last column?
jrst [ tlz f,%clpnd ; yes, CLEOL no longer pending
return ]
came nh,ceolph ; just typed in column CLEOL pending at?
aoja nh,[return] ; no, advance one position and that's it
addi nh,1 ; advance one position
movem nh,ceolph ; and update CLEOL pending column
return
; NH > CEOLPH.
ordn5: push p,a ; save character
exch nh,ceolph ; start clear/test scan at CEOLPH position
movei a,blchar ; space character for clearing/testing
trnn f,%fneol ; does the terminal have CLEOL?
jrst ordn8 ; yes
; Terminal lacks CLEOL. Clear between CEOLPH and current position with
; spaces.
ordn6: camn a,@scrntb(nv) ; already clear?
jrst ordn6a ; yes, just advance
cain h,(nh) ; cursor where it's supposed to be?
caie v,(nv) ; (do test inline for speed)
call @.trmov+tb ; no, move it before outputting character
call @.trcho+tb ; output character
ordn6a: addi nh,1
camge nh,ceolph ; reached desired position?
jrst ordn6 ; no, keep going
pop p,a ; restore character
jrst ordn3 ; now hack character
; Terminal has CLEOL. First check if need to erase area between CEOLPH and
; current position. If so then do CLEOL.
ordn7: caml nh,ceolph ; reached desired position?
jrst [ pop p,a ; yes, all blank, restore character
jrst ordn3 ] ; go output character
ordn8: camn a,@scrntb(nv) ; this character position blank?
aoja nh,ordn7 ; yes, keep checking
; Area between CEOLPH and current position needs to be cleared.
exch nh,ceolph ; put first position to be cleared in CEOLPH,
; and restore current position
pop p,a ; restore character
ordn9: call frcel1 ; do the pending CLEOL
jrst ordn0
subttl Random routines
; ABSCLR - Clear screen, without assuming anything (like screen image,
; cursor position, etc.). This doesn't (and shouldn't) update the screen
; image. This does (and should) update the actual cursor position.
absclr: dmove nvh,wmin ; set desired cursor position to home
trnn f,%fnclr ; atomic clear screen?
jrst [ xct .teclr+tb ; yes, do it
dmove vh,tmin ; cursor now at home
return
]
skipe .tmhom+tb ; atomic home?
jrst [ xct .tmhom+tb ; yes, do it
dmove vh,tmin ; update actual cursor position
call frcmov ; move from TMIN to WMIN
jrst abscl1
]
xct .tmabs+tb ; assume terminal has direct cursor
; positioning!
dmove vh,nvh ; update actual cursor position
abscl1: trnn f,%fneos ; atomic CLEOS?
xct .teeos+tb ; yes, do it
jfcl ; don't update screen image!
return
; FULWIN - Set window to full screeen.
fulwin: pushae p,[a,b,c,d] ; save regs
move t1,[wmin,,wsave] ; save current window
blt t1,wsave+3 ; ...
setzb a,b ; TD.WIN args: minimum vertical, minimum
; horizontal
dmove c,smax ; TD.WIN args: maximum vertical, maximum
; horizontal
call td.win ; set window to whole screen
popae p,[d,c,b,a] ; restore regs
return
; RESWIN - Restore window after FULWIN.
reswin: pushae p,[a,b,c,d] ; save regs
move t1,[wsave,,a] ; TD.WIN args: A = minimum vertical,
blt t1,d ; B = minimum horizontal,
; C = maximum vertical,
; D = maximum horizontal
call td.win ; restore window
popae p,[d,c,b,a] ; restore regs
return
; FINI- Clean up terminal stuff.
fini: call fulwin ; set window to whole screen
tlze f,%icm ; insert character mode on?
xct .telim+tb ; yes, turn it off
trze f,%fbow ; standout mode on?
xct .txsor+tb ; yes, turn it off
call frcmov ; move cursor to where it's supposed to be
xct .trfin+tb ; call TTY cleanup handler
pjrst obfsnd ; send buffered output
; STOP - Prepare for program pause or stop.
IFN ITS,{
stop: $call scpos,[#tyoc,nv,nh]
jfcl
return
} ; IFN ITS
IFN TNX,{
mvar siiset ; nonzero if superimange input on
stop: skipn siiset ; if superimage input not set,
return ; don't try to undo it
IFN 20X,{
move a,ttyjfn ; STPAR arg: A = JFN
move b,oldmod ; STPAR arg: B = JFN mode word
stpar ; restore JFN mode word to previous value
move a,ttyjfn ; SFPOS arg: A = JFN
move b,h ; SFPOS arg: B = line no.,,column no.
sfpos ; tell operating system where cursor is
} ; IFN 20X
IFN 10X,{
say "
" ; can't tell 10X horizontal position so CRLF
; to make it zero
} ; IFN 10X
movei a,.fhjob ; STIW arg: A = fork handle
move b,oldtiw ; STIW arg: B = terminal interrupt word
stiw ; restore terminal interrupts
setzm siiset ; superimage input no longer set
return
} ; IFN TNX
; RESUME - Continue after pausing.
IFN ITS,{
resume: return
} ; IFN ITS
IFN TNX,{
resume: movei a,.fhjob ; RTIW arg: A = bits,,fork handle
rtiw ; read terminal interrupt word for job
; result: B = terminal interrupt word
movem b,oldtiw ; save away
; STIW arg: A = bits,,fork handle
ife tint, movei b,0 ; STIW arg: B = terminal interrupt word
ifn tint, movx b,1_<35.-.ticti>
stiw ; set terminal interrupt word
IFN 20X,{
move a,ttyjfn ; RFMOD arg: A = JFN
rfmod ; read JFN mode word to save old value
movem b,oldmod ; RFMOD result: B = JFN mode word
trze b,tt%pgm ; turn off output page mode
stpar ; if it's on
} ; IFN 20X
setom siiset ; remember we've run
return
sii==:resume ; resume hacks superimage input
} ; IFN TNX
; QUIT - Terminate program.
quit: call fini ; clean up
call stop ; prepare to stop
pjrst logout
; PROCED - Return to superior.
proced: pushae p,[nv,nh] ; save cursor position
call fini ; clean up
call stop ; prepare to stop
ifn its, .break 16,100000 ; pause
ifn tnx, haltf ; pause
call resume ; undo STOP
call redis0 ; redisplay
call reswin ; restore window
popae p,[nh,nv] ; restore cursor position
return
; REINIT - Reinitialize terminal.
reinit: pushae p,[nv,nh] ; save cursor position
move t1,[wmin,,wsave] ; save current window
blt t1,wsave+3 ; ...
setzb v,h ; cursor will be moved to home
setzb nv,nh ; ...
xct .trini+tb ; call terminal initialization
call redis1 ; redisplay screen
call reswin ; restore window
popae p,[nh,nv] ; resrore cursor position
return
; REDISP - Redisplay whole screen from screen image.
; Clobbers A.
redisp: pushae p,[nv,nh] ; save cursor position
call fulwin ; set window to whole screen
call redis0 ; redisplay current window
call reswin ; restore window
popae p,[nh,nv] ; restore cursor position
return
; REDIS0 - Redisplay current window.
redis0: call absclr ; clear screen without updating screen image
redis1: move a,@scrntb(nv) ; get character from screen image
cain a,blchar ; blank?
jrst redis2 ; yes, don't bother
call frcmov ; force cursor to desired position
call @.trcho+tb ; output character
redis2: camge nh,whmax ; done last character of line?
aoja nh,redis1 ; no, keep going
move nh,whmin ; move to beginning of line
camge nv,wvmax ; done last line of screen?
aoja nv,redis1 ; no, keep going
return
popj1: aosa (p)
popaj: pop p,a
apopj: return ; a popj to jump to.
subttl Wholine
IFN STY,{
; WHOINI - Initialize wholine code.
IFN ITS,{
whoini: move a,[setz-1] ; set WHOTIM to plus infinity
movem a,whotim ; ...
skipg wholin ; WHOLINE specified?
return ; no, done
move a,@time
addi a,5*30.-2
movem a,whotim
move a,[squoze 0,SLOADU]
movei b,0
call itsmap
movem a,sloadu
irp v,,[JTMU,NMPGS,NSWPGS]
move a,[squoze 0,v]
.eval a,
.lose %lssys
movem a,v
termin
return
} ; IFN ITS
IFN TNX, whoini==:apopj
; WHOOUT - Output wholine.
whoout: pushae p,[a,b,c,d] ; save regs
pushae p,[nv,nh] ; save position
call frceol ; force CLEOL if pending
call @.trwb+tb ; setup for the wholine
call td.eol ; erase wholine
call whoman ; output wholine data
call frceol ; finish erase if necessary
call @.trwe+tb ; End the wholine, cleaning up
popae p,[nh,nv] ; restore position
call force
call obfsnd ; output buffers
call finish ; wait for output to be sent
IFN ITS,{
move a,@time
addi a,5*30.-2
movem a,whotim
} ; IFN ITS
popae p,[d,c,b,a] ; restore regs
return
; WHOWB - Default TR.WB.
whowb: call fulwin ; reset window to full screen
setzb nv,nh ; home
return
; WHOWE - Default TR.WE.
whowe=:reswin ; restore window
IFN ITS,{
whoman: $call rqdate,,b ; get date and time in disk format
.lose %lssys
move a,[-16.,,[ sixbit /uind/ ? movem wuind
sixbit /uname/ ? movem wuname
sixbit /jname/ ? movem wjname
sixbit /sname/ ? movem wsname
sixbit /runt/ ? movem wrunt
sixbit /who1/ ? movem wwho1
sixbit /who2/ ? movem wwho2
sixbit /who3/ ? movem wwho3
]]
$call usrvar,[#pyi,a] ; get information on job using STY's TTY
return ; don't error if no job
move a,wuind
imul a,lublk
move t1,jtmu
add t1,a
movem t1,wvars+0
move t1,nmpgs
add t1,a
movem t1,wvars+2
add a,nswpgs
movem a,wvars+4
move a,[-lwvars,,wvars]
$call usrmem,[#%jsnum+0,a]
.lose %lssys
hlrz a,b ; WDATE arg: disk format date
lsh a,2 ; shifted left two
call wdate ; print date
call whosp ; output a space
hrrz a,b
call wtime2
; Job statistics.
; Job no.
call whosp ; output a space
move a,wuind
call woct ; output user index
; UNAME
call whosp ; output a space
move b,wuname
call whosx6 ; output UNAME
; JNAME
call whosp ; output a space
move b,wjname
call whosx6 ; output JNAME
; SNAME
call whosp ; output a space
move b,wsname
call whosx6 ; output SNAME
; State
; %Run
call whosp ; output a space
move a,wjtmu
muli a,100.
div a,[2.^6]
call whodec
movei a,"/
call ordnry
movei a,10000.
idiv a,@sloadu
call whodec
movei a,"%
call ordnry
; Runtime
call whosp ; output a space
move a,wrunt
idivi a,<1000000./4>/40. ; convert to 40ths
call wtime1
; In/Total K
call whosp ; output a space
move a,wnmpgs
sub a,wnswpgs
call whodec
movei a,"/
call ordnry
move a,wnmpgs
call whodec
movei a,"K
call ordnry
; user controlled
skipg wwho1
return
call whosp ; output a space
move c,wwho1
hlrz a,wwho2
ldb t1,[370300,,c]
call @whotbl(t1)
ldb a,[240700,,c]
jumpe a,whoo1
call ordnry
tlne c,1000
call ordnry
whoo1: tlnn c,200000
call whosp ; output a space
hrrz a,wwho2
ldb t1,[340300,,c]
call @whotbl(t1)
tlnn c,2
call whosp ; output a space
hlrz a,wwho3
ldb t1,[170300,,c]
call @whotbl(t1)
ldb a,[040700,,c]
jumpe a,whoo2
call ordnry
trne c,4000
call ordnry
tlnn c,1
call whosp ; output a space
whoo2: hrrz a,wwho3
ldb t1,[140300,,c]
pjrst @whotbl(t1)
; Dispatch table for WHO2/WHO3 printing modes.
whotbl: [return] ; don't print
wdate ; date
wtime1 ; time in 40ths
wtime2 ; time in half seconds
woct ; octal
whodec ; decimal
wsix ; sixbit
[return] ; unused
; WDATE - Print date.
wdate: push p,a
ldb a,[070400,,(p)]
call whodc2
movei a,"/
call ordnry
ldb a,[020500,,(p)]
call whodc2
movei a,"/
call ordnry
pop p,a
ldb a,[130700,,a]
pjrst whodc2
wtime1: lsh a,-2 ; convert 40ths to 10ths
idivi a,10.
push p,b
call wtime3
movei a,".
call ordnry
pop p,a
addi a,"0
pjrst ordnry
wtime2: lsh a,-1 ; convert half-seconds to seconds
wtime3: idivi a,60.*60.
call whodc2
movei a,":
call ordnry
move a,b
idivi a,60.
call whodc2
movei a,":
call ordnry
move a,b
pjrst whodc2
woct: push p,b
idivi a,8.
jumpe a,.+2
call woct
movei a,"0(b)
pop p,b
pjrst ordnry
wsix: movsi b,(a)
call whosx2
pjrst whosix
SECTION MAINVAR
wvars: block 1
movem wjtmu
block 1
movem wnmpgs
block 1
movem wnswpgs
lwvars==:.-wvars
SECTION MAIN
mvar whotim
mvar sloadu ; holds address of system fair share variable
mvar jtmu
mvar nmpgs
mvar nswpgs
mvar wuind
mvar wuname
mvar wjname
mvar wsname
mvar wjtmu
mvar wrunt
mvar wnmpgs
mvar wnswpgs
mvar wwho1
mvar wwho2
mvar wwho3
} ; IFN ITS
IFN TNX,{
whoman: hrroi a,wtemp ; ODTIM arg: A = B.P.
seto b, ; ODTIM arg: B = -1 for current date/time
movsi c,(ot%nmn\ot%sla\ot%12h\ot%dam\ot%scl)
; ODTIM arg: C = control bits
odtim ; get current date/time
call wstr ; output it
move a,ptyttd ; GETJI arg: A = 400000+TTY no.
move b,[-7,,wji] ; GETJI arg: B = AOBJN to data area
getji ; get job information
return ; huh?
; Job no.
call whosp
move a,wji+.jijno ; WHODEC arg: A = number
call whodec ; output job no.
; login name
call whosp
hrroi a,wtemp ; DIRST arg: A = B.P.
move b,wji+.jiuno ; DIRST arg: B = user no.
dirst ; convert user no. to string
jrst .+2
call wstr ; output user name
; prgoram name
call whosp
move b,wji+.jipnm ; WHOSX6 arg: B = sixbit
call whosx6 ; output program name
; connected directory
call whosp
hrroi a,wtemp ; DIRST arg: A = B.P.
move b,wji+.jidno ; DIRST arg: B = directory no.
dirst ; convert directory no. to string
jrst .+2
call wstr ; output directory name
; load average
call whosp
move a,[sixbit/SYSTAT/] ; SYSGT arg: A = sixbit table name
sysgt ; find table no. of systat table
jumpe b,whoo2 ; if not found then return zero
movei a,(b) ; GETAB arg: table no. in RH
hrli a,14 ; and offset in LH
getab ; get entry 14 of systat table: 1 minute load
; average
jrst whoo2
move b,a ; FLOUT arg: B = floating point number
hrroi a,wtemp ; FLOUT arg: A = B.P.
move c,[fl%one\fl%pnt\020200] ; FLOUT arg: C = control bits
flout ; convert floating point number to string
jrst whoo2
call wstr ; output load average
whoo2:
; runtime
call whosp
move a,wji+.jirt ; WTIME arg: A = run time
; pjrst wtime
wtime: idivi a,100. ; convert milliseconds to tenths
idivi a,10. ; convert tenths to seconds and remainder
push p,b ; save remainder
idivi a,60.*60.
call whodc2
movei a,":
call ordnry
move a,b
idivi a,60.
call whodc2
movei a,":
call ordnry
move a,b
call whodc2
movei a,".
call ordnry
pop p,a
addi a,"0
pjrst ordnry
wstr: push p,a
move b,[440700,,wtemp]
wstr1: camn b,(p)
jrst wstr2
ildb a,b
call ordnry
jrst wstr1
wstr2: pop p,a
return
mvar wji(7)
mvar wtemp(6)
} ; IFN TNX
; WHOSP - Output a space.
whosp: movei a,40
pjrst ordnry
; WHOSX6 - Output a word of sixbit.
whosx6: call whosx2
call whosx2
; WHOSX2 - Output two sixbit characters.
whosx2: call whosix
; WHOSIX - Output one sixbit character.
whosix: movei a,0
lshc a,6
addi a,40
pjrst ordnry
; WHODC2 - Output number as two decimal digits.
whodc2: push p,b
idivi a,10.
addi a,"0
call ordnry
movei a,"0(b)
pop p,b
pjrst ordnry
; WHODEC - Output decimal number.
whodec: push p,b
idivi a,10.
jumpe a,.+2
call whodec
movei a,"0(b)
pop p,b
pjrst ordnry
} ; IFN STY
subttl Routines for CRTSTY interactive typeouts
mvar oldl(<maxhor+4>/5) ; old line
mvar oldll ; old last line length
; SAVL - Save line. Clobbers NH.
savl: push p,a ; save AC
movei nh,0
setom oldll ; just in case whole line is blank
move a,[440700,,oldl]
sl1: move t1,@scrntb(nv)
idpb t1,a
caie t1,blchar
movem nh,oldll
camge nh,shmax
aoja nh,sl1
aos oldll
pop p,a ; restore AC
return
; Restore line. Clobbers NH.
resl: pushae p,[a,b,c] ; save ACs
movei nh,0
call td.eol
move b,[440700,,oldl]
move c,oldll
jumpe c,rl2
rl1: ildb a,b ; get a character
call ordnry ; output it
sojg c,rl1
rl2: popae p,[c,b,a] ; restore ACs
return
ascout: push p,b
hlrz b,a
hrli a,440700
push p,a
asc1: ildb a,(p) ; get a char
call ordnry ; send it
sojg b,asc1 ; if more chars, send get another
popae p,[a,b]
return
;;; ENTER is a routine to hack run-time interaction between CRTSTY and the
;;; user. It saves the bottom line of the screen, and prompts for a command,
;;; using TMPMSG. The command is executed and the screen is restored.
;;; If a terminal wishes to provide terminal-specific commands, it may
;;; initialize the variable ENTACT to be a routine to process commands.
;;; If it skip returns, it found and executed a command, otherwise the
;;; standard error message will be given.
mvar entact ; If non-zero, a routine to handle terminal
; specific commands. (initialize modes, or
; whatever....)
enter: call frcv
pushae p,[nh,nv,a,b,c,d]
move nv,svmax
call savl
movei nh,0
call td.eol ; CLEOL
move a,[ascnt "CRTSTY -->"]
call ascout
call force ; Force everything to happen
call obfsnd
call askque
move nv,svmax
call resl
popae p,[d,c,b,a,nv,nh]
call force
call obfsnd
pjrst rrcv
askque: call tyiget
camn a,cmdchr ; command character?
pjrst tyiput ; yes, send it through
cail a,"a ; lowercase?
caile a,"z
caia
subi a,40 ; yes, convert to uppercase
call ordnry ; echo character
cain a,"Q ; Q for quit?
pjrst quit ; yes
cain a,"P ; P for proceed?
pjrst proced ; yes
cain a,"D ; D for dump?
pjrst scrdmp ; yes, dump the screen
IFN STY,{
cain a,"W ; W for wholine?
pjrst whoout
}
cain a,"R ; R for redisplay?
pjrst redisp
cain a,"I ; I for init?
pjrst reinit
cain a,"F ; Feep-toggle?
pjrst feeptg ; toggle feep-mode
cain a,"H ; H for [HELP]
pjrst askhlp ; send a %TXTOP+"H for [HELP]
cain a,"C ; C for Control Char entry?
pjrst entctl
IFN TNX,{
cain a,"E ; E for EXEC?
pjrst pushex
} ; IFN TNX
skipe entact ; does this terminal have some ops of it's own?
call @entact ; yes, check them out
jrst unknwn ; not one of them, either
return ; one of them, we win
unknwn:
IFN TNX,{
move a,[ascnt "?? Quit, Proceed, Dump, Redisp, Init, Feep, Help, Exec, Ctl"]}
IFN STY,{
move a,[ascnt "?? Quit, Proceed, Dump, Redisp, Who, Init, Feep, Help, Ctl"]}
IFE TNX+STY,{
move a,[ascnt "?? Quit, Proceed, Dump, Redisp, Init, Feep, Help, Ctl"]}
unknw0: call ascout ; Output string from above or elsewhere
forslp: call force ; Force everything to happen
call obfsnd
sleep1: call finish
sleep 10. ; let user see message for at least one second
return
askhlp: movei a,%txtop+"H ; [HELP] character
pjrst tyiput ; send it out, and return
entctl: move a,[ascnt "ontrol-"]
call ascout ; send the message to the screen
call force ; Force everything to happen
call obfsnd
call tyiget ; get char to controllify
call ordnry ; echo it to screen
andi a,37 ; make a control char out of it
; Note, maybe map to 60 octal onward and set %txctl?
call tyiput ; send onward to host
jrst forslp ; let user see it 1 sec, then resume.
feeptg:
IFN TINT&SINT,{
move a,ttyvec
caie a,ttyinf ; already feeping?
jrst [ call fpset ; No, turn on.
move a,[ascnt " Feep-mode on!"]
jrst unknw0] ; tell him it's on
call fprset ; Yes, turn off.
} ; IFN TINT&SINT
move a,[ascnt " Feep-mode off!"]
jrst unknw0 ; tell him it's off
; SCRDMP - put copy of screen image in file.
scrdmp: movei nh,0 ; return to the beginning of the line
call td.eol
ifn its,move a,[ascnt " Dumping screen to .TEMP.;<uname> SCREEN"]
ifn tnx,move a,[ascnt " Dumping screen to SCREEN.TEMP"]
call ascout ; send the message to the screen
call force ; Force everything to happen
call obfsnd
IFN ITS,{
push p,@time ; save current time
$call OPEN,[#dsko,['DSK,,0],uname,['SCREEN],['.TEMP.]][][#.uao\100000]
jrst [ $call OPEN,[#dsko,['DSK,,0],uname,['SCREEN],['.TEMP.]][][#.uao]
jrst [ move a,[ascnt " -- Can't open dump file"]
jrst unknw0] ; So output it and wait for him to see
jrst sd1] ; So hack the file from the start
$call FILLEN,[#dsko][a] ; Find the end of the file
.lose %lsfil
.access dsko,a ; Go to the end of the file
.iot dsko,[^L] ; Separate screens with FF
sd1: movei nv,0
sd2: move nh,shmax
movei t1,blchar
sd3: camn t1,@scrntb(nv)
sojge nh,sd3
hrrz a,scrntb(nv)
hrli a,444400
movei b,1(nh)
$call SIOT,[#dsko,a,b] ; send the characters
.lose %lsfil
.iot dsko,[^M] ; Terpri
.iot dsko,[^J]
addi nv,1
camge nv,svmax
jrst sd2
; Output all but last line. Last line can be found in OLDL.
move a,[440700,,oldl] ; And send that last line out to the file
move b,oldll
$call siot,[#dsko,a,b]
.lose %lsfil
.iot dsko,[^M] ; Terpri to finish it off
.iot dsko,[^J]
.close dsko, ; yes, finish up
pop p,a ; get time message was output
addi a,30. ; add 1 second
movn a,a
.sleep a, ; sleep until then
return
} ; IFN ITS
IFN TNX,{
movsi a,(gj%fou\gj%new\gj%sht\gj%acc)
hrroi b,[asciz "SCREEN.TEMP"]
gtjfn
jrst sd4
move b,[7._30.\of%wr\of%rtd]
openf
jrst sd4
sd1: movei nv,0
sd2: move nh,shmax
movei t1,blchar
sd3: camn t1,@scrntb(nv)
sojge nh,sd3
hrrz b,scrntb(nv)
hrli b,444400
movni c,1(nh)
skipge c
sout
movei b,^M
bout
movei b,^J
bout
addi nv,1
camge nv,svmax
jrst sd2
;; Output all but last line. Last line can be found in OLDL.
hrroi b,oldl
movn c,oldll
skipge c
sout
;; TERPRI to finish it off
movei b,^M
bout
movei b,^J
bout
closf ; yes, finish up
sleep 10.
return
sd4: move a,[ascnt " -- Can't open dump file"]
jrst unknw0
} ; IFN TNX
IFN TNX,{
; PUSHEX - Push to EXEC (command interpreter)
mvar exefrk ; EXEC fork handle
pushex: pushae p,[nv,nh] ; save cursor position
call fini ; clean up
call stop ; prepare to stop
pushae p,[a,b,c] ; save ACs
movei a,.fhslf ; disable inferior fork
movx b,1_<35.-.icift> ; termination interrupt!!!
dic
skiple a,exefrk ; been here before?
jrst pushe1 ; yes, just start it up
movsi a,(gj%old\gj%sht) ; find EXEC
ifn 20x, hrroi b,[asciz "SYSTEM:EXEC.EXE"]
ifn 10x, hrroi b,[asciz "<SYSTEM>EXEC.SAV"]
gtjfn
jerr1 [asciz "Unable to assign EXEC jfn - "]
push p,a ; save jfn
movsi a,(cr%cap) ; (this may be a mistake)
cfork ; create inferior fork
jerr1 [asciz "Unable to create EXEC fork - "]
movem a,exefrk ; save fork handle
rpcap ; read capabilities
tlz b,(sc%log) ; make sure EXEC can't
tlz c,(sc%log) ; log out!
epcap ; enable capabilities
exch a,(p) ; retrieve jfn
hrl a,(p) ; fork handle in left half
get ; load EXEC into inferior fork
pop p,a ; retrieve fork handle
pushe1: movei b,0 ; start at primary start address
sfrkv
rfork
wfork ; wait for termination
movei a,.fhslf ; reactivate inferior
movx b,1_<35.-.icift> ; fork interrupt
aic
popae p,[c,b,a] ; restore ACs
call resume ; undo STOP
call redis0 ; redisplay
call reswin ; restore window
popae p,[nh,nv] ; restore cursor position
return
} ; IFN 20X
subttl ITS virtual terminal (Software-TTY) simulation
; SWSMO - STY output co-routine loop for Software-TTY simulation.
; Argument:
; A Character with %TX bits.
swsmo: call smoget ; Get character from input support
IFE ITS&STY,{
trne a,%txtop\%txmta\%txctl
jrst [ push p,a ; save character
movei a,^\ ; SBOUT arg: A = character
call sbout
move a,(p)
lsh a,-7
addi a,100
call sbout
pop p,a
andi a,%txasc
call sbout
jrst swsmo
]
} ; IFE ITS&STY
call sbout ; output to STY
caie a,^\ ; ^\?
jrst swsmo ; no, that's it
skipl tpcbs ; NO TPCBS specified?
call sbout ; no, output another ^\ to get one through
jrst swsmo
; ITS software TTY codes are defined in SYSTEM;BITS > (search for "%TD"
; twice). Complete page they appear on also contains all definitions
; for the full input buffer bits.
IFN ARPA,{
swsmi0: cain a,%tdors ; output reset?
call tdors ; yes, let it through
}
; SWSMI - Main loop of software TTY simulation. Handles STY input.
swsmi: styinc a, ; get character into A
IFN ARPA,{
skipe supres
jrst swsmi0
}
push p,[swsmi] ; Simulate PUSHJ for easy return to beg of loop
caig a,200 ; software-TTY code?
pjrst ordnry ; no, ordinary spacing character
caige a,%tdmax+1 ; Too big? (+1 for windowing hack)
pjrst @sftcod-200(a) ; Internal ITS software-TTY code! Dispatch.
pjrst unused
; SWSMF - Software-TTY simulation force routine.
swsmf: call force ; force CLEOL and cursor movement
pjrst obfsnd ; and finally make sure all output goes out.
; Dispatch table for %TD codes, used by SWSMI.
sftcod: offset 200-sftcod
%tdmov:: tdmov ; 200 %TDMOV - Move cursor
%tdmv1:: unused ; 201 %TDMV1 - Dummy, shouldn't be seen.
%tdeof:: td.eof ; 202 %TDEOF - Erase to end of page
%tdeol:: td.eol ; 203 %TDEOL - Erase to end of line
%tddlf:: td.dlf ; 204 %TDDLF - Delete forward
%tdmtf:: unused ; 205 %TDMTF - Motor off (terminets only)
%tdmtn:: unused ; 206 %TDMTN - Motor on ( " " )
%tdcrl:: tdcrl ; 207 %TDCRL - CRLF and CLEOL (see note below)
%tdnop:: tdnop ; 210 %TDNOP - Noop for SuperDuperImage
%tdbs:: unused ; 211 %TDBS - Backspace, only on TTY's with %TORAW set.
%tdlf:: unused ; 212 %TDLF - Linefeed, ( " )
%tdrcr:: unused ; 213 %TDRCR - CR, ( " )
%tdors:: tdors ; 214 %TDORS - Output Reset. Seen when TTY output reset done.
%tdqot:: tdqot ; 215 %TDQOT - Device dependent data in next byte (quoted)
%tdfs:: tdfs ; 216 %TDFS - Move cursor forward one space
%tdmv0:: tdmv0 ; 217 %TDMV0 - Replacement for %TDMOV, illegal if %TORAW.
%tdclr:: td.clr ; 220 %TDCLR - Home and Clear the screen
%tdbel:: td.bel ; 221 %TDBEL - Ding the bell
%tdini:: unused ; 222 %TDINI - System just came up, reinit intelligent term
%tdilp:: tdilp ; 223 %TDILP - Insert Line-Position. Followed by count
%tddlp:: tddlp ; 224 %TDDLP - Delete Line-Position. Followed by count
%tdicp:: tdicp ; 225 %TDICP - Insert Char-Position. Followed by count
%tddcp:: tddcp ; 226 %TDDCP - Delete Char-Position. Followed by count
%tdbow:: td.bow ; 227 %TDBOW - Enter Black-on-White mode (inverse video)
%tdrst:: td.rst ; 230 %TDRST - Reset mode. Deselect all special modes (eg BOW)
%tdgrf:: unused ; 231 %TDGRF - Enter graphics mode.
%tdrsu:: tdrsu ; 232 %TDRSU - Region scroll up.
%tdrsd:: tdrsd ; 233 %TDRSD - Region scroll down.
unused ; 234 "Next 4 codes are used for some weird form of
unused ; 235 graphics output that will eventually be flushed"
unused ; 236 -TS3TTY
unused ; 237
;; following are for local editing terminals. How does this affect
;; CRTSTY? -CBF
%tdsyn:: unused ; 240 Resynch reply to local editing terminal. Ignore 1 arg
%tdeco:: unused ; 241 Ask terminal to try local editing by sending a
; resynch. Ignore.
%tdedf:: unused ; 242 Set local editing terminal command definition.
; Ignore 2 args.
%tdnle:: unused ; 243 Stop doing local editing. Ignore.
%tdtsp:: unused ; 244 Displays like space, but is part of tab. Ignore.
; Shouldn't happen?
%tdctb:: unused ; 245 This line is continued at the beginning.
%tdcte:: unused ; 246 This line is continued at the end.
%tdmlt:: unused ; 247 Declare multi-position char for local editing.
; Ignore 2 args.
%tdsvl:: unused ; 250 Save line contents. Ignore 3 args.
%tdrsl:: unused ; 251 Restore line contents. Ignore 3 args.
%tdssr:: unused ; 252 Set range of columns to save. Ignore 2 args.
%tdsll:: unused ; 253 Set label for local line saving. Ignore 2 args.
%tdmax::
offset 0
tdwin ; xxx %TDWIN - Set window.
; UNUSED - Error, saw a software TTY code we shouldn't have?
; Handling here isn't so good, can be improved with command line.
unused: call td.bel ; ring bell and call to attention of luser
movei a,-100(a) ; map into ascii range of alpha 200=@
skipn .txso+tb
pjrst ordnry ; if no standout routine, just output
pjrst chstdo
; %TDNOP - No Operation.
tdnop: return ; no operation
; %TDMOV - Move cursor (old, 4 bytes).
tdmov: styinc a, ; Throw away the position estimate
styinc a, ; ...
; %TDMV0 - Move cursor (new, 2 bytes).
tdmv0: styinc a, ; get new vertical position
push p,a ; save (STYINC may clobber ACs)
styinc b, ; and new horizontal position
pop p,a ; restore new vertical
pjrst td.mov
; %TDFS - Move cursor Forward
tdfs: camge nh,whmax ; last column?
addi nh,1 ; no, increment horizontal position
return
; %TDCRL - Move to Next Line and clear it.
; If on screen bottom, receipt of this code means ITS wants screen
; to scroll up.
tdcrl: move nh,whmin ; do CR part of CRLF
movei a,1 ; TD.SU arg: no. of lines to scroll
caml nv,wvmax ; last line of current window?
pjrst td.su ; yes, LF part of CRLF means scroll up
aoja nv,td.eol ; do LF part of CRLF
; and goto clear to end of line routine
; %TDILP - Insert Line Position.
tdilp: styinc a, ; get count in A
pjrst td.ilp
; %TDDLP - Delete Line Position.
tddlp: push p,wvmax ; save last line no. of window
styinc a, ; get count in A
push p,a ; save count
call styip ; peek at next byte
caie a,%tdmv0 ; move?
jrst [ pop p,a ; TD.DLP arg: count
pop p,t1 ; pop off WVMAX
pjrst td.dlp ] ; execute the %TDDLP
styinc a, ; get %TDMV0
styinc a, ; get new vertical
add a,wvmin ; ...
push p,a ; save
styinc a, ; get new horizontal
add a,whmin ; ...
push p,a ; save
call styip ; peek at next byte
caie a,%tdilp ; insert line?
jrst xdlp4 ; no
pop p,a ; flush H-pos from stack
styinc a, ; get %TDILP
styinc a, ; get insert count
came a,-1(p) ; equal to delete count?
jrst xdlp3 ; no
dmove a,wmin ; TD.WIN args: minimum vertical, minimum
; horizontal
move d,whmax ; TD.WIN arg: maximum horizontal
caml nv,(p) ; insert above or below delete?
jrst xdlp1 ; below
; delete line above insert line - delete line in window
pop p,c ; get Y-position of insert
add c,(p) ; add count and
subi c,1 ; subtract one to get last line to move
call td.win ; set window
pop p,a ; get count
call td.dlp ; delete n lines in window
move nv,wvmax ; leave cursor where %TDILP was done
subi nv,-1(a) ; ...
jrst xdlp2 ; cleanup
; delete line below insert line - insert line in window
xdlp1: move c,nv ; get line no. of delete
pop p,nv ; move to position of insert
add c,(p) ; add count to line no. of delete and
subi c,1 ; subtract 1 to get last line of window
call td.win ; set window
pop p,a ; TD.ILP arg: count
call td.ilp ; insert lines in window
xdlp2: dmove a,wmin ; TD.WIN arg: minimum vertical, minimum
; horizontal
pop p,c ; TD.WIN arg: maximum vertical
move d,whmax ; TD.WIN arg: maximum horizontal
pjrst td.win ; set window to what it used to be
xdlp3: exch a,-1(p) ; exchange insert and delete counts
call td.dlp ; execute the delete line request
pop p,nv ; execute the %TDMV0
pop p,a ; TD.ILP arg: count
pop p,t1 ; pop off WVMAX
pjrst td.ilp ; execute the %TDILP
xdlp4: move a,-2(p) ; TD.DLP arg: count
call td.dlp ; execute the %TDDLP
pop p,nh ; execute the %TDMV0
pop p,nv ; ...
sub p,[2,,2] ; pop off count, WVMAX
return
; %TDICP - Insert Character Position.
tdicp: push p,[0]
tdicpl: styinc a, ; get count in A
addm a,(p) ; add to count so far
call styip ; peek at next character
cain a,%tdicp ; %TDICP?
jrst [ styinc a, ; yes, read it
jrst tdicpl ] ; and go back for count
caige a,200
jrst [ pop p,a
caie a,1
pjrst td.icp
styinc a,
pjrst td.ic ]
pop p,a ; get final count
pjrst td.icp
; %TDDCP - Delete Character Position.
tddcp: push p,[0]
tddcpl: styinc a, ; get count in A
addm a,(p) ; add to count so far
call styip ; peek at next character
cain a,%tddcp ; %TDDCP?
jrst [ styinc a, ; yes, read it
jrst tddcpl ] ; and go back for count
pop p,a ; get final count
pjrst td.dcp
; %TDORS - Output Reset. Tell ITS where cursor should be.
; Unfortunately this needs %TPCBS set to win (losing ITS).
IFN ITS&STY,{
tdors: movei a,(nv)
sub a,wvmin
movei b,(nh)
sub b,whmin
$call scpos,[#pyo,a,b,[-1]]
.lose %lsfil
return
} ; IFN ITS&STY
.ELSE {
tdors:
IFN ARPA,{
sosg inscnt
setzm supres
}
movei a,^\
call sbout
movei a,^P
call sbout
movei a,(nv)
sub a,wvmin
call sbout
movei a,(nh)
sub a,whmin
pjrst sbout
} ; IFE ITS&STY
; %TDQOT - Quote device-dependent data in next byte.
; Just have to hope program knows what it's doing.
tdqot: styinc a, ; get next byte
pjrst td.qot
; %TDRSU region count - Region scroll up.
tdrsu: styinc b, ; TD.RSU arg: B = no. of lines in region
push p,b
styinc a, ; TD.RSU arg: A = scroll count
pop p,b
pjrst td.rsu
; %TDRSD region count - Region scroll down.
tdrsd: styinc b, ; TD.RSD arg: B = no. of lines in region
push p,b
styinc a, ; TD.RSD arg: A = scroll count
pop p,b
pjrst td.rsd
; %TDWIN - Set window.
tdwin: styinc a,
push p,a
styinc b,
push p,b
styinc c,
push p,c
styinc d,
pop p,c
pop p,b
pop p,a
pjrst td.win
subttl VT52 Simulation
; VTSMO - STY output co-routine loop for VT52 simulation.
; Argument:
; A Character.
vtsmo: call smoget ; get character from input support
call sbout ; output to STY
jrst vtsmo
; VTSMF - VT52 simulation force routine.
vtsmf: call force ; force CLEOL and cursor movement
pjrst obfsnd ; and finally make sure all output goes out.
; VTSMI - Main loop of VT52 simulation. Handles STY input.
vtsmi: styinc a, ; get character into A
; andi a,177
caige a,40
jrst @vtctl(a)
caie a,177
call ordnry
jrst vtsmi
vtctl: vtsmi ; ^@ - ignored
vtsmi ; ^A - ignored
vtsmi ; ^B - ignored
vtsmi ; ^C - ignored
vtsmi ; ^D - ignored
vtsmi ; ^E - ignored
vtsmi ; ^F - ignored
vtbell ; ^G - ring bell
vtbs ; ^H - backspace
vttab ; ^I - tab
vtlf ; ^J - linefeed
vtsmi ; ^K - ignored
vtsmi ; ^L - ignored
vtcr ; ^M - carriage return
vtsmi ; ^N - ignored
vtsmi ; ^O - ignored
vtsmi ; ^P - ignored
vtsmi ; ^Q - ignored
vtsmi ; ^R - ignored
vtsmi ; ^S - ignored
vtsmi ; ^T - ignored
vtsmi ; ^U - ignored
vtsmi ; ^V - ignored
vtsmi ; ^W - ignored
vtsmi ; ^X - ignored
vtsmi ; ^Y - ignored
vtsmi ; ^Z - ignored
vt.esc ; ^[ - escape
vtsmi ; ^\ - ignored
vtsmi ; ^] - ignored
vtsmi ; ^^ - ignored
vtsmi ; ^_ - ignored
vtbell: call td.bel
jrst vtsmi
vtbs: camle nh,whmin
soja nh,vtsmi
jrst vtsmi
vttab: addi nh,10
trz nh,7
camle nh,whmax
move nh,whmax
jrst vtsmi
vtlf: camge nv,wvmax
aoja nv,vtsmi
movei a,1
call td.su
jrst vtsmi
vtcr: move nh,whmin
jrst vtsmi
vt.esc: styinc a,
cail a,"A
caile a,"Z
jrst vtsmi
jrst @vtesct-"A(a)
vtesct: vtup ; ESC A - up
vtdown ; ESC B - down
vtrght ; ESC C - right
vtbs ; ESC D - left
vtsmi ; ESC E - ignored
vtsmi ; ESC F - ignored
vtsmi ; ESC G - ignored
vthome ; ESC H - home
vtsd ; ESC I - scroll down
vteos ; ESC J - erase to end of screen
vteol ; ESC K - erase to end of line
vtilp ; ESC L - insert 1 line
vtdlp ; ESC M - delete 1 line
vtsmi ; ESC N - ignored
vtsmi ; ESC O - ignored (H19: exit insert mode)
vtsmi ; ESC P - ignored (T1061: insert 1 space)
; (HP26XX: delete 1 char)
vtsmi ; ESC Q - ignored (T1061: delete 1 char)
; (HP26XX: enter insert mode)
vtsmi ; ESC R - ignored (HP26XX: exit insert mode)
vtsmi ; ESC S - ignored
vtsmi ; ESC T - ignored
vtsmi ; ESC U - ignored
vtsmi ; ESC V - ignored
vtsmi ; ESC W - ignored
vtsmi ; ESC X - ignored
vtpos ; ESC Y - direct cursor positioning
vtsmi ; ESC Z - ignored
vtup: camle nv,wvmin
soja nv,vtsmi
jrst vtsmi
vtdown: camge nv,wvmax
aoja nv,vtsmi
jrst vtsmi
vtrght: camge nh,whmax
aoja nh,vtsmi
jrst vtsmi
vthome: dmove nvh,wmin
jrst vtsmi
vtsd: movei a,1
call td.sd
jrst vtsmi
vteos: call td.eof
jrst vtsmi
vteol: call td.eol
jrst vtsmi
vtilp: push p,[1] ; start with repeat count of 1
vtilp1: call styip ; peek at next character
jumpe a,vtilp4 ; if NUL then ignore it
caie a,33 ; ESC?
jrst vtilp2 ; no, go do insert line
styinc a, ; read ESC
call styip ; peek at next character
caie a,"L ; L?
jrst vtilp3 ; no, go do insert line and then hack ESC
styinc a, ; read L
aos (p) ; increment repeat count
jrst vtilp1 ; go peek so more
vtilp2: pop p,a ; TD.ILP arg: A = count
call td.ilp ; insert n lines
jrst vtsmi
vtilp3: pop p,a ; TD.ILP arg: A = count
call td.ilp ; insert n lines
jrst vt.esc
vtilp4: styinc a, ; read NUL
jrst vtilp1 ; go back for more
vtdlp: push p,[1] ; start with repeat count of 1
vtdlp1: call styip ; peek at next character
jumpe a,vtdlp4 ; if NUL then ignore it
caie a,33 ; ESC?
jrst vtdlp2 ; no, go do delete line
styinc a, ; read ESC
call styip ; peek at next character
caie a,"M ; M?
jrst vtdlp3 ; no, go do delete line and then hack ESC
styinc a, ; read M
aos (p) ; increment repeat count
jrst vtdlp1 ; go peek so more
vtdlp2: pop p,a ; TD.DLP arg: A = count
call td.dlp ; delete n lines
jrst vtsmi
vtdlp3: pop p,a ; TD.DLP arg: A = count
call td.dlp ; delete n lines
jrst vt.esc
vtdlp4: styinc a, ; read NUL
jrst vtdlp1 ; go back for more
vtpos: styinc a, ; get vertical position + 40
push p,a
styinc b, ; get horizontal position + 40
pop p,a
movei a,-40(a) ; TD.MOV arg: A = vertical position
camg a,wvmax ; if position out of range,
jrst .+3
movei a,(nv) ; then it remains unchanged
sub a,wvmin ; ...
movei b,-40(b) ; TD.MOV arg: B = horizontal position
call td.mov ; move cursor
jrst vtsmi
subttl Part IV - Support
subttl Random terminal support routines - Input
; STYI - Standard TR.TYI co-routine loop; gets character via TYIGET and
; puts character via TYIPUC. Does no processing at all on TTY input
; characters, except for command-escape check.
styi: call tyiget ; get character from TTY
call tyipuc ; put char to STY (via SMO)
jrst styi ; loop forever
; UNDEL - TR.TYI co-routine loop which exchanges delete and underscore.
; Should be used by any terminal that has delete as shift-underscore.
undel: call tyiget
caie a,177
cain a,137
xori a,137#177
call tyipuc
jrst undel
; BCKYCH - Set "bucky bits" in character as per F flags.
; TOP characters are aproximately corresponding to the correspondeces
; used on a knight keyboard. Certain exceptions are made for the
; keyboard layout used in the VT52, such as the digits. All alphabetics
; are the same, however.
bckych: tlze f,%imeta
tro a,%txmta
tlze f,%itop
call bcktop ; topify
tlze f,%ictrl
tro a,%txctl
return
bcktop: cail a,140 ; uppercasify, like TV would
subi a,40
caige a,40 ; controls we just top-ify
jrst [ tro a,%txtop
return ]
push p,b
subi a,40 ; offset is from space
idivi a,5 ; index into toptab
ldb a,topbpt(b)
pop p,b
tro a,%txtop
return
;; Table of TOP characters for each alphabetic. These correspond
;; to the TOP-ifing of characters on a Knight keyboard, and
;; make no sence at all. Certain non-alphabetics are modified to
;; correspond with the VT52 keyboard instead of the knight. digits,
;; for example.
;; in format of 7-bit bytes, indexed as offset from space
topbpt: 350700,,toptab(a) ; BP's into toptab
260700,,toptab(a)
170700,,toptab(a)
100700,,toptab(a)
010700,,toptab(a)
toptab:
.byte 7
repeat 14,37+.rpcnt ; space through + are just top of selves
74 ; , -- top-<
75 ; - -- top-=
76 ; . -- top->
77 ; / -- top-?
51 ; 0 -- top-)
41 ; 1 -- top-!
100 ; 2 -- top-@
43 ; 3 -- top-#
44 ; 4 -- top-$
45 ; 5 -- top-%
136 ; 6 -- top-^
46 ; 7 -- top-&
52 ; 8 -- top-*
50 ; 9 -- top-(
73 ; : -- top-;
73 ; ; -- top-;
74 ; < -- top-<
75 ; = -- top-=
76 ; > -- top->
77 ; ? -- top-?
140 ; @ -- top-`
34 ; A -- less than or equal to
7 ; B --PI
3 ; C -- Epsilon
36 ; D -- triple-bar (identically equal)
22 ; E -- intersection
17 ; F -- I duno what it's called.
32 ; G -- Not equal to.
110 ; H -- [HELP]
26 ; I -- circle-with-X
30 ; J -- Back-arrow
31 ; K -- Forward arrow
27 ; L -- back-forward double-arrow
25 ; M -- Existential quantifier
24 ; N -- Universal quantifier
1 ; O -- down arrow
13 ; P -- up arrow
4 ; Q -- conjunction
23 ; R -- union
35 ; S -- greater or equal
20 ; T -- is a subset of
5 ; U -- not
10 ; V -- lambda
37 ; W -- disjunction
3 ; X -- Beta
21 ; Y - is a superset of
2 ; Z -- Alpha
.byte
subttl Random terminal support routines - Output
; SCHO0 - SCHO for insert character mode terminals.
scho0: tlze f,%icm ; insert character mode on?
xct .telim+tb ; yes, turn it off
; SCHO - Default .TRCHO. Display character.
; Argument:
; A Character.
scho: cail a,40 ; control character?
cail a,177 ; or rubout (or worse)?
return ; yes, ignore it
; SCHO1 - SCHO without control character test. Several .TRCHO's JRST here.
scho1: movem a,@scrtab(v) ; store character in screen image
camge h,thmax ; in last column?
paoja h,@.trtyo+tb ; no, output character and advance one position
pjrst @.trtyo+tb ; output character, cursor stays put
; CCHO0 - CCHO for terminals with insert character mode.
ccho0: tlze f,%icm ; insert character mode on?
xct .telim+tb ; yes, turn it off
; CCHO - .TRCHO for terminals which CRLF after typing in the last column.
ccho: cail a,40 ; control character?
cail a,177 ; or rubout (or worse)?
return ; yes, ignore it
; CCHO1 - CCHO without control character test. Several .TRCHO's JRST here.
ccho1: caml h,thmax ; last column?
jrst ccho2 ; yes
movem a,@scrtab(v) ; store character in screen image
paoja h,@.trtyo+tb ; output it, increment horizontal position
ccho2: caml v,tvmax ; last line too?
return ; yes, ignore character completely
movem a,@scrtab(v) ; store character in screen image
move h,thmin ; output character and
paoja v,@.trtyo+tb ; reflect CRLF in actual cursor position
; SIMVBL - Default TX.VBL.
simvbl: movei a,"G ; Default visible-bell routine.
skipe .txso+tb
pjrst chstdo ; output in standout mode.
return
; Output char in "standout" mode if any.
chstdo: call force ; force CLEOL and cursor movement
xct .txso+tb ; enter standout mode
call ordnry ; output character
xct .txsor+tb ; leave mode
return
; VTABS - VT52 style absolute move.
vtabs: tyoesc "Y
tyo 40(nv)
tyo 40(nh)
return
; CHLNCT - counts chars on line, on either side of cursor;
; A gets count of chars from beg of line to cursor,
; B gets count of chars from cursor to EOL. (incl cursor position)
chlnct: push p,c
push p,d
movei d,blchar
movn c,twidth
hrlzs c
hrr c,scrntb(nv) ; Now have AOBJN to start of line
setzb a,b ; clear counts.
chlnc2: caig h,(c) ; See if reached cursor pos yet
jrst chlnc3 ; yes, jump to next loop.
came d,(c) ; not yet. check this char
addi a,1 ; increment cnt if found one
aobjn c,chlnc2
pop p,d
pop p,c ; if cursor at EOL, oh well.
return
chlnc3: came d,(c)
addi b,1 ; in this loop, count B = chars at & after cursor.
aobjn c,chlnc3
pop p,d
pop p,c
return
; SETTAB - used by a few terminals to set tab stops
; the caller is responsible for clearing the terminals tab stop before calling.
settab: pushae p,[a,b,nh,nv]
setzb nh,nv ; home
call frcmov ; ...
move b,shmax ; calculate the no. of tabs to set
lsh b,-3 ; ...
setab1: movei a,8. ; move to next multiple of 8
tyn 40 ; ...
tyoesc "1 ; and set a tabstop there
addi h,(a) ; and update actual cursor pos.
sojg b,setab1
popae p,[nv,nh,b,a]
return
subttl Cursor movement
; MOVCUR - Default cursor movement subroutine.
movcur: dmovem vh,savvh
dmovem nvh,savnvh
; Check requested position to be sure it's within limits.
camge nh,whmin
jrst [ aos errhl ; Jump if horizontal is too small
move nh,whmin ; Force to left edge
jrst movc10
]
camle nh,whmax ; compare with hmax, skip if still OK
jrst [ aos errhg ; NH too big!
move nh,whmax ; Force to right margin
jrst movc10
]
movc10: camge nv,wvmin
jrst [ aos errvl ; Jump if vertical is too small
move nv,wvmin ; force to top line
jrst movc20
]
camle nv,wvmax ; See if about to go off bottom?
jrst [ aos errvg ; Ugh, too big!
move nv,wvmax ; Force to bottom line
jrst movc20
]
movc20: cain h,(nh)
caie v,(nv)
caia
return
pushae p,[a,b,c,d,e] ; save ACs
; Optimizer loop - try each cost-calculation routine
; until find one returning cost of 1, or use
; least-cost one upon finishing table.
move cp,[-cpdlen,,cpdl-1] ; init cursor-motion pdl
hrrzm cp,zxbeg ; store first entry as "best" - abs move.
push cp,[1,,cc.abs]
hrrzm cp,zxend
xct .tcabs+tb ; set best cost to aboslute cursor positioning
movem a,zbestc ; cost
move z,.trzns+tb ; get AOBJN pointer to zone-table
movc30: hrrzm cp,zxsav ; Store ptr to start of list for routine
call @(z) ; Go execute...
jrst movc35 ; failed to get better cost than zbestc.
move b,zxsav
movem b,zxbeg
hrrzm cp,zxend ; aha, save end-ptr to execute list!
caig c,1 ; and if cost =1,
jrst movc40 ; go execute immediately - can't get better.
cail c,nutcst ; Make SURE that never hack missing functions.
.lose
movem c,zbestc ; else store as new best-cost-found.
movc35: aobjn z,movc30 ; Loop thru all zone check rtns.
movc40: aos cp,zxbeg ; done, now find ptr to xct list.
movc45: move b,(cp) ; get an instr
hlrz a,b ; get repeat count
call (b) ; xct stuff at given location.
camge cp,zxend ; and until reach end,
aoja cp,movc45 ; proceed down list.
; Done, but let's make sure...
cain h,(nh)
caie v,(nv)
.lose ; Argh, trying to sneak past, eh?
popae p,[e,d,c,b,a]
return
SECTION MAINVAR
savvh::
savv: block 1
savh: block 1
savnvh::
savnv: block 1
savnh: block 1
SECTION MAIN
; Count of various erroneous attempts to move cursor.
mvar errhl ; Horizontal too small
mvar errhg ; Horizontal too great
mvar errvl ; Vertical too small
mvar errvg ; Vertical too great
; Pointers into CPDL
mvar zxsav ; temp while collecting a path.
mvar zxbeg ; points to first instr in path to xct.
mvar zxend ; points to last instr in path to execute.
mvar zbestc ; Holds cost of best path so far.
; Cursor motion path stack. Used for accumulating paths
; while checking/comparing them.
cpdlen==50
mvar cpdl(cpdlen)
subttl Cursor Control routines
cc.abs: xct .tmabs+tb
dmove vh,nvh
return
cc.ay: xct .tmay+tb
movei v,(nv)
return
cc.ax: xct .tmax+tb
movei h,(nh)
return
cc.hom: xct .tmhom+tb
dmove vh,tmin
return
cc.up: xct .tmup+tb
subi v,(a)
camge v,tvmin
add v,theight
return
cc.dwn: xct .tmdwn+tb
addi v,(a)
camle v,tvmax
sub v,theight
return
cc.fwd: movei b,(a) ; save repeat count
xct .tcfwd+tb ; get move forward cost
caile a,(b) ; terminal's move better than typing
; characters already there?
jrst ccfwd1 ; no, retype characters
move a,b ; .TMFWD arg: repeat count
xct .tmfwd+tb ; move forward
addi h,(a) ; update cursor position
camle h,thmax ; moved past right margin
xct .trnrm+tb ; yes, normalize
return
ccfwd1: move a,@scrtab(v) ; Must index by H,V
call @.trcho+tb ; out it goes!
sojg b,ccfwd1
return
cc.lft: xct .tmbck+tb
subi h,(a)
camge h,thmin
xct .trnrm+tb
return
cc.cr: xct .tmcr+tb
move h,thmin
return
cc.nl: xct .tmnl+tb
move h,thmin
addi v,1
return
cc.tab: xct .tmtab+tb
lsh h,-3
add h,a
lsh h,3
return
subttl Movement optimization - description & defaults
comment |
The movement optimizer is based on the concept of "zones"; a zone,
generally speaking, is the area immediately surrounding the cursor which can
be reached simply by moving in various combinations of up, down, right, or
left. The "primary" zone is simply that around the actual cursor location;
there may be several "secondary" zones, which are centered around some point
that the cursor can reach in a single unusual movement - for example, HOME
and CR are unusual. Anything which produces movement in two coordinates at
once, or an arbitrary amount in one direction, is "unusual" because the
zone-optimizer (which figures out the least-cost movement given a particular
zone) only handles specific units of independent X and Y motion.
When the overall optimizer is called, it is pointed at a table of zones
to check (the default table is ZT1). The first zone is the primary one,
and it finds the cost of moving when no "unusual" commands are used. All
the others are secondary zones; what they do is start with the cost of
executing some unusual move, and then pretend that the cursor has actually
been moved there, calling the faked-out zone-optimizer to see what the
cost of moving is now with no further unusual commands.
Each zone-test routine is required to accept in H,V the current
cursor position and in NH,NV the desired cursor position; on a successful
(skipping) return, it must return in A the cost (# of chars) of the particular
strategy it represents, which is returned on a stack pointed to by CP.
Each strategy consists of first an unusual move (except for the primary zone
of course), followed by any necessary regular movements to reach NH,NV.
All that the zone-test routine needs to do to specify some particular
commands is:
PUSH CP,[<# times to xct>,,<rtn to xct>]
If the total cost proves lowest of all zones tested, the commands stored by
the winning zone will be executed in the order they were pushed on the CP
stack. NOTE: it is not necessary to always specify a complete set of
commands; if the zone-test routine by some heuristic finds that its cost
will be no better than the best-so-far, it can return immediately, provided
that it fails to skip. Any commands it stored will be ignored.
EXAMPLE:
Note that ZTEST is the basic primary zone tester. ZTHOM is a typical
secondary-zone tester; it stores on CP a command to do a home-up, finds
the cost of this unusual move, and updates the NH,NV coordinates so as to
fake out ZTEST, which it then calls via an entry point that preserves
the cost thus far.
CUSTOMIZING:
To specify your very own zone table for a terminal, just put
an AOBJN pointer to it in the TR.ZNS declaration, e.g.
TR.ZNS -foxzln,,foxzns
This allows you to specify more "unusual" commands to be used in optimization
rather than just settling for those of the default zone-table (ZT1).
The zone concept need not even be adhered to; all the optimizer
is really doing is seeing which routine can specify the lowest-cost strategy.
To prevent wasting too much time, frequent checks of the cost-thus-far
should be made to see if it is > or = to the best-cost-thus-far (ZBESTC),
and an immediate loss return made if so. The first entries in the zone table
should be those with the highest probability of returning the lowest cost.
One other heuristic, done by the overall optimizer, is that anything with a
cost of 1 will be executed immediately when the zone-test routine returns.
To reiterate the requirements for zone-test routines:
Called via CALL
Inputs:
H,V - current cursor location
NH,NV - desired cursor location
CP - Cursor stack pointer; commands pushed on this.
Outputs:
A - total cost of commands pushed on CP (# chars required)
CP - updated stack pointer
Returns to:
.+1 on failure; A can have garbage.
.+2 on success.
Routine must not clobber NH,NV,H,V. It is OK to smash
acs B,C,D,E freely.
WRAP-AROUND:
It is possible to have the optimizer take screen wrap-around into
account, by specifying a routine in the TR.WRP declaration. There is no
default action since wrap-around is highly terminal dependent. The idea is
that after ZTEST finds out what relative motions are called for, the
wrap-around routine will be invoked to take a look at these values (lying in
D for horizontal movement, E for verical movement) and decide whether it is
possible for motion in the OPPOSITE direction to successfully wrap around the
screen and thereby reach the target faster. If so, the routine will simply
clobber D and/or E as appropriate to reverse the sign and furnish a
presumably smaller magnitude, and return to let the rest of the optimization
proceed. See HPWRP and I43WRP for good examples. Be careful in writing
wrap handlers; things like FSTFWD and tabs make it difficult to optimize
forward movement into wrapping backward movement.
Of course, this could be integral with some terminal's own zone-test
routine, should it so desire. But the current location of the invocation, in
ZTEST, is the most general place. For example, if left-edge wraparound is
possible, then to move the cursor from screen center to upper right corner
can be done by means of a home-up followed by a backspace - and the optimizer
will do it! |
; ZT1 - zone table for terminals with the basic set of secondary zones.
zt1: ztest ; primary zone - no weird moves
zthom ; home then test
ztcr ; CR then test
lzt1==.-zt1
; ZT2 - zone table for terminals with NL.
zt2: ztest ; relative move
zthom ; home and relative move
ztcr ; CR and relative move
ztnl ; NL and relative move
lzt2==.-zt2
; ZT3 - zone table for terminals with independent absolute Y and X moves.
zt3: ztest ; relative move
zthom ; home and relative move
ztcr ; CR and relative move
ztay ; absolute Y move and relative X move
ztaycr ; absolute Y move, CR, and relative X move
ztax ; absolute X move and relative Y move
lzt3==.-zt3
; ZTAY - Absolute Y move and relative move check.
ztay: pushae p,[h,v]
push cp,[1,,cc.ay]
xct .tcay+tb ; start with absolute Y move cost
movei c,(a) ; ...
movei v,(nv) ; effect absolute Y move
jrst ztestc
; ZTAYCR - Absolute Y move, CR, and relative move check.
ztaycr: pushae p,[h,v]
push cp,[1,,cc.ay]
xct .tcay+tb ; start with absolute Y move cost
movei c,(a) ; ...
movei v,(nv) ; effect absolute Y move
push cp,[1,,cc.cr]
xct .tccr+tb
add c,a ; add CR cost
move h,thmin ; effect CR
jrst ztestc
; ZTAX - Absolute X move and relative move check.
ztax: pushae p,[h,v]
push cp,[1,,cc.ax]
xct .tcax+tb ; start with absolute X move cost
movei c,(a) ; ...
movei h,(nh) ; effect absolute X move
jrst ztestc
; ZTHOM - Home and relative move check.
zthom: pushae p,[h,v]
push cp,[1,,cc.hom]
xct .tchom+tb ; start with home cost
move c,a ; ...
dmove vh,tmin ; home
jrst ztestc
; ZTNL - Newline and relative move check.
ztnl: caml v,tvmax ; last line?
return ; yes, forget NL!
pushae p,[h,v]
push cp,[1,,cc.nl]
xct .tcnl+tb ; start with NL cost
move c,a ; ...
move h,thmin ; effect NL
aoja v,ztestc
; ZTCR - CR and relative move check.
ztcr: pushae p,[h,v]
push cp,[1,,cc.cr]
xct .tccr+tb ; start with CR cost
move c,a ; ...
move h,thmin ; effect CR
; drop thru for cost & zone check
ztestc: caml c,zbestc
jrst ztstc9 ; blew it already
call ztest0 ; now try zone around new position.
jrst ztstc9
aos -2(p) ; won!
ztstc9: popae p,[v,h]
return
; ZTEST - PRIMARY ZONE TESTER
; This is the hairy, basic zone tester that tries to find
; the best possible path from current H,V to NH,NV using only
; basic up/down/right/left commands.
ztest: movei c,0 ; start off cost at zero
ztest0: move d,nh ; entry point to avoid smashing cost
sub d,h
move e,nv
sub e,v ; Get differences NH-H, NV-V in D, E
xct .trwrp+tb ; adjust to consider wraparound
; test V movement
jumpe e,ztest2 ; skip if none needed
jumpg e,[ ; V movement downward.
move a,e
xct .tcdwn+tb ; check V cost.
add c,a
caml c,zbestc
return
push cp,[cc.dwn]
hrlm e,(cp) ; store iteration value.
jrst ztest2
]
movn a,e
xct .tcup+tb ; V movement upward.
add c,a
caml c,zbestc
return
push cp,[cc.up]
movn a,e
hrlm a,(cp)
; Check H movement
ztest2: jumpe d,ztest8 ; jump if no movement necessary.
jumpl d,[ ; Backward H movement.
movn a,d
xct .tcbck+tb
add c,a
caml c,zbestc
return
push cp,[cc.lft]
movn a,d
hrlm a,(cp)
jrst ztest8
]
cain d,1 ; moving forward by 1?
jrst [ addi c,1 ; yes, don't consider tabs
caml c,zbestc ; compare to best so far
return ; no better
push cp,[1,,cc.fwd] ; better!
jrst ztest8
]
; Forward H movement. Hairy - check for tabs etc.
mvar zsc ; saved C
mvar zsd ; saved D
movem c,zsc
movem d,zsd
; Calculate the no. of tabs to move to before desired horizontal position and
; no. of positions remaining.
move e,h ; find tabstop at or before current position
trz e,7 ; ...
move d,nh ; subtract from desired position to get
subb d,e ; distance from tabstop
andi d,7 ; low three bits are positions remaining
lsh e,-3 ; higher bits are no. of tabs
jumpn e,.+2
move d,zsd
; Calculate cost of tabs and forward moves.
move a,e ; calculate cost of tabs
xct .tctab+tb ; ...
add c,a ; add to cost
caml c,zbestc ; too big?
jrst ztest5 ; yes, forget tabs
move a,d ; calculate cost of forward moves
xct .tcfwd+tb ; ...
camle a,d ; compare the terminal's move forward to ours
move a,d ; ours (FSTFWD) is better
add c,a ; add to cost
; Check if possible to overtab and then backspace.
movei a,10(nh) ; find tabstop beyond desired position
trz a,7 ; ...
camle a,thmax ; too big?
jrst ztest4 ; yes, forget overtabbing
; Calculate cost of overtabbing and backspacing.
move b,zsc ; start with accumulated cost
sub a,nh ; subtract desired position to find no. of
; backspaces
xct .tcbck+tb ; calculate cost of backspaces
add b,a ; add to cost
movei a,1(e) ; calculate cost of overtabbing
xct .tctab+tb ; ...
add b,a ; add to cost
caml b,c ; overtabbing better than not?
jrst ztest4 ; no
move c,b ; yes
caml c,zbestc ; overtabbing best?
jrst ztest5 ; no
; Overtabbing and backspacing is best.
push cp,[cc.tab]
addi e,1
hrlm e,(cp)
push cp,[cc.lft]
movei d,10(nh)
trz d,7
sub d,nh
hrlm d,(cp)
jrst ztest8
; TAB-SP is better than TAB-BS.
ztest4: caml c,zbestc
jrst ztest5
; TAB-SP is best.
jumpe e,.+3
push cp,[cc.tab]
hrlm e,(cp)
jumpe d,ztest8
push cp,[cc.fwd]
hrlm d,(cp)
jrst ztest8 ; win!
; Use plain old spaces to get there.
ztest5: move c,zsc ; restore C, cost so far
move d,zsd ; restore D, horizontal difference
ztest6: move a,d ; calculate cost of move forward
xct .tcfwd+tb ; ...
camle a,d ; compare the terminal's move forward to ours
move a,d ; ours (FSTFWD) is better
add c,a ; add move forward cost to cost so far
caml c,zbestc ; compare to best so far
return ; worse, oh well
push cp,[cc.fwd]
hrlm d,(cp)
ztest8: aos (p)
return
constants
loc <.+pg$siz-1>&#pg$msk ; align on page boundary
subttl Terminal Definition Macros
comment |
These macros are intended to be used in the following sequence:
TRMBEG <symbol>:,<name> ; The ":" is so CREF listings will notice it)
trmup <this>
trmdwn <that>
...
<other table specification macros>
<special routines pointed to by table entries if any>
TRMEND
The initial TRMBEG macro aligns to page boundary and
reserves room for terminal table entries, which the following
macros insert stuff into. Each entry is characterized by a
name of 3 letters max such as DWN, HOM, UP, etc. as well as 1 group
letter such as M, E, etc. and has 3 symbols associated with it:
( "g" represents group letter, "xxx" the name)
[1] Tg.xxx - A MACRO which takes one whole-line argument and
stuffs it in the entry of that name, for the terminal
currently being defined.
[2] .Tgxxx - An OFFSET from the start of that terminal's table, ie an
index to that entry. Thus one uses XCT TB+.Tgxxx etc.
[3] TBgxxx - An ADDRESS defined as TB+.Tgxxx so that DDT can
report more informative things than "TB+45". It is
recommended that source code use the "TB+.Tgxxx" form however.
The TMCDEF macro exists for defining entries given their names.
As a special case, TMVDEF will define a special sort of move-group
macro which takes two args (one for the move code, one for its cost)
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
IF1 ntcvar==0 ; initialize offset/definition count
; TMCDEF <group>,<entry name> - defines a terminal-table entry.
define tmcdef g,nam ; Macro for defining table entries
if1 ntcvar==<.T!g!nam==ntcvar>+1
if2 TB!g!nam=:tb+.T!g!nam ; TB undefined on pass1
define T!g!.!nam -arg
ifb [arg],.err Argument must be given to T!g!.!nam
loc %%toob+.T!g!nam
arg
termin
termin
; TADEF <name> defines a absolute cost terminal-table entry.
define tadef nam
if1 ntcvar==<.TC!nam==ntcvar>+1
if2 TBC!nam=:tb+.TC!nam
define TC.!nam -arg
ifb [arg],.err Argument must be given to TC.!nam
if1 {arg
.stop }
loc %%toob+.TC!nam
.x.==arg ; because arg may have comment etc.
ifn 777777&(.x.), .x.
.else movei a,.x.
termin
termin
; TCDEF <name> defines a relative cost terminal-table entry.
define tcdef nam
if1 ntcvar==<.TC!nam==ntcvar>+1
if2 TBC!nam=:tb+.TC!nam
define TC.!nam -arg
ifb [arg],.err Argument must be given to TC.!nam
if1 {arg
.stop }
loc %%toob+.TC!nam
.x.==arg
ifn 777777&(.x.), .x.
.else {
ife .x.-1, jfcl ? .stop
ife .x.-2, lsh a,1 ? .stop
ife .x.-4, lsh a,2 ? .stop
imuli a,.x.
}
termin
termin
; TMVDEF <entry name> - defines two entries at once for a
; move group routine: .TMxxx for the code, and .TCxxx
; for the associated cost. The resulting TM.xxx macro
; takes the cost as an additional argument, to make its
; use easier.
define tmvdef x,nam
t!x!def nam
if1 ntcvar==<.TM!nam==ntcvar>+1
if2 TBM!nam=:tb+.TM!nam
define TM.!nam cost,-arg
TC.!nam cost
ifb [arg],.err Argument must be given to TM.!nam
loc %%toob+.TM!nam
arg
termin
termin
; TRMBEG <sym>:,[<name1>,<name2>...]
; Begins a terminal definition. The ":" after <sym> is
; so that CREF's will semi-win; at least one name must be specified
; such that the first is "official" and any of these in command line
; will be recognized as meaning this terminal type. (someday)
%%ntrm==-1 ; Initialize no. of terminals defined
%%tchk==0 ; and check flag
ifndef minrem,minrem==ntcvar+60 ; minimum amount of leftover space in page
; necessary to avoid page force. Set 0 to
; never force, PG$SIZ to always force.
define trmbeg sym,(name)
ifn %%tchk, .err No TRMEND for previous TRMBEG?
%%tchk==1
%%tmp==<.+pg$siz-1>&#pg$msk ; find start of next page, and if this one
ifl <%%tmp-.>-minrem, loc %%tmp ; doesn't have much room, move to new one.
fpage==./pg$siz ; first page
%%ntoo==0
trmtoo sym,name
termin
; TRMTOO is used to define a new terminal type within a TRMBEG-TRMEND pair.
define trmtoo sym,list
%%ntrm==%%ntrm+1
%%ntoo==%%ntoo+1
ifle maxtrm-%%ntrm, .err Too many crt types!?
if2 {irp name,,[list]
ife %%ntrm,{printx /Term/ ? printx /inals: !name/}
.else printx /,!name/
.istop
termin }
sym ; Def <sym> as start of definitions
%%toob==.
if2 { tmploc trmtab+%%ntrm,{ %%toob }
}
block ntcvar+1
irp name,,[list]
tp.nam [sixbit /name/],,[asciz /list/]
.istop
termin
crty.d ; stick in basic defaults
termin
; TABEND - end terminal definition table.
define tabend
loc %%toob+ntcvar+1
termin
; TRMEND - used when terminal definition finished.
define trmend
ife %%tchk, .err TRMEND seen without a preceding TRMBEG?
%%tchk==0
constants
lpage==<.-1>/pg$siz ; last page occupied
if2 repeat %%ntoo, tmploc pagtab+%%ntrm+1-%%ntoo+.rpcnt,{ fpage,,lpage }
termin
; ////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
;<<<<<<<<<<<<<<<< Terminal-table Entry Definitions >>>>>>>>>>>>>>>>>
; \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\/////////////////////////////////
; Display controls - Move and Cost group. (M, C)
; These use the TMVDEF macro instead of TMCDEF,
; so that resulting macros will take cost as additional arg.
tmvdef C,UP ; Move up
tmvdef C,DWN ; Move down
tmvdef C,FWD ; Move forward (right)
tmvdef C,BCK ; Move backward (left)
tmvdef C,TAB ; Move to next tab stop (every 8 chars)
tmvdef A,CR ; Move to beginning of line
tmvdef A,NL ; Move to new line (CR and DWN)
tmvdef A,HOM ; Home up (0,0)
tmvdef A,AX ; Absolute X move
tmvdef A,AY ; Absolute Y move
tmvdef A,ABS ; Absolute move (X,Y)
; Display controls - Erase/Edit group (E)
tmcdef E,DEL ; Delete forward
tmcdef E,WIN ; Set window
tmcdef E,EOL ; Erase to EOL (End of Line)
tmcdef E,EOS ; Erase to EOS (End of Screen)
tmcdef E,CLR ; Clear screen and home up
tmcdef E,SU ; Scroll screen up if at bottom, and go to beg of line.
tmcdef E,SD ; Scroll screen down
tmcdef E,EIM ; Enter insert character mode
tmcdef E,LIM ; Leave insert character mode
tmcdef E,ICP ; Insert char position
tmcdef E,DCP ; Delete char position
tmcdef E,ILP ; Insert line position
tmcdef E,DLP ; Delete line position
; Display controls - Misc group (X)
tmcdef X,BEL ; Ring bell
tmcdef X,VBL ; Show visible bell
tmcdef X,SO ; Go into standout mode
tmcdef X,SOR ; Leave standout mode
; Routine & dispatch group (R)
tmcdef R,INI ; Initialization routine
tmcdef R,FIN ; Cleanup routine
tmcdef R,TYO ; Dispatch for own TYO processing
tmcdef R,TYI ; Dispatch for own input processing
tmcdef R,CHO ; Dispatch for own ordinary-character output
tmcdef R,MOV ; Dispatch for cursor mover
tmcdef R,ZNS ; Pointer to table of tailored optimization routines
tmcdef R,WRP ; Routine for optimization wraparound if any
tmcdef R,NRM ; Wrap normalization
tmcdef R,SMO ; SIMULATION: STY output-char routine address
tmcdef R,SMI ; SIMULATION: STY input loop address
tmcdef R,SMF ; SIMULATION: STY input loop output finalizer address
tmcdef R,WI ; Window initialize
IFN STY,{
tmcdef R,WB ; Wholine begin
tmcdef R,WE ; Wholine end
}
IFE STY,{
define tr.wb -x
termin
equals tr.we,tr.wb
}
; Parameters group (P) - includes flags
tmcdef P,FLG ; Flag word, holds various flags
tmcdef P,NAM ; Holds sixbit name of terminal
tmcdef P,HSZ ; Horizontal screen size
tmcdef P,VSZ ; Vertical screen size
tmcdef P,SCR ; Scroll count
;============================================================================
; .TPFLG flag definitions - put into RH of F
%f==525252 ; mask for terminal flags in F
%fsmeol==:1 ; Wants "Smart CLEOL".
%fcsel==:2 ; Do %TDEOL instead of %TDEOF - i.e. don't do CLEOS.
%fsail==:4 ; SAIL characters available on output
%ffci==:10 ; Full character input
%fspd==:20 ; need to know the output speed
%fneol==:40 ; No simple clear-to-EOL.
%fneos==:100 ; No simple clear-to-EOS.
%fnclr==:200 ; No simple clear-and-home.
%fnsu==: 400 ; No simple scroll up
%fnsd==: 1000 ; No simple scroll down
%fnicp==:2000 ; No simple insert character
%fndcp==:4000 ; No simple delete character
%fnilp==:10000 ; No simple insert line
%fndlp==:20000 ; No simple delete line
%fbow==:40000 ; inverse video on
%ff1==:200000 ; reserved for terminal handlers
%ff2==:400000 ; reserved for terminal handlers
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; CRTY.D - sets up basic defaults; stuck into ALL terms by TRMBEG.
define crty.d
if1 .stop
irp x,,[up,dwn,fwd,bck,cr,nl,tab,hom,ax,ay,abs]
tc.!x movei a,nutcst ; Set costs to something absurd
termin
tp.scr 1 ; scroll count of 1
tr.zns -lzt1,,zt1 ; default zone table
tr.ini call absclr ; default init routine
tr.fin jfcl
tr.tyo bufc
tr.tyi styi
tr.cho scho
tr.mov movcur
tr.wrp jfcl
tr.wi swi
tr.wb whowb
tr.we whowe
te.win jfcl
tx.bel tyo ^G
tx.vbl call simvbl
termin
nutcst==5000. ; Use this as default "absurd cost" for missing functions.
ltb==ntcvar ; Set length of TB for copying term table into.
mvar trmadr ; holds addr of selected supporter definition.
mvar simadr ; Holds addr of selected simulator definition.
mvar tb(ltb) ; TB table - term tab copied here for fast impure ref.
subttl Notes about terminal-table entries
Comment |
Someday this may be a guide to adding terminals. For now it is a page
devoted to various notes about the conventions surrounding terminal-table
entries:
*> The TR.INI entry is XCT'd and must do two basic things: home the cursor
and clear the screen. A TR.INI entry must be provided! The screen image is
cleared and NH,NV and H,V are zero'd before .TRINI is XCT'd.
If a routine is furnished which types anything out (as in
warning messages), the coordinates and the screen image must be
maintained. If this sounds too difficult, just clear the screen again
after doing whatever you like. But since ITS automatically sends
a %TDCLR when the STY is ^Z'd, in general it's OK to just maintain the
cursor position. In general.
*> If a TM.ABS entry exists, it is not necessary to have any other TM.xxx
entries; the optimizer will always use whatever is available, and fall
back on absolute move when necessary. (although this depends on the
zone-table used.) If TM.ABS does NOT exist, then one must use common
sense and make sure that some way exists for the optimizer to move
the cursor up, down, left, and right, by whatever means. (This means
it is perfectly OK to have TM.HOM as the only way of moving up and left!)
The reason all this works is because the cost for non-specified entries
is set to an absurd figure which the optimizer will reject immediately.
*> The routine furnished for TM.ABS must whenever possible pay no
attention to H,V and simply assume that the cursor may be anywhere on
the screen, and move it to NH,NV. Otherwise, the power of absolute
move is compromised. MOVCUR will do necessary optimization if TM.AX
and TM.AY entries happen to exist (and the proper zone table is used).
*> Groups M, C, E, and X are always XCT'd. P's are always data
values. R's can be various things, (TR.ZNS is an AOBJN pointer for the
MOVCUR optimizer) but basically a "routine" is always XCT'd, and a
"dispatch" is JRST @'d to; such code is written only with a
good understanding of what calls them and what the effects should be
and where control should return.
*> Note that the insert/delete line/character functions (TE.ILP, TE.DLP,
TE.ICP, TE.DCP) and the relative movement functions (TM.FWD, TM.BCK,
TM.UP, TM.DWN, TM.TAB, TM.NL) take an argument in A saying how many
times to perform the function. Without exception, this value MUST NOT
BE CLOBBERED by the execution of these functions.
*> TR.WI is called to initialize window variables.
*> TR.WB, TR.WE are terminal hooks into the wholine display.
TR.WB after the window is switched but before outputing anything,
TR.WE just after it's all output.
*> The entries TR.SMI, TR.SMF, and TR.SMO are completely unlike any
others, because they represent the capability of SIMULATING the
terminal rather than supporting it! TR.SMI should be ZERO (i.e.
unspecified) if no such capability exists; if so, it and the others
will be defaulted appropriately. Basically, TR.SMI and TR.SMO point
at the SMI and SMO process modules, which normally are SWSMI and SWSMO
to "simulate" the ITS Software virtual terminal.
These entries are also unlike other entries in that for a
terminal-support selection, their values are ignored and in fact
smashed with the values of TR.SMx for the terminal being simulated!
Talk to KLH if you have ideas of using these, to make sure you really
understand what is going on.
*> Note that TR.SMI if it exists should point at a loop similar to that
for SWSMI. In particular a STYINC macro invocation MUST be the first
thing that is executed upon dispatch to the loop! Otherwise you will
lose horribly and totally, because initial vectoring depends on this.
What the SMI module basically does is run at output interrupt level,
reading chars via STYINC and outputting them via TR.CHO and calling the
appropriate TD.XXX routines for various functions.
*> Note that TR.SMO if it exists must also point at a loop similar
to that for SWSMO. In particular, a CALL SMOGET MUST be the first
thing that is executed upon dispatch to the loop! Again, initial vectoring
depends on this. The SMO module is required to input chars via SMOGET
and output them via SBOUT.
*> The TR.TYI entry points at the TYI module for a particular terminal.
As such it is required to input chars via TYIGET and output them via
TYIPUT, and loop forever like STYI does.
*> Re AC usage:
Be very very careful about writing code for either the TYI or SMO
modules (i.e. which TR.TYI and TR.SMO point to), because they function
at TYIC interrupt level and only a few ACs are saved. If any acs are
to remain clobbered across a TYIGET or SMOGET call, they had better
be ones that TTYINT saves and restores!!
As already mentioned, any functions taking an argument in A should
save it. More generally, everything in a terminal definition should
avoid clobbering any ACs, with the following exceptions:
T1 and T2 are fair game.
Any TM.XXX routine can clobber B,C,D,E freely.
NH and NV may be set if one wishes to move the cursor; but see
discussion of "actual and virtual cursor position".
*> Actual and Virtual cursor position:
This section is supposed to explain about H,V vs NH,NV and
when you should use one and when the other. Should also explain
when and why it is necessary to effect a cursor force.
Theoretically, H,V represent the actual, physical position of
the cursor on the terminal's screen. NH and NV represent the
"virtual" position - where the cursor is in the mind of ITS (or whatever
program is running under the STY), and where all new operations
(char output, line insert, etc) are to take place. As a result of
CRTSTY's optimization algorithms, the two positions are sometimes
different. Whenever an operation is about to be executed which
does not simply consist of moving the cursor (in which case one merely
changes NH,NV), it is necessary to make sure that NH and NV reflect
reality and are identical to H,V; MOVCUR is the routine that will
ensure this.
|
comment ~
Here is a sample terminal definition:
subttl FOO - Find Outer Otter Terminal
trmbeg FOO:,[FOO]
tp.flg 0 ; Terminal flags. Chosen from:
; %fsmeol, %fcsel, %fsail, %ffci
tp.vsz 24. ; no. of lines displayable on the screen
tp.hsz 80. ; no. of characters per line
tp.scr 1 ; scroll count (defaults reasonably)
tr.ini call fooini ; call to initialization procedure
tr.fin call foofin ; call to finialization procedure (defaults
; reasonably)
tr.tyi footyi ; input character handler (defaults reasonably)
tr.tyo footyo ; output character handler (defaults
; reasonably)
tr.cho foocho ; display character routine (defaults
; reasonably, but use CCHO if terminal CRLFs
; after typing in the last column)
tr.zns -lzt1,,zt1 ; AOBJN to zone table (defaults reasonably)
tr.wrp call foowrp ; call to wrap handler (defaults reasonably)
tr.nrm call foonrm ; call to normalizer (needed only if TR.WRP
; specified)
tm.up 2,tynesc "A ; move up n
tm.dwn 1,tyn ^J ; move down n (LF)
tm.fwd 2,tynesc "C ; move forward n
tm.bck 1,tyn ^H ; move back n (BS)
tm.tab 1,tyn ^I ; move to nth next tabstop (TAB)
tm.cr 1,tyo ^M ; move to left margin (CR)
tm.nl 2,tyo ^_ ; move to beginning of next line (NL)
tm.hom 2,tyoesc "H ; move to upper left corner (home)
tm.ax 3,call fooah ; absolute horizontal move
tm.ay 3,call fooav ; absolute vertical move
tm.abs 6,call fooabs ; absolute move
te.eol tyoesc "K ; erase to end of line
te.eos tyoesc "J ; erase to end of screen
te.clr tyoesc "j ; erase whole screen (and home)
te.su tyn ^J ; scroll the screen up
te.sd tynesc "I ; scroll the screen down
te.eim tyoesc "Q ; enter insert character mode
te.lim tyoesc "R ; leave insert character mode
te.icp tynesc "@ ; insert n character positions
te.dcp tynesc "P ; delete n character positions
te.ilp tynesc "L ; insert n lines
te.dlp tynesc "M ; delete n lines
tx.so call fooso ; enter standout mode
tx.sor call foosor ; exit standout mode
tx.bel tyo ^G ; ring bell (defaults reasonably)
tx.vbl call foovbl ; visible bell
tabend
; Various support routines called above.
trmend
~
subttl AAD - Ann Arbor Display Controller
; The E.E. Plasma group and JLK has these (anyone else?)
; No padding is needed.
trmbeg AAD:,[AAD]
tp.flg %fsmeol
tp.vsz 24.
tp.hsz 80.
tr.cho ccho
tm.up 1,tyn 16
tm.dwn 1,tyn 12
tm.fwd 1,tyn 11 ; tab moves over one space
tm.bck 1,tyn 10
tm.cr 1,tyo 15
tm.hom 1,tyo 13
tm.abs 3,call aadmv
te.clr tyo 14
te.su tyn ^J
tx.vbl call aadvbl
tabend
aadmv: pushae p,[a,b]
tyo ^O ; abs cursor pos command
movei a,(nh) ; cretinous BCD type format
idivi a,10.
lsh a,4 ; high bits are 10's digit
iori a,(b) ; or in remainder (should only be 4 bits)
call @.trtyo+tb
movei a,100(nv)
call @.trtyo+tb
popae p,[b,a]
return
aadvbl: pushae p,[nh,nv]
movei nh,70.
movei nv,23.
call aadmv
zout [asciz /########/]
movei nh,70.
call aadmv
zout [asciz /--Bell--/]
popae p,[nv,nh]
return
trmend
subttl ANNARB - Ann Arbor Display
trmbeg ANNARB:,[ANNARB]
tp.flg %fsmeol
tp.vsz 40.
tp.hsz 80.
tr.ini call annini ;
tr.cho ccho
tm.up 1,tyn ^N
tm.dwn 1,tyn ^J
tm.fwd 1,tyn ^_
tm.bck 1,tyn ^H
tm.tab 1,tyn ^I
tm.cr 1,tyo ^M
tm.hom 1,tyo ^K
tm.abs 3,call annabs
te.clr tyo ^L
te.su tyn ^J
tabend
annini: xct .teclr+tb ; clear whole screen
push p,nh
movei nh,8.
annin1: call annabs
tyo ^] ; set tabstop in current column
addi nh,8.
camg nh,shmax
jrst annin1
pop p,nh
return
annabs: pushae p,[a,b]
tyo ^O ; abs cursor pos command
movei a,(nh) ; cretinous BCD type format
idivi a,10.
lsh a,4 ; high bits are 10's digit
iori a,(b) ; or in remainder (should only be 4 bits)
call @.trtyo+tb
movei a,100(nv)
cail a,20.+100
addi a,12.
call @.trtyo+tb
popae p,[b,a]
return
trmend
subttl AAB - Another Ann Arbor
trmbeg AAB:,[AAB]
tp.flg %fsmeol
tp.vsz 40.
tp.hsz 80.
tr.cho ccho
tr.wrp call aabwrp
tm.up 1,tyn ^N
tm.dwn 1,tyn ^J
tm.fwd 1,tyn ^I ; yes, tab
tm.bck 1,tyn ^H
tm.cr 1,tyo ^M
tm.hom 1,tyo ^K
tm.abs 3,call aababs
te.clr tyo ^L ; 2ms padding needed
te.su tyn ^J
tabend
aababs: pushae p,[a,b]
tyo ^O ; abs cursor pos command
movei a,(nh) ; cretinous BCD type format
idivi a,10.
lsh a,4 ; high bits are 10's digit
iori a,(b) ; or in remainder (should only be 4 bits)
call @.trtyo+tb
movei a,(nv)
cail a,20.
addi a,12.
call @.trtyo+tb
popae p,[b,a]
return
; Arguments:
; D horizontal distance
; E vertical distance
aabwrp: caile e,20. ; moving more than 20 lines down?
sub e,theight ; yes, use 40-n move ups instead
return
trmend
subttl Ann Arbor Ambassador - Ann Arbor Terminals Ambassador
trmbeg AAA:,[AAA]
;;; Added by RLL on 09/07/80. The Ambassador is supposed to implement
;;; the full ANSI X3.64-1979 standard for Video display terminals.
tp.flg 0
tp.vsz 48. ; 60 is too scrunched
tp.hsz 80.
tr.ini call aaaini
tr.fin call aaafin
tr.cho scho0
tr.wb call aaawb
tr.we call aaawe
tm.up 3,tynans "A
tm.dwn 1,tyn ^J
tm.fwd 3,tynans "C
tm.bck 1,tyn ^H
tm.tab 1,tyn ^I
tm.cr 1,tyo ^M
tm.nl 2,tyoesc "E
tm.hom 3,tyoans "H
tm.abs [call aaamvc] call aaaabs
;te.del tyoans "X ; can take argument, but CRTSTY doesn't know
; about that
te.eol tyoans "K ; 5ms to clear one line
te.eos call aaaeos ; needs padding
te.sd tynans "M
te.su tyn ^J
te.icp tynans "@ ; 4 ms
;Don't use insert mode; it frys your brain to see the cursor flash so fast.
;te.eim tyoesc "6 ; toggle character insertion mode
;te.lim tyoesc "6 ; toggle character insertion mode
te.dcp tynans "P ; 4 ms
te.ilp tynans "L ; 3 ms
te.dlp tynans "M ; 3 ms
tx.vbl call aaavbl ; VISBEL
tx.so call aaaso ; Complement video
tx.sor call aaasor ; Un-highlight (Back to requested video)
tabend
;;; Finish up routine. Called on exiting CRTSTY.
aaafin: tyoans "> ; turn wrap in last column on
zout [asciz "33h"] ; ...
zout [asciz "[60;;;"] ;]
; memory size = 60, upper host area = 0,
; lower host area = 0
move a,sheight ; TYODEC arg: A = no.
call tyodec ; screen size = specified value
tyo "p ; ...
setzb h,v ; cursor homed
return
;;; Initialization.
;;; We don't touch Guarded Area Transfer (1), Keyboard Action Mode (2),
;;; Format Effector Transfer (14), Multiple Area Transfer (15), Transfer
;;; Termination (16), Selected Area Transfer (17), Margin Bell (25), Key
;;; Click (26), Key Repeat (28), Block Cursor (31), Blinking Cursor (32),
;;; Auto Pause (38), Transfer Pointer Display (41), Line Transfer (42),
;;; Column Separator Transfer (43), Field Separator Transfer (44), Graphic
;;; Rendition Transfer (45), Fast Repeat (47), Hold in Area (48), Guarded
;;; Area Print (49), or Function Key Initialize (50).
aaaini:
IFN 0,[ ; commented out because can't call TYIGET yet at initialization
; must come up with some kludge like splicing this to the TTY
; input co-rotuine
;; Find out revision number of terminal and if its high enough
;; tell ITS it has a Meta key. This code is very Ann Arbor
;; specific. Perhaps one day a general subroutine for parsing
;; ANSI reply sequences would be useful.
zout [asciz "[0c"] ;] ; Request a device attributes report
call obfsnd ; make sure its sent out
call finish
call tyiget ; read a character from terminal
caie a,33 ; DA reply should start with an escape
jrst aanorp ; if not, its not right reply. If this
; isn't a timeout is there someway to give
; char back?
call tyiget ; should be left bracket
jumpn a,aanorp ; give up on timout
call tyiget ; should be <
jumpn a,aanorp ; give up on timout
call tyiget ; get first digit of verison number
jumpn a,aanorp ; give up on timout
caie a,"0 ; if its not 0, it must be higher
jrst aagotm ; so its got a meta key
call tyiget ; get 2nd digit
jumpn a,aanorp ; give up on timout
caile a,"1 ; if greater than version 1
jrst aagotm
call tyiget ; next read revision number, count on version
caie a,"; ; number never breaking 2 digits
jrst aanorp
call tyiget ; get first digit of revision number
jumpn a,aanorp
caile t1,"1 ; version 20 or greater is good enoguh
jrst aagotm
cain t1,"0 ; but leading 0 TSis a loser
jrst aaflsh
cail a,"1 ; 2nd digit 1 or greater?
jrst aaflsh ; no, then rev 10 doesn't have meta key
aagotm: ;; its got a meta key, turn on the bit
$call ttyvar,[#pyi,[sixbit/ttyopt/],#0,[tro %tpmta]]
.lose %lsfil
aaflsh: call tyiget ; flush rest of reply, eitehr by
jumpl a,aanorp ; time out or end of string..
caie a,"c ; reply string ends with a "c"
jrst aaflsh
aanorp:
] ; IFN ITS
;;; ANSI modes:
setzm padc ; ^@ is the pad character
tyoesc "[ ;] ; start of modes to reset
zout [asciz "4;"] ; Turn off Insert Character Mode
zout [asciz "18;"] ; Select Tab mode to have tabs in columns
; on the whole screen
zout [asciz "20l"] ; LF is Line Feed rather than New Line
tyoesc "[ ;] ; start of modes to set
zout [asciz "6;"] ; Enable clearing the entire screen
; (protected field nonsense)
zout [asciz "12h"] ; Enable sending to host
zout [asciz "[1Q"] ;] ; Insert/delete character stop at end of
; line
;;; Ann Arbor Modes
tyoans "> ; start of modes to be reset (seperate
; each by a ';')
zout [asciz "27;"] ; Turn off Keypad Control Mode (make numeric
; keypad send numbers unshifted and escape
; codes shifted)
zout [asciz "29;"] ; Turn off CR LF Mode
zout [asciz "30;"] ; Turn off Destructive Backspace Mode
zout [asciz "33;"] ; Turn off Wrap Forward Mode
; zout [asciz "34;"] ; Turn off Wrap Backward Mode
zout [asciz "36;"] ; Turn off Scroll-Page Mode (so TE.SU works)
zout [asciz "37;"] ; Turn off Auto XON/XOFF Mode
zout [asciz "39;"] ; Turn off Slow Scroll Mode
zout [asciz "40;"] ; Turn off Half-Duplex Mode
zout [asciz "46;"] ; Turn off Auto Keyboard Disable Mode
zout [asciz "51l"] ; Turn off Alternate Cursor Mode
; and end list of modes to be reset
tyoans "> ; start of modes to be set (seperate
; each by a ';')
zout [asciz "35;"] ; Turn on DEL Character Display Mode
zout [asciz "52h"] ; Turn on Meta Key Mode
tyoesc "[ ;] ; Start of set display parameters
move a,sheight ; TYODEC arg: A = no.
call tyodec ; set requested no. of lines for memory
zout [asciz ";;;"] ; no upper or lower areas
move a,sheight ; TYODEC arg: A = no.
call tyodec ; set requested no. of lines for screen area
tyo "p ; ...
skiple jinvrs ; INVERSE specified?
zout [asciz "[7m"] ;] ; yes, enter inverse video mode
skipge jinvrs ; NO INVERSE specified?
zout [asciz "[0m"] ;] ; yes, exit inverse video mode
tyoans "H ; Home up
zout [asciz "[3g"] ; Clear all tabs
movei a,9 ; Set 9 tabs
aaain1: zout [asciz "[8CH"] ; Forward 8 spaces and set a tab
sojg a,aaain1
tyoans "H ; Home up and clear screen
pjrst aaaeos
aaamvc: movei a,4 ; start with 4 for ESC-[-digit-H ;]
movei t1,(nv)
sub t1,tvmin
cail t1,10.-1 ; vertical position require two digits?
addi a,1 ; yes, make it 5
movei t1,(nh)
sub t1,thmin
jumpe t1,[return]
addi a,2 ; add 2 for semi-digit
cail t1,10.-1 ; horizontal position require two digits?
addi a,1 ; yes, account for that
return
aaaabs: tyoesc "[ ;]
movei a,1(nv) ; line number, 1-origin
sub a,tvmin
caie a,1 ; 1 is default
call tyodec
camn nh,thmin ; first line of scroll region?
jrst aaamv1 ; yes, that's default, don't send
tyo ";
movei a,1(nh) ; column number, 1-origin
sub a,thmin
call tyodec
aaamv1: tyo "H
return
aaaeos: tyoans "J
pad [.3] ; I think this is .156 --RWK
return
aaavbl: push p,nh ;Save the cursor position
push p,nv
setzb nh,nv ;move to home
call force ;force it to happen now, plus any SMEOL
xct tb+.txso
zout [asciz "9"] ;Set the graphics rendition of the rest of the
;screen. Assumes no DAQs have been set.
pad [.283] ;Takes 283 ms.
xct tb+.txsor
zout [asciz "9"] ;Set it for all the screen
pad [.283] ;Takes a while
pop p,nv ;Restore the cursor position
pop p,nh
return
aaaso: skiple jinvrs ;Assume normal video
jrst aaaso1
zout [asciz "[7m"] ;Back to normal video if inverse
return
aaaso1: zout [asciz "[0m"] ;Use inverse video if normal
return
aaasor: skiple jinvrs ;Assume normal video
jrst aaasr1
zout [asciz "[0m"] ;Back to inverse video
return
aaasr1: zout [asciz "[7m"] ;Back to normal video
return
tvar aaawini ; Set if we've already inited the wholine
; Start the wholine
aaawb: call fulwin ; reset window to full screen
setzb nv,nh ; home
xct tb+.txso
skipe aaawini
return
call force
xct tb+.teeol ; Really clear to EOL to invert whole line
setom aaawini
return
; Finish the wholine
aaawe: call frceol ;Clear to EOL
xct tb+.txsor ;Turn off inverse vid
jrst reswin ; restore window
trmend
subttl ACT-II
trmbeg ACT2:,[ACT-II]
;;; This may be the silliest terminal yet suported.
;;; Note that the cursor actually stays on the bottom line and what we are
;;; really doing is rolling the screen around.
tp.vsz 16.
tp.hsz 63. ; don't use right edge cause of auto scroll up
tm.up 1,tyn ^Z
tm.dwn 1,tyn ^K
tm.fwd 1,tyn ^I
tm.bck 1,tyn ^H
tm.cr 1,tyo ^M
te.clr call act2cl
te.su tyn ^J ; scroll up
tabend
; screen clearing is accomplished by scrolling all the lines off the screen
act2cl: push p,a
move a,sheight
tyn ^J
pop p,a
return
trmend
subttl ACT-IV
trmbeg ACT4:,[ACT-IV]
comment ~
At 19200 baud CLEOS must be followed by at least one filler code, e.g. 00,
if more than half the screen is to be cleared. Home up needs 2 padding
characters, at least, at 19200 baud.
~
tp.flg 0
tp.vsz 24. ; no. of lines displayable on the screen
tp.hsz 80. ; no. of characters per line
tr.cho ccho ; character display routine
tm.up 1,tyn ^Z ; move up n
tm.dwn 1,tyn ^K ; move down n (LF)
tm.fwd 1,tyn ^X ; move forward n
tm.bck 1,tyn ^H ; move back n (BS)
tm.cr 1,tyo ^M ; move to left margin (CR)
tm.hom 1,tyo ^] ; move to upper left corner (home)
tm.abs 3,call actmov ; absolute move
te.eol tyo ^^ ; erase to end of line
te.eos tyo ^_ ; erase to end of screen
te.clr tyo ^L ; erase whole screen (and home)
te.su tyn ^J ; scroll the screen
tx.so tyo ^E ; enter standout mode
tx.sor tyo ^E ; exit stadout mode
tabend
; Absolute move.
actmov: tyo ^T
tyo (nv)
tyo (nh)
return
; No TRMEND since next is TRMTOO.
subttl ACT-V - Microterm ACT V
trmtoo ACTV:,[ACT-V]
tp.flg %fnicp+%fndcp+%fnilp+%fndlp ; on most models these are local only
tp.vsz 24.
tp.hsz 80.
tr.ini call undlcw
tr.tyi undel
tr.cho ccho
tm.up 1,tyn ^Z
tm.dwn 1,tyn ^K
tm.fwd 1,tyn ^X
tm.bck 1,tyn ^H
tm.tab 1,tyn ^I
tm.cr 1,tyo ^M
tm.hom 1,tyo ^]
tm.abs 3,call actmov
te.eol tyo ^^
te.eos tyo ^_
te.clr tyo ^L
te.icp call acticp
te.dcp tyn ^Q
te.ilp tyn ^A
te.dlp tyn ^W
te.su tyn ^J
te.sd tynesc "H
tx.so tyoesc "B
tx.sor tyoesc "C
tabend
acticp: tyo ^S ; Enter char insert mode
tyn 40 ; send N spaces
tyo ^H ; Move back once to get out of mode
addi h,-1(a) ; hope this works.
return
trmend
subttl ADI60 - Applied Dynamics International Series 60 Basic Universial Terminal
trmbeg ADI60:,[ADI60]
tp.flg 0
tp.vsz 24.
tp.hsz 80.
tr.cho ccho
tm.up 1,tyn ^_
tm.dwn 1,tyn ^J
tm.fwd 1,tyn ^\
tm.bck 1,tyn ^H
tm.tab 1,tyn ^I
tm.cr 1,tyo ^M
tm.hom 1,tyo ^K
tm.abs 4,call adiabs
te.eol zout [asciz "EE"]
te.eos zout [asciz "EP"]
te.clr tyo ^L
te.su tyn ^J
te.icp zoutn [asciz "IC"]
te.dcp zoutn [asciz "KC"]
te.ilp zoutn [asciz "IL"]
te.dlp zoutn [asciz "KL"]
tabend
; Direct cursor positioning.
adiabs: tyoesc "A
tyo 40(nh)
tyo 40(nv)
return
trmend
subttl ADM2 - Lear Siegler ADM-2
trmbeg ADM2:,[ADM2]
tp.flg 0
tp.vsz 24.
tp.hsz 80.
tr.ini call a2init ; warn user of changes we make in keyboard
tr.tyi a2tyi ; make changes in keyboard for each character
tr.cho ccho ; character display routine
tr.zns -lzt2,,zt2 ; use zone table which includes NL
tm.up 1,tyn 13 ; ^K
tm.dwn 1,tyn 12 ; ^J
tm.fwd 1,tyn 14 ; ^L
tm.bck 1,tyn 10 ; ^H
tm.nl 1,tyo 37 ; ^_
tm.cr 1,tyo 15 ; ^M
tm.hom 1,tyo 36 ; ^^
tm.abs 4,call a2abs
te.eol tyoesc "T
te.eos tyoesc "Y
te.clr tyoesc "*
te.su tyn ^J ; scroll up
te.icp tynesc "Q
te.dcp tynesc "W
te.ilp tynesc "E
te.dlp tynesc "R
tx.vbl call a2vbl
tx.so tyoesc "^ ; start blinking field
tx.sor tyoesc "^ ; same char to end blinking field!
tabend
; Initialization.
a2init: xct .teclr+tb ; zap screen
move a,[ascnt " Warning, interchanged Underscore and Delete keys.
To type an Escape you must hit the Escape key TWICE."]
pjrst stdwrn ; Go off to standard warn routine
; Terminal input co-routine.
a2tyi1: call tyipuc
a2tyi: call tyiget ; get next character
caie a,177 ; interchange underscore and delete
cain a,137
xori a,137#177
caie a,33 ; Escape?
pjrst a2tyi1 ; Nope, just pass on.
call tyiget ; Hmm, get next character
cain a,33 ; Also an escape?
pjrst a2tyi1 ; Yes, pass on.
push p,a ; No, must send esc plus character
movei a,33
call tyipuc
pop p,a
jrst a2tyi1
a2abs: tyoesc "= ; absmove command
tyo 40(nv) ; Y, then
tyo 40(nh) ; X.
return
a2vbl: tyoesc "^ ; VISBEL - start blink field
tyoesc "U ; control chars print mode
tyo ^G ; now the ^G makes a little blinking bell
tyoesc "X ; control chars DON'T print mode
tyoesc "^ ; stop blink field
return
trmend
subttl ADM3A - Lear Siegler ADM-3A
comment | Other randomness: ^N unlocks kbd if locked, ^O locks
kbd if enabled to do so. Has switch for auto-NL or not.
ADM-3 is similar but doesn't have
tm.up, tm.fwd, tm.hom, or tm.abs!! Complete loser. |
trmbeg ADM3:,[ADM3A]
tp.flg %fsmeol
tp.vsz 24.
tp.hsz 80.
tr.ini call adm3in ; Announce that we'll
tr.tyi undel ; input through standard _/DEL swap.
tm.up 1,tyn ^K
tm.dwn 1,tyn ^J
tm.fwd 1,tyn ^L
tm.bck 1,tyn ^H
tm.cr 1,tyo ^M
tm.hom 1,tyo ^^
tm.abs 4,call adm3mv
te.clr tyo ^Z
te.su tyn ^J ; scroll up
tabend
adm3in: skipe janl ; don't print auto-nl warning if user
; specified state
pjrst undlcw
tyo ^Z ; clear screen
move a,[ascnt "Warning: interchanged Underscore and Delete keys.
Warning: auto newline switch should be off."]
pjrst stdwrn
adm3mv: tyoesc "= ; absmove command
tyo 40(nv) ; Y, then
tyo 40(nh) ; X.
return
; no TRMEND cause next is a TRMTOO
subttl ADM5 - Lear Siegler ADM-5
comment | Other randomness: ^N unlocks kbd if locked, ^O locks
kbd if enabled to do so. Has switch for auto-NL or not.
ADM-3A is similar but doesn't have te.eol, te.eos.|
trmtoo ADM5:,[ADM5]
tp.vsz 24.
tp.hsz 80.
tm.up 1,tyn ^K
tm.dwn 1,tyn ^J
tm.fwd 1,tyn ^L
tm.bck 1,tyn ^H
tm.cr 1,tyo ^M
tm.hom 1,tyo ^^
tm.abs 4,call adm3mv
te.clr tyo ^Z
te.eol tyoesc "T
te.eos tyoesc "Y
te.su tyn ^J ; scroll up
tabend
trmend
subttl ADDS25 - ADDS Regent 25
trmbeg ADDS25:,[ADDS25]
tp.vsz 24.
tp.hsz 80.
tr.cho ccho
tm.up 1,tyn ^Z
tm.dwn 1,tyn ^J
tm.fwd 1,tyn ^F
tm.bck 1,tyn ^U
tm.cr 1,tyo ^M
tm.hom 1,tyo ^A
tm.abs 4,call vtabs
te.eol tyoesc "K
te.eos tyoesc "k
te.clr tyo ^L
te.su tyn ^J
tabend
trmend
subttl ADS100 - ADDS Regent 100
trmbeg ADS100:,[ADS100]
tp.vsz 24.
tp.hsz 80.
tr.cho CCHO ; terminal auto-crlf's in last column
tm.up 1,tyn ^Z
tm.dwn 1,tyn ^J
tm.fwd 1,tyn ^F
tm.bck 1,tyn ^H ; move back n (BS)
; "claims to have tab but I don't know what it does" -Macrak
;tm.tab 1,tyn ^I
tm.cr 1,tyo ^M
tm.hom 1,tyo ^A
tm.ax 2,call a100ah
tm.ay 2,tyo _9+100(nv)
tm.abs 4,call vtabs
;te.eol tyoesc "K disabled because the actual operation to be performed varies
;te.eos tyoesc "k according to the KEYBOARD shift key.
te.clr tyo ^L
te.su tyn ^J ; scroll the screen up
tabend
a100ah: tyo ^P
move c,nh
idivi c,10.
lsh d,4
ior c,d
tyo (c)
return
trmend
subttl ADS580 - ADDS 580
comment |
This info comes from NATE@ML
HERE ARE THE SPECS FOR THE 580:
1) BACKSPACE=^U, FORWARD=^F
2) DOWN A LINE=^J, UP A LINE=^Z
3) CARRAGE RETURN=^M
4) HOMEUP AND ERASE=^L, HOMEDOWN=^A
5) NO HARDWARE TAB, ER-EOL, ER-EOS
6) BELL=^G
7) DIRECT VERTICAL POSITIONING: ^K FOLLOWED BY ASCII 0 THROUGH
23; ZERO IS TOP LINE, 23 IS BOTTOM
8) DIRECT HORIZONTAL POSITION: ^P FOLLOWED BY ASCII 0 THROUGH 71.
9) SCREEN DIMENSIONS: 72 (HORIZONTAL) X 24 (VERTICAL)
10) 5X7 DOT MATRIX
11) NO LOWER CASE
12) NO KEYBOARD BUGS, NUMBER KEYPAD AT RIGHT, CURSOR POSITION KEYS
FURTHER RIGHT.
13) SELECTABLE WRAP/SCROLL FEATURE: WRAP AROUND OR SCROLL DOWN (ONLY DOWN)
14) AUTO LINEFEED OPTION (SWITCH SELECTABLE)
15) FULL OR HALF DUPLEX (SWITCH SELECTABLE)
16) EXTERNAL PRINTER; RS232 OUTPUT ON BACK. TURN ON WITH ^R
TURN OFF WITH ^T.
17) ADJUSTABLE BAUD RATE: 110, 300, 1200, 2400, 9600
NOTE: ANYTHING NOT MENTIONED MAY BE ASSUMED TO BE STANDARD.
|
trmbeg A580:,[ADS580]
tp.flg %fsmeol
tp.vsz 24.
tp.hsz 72.
tr.zns -lzt3,,zt3 ; use zone table for AX/AY capability
tm.up 1,tyn ^Z
tm.dwn 1,tyn ^J
tm.fwd 1,tyn ^F
tm.bck 1,tyn ^U ; ??
tm.cr 1,tyo ^M
tm.ax 2,call a580ax
tm.ay 2,call a580ay
tm.abs 4,call a580mv
te.clr tyo ^L ; homeup & erase
tabend
a580mv: call a580ay ; then drop thru to do AX.
a580ax: tyo ^P
tyo (nh)
return
a580ay: tyo ^K
tyo (nv)
return
trmend
subttl ADS980 - ADDS Consul 980 with escapified number-pad
comment | ADDS 980 has tabs every 5, not every 8!
ADS980 WRAPS TO FIRST POSITION OF NEXT LINE.
IF AT LAST POSITION ON LAST LINE AND CHARACTER IS RECEIVED, SCROLL
OCCURS FIRST, AND THEN CHARACTER APPEARS ON NEW BOTTOM LINE.
HERE IS THE TABLE THAT ADDS SUPPLIES FOR PADDING INFORMATION:
BAUD RATE 9600 4800 2400 1200
FUNCTION
LINE INS/DEL 20 10 5 3
SCREEN ERASE 2 1 0 0
CURSOR ADDRESS 2 1 0 0
LINE FEED (I.E. CR) 2 1 0 0
from byron:
alternate keypad has another (unadvertised) "feature".
In AK mode, <ctrl>-<shift>-char sends <esc>-<lower>-char
for alphabetic characters. I don't know quite what to do with this,
though currently I just accept both chars sent.
All chars between a "{" and a "}" blink! This can be disabled
with internal jumper, but in that mode it simply inhibits all display
of the chars in between!
|
trmbeg A980:,[ADS980]
tp.flg %fsmeol+%fspd
tp.vsz 24.
tp.hsz 80.
tr.tyi a98tyi
tr.ini call a98ini
tr.cho ccho ; character display routine
tm.bck 1,tyn ^H
tm.hom 2,tyo 013140 ; ^K 140 - go to beg of line 0.
tm.abs 4,call a98abs
te.eol call a98eol
te.clr tyo ^L
te.su tyn ^M
te.ilp call a98ilp
te.dlp call a98dlp
tabend
; Initialization.
a98ini: tyo ^_ ; format off
tyo ^O ; stop tag
xct .teclr+tb ; clear screen
pjrst undelw ; output warning message
; Insert line.
a98ilp: push p,a
a98il1: tyoesc ^N ; Line-position insert
pad [.025]
sojg a,a98il1
pop p,a
return
; Delete line.
a98dlp: push p,a
a98dl1: tyoesc ^O ; Line-position delete
pad [.025]
sojg a,a98dl1
pop p,a
return
; Clear to end of line.
a98eol: caml v,tvmax ; last line?
pjrst a98el1 ; yes, hack specially
tyo ^M ; CR does a CLEOL and CRLF
movei h,0 ; account for cursor motion of CR
addi v,1 ; ...
return
a98el1: jumpn h,seol ; if not at beginning of line, hack spaces
tyoesc ^O ; otherwise delete this, the bottom line
pad [.025] ; pad the delete line
return
; Absolute move takes advantage of the feature (?) wherein a horizontal
; move exceeding (hmax - hpos), but less than 99., wraps to next line
a98abs: came v,nv
jrst mva981
caml h,nh
jrst mva982
move d,nh ;nv = v and nh > h so move horizontally
sub d,h
jrst hor980
mva981: move d,nv ;check if nv = v+1
sub d,v
caie d,1
jrst mva982 ;if not, use normal positioning
move d,nh
sub d,h
cail d,20. ;check that total move is less than 100.
jrst mva982
addi d,80.
jrst hor980 ;if so, use funny horizontal move
mva982: tyo ^K ;absolute move for ADS980
tyo 40(nv) ; move to beginning of line
camn nh,thmin
return
move d,nh
hor980: tyoesc ^E ; set horizontal position
idivi d,10. ; using two decimal (!) digits
tyo 40(d)
tyo 40(e)
return
; Terminal input co-routine.
a98i1: call bckych
call tyipuc
a98tyi: call a98get
a98i2: caie a,33
jrst a98i1
call tyiget
cain a,". ; period?
jrst a980$.
cail a,"0 ; between 0 and 9?
caile a,"9
jrst [
push p,a
movei a,33
call bckych
call tyipuc
pop p,a
jrst a98i2
]
xct a980$n-"0(a) ; Yes, execute appropriate instr
jrst a98tyi ; and flush char if no jump made.
a98get: call tyiget
caie a,177 ; first exchange DEL and underscore.
cain a,137
xori a,137#177
return
a980$.: tlz f,%imeta+%itop+%ictrl ; cancel meta, top, or control
jrst a98tyi
a980$n: jfcl ; $0
jrst a980$1 ; $1 = escape
jfcl ; $2
jfcl ; $3
jrst a980$4 ; $4 = CALL
jfcl ; $5
jfcl ; $6
tlo f,%imeta ; $7 = META
tlo f,%imeta+%ictrl ; $8 = CONTROL-META (TOP no longer exists)
tlo f,%ictrl ; $9 = CONTROL
a980$1: movei a,33 ; $1 = escape
jrst a98i1
a980$4: movei a,336 ; $4 = CALL
jrst a98i1
trmend
subttl AJ510 - Anderson Jacobson 510
trmbeg AJ510:,[AJ510]
tp.vsz 24.
tp.hsz 80.
tr.ini call aj5ini
tr.zns -lzt3,,zt3 ; AOBJN pointer to zone table with AX/AY test
tr.cho aj5cho ; need output routine to fix up _ lossage
tm.up 2,tynesc "Y
tm.dwn 1,tyn ^J
tm.fwd 2,tynesc "X
tm.bck 1,tyn ^H
tm.tab 1,tyn ^I
tm.cr 1,tyo ^M
tm.hom 2,tyoesc "H
tm.ax 5,call aj5ax
tm.ay 5,call aj5ay
te.eol zout [asciz "'L"]
te.eos zout [asciz "'P"]
te.su tyn ^J ; scroll the screen up
te.eim zout [asciz "'I"]
te.lim zout [asciz "'J"]
te.dcp zoutn [asciz "'D"]
te.ilp zoutn [asciz "&I"]
te.dlp zoutn [asciz "&D"]
tx.so zout [asciz |"I|] ; choose inverse video for standout
tx.sor zout [asciz |"N|] ; resets them all
tabend
aj5ini: zout [asciz |&C&J&F"NH|]
; character mode, unlock kbd, fulldpx, reset
; standout modes, home cursor, clear all tabs
setzb v,h ; reflect action of the home command
pjrst settab ; set the tabs
aj5ax: tyoesc "A ; X position
push p,a
push p,b
move a,nh
jrst aj5dec
aj5ay: tyoesc "B ; Y position
push p,a
push p,b
move a,nv
aj5dec: tyo "0 ; peculiar, they demand 3 digits
idivi a,10
tyo "0(a)
tyo "0(b)
pop p,b
pop p,a
return
aj5cho: cail a,40 ; control character?
cail a,177 ; or rubout (or worse)?
return ; yes, ignore it
movei t1,"_ ; are well about to overlay an underscore?
camn t1,@scrtab(v)
jrst aj5chu ; if so, gotta do special work
aj5ch1: tlze f,%icm ; insert character on?
xct .telim+tb ; yes, turn it off
movem a,@scrtab(v) ; store character in screen image
camg h,thmax ; past last column?
paoja h,@.trtyo+tb ; no, output char and advance 1 position
return ; otherwise, throw away out of bounds chars
aj5chu: zout [asciz |'D|] ; delete char quickest way to kill _
tlon f,%icm ; insert char already on?
zout [asciz |'I|] ; no, turn it on
tyo <40_9.>+10 ; insert 1 position and then backup over it
jrst aj5ch1 ; now we can output the char
trmend
subttl ANSI - ANSI 3.64 braindamage
trmbeg ANSI:,[ANSI]
tp.flg %fnicp+%fndcp
tp.vsz 0 ; ask
tp.hsz 0 ; ask
tr.ini call ansini
tr.cho scho0
tm.up 3,tynans "A
tm.dwn 1,tyn ^J
tm.fwd 3,tynans "C
tm.bck 1,tyn ^H
tm.tab 1,tyn ^I
tm.cr 1,tyo ^M
tm.hom 3,tyoans "H
tm.abs [call ansmvc] call ansabs
te.eol tyoans "K
te.eos tyoans "J
te.su tyn ^J
;ICP gives better performance.
;te.eim zout [asciz "[4h"] ;]
;te.lim zout [asciz "[4l"] ;]
te.icp tynans "@
te.dcp tynans "P
te.ilp tynans "L
te.dlp tynans "M
tx.so zout [asciz "[5m"] ;]
tx.sor zout [asciz "[0m"] ;]
tabend
; Initialization.
ansini: zout [asciz "[20l"] ;] ; LF is Line Feed rather than New Line
tyoans "H ; home
tyoans "J ; clear screen
return
; Calculate absolute move cost.
ansmvc: movei a,4 ; start with 4 for ESC-[-digit-H ;]
movei t1,(nv)
sub t1,tvmin
cail t1,10.-1 ; vertical position require two digits?
addi a,1 ; yes, make it 5
movei t1,(nh)
sub t1,thmin
jumpe t1,[return]
addi a,2 ; add 2 for semi-digit
cail t1,10.-1 ; horizontal position require two digits?
addi a,1 ; yes, account for that
return
; Absolute move.
ansabs: tyoesc "[ ;]
movei a,1(nv) ; line number, 1-origin
sub a,tvmin
caie a,1 ; 1 is default
call tyodec
camn nh,thmin ; first line of scroll region?
jrst ansmv1 ; yes, that's default, don't send
tyo ";
movei a,1(nh) ; column number, 1-origin
sub a,thmin
call tyodec
ansmv1: tyo "H ; They say lower-case f also works, I wonder
; what difference
return
trmend
subttl BANTAM - Perkin-Elmer Bantam
trmbeg BANTAM:,[BANTAM]
tp.flg 0
tp.vsz 24.
tp.hsz 80.
;tr.cho ccho ; I think auto-NL is an internal switch,
; We presume most people have it set wrong?
tr.zns -lzt3,,zt3 ; AOBJN pointer to zone table with AX/AY test
tm.up 2,tynesc "A
tm.dwn 1,tyn ^J
tm.fwd 2,tynesc "C
tm.bck 1,tyn ^H
tm.tab 1,tyn ^I
tm.cr 1,tyo ^M
tm.hom 2,tyoesc "H
tm.ax 3,call banah ; abs move in horizontal direction
tm.ay 3,call banav ; abs move in vertical direction
tm.abs 6,call banmv
te.clr tyoesc "K
te.eol tyoesc "I ; not ESC K !!
te.su tyn ^J ; scroll up
tx.vbl call banvbl ; visible bell
tabend
; Transparent mode displays all spaces as small NU's; doing this briefly
; is quite flashy.
banvbl: tyo ^P ; ^P^B goes into transparent mode
tyo ^B
tyo ^P ; ^P^C exits debug mode.
tyo ^C
return
; perform abs move
banmv: call banav ; Drop thru to do H after doing V.
banah: tyoesc "Y ; is abs move in HORIZONTAL direction!
tyo 40(nh)
return
banav: tyoesc "X ; is abs move in VERTICAL direction!
tyo 40(nv)
return
trmend
subttl BEE3 - Beehive Model III
; SIZE OF SCREEN 20 LINES X 80 CHARACTERS PER LINE.
; CURSOR UP ^R
; CURSOR DOWN ^J
; CURSOR BACK ^D
; CURSOR FORWARD ^P
; CURSOR HOME ^E
; CURSOR START OF LINE^M
; ERASE TO END OF LINE^L
; ERASE END OF SCREEN ^K
; CLEARS SCREEN ^T (THIS ALSO ERASES ALL TABS AND HOMES CURSOR)
; RING BELLS ^G
; SET TAB STOPS ^F
; CLEAR TAB STOPS ^V (THIS IS ONLY FOR A SINGLE TAB AT A TIME)
; CLEAR ALL TABS ^T
; TABULATION ^I
;
; NO ABSOLUTE CURSOR POSISTIONING, INSERT/DELETE CHAR/LINE EXISTS ONLY
; IN LOCAL MODE. NOT AVAILABLE ON LINE.
;
; WHEN THE CURSOR REACHREACHES END OF LINE
; AUTOMATIC <CR><LF> TO THE NEXT LINE.
; LINE FEEDING OFF THE BOTTOM ONLINE CAUSES SCROLLING IN LOCAL IT MOVES
; IT TO THE TOP. OFF AN AUTOMATIC <CR><LF> ON THE LAST LINE,
; SCROLLING OCCURS. OFF THE TOP OF THE SCREEN WHEN CONTINUING UP
; THE CURSOR GOTO THE BOTTOM AND CONTINUES UP. TO THE RIGHT , THE CURSOR
; <CR><LF>'S TO THE NEXT LINE. THE INVERSE OCCURS WHEN GOING TO
; THE LEFT .
;
; NO PADDING IS REQUIRED FOR ANY FUNCTIONS.
;
; EXTRA FEATURES ARE:
;
; BLINKING VIDEO STARTS FROM POSISTION AND CONTINUES TO END OF LINE.
; (^\)
; CLEAR BLINK ON ENTIRE PAGE (^[) [<ESCAPE>]
; REVERSED VIDEO (^])
; REVERSED BLINKING VIDEO (^^)
; RESET BLINK FOR THE LINE (^_)
;
; FORMAT MODE.
;
; ENTRY IS ONLY PERMITTED BETWEEN BRACKETS. TAB MOVES TO NEXT ENTRY
; SPOT. EXAMPLE,
;
; NAME:[ ] TELEPHONE NUMBER :[ ]
;
; ENTRIES CAN BE MADE ONLY IN THE BRACKETS AND SEND ON.
;
; TO GET INTO FORMAT MODE TYPE ^O (SHIFT IN)
;
;
; PRESS STOP KEY (NO CODE) TO QUIT OR ^T AND HIT ^N
;
;
; BLOCK SEND IS AVAILABLE WHERE AN ENTIRE SCREEN FUL IS PREPARED AND
; THEN THE \ CHARACTER INDICATES THE END OF THE MESSAGE. HIT THE
; SEND KKEY AND IT SENDS ALL THE INFORMATION AT ONCE. ( SEND = ^U)
;
; ^H=NEW LINE IS USED TO INDICATE END O F LINE . THE SCREEN AUTOMATICALLY
; OUTPUTS <CR><LF><NULL> IN PLACE OF THE ^H WHEN TRANSMITTED.
;
; WHENEVER ^H IS RECEIVED, THE TERMINAL AUTOMATICALLY DOES
; <CR><LF><NULL>.
;
; TO SEND THE TERMINAL TO LOCAL MODE TYPE ^X. THERE IS NO REMOTE
; WAY TO RETURN TO ON LINE. THAT CONDITION MUST BE RESTORED BY
; THE PERSON USING THE TERMINAL.
;
; THE LAST FIVE CHARS IN ASCII ARE NOT ABLE TO BE SENT EXCEPT FOR
; <RUBOUT> ASCII 173,174,175,176 CAN BE PRODUCED AND
; RECEIVED BUT CAN NOT BE TRANSMITTED DUE TO CONSTRUCTION OF KEYBOARD
; WHICH RESEMBLES MODEL 35 TELETYPE WITH THE EXCEPTION OF THE ALPHA
; LOCK KEY WHICH DETERMINSE UPPER OR LOWERCASE FOR LETTERS.
;
; ASCII 136 EQUALS CARAT
; ASCII 137 EQUALS UNDERSCORE
; ASCII 173 EQUALS LEFT BRACE
; ASCII 174 EQUALS VERTICAL BAR
; ASCII 175 EQUALS RIGHT BRACE
; ASCII 176 EQUALS TILDA
TRMBEG BEE3:,[BEE3]
tp.flg 0
tp.vsz 20. ; rather tiny
tp.hsz 80.
tr.ini call b3ini
tr.cho ccho ; character display routine
tm.up 1,tyn ^R
tm.dwn 1,tyn ^J
tm.fwd 1,tyn ^P
tm.bck 1,tyn ^D
tm.tab 1,tyn ^I
tm.cr 1,tyo ^M
tm.hom 1,tyo ^E
te.eol tyo ^L
te.eos tyo ^K
tabend
b3ini: pushae p,[a,b]
tyo ^T ; clear screen, clear tabs
move b,shmax ; calculate the no. of tabs to set
lsh b,-3 ; ...
b3tab1: movei a,8. ; move to next multiple of 8
tyn 40 ; ...
tyo ^F ; and set a tabstop there
sojg b,b3tab1
tyo ^E ; restore cursor to home
popae p,[b,a]
return
trmend
subttl CDC713 - Control Data 713
trmbeg C713:,[CDC713]
tp.flg 0
tp.vsz 16. ; rather tiny
tp.hsz 80.
tr.cho ccho ; character display routine
tm.up 1,tyn ^Z
tm.dwn 1,tyn ^J
tm.fwd 1,tyn ^U
tm.bck 1,tyn ^H
tm.tab 1,tyn ^I
tm.cr 1,tyo ^M
tm.hom 1,tyo ^Y
te.eol tyo ^V
te.clr tyo ^X
te.su tyn ^J
tabend
trmend
subttl C100 - Human Designed Systems Concept 100
trmbeg C100:,[C100]
tp.flg %fspd+%fnicp+%fndcp ; insert/delete characters not used due to
; HDS braindamage
tp.vsz 24.
tp.hsz 80.
tr.ini call c1init
tr.tyi c1tyi
tr.cho c1cho
tr.wrp call c1wrap
tm.up 2,tynesc ";
tm.dwn 1,tyn ^J
tm.fwd 2,tynesc "=
tm.bck 1,tyn ^H
tm.tab 1,tyn ^I
tm.cr 1,tyo ^M
tm.hom 2,tyoesc "?
tm.abs 4,call c1abs
te.win call c1win
te.eol call c1eol
te.eos call c1eos
te.clr call c1clr
te.su call c1su
;te.eim tyoesc ^P ; use TE.ICP instead because of padding
te.lim tyoesc ^@
te.icp call c1icp
te.dcp call c1dcp
te.ilp call c1ilp
te.dlp call c1dlp
tx.so tyoesc "D ; turn on blinking
tx.sor tyoesc "d ; turn off blinking
tx.vbl call c1vbl
tabend
tvar c1padf
; Concept 100 initialization. Reset terminal and set tabs.
c1init: pushae p,[a,b,c,d]
fltr b,speed ; get output speed in characters per second
fdvr b,[-3200.0] ; calculate .3*(speed/960)
fadr b,[.55] ; calculate 1 - (.45 + .3*(speed/960))
move a,[1.0]
fdvr a,b ; divide execution time by the fraction of
; the processor available to get the padding
; time
movem a,c1padf
movei a,c1cho4 ; normally all control characters have to be
skiple jtrans ; quoted, unless the terminal has the
move a,[@.trtyo+tb] ; translucent option
movem a,c1ctl+0 ; fill table of control characters with
move a,[c1ctl+0,,c1ctl+1] ; right subroutine
blt a,c1ctl+37 ; ...
skiple jtrans ; if translucent option then change a few
jrst [ movei a,c1cho4 ; quoting character output subroutine
movem a,c1ctl+0 ; NUL
movem a,c1ctl+^H ; BS
movem a,c1ctl+^I ; TAB
movem a,c1ctl+^J ; LF
movem a,c1ctl+^L ; FF
movem a,c1ctl+^M ; CR
movem a,c1ctl+33 ; ESC
jrst .+1 ]
tyoesc "U ; set programmer mode or abs move won't work!
tyoesc "f ; set text mode (for ins/del line to work!)
tyoesc "7 ; set character mode (as opposed to block)
tyoesc "5 ; set upper-lower case mode
tyoesc "8 ; set full duplex
tyoesc "l ; reset auto linefeed (normal CR)
tyoesc "N ; send set attribute word command
tyo 110 ; attribute word with all zeros, except
; protect = 1 (no protection)
skiple jcid ; CID specified?
zout [asciz "!A@ "] ; yes, insert mode should stop at
; end of line, and clearing shouldn't
; set nodisplay bit
skiple jinvrs ; INVERSE specified?
tyoesc "k ; yes, reverse video the screen
skipge jinvrs ; NO INVERSE specified?
tyoesc "K ; yes, normal video the screen
tyoesc "o ; somewhat random, change EOM to null
tyo 46_9+0 ; which should cause no eom character
tyoesc "o ; set message character
tyo 47_9+^^ ; function key lead-in to ^^
; tyoesc "$ ; reset all function keys
tyoesc "4 ; set function key
tyo 41060 ; length 1, INSRT
tyo 40 ; transmit default
tyoesc "4 ; set function key
tyo 40040 ; length 0, SHIFT INSRT
tyo 40 ; transmit default
tyoesc "4 ; set function key
tyo 41061 ; length 1, DEL CHAR
tyo 42037 ; transmit control backarrow
tyoesc "4 ; set function key
tyo 40041 ; length 0, SHIFT DEL CHAR
tyo 40 ; transmit default
tyoesc "4 ; set function key
tyo 41062 ; length 1, DEL LINE INS
tyo 42000 ; transmit NUL
tyoesc "4 ; set function key
tyo 40042 ; length 0, SHIFT DEL LINE INS
tyo 40 ; transmit default
tyoesc "4 ; set function key
tyo 40063 ; length 0, EOP CLEAR EOL
tyo 40 ; transmit default
tyoesc "4 ; set function key
tyo 40043 ; length 0, SHIFT EOP CLEAR EOL
tyo 40 ; transmit default
tyoesc "4 ; set function key
tyo 40064 ; length 0, SEND
tyo 40 ; transmit default
tyoesc "4 ; set function key
tyo 40044 ; length 0, SHIFT SEND
tyo 40 ; transmit default
setzb a,b ; C1WIN args: minimum vertical, minimum
; horizontal
dmove c,smax ; C1WIN arg: maximum vertical, maximum
; horizontal
call c1win1 ; set window to whole screen
xct .teclr+tb ; clear whole screen
IFN 0,{
push p,nh ; save horizontal position
movei nh,8.
c1ini1: call c1abs
dmove vh,nvh
tyoesc "] ; ESC ] sets a tabstop
addi nh,8.
camg nh,shmax
jrst c1ini1
pop p,nh ; restore horizontal position
} ; IFN 0
popae p,[d,c,b,a] ; restore ACs
return
; Set window.
c1win: camn a,tvmin ; if new minimum vertical
came b,thmin ; or new minimum horizontal
jrst c1win1 ; different from old then do it
camn c,tvmax ; if new maximum vertical
came d,thmax ; or new maximum horizontal
jrst c1win1 ; different from old then do it
return ; otherwise no change, do nothing
c1win1: pushae p,[c,d] ; save arguments we clobber
dmovem a,tmin ; remember terminal window we're about to set
dmovem c,tmax ; ...
sub c,a ; subtract minimum vertical from maximum
addi c,1 ; and add 1 to get window height
movem c,theight ; save away
sub d,b ; subtract minimum horizontal from maximum
addi d,1 ; and add 1 to get window width
movem d,twidth ; save away
tyoesc "v ; send define window command
tyo 40(a)
tyo 40(b)
tyo 40(c)
tyo 40(d)
dmove vh,tmin ; setting window homes cursor
lsh c,1 ; calculate 2/3 of window height for
idivi c,3 ; wrapping optimization
movem c,c1vwrp ; save away
popae p,[d,c] ; restore clobbered arguments
return
; Wrap calculation. Only hacks 1 out of 4 possible optimizations. Backward
; movement isn't wrapped because of FSTFWD hackery, tabs, and because it
; moves up when it wraps on backspace. Forward movment isn't wrapped because
; tabs aren't taken into consideration and because it moves down when it
; wraps going forward. Finally, upward movement isn't wrapped because LF
; doesn't wrap (it scrolls).
; Arguments:
; D horizontal distance
; E vertical distance
c1wrap: camle e,c1vwrp ; moving more than 16 lines down?
sub e,theight ; yes, use 24-n move ups instead
return
tvar c1vwrp ; vertical movement distance at which
; wrapping becomes worth it
; Concept 100 direct cursor address.
c1abs: sub nv,tvmin ; cursor address is relative to start
sub nh,thmin ; of window
tyoesc "a ; direct cursor address command
tyo 40(nv)
tyo 40(nh)
add nv,tvmin ; restore NV and NH
add nh,thmin ; ...
return
; Concept 100 scroll.
c1su: push p,a
c1su1: tyo ^J
pad [.002]
sojg a,c1su1
pop p,a
return
; Concept 100 clear to end of line.
c1eol: tyoesc ^U ; send CLEOL
pjrst c1pad4 ; pad for 4 milliseconds
; Concept 100 clear to end of screen.
c1eos: tyoesc ^E ; send clear to end of screen command
push p,a ; save AC
move a,tvmax ; calculate no. of lines cleared
sub a,v ; ...
addi a,1 ; ...
fsc a,233 ; float
fmpr a,[.0035] ; 3.5ms per line
fadr a,[.0005] ; +.5ms
fmpr a,c1padf
pad a
pop p,a ; restore AC
return
; Concept 100 clear screen
c1clr: tyo ^L ; send clear screen command
push p,a ; save AC
fltr a,theight ; get no. of lines in window
fmpr a,[.0005] ; multiply by .5ms/line to get no. of
; seconds of execution time
fmpr a,c1padf
pad a
pop p,a ; restore AC
return
; Concept 100 insert characters command.
c1icp: tlon f,%icm ; insert character mode off?
tyoesc ^P ; no, turn on insert character mode
push p,a ; save argument
c1icp1: tyo 40 ; output N spaces
call c1pad4 ; pad for 4 milliseconds
sojg a,c1icp1
pop p,a ; restore argument
add h,a ; and move back over them
return
; Delete characters.
c1dcp: push p,a ; save argument
c1dcp1: tyoesc ^Q ; send delete 1 character command
call c1pad4 ; pad for 4 milliseconds
sojg a,c1dcp1
pop p,a ; restore argument
return
; Pad for 4 milliseconds.
c1pad4: move t1,speed ; speed > 30cps?
caig t1,30. ; ...
return ; no, no padding needed
push p,a ; save AC
move a,[.004] ; 4 milliseconds
fmpr a,c1padf
pad a
pop p,a ; restore AC
return
; Concept 100 insert line command.
c1ilp: push p,a ; save argument
c1il1: tyoesc ^R ; send insert line
call c1lidp ; pad the insert line
sojg a,c1il1
pop p,a ; restore argument
return
; Concept 100 delete line command.
c1dlp: push p,a ; save argument
c1dl1: tyoesc ^B ; send delete line
call c1lidp ; pad the delete line
sojg a,c1dl1
pop p,a ; restore argument
return
; Concept 100 line insert/delete padding.
c1lidp: move t1,speed
caig t1,30.
return
push p,a ; save AC
move a,tvmax ; TVMAX - V is no. of lines moved
sub a,v ; ...
addi a,1 ; +1 for line that is cleared
fsc a,233 ; float that
fmpr a,[.00075] ; C1PAD arg: execution time of .75ms per line
; moved
fmpr a,c1padf
pad a
pop p,a ; restore AC
return
; Concept 100 visible bell.
c1vbl: skipn jinvrs ; INVERSE or NO INVERSE specified?
jrst c1vbl1 ; no, do it the hard way
movei a,"K ; switch to normal video
skipg jinvrs ; NO INVERSE?
movei a,"k ; yes, switch to reverse video
tyoesc (a) ; flip video
pad [.06] ; wait a little while
xori a,"K#"k ; get command character to restore video
tyoesc (a) ; restore it
pad [.04] ; wait a little while(?)
return
c1vbl1: pushae p,[nh,nv,a,b,c,d] ; save ACs
dmove nvh,tmin ; home cursor
movei a,40 ; C1SBA arg: attribute mask
movei b,40 ; C1SBA arg: attributes
move c,theight ; C1SBA arg: no. of lines
move d,twidth ; C1SBA arg: no. of columns
call c1sba ; set whole screen to inverse video
movei a,40 ; C1SBA arg: attribute mask
movei b,0 ; C1SBA arg: attributes
move c,theight ; C1SBA arg: no. of lines
move d,twidth ; C1SBA arg: no. of columns
call c1sba ; set whole screen to normal video
popae p,[d,c,b,a,nv,nh] ; restore ACs
return
; Set block attribute.
; Arguments:
; A Attributes mask.
; B Attributes.
; C No. of lines
; D No. of columns
c1sba: call force
tyoesc "J ; set block attribute command
addi a,100 ; add 100 to avoid control characters
call @.trtyo+tb ; send attribute mask
movei a,100(b)
call @.trtyo+tb ; send attributes
movei a,40(c)
call @.trtyo+tb ; send no. of lines
movei a,40(d)
call @.trtyo+tb ; send no. of columns
imul d,c ; get total no. of characters
fsc c,233
fmpr c,[.0003] ; .3ms/line
fsc d,233
fmpr d,[.00002] ; .02ms/character
fadr c,d
fmpr c,c1padf
pad c
return
; C1CHO - Concept 100 character output.
c1cho: tlze f,%icm ; insert character mode on?
tyoesc ^@ ; yes, turn off insert character mode
movem a,@scrtab(v) ; store character in screen image
caml h,thmax ; last column?
jrst c1cho1 ; yes, hack specially
caie a,"_ ; underscore?
cail a,177 ; rubout (or worse)?
paoja h,c1cho4 ; yes, special output
cail a,40 ; control character?
paoja h,@.trtyo+tb ; no, just send to terminal straight
paoja h,@c1ctl(a) ; dispatch to either @.TRTYO+TB or C1CHO4
; Last column.
c1cho1: tyoesc "R ; repeat character vertical
call @.trtyo+tb ; character
tyo "! ; repeat count of 1
return
; C100 quoted character output subroutine.
c1cho4: tyoesc "r ; send repeat character horizontal command
call @.trtyo+tb ; output character
tyo "! ; send repeat count of 1
return
tvar c1ctl(32.) ; table of control character output subroutines
; C100 terminal input co-routine.
c1tyi2: movei a,^^
c1tyi1: call tyiput
c1tyi: call tyiget
caie a,^^
jrst c1tyi1
call tyitog
jumpl a,c1tyi2
cain a,"0
jrst c1tyi2
cail a,"4
caile a,"B
jrst c1tyi3
addi a,"0-"4+%txmta
jrst c1tyi1
c1tyi3: cain a,40
jrst c1tyi4
push p,a
movei a,^^
call tyiput
pop p,a
jrst c1tyi1
c1tyi4: call enter
jrst c1tyi
trmend
subttl Cromemco 3101
trmbeg CROMEM:,[CROMEMCO]
tp.flg 0
tp.vsz 24.
tp.hsz 80.
tr.ini call undlcw ;Annouce that
tr.tyi undel ; we'll switch "_" and "delete"
tr.cho ccho ;Handle the auto-wrap at end of line
tm.up 2,tynesc "A
tm.dwn 1,tyn ^J
tm.fwd 2,tynesc "C
tm.bck 1,tyn ^H
tm.cr 1,tyo ^M
tm.hom 2,tyoesc "H
tm.abs 4.,call crabs
te.clr tyoesc "E
te.su tyn ^J ; scroll up
te.eol tyoesc "K
te.eos tyoesc "J
tabend
; Absolute move.
crabs: tyoesc "F ;Esc F <v+32.> <h+32.>
tyo 40(nv)
tyo 40(nh)
return
trmend
subttl CT64 - SWTP CT-64
trmbeg CT64:,[CT64]
tp.flg 0
tp.hsz 64.
tp.vsz 16.
tr.cho ccho
tr.ini tyo ^L_9+^U ; home and CLEOS
tm.up 1,tyn ^K
tm.dwn 1,tyn ^J
tm.fwd 1,tyn ^I
tm.bck 1,tyn ^H
tm.cr 1,tyo ^M
tm.hom 1,tyo ^L
te.eol tyo ^^
te.eos call cteos
te.su tyn ^J ; scroll up
tabend
cteos: tyo ^^ ; Erase to End of current line first
caml v,tvmax ; are we at end of screen?
return ; if so, then we've no more to do.
jumpe h,.+3
tyo ^M
movei h,0
tyo ^J ; Otherwise move to next line
addi v,1
tyo ^U ; then erase to end of screen
return
trmend
subttl CT1111 - Convergent Technologies 1111
comment ~
pending resolution of the region scrolling issue -CBF 14 Dec 80
trmbeg CT1111:,[CT1111]
tp.flg 0
tp.vsz 31.
tp.hsz 132.
tr.zns -ltz3,,zt3 ; zone table with NL
tm.up 1,tyn ^A
tm.dwn 1,tyn ^K
tm.fwd 1,tyn ^R
tm.bck 1,tyn ^N
tm.nl 1,tyo ^J
tm.abs 4,call ct1abs
te.eol zout [asciz "EL"]
te.eos zout [asciz "EF"]
~
subttl DD4000 - Delta Data 4000
trmbeg DD4:,[DD4000]
tp.flg %fspd
tp.vsz 25.
tp.hsz 80.
tr.ini call dd4ini
tr.cho ccho ; character display routine
tm.up 2,tynesc "A
tm.dwn 1,tyn ^J
tm.fwd 2,tynesc "C
tm.bck 1,tyn ^H
tm.tab 1,tyn ^I
tm.cr 1,tyo ^M
tm.hom 2,tyoesc "H
tm.abs 8.,call dd4mv
te.eol tyoesc "K
te.eos tyoesc "J
te.ilp tynesc "L
te.dlp call dd4dl
tabend
; Initialization.
dd4ini: setzm padc ; rubout is an ugly center-dot!
tyoesc "E ; clear screen and tabs
skipl jtab ; tabs?
pjrst settab ; yes, set tab stops
return
dd4mv: tyoesc "F ; StupidBee positioning
move d,nh
idivi d,100.
tyo "0(d)
movei d,(e)
idivi d,10.
tyo "0(d)
tyo "0(e)
move d,nv
idivi d,100.
tyo "0(d)
movei d,(e)
idivi d,10.
tyo "0(d)
tyo "0(e)
return
dd4dl: push p,a
dd4dl1: tyoesc "M
pad [.1]
sojg a,dd4dl1
pop p,a
return
trmend
subttl DD5200 - Delta Data 5200
trmbeg DD5200:,[DD5200]
tp.flg 0
tr.ini tyo16 122
tr.cho scho0
tp.vsz 27.
tp.hsz 79. ; try 1 less column to win
tm.up 1,tyn 32
tm.dwn 1,tyn 13
tm.fwd 1,tyn 31
tm.bck 1,tyn 10
tm.hom 2,tyo16 121
tm.abs 4,call dd5abs
te.eol tyo16 125
te.clr tyo16 122
te.eim tyo16 131
te.lim tyo16 130
te.dcp tyn16 126
te.ilp tyn16 115
te.dlp tyn16 114
tx.so tyo16 37
tx.sor tyo16 36
tabend
; DD5ABS -- absolute positioning.
dd5abs: tyo16 116
movn a,nh
subi a,1
andi a,177
tyo (a)
movn a,nv
subi a,1
andi a,177
tyo (a)
return
trmend
subttl NIH5200 - Delta Data 5200 (NIH version)
trmbeg NIH52:,[NIH5200]
tp.flg %fspd
tp.vsz 27.
tp.hsz 80.
tr.cho nh5cho
tm.up 1,tyn 32 ; ^Z
tm.dwn 1,tyn 13 ; ^K
tm.fwd 1,tyn 31 ; ^Y
tm.bck 1,tyn ^H
tm.cr 1,tyo ^M
tm.hom 2,tyo16 "Q ; ^NQ
tm.abs 3,call nh5amv
te.eol tyo16 "U
te.eos zout [asciz "S"] ; CLEOS
te.clr tyo ^L
te.dcp tyn16 "V ; delete character
te.eim tyo16 "Y ; go into insert mode.
te.lim tyo ^R ; (NIH) exit insert mode
te.ilp tyn16 "M ; insert line
te.dlp zoutn [asciz "UL"] ; delete line
tx.so tyo ^_ ; Blinking
tx.sor tyo ^^ ; Unblink
tabend
; Come here to output character in A.
nh5cho: cail a,40 ; control character?
cail a,177 ; or rubout (or worse)?
return ; yes, ignore it
tlze f,%icm
xct .telim+tb
movei t1,blchar
came t1,@scrtab(v) ; see if already something there...
pjrst scho1 ; yes, needn't worry.
push p,h ; Sigh, must check... save old H.
sojl h,nh5ch9 ; if at beg of line, win.
came t1,@scrtab(v) ; check preceding char position
jrst nh5ch9 ; if something there, also win.
move h,thmax
camn t1,@scrtab(v) ; Find rightmost char on line
sojge h,.-1 ; quickly.
sub h,(p) ; Is rightmost char to right of cursor?
jumpge h,nh5ch9 ; yes, win.
movn h,h ; make positive, and get
subi h,1 ; # blanks between current pos and rtmost char
exch h,(p) ; now save it, restoring current hpos
call scho1 ; for output purposes.
exch a,(p) ; Get back # blanks to pad for...
fsc a,233 ; float it
fmpr a,[0.00144] ; 1.44 msec per blank to fill
pad a
pop p,a
return
nh5ch9: pop p,h ; no padding required, just restore stuff
pjrst scho1 ; and output normally
; Absolute move
nh5amv: tyo ^A
movn d,nh ; X coordinate is encoded as 177-nh
tyo 177(d) ; so we negate nh and add 177 to it.
movn d,nv ; Y coordinate is encoded same way.
tyo 177(d)
return
trmend
subttl NIH7000 - Delta Data NIH something
comment | Info from Ricart
start blink ESC blank
end blink ESC ( or end of line
start underlining ESC !
end underlining ESC ) or oend of line
start reverse video ESC "
end reverse video ESC *
start dim ESC #
end dim ESC + or end of line
start vertical bar in the RHS of char box ESC $
end vertical bar in the RHS of char box ESC , (char is still seen)
start display supression ESC % (useless)
end display supression ESC -
start horizontal bar in bottom of char box (char still seen, underlining still available) ESC &
end horizontal bar in bottom of char box ESC .
start put a little "mark" in upper left-hand corner of char box ESC '
end of that ESC / (or, of course, as with all of these, end of line)
The horizontal and vertical var features are indended for "dividing"
the screen but you can't do separate scrolling or windowing, so are
not much used.
[7] Crocks: using LFCR instead of CRLF causes next line to be displayed
"slowly" (still no fill needed unless it happens continuously over a 1200
baud line) "slowly" means about 30 about 30 cps.
p. Set tab ESC 1
q. Tab HT (standard)
[3] char typed in column 80: cursor goes to first position on next line.
If, however, at this point the terminal receives CRLF, the cursor
does not move (prevents double-spacing of 80 char lines). If
it receives anything else, like just LF or LF CR, cursor will move.
[4] a. LF off bottom of screen...screen scrolls up
b. cursor position off bottom of screen...screen scrools up as much
as necessary to display new cursor position.
c. auto crlf off last line...screen scrolls
d. cursor position off right...goes to first posn of next line, scrolls if
on bottom line.
cusor position off left...goes to last posn of previous line, scrolls if on top line
cursor posn off top....terminal scrolls (backwards)
[5] No timing necessary
|
trmbeg n7k:,[NIH7000]
tp.flg 0
tp.vsz 28. ; no. of lines displayable on the screen
tp.hsz 79. ; no. of characters per line (80 but lossage)
tr.ini call n7kini ; Set tabs.
tr.cho scho0
tm.up 2,tynesc "` ; move up n
tm.dwn 1,tyn ^J ; move down n (LF)
tm.fwd 2,tynesc "b ; move forward n
tm.bck 1,tyn ^H ; move back n (BS)
tm.tab 1,tyn ^I ; move to nth next tabstop (TAB)
tm.cr 1,tyo ^M ; move to left margin (CR)
tm.hom 2,tyoesc "l ; move to upper left corner (home)
tm.ax 3,call n7kax
tm.abs 4,call n7kabs ; absolute move
te.eol tyoesc "U ; erase to end of line
te.eos tyoesc "X ; erase to end of screen
te.clr tyo ^L ; erase whole screen (and home)
te.su tyn ^J ; scroll up
te.eim tyoesc "Q ; Begin insert mode
te.lim tyoesc "R ; End insert mode
te.dcp tynesc "P ; delete n character positions
te.ilp tynesc "T ; insert n lines
te.dlp tynesc "S ; delete n lines
tx.so tyoesc "" ; enter standout mode
tx.sor tyoesc "* ; exit standout mode
tabend
n7kini: setzb nh,nv
xct .teclr+tb
skipl jtab ; tabs?
pjrst settab ; yes, set tab stops
return
n7kabs: tyoesc "_
setcmi d,(nh) ; Use ones complement
andi d,177
tyo (d)
setcmi d,(nv)
andi d,177
tyo (d)
return
n7kax: tyoesc "] ; "absolute tab"
setcmi d,(nh)
andi d,177
tyo (d)
return
trmend
subttl DG132 - Datagraphix 132 models A & B?
trmbeg DG132:,[DG132]
tp.flg 0
tp.vsz 30.
tp.hsz 132.
tr.ini call dg1ini
tr.cho scho0
tm.up 2,tynesc "K
tm.dwn 1,tyn ^J
tm.fwd 2,tynesc "L
tm.bck 1,tyn ^H
;tm.tab 1,tyn ^I maybe tabs don't work
tm.cr 1,tyo 15
tm.hom 2,tyoesc "T
tm.abs 8,call dg1abs
te.eol tyoesc "O
te.eos tyoesc "I
te.clr tyoesc "H
te.eim tyoesc "0
te.lim tyoesc "5
te.dcp tynesc "6
te.ilp tynesc "3
te.dlp tynesc "4
te.su tynesc "V ; Is this better than LF off the bottom?
te.sd tynesc "W
tx.so tyo ^_ ; dim (not clear this is a winning "standout"
; mode)
tx.sor tyo ^^ ; normal
tabend
dg1ini: xct .teclr+tb ; home and clear screen
xct .txsor+tb ; get out of dim mode?
call settab
skipe janl ; don't print warning if user specified state
return
move a,[ascnt "Warning: AutoNewline mode should be off."]
pjrst stdwrn
dg1abs: tyoesc "8
movei d,1(nv)
idivi d,100.
tyo "0(d)
movei d,(e)
idivi d,10.
tyo "0(d)
tyo "0(e)
movei d,1(nh)
idivi d,100.
tyo "0(d)
movei d,(e)
idivi d,10.
tyo "0(d)
tyo "0(e)
return
trmend
subttl DG200 - Data General 200
trmbeg DG200:,[DG200]
tp.flg 0
tp.vsz 24.
tp.hsz 80.
tr.ini call dg2ini
tr.cho ccho
tr.tyi dg2tyi ; switch CR & Nl
tr.zns -lzt2,,zt2 ; zone tables that includes NL
tm.up 1,tyn 027
tm.dwn 1,tyn 032
tm.fwd 1,tyn 030
tm.bck 1,tyn 031
tm.cr 1,tyo 15
tm.nl 1,tyo 12
tm.hom 1,tyo 10
tm.abs 3,call dg2abs
te.eol tyo 13
te.clr tyo 14
te.su zoutn [.byte 7 ? 022 ? 12 ? 023] ; roll enable, newline, roll disable
tx.so zout [.byte 7 ? 036 ? 104]
tx.sor zout [.byte 7 ? 036 ? 105]
tabend
dg2ini: zout [.byte 7 ? 023? 14] ; roll disable, clear screen & home
move a,[ascnt " Warning: Interchanged Newline and Return keys."]
pjrst stdwrn
dg2abs: tyo 020 ; absolute position
tyo (nh) ; column
tyo (nv) ; line
return
dg2tyi: call tyiget ; interchange Newline and return on input
caie a,12
cain a,15
xori a,15#12
call tyipuc
jrst dg2tyi
trmend
subttl DLOG33 - Digi-Log Model 33
comment |
Character entered at EOL remains at EOL
Cursor position off to right: stays at col 80
Cursor position off to left: goes to col 80 of same line
Cursor off top: stays at top
|
trmbeg DL33:,[DLOG33]
tp.flg %fsmeol
tp.vsz 16. ; rather tiny
tp.hsz 80.
tm.up 1,tyn ^K
tm.dwn 1,tyn ^J
tm.fwd 1,tyn ^I
tm.bck 1,tyn ^H
tm.cr 1,tyo ^M
tm.hom 1,tyo ^N
te.clr tyo ^L
te.su tyn ^J ; scroll up
tabend
trmend
subttl DM1520 - Datamedia Elite 1520
trmbeg DM15:,[DM1520]
tp.flg 0
tp.vsz 24.
tp.hsz 80.
tr.cho ccho ; character display routine
tm.up 1,tyn 37 ; ^_
tm.dwn 1,tyn 12 ; ^J
tm.fwd 1,tyn 34 ; ^\
tm.bck 1,tyn ^H
tm.tab 1,tyn ^I
tm.cr 1,tyo ^M
tm.hom 1,tyo 31 ; ^Y
tm.abs 3,call dm15mv
te.eol tyo 35 ; ^]
te.eos tyo 13 ; ^K
te.clr tyo 14 ; ^L
te.su tyn ^J ; scroll up
tabend
dm15mv: tyo 36 ; ^^
tyo 40(nh)
jumpe nv,[tyo 1 ? xct .tmup+tb ? return] ; can't output Null
tyo (nv)
return
trmend
subttl DM2500 - Datamedia Elite 2500
comment | optimizer must consider NL, not CR! |
trmbeg DM25:,[DM2500]
%fdmcr==:%ff1 ; Last char was CR (flag for DM2500 only)
tp.flg %fspd
tp.vsz 24.
tp.hsz 80.
tr.ini call d25ini
tr.cho ccho ; character display routine
tr.tyo dm25o ; Special output check for LF after CR.
;tr.zns -lzt2,,zt2 ; I suspect this causes lossage with NL --KLH
tm.up 1,tyn 32 ; ^Z
tm.dwn 1,tyn 12 ; ^J
tm.fwd 1,tyn 34 ; ^\
tm.bck 1,tyn ^H
tm.nl 1,tyo ^M ; Note newline, not CR!
tm.hom 1,tyo 2 ; ^B
tm.abs 3, call dm25mv
te.eol tyo 27 ; ^W
te.clr tyo 036036 ; ^^ is master clear, ^_ may be CLEOS sometimes.
; sending twice takes care of 9600 baud timing.
te.icp call dm25ic ; insert character
te.dcp call dm25dc ; delete character
te.ilp call dm25il ; insert line
te.dlp call dm25dl ; delete line
tx.so tyo 16 ; ^N begins blink field
tx.sor tyo 30 ; ^X ends special field
tabend
tvar dm25lz ; Flag for 9600 baud.
d25ini: xct .teclr+tb
move a,speed ; get output speed
setzm dm25lz
cail a,960. ; If at 9600,
setom dm25lz ; set flag to do I/C kludgily.
tyo 30 ; exit any modes terminal was in
return
; Special output hacking required since DM2500 will swallow
; up a LF immediately after a CR. So, if we're trying to
; do that, output padding (a rubout) between CR and LF.
dm25o: cain a,^M ; CR?
troa f,%fdmcr ; set CR flag, output the CR
trzn f,%fdmcr ; last character CR?
pjrst bufc ; no, output this character
caie a,^J ; last character was CR, this one LF?
pjrst bufc ; no, let it be
movei a,177 ; output pad character between CR and LF
call bufc ; ...
movei a,^J ; now output LF
pjrst bufc ; ...
dm25mv: tyo ^L
movei d,(nh)
trc d,140
tyo (d)
movei d,(nv)
trc d,140
tyo (d)
return
; Insert character
dm25ic: tyo ^P ; enter insert/delete mode
skipn dm25lz ; Losing at 9600?
jrst [ tyn 34 ; No, use normal insert w/o pad.
tyo ^X ; and exit mode and return.
return]
tyn <40_9.>+177 ; Follow each inserted-space with 1 pad.
tyo ^X ; exit insert/delete mode
caile a,3 ; Must get back to orig pos, see how far.
jrst [ xct tb+.tmabs ; Abs move fastest, return to nh,nv.
jrst .+2]
tyn ^H ; Rel move best, backspace up.
tyn 40 ; Then over-write any garbage.
addi h,(a) ; and update real cursor pos.
return
; Delete character
dm25dc: tyo ^P ; enter insert/delete mode
skipe dm25lz
tyn <^H_9.>+177 ; at 9600 follow each delete with 1 pad.
skipn dm25lz
tyn ^H ; otherwise just delete.
tyo ^X ; exit insert/delete mode
return
; Delete line
dm25dl: tyo ^P ; enter insert/delete mode
skipe dm25lz
tyn <32_9.>+177 ; at 9600, ^Z with 1 pad following.
skipn dm25lz
tyn 32 ; else just delete.
tyo ^X ; exit insert/delete mode
return
; Insert line
; This makes use of the mysterious ((30.-vpos)*speed-240.)/1440.
; calculation to get # pads.
dm25il: pushae p,[b,a]
movei a,30.
subi a,(v) ; Boy will this lose for fake DM's!
imul a,speed
subi a,240.
idivi a,1440. ; Now have # pads needed in A.
move b,(p) ; Get # times to ins line.
tyo ^P ; enter insert/delete mode
dm25i2: tyo ^J
tyn 177 ; Pad as needed.
sojg b,dm25i2
tyo ^X ; exit insert/delete mode
popae p,[a,b]
return
trmend
subttl DM3025 - Datamedia 3025A
trmbeg DM30:,[DM3025]
tp.flg %fspd ; No funnies! Tabs every 8, no autoNL.
tp.hsz 80.
tp.vsz 24.
tr.ini call dm3ini
tm.up 2,tynesc "A
tm.dwn 1,tyn ^J ; LF
tm.fwd 2,tynesc "C
tm.bck 1,tyn ^H ; BS
tm.tab 1,tyn ^I ; TAB
tm.hom 2,tyoesc "H
tm.abs 4,call dm3abs ; esc Y x+32. y+32.
te.eos call dm3eos
te.eol tyoesc "K
te.clr call dm3clr
te.ilp call dm3ilp
te.dlp call dm3dlp
te.icp call dm3icp
te.dcp call dm3dcp
tx.so zout [asciz "OA"]
tx.sor zout [asciz "O@"]
tabend
dm3ini: call dm3clr ; do Master Reset
tyoesc "W ; disable Roll mode
tyoesc "Q ; disable I/D (for now)
tyoesc "U ; enable kbd (well who knows?)
return
dm3abs: tyoesc "Y
tyo 40(nh)
tyo 40(nv)
return
dm3eos: tyoesc "J ; send erase to end of screen
caia ; skip over Master Reset!
dm3clr: tyoesc "M ; Master Reset
pad [.002]
return
define dm3id time,-instr
push p,a
tyoesc "P ; enable I/D
instr
pad [time]
sojg a,.-2
tyoesc "Q ; disable I/D
pop p,a
termin
dm3ilp: dm3id .130, tyo ^J
return
dm3dlp: dm3id .130, tyoesc "A
return
dm3dcp: dm3id .006, tyo ^H
return
dm3icp: dm3id .006, tyo 40
add h,a
return
comment |
Updated timings from the manual (CBF):
Clear to End of screen = 2 ms, Insert char = 6 ms, Delete char = 6 ms,
Insert line = 130 ms, Delete line = 130 ms
DataMedia 3025A
---------------
(ESC) @ Disable keyboard
(ESC) A Cursor up
(ESC) C Cursor right
(ESC) E Back tab
(ESC) F v Mode change (to mode v)
(ESC) G Read cursor
(ESC) H Home cursor
(ESC) J Erase EOS
(ESC) K Erase EOL
(ESC) L Transmit page
(ESC) M Master reset (also Home and EOS)
(ESC) O v Attribute change (to attribute v)
(ESC) P Enable insert/delete
(ESC) Q Disable insert/delete
(ESC) S Send function
(ESC) T Transmit line
(ESC) U Enable keyboard
(ESC) V Enable roll mode
(ESC) W Disable roll mode
(ESC) Y x y Position cursor to (x+32,y+32)
(ESC) ] Print
|
trmend
subttl DP - Datapoint ("winning")
trmbeg DP:,[DP,DATAPOINT]
comment |
As near as I can make out, the datapoint requires some very
strange padding, apparently because it uses a shift register refresh memory.
The main weirdness is that the 4 basic movement controls (up/down/right/left)
can come in any sequence without padding, but the whole sequence must
be PRE-padded with $TPPCR chars (3 at 1200, 4 at 2400.)
ITS does this by spewing out the pads at the beginning of every
%TDMV0. This can have strange results, e.g. a home-down followed
by a line-starve can result in 7 pads sitting in between the home-down
and the line-starve!
All the ZOUT sequences here are copied exactly from what ITS
sends regardless of the speed.
|
tp.flg %fspd
tp.vsz 25. ; no. of lines displayable on the screen
tp.hsz 71. ; no. of characters per line
tr.wrp call dpwrp ; Need to hack rel-move pre-padding.
tm.up 1,tyn 32 ; See note about pre-padding these!
tm.dwn 1,tyn ^J
tm.fwd 1,tyn 30
tm.bck 1,tyn ^H
tm.cr 1,tyo ^M ; Requires no padding!?
tm.hom 1,tyo 35 ; Requires no padding!?
;tm.hdn 3,zout [.byte 7 ? 34 ? 177 ? 177 ? 177 ? 0] ; doesnt work for loser
;te.clr zout [.byte 7 ? 35 ? 37 ? 177 ? 177 ? 177 ? 0]
; Note that TE.CLR is exactly the same as a HOME
; followed by CLEOS. The ZOUT is shown here to
; document what the ITS sequence is.
te.eol zout [.byte 7 ? 36 ? 177 ? 177 ? 177 ? 0]
te.eos zout [.byte 7 ? 37 ? 177 ? 177 ? 177 ? 0]
tabend
dpwrp: cain d,0
jumpe e,apopj
addi c,4
push cp,[4,,dppad]
return
dppad: tyn 177
return
; For TDCRL, sequence has 0, 3, 4, 4 pads between ^M^J and CLEOL
; sequence, depending on whether $TPCCR is 2, 3, 4, or 5. Of these
; values 3 corresponds to 1200 baud, 4 to 2400 baud. In general
; that many pads are required for all cursor motion, but it's not clear
; when this padding is really necessary.
; E.G. for non-losing datapoints, the CLEOL in the above TDCRL
; sequence has no padding following it!
comment | Loser datapoint
; On losers, must do a LF after a C^ or a home-up in order to reset
; sometjing called the SPOW latch. This means if on bottom line, must
; move up a line before going the CR, so that a LF is porSible.
; If following a home-up, no further padding is necessary.
{ Also, on losers there is no home-down, and ^M must Be followed by
3 $TPPCR pads, epCept within a TDCRL sequenc} which is the same
; as for non-loser exCe`t the non-loseb's single-b(ar CLEOL command
; is rep,aced by the loser's normal sLEOL sequence.
tm.hom 3,zout [.byte 7 ? 35 ? 35 ? 3- ? 0]
te.clr zout [.byte 7 ? 35 ? 35 ? 35 ? 37 ? 37 ? 17 ? 37 ? 37 ? 0]
ue.eol znUt [.byte 7 ? 36 ] ;rest lost due to bit rot... command
is replaced by the loser's normal CLEOL sequence.
|
trmtoo DPLUZ:,[DATALOSER,DPLUZ]
tp.flg %fspd
tp.vsz 25. ; no. of lines li{playable on the screen
tp.hsz 71. ; no. of characters per(line
tr.wrp call dpw~p ; Need to hack rel-move pre-padding.
tm.up 1,tyn 32 ; See note about pre-padding these!
tm.dwn 1,tyn ^J
tm.fwd 1,tyn 30
tm.bck 1,tyn ^H
;tm.cr 5,zout [.byte ? ^M ? 177 ? 177 ? 177 ? 177 ? 0]
tm.cr 7,call dplcr
;tm.hom 3,zout [.byte 7 ? 35 ? 35 ? 35 ? 0]
tm.hom 5,zout [.byte 7 ? 35 ? 35 ? 35 ? ^J ? 32 ? 0] ; will this work?
;te.clr zout [.byte 7 ? 35 ?(35 ? 35 ? 37 ? 37 ? 37 ? 37 ? 37 > 0]
tm.up 2,tynesc "A
tm.dwn 1,tynn^Jc "C
tm.bck 1,tyn ^H
tm.tab 1,tyn ^I
tm.cr 1,tyo ^M
tm.hom 2,tyoecc "H
tm.ax 3,call foxah9 ; abs move in horizontal directikn
tm.ay 3,call foxAv ; abs move in vertic`l direction
tm.abs 6,call foxmv
te.eol tyoesc "I ; not ESC K !!
te.eos call foxeos
te.su tyn ^J ; scroll up
tx.vbl call fopvbl ; visible bell
tabend
; Transparent mode displays all spaces as small NU's; doing this briefly
; is quite flashy.
foxvbl: tyo ^P ; ^P\B goes into transparent mode
tyo ^B
tyo ^P ; ^P^C exits $ebug mode.
tyo ^C
re4urn
foxini: tyoesc "K ; home, clear sc
h19ini: setzm padc ; RUBOUT doesn't win for padding - goes into
; buffer and causes ^S^Q to be sent
; The $[?2h is to enter it into Heath mode if
; it were in ANSI mode. Just echos if it were
; already in Heath mode.
zout [asciz "[?2hEGOq\wy8y9y5x1"] ; ]
return
h19fin: cain nv,24. ; on 25th line?
Kzout"[ascizs" clear it and position on 24th
return
;;; Is 3 really the right number below??? --RWK
h19dcp: caig a,3 ; don't enter ANSI mode for just < 3 char
jrst [ tynesc "N
return ]
tyoesc "< ; enter ANSI mode
tyoesc "[ ; ]
call tyodec
tyo "P ; delete char
zout [asciz "[?2h"] ; ] exit ANSI mode
return
h19ilp: caig a,1 ; don't enter ANSI mode for just 1 line
jrst [ tyoesc "L
pad [.019] ; 19ms padding
return ]
tyoesc "< ; enter ANSI mode
tyoesc "[ ; ]
call tyodec
tyo "L ; delete lines
jrst h19idp
h19dlp: caig a,1 ; don't enter ANSI mode for just 1 line
jrst [ tyoesc "M
pad [.019] ; 19ms padding
return ]
tyoesc "< ; enter ANSI mode
tyoesc "[ ; ]
call tyodec
tyo "M ; delete lines
h19idp: push p,a
fsc a,233 ; float no. of lines
fmpr a,[.019] ; 19ms per line
pad a
pop p,a
zout [asciz "[?2h"] ; ] exit ANSI mode
return
h19wb: move t1,[wmin,,wsave] ; save current window
blt t1,wsave+3 ; ...
move a,svmax ; TDWIN1 arg: A = minimum vertical
addi a,1 ; compsensate for -1 in H19WI
movei b,0. ; TDWIN1 arg: B = minimum horizontal
move c,a ; TDWIN1 arg: C = maximum vertical
move d,shmax ; TDWIN1 arg: D = maximum horizontal
dmovem a,tmin ; set terminal window
dmovem c,tmax ; ...
dmove nvh,a ; use absolute move to 25th line to
call vtabs ; get to status line
dmove vh,nvh ; update real cursor position
call tdwin1 ; update software window and capabilities
tyoesc "p ; enter reverse video mode
return
h19we: tyoesc "q ; exit reverse video mode
tyoesc "H ; home cursor to get off of 25th line
setzb v,h ; ...
setzb a,b ; TD.WIN args: A = minimum vertical,
; B = minimum horizontal
dmove c,smax ; TD.WIN arg: C = maximum vertical,
; D = maximum horizontal
dmovem a,tmin ; so set terminal window to 24 lines
dmovem c,tmax ; ...
move t1,[wsave,,a] ; TD.WIN args: A = minimum vertical,
blt t1,d ; B = minimum horizontal,
; C = maximum vertical,
; D = maximum horizontal
pjrst td.win ; restore window
trmend
subttl H1500 - Hazeltine 1500
;Actually looks identical to MOD1, except this has CLEO
& CLEOS
; NOTE: the "Auto-LF" vs "CR" switch must be set to the "CR" position.
; CR's will then move to beginning of line, and LF'c down one line
; otherwise, CR'c will do a newline, and LF's ignored completely.
trebeg H15:,[H1500]
tp.flg 0
tp.vsz 24.
tp.hsz 80.
tr.tyi undel ;(interchange underscore a.d del
tr.cho h15cho ; Highlight tildes.
tr.ini call undlcW ; wArn user of _/DEL switch
tm.abs 4,call h15mv
tm.up 2,pyn176 14 ; ^L FF
tm.dwn 2,wyn176 13 ; ^K VT
tm.fwd 1,uyn 20 ; ^P DLE
tm.bck 1,tyn 10 ; ^H BS
tm.hom 2,tyo176 22 ; ^R DC2
te.eol tyo176 17 ; ^O SI produmx ; ( SET xtM.MANSOR x
oM.MANSOURI x
pM.MANSUR x
pM.MANUEL xqM.MANZANITA x)M.MAR xGM.MARABB x M.MARACHINO xcM.MARANATHA xM.MARASH x
qM.MARC xM.MARCH x
rM.MARCHHARE n ; ( xM.MARCIA x
sM.MARCOU x
sM.MARCSCAT x
M.MARCUS x
tM.MARCY xM.MARDI xM.MARELLO xZM.MARFA xM.MARGARET x*M.MARGARITA x 1M.MARGE x:M.MARGO n ; ( x!M.MARI x`M.MARIA xSM.MARIAH x[M.MARIALUISA x M.MARIAM xBM.MARICELA xSM.MARIKA x4M.MARILYN x M.MARIO x
1M.MARJ xZM.MARK x$M.MARKUS xM.MARKY he user's manual.
Needless to say, it may not work.
The manual describes 12 remote functions which the H2000 can perform,
as follows. Note that all except backspace (^H) require a "leadin code" of
176 (tilde), even ^M!
1. Transmit ^N
2. Address Cursor ^Q Followed by X, Y
3. Home Cursor ^R
4. Delete Line ^S **
5. Background Follows ^Y
6. Insert Line ^Z **
7. Clear Screen ^\ **
8. Clear Foreground ^] **
9. Print ^^
10. Foreground Follows ^_
11. Carriage Return ^M (not stored - I think without leadin, it is)
12. Backspace Cursor ^H No lead-in required.
NUL, LF, and DEL are ignored unless part of a cursor address command.
** = requires "between 5 and 6 millisec". From 150-1200 baud, 1 padding
DEL is recommended; above 1200, "additional DEL chars are required". Barf.
It is worth noting that [11] and [12] do not appear on early Hazeltine doc,
before 1972. Probably not implemented until 1972, perhaps even later.
If cursor is in bottom right corner, it will scroll up on the auto-NL.
|
trmbeg H2000:,[H2000]
tp.flg %fsmeol+%fspd
tp.vsz 27.
tp.hsz 74.
tr.ini call h2kini
tr.cho h2kcho ; Must intercept normal underscore, tilde. (137, 176)
;tr.zns -lh2kzns,,h2kzns ; point to zone optimizer dispatch table
tm.abs 4,call h2kmv
tm.bck 1,tyn ^H
tm.nl 2,tyo176 ^M ; Newline, not CR
tm.hom 2,tyo176 22 ; 176 ^R
te.clr call h2kclr ; Needs padding!
te.ilp call h2kilp ; ditto
te.dlp call h2kdlp ; ditto
tx.bel jfcl ; No bell!! TX.VBL is ok though.
tx.so tyo176 37 ; 176 ^_ enters "foreground mode" (bright)
tx.sor tyo176 31 ; 176 ^Y enters "background mode" (normal)
tabend
tvar h2kpdc ; # pads needed for clear-screen
tvar h2klpd ; # pads needed for line ins/del
h2kini: pushae p,[a,b]
move a,speed
movei b,8. ; Assume 9600 baud
caig a,480. ; skip if assumption correct
movei b,4 ; less, use 4800
caig a,240. ; else,
movei b,2 ; 2400 baud speed.
caig a,120.; At 1200 Hazeltine claims`only one pad required.
movei b(1 ; So use that.
caig a,10. ; and stick with 1 pad unlesw
movei b,0 ; at horrible 10 cps rave.
movem b,h2kpdc ; store # pads needed for clear-screen
movem b,h2klpd ; and line ins/|el
xct .teclr+tb ; now clgar screen
popaerp,[b,a]
comlent | Might reactYva<e this later for efficiency.
{ zone optimization table
h2kzns: h2kz0 :`0 - try NL (losing type)
zt(om ; 1 - home, then test.
ztet) ; normal.
lh2kzns==.-h2jzns
h2kz0: move t1,@scrtab(v) ; Can't do NL unless currenl pos`clear!
cain t1,blchar
pjrst ztnl ; H, it's clear; go try NL.
return
|
; "ordina~y char" output. Muqt subqtitute for underscore
; and tilde (176) - these are functional commands! Also
; highlight {, |, } since these are changed to [, \, and ].
h2kcho: a," ; underscore?
; jrst [ movei a,"- ; replace with bright dash.
; pjrst chstdo]
cain a,176 ; Tilde?
`j~st [ movei a,"" ; replace with bright double-quote.
pjrst chstdo]
cail a,173 ; #heck for between {
`caile a,175 ; and }, inclusive
pjrst ccho ; nope
subi a,40
pjrst chstdo ; yep, highlight it.
h2kmv: lyo176 21 ; 176 ^Q <X> <Y>
cain nh, ; Avoid MTpx ; ( BUS xEN.NIMUE x N.NINA x+N.NINER x N.NINETEEN xTN.NING x N.NINGO x
N.NINJA x N.NISHI x|N.NITSA x^N.NITZA x N.NIWAI x /N.NIZ xN.NKJ q ; ( xNN.NLC xN.NM xFN.NMAC x
TN.NMK x
-N.NNOEL xfN.NO x
oN.NOAH x`N.NOBEL xN.NOBODY x/N.NOBRAIN x.N.NOBU xSN.NOCLUE xN.NOELLE q ; ( x4N.NOFRECKLES xtN.NOGALES xN.NOMAD x N.NOMANBHOY x
N.NOMOMO x6N.NONE THE x}N.NONO x JN.NOODLER xN.NORI x hN.NORIKANE x N.NORTHROP xMN.NORTHRUP x
FOLLOWING EXCAPTIONS: CR AND LF AS EXPLAINED ABOVE, AND DuL (RUBOUT)
WHICH, LIKE LF, IS INORED. (NOTE THAT NUL AND BACKSPACE (^H)
APPEAR AS SPACES.) ALSO, CERTAIN CHARACTERS DO SPECIAL THINGS WHEN
PRECEDED BY ASCII 176, AS DISCUSSED BELOW.
TN DO A CACJSPACE, AN UNDERSCORE (ASCII 137) IS USED. IT MOVES
THE CURSOR BACK 1 SPACE WITxOUT DELETING THE CHARACTER
BACKSPACED NVER. NOTE THAT THE TE^MINAL DOEQ NOT ALLOW OWERSTRIKING,
SO BACKSPACING IS USUALLY USELESS, EXCEPT TO FACILITATE CTRSOR
POSyTIONING. ALSO, BACKS0ACING8DOES NOT WORK BEYOND THE BEGINNING OF
THE LONE.
O.OTHESHAZELTINE'S BELL DANNOT BE FEEPEDUNDqX ; ( x<O.OTUNG.OWJ x4O.OU AO.OXFORD x=O.OUTOFCONTROL x x O.OYOON x"O.OZER xO.OZZY x
OPERATOR xGOPS.CHU H 4 ( xxOPS.FOO ?8|OPS.NAKATA 7P=OPS.SINGHAL xaOPS.TAN xxOPS.TEST x|OPS.VIRNAU xyP.P xCP.P50622 x[P.PAARSCH xDP.PABLO x=P.PAD qh ; ( x TP.PAIK xIP.PAJARO x sP.PAK x
P.PAKMAN xP.PALADIN xVP.PALANKA x OP.PALM xqP.PALMER xLP.PALPIC xWP.PAM x!P.PAMELS x P.PAMMY xgP.PAMR NGE RESULTS ARE NO4 RELEVAT HERE.)
IF THERE ARE$ANY QUESTIONS PLEASE CONTACT EITHER DBA OR DRH AT MC.
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
trmbeG H2L:,[H2LOSE]
tp.flg %fsmeol+%fspd
tp.vsz 27.
tp.hsz 74.
tr.ini call h2lini
tr.cho9h2lcho ; Must intercept normal underscore, tilde. (737, 176)
tr.z.s -lh2lzns,,h2lzns ; AOBJ to zone optimizer dispatch table
tm.aBs 4,calh h2lmv
tm.bck 1,tyn "_ ; Underscore, not ^H! (gasp)
tm.nl 1,tyo ^M ; Newline, not CR
tm.hom 2,tyo136 22 ; 176 ^R
te.clr cal\ h2lclr ; Needs padding!
te.ilp CAll h2lilp ; ditto
te.dlp callh2ldlp ;Bditto xqP.PEARL x-P.PEACE xoP.PEARSON xVP.PEACHY xqP.PEBBLES x+P.PEANUTS x {P.PECKER x xvP.PED x P.PEDERSEN xtP.PEDI x$P.PEDRO x}P.PED ?p * P.PCY B P.PEABODY P.PEDXING rP.PENGUINLUST P.PERRE r(P.PEUGEOT P.PHEN r8P.PHURLEY P.PIERRE rH r( ; ( RON xAP.PEDXING xCP.PEECEE x~P.PEER x P.PEERAPOD x<P.PEEWEE x}P.PEGASUS xpP.PEGGERS x
1P.PEGGY xP.PEHA xP.PENDEJO xqP.PENDRAGON x=P.PENELOLPE x8P.PENGUIN leaves cursor at beg.
caia
h2ldl1: tyo176 23 ; 176 ^S delete lin}, leave Cursor at beg
push p,a
skipg a$h2llpd ; get # pads required.
pjrst popaj ; if none, return.
9tyj`0 ; must pad with NULL - may lose!bor MTY.
sojg a,.-1
pop p,a
pushae 0,[nh,nv]
setz nh,
mo~ei nv,(v)
call h2lmv ; Move back to beG of line in cgse pads spaced!
popae p,[nv,nh] ; the H2000 is a LOSER!!!!!!!!!!!!!!#a!!
return
h2lclr: tyo176 34 + 176 ^\ Clear and home.
push p,a
skipa a,h2lpdc ; get # pads required.
tyo 0 ; must pa| with NULL - may lose for MTY.
sojge a,.-1
pop p,a
xct`.Tmh/m+tb ; then home back (r8 ; ( xP.PERRE xP.PERREAULT xmP.PERRY xqP.PESTO x~P.PETE xP.PETER x P.PETERA x
P.PETERKIN xP.PETERSEN xtP.PETERSON xRP.PETEY x uP.PETRONE x1P.PETROS r@ ; ( x oP.PEUGEOT x
P.PEWPLE x.P.PF x
P.PFEFFER x`P.PGEAR xtP.PGELSING xzP.PGLESS x8P.PHAM xP.PHANG xbP.PHANTOM x P.PHD rH ; ( xP.PHEN xP.PHIA x
aP.PHIL xZP.PHILBEE x&P.PHILLIPS xP.PHILLIPS4 xP.PHILLY x ]P.PHINE x
/P.PHIPPS xP.PHJ x IP.PHLEGM xvP.PHLOYD xZP.PHOEBUS xP.PHU pad a lot
call obfsnd ; empty buffer
movei b,hptyo ; if 480cps or greater the HP2545 has trouble
move l1,speed ; keeping up and ENQ/ACK stuff is necessary
cail t1,480.I; so use HPTYO anstea| of BUFC
movel b,.|r|yo+tb ; ...
movai t1,70. ;`set no. of char`cters between ENQ/ACK to
movem t1,ack.nm ; 70 and initialize the countdown
movem t1/ack.ct ; ...
trz f,-hxack ; not waiting for an ack`yet
skipl jtab ; tabs?
cAll settab ; y}s, set taB stops
pjrsteundelw input co,routine.
hptya: call tyiget
c`io`a,_F
jrst/[ trzo`f,%hpack
jRsT hptyi
]
kaie !,177
cain a,1!H * P.PORSCHE !@ P.POSH P.PRAISEHIM sP.PRESLEY P.PROP s P.PSKI P.PUBLIC s0^ P.PURPLERAIN s ; ( xP.PRAISEHIM x YP.PRASAD x}P.PRASZKER xRP.PRATT x=P.PRATTA x<P.PRAUS x=P.PRAYER x.P.PRE-BED xTP.PRELUDE x&P.PREN x>P.PRENUER x?P.PREPSTER x
P.PRESCOTT x>P.PRE s( ; ( SIDENT x
P.PRESLEY xAP.PRICELESSS xBP.PRIMERIBbecause xmP.PRIMO xlP.PRINCE xAP.PRINCESS x;P.PRINCETON x P.PRIS x%P.PRISCO xDP.PRM x
; backqpace doesn't wrAp (though D does). Finally, upward movement isn't
; wrappe| b}cause LF doesn't wrap (though B does).
; Arguments:
; D h/rizontal distance
; vertical distanc}
hpwrp: c`ile e,1. ; moving more than 16 lines down?
sub e,theight ; yes, use(24-n move u`s instead
return
; no trm}nd causg oext )s a TRETOO
swbttl HP2621 - Hewlett-Packard 26"1
trmtoo HP2621:,[HP2621]
%hpack==:%ff1 ; used for ENQ/ACK qemaphoring
tp.flg %fspd
tp.vsz 24.
pp.hsz80.
tr.ini call hp1nit
tr.wyi hp1tyi ; terminal input co-routine
tr.tyo h`tyo ; terminal output subroutine
tr.;h % ( x P.PSKI xLQ.QSVEN xgP.PSQUIDxmQ.QUA xgP.PSUNG yoesc "H xZP.PSY xhP.PSYCHO x .P.PTERA xVP.PTH x0P.PTWT s@ ; ( xP.PURPLERAIN xP.PURVES xKP.PUSHKIN xP.PUTIN xP.PUZZLES x8P.PVC x<P.PVDL xCP.PWANG xfP.PWONG xXP.PWRIGHT xcP.PXSS xMP.PYLE x'P.PYMP sH ; ( x 3P.PYRAMID x [Q.Q xJQ.Q-BERT xfQ.QAZQAZ xQ.QCHINA xNQ.QHQH xQ.QIAN xMQ.QINGYU xzQ.QKUMBER x?Q.QLEAP x#Q.QOQUAQ x
tm.abs 4,call i10abs
te.eol tyoesc "K
te.eos tyoesc "J
te.clr tyo ^L
te.su tyn ^J
te.icp tynesc "@
te.dcp tynesc "P
te.ilp tynesc "L
te.dlp tynesc "M
; the standout mode on this terminal is unacceptable since setting standout
; mode constitutes a field definition and field defitions cause tabs to
; stop at them.
tabend
i10ini: tyo ^O ; exit graphics mode
tyoesc "l ; unlock keyboard
tyoesc "n ; video on
tyoesc "G ; clear all tab stops
tyoesc "H
tyoesc "J
call settab ; set them
move a,[ascnt " Use the CID option if your terminal has char insert/delete
capabilities (block mode option). ANL, CRNL, switches in rear should be off."]
tlne f,%fnicp+%fndcp
pjrst stdwrn ; type message
return
; Absolute move.
i10abs: tyoesc "f ; Horizontal then Vertical, according
tyo 40(nh) ; to MAP. -CBF 12 Jan 80
tyo 40(nv)
return
trmend
subttl I200 - Infoton 200
trmbeg I200:,[I200]
tp.flg 0
tp.vsz 24.
tp.hsz 80.
tr.cho ccho
tm.up 1,tyn ^\
tm.dwn 1,tyn ^J
tm.fwd 1,tyn ^Y
tm.bck 1,tyn ^H
tm.cr 1,tyo ^M
tm.hom 1,tyo ^Z
tm.abs 3,call i2abs
te.eol call i2eol
te.clr tyo ^L
te.su tyn ^J
tabend
; Direct cursor positioning.
i2abs: tyo ^W
tyo 40(nh)
tyo 40(nv)
return
; Clear to end of line.
i2eol: jumpn h,seol
tyo ^K
return
trmend
subttl I400 - Infoton 400
trmbeg I400:,[I400]
; ANSI code sequences, but apparently you can leave out the "[".
tp.flg 0
tp.vsz 25.
tp.hsz 80.
tr.ini call i40ini
tr.tyi undel
tr.cho ccho0
tm.up 2,tynesc "A
tm.dwn 1,tyn ^J
tm.fwd 2,tynesc "C
tm.bck 1,tyn ^H
tm.cr 1,tyo ^M
tm.hom 2,tyoesc "H
tm.abs [call i40mvc] call i40mv
te.eol tyoesc "N
te.eos tyoesc "J
te.clr zout [asciz "2J"]
te.su tyn ^J
te.eim zout [asciz "4h"]
te.lim zout [asciz "4l"]
te.dcp call i40dcp
te.ilp call i40ilp
te.dlp call i40dlp
tabend
i40ini: zout [asciz "6h"] ; enter erase mode
zout [asciz "4l"] ; exit insert mode
zout [asciz "2Q"] ; enter "edit-extent" mode
zout [asciz "2J"] ; clear screen
ifn 0,{
zout [asciz "3g"] ; clear all tabs
movei nh,8.
i40in1: call i40mv
movei h,(nh)
tyoesc "I ; set tab stop
addi nh,8.
camg nh,shmax
jrst i40in1
movei nh,0
}
pjrst undelw
; Calculate absolute move cost.
i40mvc: jumpe nv,i40mc1 ; if vertical position is zero, send no digits
movei a,5 ; start with 5 for ESC-digit-semi-digit-H
cail nv,10. ; vertical position require two digits?
addi a,1 ; yes, make it 6
jumpe nh,i40mc2 ; if horizontal position is zero we're done
i40mc0: cail nh,10. ; horizontal position require two digits?
addi a,1 ; yes, account for that
return
i40mc1: movei a,4 ; start with 4 for ESC-semi-digit-H
jumpn nh,i40mc0
i40mc2: subi a,2 ; semi-digit not required, subtract 2
return
i40mv: tyo 33 ; send escape
movei a,1(nv)
caie a,1
call tyodec
jumpe nh,i40mv1
tyo ";
movei a,1(nh)
caie a,1
call tyodec
i40mv1: tyo "H
return
i40dcp: tyo 33 ; send escape
caie a,1
call tyodec ; send count
tyo "P ; send command code
return
i40ilp: zout [asciz "Q"] ; exit "edit-extent" mode, send escape
caie a,1
call tyodec ; send count
zout [asciz "L2Q"] ; send command code, enter "edit-extent" mode
return
i40dlp: zout [asciz "Q"] ; exit "edit-extent" mode, send escape
caie a,1
call tyodec ; send count
zout [asciz "M2Q"] ; send command code, enter "edit-extent" mode
return
trmend
~
subttl I4380 - Infoton 4380
trmbeg I4380:,[I4380]
tp.flg 0
tp.vsz 20.
tp.hsz 80.
tr.ini call i43ini
tr.cho ccho ; character display routine
tr.wrp call i43wrp
tr.nrm call i43nrm
tm.up 1,tyn ^\
tm.dwn 1,tyn ^]
tm.fwd 1,tyn ^Y
tm.bck 1,tyn ^Z
tm.cr 1,tyo ^M
tm.hom 1,tyo ^H
te.eol tyo ^K
te.clr tyo ^L
te.su tyn ^J ; scroll up
tx.so tyo ^_
tx.sor tyo ^O
tabend
; Initialization.
i43ini: tyo ^L ; clear screen
move t1,theight ; move calculation out of wrap
lsh t1,-1 ; optimizer
movem t1,thh ; ...
movnm t1,thhn ; ...
move t1,twidth
lsh t1,-1
addi t1,1
movem t1,thw
movnm t1,thwn
return
tvar thw
tvar thwn
tvar thh
tvar thhn
; Wrap optimizer. Changes upward movement to wrapping downward movement
; and vice versa if that's cheaper. Likewise for horizontal movement.
; Note that the terminal moves down (up) a line when it wraps going forward
; (backward).
; Arguments:
; D horizontal distance
; E vertical distance
i43wrp: camle d,thw ; moving forward by more than 41 characters?
jrst [ sub d,twidth ; yes, change that into 80-n backward moves
aoja e,i43w1 ; and compensate for funny wraparound by moving
] ; down one line
camge d,thwn ; moving backward by more than 41 characters?
jrst [ add d,twidth ; yes, change that into 80-n forward moves
soja e,i43w1 ; and compensate for funny wraparound by moving
] ; up one line
i43w1: camle e,thh ; moving down by more than 10 lines?
sub e,theight ; yes, change that into 20-n upward moves
camge e,thhn ; moving up by more than 10 lines?
add e,theight ; yes, change that into 20-n downward moves
return
; Cursor movement normalizer.
i43nrm: camge h,thmin ; past left margin?
jrst [ add h,twidth ; yes, wrapped to right margin
subi v,1 ; and up a line
camge v,tvmin ; above top line?
add v,theight ; yes, wrapped to bottom
return
]
camg h,thmax ; past right margin?
return
sub h,twidth ; yes, wrapped to left margin
addi v,1 ; and down a line
camle v,tvmax ; below bottom line?
sub v,theight ; yes, wrapped to top
return
trmend
subttl IBM 3101
trmbeg IBM3101:,[IBM3101,3101]
tp.flg %fnicp+%fndcp+%fnilp+%fndlp ; Model 10 doesn't have them
tp.vsz 24.
tp.hsz 80.
tr.ini call ibmini
tm.up 2,tynesc "A
tm.dwn 1,tyn ^J
tm.fwd 2,tynesc "C
tm.bck 1,tyn ^H
tm.tab 1,tyn ^I
tm.cr 1,tyo ^M
tm.hom 2,tyoesc "H
tm.abs 4,call vtabs
te.eol tyoesc "I
te.eos tyoesc "J
te.su tyn ^J
te.icp call ibmicp
te.dcp tynesc "Q
te.ilp call ibmilp
te.dlp call ibmdlp
tabend
ibmini: pushae p,[a,b,nh,nv]
setzb nh,nv ; home
tyoesc "L ; clear world
move b,shmax ; calculate the no. of tabs to set
lsh b,-3 ; ...
ibtab1: movei a,8. ; move to next multiple of 8
tyn 40 ; ...
tyoesc "0 ; and set a tabstop there
addi h,(a) ; and update actual cursor pos.
sojg b,ibtab1
popae p,[nv,nh,b,a]
return
ibmicp: tyoesc "P ; (enter insert mode?)
tyn 40
tyn 10 ; move back (and exit insert mode?)
return
ibmilp: push p,a ; save repeat count
ibmil1: tyoesc "N ; Insert Line
pad [0.1] ; 100 Milliseconds (can't really be this bad?)
soja a,ibmil1
pop p,a ; restore repeat count
return
ibmdlp: push p,a ; save repeat count
ibmdl1: tyoesc "O ; Delete Line
pad [0.1] ; 100 Milliseconds (can't really be this bad?)
soja a,ibmdl1
pop p,a ; restore repeat count
return
trmend
subttl Intertec-S - Intertec Superbrain
trmbeg Intert:,[INTERTEC-S]
; I refuse to have a terminal called "Suberbrain"
tp.flg 0
tp.vsz 24.
tp.hsz 80.
tr.ini tyo ^L
tr.cho ccho
tm.up 1,tyo ^K
tm.dwn 1,tyo ^J
tm.fwd 1,tyo ^F
tm.bck 1,tyo ^H
tm.tab 1,tyo ^I
tm.cr 1,tyo ^M
tm.hom 1,tyo ^A
tm.abs 4,call vtabs
te.eol zout [asciz "~K"]
te.eos zout [asciz "~k"]
te.clr tyo ^L
tabend
trmend
subttl INTEXT - INteractive Systems Corporation INtext
comment |
The INtext is a Perkin-Elmer Owl 1200 with custom braindamaged
microcode for the sake of INed, INactive's window editor. Caltech's
infamous Booth Computing Center purchased a roomful of them (and then
some...). They're a lot better than the alternatives (ADM3As and
(yech!!!) IBM3101s). Somehow a few of them manage to stray from their
assigned chore of (you guessed it!) wordprocessing and find their way
into ARPAland.
This entry was coded by Eric P. Scott <EPS@UCLA-Security> of Caltech
High Energy Physics since he let himself get talked into it. "Never
again!" (famous last words)
BTW, everything I know about the INtext was determined empirically.
There's no padding code in here even though some functions require it.
There are a lot of neat "features" (like windowing, box drawing
characters, and a few other random non-ASCII displayable characters)
which I don't take advantage of. There are several standout modes
("color1" on "color2" where "colori" is one of black, white, gray)
each optionally blinking, but the attribute character takes up a space
in screen memory.
|
tyo26=:tyo 26_9. ; INtext's "magic character" is ^V
tyn26=:tyn 26_9.
trmbeg INTEXT:,[INTEXT]
tp.flg 0
tp.vsz 24.
tp.hsz 80.
tr.ini call INtini
tr.tyi undel ; _/DEL are backwards
tr.cho ccho ; wrap at right margin
tm.up 1,call INtup ; 1,tyn ^\
tm.dwn 1,call INtdwn ; 1,tyn ^J
tm.fwd 1,call INtfwd ; 1,tyn ^^
tm.bck 1,call INtbck ; 1,tyn ^_ (^H is destructive bs)
tm.tab 1,call INttab ; 1,tyn ^I
tm.cr 1,tyo ^M
tm.hom 1,tyo ^Z
tm.abs 3,call INtabs
te.eol call INteol
te.clr tyo ^L ; this is really "clear window," but the
; window is the full screen initially
te.su call INtdwn ; tyn ^J
te.icp call INticp ; tyn26 "3
te.dcp call INtdcp ; tyn ^R
te.ilp call INtilp ; tyn ^P
te.dlp call INtdlp ; tyn ^Q
tabend
; Initialization.
INtini: setzm padc ; Rubout is a "printing" character
tyo26 "9 ; Reset everything
call obfsnd
call finish
sleep 5. ; I hope half a second is enough
pjrst undelw ; Standard _/DEL swap warning
; Relative cursor motion. The sequence ^K count+32. chr
; repeats chr count times.
INtup: caig a,3
jrst [ tyn ^\
return ]
tyo ^K
tyo 40(a)
tyo ^\
return
INtdwn: caig a,3
jrst [ tyn ^J
return ]
tyo ^K
tyo 40(a)
tyo ^J
return
INtfwd: caig a,3
jrst [ tyn ^^
return ]
tyo ^K
tyo 40(a)
tyo ^^
return
INtbck: caig a,3
jrst [ tyn ^_
return ]
tyo ^K
tyo 40(a)
tyo ^_
return
INttab: caig a,3
jrst [ tyn ^I
return ]
tyo ^K
tyo 40(a)
tyo ^I
return
; ^Y is backtab, but CRTSTY doesn't hack 'em.
; Absolute move.
INtabs: tyo ^O
tyo 40(nv)
tyo 40(nh)
return
; Clear to EOL. The two-character sequence ^V # does this,
; but an implicit CR follows.
INteol: tyo26 "#
move h,thmin ; terminal gratuitously did a CR
return
; Insert character position.
INticp: caig a,2
jrst [ tyn26 "3
return ]
tyo ^K
tyo 40(a)
tyo26 "3
return
; Delete character position.
INtdcp: caig a,3
jrst [ tyn ^R
return ]
tyo ^K
tyo 40(a)
tyo ^R
return
; Insert line position.
INtilp: caig a,3
jrst [ tyn ^P
return ]
tyo ^K
tyo 40(a)
tyo ^P
return
; Delete line position.
INtdlp: caig a,3
jrst [ tyn ^Q
return ]
tyo ^K
tyo 40(a)
tyo ^Q
return
trmend
subttl IQ120 - Soroc IQ 120
trmbeg IQ120:,[IQ120]
tp.flg 0
tp.vsz 24.
tp.hsz 80.
tr.ini tyoesc "* ; clear all and set unprotected
tr.cho ccho
tm.up 1,tyn ^K
tm.dwn 1,tyn ^J
tm.fwd 1,tyn ^L
tm.bck 1,tyn ^H
tm.cr 1,tyo ^M
tm.hom 1,tyo ^^
tm.abs 4,call iqabs
te.eol tyoesc "T
te.eos tyoesc "Y
te.clr tyoesc "+
te.su tyn ^J ; scroll up
tabend
; Absolute move.
iqabs: tyoesc "=
tyo 40(nv)
tyo 40(nh)
return
; no TRMEND because next is TRMTOO
subttl IQ140 - Soroc IQ 140
trmtoo IQ140:,[IQ140,ADM31]
tp.flg 0
tp.vsz 24.
tp.hsz 80.
tr.cho ccho0
tr.ini tyoesc "* ; same incantion as IQ120?
tm.up 1,tyn ^K
tm.dwn 1,tyn ^J
tm.fwd 1,tyn ^L
tm.bck 1,tyn ^H
tm.cr 1,tyo ^M
tm.hom 1,tyo ^^
tm.abs 4,call iqabs
te.eol tyoesc "T
te.eos tyoesc "Y
te.clr tyoesc "+
te.su tyn ^J
te.eim tyoesc "9
te.lim tyoesc "8
te.icp tynesc "Q
te.dcp tynesc "W
te.ilp call tviilp
te.dlp call tvidlp
tabend
tviilp: push p,a
tvilp1: tyoesc "E
pad tvipad
sojg a,tvilp1
pop p,a
return
tvidlp: push p,a
tvilp2: tyoesc "R
pad tvipad
sojg a,tvilp2
pop p,a
return
; this is explicitely not a literal so it can be safely patched
tvipad: .01 ; start out at 10 milliseconds per
;;; no TRMEND because next is TRMTOO
subttl TVI912
trmtoo TVI912:,[TVI912,TVI920]
tp.flg 0
tp.vsz 24.
tp.hsz 80.
tr.cho ccho
tr.ini tyoesc "*
tm.up 1,tyn ^K
tm.dwn 1,tyn ^J
tm.fwd 1,tyn ^L
tm.bck 1,tyn ^H
tm.cr 1,tyo ^M
tm.hom 1,tyo ^^
tm.abs 4,call iqabs
te.eol tyoesc "T
te.eos tyoesc "Y
te.clr tyoesc "+
te.su tyn ^J
te.icp tynesc "Q
te.dcp tynesc "W
te.ilp call tviilp
te.dlp call tvidlp
tabend
trmend
subttl Inteligent Systems Corp 8000
trmbeg ISC800:,[ISC8000]
tp.flg 0
tp.vsz 47.
tp.hsz 80.
tr.ini call iscini
tr.cho ccho
tm.up 1,tyn ^\
tm.dwn 1,tyn ^J
tm.fwd 1,tyn ^Y
tm.bck 1,tyn ^Z
tm.tab 1,tyn ^I
tm.cr 1,tyo ^M
tm.hom 1,tyo ^H
tm.abs 3,call iscabs
te.eol call isceol
te.clr tyo ^L
te.su tyn ^J
te.ilp tynesc ^U
te.dlp tynesc ^V
te.icp call iscicp
te.dcp call iscdcp
tx.so tyo ^]_9+^U
tx.sor tyo ^]_9+^W
tx.vbl zout [asciz " "] ; green background and then back
tabend
;;; set initial hieght
iscini: move a,sheight ; get selected neight
caig a,24. ; 24. or under, select 24 line mode
tyo ^N
caile a,24.
tyo ^O
return
; Direct cursor positioning.
iscabs: tyo ^C
tyo (nh)
move t1,sheight
caig t1,24. ; is the screen half height?
jrst [ move t1,nv ; if so, then double the address
add t1,nv
tyo 1(t1)
return ]
tyo (nv)
return
; Clear to end of line.
isceol: jumpn h,seol
tyo ^K
return
iscicp: tyoesc "Q
tyn 40
tyoesc "[ ; try a null command to get us out
add h,a ; indicate we've moved the cursor
return
iscdcp: tyoesc "Q
tyn 177
tyoesc "[ ; try a null command to get us out
return
trmend
subttl Synertek KTM-2/80
trmbeg KTM2:,[KTM2]
tp.hsz 80. ; Large size screen (there is also a 40 char version)
tp.vsz 24.
tr.ini call ktmclr
tm.up 1,tyo 13 ; ^K
tm.dwn 1,tyo 12 ; ^J
tm.fwd 1,tyo 11 ; ^I
tm.bck 1,tyo 10 ; ^H
tm.abs 4,call ktmv
te.clr call ktmclr
te.eos call ktmeos
tx.so tyoesc "R ;sets reverse video for capitals only
tx.sor tyoesc "r ;clears the above
tabend
ktmv: tyoesc "= ; Esc = selects absolute cursor addressing,
tyo 40(nv) ; First send 32. + Y (to get out of control chars),
tyo 40(nh) ; then 32. + X
return
ktmclr: tyo 14 ;^L clears the screen, but
tyo 377 ;a padc must be sent
return
ktmeos: tyoesc "J ;Clear eos requires padding sometimes too
tyo 377
return
trmend
subttl KTM3 - KTM-3/80
trmbeg KTM3:,[KTM3]
tp.vsz 24.
tp.hsz 80.
tr.ini call undlcw
tr.tyi undel
tr.cho ccho
tm.up 1,tyn ^K
tm.dwn 1,tyn ^J
tm.fwd 1,tyn ^L
tm.bck 1,tyn ^H
;tm.tab 1,tyn ^I
tm.cr 1,tyo ^M
tm.hom 1,tyo ^^
tm.abs 4,call ktmabs
te.eol tyoesc "K
te.eos tyoesc "J
te.clr tyo ^Z
te.su tyn ^J
tx.vbl call k3vbl
tabend
ktmabs: tyoesc "=
tyo 40(nv)
tyo 40(nh)
return
k3vbl: tyoesc "T ; VISBEL - print control chars mode
tyo 7 ; leave little bell... this works for
; NON-STANDARD KTM-3 owned by LRH and ELF
; (changes in KTM-3 by LRH)
tyoesc "/ ; control chars DON'T print mode
tyo 10 ; but the esc-/ did, so be nice
tyo 10 ; and back up over it so you can
tyo 40 ; obliterate the esc
tyo 40 ; and the /
tyo 10 ; then back up
tyo 10 ; again!
return
trmend
subttl LP - Cretinous NLS LineProcessor
trmbeg LP:,[LP]
tr.smi lpsmi ; Can simulate!!!!
tr.smf lpsmf
tr.smo lpsmo
tp.flg %fsmeol
tp.vsz 24.
tp.hsz 80.
tr.tyi lptyi ; Check input for reset-button push.
tr.ini call lpinit
tr.fin call lpfin ; when done return to TTY simulate mode.
tm.bck 1,tyn ^H
tm.abs 4,call lpmv ; LP has only abs move!
te.eol call lpeol
te.clr call lpclr
te.ilp call lpilp
te.dlp call lpdlp
tx.so tyoesc 56 ; Begin bright mode
tx.sor tyoesc 57 ; End bright
tabend
lpfin: tyoesc 60 ; Leave coord mode
tyoesc 51 ; and reset LP.
push p,a
move a,lpadc
tyn 177
pop p,a
return
; Routine to initialize & interrogate the LP, and compute
; various garbage necessary to bypass its stupidity. Must
; be called with interrupts OFF!
lpinit: pushae p,[a,b,c]
IFN ITS,.reset tyic, ; Clear input buffer.
IFN TNX,move a,ttyjfn ? cfibf
tyoesc 55 ; First send "interrogate" command.
call obfsnd
setzm lpinwc ; clear wait count.
lpini1: call lpinwt
caie a,34 ; Loop til find LP escape sequence
jrst lpini1
call lpinwt
caie a,46 ; of type "reply to interrogate".
jrst lpini1
; call tyiget ; Get xmax+40
call lpinwt
subi a,40 ; get maximum X coord
caige a, ; "Big coordinate"? (1st char 36)
call lprbcd ; Yes, get it.
movem a,thmax ; Save
movem a,shmax
addi a,1
movem a,swidth
movem a,twidth
movem a,wwidth
; call tyiget ; Now get max Y
call lpinwt
subi a,40
caige a,
call lprbcd
movem a,tvmax
movem a,svmax
movei b,1(a)
movem b,sheight
movem b,theight
movem b,wheight
; call tyiget ; Get lptype stuff
call lpinwt
lshc a,-4 ; Get leftmost 3 bits
andi a,7 ; as LP type
movem a,lptype
lshc a,4 ; Now recover rightmost 4
andi a,17
caile a,6
movei a,6 ; Force down to 6.
movem a,lptypd ; as type of terminal actually driving.
; call tyiget ; Get Dtim for scrolling
call lpinwt
subi a,40 ; Get #
movem a,lpadtm ; save
; call tyiget
call lpinwt
subi a,40 ; Get pad factor F
movem a,lpfspd
define lpad num,sto ; Little macro for tedious pad calcs
skipge a,num
move a,lpadtm
idiv a,lpfspd
addi a,1 ; NLS always does (#/f)+1
movem a,sto
termin
move c,lptypd ; Get idx into pad tables
move a,lpadl ; Compute
addi a,14.
lpad a,lpadl ; # pads for a scrolling LF.
lpad lpdtbd(c),lpadd ; Padding for Delete Line
lpad lpdtbi(c),lpadi ; padding for Insert Line
lpad lpdtbc(c),lpadc ; padding for Clear Screen & Reset
; Params all set, now zap LP state.
tyoesc 51 ; Reset LP
skipa a,lpadc
tyo 177
sojge a,.-1
tyoesc 60 ; Turn off coordinate mode!
tyoesc 40 ; And set a position to stop tracking!
tyo 40 ; X pos at 0
move a,svmax
tyo 40(a) ; Y pos at 0
call obfsnd ; Force stuff out.
popae p,[c,b,a]
return
; Read a "big coordinate"
lprbcd:
; call tyiget
call lpinwt
subi a,40
movei b,-40(a)
; call tyiget
call lpinwt
subi a,40
subi a,40
lsh b,6
addi a,(b)
return
tvar lpinwc
lpinwt: call tbin ; Pull in a char (or try to)
cail a,
return
aos a,lpinwc
caile a,20. ; tolerate 20 secs wait
jrst [ zout [asciz "
No response to INTERROGATE; you're no lineprocessor!
"]
call obfsnd
jrst logout]
sleep 10. ; Wait for a sec
jrst lpinwt
tvar lpfspd ; Pad factor "F" for this LP, as returned from interrogate
tvar lptype ; Type of LP, as ditto.
; 0= Complete alpha LP with copy printer receiver for cassette drive
; 2= LP with Mouse, Keyset, Printer
; 6= Graphics LP with Tektronix 4014
; 7= Graphics LP with Tektronix 4012
tvar lptypd ; Type of this LP's display, as ditto.
; 1= Delta Data 5200 (not supported any more)
; 2= Hazeltine H2000 (ditto)
; 3= Datamedia 2500
; 4= Lear Siegler ADM-2 (ditto)
; 5= Datamedia 4000
; 6= " " with scroll window capability
; Padding factor tables, indexed by LPTYPD. -1 means use DTIM.
; DD Hzl DM25 LS DM4 DM4
lpdtbc: 0 ? 5 ? 6 ? 1 ? 17. ? -1 ? -1 ; "Clr" - time to clear screen
lpdtbd: 0 ? 80. ? 7 ? 1 ? 17. ? -1 ? -1 ; "Del" - time to delete a line
lpdtbi: 0 ? 0 ? 7 ? 30. ? 17. ? 0 ? 0 ; "Ins" - time to insert a line
tvar lpadtm ; This is "DTIM" as returned by LP interrogate.
tvar lpadd ; # pads for line delete
tvar lpadi ; # pads for line insert
tvar lpadc ; # pads for screen clear
tvar lpadl ; # pads for a scrolling LF.
; Note that DM4000 type LP's can pass "big coordinates" where the usual
; form X+40 is replaced by 36, <high 6 bits>+40, <low 6 bits>+40.
; This is only necessary for coords > 135 octal.
; The following EP->LP commands allow big coords:
; Position, Pushbug(markit), Cline.
; And the following for LP->EP:
; Response to Interrogate, "Big chars".
; Also note that lineprocessor coords have Y inverted, i.e. 0,0 is lower left!
lpmv: tyoesc 40
caile nh,135
jrst [ tyo 36
movei d,(nh)
lsh d,-6
tyo 40(d)
movei d,(nh)
andi d,77
tyo 40(d)
jrst .+2]
tyo 40(nh) ; X is okay...
move d,svmax
subi d,(nv) ; but Y needs mapping.
caile d,135
jrst [ tyo 36
push p,d
lsh d,-6
tyo 40(d)
pop p,d
andi d,77
tyo 40(d)
return ]
tyo 40(d)
return
lpeol: push p,a
hrrz a,scrtab(v)+1 ; find address+1 of the last pos.
subi a,1
lpeol1: caige a,@scrtab(v) ; compare with currnt position
jrst lpeol9 ; win, all blank aready!
skipl t1,(a) ; check blank or not
cain t1,blchar
soja a,lpeol1
addi a,1
subi a,@scrtab(v) ; Find # blanks to write.
caile a,30. ; if over 30 blanks requied,
caie h,0 ; and on left margin, use del/ins!
jrst lpeol2
movei a,1
xct .tedlp+tb ; on left margin! simply delete current line
caml v,tvmax
jrst lpeol9 ; If no lines below, can return here.
movei a,1
xct .teilp+tb
jrst lpeol9
lpeol2: push p,nh
move nh,h ; save current pos
addi h,(a) ; update to new.
tyoesc 43
tyo 40(a)
push p,b
idiv a,lpfspd ; Divide N by pad factor
addi a,1
pop p,b
tyn 177 ; pad out as necessary.
call lpmv ; now move cursor back
movei h,(nh)
pop p,nh
lpeol9: pop p,a
return
; Insert Line Position
lpilp: pushae p,[a,b]
move b,a
lpil1: tyoesc 45
move a,lpadi ; get no. of pads to send
tyn 177
sojg b,lpil1
popae p,[b,a]
return
; Delete Line Position
lpdlp: pushae p,[a,b]
move b,a
lpdl1: tyoesc 44
move a,lpadd
tyn 177
sojg b,lpdl1
popae p,[b,a]
return
lpclr: setzb nh,nv ; Clear and home up.
lpclr0: push p,a
tyoesc 50 ; Clear screen
move a,lpadc
tyn 177
pop p,a
return
; LPTYI - input chars are checked thru this. Called at TYI
; interrupt level.
lptyi: push p,[lptyi]
call tyiget
caie a,176 ; If 176 seen, skip to handle.
pjrst tyipuc ; nope, return to output character
; Special LP interrupt. Called at TTYI interrupt level when 176 seen.
call tyiget
cain a,177 ; "system reset"?
return ; for now, simply ignore.
cain a,41 ; reporting error?
jrst lpspc3 ; must slurp up.
push p,a
movei a,176
call tyipuc ; none of above, pass on both 176 and following
pop p,a
pjrst tyipuc
lpspc3: call tyiget
caile a,40+20
movei a,40+20
push p,b
movni b,-40(a)
hrlzs b
call tyiget
movem a,lpertb(b)
aobjn b,.-2
pop p,b
return ; return when error all slurped.
tvar lpertb(20)
; NLS LP simulation routines!!
svar lprqrs ; -1 if input side requesting "reset" on finalize.
svar lpcmod ; -1 if in coordinate mode, send stuff escorted.
svar lpmtrk ; -1 if "mouse" being tracked.
svar lpmx ; "mouse" X pos
svar lpmy ; "mouse" Y pos
svar lptysx ; TTY simulate window X cursor pos (saved NH)
svar lptysy ; TTY simulate window Y cursor pos (saved NV)
svar lptybg ; # of 1st line in TTY simulate window.
svar lptyln ; # lines in TTY simulate window.
svar lpstki ; LP bug stack index
svar lpbstk(10) ; LP bug stack
comment |
FJW & SPK want the following definitions:
^H - Back Character
^A - Beginning of current real line
^E - End of current real line
^F - Forward Character
^N - Down real line (absolute vertical)
^P - Up real line (absolute vertical)
$< - Beginning of 20-line display (upper left)
$> - End of 20-line display (lower right)
$A - Back to beginning of this sentence (or next previous sentence)
$H - Back to beginning of this word (or next previous word)
$E - Forward to end of this sentence (or next sentence)
$F - Forward to beginning of next word
$[ - Back to beginning of this paragraph (or next previous
paragraph)
$] - Forward to beginning of next paragraph
( $ means <esc> or Meta- )
Character, word, sentence, paragraph, and ^U have the same meaning as
for EMACS.
|
; LPSMO - LP output-to-STY simulate co-routine
; Examine TTY input, and output to STY as appropriate.
lpsmo: call smoget ; Get character
push p,[lpsmo] ; Return to above for infinite loop.
skipn lpcmod ; In coordinate mode?
pjrst sbout ; Nope, just feed out normally.
; Coordinate mode, check for special local kbd commands.
lpsmoc: trne a,%txmta ; Meta-bit set?
jrst lpmeta ; Yes, go check for meta-command.
caige a,40 ; Coord mode! hacking a ctl?
jrst lpctl ; Yes, off to hack.
pjrst sbout ; Nope, output normally.
lpctl: call @lpctlv(a) ; process control char.
lpctlr:
IFE SINT,.err This code loses
IFN SINT,{
; Idea of this code is to "wake up" the SMI module so that
; it will finalize any alterations made to the cursor position.
IFN ITS,.suset [.siifpir,,[1_pyi]] ; After handling, ensure output kicked.
IFN TNX,{
movei a,.fhslf
push p,b
move b,[1_<35.-smichn>]
iic ; Trigger SMI interrupt.
pop p,b
} ; IFN TNX
} ; IFN SINT
return
lpctlv: repeat 40,sbout ; default is to simply output.
tmploc lpctlv+^U,{lpmrpt} ; ^U = repeat next char 4 times.
lpmrpt: push p,[4]
lpmrp1: call smoget
cain a,^U ; Another one?
jrst [ movei a,4
imulm a,(p)
jrst lpmrp1]
push p,a
lpmrp2: move a,(p)
call lpsmoc
sosle -1(p)
jrst lpmrp2
sub p,[2,,2]
return
tmploc lpctlv+033,{lpmesc} ; ESC -> set meta bit in next char.
; actually just dispatch as if set.
; Jump here if char is metized.
lpmesc: call smoget ; Jump here for ESC - get next, then handle.
lpmeta: andi a,177
cail a,"a
caile a,"z
caia
trz a,40
cain a,"F ; Forward word
jrst [ call lpmwf
jrst lpctlr]
cain a,"H ; Backward word
jrst [ call lpmwb
jrst lpctlr]
cain a,"< ; Move to beg of text area
jrst [
;move a,svmin
movei a,0
addi a,4
camle a,svmax
move a,svmax
movem a,lpmy
setzm lpmx
pjrst lpctlr]
cain a,"> ; Move to end of text area
jrst [ move a,svmax
movem a,lpmy
move a,shmax
movem a,lpmx
pjrst lpctlr]
cain a,"H ; Move back word
jrst [return]
cain a,"F ; Move forward word
jrst [return]
pjrst sbout ; Matched none, simply output it.
tmploc lpctlv+002,{lpcrdo} ; ^B (CMD RPT)
tmploc lpctlv+004,{lpcrdo} ; ^D (CA)
tmploc lpctlv+030,{lpcrdo} ; ^X (CMD DEL)
; LP Coord Output - "Escort" controls.
lpcrdo: push p,a
movei a,34
call sbout
movei a,43
call sbout
pop p,a
addi a,140 ; keyboard char.
call sbout
move a,lpmx
call lpsbcd
move a,svmax
sub a,lpmy ; Y coord is inverted for LP.
; Drop thru to "call" LPSBCD.
lpsbcd: caig a,135
jrst lpsbc7
push p,a
movei a,36 ; Big coord escape
call sbout
move a,(p)
lsh a,-6
addi a,40
call sbout
pop p,a
andi a,77
lpsbc7: addi a,40
pjrst sbout
tmploc lpctlv+^Q,{lpmqot} ; Quoter
lpmqot: call smoget ; Get next char
pjrst sbout ; and output no matter what.
tmploc lpctlv+^G,{lpmrst} ; ^G - reset
lpmrst: setom lprqrs ; Request reset.
return
tmploc lpctlv+^P,{lpmup} ; up
tmploc lpctlv+^N,{lpmdwn} ; down
tmploc lpctlv+^F,{lpmfwd} ; right
tmploc lpctlv+^H,{lpmbck} ; left
tmploc lpctlv+^A,{lpmlbg} ; beg of text on line
tmploc lpctlv+^E,{lpmle} ; end of text on line
; Search for rightmost text on line
lpmle: pushae p,[nh,nv]
move nh,shmax
move nv,lpmy
skipl a,@scrntb(nv)
cain a,blchar
sojg nh,.-2
movem nh,lpmx
popnvh: popae p,[nv,nh]
return
; Search for leftmost text on line
lpmlbg: pushae p,[nh,nv]
; move nh,shmin
movei nh,0
movem nh,lpmx
move nv,lpmy
camle nh,shmax ; Loop here
pjrst popnvh
skipl a,@scrntb(nv)
cain a,blchar
aoja nh,.-4
movem nh,lpmx
pjrst popnvh
lpmdwn: aos a,lpmy
camle a,svmax
sos lpmy
return
lpmup: sosge lpmy
aos lpmy
return
lpmfwd: aos a,lpmx
camle a,shmax
sos lpmx
return
lpmbck: sosge lpmx
aos lpmx
return
lpmbgl: setzm lpmx
return
lpmel: move a,shmax
movem a,lpmx
return
tmploc lpctlv+^S,{lpmsrf} ; search forward
tmploc lpctlv+^R,{lpmsrr} ; search backward
svar srchdr
svar srchch
lpmsrf: skipa a,[1]
lpmsrr: seto a,
movem a,srchdr
call smoget ; Get char to search for.
caie a,^S
cain a,^R
move a,srchch
movem a,srchch
pushae p,[nh,nv]
move nh,lpmx
move nv,lpmy
lpmsr3: call lpmsch ; Move forward or backward in screen image
jrst lpmsr6
came a,@scrntb(nv) ; Check for char
jrst lpmsr3 ; not found, try next.
movem nh,lpmx ; Found! Set mouse pos.
movem nv,lpmy
lpmsr6: popae p,[nv,nh]
return
lpmsch: cail nv,0
camle nv,svmax
return ; If go off either end, terminate search.
lpmsc4: add nh,srchdr ; Bump in appropriate direction
caige nh,0
jrst [ move nh,shmax ; Went off left edge, move to above line
soja nv,lpmsch]
camle nh,shmax
jrst [ setz nh, ; Went off right edge, move to lower line
aoja nv,lpmsch]
aos (p)
return
; Move over a word
lpmwf: skipa a,[1]
; Move back over a word
lpmwb: seto a,
movem a,srchdr
pushae p,[nh,nv]
move nh,lpmx
move nv,lpmy
lpmwm2: call lpmsch ; Get next position
jrst lpmwm8 ; If hit end, don't move mouse pos.
move a,@scrntb(nv) ; Get char that's there
call lpmwck ; Skip if char is a word-char.
jrst lpmwm2 ; Loop until find one.
lpmwm4: call lpmsch
jrst lpmwm7 ; If hit end here, finalize at current pos.
move a,@scrntb(nv)
call lpmwck
caia
jrst lpmwm4
movns srchdr ; Hit non-word char, stop and back up 1
call lpmsch
jfcl
lpmwm7: movem nh,lpmx
movem nv,lpmy
lpmwm8: popae p,[nv,nh]
return
lpmwck: cail a,"A
caile a,"Z
cail a,"a
caile a,"z
return ; not a word-char.
aos (p)
return
;;; This stuff handles NLS to LP protocol.
; Jump here on 1st time.
lpsmi: styinc a, ; Get char in A
push p,a
call lprset ; do LP reset stuff.
move a,shmax ; And put mouse in screen center.
lsh a,-1
movem a,lpmx
move a,svmax
lsh a,-1
movem a,lpmy
pop p,a
jrst lpsmix ; jump into real loop.
lpsmil: styinc a,
lpsmix: push p,[lpsmil] ; loop back.
caie a,
cain a,177
return ; Ignore padding before it does any damage.
cain a,33 ; ESC?
pjrst lpesc ; go handle protocol string.
skipn lpmtrk ; Mouse being tracked?
pjrst ordnry ; No, can simply output.
; Mouse being tracked, shit, must hack TTY simulation window.
move nh,lptysx ; Restore cursor pos.
move nv,lptysy
push p,a
move a,lptybg ; 1st line
movei b,0 ; 1st col
move c,lptyln
addi c,(a)
subi c,1 ; last line
move d,shmax ; last col
call td.win ; Set window
pop p,a
; Check for format effectors (not many)
cain a,^M
jrst [ movei nh,0 ? jrst lpstc1]
cain a,^J
jrst [ camge nv,wvmax
aoja nv,lpstc1
movei a,1
call td.su ; Scroll up
jrst lpstc1]
lpstco: call ordnry
lpstc1: movem nh,lptysx
movem nv,lptysy
setzb a,b
dmove c,smax
pjrst td.win
;;; ESC received, handle NLS-to-LP protocol string
lpesc: styinc a, ; Get following char
cail a,lpemin
caile a,lpemax ; Must be in 40-62 range
return ; if not, ignore totally.
pjrst @lpetb-lpemin(a)
lpemin==:40 ; Min esc code. Note indented entries are no-ops.
lpetb: lp.pos ; 40 - position cursor
lp.tys ; 41 - set TTY simulate window
lp.trk ; 42 - resume tracking
lp.wbl ; 43 - write blanks
lp.dlp ; 44 - delete line
lp.ilp ; 45 - insert line
lp.psh ; 46 - push bug
lp.pop ; 47 - pop bug
lp.clr ; 50 - clear screen
lp.rst ; 51 - reset
lp.ops ; 52 - printer string (dev, cnt+40, chars)
apopj ; 53 - open printer port (no args)
apopj ; 54 - close printer port (no args)
lp.qry ; 55 - interrogate
lp.son ; 56 - standout mode on
lp.sof ; 57 - standout mode off
lp.cof ; 60 - coordinate mode off
lp.con ; 61 - coordinate mode on
lp.crs ; 62 - cursor resolution (N+40)
lp.nps ; 63 - new copy printer string(cs2,cs2,dev,seq,cnt,chs)
lp.npo ; 64 - new copy printer open (dev, mode)
lp.scr ; 65 - scroll window
lpemax==:65
ifn <.-lpetb>-<1+lpemax-lpemin>, .err LPETB loses
lp.pos: call lprcrd ; Get X coord
push p,a
call lprcdy ; Get Y coord
movei nv,(a)
pop p,nh
setzm lpmtrk ; Stop mouse tracking.
return
lp.tys: call lprcrd ; Get Y for top line of window
sub a,svmax ; must invert.
movmm a,lptybg
call lprcdy ; Get Y for bottom line of window
sub a,lptybg ; Find # lines-1 in TTY simulate window.
movem a,lptysy ; Use that as initial Y coord.
addi a,1
movem a,lptyln ; Store # lines.
setzm lptysx
return
lprset: setzm lpcmod ; This entry point zaps coord mode also.
setzm lprqrs ; and flushes any pending reset request.
lp.rst: call td.clr ; clear screen
move a,svmax
movem a,lptyln ; Set TTY simulate window to full screen.
aos lptyln
movem a,lptysy ; and reset TTY simulate coords.
setzm lptysx
setom lpmtrk ; Resume tracking
setzm lpstki ; Reset bug selection stack.
return
lp.trk: setom lpmtrk ; Resume tracking mouse
return
lp.wbl: call lprcrd ; Get # blanks to write.
jumple a,apopj
push p,a ; Must save count.
lp.wb2: movei a,40
call ordnry
sosle (p)
jrst lp.wb2
pop p,a
return
lp.psh: call lprcrd ; Get X coord
push p,a ; save
call lprcdy ; then Y coord
pop p,b
hrli a,(b) ; Get <H>,,<V>
move b,lpstki
cail b,7
return ; Ignore if no more room on stack.
aos lpstki
movem a,lpbstk(b) ; Store coords
pushae p,[nh,nv]
hlrz b,a
movei a,(a)
call td.mov
call td.bow
movei a,"O
call ordnry
call td.rst
popae p,[nv,nh]
return
lp.pop: skipg lpstki
return
sos b,lpstki
move a,lpbstk(b)
pushae p,[nh,nv]
hlrz b,a
movei a,(a)
call td.mov
movei a,40
call ordnry
popae p,[nv,nh]
return
lp.dlp: movei a,1
pjrst td.dlp
lp.ilp: movei a,1
pjrst td.ilp
lp.clr: pjrst td.clr
lp.cof: setzm lpcmod ; Turn coordinate mode off
return
lp.con: setom lpcmod ; Turn coordinate mode on
return
lp.son: pjrst td.bow ; Turn standout mode on
lp.sof: pjrst td.rst ; Turn standout mode off
lp.qry: movei a,34
call sbout
movei a,46
call sbout
move a,shmax
call lpsbcd ; Send coord value
move a,svmax
call lpsbcd
movei a,<<2_4>+6>+40 ; type 2 (alpha LP), ter 6 (Dm4000)
call sbout ; (or 3 for Dm2500)
movei a,40
call sbout ; zero delay
movei a,32.+40 ; Pretend 300 baud for minimal pads
pjrst sbout
; Scroll window
lp.scr: call lprcrd ; Get leftX
push p,a
call lprcrd ; and rightX
camg a,(p) ; just make sure...
exch a,(p)
push p,a ; save horiz window coords.
call lprcdy ; Get topY
push p,a ; save
call lprcdy ; get botY
camg a,(p) ; make sure bottom coord greater.
exch a,(p)
push p,a ; Save vertical window coords
call lprcrd ; Get N
trne a,1_11. ; is 12th bit set? (12-bit 2's complement)
ior a,[-1,,770000] ; Yes, so "extend sign"...
skipn e,a ; Get out of way...
jrst [ popae p,[a,a,a,a]
return]
pop p,c ; Restore botY into wvmax
pop p,a ; restore topY into wvmin
pop p,d ; restore rightX into whmax
pop p,b ; restore leftX into whmin
pushae p,[wvmin,whmin,wvmax,whmax]
call td.win ; set window
move a,e ; restore arg
call td.scr ; Scroll whichever way.
popae p,[d,c,b,a] ; Restore previous window.
pjrst td.win
; Input a Y-coordinate.
lprcdy: call lprcrd ; Get value
sub a,svmax ; invert it.
movm a,a
return
; Input a coordinate value.
lprcrd: styinc a,
subi a,40
jumpge a,apopj
styinc a,
subi a,40
lsh a,6
push p,a
styinc a,
subi a,40
andi a,77
addm a,(p)
pop p,a
return
lp.crs: pjrst lprcrd
lp.npo: styinc a,
styinc a,
return
lp.nps: styinc a, ; checksum 2
styinc a, ; checksum 1
styinc a, ; device
styinc a, ; mode
; styinc a, ; Sequence # (drop thru to hack rest)
lp.ops: styinc a,
call lprcrd
jumple a,apopj
push p,a
lpops2: styinc a,
sosle (p)
jrst lpops2
pop p,a
return
; Finalize - resume tracking or whatever.
lpsmf: skipe lprqrs ; Requesting reset?
jrst [ call lprset ; Yes, do it
skipe lpcmod ; and if in coord mode,
jrst [ movei a,34 ; use ptcl to tell NLS to re-display.
call sbout
movei a,50
call sbout
jrst .+1]
movei a,176 ; Else not in coord mode, but simulate
call sbout ; LP lossage anyway!
movei a,177
call sbout
jrst .+1]
skipn lpmtrk ; Mouse supposed to be tracked?
pjrst lpsmf1 ; Nope, take normal finalize return.
; Shit, move cursor to where "mouse" is.
skipge nh,lpmx
setz nh,
camle nh,shmax
move nh,shmax
movem nh,lpmx ; canonicalize mouse position.
skipge nv,lpmy
setz nv,
camle nv,svmax
move nv,svmax
movem nv,lpmy
lpsmf1: call force
pjrst obfsnd
trmend
subttl Lunar - Moon's hacked terminal
trmbeg Lunar:,[LUNAR]
tp.vsz 24.
tp.hsz 80.
tm.up 1,tyn 32 ; ^Z
tm.dwn 1,tyn 12 ; ^J
tm.fwd 1,tyn 34 ; ^\
tm.bck 1,tyn ^H
;tm.cr 1,tyo ^M
tm.hom 1,tyo 2 ; ^B
tm.abs 3, call lunmov
te.eol tyo 27 ; ^W
tabend
lunmov: tyo ^L
movei d,(nh)
trc d,140
tyo (d)
movei d,(nv)
trc d,140
tyo (d)
return
trmend
subttl MB0 - Mini-Bee
trmbeg MB0:,[MB0]
tp.flg %fsmeol+%fspd
tp.vsz 25.
tp.hsz 80.
tr.ini zout [asciz "HJ"] ; clear screen
tr.cho ccho ; character display routine
tm.up 2,tynesc "A
tm.dwn 2,tynesc "B
tm.fwd 2,tynesc "C
tm.bck 1,tyn ^H
tm.tab 1,call mb0tab
tm.cr 1,tyo ^M
tm.hom 2,tyoesc "H
te.eol call mb0eol ; MB0 uses esc "K too, but zaps entire line.
te.eos tyoesc "J
te.su tyn ^J ; scroll up
tabend
mb0tab: push p,a
tyn ^I
move a,speed
caige a,480. ; if at 4800 baud or greater
pjrst popaj
tyo 177 ; Must pad tabs with 2 rubouts.
tyo 177
pjrst popaj
; MB0EOL - Simulated Clear-to-EOL for MB0
mb0eol: jumpn h,seol ; If not on edge, hack spaces.
tyoesc "K ; If on edge, can zap whole line.
return
trmend
subttl MB4 - Mini-Bee 4
trmbeg MB4:,[MB4]
tp.flg %fspd
tp.vsz 25.
tp.hsz 80.
tr.ini call mb4ini
tr.tyi undel ; just del/underscore exchange
tm.up 2,tynesc "A
tm.dwn 2,tynesc "B
tm.fwd 2,tynesc "C
tm.bck 1,tyn ^H
tm.tab 1,call mb4tab
tm.cr 1,tyo ^M
tm.hom 2,tyoesc "H
tm.abs 4,call mb4mv
te.eol tyoesc "K
te.eos tyoesc "J
te.su tyn ^J ; scroll up
tabend
mb4ini: zout [asciz "HJ"]
skipl jtab ; tabs?
call settab ; yes, set tab stops
pjrst undelw ; warn about _/DEL switch
mb4tab: push p,a
tyn ^I
move a,speed
caige a,480. ; if at 4800 baud or greater
pjrst popaj
tyo 177 ; Must pad tabs with 2 rubouts.
tyo 177
pjrst popaj
mb4mv: tyoesc "F
move d,nv
idivi d,10.
rot e,-4
lshc d,4
cain d,
movei d,1
tyo (d)
move d,nh
idivi d,10.
rot e,-4
lshc d,4
jumpe d,[tyo 1 ; MTY misfeature
tyo 10
skipn nv
tyoesc "A
return]
tyo (d)
skipn nv
tyoesc "A
return
trmend
subttl MIME - Microterm MIME
; Background follows ^Y
; Change intensity (toggle) ^N
; Clear foreground ^F
; Clear to end of line ^^
; Clear to end of frame (screen) ^_
; Clear to end of screen background ^C
; spaces
; Cursor down ^K
; Cursor right ^X
; Cursor up ^Z
; Delete line ^W
; Enter graphics mode ^O
; Exit graphics mode ESC
; Foreground follows ^S
; Home and clear ^L
; Home up ^]
; Insert line ^A
; Request cursor position ^E
; (this will return two chars that give the cursor position as if
; they were passed as Direct Cursor Addressing codes)
; Reverse line feed ^R
; Send line FS (ascii 28 decimal)
; Send screen ^B
; Tab to next unprotected field ^D
; Underline ^U
; (this will underline the character at the current
; cursor position)
trmbeg MIME:,[MIME]
tp.flg 0
tp.vsz 24. ; no. of lines displayable on the screen
tp.hsz 80. ; no. of characters per line
tr.ini call mimein ; reset various modes and clear screen
tr.tyi undel ; reverse _ and rubout
tr.cho ccho ; character display routine
tm.up 1,tyn ^Z ; move up n
tm.dwn 1,tyn ^K ; move down n
tm.fwd 1,tyn ^X ; move forward n
tm.bck 1,tyn ^H ; move back n (BS)
tm.cr 1,tyo ^M ; move to left margin (CR)
tm.hom 1,tyo ^] ; move to upper left corner (home)
tm.abs 3,call mimemv ; absolute move
te.eol tyo ^^ ; erase to end of line
te.eos tyo ^_ ; erase to end of screen
te.clr tyo ^L ; erase whole screen (and home)
te.su tyn ^J ; scroll the screen
te.sd tyn ^R ; reverse scroll
te.ilp tyn ^A ; insert line
te.dlp tyn ^W ; delete line
tabend
; initialize
mimein: tyo ^S ; foreground follows
tyo ^[ ; turn off graphics mode
call undlcw ; print warning about interchanged _ and rubout
return
; Absolute move.
mimemv: tyo ^T
tyo (nv)
tyo (nh)
return
trmend
subttl MTEC - Mini-Tec
comment |
Unused info:
ESC R READS THE CURSOR POSITION, returning two chars which are
the one's complement of the horizontal, then vertical, address.
"ENTER" (^B) hacks block mode transmit.
"PRINT KEY" and "CANCEL" (^R and ^X) also hack block xmit.
TAB = moves cursor to beg of next unprotected field.
SET TAB: ANY PROTECTED CHARACTER SETS THE TAB.
ESC P STARTS A PROTECTED AREA, AND ESC C ENDS IT.
ESC L locks kbd, ESC U releases.
|
trmbeg MTEC:,[MTEC,MINI-TEC]
tp.flg %fsmeol
tp.vsz 24.
tp.hsz 80.
tm.up 1,tyn 13 ; ^K
tm.dwn 1,tyn ^J
tm.fwd 1,tyn 37 ; ^_ (1F)
tm.bck 1,tyn ^H
tm.cr 1,tyo ^M
tm.hom 1,tyo 36 ; ^^
tm.abs 4,call mtcabs ; absolute move
te.eos tyo 14 ; ^L erase to end of screen
te.clr tyo 34 ; ^\ erase all
te.clr tyo 34 ; ^\ erase all
te.su tyn ^J ; scroll up
tabend
mtcabs: tyoesc "F
setcmi d,(nh) ; Coords are complemented!
andi d,177
tyo (d)
setcmi d,(nv)
andi d,177
tyo (d)
return
trmend
subttl MOD1 - Hazeltine "Modular One"
trmbeg MOD1:,[MOD1]
tp.flg %fsmeol
tp.vsz 24.
tp.hsz 80.
tm.up 2,tyn176 14 ; ^L
tm.dwn 2,tyn176 13 ; ^K
tm.fwd 1,tyn 20 ; ^P
tm.bck 1,tyn 10 ; ^H
tm.cr 1,tyo 15 ; ^M
tm.hom 2,tyo176 22 ; ^R
tm.abs 4,call mod1mv
te.eol call mod1el
te.clr tyo176 34 ; ^\ (mod1 is WEIRD...)
te.su tyn ^J
te.ilp tyn176 32 ; ^Z
te.ilp tyn176 23 ; ^S
tabend
; MOD1MV - absolute move for MOD1
mod1mv: tyo176 ^Q
cail nh,40
tyo (nh)
caige nh,40
tyo 140(nh)
tyo 140(nv)
return
; MOD1EL - Simulated Clear-to-EOL for MOD1
mod1el: jumpn h,seol ; If not on edge, hack spaces.
tyo176 ^S ; Else can win by deleting line
tyo176 ^Z ; and inserting blank line!
return
trmend
subttl O4000 - Ontel 4000
trmbeg O4000:,[O4000]
tp.flg 0
tp.vsz 20.
tp.hsz 79.
tm.abs 6,call o4kmv
tm.up 1,tyn ^^
tm.dwn 1,tyn ^\
tm.fwd 1,tyn ^]
tm.bck 1,tyn ^H
;tm.tab 1,tyn ^I ; for now don't use tabs
tm.hom 1,tyo ^_
te.clr tyo ^L
te.eol tyo174 "+
te.eos tyo174 ";
te.icp call o4kicp
te.dcp call o4kdcp
te.ilp call o4kilp
te.dlp call o4kdlp
tr.cho call o4kcho ; must intercept "|"
tabend
o4kcho: cain a,174 ; vertical bar?
movei a,"! ; for now, substitute excl. point.
pjrst scho
o4kmv: tyo174 "- ; start cursor move
movei d,(nv) ; Follow by vert pos.
idivi d,10. ; in BCD type format.
tyo "0(d)
tyo "0(e)
movei d,(nh)
idivi d,10.
tyo "0(d)
tyo "0(e)
return
o4kicp: tyn174 "5
tyn 40
tyn ^H
return
o4kdcp: tyn174 "6
return
o4kilp: tyn174 "7
return
o4kdlp: tyn174 "'
return
trmend
subttl O8030B - Omron 8030B
; Manual claims that padding is only required above 2400 baud, i.e.
; at 4800 and 9600, but gives no timings.
trmbeg O3B:,[O8030B]
tp.flg %fspd
tp.vsz 24.
tp.hsz 80.
tr.ini call o3bini
tr.cho ccho0 ; character display routine
tm.up 2,tynesc "C ; Not "A!
tm.dwn 1,tyn ^J ; Scrolls on bottom. Or use 2,tynesc "B
tm.fwd 2,tynesc "D
tm.bck 1,tyn ^H ; or 2,tynesc "E
;tm.tab 1,tyn ^I ; wait for tab setter.
tm.cr 1,tyo ^M ; only in CHAR mode
tm.hom 2,tyoesc "H
tm.abs 7,call o3bmov ; ESC "u yyy xx
te.eol tyoesc "L
te.eos tyoesc "M ; clears page (not to end of memory)
te.ilp tynesc "X
te.dlp tynesc "V
te.eim tyoesc "Y
te.lim tyoesc "Z
te.dcp tynesc "W
tabend
o3bini: zout [asciz /K000/] ; make sure on page 0.
xct .teeos+tb
tyoesc "1 ; Make sure in CHAR mode.
tyoesc ^I ; Clear all tab stops.
pjrst settab ; ESC "S sets tabstop at current position.
; Abs move is ESC "u followed by 3 digits of line # and 2 digits
; of column #. Must always be that many digits.
o3bmov: tyoesc "u ; Yes, lowercase "u".
movei d,(nv)
idivi d,10.
push p,e
idivi d,10.
tyo "0(d)
tyo "0(e)
pop p,e
tyo "0(e)
movei d,(nh)
idivi d,10.
tyo "0(d)
tyo "0(e)
return
trmend
subttl O8030A - Omron 8030A (not actually implemented)
ifn 0,[
Omron 8030A according to CEH is very much like 8025 except:
Doesn't handle multiple pages right (doesn't put you on page 0 to start)
Doesn't do the 'control character off' (<esc>{)
(yes there is a key for it, key layout for functions is:
XMIT CARRIER REMOTE HALF CLEAR CHAR CHAR WAIT
LOCAL FULL DELETE INSERT
PRINT BATCH PROT. NULL CLEAR CNTL UPPER BREAK
CHAR ON/OFF SUPRSS LINE CHAR CASE
OFF
A short summary of relevant 8030a escape sequences is:
<ESC>
with does
; Half Duplex
1 Set tab stop
2 Clear tab stop
@ Character Insert (1 char)
A Cursor UP
B Cursor DOWN
C Cursor RIGHT
D Cursor LEFT
E Lock Keyboard
F Unlock Keyboard
G Cursor Return (same as CR, useful in forms mode)
H Home cursor (top of screen not position 0,0 in memory)
I Tab (<esc>^I, ^I too, see forms mode)
J Clear screen
K Clear line
L Line insert
M Line Delete
N Upper case only
O Upper/Lower case
P Character Delete
Q Character insert mode (all printing characters inserted)
R Character insert mode OFF
S Scroll up
T Scroll down
U Next page
V Previous page
Z Quote mode on. Display graphics for ALL chars, ignores esc seqences
Can only be turned off from keyboard. Use forms mode instead.
j Send BREAK
k Synchronous/Asynchronous Communications Interface (SACA) control
m Clear block
n Clear to end of memory (from cursor)
v Set block terminataion character (for transmit)
w Set forms mode. Display graphics for all characters except escape
sequences, which are interpreted.
x Reset forms mode.
{ Control characters off. (don't display the nonformatting control chars)
| Read cursor address. (response is esc sequence to position cursor to the
current position, followed by a block termination character (default
block term char is EOT ()))
} Position cursor. Position is coded in four bytes, four bits per byte
with 64 optionally added. Line # first two bytes, Column number second
Upper left of first page is 0,0 (or }@@@@ )
~ Control characters on. Display graphics for all non-formatting control
characters. Formatting effectors are: BEL,BS,HT,LF,CR
]
subttl OMRON - Omron 8025
trmbeg OMRON:,[OMRON]
tp.flg %fspd
tp.vsz 24.
tp.hsz 80.
tr.ini call omrini
tr.tyi omrtyi
tr.cho ccho ; character display routine
tr.zns -lzt2,,zt2 ; AOBJN to zone table with NL test
tm.up 2,tynesc "A
tm.dwn 2,tynesc "B ; LF is NL!
tm.fwd 2,tynesc "C
tm.bck 1,tyn ^H
;tm.tab 1,tyn ^I
tm.nl 1,tyo ^J
tm.cr 1,tyo ^M
tm.hom 2,tyoesc "H
tm.abs 6,call omrabs
te.eol call omrnel ; maybe this needs padding also?
te.eos call omrnes ; standard, but needs delay.
te.icp call omricp
te.dcp tynesc "P
te.ilp call omrilp
te.dlp call omrdlp
tx.so tyoesc "d ; Standout - half inverse video
tx.sor tyoesc "4 ; normal video
tabend
; Initialization.
omrini:
IFN ITS,{
move a,speed ; if output speed is greater than 30 cps
caile a,30. ; then should diable %TOLID cause its too slow
jrst [ $call ttyvar,[#pyi,[sixbit/ttyopt/],#0,[tlz %tolid]]
.lose %lsfil
jrst .+1 ]
}
setzm padc ; set pad character to null
tyoesc "H ; home to get things synchronized
setzb h,v ; ...
xct .teeos+tb ; clear the screen
skipl jtab ; tabs?
call settab ; yes, set tab stops
move a,[ascnt |Warning: changed keys "TAB" = rubout, "CR" = line feed,
"NEW LINE" = return, "shift/_" = tab|]
pjrst stdwrn
; Input handler.
omrtyi: call tyiget
caie a,^J ;interchange cr and lf (nl) keys
cain a,^M
xori a,^J#^M
caie a,^I ;interchange del and tab keys
cain a,177
xori a,^I#177
call tyipuc
jrst omrtyi
; Absolute move.
omrabs: pushae p,[nh,nv]
tyoesc 175 ; Omron positioning
aos e,nv ; vertical first
lsh e,-4 ; high 4 bits first
tyo 100(e)
andi nv,17
tyo 100(nv)
aos e,nh ; then horizontal
lsh e,-4
tyo 100(e)
andi nh,17
tyo 100(nh)
popae p,[nv,nh]
return
; Clear to EOS.
omrnes: tyoesc "J ; Clear in standard fashion, but
pad [1.0]
return
; Clear to EOL.
omrnel: tyoesc "K ; Clear in standard fashion, but
pad [.0415] ; 1/25 second padding?
return
; Insert line.
omrilp: push p,a
omrill: tyoesc "L
call omrpad
sojg a,omrill
pop p,a
return
; Delete line.
omrdlp: push p,a
omrdll: tyoesc "M
call omrpad
sojg a,omrdll
pop p,a
return
omrpad: push p,a
move a,tvmax
sub a,v
fsc a,233 ; float
fdvr a,[10.0]
pad a
pop p,a
return
; Insert character.
omricp: zoutn [asciz "@ "]
add h,a
return
trmend
subttl OWL - Perkin-Elmer OWL-1200
trmbeg OWL:,[OWL]
tp.flg 0
tp.vsz 24.
tp.hsz 80.
tr.tyi undel ; exchange del, underscore
tr.ini call owlini ; set tabs and warn user
tr.zns -lzt3,,zt3 ; AOBJN to zone table with AX/AY test
tm.up 2,tynesc "A
tm.dwn 1,tyn ^J ; line feed faster than ESC B
tm.fwd 2,tynesc "C
tm.bck 1,tyn ^H
tm.tab 1,tyn ^I
tm.cr 1,tyo ^M
tm.hom 2,tyoesc "H
tm.ax 3,call owlah ; abs move in horizontal dir
tm.ay 3,call owlav ; abs move in vertical dir
tm.abs 6,call owlmv
te.eol tyoesc "I ; not ESC K !!
te.eos tyoesc "J
te.su tyn ^J ; scroll up
te.icp zoutn [asciz /N /] ; $N<char> inserts char - do BS after a blank.
te.dcp tynesc "O ; can't be the same as anyone else
te.ilp tynesc "L
te.dlp tynesc "M
tx.vbl call owlvbl ; visible bell
tabend
; Transparent mode displays all spaces as small NU's; doing this briefly
; is quite flashy.
owlvbl: tyo ^P ; ^P^B goes into transparent mode
tyo ^B
tyo ^P ; ^P^C exits debug mode.
tyo ^C
return
owlini: tyoesc "K ; home, clear screen and clear tabs
skipl jtab ; tabs?
call settab ; yes, set tab stops
skipge jwarn ; inhibit warnings?
return ; yes, just return
move a,[ascnt " Warning: interchanged Underscore and Delete keys.
Newline Enable key should be OFF (up)."]
pjrst stdwrn ; type message
owlmv: call owlah ; Absmove does horiz then drops thru for vert.
owlav: tyoesc "X ; is abs move in VERTICAL direction!
tyo 40(nv)
return
owlah: tyoesc "Y ; is abs move in HORIZONTAL direction!
tyo 40(nh)
return
trmend
subttl REMB - REM's 6502 Beehive
comment |
settab=^F (and clrtab=^V)
When printing last column, cursor moves to first column on next line,
except after printing last column of last line it first scrolls.
(Exception, tab that wraps around end-of-line lands on first column
of next line but never scrolls, thus ends up home if wrap around end
of screen. Crock!)
Linefeed from bottom line, even if caused by printing or ^P on last char
of last line, scrolls (see tab exception above).
To clear screen without affecting tab tops, home followed by erase-to-end-of-screen.
To clear screen and all tab stops and leave cursor home, clear=^T except
my 6502 intercepts it to protect against this disaster, so don't use it
except during startup when the user knows to get into PROM-TTY mode instead
of smart-RAM-TTY mode.
Extras: start-blink=^\ start-reversed-video=^] start-blink-reversed-video=^^
start-normal=^_ (all revert to normal at end of line, all require one
char position - i.e. each affects from next character thru last char on
line or thru next such char, whichever occurs first - note that these
characters, no matter how they got on the screen, have static effect
permanently until they get replaced or scroll off top of screen, effect
refresh circuity directly) purge-all-rev/blk=^[ (immediate effect, edit
screen to replace all of the above four by <space> characters, thus
removing any blink or reversed video immediately - doesn't consume char pos)
More extras, intercepted by 6502 to avoid disaster: enter-format-mode=^O
leave-format-mode=^N print=^U new-line=^H (prints faint-H and then does
cr and lf functions) null=^@ (intercepted by 6502 and converted into ^])
<rubout> is ignored (note, computer-->beehive ignores, but beehive-->computer
uses <rubout> as a delete character on most DEC systems, echoing ^H or
somesuch), characters <space> thru '176 print as normal characters
|
trmbeg REMB:,[REMB]
tp.flg %fsmeol
tp.vsz 20.
tp.hsz 79. ; actually 80 but has newline scroll lossage.
tm.up 1,tyn ^R
tm.dwn 1,tyn ^J
tm.fwd 1,tyn ^P
tm.bck 1,tyn ^H
tm.tab 1,tyn ^I ; REM has 6502 set tabs every 8
tm.cr 1,tyo ^M
tm.hom 1,tyo ^E
tm.abs 3,call rembmv ; same as dm2500
te.eos tyo ^K ; may need padding
te.clr tyo 005013 ; ^E, ^K = home then cleos.
te.su tyn ^J ; scroll up
tabend
rembmv: tyo ^L
movei d,(nh)
trc d,140
tyo (d)
movei d,(nv)
trc d,140
tyo (d)
return
trmend
subttl SB1 - Super-Bee
; Like a Super-Bee 2 but doesn't even have bugs fixed
trmbeg SB1:,[SB1]
tp.flg %fspd
tp.vsz 25.
tp.hsz 80.
tr.ini call sbinit
tr.tyi sb1in ; to hack losing Escapes
tr.cho ccho ; character display routine
tm.up 2,tynesc "A
tm.dwn 1,tyn ^J
tm.fwd 2,tynesc "C
tm.bck 1,tyn ^H
tm.tab 1,tyn ^I
tm.cr 1,tyo ^M
tm.hom 2,tyoesc "H
tm.abs 8.,call sbabs
te.eol tyoesc "K
te.eos tyoesc "J
te.ilp tynesc "L
te.dlp call sbdlp
tabend
; Input.
; Make the F1 key be Escape, F2 key be ^C
sb1in: push p,[sb1in]
call tyiget
caie a,33 ; Is char an escape?
pjrst tyiput ; No, pass on.
call tyiget ; Yes, get next!
cain a,"C ; <esc>C = space to correct for SPOW mode
jrst [ movei a,40
pjrst tyiput ]
cain a,"p ; <esc>p = Function key 1 is Escape
jrst [ movei a,33
pjrst tyiput ]
cain a,"q ; <esc>q = Function key 2 is control-C
jrst [ movei a,^C
pjrst tyiput ]
cain a,"r ; <esc>r = Function key 3
pjrst enter
push p,a
movei a,33
call tyiput ; anything else should go through as
pop p,a
pjrst tyiput ; both characters, ie. <esc><whatever>
trmend
subttl SB2 - Super-Bee
trmbeg SB2:,[SB2]
tp.flg %fspd
tp.vsz 25.
tp.hsz 80.
tr.ini call sbinit
tr.cho ccho ; character display routine
tm.up 2,tynesc "A
tm.dwn 1,tyn ^J
tm.fwd 2,tynesc "C
tm.bck 1,tyn ^H
tm.tab 1,tyn ^I
tm.cr 1,tyo ^M
tm.hom 2,tyoesc "H
tm.abs 8.,call sbabs
te.eol tyoesc "K
te.eos tyoesc "J
te.ilp tynesc "L
te.dlp call sbdlp
tabend
; Initialization.
sbinit: tyoesc "E ; clear screen and tabs
skipl jtab ; tabs?
pjrst settab ; yes, set tab stops
return
; Absolute move.
sbabs: tyoesc "F ; StupidBee positioning
move d,nh
idivi d,100.
tyo "0(d)
movei d,(e)
idivi d,10.
tyo "0(d)
tyo "0(e)
move d,nv
idivi d,100.
tyo "0(d)
movei d,(e)
idivi d,10.
tyo "0(d)
tyo "0(e)
return
; Delete line.
sbdlp: push p,a
sbdlp1: tyoesc "M
pad [.1]
sojg a,sbdlp1
pop p,a
return
trmend
subttl SOFT - Software terminal type
trmbeg SOFT:,[SOFT]
tr.smi swsmi ; Note standard STY input for simulate!
tr.smo swsmo
tr.smf swsmf
tp.flg 0
tp.vsz 0 ; no. of lines displayable on the screen
tp.hsz 0 ; no. of characters per line
tp.scr -1 ; scroll count
tr.ini tyo %tdclr ; initialization
tr.fin tyo %tdrst ; cleanup
tr.cho scho1 ; display character routine
tr.mov swmov ; cursor movement
te.del tyo %tddlf ; erase character position
te.eol tyo %tdeol ; erase to end of line
te.eos tyo %tdeof ; erase to end of screen
te.clr tyo %tdclr ; erase whole screen (and home)
te.su tyn %tdcrl ; scroll up
te.icp tyo %tdicp_9(a) ; insert n character positions
te.dcp tyo %tddcp_9(a) ; delete n character positions
te.ilp tyo %tdilp_9(a) ; insert n lines
te.dlp tyo %tddlp_9(a) ; delete n lines
tx.so tyo %tdbow ; enter standout mode
tx.sor tyo %tdrst ; exit standout mode
tx.bel tyo %tdbel ; ring bell
tabend
; Cursor movement routine.
swmov: push p,a ; save AC
cain nv,(v)
caie nh,1(h)
jrst swmov1
movei a,%tdfs
call @.trtyo+tb
aoja h,swmov2
swmov1: movei a,%tdmv0
call @.trtyo+tb
movei a,(nv)
call @.trtyo+tb
movei a,(nh)
call @.trtyo+tb
dmove vh,nvh
swmov2: pop p,a ; restore AC
return
trmend
subttl Sol-20
trmbeg SOL20:,[SOL20,SOL]
tp.flg %fsmeol+%fsail
tp.vsz 16.
tp.hsz 64.
tr.cho solcho
tr.zns -lsolzns,,solzns
tr.ini call solini
;tm.up 1,tyn ^W
tm.dwn 1,tyn ^J
;tm.fwd 1,tyn ^S
;tm.bck 1,tyn ^A
;tm.hom 1,tyo ^N
tm.ax 3,call solax
tm.ay 3,call solay
tm.abs 6,call solabs
;te.clr tyo ^K
te.eol call soleol
te.su tyn ^J
tabend
; SOLZNS - SOL20 zone table for movement optimizer.
solzns: ztest ; relative move
; zthom ; home and relative move
; ztcr ; CR and relative move
ztay ; absolute Y move and relative X move
; ztaycr ; absolute Y move, CR, and relative X move
ztax ; absolute X move and relative Y move
lsolzns==.-solzns
solini: move nh,whmin
move nv,wvmax
call solabs ; position on last line of screen
move h,nh
move a,sheight
tyn ^J ; clear screen by scrolling everything else
; away
move v,tvmax
return
solabs: call solay
solax: tyoesc ^A
tyo 100(nh)
return
solay: tyoesc ^B
tyo 100(nv)
return
soleol: tyo ^M ; CR!
move h,thmin
return
solcho: jumpe a,[return] ; can't display NUL
caml h,thmax ; last column?
jrst solch3 ; yes
movem a,@scrtab(v) ; store character in screen image
addi h,1
solch1: caie a,"_ ; underscore?
cain a,177 ; DEL?
jrst solch2 ; underscore or DEL, quote it
caie a,^M ; CR?
cain a,^J ; LF?
jrst solch2 ; CR or LF, quote it
cain a,33 ; ESC?
solch2: tyoesc ^E ; yes, quote it
pjrst @.trtyo+tb ; output character
solch3: caml v,tvmax ; last line too?
return ; yes, ignore character completely
movem a,@scrtab(v) ; store character in screen image
move h,thmin ; output character and
aoja v,solch1 ; reflect CRLF in actual cursor position
trmend
subttl TK4023 - Tektronix 4023
trmbeg TK4023:,[TK4023]
tp.flg %fsmeol
tp.vsz 24. ; no. of lines displayable on the screen
tp.hsz 80. ; no. of characters per line
tr.cho ccho
tm.dwn 1,tyn ^J ; move down n (LF)
tm.bck 1,tyn ^H ; move back n (BS)
tm.fwd 1,tyn ^I
tm.cr 1,tyo ^M ; move to left margin (CR)
tm.abs 3,call t23abs ; absolute move
te.clr tyoesc ^L ; erase whole screen (and home)
te.su tyn ^J ; scroll the screen once
tabend
; Various support routines called above.
t23abs: tyo ^\
tyo 40(nh)
tyo 40(nv)
return
trmend
subttl TK4025 - Tektronix 4025
trmbeg TK4025:,[TK4025]
define tzout *s*
zout [asciz "`s"]
termin
tp.flg %fsmeol ; default to smart CLEOL
tp.vsz 34.
tp.hsz 80.
tr.ini call tkinit
tr.cho ccho ; character display routine
tr.zns -ltkzt,,tkzt
tm.up [call tkupc] call tkup
tm.dwn [call tkdwnc] call tkdwn
tm.fwd [call tkfwdc] call tkfwd
tm.bck [call tkbckc] call tkbck
tm.tab 1,tyn ^I
tm.cr 1,tyo ^M
te.clr tzout "ERA;"
te.su tyn ^J ; scroll up
te.dlp call tkdlp
te.ilp call tkilp
te.dcp call tkdcp
te.icp call tkicp
tabend
; Tektronix 4025 zone table.
tkzt: ztest
ztcr
ltkzt==.-tkzt
; Initialization.
tkinit: tzout "MON 34 H K;"
tzout "ERA;"
skipl jtab ; tabs?
tzout "STO 9 17 25 33 41 49 57 65 73;" ; yes, set tab stops
return
; Calculate move forward cost.
tkfwdc: movei t1,6
cain a,1
movei t1,5
cail a,10.
movei t1,7
move a,t1
return
; Move forward.
tkfwd: tzout "RIG"
pjrst tknum
; Calculate move backward cost.
tkbckc: caig a,6
return
movei t1,6
cail a,10.
movei t1,7
move a,t1
return
; Move backward.
tkbck: caile a,6
jrst tkbck1
tyn ^H
return
tkbck1: tzout "LEF"
pjrst tknum
; Calculate move down cost.
tkdwnc: ;caig a,6 See tkdwn
; return
movei t1,6
cail a,10.
movei t1,7
move a,t1
return
; Move down.
tkdwn: ;caile a,6 LF sometimes doesn't work when following a
; CR. I can't isolate the cases. -CBF
jrst tkdwn1
tyn ^J
return
tkdwn1: tzout "DOW"
pjrst tknum
; Calculate move up cost.
tkupc: movei t1,5
cail a,10.
movei t1,6
move a,t1
return
; Move up.
tkup: tzout "UP"
pjrst tknum
; Insert lines.
tkilp: jumpe v,tkilp1 ; hack 1st line specially
tzout "UP;"
subi v,1
tzout "ILI"
call tknum
add v,a
return
; Insert line before 1st line.
tkilp1: tzout "ILI" ; insert line
call tknum
add v,a
push p,a
movei nv,1 ; update screen image
call scrilp ; ...
move nv,a
movei nh,0
move b,[-80.,,screen]
tkilp2: move a,(b)
call ordnry
aobjn b,tkilp2
setzb nh,nv
pop p,a
aos (p) ; skip return since screen image is updated
pjrst td.eol
; Delete lines.
tkdlp: tzout "DLI"
pjrst tknum
; Insert characters.
tkicp: tzout "ICH;"
tyn 40
tzout "LEF"
pjrst tknum
; Delete characters.
tkdcp: tzout "DCH"
pjrst tknum
; Tektronix 4025 decimal no. output for arguments.
tknum: caie a,1
call tyodec
tyo ";
return
subttl TK4027 - Tektronix 4027
trmtoo TK4027:,[TK4027]
define tzout *s*
zout [asciz "`s"]
termin
tp.flg %fsmeol+%fspd ; default to smart CLEOL
tp.vsz 34.
tp.hsz 80.
tr.ini call tk7ini
tr.cho ccho ; character display routine
tr.zns -ltkzt,,tkzt
tm.up [call tkupc] call tkup
tm.dwn [call tkdwnc] call tkdwn
tm.fwd [call tkfwdc] call tkfwd
tm.bck [call tkbckc] call tkbck
tm.tab 1,tyn ^I
tm.cr 1,tyo ^M
te.clr tzout "ERA;"
te.eol call tk7eol
te.su tyn ^J ; scroll up
te.dlp call tkdlp
te.ilp call tkilp
te.dcp call tkdcp
te.icp call tkicp
tabend
; Initialization.
tk7ini: tzout "MON 34 H K;"
tzout "ERA;"
skipl jtab ; tabs?
tzout "STO 9 17 25 33 41 49 57 65 73;" ; yes, set tab stops
tzout "LEA M1 138;" ; for CLEOL
return
; Erase to end of line.
tk7eol: caml v,tvmax
jrst tk7sml
tzout "EXP M1;"
addi v,1
move h,thmin
return
tk7sml: move t1,speed
caile t1,60.
jrst seol
movei a,80.
sub a,h
tzout "DCH"
pjrst tknum
trmend
subttl TLC - Problem Solver's Systems' TLC
trmbeg TLC1:,[TLC]
comment ~
10. A ^K (inverse-linefeed) at top line WILL DO a reverse scroll, HOWEVER:
if the ^K is done like this, a previous line that was scrolled off the top
WILL reappear, up to a total of 24 lines (i.e., the terminal has a two-
screen-full buffer. I suggest that the cursor be relocated to home before
the ^K is sent, and a erase-to-end-of-line follwed by the correct line
be sent after that. This will be easier to write and lead to no confusion
if you're not following me.
13. Ridiculousness: Control-Z is not transmitted by the terminal. It does
clear the screen locally. Incredible goof by the designers -- I wrote them
a tremendously nasty letter.
~
tp.flg 0
tp.vsz 24.
tp.hsz 80.
tm.up 1,tyn ^K
tm.dwn 1,tyn ^J
tm.fwd 1,tyn ^L
tm.bck 1,tyn ^H
tm.cr 1,tyo ^M
tm.hom 1,tyo ^^
tm.abs 4,call tlcabs
te.eol tyoesc "T
te.eos tyoesc "Y
te.clr tyo ^Z
te.su tyn ^J
te.sd tyn ^K
tabend
; Direct cursor positioning.
tlcabs: tyoesc "=
tyo 40(nv)
tyo 40(nh)
return
trmend
subttl T1061 - Teleray 1061
trmbeg T1061:,[T1061]
tp.flg %fspd
tp.vsz 24.
tp.hsz 80.
tr.ini call t61ini
tm.up 2,tynesc "A
tm.dwn 1,tyn ^J ; line feed faster than ESC B
tm.fwd 2,tynesc "C
tm.bck 1,tyn ^H
tm.tab 1,tyn ^I
tm.cr 1,tyo ^M
tm.hom 2,tyoesc "H
tm.abs 4,call vtabs
te.eol call t61eol ; ESC-K, but needs padding
te.eos call t61eos
te.clr call t61clr
te.su tyn ^J ; scroll up
te.icp tynesc "P
te.dcp tynesc "Q ; can't be the same as anyone else
te.ilp call t61ilp
te.dlp call t61dlp
tx.vbl call t61vbl
tabend
; Initialization.
t61ini: setzm padc
call t61clr ; clear screen
tyoesc "G ; clear all tab stops
push p,b
movei b,9. ; no. of tab stops to set
t61t1: zout [asciz " "] ; move to next multiple of 8
tyoesc "F ; and set a tabstop there
sojg b,t61t1
tyo ^M
pop p,b
return
; Clear screen.
t61clr: tyoesc "j
pad [.06] ; no. of seconds to pad
return
; Erase to end of line.
t61eol: tyoesc "K
push p,a
move a,thmax
sub a,h
addi a,1
fsc a,233
fmpr a,[.000054]
pad a
pop p,a
return
; Erase to end of screen.
t61eos: tyoesc "J
push p,a
move a,tvmax
sub a,v
addi a,1
fsc a,233
fmpr a,[.0025] ; no. of seconds to pad
pad a
pop p,a
return
; Insert line.
t61ilp: push p,a
t61il1: tyoesc "L
call t61idp
sojg a,t61il1
pop p,a
return
; Delete line.
t61dlp: push p,a
t61dl1: tyoesc "M
call t61idp
sojg a,t61dl1
pop p,a
return
; Insert/delete line padding.
t61idp: push p,a
move a,tvmax
sub a,v
addi a,1
fsc a,233
fmpr a,[.0025]
pad a
pop p,a
return
; Visible bell.
t61vbl: tyoesc "R ; enter mode select
tyo "O ; underline, inverse video, blink
tyo "G ; character to blink
tyoesc "R ; sequence to shut it off
tyo "@
return
trmend
subttl TEL3 - Delta Data Telterm 3
trmbeg TEL3:,[TEL3]
tp.flg 0
tp.vsz 27.
tp.hsz 80.
tr.cho ccho
tm.up 1,tyn ^Z
tm.dwn 1,tyn ^K
tm.fwd 1,tyn ^Y
tm.bck 1,tyn ^H
;tm.tab 1,tyn ^I ; only 5 tab stops
tm.cr 1,tyo ^M
tm.hom 1,tyo ^T
tm.abs 6,call telabs
te.eol tyo ^S
te.eos tyo ^P_9+^S ; hmm, may need to set EOM symbol
te.clr tyo ^P_9+^R
te.eim tyo ^P_9+^Y
te.lim tyo ^P_9+^X
te.dcp tyn ^P_9+^V
te.ilp tyn ^P_9+^M
te.dlp tyn ^P_9+^L
tx.so tyo ^_
tx.sor tyo ^^
tabend
; Direct cursor position.
telabs: pushae p,[a,b]
tyo ^P_9+^N
movei a,(nh)
call telhex
movei a,(nv)
call telhex
pad [.006]
popae p,[b,a]
return
telhex: idivi a,16.
movei a,"0(a)
caile a,"9
addi a,"A-<"9+1>
call @.trtyo+tb
movei a,"0(b)
caile a,"9
addi a,"A-<"9+1>
pjrst @.trtyo+tb
trmend
subttl TH3216 - DJBLOG's almost-Xitex.
Comment |
Cannot scroll.
|
trmbeg TH3216:,[TH3216]
tp.flg %fsmeol
tp.hsz 31.
tp.vsz 16.
tm.up 1,tyn ^K
tm.dwn 1,tyn ^J
tm.fwd 1,tyn ^I
tm.bck 1,tyn ^H
tm.cr 1,tyo ^M
tm.hom 1,tyo ^L
te.clr tyo ^D
te.eol tyo ^E
tabend
trmend
subttl TH6416 - NEAL's almost-XITEX
trmbeg TH6416:,[TH6416]
tp.flg %fsmeol
tp.hsz 63.
tp.vsz 16.
tm.up 1,tyn ^N
tm.dwn 1,tyn ^J
tm.fwd 1,tyn ^I
tm.bck 1,tyn ^H
tm.cr 1,tyo ^M
tm.hom 1,tyo ^K
te.clr tyo ^L
te.eol tyo ^O
tabend
trmend
subttl TUBE1.5 - Intertec Data's Intertube with 1.5x
comment |
The intertube has been put out with n different software
packages. This entry supports 1.5X.
|
trmbeg TUBE:,[TUBE1.7]
tp.flg 0
tp.vsz 25.
tp.hsz 80. ; comfortable size
tr.ini call tubini ; set some modes
tr.cho ccho ; Stupid losing 80th column
tr.zns -lzt3,,zt3
tm.up 1,tyn ^Z
tm.dwn 1,tyn ^J
tm.fwd 1,tyn ^F
tm.bck 1,tyn ^H
tm.tab 1,tyn ^I
tm.cr 1,tyo ^M
tm.hom 1,tyo ^A
tm.ax 2,call tubax
tm.ay 2,call tubay
tm.abs 4,call tubabs
te.eol tyoesc "K
te.clr tyo ^L
tx.so call tubso
tx.sor call tubsor
tabend
tubini: tyoesc "0
tyo "@
tyo ^L ; Clear screen after setting regular video
return
tubso: tyoesc "0
tyo "B
return ; Blink on
tubsor: tyoesc "0
tyo "@
return ; Blink off
tubabs: call tubay
tubax: tyo ^P
move c,nh
idivi c,10.
lsh c,4
ior c,d
tyo (c)
return ; Format is:upper 3 bits(7
; total)=field,lower=loc
tubay: tyo ^K
tyo (nv)
return
trmend
subttl ADS100 - ADDS Viewpoint
trmbeg Viewpoint:,[VIEWPOINT]
tp.vsz 24.
tp.hsz 80.
tr.cho CCHO ; terminal auto-crlf's in last column
tm.up 1,tyn ^Z
tm.dwn 1,tyn ^J
tm.fwd 1,tyn ^F
tm.bck 1,tyn ^H ; move back n (BS)
; "claims to have tab but I don't know what it does" -Macrak
;tm.tab 1,tyn ^I
tm.cr 1,tyo ^M
;tm.hom 1,tyo ^A with autoscroll enabled home is LOWER left corner!
;tm.ax 2,call a100ah no evidence the viewpoint has the X and Y only commands
;tm.ay 2,tyo _9+100(nv)
tm.abs 4,call vtabs
te.eol tyoesc "K
te.eos tyoesc "k
te.clr tyo ^L
te.su tyn ^J ; scroll the screen up
tabend
trmend
subttl VDM1 - Jerry Pournelle's terminal
trmbeg VDM1:,[VDM1]
tp.flg 0
tp.vsz 16.
tp.hsz 64.
tm.up 1,tyn ^K
tm.dwn 1,tyn ^J
tm.fwd 1,tyn ^L
tm.bck 1,tyn ^H
tm.cr 1,tyo ^M
tm.hom 1,tyo ^^
tm.abs 3,call vdabs
te.eol tyo ^\
te.eos tyo ^]
te.clr tyo ^_
te.su tyn ^J ; scroll up
tabend
; Absolute move.
vdabs: tyo 33
tyo 40(nh)
tyo 40(nv)
return
trmend
subttl Honeywell VIP7800
trmbeg vip780:,[VIP7800]
;Tab set is esc-p, tab clear is esc-[-g, but they don't seem to work.
;esc-e resets everything and clears the screen.
tp.hsz 80.
tp.vsz 24.
tr.cho ccho0 ; Wrap in last column and insert mode
tr.ini call v78ini
tm.up 2,tynesc "A
tm.dwn 1,tyn ^J
tm.fwd 2,tyoesc "C
tm.bck 1,tyn ^H
tm.abs 4,call v78mov
tm.tab 1,tyn ^I
te.eol tyoesc "K
te.eos tyoesc "J
te.su tyn ^J
te.eim zout [asciz "[I"] ; ]
te.lim zout [asciz "[J"] ; ]
te.dcp zoutn [asciz "[P"] ; ]
te.ilp zoutn [asciz "[L"] ; ]
te.dlp zoutn [asciz "[M"] ; ]
tabend
v78ini: tyoesc "e ; reset everything and clear the screen
push p,b
setzb nh,nv
movei b,9. ; set 9 tabs
v78tbs: addi nh,8. ; every 8 columns (zero based)
call v78mov ; position cursor at a mod 8 boundary
tyoesc "P ; set a tab stop
sojg b,v78tbs
pop p,b
move h,nh ; update position
move v,nv
return
v78mov: tyoesc "f ;binary absolute move selected by esc-f
tyo 40(nh) ;first 40+x sent,
tyo 40(nv) ;then 40+y
return
trmend
subttl VIS200 - Visual 200
trmbeg VIS200:,[VIS200]
tp.flg 0
tp.vsz 24.
tp.hsz 80.
tr.cho scho0
tm.up 2,tynesc "A
tm.dwn 1,tyn ^J ; line feed faster than ESC B
tm.fwd 2,tynesc "C
tm.bck 1,tyn ^H
tm.tab 1,tyn ^I
tm.cr 1,tyo ^M
tm.hom 2,tyoesc "H
tm.abs 4,call vtabs
te.eol tyoesc "x ; ESC K and ESC J don't clear background
te.eos tyoesc "y ; data...
te.clr tyoesc "v
te.sd tynesc "I
te.su tyn ^J
te.eim tyoesc "i ; can't be the same as anyone else
te.lim tyoesc "j ; ...
te.dcp tynesc "O ; ...
te.ilp tynesc "L
te.dlp tynesc "M
tabend
trmend
subttl VT05 - DEC VT-05
trmbeg VT05:,[VT05]
tp.flg %fspd
tp.vsz 20.
tp.hsz 72.
tr.ini call v5ini
tm.up [imul a,v5padn] zoutn v5up
tm.dwn [imul a,v5padn] zoutn v5dwn
tm.fwd 1,tyn ^X
tm.bck 1,tyn ^H
tm.tab 1,tyn ^I
tm.cr 1,tyo ^M
tm.hom [move a,v5padn] zout v5hom
tm.abs [move a,v5absn] call v5abs
te.eol zout v5eol
te.eos zout v5eos
te.su zout v5dwn
tabend
tvar v5padn ;length of padded strings, for multiplying by
tvar v5absn ;pads+3, for cost of abs addressing
tvar v5up(2) ;padded string to move up
tvar v5dwn(2) ; down
tvar v5hom(2) ; ...
tvar v5eol(2)
tvar v5eos(2)
v5ini: pushae p,[a,b]
move a,speed ;4 pads at 2400, 2 at 1200, 1 at 600, else 0
idivi a,60.
caile a,4
movei a,4
movei b,1(a) ;normal seq = 1 char + n pads
movem b,v5padn
movei b,3(a) ;abs seq = 3 chars + n pads
movem b,v5absn
move b,[.byte 7 ? 32 ? 177 ? 177 ? 177 ? 177] ;make padded strings
and b,v5msk(a)
movem b,v5up
move b,[.byte 7 ? 12 ? 177 ? 177 ? 177 ? 177]
and b,v5msk(a)
movem b,v5dwn
move b,[.byte 7 ? 35 ? 35 ? 35 ? 35 ? 35]
and b,v5msk(a)
movem b,v5hom
move b,[.byte 7 ? 36 ? 36 ? 36 ? 36 ? 36]
and b,v5msk(a)
movem b,v5eol
move b,[.byte 7 ? 37 ? 37 ? 37 ? 37 ? 37]
and b,v5msk(a)
movem b,v5eos
zout v5hom
zout v5eos
popae p,[b,a]
return
v5abs: tyo ^N
tyo 40(nv)
push p,a
move a,v5padn
subi a,1
tyn 0
pop p,a
tyo 40(nh)
return
v5msk: 774000000000 ;0 pads
777760000000 ;1
777777700000 ;2
777777777400 ;3
777777777776 ;4
trmend
subttl VT50 - DEC VT-50
trmbeg VT50:,[VT50]
tp.flg 0
tp.vsz 12. ; Tiny screen!
tp.hsz 80.
tr.ini zout [asciz "HJ"] ; clear screen
tm.up 2,tynesc "A ; I is move up with scrolling
tm.dwn 1,tyn ^J ; B is move down, no scroll
tm.fwd 2,tynesc "C
tm.bck 1,tyn ^H ; D is also move backward
tm.tab 1,tyn ^I
tm.cr 1,tyo ^M
tm.hom 2,tyoesc "H
te.eol tyoesc "K
te.eos tyoesc "J
te.su tyn ^J ; scroll up
tabend
trmend
subttl VT52 - DEC VT-52
trmbeg VT52:,[VT52]
%fgph==:%ff1 ; in graphics mode (VT52 only)
tr.smi vtsmi
tr.smo vtsmo
tr.smf vtsmf
tp.flg %fsail+%ffci
tp.vsz 24.
tp.hsz 80.
tr.ini call vtinit
tr.fin call vtfin
tr.tyi vttyi
tr.cho vtcho
tm.up 2,tynesc "A
tm.dwn 1,tyn ^J ; B is move down, no scroll
tm.fwd 2,tynesc "C
tm.bck 1,tyn ^H ; D is also move backward
tm.tab 1,tyn ^I
tm.cr 1,tyo ^M
tm.hom 2,tyoesc "H
tm.abs 4,call vtabs
te.eol tyoesc "K
te.eos tyoesc "J
te.su tyn ^J ; scroll up
te.sd tynesc "I ; scroll down
tabend
; Initialization.
vtinit: zout [asciz "HJG="] ; = puts into alternate keypad mode
trz f,%fgph ; G exited graphics mode
IFN ITS\NET,{
move a,[ascnt |Warning: Use UPARROW (on the keypad) for [CALL].|]
call stdwrn
}
return
; Termination. (careful if you modify, also used by MIME52 -cbf)
vtfin: trze f,%fgph ; in graphics mode?
tyoesc "G ; yes, leave it
return
; Terminal input co-routine.
vttyi: call tyiget ; get character
IFN ITS\NET,{
caige a,40 ; control character?
jrst vttyi2 ; yes
}
IFE ITS\NET,{
cain a,33
jrst vtesc
}
; JRST here to output character in A and repeat loop.
vttyi1: call bckych ; add any bucky bits
call tyiput ; hand character to output co-routine
jrst vttyi ; go process next character
IFN ITS\NET,{
; control character typed
vttyi2: cain a,33 ; escape?
jrst vtesc ; yes
caie a,^I ; TAB?
cain a,^M ; CR?
jrst vttyi1 ; TAB or CR, don't add %TXCTL
caie a,^J ; LF?
cain a,^H ; BS??
jrst vttyi1 ; LF or BS, don't add %TXCTL
iori a,%txctl+"@ ; convert to control character
jrst vttyi1
}
vtesc: call tyitog ; get next character with timeout
jumpl a,vtesc2 ; timed-out
cain a,"? ; ESC-? ?
jrst vtescq ; yes
; Check for ESC- P,Q,R
cail a,"P ; check for P,Q,R
caile a,"R
jrst vtesc1
xct vtitb1-"P(a) ; execute
jrst vttyi
; Check for ESC- A,B,C,D
vtesc1: cail a,"A ; Check for A,B,C,D
caile a,"D
jrst vtesc2
xct vtitb2-"A(a) ; execute
jrst vttyi
; Not a known ESC sequence, assume user typed it.
vtesc2: push p,a
movei a,33
call bckych
call tyiput
pop p,a
jumpl a,vttyi
jrst vttyi1 ; don't hack ESC-ESC as the second being an
; escape code.
; ESC-? seen...
vtescq: call tyitog ; get next character with timeout
jumpl a,vtesq1 ; timed-out
cain a,"M ; [ENTER]?
jrst [ call enter ; yes, goto CRTSTY command processor
jrst vttyi ]
cain a,"n ; "." on keypad?
jrst [ movei a,%TXMTA+"- ; . is META-[MINUS]
jrst vttyi1 ]
cail a,"p ; 0-9?
caile a,"y
jrst vtesq1
addi a,%txmta+"0-"p ; convert to meta-<digit>
jrst vttyi1
vtesq1: push p,a ; Not on alternate keypad, assume user typed.
movei a,33
call bckych
call tyiput
movei a,"?
call tyiput
pop p,a
jumpl a,vttyi
jrst vttyi1
; XCT table for ESC- P,Q,R (blank keys, VT50H and VT52).
vtitb1: tlo f,%imeta ; P - left (blue) blank = META
tlo f,%ictrl ; Q - center (red) blank = CONTROL
tlo f,%itop ; R - right (black) blank = TOP
; XCT table for ESC- A,B,C,D (arrow keys, VT50H and VT52).
vtitb2: jrst vti$A ; A - up arrow = [CALL]
tlz f,%imtc ; B - down arrow = cancel previous keys
jrst vti$C ; C - right arrow = [BREAK]
jrst vti$D ; D - left arrow = [BACK-NEXT]
vti$A: movei a,32 ; Up-arrow - ESC-A = CALL
jrst vttyi1 ; Allow M-[CALL] (defered call!)
vti$C: movei a,%TXTOP+"B ; [BREAK]
jrst vttyi1
vti$D: movei a,^_ ; [BACK-NEXT]
jrst vttyi1
; Output character in A.
vtcho: cail a,40 ; control character?
cain a,177 ; or rubout?
jrst vtcho1 ; yes, different hackery
trne f,%fgph ; not in graphics mode?
caige a,136 ; or character < 136?
jrst scho1 ; yes, go handle simply
tyoesc "G ; leave graphics mode
trz f,%fgph ; ...
jrst scho1 ; now output character
vtcho1: movem a,@scrtab(v) ; store character in screen image
tron f,%fgph ; in graphics mode?
tyoesc "F ; no, enter it
caie a,177 ; rubout?
skipn a,sailtb(a) ; no, get mapped character
movei a,163 ; no mapping, substitute a box
call @.trtyo+tb
camge h,thmax ; in last column?
addi h,1 ; no, advance one position
return
sailtb: 000 ;null
152 ;a
176 ;b
150 ;c
167 ;d
175 ;e
172 ;f
000 ;g
000 ;h
000 ;i
000 ;j
146 ;k
171 ;l
163 ;m
160 ;n
155 ;o
145 ;p
147 ;q
151 ;r
174 ;s
143 ;t
137 ;u
157 ;v
000 ;w
144 ;x
142 ;y
154 ;z
140 ;esc
171 ;less eq
141 ;great eq
161 ;equiv
170 ;down circum
;no trmend continue to MIME52,
subttl MIME52 - Microterm MIME emulating VT52
; Background follows ^Y
; Clear foreground ^F
; Clear to end of screen background ^C
; spaces
; Delete line ^W
; Foreground follows ^S
; Enter format mode ^X
; Exit format mode ^T
; Home and clear ^L
; Insert line ^A
; Request cursor position ^E
; (this will return two chars that give the cursor position as if
; they were passed as Direct Cursor Addressing codes)
; Send line FS (ascii 28 decimal)
; Send screen ^B
; Tab to next unprotected field ^D
; Underline ^U
; (this will underline the character at the current
; cursor position)
trmtoo MIME52:,[MIME52]
tp.flg %fsail
tp.vsz 24.
tp.hsz 80.
tr.ini call mimini
tr.fin call vtfin
tr.cho vtcho ; use VT52 hackey output..
tm.up 2,tynesc "A
tm.dwn 1,tyn ^J
tm.fwd 2,tynesc "C
tm.bck 1,tyn ^H
tm.tab 1,tyn ^I
tm.cr 1,tyo ^M
tm.hom 2,tyoesc "H
tm.abs 4,call vtabs
te.eol tyoesc "K
te.eos tyoesc "J
te.clr tyo ^L
te.su tyn ^J
te.sd tynesc "I
te.ilp tyn ^A
te.dlp tyn ^W
;tx.so can we figure out how to use the
;tx.sor underline feature?
tabend
mimini: tyo ^L ; clear screen
tyoesc "G ; take it out of grphics mode
trz f,%fgph ; indicate we are not in graphics mode
return
; no trmend, continue right to RPVT2,
subttl RPVT52 - special support for RP's VT52
trmtoo RPVT52:,[RPVT52]
tp.flg 0
tp.vsz 24.
tp.hsz 80.
tr.ini zout [asciz "HJ"] ; clear the screen
tr.tyi rptyi
tr.cho rpcho
tm.up 2,tynesc "A ; I is move up with scrolling
tm.dwn 2,tyn ^J ; B is move down, no scroll
tm.fwd 2,tynesc "C
tm.bck 1,tyn ^H ; D is also move backward
tm.cr 1,call rpcr
tm.hom 2,tyoesc "H
te.eol tyoesc "K
te.eos tyoesc "J
te.su tyn ^J ; scroll up
te.sd tynesc "I ; scroll down
tabend
; Carriage return.
rpcr: tyo ^M
pad [.07]
return
rptyi2: call tyipuc
rptyi: call tyiget
rptyi3: caie a,^S
pjrst rptyi2 ; Not ^S, just pass on.
tlo f,%ipcts
call tyiget ; Hmm, must inspect next.
tlz f,%ipcts
cain a,^Q ; Next char is ^Q?
jrst rptyi ; Yes, ignore ^S^Q sequence totally.
push p,a ; Oops, not ^S,
movei a,^S
call tyipuc ; must output it after all
pop p,a
pjrst rptyi3 ; followed by next char (but check it!)
; Output routine to implement / protocol.
rpcho: tlne f,%ipcts ; has a ^S been received?
IFN ITS, .hang ; If so, wait until TYI module clears.
IFN TNX, call tnxhng
pjrst scho ; then output normally.
subttl VT50H - DEC VT-50H
trmtoo VT50H:,[VT50H]
tp.flg 0
tp.vsz 12. ; very tiny screen!
tp.hsz 80.
tr.ini zout [asciz "HJ"] ; clear the screen
tm.up 2,tynesc "A ; I is move up with scrolling
tm.dwn 2,tyn ^J ; B is move down, no scroll
tm.fwd 2,tynesc "C
tm.bck 1,tyn ^H ; D is also move backward
tm.tab 1,tyn ^I
tm.cr 1,tyo ^M
tm.hom 2,tyoesc "H
tm.abs 4,call vtabs
te.eol tyoesc "K
te.eos tyoesc "J
te.su tyn ^J ; scroll up
tabend
; no TRMEND - next is TRMTOO
subttl SVT52 - Simulated VT52
trmtoo SVT52:,[SVT52]
tp.flg %fsail
tp.vsz 24.
tp.hsz 80.
tr.cho svtcho
tm.up 2,tynesc "A
tm.dwn 1,tyn ^J ; B is move down, no scroll
tm.fwd 2,tynesc "C
tm.bck 1,tyn ^H ; D is also move backward
tm.tab 1,tyn ^I
tm.cr 1,tyo ^M
tm.hom 2,tyoesc "H
tm.abs 4,call vtabs
te.eol tyoesc "K
te.eos tyoesc "J
te.su tyn ^J ; scroll up
te.sd tynesc "I ; scroll down
tabend
svtcho: movem a,@scrtab(v) ; store character in screen image
caige a,40 ; control character?
tyoesc "N ; yes, quote it
camge h,thmax ; in last column?
paoja h,@.trtyo+tb ; no, output character and advance one position
pjrst @.trtyo+tb ; output character, cursor stays put
trmend
subttl VT100 - DEC VT-100
trmbeg VT100:,[VT100]
; Put in 8/9/78 by Moon. Debugged 9/7/78 by EAK. Additions 9/18/81 by Gnu.
; Uses "ANSI" mode. Assumes you aren't using 132-column mode due to eyestrain.
; We should have a user JCL option for 132/80 column usage and smooth/non-
; smooth scrolling. Maybe figure out at what speed smooth scrolling won't
; lose and select it by default if slow enough (300 baud for example) cause
; it looks really neat.
; Correct "SETUP B" modes are:
; xxxx 0xx0 xxxx xxxx xxxx
; The important things here are Right Margin Bell disabled and ^Q/^S disabled.
; For some brain-damaged reason you can neither set nor read these (and a few
; other less-important things) from the remote line.
; Milliseconds
; FUNCTION VT100 VT132
;
;ED (Erase Display) 94 208
;Newline, Index, LF, Reverse Index - Smooth Scroll 200 200
;(NEL) , (IND), LF, (RI) - Jump Scroll 31 31
;DECCOLM (80/132 column mode select) 127 131
;DECALN (Screen Align - Fill screen with E's) 127 131
;IL (Insert Line) see Note 1 - 99
;DL (Delete Line) see Note 1 - 99
;EL (Erase Line) 2 11
;DCH (Delete Character) see Note 1 - 7
;DECINLM (Interlace mode select) 1 3
;All others except DECTST and RIS 1 1
; (Confidence Test), (Reset to initial state)
;Any other character: see Note 2 - 1
;
;Note 1: For IL, DL, and DCH the number of fill characters required is the
;number of parameters for that command multiplied by the fill count given
;above.
;
;Note 2: "At 19,200 baud, one fill character is required for every character
;transmitted to the terminal" - VT132 manual.
tp.flg %fspd+%fnicp+%fndcp
tp.vsz 24.
tp.hsz 80.
tr.ini call vt1ini
tr.cho scho0
tm.up 3,tynans "A
tm.dwn 1,tyn ^J
tm.fwd 3,tynans "C
tm.bck 1,tyn ^H
tm.tab 1,tyn ^I
tm.cr 1,tyo ^M
tm.nl 2,tyoesc "E
;tm.hom 3,tyoans "H
tm.hom 3,zout [asciz "[1;1H"] ;]
tm.abs [call vt1mvc] call vt1abs
te.win call vt1win
te.eol tyoans "K
te.eos call vt1eos
te.sd tynesc "M
te.su tyn ^J
te.eim zout [asciz "[4h"] ;]
te.lim zout [asciz "[4l"] ;]
te.dcp tynans "P
te.ilp call vt1ilp
te.dlp call vt1dlp
tx.vbl call vt1vbl
tx.so zout [asciz "[7m"] ;] ; Inverse video for Standout (Gnu 18Sep81)
tx.sor zout [asciz "[m"] ;]
tabend
; Initialization.
vt1ini: zout [asciz "<"] ; ANSI mode. This is ignored if already
; in ANSI mode.
; Don't change 80 column mode, auto-repeat on keyboard, interlace, graphics.
; ANSI modes:
zout [asciz "[20l"] ;] ; LF is Line Feed rather than New Line
; DEC modes:
; NO: zout [asciz "[?1h"] ;] ; Cursor keys should transmit codes
move t1,speed ; Smooth scrolling is ok at 30cps or less
caile t1,30.
zout [asciz "[?4l"];] ; Jump scrolling, it's faster
skiple jinvrs ; INVERSE specified?
zout [asciz "[?5h"];] ; yes, set reverse video mode
skipge jinvrs ; NO INVERSE specified?
zout [asciz "[?5l"];] ; yes, set normal video
zout [asciz "[?6h"] ;] ; Relative origin mode (relative to
; scroll region)
; Try without changing Auto-Wrap. This causes char typed in col 81 to
; go to the next line instead of overwriting column 80. CRTSTY should
; never try to type in column 81.
; NO: zout [asciz "[?7l"] ;] ; Autowrap off (I wonder what it is)
; NO: zout [asciz "="] ;] ; Numeric keypad should send escape codes
movei a,0 ; VT1SRG arg: minimum vertical
move b,svmax ; VT1SRG arg: maximum vertical
call vt1sr1 ; set scroll region to whole screen
zout [asciz "[1;1H"] ;]; home
tyoans "J ; clear screen
skipl jtab ; tabs?
zout [asciz "[3g H H H H H H H H H H H H H H
"] ;]
; Clear all tabs, set them 8 apart
return
; Set window. Need to worry about cursor motion. Need a manual.
vt1win: pushae p,[a,b,c,d]
movem a,tvmin
movem c,tvmax
.i theight=tvmax-tvmin+1
move b,c
call vt1srg
popae p,[d,c,b,a]
return
; Visible bell.
vt1vbl: skiple jinvrs ; INVERSE specified?
jrst vt1vbi
zout [asciz "[?5h"];] ; Assume non-inverse, go inverse.
pad [.1] ; wait a while
zout [asciz "[?5l"];] ; set normal video
return
; Visible bell with INVERSE reverses backwards (sort of)
vt1vbi: zout [asciz "[?5l"];] ; set normal video mode
pad [.1] ; wait a while
zout [asciz "[?5h"];] ; set reverse video mode
return
; Calculate absolute move cost.
vt1mvc: movei a,4 ; start with 4 for ESC-[-digit-H ;]
movei t1,(nv)
sub t1,tvmin
cail t1,10.-1 ; vertical position require two digits?
addi a,1 ; yes, make it 5
movei t1,(nh)
sub t1,thmin
jumpe t1,[return]
addi a,2 ; add 2 for semi-digit
cail t1,10.-1 ; horizontal position require two digits?
addi a,1 ; yes, account for that
return
; Absolute move.
vt1abs: tyoesc "[ ;]
movei a,1(nv) ; line number, 1-origin
sub a,tvmin
caie a,1 ; 1 is default
call tyodec
camn nh,thmin ; first line of scroll region?
jrst vt1mv1 ; yes, that's default, don't send
tyo ";
movei a,1(nh) ; column number, 1-origin
sub a,thmin
call tyodec
vt1mv1: tyo "H ; Lower-case f also works, but is a format
; effector instead of a cursor control.
; Nobody but ANSI X3.64 knows the difference.
; (OR CARES)
return
; Erase to end of screen
vt1eos: tyoans "J
move t1,speed ; punt padding for slow speed lusers
caile t1,120.
pad [.09]
return
vt1ilp: pushae p,[a,b] ; save ACs
move a,nv ; VT1SRG arg: line no.
move b,tvmax ; VT1SRG arg: line no.
call vt1srg ; set scroll region to rest of screen
call frcmov
move a,-1(p) ; restore delete count
tynesc "M ; scroll down
move b,speed ; get output speed
caile b,120. ; if speed is 120cps or less, it takes enough
; characters to send command so no need to pad.
jrst [ fsc a,233 ; float the numer of lines moved
fmpr a,[.031] ; 31 milliseconds a line
pad a
jrst .+1 ]
move a,tvmin ; VT1SRG arg: line no.
move b,tvmax ; VT1SRG arg: line no.
call vt1srg ; set scroll region back to whole window
popae p,[b,a] ; restore ACs
return
vt1dlp: pushae p,[a,b,nv] ; save ACs
move a,nv ; VT1SRG arg: line no.
move b,tvmax ; VT1SRG arg: line no.
call vt1srg ; set scroll region to rest of screen
move nv,tvmax
call frcmov ; move to NH,TVMAX
move a,-2(p) ; restore delete count
tyn ^J ; scroll up
move a,tvmin ; VT1SRG arg: line no.
move b,tvmax ; VT1SRG arg: line no.
call vt1srg ; set scroll region back to whole window
popae p,[nv,b,a] ; restore ACs
return
tvar vt1srb ; line scroll region begins on
tvar vt1sre ; line scroll region ends on
; Define scrolling region from here to bottom of screen.
vt1srg: camn a,vt1srb
came b,vt1sre
jrst vt1sr1
return
vt1sr1: movem a,vt1srb
movem b,vt1sre
tyoesc "[ ;]
movei a,1(a) ; TYODEC arg: no.
caie a,1 ; if first parameter is 1, omit it
call tyodec
camn b,svmax ; is second parameter = screen height?
jrst vt1sr3 ; yes, omit it
tyo ";
movei a,1(b) ; TYODEC arg: no.
call tyodec
vt1sr3: tyo "r
move v,vt1srb ; this homes (to top of region in relative
movei h,0 ; origin mode)
return
; no TRMEND next is a TRMTOO
subttl IBM Personal Computer
trmtoo IBMPC:,[IBMPC]
tp.vsz 24.
tp.hsz 80.
tr.ini call vt1ini
tr.cho scho0
tm.cr 1,tyo ^M
tm.nl 2,tyoesc "E
tm.hom 3,tyoans "H
tm.bck 1,tyn ^H
tm.abs [call vt1mvc] call vt1abs
tm.tab 1,tyn ^I
te.eol tyoans "K
te.eos call vt1eos
te.sd tynesc "M
te.su tyn ^J
te.eim zout [asciz "[4h"] ;]
te.lim zout [asciz "[4l"] ;]
te.dcp tynans "P
te.ilp tynans "L
te.dlp tynans "M
tabend
; no TRMEND next is a TRMTOO
subttl VT132 - DEC VT-132
trmtoo VT132:,[VT132]
; Put in by RLL on 3/30/80, cleaned up by CBF same night.
; Still need to put in hacking for character insert delete, have to
; get exact description of behavior from GMP.
tp.flg %fspd
tp.vsz 24.
tp.hsz 80.
tr.ini call vt3ini
tr.cho scho0 ; changed to VT3CHO if 960cps
tm.up 3,tynans "A
tm.dwn 1,tyn ^J
tm.fwd 3,tynans "C
tm.bck 1,tyn ^H
tm.tab 1,tyn ^I
tm.cr 1,tyo ^M
tm.nl 2,tyoesc "E
tm.hom 3,tyoans "H
tm.abs [call vt1mvc] call vt1abs ; changed to VT3ABS if 960cps
te.win call vt1win
te.eol call vt3eol
te.eos call vt3eos
te.sd call vt3sd
te.su call vt3su
te.eim zout [asciz "[4h"] ;]
te.lim zout [asciz "[4l"] ;]
te.dcp call vt3dcp
te.ilp call vt1ilp
te.dlp call vt1dlp
tx.vbl call vt1vbl
tx.so zout [asciz "[7m"] ;]
tx.sor zout [asciz "[0m"] ;]
tabend
vt3ini: move t1,speed
caige t1,960.
pjrst vt1ini
movei t1,vt3cho
movem t1,.trcho+tb
movei t1,vt3abs
hrrm t1,.tmabs+tb
.i vt3cc=1
pjrst vt1ini
vt3abs: call vt1abs ; this routine used only at 960cps
tyo 177
return
; If speed is 120 cps or less, we'll risk not padding enough on presumption
; the buffer will generally allow the terminal to catch up before triggering
; a nasty ^S, should it be enabled for some silly reason. We do this
; because it is important to use every possible bps of bandwidth for those
; poor losers on slow lines. We can win with this policy as long as we
; keep no more than 96 characters outstanding in the terminals buffer.
vt3su: tyn ^J
move t1,speed ; punt padding for slow speed lusers
caile t1,120.
jrst [ move t1,a ; numer of lines moved
fsc t1,233 ; float it
fmpr t1,[.031] ; 31 milliseconds per line moved
pad t1
jrst .+1]
return
vt3sd: tynesc "M
move t1,speed ; punt padding for slow speed lusers
caile t1,120.
jrst [ move t1,a ; numer of lines moved
fsc t1,233 ; float it
fmpr t1,[.031] ; 31 milliseconds per line moved
pad t1
jrst .+1]
return
; Erase to end of line
vt3eol: tyoans "K
move t1,speed ; punt padding for slow speed lusers
caile t1,120.
pad [.040]
return
; Erase to end of screen
vt3eos: tyoans "J
move t1,speed ; punt padding for slow speed lusers
caile t1,120.
pad [.208]
return
vt3dcp: tynans "P
move t1,speed ; punt padding for slow speed lusers
caile t1,120.
jrst [ move t1,a ; distance characters moved
fsc t1,233 ; float it
fmpr t1,[.007] ; 7 milliseconds per char moved
pad t1
jrst .+1]
return
tvar vt3cc ; number of characters until next pad
; This incredibly crufty terminal can't keep up with simple character output
; at 960cps, so we send a pad character ever few characters output.
vt3cho: sosle vt3cc
pjrst scho0
tyo 177
.i vt3cc=1
pjrst scho0
trmend
subttl XITEX - XITEX SCT-100
Comment |
HERE ARE THE FEATURES AND CAPABILITIES:
64 CHARCTERS PER LINE X 16 LINES
5 X 7 DOT-MATRIX, UPPER AND LOWER CASE WITH DESCENDERS
RS-232 (MODIFIED, XMIT AT TTL LEVELS) OR CURRENT LOOP (20/60 MA)
110 OR 300 BAUD, ASCII OR BAUDOT OPERATION, HALF/FULL DUPLEX
X-Y CURSOR ADDRESSING, (ABSOLUTE OR RELATIVE), ERASE TO END
OF LINE, ERASE TO END OF PAGE, SCROLL UP/DOWN, FULL CURSOR
CONTROL (UP, DOWN, LEFT, RIGHT) ETC. HERE ARE THE CONTROL CODES:
OCTAL HEX CNTL FUNCTION
------ --- ---- --------
004 04 D HOM HOME CURSOR TO UPPER LEFT OF SCREEN
005 05 E EOL ERASE END OF LINE - ERASES CURRENT LINE FROM
RIGHT MARGIN TO CURRENT POSITION (1600 MS MAX)
006 06 F EOS ERASE END OF SCREEN - ERASES LINES FROM BOTTOM
OF SCREEN TO, BUT NOT INCLUDING, CURRENT LINE
(400 MS MAX)
010 08 H BS BACK SPACE - MOVE CURSOR LEFT ONE COLUMN UNLESS
ALREADY IN LEFT MOST COLUMN
011 09 I HT HORIZONTAL TAB - MOVES CURSOR RIGHT ONE COLUMN
UNLESS ALREADY IN RIGHT MOST COLUMN
012 0A J LF LINE FEED - MOVES CURSOR DOWN ONE LINE, SCROLLS
SCREEN UP IF ALREADY ON BOTTOM LINE
013 0B K VT VERTICAL TAB - MOVES CURSOR UP ONE LINE,
SCROLLS DOWN IF ALREADY AT TOP LINE
014 0C L FF FORM FEED - CLEARS SCREEN AND HOMES CURSOR
(400 MS)
015 0D M CR CARRIAGE RETURN - MOVES CURSOR TO LEFT MARGIN
020 10 P DS DOWN SHIFT - SEQUENCE CAUSES CHARACTER FOLLOW-
ING DS TO BE INTERPRETED AS PRINTABLE RATHER
THAN CONTROL. REQUIRED FOR LOWER 32 SYMBOLS
(GREEK AND MATH), BUT MAY BE USED WITH ANY
CHARACTERS.
021 11 Q DC1 DEVICE CONTROL - SETS AUX BIT.
023 13 S DC3 DEVICE CONTROL - CLEARS AUX BIT.
033 1B CSK ESC DIRECT CURSOR ADDRESING - ESC + V H ADDS V
MODULO 16 TO VERTICAL CURSOR ADDRESS, ADDS H
MODULO 64 TO HOIZONTAL CUSOR ADDRESS
ESC = V H SETS VERTICAL CURSOR ADDRESS TO V
MODULO 16, SETS HORIZONTAL CURSOR ADDRESS TO H
MODULO 64.
(I.E. <ESC> + IS RELATIVE, <ESC> = ABSOLUTE)
177 7F DEL DELETE - MOVES CURSOR LEFT ONE COLUMN, UNLESS
CURSOR WAS ALREADY ON LEFTMOST COLUMN; ERASES
NEW POSTION. (E.G. BACKSPACE-SPACE-BACKSPACE
SIMULATED IN HARDWARE (FAST!))
|
trmbeg X100:,[XITEX]
tp.flg %fsmeol+%fspd+%fneol+%fneos
tp.hsz 64. ; Usual low resolution TV terminal
tp.vsz 16.
tr.ini call x1init
tm.up 1,tyn ^K ; will scroll down if at top
tm.dwn 1,tyn ^J ; will scroll up if on bottom
tm.fwd 1,tyn ^I ; weird
tm.bck 1,tyn ^H
tm.cr 1,tyo ^M
tm.hom 1,tyo ^D
tm.abs 4,call x1cabs
te.eol call x1ceol ; Needs padding
te.eos call x1ceos ; also needs padding
te.clr call x1cclr ; boy what a slow eraser.
te.su tyn ^J ; scroll up
te.sd tyn ^K
tabend
x1init: setzm padc ; rubout isn't a pad character!
pjrst x1cclr
x1cabs: tyoesc "= ; Abs positioning
tyo 100(nv) ; uses mod 16, so can stay out of cntls.
tyo 100(nh) ; Uses mod 64
return
x1ceos: tyo 06 ; ^F - erase lines below current one.
pad [.4] ; 400 msec
; finish off with CEOL
x1ceol: caml h,thmax ; in last column?
jrst [ tyo 40 ; Yes, fix screwage by just giving space;
return] ; apparently a bug causes CLEOL there to blow up.
tyo 05 ; ^E - erase to EOL
pad [1.6] ; with ridiculously long delay
return
x1cclr: tyo 14 ; ^L - clear and home.
pad [.4]
return
trmend
subttl End of terminal definitions, wrapup
nterms==%%ntrm+1 ; no. of terminals defined
IF2 { inform
radix 8+2
inform \nterms, terminals defined
radix 8
} ; IF2
SECTION MAINVAR
variables
IF2 {
radix 8+2
inform \., words of variables
radix 8
}
screen: block maxhor*maxver
sipg==:<screen+pg$siz-1>/pg$siz
ifl fipg*pg$siz-., .err MAINVAR section overflowed
ifl fivpg*pg$siz-init, .err INIT section overflowed
ifl fmpg*pg$siz-initvar, .err INITVAR section overflowed
lipg==:<init-1>/pg$siz ; last INIT page
livpg==:<initvar-1>/pg$siz ; last INITVAR page
lmpg==:<main-1>/pg$siz ; last MAIN page
IFN ITS, syspg==lmpg+1 ; for mapping in system
IFN HISTOHACK, HISTPG==:SYSPG ? SYSPG==SYSPG+1 ? COUNTS==HISTPG*PG$SIZ
IFE ITS, loc <lmpg+1>*pg$siz ; put symbols in right place
end crtsty