SUBTTL General-purpose macro library

;  This file contains symbolic and macro definitions that many of my programs
; use.  It is an experiment in higher-level assembly language programming.

IF2 .INEOF				; only read this file on pass 1
.AUXIL					; don't cref this file's unused symbols
.NSTGW					; do not allow storage words

IFN 0,[					; for @ happiness
 .INSRT SYSTEM;TTYDEF >
 .INSRT SYSTEM;BITS >
]

; These symbols are temporaries that the user should never have to worry about.

.XCREF TEMP%%,FLAG%%,%ADD,%ADDI,%SUB,%SUBI,%FADR,%FADRI,%FSBR,%FSBRI

; MIDAS environment alteration and recording (date, time, etc.)

.FORMAT 30,2704_24.			; make A, format treat A like an ac
.FORMAT 34,00222704_12.			; make A,B format treat A like an ac

IFE .OSMIDAS-('ITS),[			; ** ITS MIDAS **
 .AOP .RDATIM				; get date and time of assembly
 %ASTIM==.AVAL1				; time of assembly in SIXBIT (HHMMSS)
 %ASDAT==.AVAL2				; date of assembly in SIXBIT (YYMMDD)
]					; ** End of ITS MIDAS **
IFN .OSMIDAS-('ITS),[			; ** DEC MIDAS **
 %ASTIM==.OP MSTIME			; time of assembly in milliseconds
 %ASDAT==.OP DATE			; date of assembly in DEC format
]					; ** End of DEC MIDAS **
%VERSION==.FNAM2			; version when assembled
SUBTTL Instruction, field definitions

; PDP-10 word field definitions

%INFIN==377777777777			; infinity
%MINFI==400000000000			; minus infinity
%LHALF==777777000000			; left half word
%RHALF==000000777777			; right half word
%FWORD==777777777777			; full word
%ZEROS==000000000000			; zeroes

; Instruction fields

%ICOPC==777000,,			; opcode
%ICACF==000740,,			; ac field
%ICIOP==700340,,			; I/O opcode
%ICIDV==077400,,			; I/O device channel
%ICIND==000020,,			; indirect bit
%ICIDX==000017,,			; index field
%ICADR==777777				; address

; Special PDP-10 instructions

MAP=257000,,				; map an address

;  The following are used by a subroutine that calls a second
; subroutine that is to return to the former's caller.

; Instruction				Replaces
; -----------				--------

PJRST==JRST				; pushj/popj
PJRSTF==JRSTF				; pushj/popj
PJSP==JSP				; movei .+1/pushj/popj
PJUMPL==JUMPL				; JUMP??/POPJ/PUSHJ/POPJ
PJMPLE==JUMPLE
PJUMPN==JUMPN
PJUMPG==JUMPG
PJMPGE==JUMPGE

;  The following are mostly for convenience in using DDT.

IFNDEF P,P==17				; conventional stack pointer ac

SAVE=PUSH P,				; save value on stack
RETR=POP P,				; retrieve value from stack
CALL=PUSHJ P,				; save PC on stack and jump
RETURN=POPJ P,				; restore PC from stack
SUBTTL General pseudo-ops

; TMPLOC - assemble into a certain location
;	TMPLOC loc,value

DEFINE TMPLOC ?LOC=0,VALUE=0
 TEMP%%==. ? .==LOC ? VALUE ? .==TEMP%%
TERMIN

; END - terminate assembly, expunge temporary symbols
;	END <start address>

EQUALS %END,END				; make %END terminate assembly

DEFINE END ADDR
 IF2 EXPUNGE TEMP%%,FLAG%%,%ADD,%ADDI,%SUB,%SUBI,%FADR,%FADRI,%FSBR,%FSBRI
 %END ADDR
TERMIN

; ND. - define a symbol if it is not defined
;	ND. symbol=value

DEFINE ND. DEFN
 IRPS TEMP%%,,[DEFN]
  IFDEF TEMP%%,NULL
  .ISTOP
 TERMIN
 .ELSE DEFN
