PDP-10 Archive: utilities/klh-macros.mid from SRI_NIC_PERM_SRC_3

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_3_19910112 - utilities/klh-macros.mid

There are no other files named klh-macros.mid in the archive.

IF2 .INEOF		; Never read on 2nd pass, nothing to re-define.
IF1 IFDEF %%%MAC .INEOF	;This checks for file already .INSRT'd.
%%%MAC==1		;aha, first!  Prevent other .INSRT's from winning.
;----------------------------------------------------------------------------

; Determine what OS to assemble for.  To force a particular OS,
; simply set OS%==SIXBIT/foo/ where foo is one of
;	ITS,CMU,SAIL,DEC,TENEX,TWENEX	mutually exclusive.
;	T10		equivalent to DEC
;	T20,20X		equivalent to TWENEX
;	10X		equivalent to TENEX
;	TNX		indicates either 10X or 20X, macro determines which.
; The following symbols are defined by this section:
;	Flag		Set if assembling for:
;	OS%ITS		ITS system (AI,ML,MC,DM)
;	OS%CMU		CMU system
;	OS%SAI		SAIL system
;	OS%T10		a vanilla Tops-10 system (neither SAIL nor CMU)
;	OS%DEC		set for all of the above 3 Tops-10 based systems.
;	OS%10X		BBN TENEX
;	OS%20X		DEC Tops-20 (TWENEX)
;	OS%TNX		set for both of the above 2 (10X or 20X).

ifndef os%,os%==.osmidas
%%t==0
irp pair,,[[ITS,its],[DEC,t10],[CMU,cmu],[SAIL,sail],[TENEX,10X],[TNX,tnx],[10X,10x],[20X,20x],[TWENEX,20x]]
  irp sys,flg,[pair]
  ife os%-sixbit/sys/, os%!flg==1
  .else ifndef os%!flg, os%!flg==0
  %%t==%%t+os%!flg
  .istop
  termin
termin
ife %%t,.err Can't determine OS to assemble for!
expunge %%t

	; Fixups...
ifn os%tnx,[		; If TNX of some kind, find exact variety.
ife .osmidas-sixbit/tenex/, os%10x==1
.else os%20x==1
]
os%tnx==os%10x+os%20x	; TNX on if either 10X or 20X.
os%t20==os%20x		; T20 synonym for 20X.
os%dec==os%t10\os%cmu\os%sai	; DEC means a T10-like sys.
;------------------------------------------------------------------

	; Default no-op'ing of purification macros if they're
	; not already defined to do something.
IFNDEF BVAR,[
DEFINE BVAR		; Make BVAR, EVAR, and LVAR all do nothing.
TERMIN
EQUALS EVAR,BVAR
EQUALS LVAR,BVAR
DEFINE VARCHK		; VARCHK always has this side effect.
VARIABLES
TERMIN ]

	; Defs for .CALL code bits
CIMM==1000,,0	;immediate arg
CRET==2000,,0	;value returned
CERR==3000,,0	;error code returned
CTL== 4000,,0	;control bits at loc
CTLI==5000,,0	;control bits, immediate

DEFINE SYSCAL A,B
	.CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))]
TERMIN

%SIGN==SETZ	; Define full-word Sign bit.
%HSIGN==400000	; and Halfword sign bit.

	; Common byte-pointer LH's
IFNDEF $OPCOD,$OPCOD==331100	; Instruction op-code
IFNDEF $ACFLD,$ACFLD==270400	; Instruction AC field
IFNDEF $IFLD,$IFLD==220400	; Instruction (I) field
IFNDEF $ATFLD,$ATFLD==260100	; Instruction @ field
IFNDEF $ERRCD,$ERRCD==220600	; Error code from .STATUS wd

IFNDEF PJRST,PJRST==JRST	;jrst to a popj'ing routine

DEFINE PUSHAE AC,LIST
IRP LOC,,[LIST]
PUSH AC,LOC
TERMIN
TERMIN

