Add OCTPUS.

src/gren/octpus.21

@@ -0,0 +1,338 @@
+;-*-Midas-*-
+
+	Title @OCTOPUS
+
+A=5
+B=6
+C=7
+D=10
+T=12
+TT=13
+T3=14
+Char=15
+Uparro=16
+P=17
+
+Call=<PUSHJ P,>
+Return=<POPJ P,>
+
+TTYi==1
+TTYo==2
+
+PDLen==20
+
+Define SYSCAL op,args
+	.Call [Setz ? Sixbit /op/ ? args ((Setz))]
+Termin
+
+Define TYPE &string
+	Movei T,<.Length string>
+	Move TT,[440700,,[Ascii string]]
+	Syscal SIOT,[%Climm,,TTYo ? TT ? T]
+	  .Lose
+Termin
+
+PDList:	-PDLen,,.
+	Block PDLen
+
+Bases:	[12.,,ZerOut],,2
+	[4,,DecOut],,8.
+	[4,,DecOut],,10.
+	[3,,HexOut],,16.
+nBases=.-Bases
+
+HexChr:	"0 ? "1 ? "2 ? "3 ? "4
+	"5 ? "6 ? "7 ? "8 ? "9
+	"A ? "B ? "C ? "D ? "E ? "F
+
+Names:	[Asciz "NUL"],,[Asciz "Null"]
+	[Asciz "SOH"],,[Asciz "Start of Heading"]
+	[Asciz "STX"],,[Asciz "Sart of Text"]
+	[Asciz "ETX"],,[Asciz "End of Text"]
+	[Asciz "EOT"],,[Asciz "End of Transmission"]
+	[Asciz "ENQ"],,[Asciz "Enquiry"]
+	[Asciz "ACK"],,[Asciz "Acknowledge"]
+	[Asciz "BEL"],,[Asciz "Bell"]
+	[Asciz "BS "],,[Asciz "Backspace"]
+	[Asciz "HT "],,[Asciz "Horizontal Tab"]
+	[Asciz "LF "],,[Asciz "Line Feed"]
+	[Asciz "VT "],,[Asciz "Vertical Tab"]
+	[Asciz "FF "],,[Asciz "Form Feed"]
+	[Asciz "CR "],,[Asciz "Carriage Return"]
+	[Asciz "SO "],,[Asciz "Shift Out"]
+	[Asciz "SI "],,[Asciz "Shift In"]
+	[Asciz "DLE"],,[Asciz "Data Link Escape"]
+	[Asciz "DC1"],,[Asciz "Device Control 1"]
+	[Asciz "DC2"],,[Asciz "Device Control 2"]
+	[Asciz "DC3"],,[Asciz "Device Control 3"]
+	[Asciz "DC4"],,[Asciz "Device Control 4"]
+	[Asciz "NAK"],,[Asciz "Negative Acknowledge"]
+	[Asciz "SYN"],,[Asciz "Synchronous Idle"]
+	[Asciz "ETB"],,[Asciz "End of Trans"]
+	[Asciz "CAN"],,[Asciz "Cancel"]
+	[Asciz "EM "],,[Asciz "End of Medium"]
+	[Asciz "SUB"],,[Asciz "Substitute"]
+	[Asciz "ESC"],,[Asciz "Escape"]
+	[Asciz "FS "],,[Asciz "File Separator"]
+	[Asciz "GS "],,[Asciz "Group Separator"]
+	[Asciz "RS "],,[Asciz "Record Separator"]
+	[Asciz "US "],,[Asciz "Unit Separator"]
+	0,,[Asciz "Space"]
+	0,,[Asciz "Exclamation Point"]
+	0,,[Asciz "Quotation Mark"]
+	0,,[Asciz "Number/Pound/Sharp Sign"]
+	0,,[Asciz "Dollar Sign"]
+	0,,[Asciz "Percent Sign"]
+	0,,[Asciz "Ampersand"]
+	0,,[Asciz "Apostrophe"]
+	0,,[Asciz "Open Parenthesis"]
+	0,,[Asciz "Close Parenthesis"]
+	0,,[Asciz "Asterisk"]
+	0,,[Asciz "Plus Sign"]
+	0,,[Asciz "Comma"]
+	0,,[Asciz "Hyphen/Minus Sign"]
+	0,,[Asciz "Period"]
+	0,,[Asciz "Slash"]
+	0,,[Asciz "Zero"]
+	0,,[Asciz "One"]
+	0,,[Asciz "Two"]
+	0,,[Asciz "Three"]
+	0,,[Asciz "Four"]
+	0,,[Asciz "Five"]
+	0,,[Asciz "Six"]
+	0,,[Asciz "Seven"]
+	0,,[Asciz "Eight"]
+	0,,[Asciz "Nine"]
+	0,,[Asciz "Colon"]
+	0,,[Asciz "Semicolon"]
+	0,,[Asciz "Less-Than Sign"]
+	0,,[Asciz "Equal Sign"]
+	0,,[Asciz "Greater-Than Sign"]
+	0,,[Asciz "Question Mark"]
+	0,,[Asciz "At Sign"]
+	0,,[Asciz "Uppercase A"]
+	0,,[Asciz "Uppercase B"]
+	0,,[Asciz "Uppercase C"]
+	0,,[Asciz "Uppercase D"]
+	0,,[Asciz "Uppercase E"]
+	0,,[Asciz "Uppercase F"]
+	0,,[Asciz "Uppercase G"]
+	0,,[Asciz "Uppercase H"]
+	0,,[Asciz "Uppercase I"]
+	0,,[Asciz "Uppercase J"]
+	0,,[Asciz "Uppercase K"]
+	0,,[Asciz "Uppercase L"]
+	0,,[Asciz "Uppercase M"]
+	0,,[Asciz "Uppercase N"]
+	0,,[Asciz "Uppercase O"]
+	0,,[Asciz "Uppercase P"]
+	0,,[Asciz "Uppercase Q"]
+	0,,[Asciz "Uppercase R"]
+	0,,[Asciz "Uppercase S"]
+	0,,[Asciz "Uppercase T"]
+	0,,[Asciz "Uppercase U"]
+	0,,[Asciz "Uppercase V"]
+	0,,[Asciz "Uppercase W"]
+	0,,[Asciz "Uppercase X"]
+	0,,[Asciz "Uppercase Y"]
+	0,,[Asciz "Uppercase Z"]
+	0,,[Asciz "Open Bracket"]
+	0,,[Asciz "Back-Slash"]
+	0,,[Asciz "Close Bracket"]
+	0,,[Asciz "Uparrow/Caret"]
+	0,,[Asciz "Underscore"]
+	0,,[Asciz "Back-Quote"]
+	0,,[Asciz "Lowercase A"]
+	0,,[Asciz "Lowercase B"]
+	0,,[Asciz "Lowercase C"]
+	0,,[Asciz "Lowercase D"]
+	0,,[Asciz "Lowercase E"]
+	0,,[Asciz "Lowercase F"]
+	0,,[Asciz "Lowercase G"]
+	0,,[Asciz "Lowercase H"]
+	0,,[Asciz "Lowercase I"]
+	0,,[Asciz "Lowercase J"]
+	0,,[Asciz "Lowercase K"]
+	0,,[Asciz "Lowercase L"]
+	0,,[Asciz "Lowercase M"]
+	0,,[Asciz "Lowercase N"]
+	0,,[Asciz "Lowercase O"]
+	0,,[Asciz "Lowercase P"]
+	0,,[Asciz "Lowercase Q"]
+	0,,[Asciz "Lowercase R"]
+	0,,[Asciz "Lowercase S"]
+	0,,[Asciz "Lowercase T"]
+	0,,[Asciz "Lowercase U"]
+	0,,[Asciz "Lowercase V"]
+	0,,[Asciz "Lowercase W"]
+	0,,[Asciz "Lowercase X"]
+	0,,[Asciz "Lowercase Y"]
+	0,,[Asciz "Lowercase Z"]
+	0,,[Asciz "Left Brace"]
+	0,,[Asciz "Vertical Bar"]
+	0,,[Asciz "Right Brace"]
+	0,,[Asciz "Tilde"]
+	[Asciz "DEL"],,[Asciz "Rubout/Delete"]
+
+%TXSFL==2000			;Why isn't this defined?
+
+BitTab:	%TXTOP,,[Asciz "Top-"]
+	2000,,[Asciz "Hyper-"]
+	1000,,[Asciz "Super-"]
+;	%TXSFL,,[Asciz "Shiftlock-"]
+;	%TXSFT,,[Asciz "Shift-"]
+	%TXMTA,,[Asciz "Meta-"]
+	%TXCTL,,[Asciz "Control-"]
+nBits==.-BitTab
+
+Begin:	Move P,PDList
+	Syscal OPEN,[%CLBIT,,.uao
+		     %CLIMM,,TTYo
+		     [Sixbit "TTY"]]
+	  .Lose %LSFIL
+	Syscal OPEN,[%CLBIT,,.uai\%TIFUL
+		     %CLIMM,,TTYi
+		     [Sixbit "TTY"]]
+	  .Lose %LSFIL
+	Syscal TTYGET,[%CLIMM,,TTYo
+		       Repeat 2,%CLOUT,,T
+		       %CLOUT,,TT]
+	  .Lose %LSSYS
+	Tlo TT,%TSSII		;Super-image input.
+	Move T,[020202,,020202]
+	Syscal TTYSET,[%Climm,,TTYo ? T ? T ? TT]	;Turn off echo.
+	  .Lose %LSSYS
+	Syscal CNSGET,[%Climm,,TTyo
+			Repeat 4,%CLOUT,,T
+			%CLOUT,,TT]
+	  .Lose %LSSYS
+	Movei Uparro,^K		;assume sail graphics
+	Tln TT,%TOSAI
+	  Movei Uparro,"^	;"
+	
+	Type "Type the characters, ^Z to exit.
+   Binary     Oct  Dec Hex Abr Ch Full name.
+"
+
+Loop:	.IOT TTYi,Char
+	Move C,Char
+	Andi C,%TXASC		;Kill high bits, leave only ASCII part
+
+	Movsi A,-nBases
+Loop1:	Move T,Char
+	Hrrz B,Bases(A)		;Base
+	Hlrz TT,Bases(A)		;field-width or 0 for no leading 0's
+	Hlrz D,(TT)		;Field width?
+	Hrrz TT,(TT)		;typeout routine
+	Call (TT)
+	.IOT TTYo,[40]
+	Aobjn A,Loop1
+
+	Hlrz T,Names(C)
+	Jumpn T,[Call AType
+		 Jrst Loop2]
+	.IOT TTYo,[40]
+	.IOT TTYo,C
+	.IOT TTYo,[40]
+Loop2:	.IOT TTYo,[40]
+	Cain C,177
+	  Jrst Karf
+	Caige C,40
+	  Jrst [.Iot TTYO,["^]
+		Movei 1,-100(C)
+		.IOT TTYo,1
+		Jrst Loop3]
+	.IOT TTYo,[40]
+Karf:	.IOT TTYo,C
+Loop3:	.IOT TTYO,[40]
+
+Loop4:	Movsi A,-nBits
+Loop5:	Hlrz T,BitTab(A)
+	Tdne Char,T
+	  Jrst [Hrrz T,BitTab(A)
+		Call AType
+		Jrst .+1]
+	Aobjn A,Loop5
+	Caige C,40
+	  Jrst [.IOT TTYo,Uparro
+		Movei TT,(C)+"@	;"balance them quotes!
+		.IOT TTYo,TT
+		Type " ("	;"make Emacs happy)"
+		Jrst .+1]	
+	Hrrz T,Names(C)
+	Call AType
+	Caige C,40		;[("more gross ways to make emacs happy]
+	  .IOT TTYo,[")]
+	Type "
+"
+	Caie C,^Z
+	  Jrst Loop
+	Type "Want to quit? (Y/N) "
+Quitp:	.Iot TTYi,1
+	Andi 1,%TXASC
+	Cail 1,"a
+	  Trz 1,40
+	Cain 1,"Y
+	  .Logout 1,
+	Caie 1,"N
+	  Jrst [.Iot TTYo,[^G]
+		Jrst Quitp]
+	Type "Naw...
+"
+	Jrst Loop
+
+AType:	Hrli T,440700
+AType0:	Ildb TT,T
+	Skipn TT
+	  Return
+	.IOT TTYo,TT
+	Jrst AType0
+
+DecOut:	Setz T3,
+DecOu0:	IDiv T,B
+	Push P,TT
+	Aoj T3,
+	Jumpn T,DecOu0
+	Caml T3,D
+	  Jrst DecOu1
+	Move T,D
+	Sub T,T3
+	.IOT TTYo,[40]
+	Sojg T,.-1
+DecOu1:	Pop P,T
+	Addi T,"0
+	.IOT TTYo,T
+	Sojg T3,DecOu1
+	Return
+
+ZerOut:	Move T3,D
+ZerOu0:	IDiv T,B
+	Push P,TT
+	Sojg T3,ZerOu0
+	Move T3,D
+ZerOu1:	Pop P,TT
+	Addi TT,"0
+	.IOT TTYo,TT
+	Sojg T3,ZerOu1
+	Return
+
+HexOut:	Setz T3,
+HexOu0:	IDivi T,16.
+	Push P,TT
+	Aoj T3,
+	Jumpn T,HexOu0
+	Caml T3,D
+	  Jrst HexOu1
+	Move T,D
+	Sub T,T3
+	.IOT TTYo,[40]
+	Sojg T,.-1
+HexOu1:	Pop P,T
+	Move T,HexChr(T)
+	.IOT TTYo,T
+	Sojg T3,HexOu1
+	Return
+
+Constants
+Variables
+	End Begin