This is a cross-referenced version of stack.defs, to download the unmodified
source try stack.defs.
# A simple stack.
# Word 0 of each frame holds previous stack frame pointer
# words 1..n usable
# Traditionaly word 1 is the link.
# We need some way of defining stack size at
# consolidation time. If a segment with a bigger
# stack is included then the bigger size is used
#DEFINE SSIZE=1024 [ stack size
#DEFINE SXOFFSET=0 [ stack pointer offset
# [ needs to be nonzero for C calling
#DEFINE SXARG1=SXOFFSET-1 [ 1st arg in C style
#DEFINE SXARG2=SXOFFSET-2 [ 2nd arg in C style
#DEFINE SXARG3=SXOFFSET-3 [ 3rd arg in C style
#DEFINE SXARG4=SXOFFSET-4 [ 4th arg in C style
#DEFINE SXARG5=SXOFFSET-5 [ 5th arg in C style
#DEFINE SXARG6=SXOFFSET-6 [ 6th arg in C style
#DEFINE SXARG7=SXOFFSET-7 [ 7th arg in C style
#DEFINE SXARG8=SXOFFSET-8 [ 8th arg in C style
#DEFINE SXPREV=SXOFFSET+0 [ saved BP of prev frame
#DEFINE SXLINK=SXOFFSET+1 [ Return address
#DEFINE SXFRAME=SXOFFSET+2 [ Top of minimum stack frame
#DEFINE SXPAR1=SXOFFSET+2 [ First argument in PASCAL style
#DEFINE SXPAR2=SXOFFSET+3 [ 2nd argument in PASCAL style
#DEFINE SXPAR3=SXOFFSET+4 [ 3rd argument in PASCAL style
#DEFINE SXPAR4=SXOFFSET+5 [ 4th argument in PASCAL style
#DEFINE SXPAR5=SXOFFSET+6 [ 5th argument in PASCAL style
#DEFINE SXPAR6=SXOFFSET+7 [ 6th argument in PASCAL style
#DEFINE SXPAR7=SXOFFSET+8 [ 7th argument in PASCAL style
#DEFINE SXPAR8=SXOFFSET+9 [ 8th argument in PASCAL style
# ...
#UPPER COMMON/STACKMEM/
STACK(SSIZE)
#LOWER COMMON/STACKPTR/
BASEP #77777777 [ explode on stack underflow
STAKP /STACK-SXOFFSET [ initial top of stack
# Get base of current stack frame
# Args:
# Register to receive base pointer.
#MACRO
BASE S
LDX S BASEP [ Get base of stack frame to S
# Save base from register
# Args:
# Register holding base pointer
#MACRO
ESAB B
STO B BASEP
# Load current top of stack to a register
# Can be used for passing arguments to routines:
#
# C style:
#
# STACK 3
# PUSH 3 2 [ push 2 args on stack
# STO n SXARG2(3) [ arg 2 of 2
# STO m SXARG1(3) [ arg 1 of 2
# CALL ....
# POP 3 2 [ remove 2 args fom stack
#
# Inside the routine args can be accessed by
#
# BASE 2
# LDX n SXARG1(2) [ get arg #1
# LDX m SXARG2(2) [ get arg #2
#
# Alternative PASCAL style convention
#
# Pass args:
#
# STACK 3
# STO n SXPAR1(3)
# STO m SXPAR2(3)
# CALL ....
#
# Inside routine
#
# BEGIN 2 ...
# LDX n SXPAR1(2)
# LDX m SXPAR2(2)
# Note that it's possible to write routines that can be
# called using either the Fortran or Pascal conventions;
#
# GFFUNC OBEY 0(1) [ get @arg1
# LDX 3 0(3) [ ... get arg1
# STACK 2
# STO 3 SXPAR1(2) [ ... save in stack
#
# ... repeat for other args
#
# ADN 1 ARGS [ point return past args
#
# GPFUNC BEGIN 2 3,1,STFRAME [ allocate stack frame
#
# ... code with args in SXPAR1(2) and so on
#
# END 2 1,0
#
#
#MACRO
STACK S
LDX S STAKP
# Save stack top from register
#MACRO
KCATS S
STO S STAKP
# Begin new stack frame, new version that includes
# link saving.
# Args:
# Register: Register to hold base (preferably index)
# Arg#1: Index register for top of stack
# Arg#2: register holding link
# Arg#3: size of stack frame
#MACRO
BEGIN B S,L,N
BASE B [ bp ->
STACK S [
STO B SXPREV(S) [ [ sp + 0 ]; save old bp
STO L SXLINK(S) [ link -> [ sp + 1 ]; save link
STO S B [ sp -> bp.reg
ESAB B [ bp.reg -> bp
ADN S N-SXOFFSET+1 [ sp.reg += n ; set new tos
KCATS S [ sp = sp.reg ; save tos
# End stack frame, new version that includes
# subroutine return
# Args:
# Register: Index register holding stack base
# Arg#1: Register to use for link
# Arg#2: number of instructions to skip on return
#MACRO
END B L,N
KCATS B [ bp -> sp
LDX L SXLINK(B) [ [ bp + 1 ] -> link
LDX B SXPREV(B) [ [ bp + 0 ] -> bp.reg
ESAB B [ bp.reg -> bp
EXIT L N [ and return
# PUSH "n" words on stack, enter with SP in reg
#MACRO
PUSH S N
ADN S N
KCATS S
# Pop "n" words of stack
#MACRO
POP W N
LDN W N [ W is work reg, *not* left
SBS W STAKP [ holding stack pointer
#
# Macro to load a 24 bit value without
# using lower or literal. Takes 4 words
# and can only load index register
#MACRO
LDXL R A
CALL R *+2
A
SBN R 1
LDX R 0(R)
#
# Move W words from X to Y (Y = X')
#
# X = source
# Y = dest (must be X')
# W = words to move - must be index register
# all registers trashed
#MACRO
MOVEW XY W
SBNC W 512 [ going to move 512 words
BCS *+6 [ jif less than 512 to move
MOVE X 0 [ Move 512 words
ADN X 512 [ increment
ADN Y 512 [ pointers
SBNC W 512 [ moved 512 words
BCC *-4 [ jif more to move
ADNC W 512 [ Correct for overshoot
BZE W *+2 [ jif no remainder
MOVE X 0(W) [ move remainder
#
# Extract info from Fortran array desc
# Fortran (and Algol) pass array args as:
# If the actual argument is an array element
# then the address of the element is passed
# with one or both of the two two bits set.
# If the acual argument is the name of an
# array then the address of an array descriptor
# is passed, with the top two bits clear
# User code is not supposed to know the format
# of an array descriptor, a routine GETAH is
# provided to transformt the format into a
# "array header" with is documented.
# Experimentation shows that the format for single
# dimensioned arrays is:
# word 0 = address of (non-existent) element 0
# with one or both of the top bits set
# (B22 for COMPRESS INTEGER AND LOGICAL
# B23 and B22 otherwise).
# word 1 = address of element 1
# word 2 = number of words in the array, with
# B23 on
# For multi-dimensional arrays the "partial products"
# are inserted after word1 before the array size word.
# Get address of array element:
# Args: Index register holding passed argument,
# array element or array name.
# No error checking done (we could look at word 0 of
# the "descriptor" and if neithe B23 or B22 set assume
# this is a simple variable - would screw up if caller
# passed simple variable with -ve value).
# If descriptor looks bad should produce an error.
#MACRO
ARRAY A
BXGE A '#17777777',*+2 [ jif either of top 2 bits set
LDX A 1(A) [ get addr of 1st element
ANDX A '#17777777' [ turn off high bits