DEFINE POPAE AC,LIST
IRP LOC,,[LIST]
POP AC,LOC
TERMIN
TERMIN

	; TMPLOC <loc>,<parenthesized arg> - puts argument at given LOC
	;	without changing location counter outside macro call.
DEFINE TMPLOC VAL,?ARG
%%%TLC==.
LOC VAL
ARG
LOC %%%TLC
TERMIN

IFNDEF %%%ASC,%%%ASC==0	; Default is old mode, i.e. ASCNT [str]
IFE %%%ASC,[
	; ASCNT [string] - produces word of <char cnt>,,<addr to string>
DEFINE ASCNT STR
.LENGTH STR,,[ASCIZ STR]!TERMIN

DEFINE LITSTR STRING
[ASCNT [STRING]]TERMIN

	; ASCSTR [string] - produces 2 words of constant string descriptor,
	;	0,,<char cnt> ? <BP to string>
DEFINE ASCSTR STR
.LENGTH STR
440700,,[ASCIZ STR]!TERMIN

] ; end IFE %%%ASC

IFE %%%ASC-1,[

	; New style, i.e. ASCNT /str/

DEFINE ASCNT &STR&
.LENGTH STR,,[ASCIZ STR]!TERMIN

DEFINE LITSTR &STR&
[ASCNT STR]!TERMIN

DEFINE ASCSTR &STR&
.LENGTH STR
440700,,[ASCIZ STR]!TERMIN

] ; end of IFE %%%ASC-1

; NETHANG - macro interface to use NETBLK call.  Hangs until specified
;net channel changes state, or call times out.
;	MOVEI AC,<channel>
;	NETHANG <timeout in 30th's>,AC,<hang state>,[<winning states>]
;	 failure return (timed out or non-winning new state)
;	win return (changed to winning state)
; Always returns new state in AC.

DEFINE NETHANG TIMOUT,AC,HANGST,NEWSTL
JRST [	MOVEM AC,TMSTOR'
	MOVE AC,[TIMOUT]
	EXCH AC,TMSTOR
	SYSCAL NETBLK,[AC ? [HANGST] ? TMSTOR ? CRET AC]
	 JRST .+1
IRP CODE,,[NEWSTL]
	CAIN AC,CODE
	 JRST .+2
TERMIN
	JRST .+1]
TERMIN

; BLKINI, BLKADD - couple of hairy macros that take a given <blockname>
;	and turn it into repository of text, initialized by BLKINI <name>
;	added to by BLKADD <name>,[<text to add>].
;	To dump text, simply stick <name> someplace after all has been added.

DEFINE BLKINI BLKNAM	; Initialize specified blockname.
DEFINE BLKNAM ARG
ARG
TERMIN
TERMIN

DEFINE BLKADD BLKNAM,NEW	; Add stuff to specified blockname.
BLKNAM [DEFINE BLKNAM ARG
ARG]NEW
TERMIN
TERMIN


	; Macro to clear clock and set frame time for interrupts
DEFINE CLKSET TMOLOC
	PUSH P,A
	MOVE A,[600000,,TMOLOC]
	.REALT A,
	JFCL
	POP P,A
TERMIN

	;to enable clock interrupts
DEFINE CLKON
	.SUSET [.SAPIRQC,,[%PIRLT]]	;turn off any pending realt
	.SUSET [.SIMASK,,[%PIRLT]]	;enable it
TERMIN

	;to disable
DEFINE CLKOFF
	.SUSET [.SAMASK,,[%PIRLT]]
TERMIN

;-------------------------------------------------------------
; Super duper macro to make output a breeze.  requires UUOS.
DEFINE ASCFWR STR	; This is temp crock while %%%ASC exists.
.LENGTH STR,,[ASCIZ STR]!TERMIN