TERMIN

; ACDEF. - define consecutive accumulators, I/O channels, etc.
; 	starting at 1.
;	ACDEF. <ac-list>

DEFINE ACDEF. ACLIST
 IRPS TEMP%%,,[ACLIST]
  ND. TEMP%%=.IRPCNT+1
  IFGE TEMP%%-20,.ERR TEMP%%	MAGNITUDE > 17
 TERMIN
TERMIN

; FLAG. - dynamically generate a bit flag
;	FLAG. flag		;to generate a flag
;	FLAG.			;to initialize the mechanism

DEFINE FLAG. BIT
 IFB BIT,FLAG%%==%MINFI ? .ISTOP
 IFNDEF FLAG%%,.ERR BIT	Flags not initialized
 IFE FLAG%%,.ERR BIT	Too many flags
 BIT==FLAG%%
 FLAG%%==FLAG%%_-1
TERMIN

; IOWD - generate a DEC IOWD
;	IOWD length,address

DEFINE IOWD ?LEN,ADR
<-LEN,,ADR-1>TERMIN

; SWDEF. - define an assembly switch
;	SWDEF. [definition];description

DEFINE SWDEF. DEFN,DESC/
 IF1,[
  DEFN
  PRINTX\!DESC!:  !DEFN! \
  IRPS SWITCH,,[DEFN]
   .TTYMAC CRUFT/
    IFNB [CRUFT][SWITCH==CRUFT]
   TERMIN
   .ISTOP
  TERMIN
 ]
TERMIN
SUBTTL Byte manipulation pseudo-ops

; POINT. - MACRO-10 style point pseudo-op
;	POINT. length,address,position

DEFINE POINT. ?S,ADDR,B=-1
<<<<35.-.RADIX 10.,B>&77>_30.\<<.RADIX 10.,S>&77>_24.> ADDR>TERMIN

; WID. - compute the width of a mask
;	WID. mask

DEFINE WID. ?MASK
<.LDB 300600,.BP MASK>TERMIN

; POS. - compute the position of a mask
;	POS. mask

DEFINE POS. ?MASK
<35.-.TZ MASK>TERMIN

; MASK. - build a mask pointed to by point wid,loc,pos
;	MASK. width,position

DEFINE MASK. ?WID,POS
<<<1_WID>-1>_<35.-POS>>TERMIN

; RGHBT. - generate the rightmost bit in a mask
;	RGHBT. mask

DEFINE RGHBT. ?MASK
<MASK&-MASK>TERMIN

; LFTBT. - generate the leftmost bit in a mask
;	LFTBT. mask

DEFINE LFTBT. ?MASK
<1_<35.-.LZ MASK>>TERMIN

; FILIN. - fill in ones from leftmost bit of mask to rightmost bit
;	FILIN. mask

DEFINE FILIN. ?MASK
<.BM .BP MASK>TERMIN

; INSVL. - position value in mask
;	INSVL. value,mask

DEFINE INSVL. ?VALUE,MASK
<<VALUE_.TZ MASK>&MASK>TERMIN

; RJUST. - right justify a mask
;	RJUST. mask

DEFINE RJUST. ?MASK
<MASK_<-.TZ MASK>>TERMIN

; LJUST. - left justify a mask
;	LJUST. mask

DEFINE LJUST. ?MASK
<MASK_.LZ MASK>TERMIN
SUBTTL Text accumulation pseudo-ops

; CINFO. - macro to clear and/or initialize the text mechanism
;	CINFO.

DEFINE CINFO.
 DEFINE INFO. OCRUFT
  OCRUFT
 TERMIN
TERMIN

; REDEF. - macro to add text to the mechanism.  It adds a <crlf>
;	at the end.
;	REDEF. [...text...]

DEFINE REDEF. NCRUFT
 INFO. [DEFINE INFO. OCRUFT
  OCRUFT]NCRUFT
 TERMIN