DEFINE FWRITE ICH,LIST
%F==0
IRP ITEM,REST,[LIST]
IFN %F,[%F==0 ? .STOP]
IFNSQ [ITEM][OUTC ICH,[ASCFWR [ITEM]] ? .STOP]
IFDEF %%.!ITEM,[IRP ARG,,[REST] ? %%.!ITEM ICH,[ARG] ? .ISTOP ? TERMIN
		%F==1 ? .STOP]
OUTC ICH,[ASCFWR [ITEM]]
TERMIN
TERMIN

DEFINE MAKSTR LOC,LIST	;for making string in one fell swoop.
BCONC
FWRITE STRC,[LIST]
ECONC LOC
TERMIN

DEFINE CONC LOC,LIST	;for concatenating stuff to existing string.
BCONC LOC
FWRITE STRC,[LIST]
ECONC LOC
TERMIN

;------------------- FWRITE item routines ------------------
; item is in form "%%.<item-name> <channel>,<argument>"
;  Note that if item takes no argument and it is the last thing in FWRITE,
; a space should follow the comma, as in FWRITE CH,[[foo],WAI, ]
; Otherwise MIDAS botches it with no err message.

DEFINE %%.TLS C,ARG	; "TLS" - Text, List String.
OUTLS C,ARG		;	takes arg as location of SPT and outputs string therein.
TERMIN

DEFINE %%.TA C,ARG	; "TA" - Text, Area.  outputs whole area.
OUTAR C,ARG		;	takes arg as an ARPT to desired area.
TERMIN

DEFINE %%.TS C,ARG	; "TS" - Text, String.  outputs string var.
OUTS C,ARG		;	arg is address thereof.
TERMIN

DEFINE %%.N10 C,ARG	; "N10" - Number, base 10 ; signed decimal value,
OUN10 C,ARG		;	with decimal point.
TERMIN

DEFINE %%.N9 C,ARG	; "N9" - N10 without decimal point.  Kludge.
OUN9 C,ARG
TERMIN

DEFINE %%.N8 C,ARG	; "N8" - Number, base 8.  Signed octal value.
OUN8 C,ARG
TERMIN

DEFINE %%.OCT C,ARG	; "OCT" - OCTal value of word, same as N8.
OUN8 C,ARG
TERMIN

DEFINE %%.DEC C,ARG	; "DEC" - DECimal value of word, same as N10.
OUN10 C,ARG
TERMIN

DEFINE %%.NFL C,ARG	; "NFL" - Number, FLoating.  From MACLISP.
OUNFLT C,ARG
TERMIN

DEFINE %%.TI C,ARG	; "TI" - Text Immediate.  Outputs arg as char
OUTI C,ARG
TERMIN

DEFINE %%.TZ C,ARG	; "TZ" - Text ASCIZ.  Outputs asciz string
OUTZ C,ARG		;	starting at arg.
TERMIN

DEFINE %%.TZ$ C,ARG	; "TZ$" - Text ASCIZ kludge.  Outputs asciz string addressed by RH of word at arg
MOVE U4,ARG		;	(like OUTZ C,@ARG but avoids further indirection)
OUTZ C,(U4)
TERMIN

DEFINE %%.TC C,ARG	; "TC" - Text, Count.  Outputs ASCNT string at arg
OUTC C,ARG
TERMIN

DEFINE %%.TPZ C,ARG	; "TPZ" - Text, BP ASCIZ.  c(ARG) is BP to asciz string
OUTPZ C,ARG
TERMIN

DEFINE %%.TPC C,ARG	; "TPC" - Text, BP Count.  c(ARG) is <char cnt>,,<addr of BP to string>
OUTPC C,ARG
TERMIN

DEFINE %%.LH C,ARG	; "LH" - outputs LH of c(ARG) in octal (6 chars)
HLRZ U4,ARG
OUNRH C,U4
TERMIN

DEFINE %%.RH C,ARG	; "RH" - outputs RH of c(ARG) in octal (6 chars)
OUNRH C,ARG
TERMIN

DEFINE %%.H C,ARG	; "H" - outputs c(ARG) in halfwd format (LH,,RH)
HLRZ U4,ARG
OUNRH C,U4
OUTZ C,[ASCIZ /,,/]
OUNRH C,ARG
TERMIN

DEFINE %%.RHV C,ARG	; "RHV" - rh(arg) as octal number, not bit pattern
HRRE U4,ARG
OUN8 C,U4
TERMIN

DEFINE %%.LHV C,ARG	; "LHV" - lh(arg) as octal number
HLRE U4,ARG
OUN8 C,U4
TERMIN

DEFINE %%.HV C,ARG	; "HV" - lhv,,rhv
HLRE U4,ARG
OUN8 C,U4
OUTZ C,[ASCIZ /,,/]
HRRE U4,ARG
OUN8 C,U4
TERMIN

DEFINE %%.6F C,ARG	; "6F" - outputs c(arg) as sixbit without trailing blanks
OUT6F C,ARG
TERMIN

DEFINE %%.6W C,ARG	; "6W" - outputs all of c(arg) as sixbit
OUT6W C,ARG
TERMIN

DEFINE %%.6Q C,ARG	; "6Q" - like 6F but puts ^Q in front of punctuation characters
OUT6Q C,ARG
TERMIN

DEFINE %%.WA C,ARG	; "WA" - When, type A.
PUSH P,A		;	Converts internal time into "mm/dd/yy hh:mm:ss"
MOVE A,ARG
PUSHJ P,TIMDTM
OUTC C,A
POP P,A
TERMIN

DEFINE %%.WB C,ARG	; "WB" - When, type B.
PUSH P,A		;	Converts internal time into "dd mmm yy hh:mm-zon"
MOVE A,ARG
PUSHJ P,TIMEXP
OUTC C,A
POP P,A
TERMIN

DEFINE %%.WC C,ARG	; "WC" - When, type C.  Converts internal time into HH:MM:SS.
PUSH P,A
MOVE A,ARG
PUSHJ P,TIMTIM
OUTC C,A
POP P,A
TERMIN

DEFINE %%.WD C,ARG	; "WD" - When, type D.
PUSH P,A		;	Converts internal time into "dd mmm yy hh:mm-zon"
MOVE A,ARG
PUSHJ P,LTMEXP
OUTC C,A
POP P,A
TERMIN

DEFINE %%.WAI C,ARG	; "WAI" - WA Immediate.  Like WA but ignores arg,
PUSH P,A		;	uses current time and date.
PUSHJ P,TIMGT
PUSHJ P,TIMDTM
OUTC C,A
POP P,A
TERMIN

DEFINE %%.WBI C,ARG	; "WBI" - like WB but etc.
PUSH P,A
PUSHJ P,TIMGET
PUSHJ P,TIMEXP
OUTC C,A
POP P,A
TERMIN

DEFINE %%.WCI C,ARG	; "WCI" - like WC but etc.
PUSH P,A
PUSHJ P,TIMGT
PUSHJ P,TIMTIM
OUTC C,A
POP P,A
TERMIN
 