TERMIN

; INFO. - macro (hacked by CINFO. and REDEF.) to dump out the text.
;	INFO.
SUBTTL System dependent macros

IFE .OSMIDAS-('ITS),[			; ** ITS MIDAS only **
; SYSCAL - macro to generate a symbolic system call
;	SYSCAL call,[args]

DEFINE SYSCAL CALL,ARGS
 .CALL [%MINFI
	SIXBIT/CALL/
	ARGS
	%MINFI\%CLERR $ERCOD']
TERMIN

; SYSCAL op-codes

%CLARG==000000,,			; argument
%CLARI=001000,,				; immediate argument
%CLVAL=002000,,				; value
%CLERR=003000,,				; error
%CLCTL=004000,,				; control
%CLCTI=005000,,				; immediate control

;  CLARG. and CLCTL. are to allow for ambigious immediates in a SYSCAL
; argument and control argument.

DEFINE CLARG. ARG
 TEMP%%=ARG
 IFN TEMP%%&%LHALF,%CLARG [TEMP%%]
 .ELSE %CLARI TEMP%%
TERMIN

DEFINE CLCTL. CTL
 TEMP%%==CTL
 IFN TEMP%%&%LHALF,%CLCTL [TEMP%%]
 .ELSE %CLCTI TEMP%%
TERMIN

; UGET - fetch a user variable
;	UGET name,loc,channel

DEFINE UGET VAR,LOC,CHNL
 IFB CHNL,.SUSET [.R!VAR,,LOC]
 .ELSE .USET CHNL,[.R!VAR,,LOC]
TERMIN

; USET - set a user variable
;	USET name,loc,channel

DEFINE USET VAR,LOC,CHNL
 IFB CHNL,.SUSET [.S!VAR,,LOC]
 .ELSE .USET CHNL,[.S!VAR,,LOC]
TERMIN

; USETI - set a user variable, immediate
;	USETI name,value

DEFINE USETI VAR,VAL,CHNL
 IFB CHNL,.SUSET [.S!VAR,,[VAL]]
 .ELSE .USET CHNL,[.S!VAR,,[VAL]]
TERMIN

; PEEK - peek at an ITS system location
;	PEEK ac,name

DEFINE PEEK AC,NAME
 MOVX AC,<SQUOZE 0,NAME>
 .EVAL AC,
  .LOSE
 HRLI AC,AC
 MOVSS AC
 .GETLOC AC,
TERMIN
]					; ** End of ITS MIDAS **
SUBTTL High-level instructions

; INSIRP - repeat over an instruction with various addresses
;	INSIRP inst,address(es)

DEFINE INSIRP INST,ADDRS
 IRPS TEMP%%,,[ADDRS]
  INST,TEMP%%
 TERMIN
TERMIN

; JUMPPT - jump depending upon processor type
;	JUMPPT ac,PDP-6,KA-10,KI-10,KL-10
; ac is a temporary ac not equal to zero.

DEFINE JUMPPT AC=1,CP166=0,KA10=0,KI10=0,KL10=0
IFE AC,.ERR JUMPPT	1st arg zero
IF2,IFE CP166*KA10*KI10*KL10,.ERR JUMPPT	Null processor argument
	JFCL 1,.+1			; clear PDP-6 PC change flag
	JRST .+1			; set PC change flag on PDP-6
	JFCL 1,CP166			; if flag is on, PDP-6
	MOVX AC,<-2,,-1>		; ac := -2,,-1
	AOBJP AC,KA10			; non-zero ac means KA-10
	MOVX AC,%ZEROS			; ac := 0
	BLT AC,				; KI/KL test
	JUMPE AC,KI10			; zero ac means KI-10
	JRST KL10			; else it is a KL-10
TERMIN

; STORE - macro to place a constant in a block of locations
;	STORE <constant>,<first location>,<last location>,<temp ac>

;		** Note Well **

; May generate more than one word of code.
; If last location is not specified, it is a "MOVXM".  If temp ac is
; not specified, ac 0 is used.  <== Note Well !!

DEFINE STORE ?CONS=0,FIRST=0,LAST,AC=0
 TEMP%%=0
 IFE CONS,SETZM FIRST ? TEMP%%=-1
 IFE CONS+1,SETOM FIRST ? TEMP%%=-1
 IFE CONS-1,SETZM FIRST ? AOS FIRST ? TEMP%%=-1
 IFE CONS+2,SETOM FIRST ? SOS FIRST ? TEMP%%=-1
 IFE TEMP%%,[MOVX AC,CONS
  MOVEM AC,FIRST]
 IFNB LAST,MOVE AC,[FIRST,,FIRST+1] ? BLT AC,LAST
TERMIN

; MOVX - macro to load an immediate value into an accumulator

DEFINE MOVX ?AC=0,FLAG=0
 TEMP%%=FLAG
 IFE TEMP%%,SETZ AC, ? .ISTOP
 IFE TEMP%%+1,SETO AC, ? .ISTOP
 IFE TEMP%%&%LHALF,MOVEI AC,TEMP%% ? .ISTOP
 IFE TEMP%%&%RHALF,MOVSI AC,(TEMP%%) ? .ISTOP
 IFE <TEMP%%_-18.>-%RHALF,HRROI AC,TEMP%% ? .ISTOP
 IFE <TEMP%%_18.>-%LHALF,HRLOI AC,(TEMP%%-%RHALF) ? .ISTOP
 MOVE AC,[TEMP%%]
TERMIN

; CAX?? - compare ac with immediate and skip under condition

IRP CODE,,[,L,LE,E,G,GE,N,A]
 DEFINE CAX!CODE ?AC=0,VALUE=0
  TEMP%%=VALUE
  IFE TEMP%%&%LHALF,CAI!CODE AC,TEMP%%
  .ELSE CAM!CODE AC,[TEMP%%]
 TERMIN
TERMIN
; Arithmetic operations

IRPS CODE,,[%ADD,%SUB,MUL,IMUL,DIV,IDIV]
 DEFINE CODE!X ?AC=0,VALUE=0
  TEMP%%=VALUE
  IFE TEMP%%&%LHALF,CODE!I AC,TEMP%%
  .ELSE CODE AC,[TEMP%%]
 TERMIN
TERMIN

DEFINE ADDX ?AC=0,VALUE=0
 TEMP%%=VALUE
 IFE <TEMP%%_-18.>-%RHALF,SUBI AC,-TEMP%%
 .ELSE %ADDX AC,TEMP%%
TERMIN

EQUALS %ADD,ADD ? EQUALS %ADDI,ADDI

DEFINE SUBX ?AC=0,VALUE=0
 TEMP%%=VALUE
 IFE <TEMP%%_-18.>-%RHALF,ADDI AC,-TEMP%%
 .ELSE %SUBX AC,TEMP%%
TERMIN

EQUALS %SUB,SUB ? EQUALS %SUBI,SUBI

IRPS CODE,,[%FADR,%FSBR,FMPR,FDVR]
 DEFINE CODE!X ?AC=0,VALUE=0
  TEMP%%==VALUE
  IFE TEMP%%&%RHALF,CODE!I AC,(TEMP%%)
  .ELSE CODE AC,[TEMP%%]
 TERMIN
TERMIN

DEFINE FADRX ?AC=0,VALUE=0
 TEMP%%=VALUE
 IFE <TEMP%%_18.>-%LHALF,FSBRI AC,(%LHALF&-TEMP%%)
 .ELSE %FADRX AC,TEMP%%
TERMIN

EQUALS %FADR,FADR ? EQUALS %FADRI,FADRI

DEFINE FSBRX ?AC=0,VALUE=0
 TEMP%%=VALUE
 IFE <TEMP%%_18.>-%LHALF,FADRI AC,(%LHALF&-TEMP%%)
 .ELSE %FSBRX AC,TEMP%%
TERMIN

EQUALS %FSBR,FSBR ? EQUALS %FSBRI,FSBRI

; BTSWAP - swap states of two bits in an accumulator

DEFINE BTSWAP ?AC=0,BIT1=0,BIT2=0
 REPEAT 3,TXCE AC,BIT1\BIT2
TERMIN
; TX?? - test ac under immediate mask with option and skip under
;	condition

IRP ACTION,,[N,Z,O,C]
 IRP CODE,,[E,N,A]
  DEFINE TX!ACTION!!CODE ?AC=0,FLAG=0
   TEMP%%=FLAG
   IFE TEMP%%&%RHALF,IFN TEMP%%,TL!ACTION!!CODE AC,(TEMP%%) ? .ISTOP
   IFE TEMP%%&%LHALF,TR!ACTION!!CODE AC,TEMP%% ? .ISTOP
   TD!ACTION!!CODE AC,[TEMP%%]
  TERMIN
 TERMIN
TERMIN

DEFINE TXZA ?AC=0,FLAG=0
 TEMP%%=FLAG
 IFE TEMP%%,TRNA AC,%ZEROS ? .ISTOP
 IFE TEMP%%-%FWORD,TDZA A,A ? .ISTOP
 IFE TEMP%%&%RHALF,TLZA AC,(TEMP%%) ? .ISTOP
 IFE TEMP%%&%LHALF,TRZA AC,TEMP%% ? .ISTOP
 TDZA AC,[TEMP%%]
TERMIN

DEFINE TXN ?AC=0,FLAG=0
 TRN AC,<,,FLAG>
TERMIN

DEFINE TXZ ?AC=0,FLAG=0
 TEMP%%=FLAG
 IFE TEMP%%-%FWORD,MOVX AC,%ZEROS ? .ISTOP
 IFE <TEMP%%_-18.>-%RHALF,ANDI AC,#TEMP%% ? .ISTOP
 IFE TEMP%%_18.,IFN TEMP%%,TLZ AC,(TEMP%%) ? .ISTOP
 IFE TEMP%%_-18.,ANDCMI AC,TEMP%% ? .ISTOP
 AND AC,[#TEMP%%]
TERMIN

DEFINE TXO ?AC=0,FLAG=0
 TEMP%%=FLAG
 IFE TEMP%%-%FWORD,MOVX AC,%FWORD ? .ISTOP
 IFE <TEMP%%_-18.>-%RHALF,ORCMI AC,#TEMP%% ? .ISTOP
 IFE TEMP%%_18.,IFN TEMP%%,TLO AC,(TEMP%%) ? .ISTOP
 IFE TEMP%%_-18.,IORI AC,TEMP%% ? .ISTOP
 IOR AC,[TEMP%%]
TERMIN

DEFINE TXC ?AC=0,FLAG=0
 TEMP%%=FLAG
 IFE TEMP%%-%FWORD,SETCA AC, ? .ISTOP
 IFE <TEMP%%_-18.>-%RHALF,EQVI AC,#TEMP%% ? .ISTOP
 IFE TEMP%%_18.,IFN TEMP%%,TLC AC,(TEMP%%) ? .ISTOP
 IFE TEMP%%_-18.,XORI AC,TEMP%% ? .ISTOP
 XOR AC,[TEMP%%]
TERMIN

; IORX, ANDX, XORX, EQVX are super-random versions of TX??

EQUALS IORX,TXO

DEFINE ANDX ?AC=0,FLAG=0
 TEMP%%=FLAG
 TXZ AC,#TEMP%%
TERMIN

EQUALS XORX,TXC

DEFINE EQVX ?AC=0,FLAG=0
 TEMP%%=FLAG
 XORX AC,#FLAG
TERMIN

.YSTGW					; allow storage words again

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;		*** The END ***			;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