; "HN" - takes host # from arg and outputs number, performing
; simplifications where appropriate.  Intended for use with new (HOSTS2)
; host table.  Will hack slash format #'s when they become acceptable.
DEFINE %%.HN C,ARG
MOVE U4,ARG
LDB U3,[NETWRK"NW$BYT,,ARG]	; If no string exists, check number.
CAIN U3,NETWRK"NW%ARP		; Arpanet?
 PUSHJ P,[
	TDNE U4,[777,,77700774]	; Are any extended bits set?
	 POPJ P,		; If so, just print number (hack slash fmt later)
	DPB U4,[170200,,U4]	; Move host # ahead of imp #
	LSH U4,-9.
	ANDI U4,377
	POPJ P,]		; finally output old-form number
OUN8 C,U4	; not arpanet?? just print.
TERMIN

; "HST" - takes host # from arg and outputs name or #
; This version works with new host table file
DEFINE %%.HST C,ARG	; "HST" - takes host # from arg and outputs name or #
	PUSHAE P,[A,B,D] ;clobbered by HSTSRC routine 
	SKIPN B,ARG 
	 MOVE B,OWNHST 
	PUSHJ P,NETWRK"HSTSRC	;make A point to asciz name
	 PUSHJ P,[
		%%.HN C,B	; Output number.
		JRST POPJ1]
	OUTZ C,(A)
	POPAE P,[D,B,A]
TERMIN

DEFINE %%.ERR C,ARG	; "ERR" - ITS error message.  If arg is blank,
PUSH P,A			; use .BCHN, otherwise arg is error code
PUSH P,B
IFNB ARG, MOVE A,ARG		; A arg if present
MOVEI B,C			; B channel to output on
IFB ARG, PUSHJ P,ERRMO
.ELSE	 PUSHJ P,ERRMOA
POP P,B
POP P,A
TERMIN

;		Character Table Macros

;	These macros facilitate use of 200-word arrays indexed by
; an ASCII character.  A standard table definition is furnished which
; can be inserted where desired, and each insertion may be altered
; as necessary.


	; Character class definitions - all in LH

ch%msk==377000		; Note sign bit not included; user can set.

ch%ul== 200000		; Uppercase Letter (A-Z)
ch%ll== 100000		; Lowercase Letter (a-z)
ch%d==   40000		; Digit (0-9)
ch%pt==  20000		; Printing (41-176; all but CTLs, SP, DEL)
ch%wsp== 10000		; Whitespace (SP, TAB)
ch%fmt==  4000		; ForMaT effector (^H, ^I, ^J, ^K, ^L, ^M)
ch%lbr==  2000		; Left BRacket  (<[{
ch%rbr==  1000		; Right BRacket }]>)

		; Some useful combinations
ch%l==ch%ul+ch%ll	; Letter (upper or lower case)
ch%ld==ch%l+ch%d	; Letter or Digit
ch%uld==ch%ul+ch%d	; Uppercase Letter or Digit
ch%lld==ch%ll+ch%d	; Lowercase Letter or Digit
ch%br==ch%lbr+ch%rbr	; Brackets


define c.set #chr#,?val
<ch%!chr==val>
termin
define c.add #chr#,?val
<ch%!chr==ch%!chr\val>
termin
define c.addl #chr#,?val
<ch%!chr==ch%!chr\<val,,>>
termin
define c.setr #chr#,?val
<ch%!chr==<-1,,>&ch%!chr\val>
termin

define chrgrp mode,ch1,ch2,*str*,?val
if1 .stop
ifsn [ch1][]{
ifsn [ch2][] %%%nc==1+<ch2>-<ch1>
.else %%%nc==1
%%%tlc==.
loc chrtab+<ch1>
repeat %%%nc,c.!mode \<<ch1>+.rpcnt>,val
loc %%%tlc
}
ifse [str][] .stop
%%%tlc==.
irpc c,,[str]
loc chrtab+<"c>
c.!mode \<"c>,val
termin
loc %%%tlc
termin

define CHTMAC
chrtab==.		; addr of latest table.
repeat 200,c.set \.rpcnt,0
chrgrp addl,"A,"Z,,ch%ul
chrgrp addl,"a,"z,,ch%ll
chrgrp addl,"0,"9,,ch%d
chrgrp addl,41,176,,ch%pt
chrgrp addl,^I,," ",ch%wsp
chrgrp addl,^H,^M,,ch%fmt
chrgrp addl,133,,"(<{",ch%lbr	; 133 = [
chrgrp addl,135,,"}>)",ch%rbr	; 135 = ]
termin