cmpupd(cm160000,t77770) -*- mode: update;-*-
user,plato,plato.
attach(cmpopl)
modify(p=cmpopl,i,a,lo=e)
attach,lgo=cstc/m=w.
*define,cstc.
rewind(compile)
compass(i,x=cmpopl,s=iptext,s=psstext,s=scptext,s=cpctext,s=cputext)
~
*ident cstc
*deck compcom
*delete cps064.2
cp.name micro 1,, cst1$
*ident cstc1
*deck compass
*delete cp139cp.95
ident cst,orgz
*delete cp139cp.100
entry cst primary entry point
*delete cp139cp.142
cst sb1 1
*/ end mod
*deck compass
*edit compass
*ident sqz
*/ add cerl squoze files
*delete cmp24.281,cmp24.282
sa7 rnsz preset to no local sqz
nz x3,rns0 if compressed
mx0 12
bx0 x0*x5
nz x0,rns1 if normal card
sx3 b1 mark modify 63 char set
sx6 b1 mark end action
sa6 rnsz
rns0 sa5 a0+2
*delete cmp30.4633,cmp24.395
sa1 cct card count
sa3 rnsz check sqz
zr x3,rnz1 not sqz
sa4 a0+b1 get modword
mx6 0
bx7 x4
eq rns8
rnz1 sa3 cp.iform
*delete cmp24.462
nz x3,rns8b if compressed
sa1 a0 check for sqz
mx6 12
bx6 x6*x1
nz x6,rns8b
sx3 b1 mark as modify 63
rns8b sa1 editm
*insert cmp24.488
rnsz data 0 for cerl sqz flag
*delete cmp24.177,cps146.5
rnc1 readw x2,a0,b1 check for cerl sqz
sa3 a0
mx6 12
bx6 x6*x3
nz x6,rnc1a if normal card
bx6 x3 move mod field for modify type
sa6 a0+b1
mx6 0 clear seq
sa6 a0
readc x2,a0+2,10 read rest of card
sx0 a0+2 mark text
sa3 a0+b1 get modword
sx3 x3
ng x3,rnc1 deleted
eq rncx exit
rnc1a sx0 a0 for normal card
mx6 -12 is the first word the last one
bx6 -x6*x3
zr x6,rncx if only card
readc x2,a0+b1,9 read rest of card
*insert compass.4326
zr x2,cpl3 if possible sqz card
*delete compass.4328
cpl1a bx6 x2
*delete compass.4332
cpl1b sb6 b2
*insert cmp24.42
mx2 12
bx2 x2*x5
zr x2,cpl if cerl sqz
*insert cmp24.59
* process possible modword
cpl3 sa2 a2+b1 get possible modword
ux3,b3 x2
sx3 b3+1777b test for sqz
nz x3,cpl1a if modify format
bx3 x2 isolate name
ax3 18
lx3 18
bx7 x3+x7 pack name
bx2 x2-x3 clear name
mx6 -14 save year,month,day
bx2 -x6*x2
bx6 x2
ax6 4+5 isolate year
sa3 x6+ymdvals
lx3 30
ax3 30 mask year
bx7 x3+x7 pack year
sa7 a6+b1
lx6 4+5
bx2 x2-x6 clear year
bx7 x2
ax7 5 isolate month
sa3 x7+ymdvals
ax3 30 mask month
lx3 -18 position month
bx6 x3
lx7 5
bx2 x2-x7 clear month
sa3 x2+ymdvals
ax3 30
lx3 -18-18
bx6 x3+x6
sa6 a7+b1
eq cpl1b back for next card
* year, month, day table
list g
ymdvals bss 0
year set 73 base year
day set 0 there*s a zero year
dup 32,5
day decmic day,2
year decmic year,2
vfd 30/3r/"day",30/3r "year"
year set year+1
day set day+1
list *
*deck compass
*edit compass
*ident cerlwrt
*/ fixes l=0 problem for small outputs
*delete cps009.5,cmp30.2319
mi x1,cmp6a if anything was writen
zr x4,cmp7 if buffer is empty
write e process buffer
cmp6a writer e,recall
*insert cmp042.235
sa1 zmsg transfer warning message
sa2 a1+b1
sa3 a2+b1
sa4 a3+b1
bx6 x1
sa6 line
bx7 x2
sa7 a6+b1
bx6 x3
bx7 x4
sa6 a7+b1
sa7 a6+b1
rj listerf list message
*/ end mod
*ident cerlcst
*deck compass
*/ modifications for common symbols text options
*/ cst permanent tables and xtext tables
*insert cmp30.18
*
* c system common text from file *csystxt*
* c=0 no common text
* c=fname common systems test from file *fname*
*insert compass.68
* c=0
*i f4810a.275
vfd 12/0lc,18/optc,30/csystxt
*i f4810a.297
optc data 0lcsystxt
*insert compass.629
lsysmic data 0 length of system micros
csystxt data 0 special common systems text
*insert compass.656
csyname data 0 special name if given
*insert compass.783
q error (see listing for comment.)
x error (macro purged and redefined)
y error (duplicate common block definition ignored.)
z error (system common blocks redefined.)
*insert compass.1024
csyms space 4
*** csyms - table of common system symbols
*
* contains information necessary to define
* common blocks and their associated symbols
*
*
* format of table
*
* word1 - length of absolute symbol definitions
* word2 - first symbol
* word3 - value
* ***
* word i - length of first common block information
* word i+1 - common block name
* word i+2 - 30/length,30/params
* word i+3 - first symbol
* word i+4 - value
* ***
* word n-1 - last symbol of last block
* word n - value of last symbol
csyms table
cysdef space 4
*** common symbols macro text table
*
* see macdef for format
cysdef table
cysmac space 4
*** cysmac - table of macro names for common symbols text
*
* format of entry
*
* word 1 - macro name
* word 2 - macro definition (lower 18 bits bias into cysdef)
cysmac table
cysmic space 4
*** cysmic - table of micro definitions for common symbols text
*
* see sysmic for format
cysmic table
*insert compass.13957
bx6 x3 save length of mictab
sa6 lsysmic
*insert compass.6405
*** cmtext - generate special common systems text
*
*
*csystext cmtext
*
* similar to stext but generates texts useful for
* relocatable programs
qual pass1
cmtext sa1 absfg error if absolute assembly
nz x1,ctx3
sa1 csystxt check if cst option available
nz x1,ctx3 error if envoked
sa1 locsym test formats
sa2 badloc
zr x2,ctx1
mx1 0 force ident name
sx6 b1
sa6 lerr bad name
sa6 eflg
ctx1 nz x1,ctx2 check name given
sa1 idnam otherwise use ident name
ctx2 rj ljust
sa7 csyname
mx6 0 clear out cst function
sa6 l.csyms
eq ctl70
ctx3 sx6 b1
sa6 oerr
sa6 eflg
eq ctl70
** cmtext - generate common system text
qual pass2
cmtext sx6 0 clear name
sa6 csyname
eq zlist
space 4
*insert compass.6711
cst space 4
*** cst - common symbols table
*
*
* cst
* defines system common symbols
* as if they were defined by the routine
qual pass1
cst sa1 absfg not available to absolute assembles
nz x1,cst2
sa1 locsym test blank loc symbol
rj ljust left jusify symbol
sa2 badloc
zr x2,cst1 symbol ok
sx6 b1
sa6 lerr
sa6 eflg
cst1 sa2 csystxt check same or change text
nz x7,cst3 defining new text
nz x2,cst4
cst2 sx6 b1 no text mark error
sa6 oerr
sa6 eflg
eq ctl70
cst3 sa7 csystxt plant text name
zr x2,cst4 no previous text
bx6 x7-x2
zr x6,cst4 same as previous
sx6 b1 mark redefined
mx7 0
sa6 zerr
sa6 eflg
sa7 l.csyms cancel previous symbols
cst4 rj ldc
rj cmac define macros
rj cmic define micros
cst5 mx6 0
sa6 p1tempa set to block 0 for absolutes
sa6 p1temp
rj xdef define externals
sa1 p1temp set length for absolutes
sx6 x1+b1
sa6 a1
sa2 o.csyms
sb7 x2
sa2 x1+b7
bx6 x2
sa6 p1tempb set length
rj cdef define symbols
cst6 sa1 l.csyms end test
sa2 p1temp bias to next item
ix6 x1-x2
zr x6,ctl70 --- exit
rj cuse process use
rj cdef define symbols
eq cst6
* cdef define common symbols
cdef ps return exit
cdef1 sa1 p1temp
sa2 p1tempb
zr x2,cdef -- exit
sx6 x1+2 bump bias
sx7 x2-2 bump length
sa6 a1
sa7 a2
sa3 o.csyms get item
sb2 x3
sa1 x1+b2 fetch symbol
sa2 a1+b1 fetch value
sa3 p1tempa fetch reloc
mx4 0 not external
sx5 2 mark symbol as xtext
rj ydefsym
eq cdef1 loop to next entry
** define macros associated with common systems text
cmac ps return exit
sa1 l.cysmac process names
zr x1,cmac no defs
sa2 optype
bx6 x2
sa6 p1tempd save optype
mx6 0
sa6 l.duptab
manage duptab,x1 transfer to temp table for processing
sx1 x3+ length to x1
sa2 o.cysmac
sa3 o.duptab
rj move
sa3 l.macdef present table length
zr x3,cmac2
sa4 o.duptab set up to bias macro entries
sa5 l.duptab
sb7 x5
sb4 x4+b1 set to table pointer word
sb4 b4+b7
sb2 b1+b1 b2=2
cmac1 sa1 b4-b7
ix6 x1+x3
sa6 a1
sb7 b7-b2
nz b7,cmac1
cmac2 sa1 l.cysdef transfer macro text
manage macdef,x1
sa1 l.cysdef
ix3 x2+x3 determine first word for new text
ix3 x3-x1
sa2 o.cysdef
rj move move text
* enter names into opcode table
cmac3 sa4 o.duptab
sa1 x4+ get name
rj tluop test in table
zr x6,cmac4 sense no entry
sa4 o.duptab pick name to purge
sa1 x4+
rj pgo purge entry for this assembly
sx6 1
sa6 xerr and mark
cmac4 sa4 o.duptab
sa1 x4 get name
sa2 a1+b1 and definition
rj entop
sa4 o.duptab
sa5 l.duptab
sx6 x4+2
sx7 x5-2
sa6 a4
sa7 a5
nz x7,cmac3 loop
sa1 p1tempd restore op type
bx6 x1
sa6 optype
eq cmac -- exit
** enter common symbols micros
cmic ps return exit
sa1 l.cysmic move micros
zr x1,cmic if no defs
manage mictab,x1
sa1 l.cysmic prepare to move defs
ix3 x2+x3
ix3 x3-x1
sa2 o.cysmic
rj move
eq cmic
* cuse set up use table entry for cst
cuse ps return exit
sa1 p1temp bias to length
sx6 x1+3 set bias to first symbol
sa2 o.csyms get length
sb2 x2
sa1 x1+b2
sx7 x1-2 adjust length for defining
sa6 p1temp
sa7 p1tempb
sa4 a1+b1 get use name
sb3 b0 use counter
sb2 b1+b1 b2=2
sb6 -4
sa1 o.usetab check prior existance
sa2 l.usetab
sa3 ui
ix1 x1+x3
ix2 x2-x3
sb7 x2+b6
sb4 x1+b7 lwa + 1
cuse1 ng b7,cuse2 sense not in list
sa1 b4-b7 fetch block name
sb7 b7+b6
sb3 b3+b1 block counter
bx1 x1-x4
nz x1,cuse1 loop to next block
sa2 a1+b2 check block type
zr x2,cuse1 sense program block, not common
sx6 b1 mark error
sa6 yerr mark non fattle error
sa6 eflg mark it
sa1 p1tempb adjust bias and table length
sa2 p1temp to ignor block entries
ix6 x1+x2
sa6 a2
mx7 0
sa7 a1 clear block entries
eq cuse --exit
cuse2 sx6 b3 save index
sa6 p1tempc
manage usetab,-b6 reserve table space
sa4 p1temp get name back
sa5 o.csyms
sb2 x4-2
sa4 x5+b2
sb7 x3-4
sa5 a4+b1 fetch block params
mx0 30
bx7 -x0*x5
lx6 x4
sa6 x2+b7 plant name
sa7 a6+b1 and some params
sx6 b1 mark commonality
bx7 x0*x5
ax7 30
sa6 a7+b1 commonality
sa7 a6+b1 and present length
sa1 ui+1 set up block number
sa2 p1tempc
ix6 x1+x2
sa6 p1tempa
sa6 usecnt
sa6 ui+2 update use block count
eq cuse -- exit
xdef space 4
** enter cst externals into tables
xdef ps return exit
mx1 0 set blank qualifier
rj sqv
sa1 p1temp
sa2 o.csyms get length of primatives
sb2 x2
sx6 x1+b1 increment table pointer
sa6 a1
sa1 x1+b2
bx6 x1 length of primatives
sa6 p1tempb
* define primatives
xdef1 sa1 p1temp increment relative pointers
sa2 p1tempb
sx6 x1+1
sx7 x2-1
ng x7,xdef4 now define sysmbols
sa6 a1
sa7 a2
sa3 o.csyms get primative
sb2 x3
sa1 x1+b2
bx6 x1
sa6 p1tempc save primative
rj tlusymt look up symbol
lx2 59-31
ng x2,xdef2 if external
lx2 1
ng x2,xdef3 if defined
manage extab,1 add symbol to ext table
sb7 x3-1
sa1 p1tempc
bx6 x1
sa6 x2+b7 plant name
bx4 x3 external number
sx5 2 mark symbol as xtext
mx2 0 value = 0
sx3 b0 relocation
rj ydefsym define it
eq xdef1
xdef2 rx4 x3 get equivalent
mx0 -21
bx2 -x0*x4
nz x2,xdef3 not a primative.. error
ax4 21 get ext number
mx0 -9
bx4 -x0*x4
sb7 x4-1 true relative position
sa3 o.extab
sa4 x3+b7 get symbol
bx3 x4-x1
zr x3,xdef1 if definition ok
xdef3 sx6 1 mark d error
sa6 eflg
sa6 derr
eq xdef1
* define biased external symbols
xdef4 sa1 p1temp fetch length of ext symbols
sx6 x1+b1
sa6 a1
sa2 o.csyms
sb2 x2
sa2 x1+b2 length
bx6 x2
sa6 p1tempb plant length
xdef5 sa1 p1temp increment table pointers
sa2 p1tempb
sx6 x1+3
sx7 x2-3
ng x7,xdef8 end of table test
sa6 a1
sa7 a2
sa3 o.csyms get entry
sb7 x3
sa1 x1+b7 symbol
sa2 a1+b1 equivalent
sa3 a2+b1 and primative
bx6 x1
bx7 x2
sa6 p1tempc and save them
sa7 p1tempd
bx6 x3
sa6 p1tempe
rj tlusymt look up symbol
lx2 59-31
ng x2,xdef6 if external
lx2 1
ng x2,xdef7 if defined
sa1 p1tempe get primative
rj tlusymt look up symbol
rx4 x3 fetch equiv
mx0 -9
ax4 21 get external number
bx4 -x0*x4
sa1 p1tempc symbol
sa2 p1tempd
mx0 -21
bx2 -x0*x2
sx3 b0 relocation
sx5 2 mark symbol as xtext
rj ydefsym
eq xdef5
xdef6 rx4 x3 fetch equiv
mx0 -21
bx3 -x0*x4
sa2 p1tempd compare with value and ext
bx5 -x0*x2
ix6 x5-x3
nz x6,xdef7 if not same value
ax4 21
mx0 -9
bx4 -x0*x4
sb7 x4-1
sa2 o.extab get external symbol
sa2 x2+b7
sa1 p1tempe
bx6 x1-x2
zr x6,xdef5 if same definition
xdef7 sx6 1 mark duplicate def
sa6 eflg
sa6 derr
eq xdef5
xdef8 sa1 qval+1 reset qualification
bx6 x1
sa6 a1-b1
eq xdef exit
** cst - activate common symbols
qual pass2
cst sx6 0
sa6 p2temp set up to enter externals
rj xdef
eq zlist
cst space 4
** enter cst externals into entref
xdef ps return exit
mx1 0
rj sqv set to blank qualifier
sa1 p2temp increment csyms pointer
sx6 x1+b1
sa6 a1
sa2 o.csyms get length of external table
sb7 x2
sa1 x1+b7 fetch length
bx6 x1
sa6 p2tempa
xdef1 sa1 p2temp increment pointers
sa2 p2tempa
sx6 x1+1
sx7 x2-1
ng x7,xdef2 endtest
sa6 a1
sa7 a2
sb7 x1
sa1 o.csyms get symbol
sa1 x1+b7
rj tlusymt look up symbol
zr x3,xdef1 if not defined
sx1 1rx
rj entref enter item
eq xdef1
xdef2 sa1 qval+1 restore qualifier
bx7 x1
sa7 a1-b1
eq xdef exit
*insert compass.7490
rj gcs
*insert compass.12768
gcs space 4
** get common symbols system text
gcs ps return exit
sa1 csyname check for common systems text required
zr x1,gcs no
sx6 a0 save a0
sa6 p1temp
recall x
sa1 csyname
sx6 1
bx6 x1+x6
sa6 x set up name file
sa2 ercnt
nz x2,gcs3 no text if errors
sa4 date generate ident table
bx6 x1
lx7 x4
sa6 dpba+1
sa7 a6+b1
rewind x
recall x
writew x,dpba,17b
writew x,(=50000101bs36),1
sa1 l.usetab reserve space
sa2 l.symtab
ax1 1
ix1 x1+x2
sa2 l.extab external table length
ix1 x1+x2
manage duptab,x1+b1
sa3 o.duptab set up store
sx3 x3+2 set destination for move
sa1 l.extab length of move
sa2 o.extab origin
bx6 x1 plant table length
sa6 x3-1 length at beginning
rj move move externals
sa1 l.extab set up a7
sa2 o.duptab
sb7 x1+2
sa7 x2+b7
sb6 a7 save begining table address
rj dfs dump externals
sx6 a7-b6
sa6 b6 plant length of external table
sa7 a7+b1 for absolute symbol length
sa5 =16777bs21 surpress ext etc.
sb5 b0 set up to dump abs syms
sb6 a7 save beginning loc
rj dbs
sx6 a7-b6
sa6 b6
rj fcb get common symbols
sa1 o.duptab mark total length
sb6 x1
sx6 a7-b6
sa6 b6
writew x,b6,x6+b1 write out symbols
sx6 b0
sa6 l.duptab clear work table
sa1 l.macdef transfer macros
sa5 lsysmac only program macros
ix6 x1-x5
sa6 p1temp write length
writew x,a6,b1
sa1 o.macdef
sa2 p1temp
ix6 x1+x5
writew x,x6,x2
* transfer micro table
sa1 l.mictab
sa5 lsysmic length of system micros
ix6 x1-x5 length of programer micros
sa6 p1temp write length
writew x,a6,1
sa1 o.mictab
sa5 lsysmic
ix1 x1+x5 origin of programmer micros
sa3 p1temp
zr x3,gcs0 if no micros
writew x2,x1,x3
* transfer opcodes to duptab
gcs0 sa1 l.optab
manage duptab,x1+b1
sb6 x2
sb7 x3-1
mx1 1
sa4 o.optab
sa7 x2
sb4 x4+b7 lwa + 1
sa5 lsysmac
mx0 12
lx1 -2
sb2 b1+b1 b2=2
sb5 57
sb4 b4+b1
* scan optab and transfer macro names
gcs1 zr b7,gcs2 if end of operation table
sa2 b4-b7
sb7 b7-b2
ax6 x2,b5
bx7 x1+x6
nz x7,gcs1 sense no program macro
sa3 a2-b1 fetch name
bx6 -x0*x3 clean up
ix7 x2-x5
lx2 12
ng x2,gcs1 if opsyn
sa6 a7+b1
sa7 a6+b1
nz b7,gcs1 if not end of operation table
gcs2 sx6 a7-b6 length of macro names
sa6 b6
writew x,b6,x6+b1
sx6 b0
sa6 l.duptab clear work table
gcs3 writer x,r
recall x
sa1 p1temp
sa0 x1
mx6 0 clear option
sa6 csyname
eq gcs -- exit
fcb space 4
** find common blocks and dump symbols
fcb ps return exit
sa1 ui set up scan
sa2 o.usetab
ix2 x1+x2
sa0 x2-4
sb3 b0
fcb1 sa1 o.usetab set up end test
sa2 l.usetab
sb7 x1
sb7 x2+b7 lwa + 1
sb2 2
sb6 4
fcb2 sa0 a0+b6 bump to next use
sb4 a0 set up end test
ge b4,b7,fcb -- exit
sa1 a0+b2 get common word
sb3 b3+b1 bump block number
zr x1,fcb2 sense no common block
fcb3 sa1 a0 get block name
sa2 a1+b1 params
sa3 a2+b2 and length
lx3 30
sa7 a7+b1
sb6 a7 save first cell
lx6 x1
bx7 x2+x3
sa6 a7+b1
sa7 a6+b1
sa1 ui+1 construct block number
sb3 b3-b1
sb3 x1+b3
sb5 -b3
sa5 =16000bs21 supress sst, external
rj dbs
sx6 a7-b6 length of table
sa6 b6
eq fcb1 and loop to next block
dbs space 4
* dump all symbols for a given block
* enter with b5 set to negative of block
* and x5 symbol supression mask
*
* uses a - 1,2,3,4,6,7
* b - 1,2,4,5,7
* x - 0,1,2,3,4,5,6,7
dbs ps return exit
sa1 o.symtab get symbol table parameters
sa2 l.symtab
sb7 x2
sb4 x1+b7 lwa + 1
sb2 b1+b1 b2=2
mx0 12 qual mask
mx1 -21 value mask
mx2 -9 block mask
dbs1 zr b7,dbs -- exit
sa3 b4-b7 fetch symbol
sb7 b7-b2
zr x3,dbs1 symbol vacuous
sa4 a3+b1 get value
bx6 x0*x3
nz x6,dbs1 sense qualified symbol
bx6 x3
ax3 36
sx3 x3-2r'?
zr x3,dbs1 sense local symbol
bx3 x4*x5
nz x3,dbs1 sense symbol supression (external etc.)
bx7 -x1*x4 fetch value
ax4 21 position block
bx4 -x2*x4
sx4 x4+b5
nz x4,dbs1 block test
sa6 a7+b1 plant symbol
sa7 a6+b1 and value
eq dbs1
dfs space 4
** dump external sysmbols for cst
dfs ps return exit
sa1 o.symtab fetch symbol table params
sa2 l.symtab
sb7 x2
sb4 x1+b7 lwa + 1
sb2 b1+b1 b2=2
mx1 -21 value mask
mx2 -9 primative mask
dfs1 zr b7,dfs end test
sa3 b4-b7 fetch symbol
sb7 b7-b2
zr x3,dfs1 if vacuous
sa4 a3+b1 fetch equivalent
bx7 x4
lx4 59-31 check exteranal bit
pl x4,dfs1 if not external
bx4 x7
ax4 21 get exteranl number
bx4 -x2*x4
sb3 x4-1 true relative position in talbe
sa5 o.extab
sa5 x5+b3
bx0 x3-x5
zr x0,dfs1 if primative definition
bx6 x3 symbol
bx7 -x1*x7 value
sa6 a7+b1
sa7 a6+b1
bx7 x5 primative symbol
sa7 a7+b1
eq dfs1
ldc space 4
*** load common systems text
ldc ps return exit
sa1 csystxt check option active
zr x1,ldc
sa1 l.csyms no defs
nz x1,ldc ignor
rj lct load common systems text
nz x0,cys2 note error
sa1 o.memory verify text format
sa2 o.endtab
ix2 x2-x1
sa3 x1+b1 fetch symbol table length
sb6 x3+b1 bias to next table
sb7 x2-10b maximum length
ax3 18
ge b6,b7,cys2 if bad
ng b6,cys2 if bad text
nz x3,cys2
sa4 a3+b6 fetch macdef length
sb3 x4+b1
ax4 18
sb6 b3+b6
ng b3,cys2
ge b6,b7,cys2
nz x3,cys2
sa4 a3+b6 fetch micro length
sb3 x4+b1
ax4 18
sb6 b3+b6 total length to here
ng b3,cys2
ge b6,b7,cys2
nz x4,cys2
sa4 a3+b6 fetch macro name length
sb3 x4+b1
ax4 18
sb6 b3+b6
nz x4,cys2
ng b3,cys2
ge b6,b7,cys2
sx6 b6+b1 set memory length
sa6 l.memory
rj cstcm load cm
eq ldc --exit
cys2 message (=c* bad commons text.*)
eq ldc
cstcm space 4
*** cstcm - load cst tables into central memory
*
cstcm ps return exit
sa1 o.memory
sa1 x1+b1 fetch symbol table length
mx6 0
sa6 l.csyms zero table length
manage csyms,x1
sa4 o.memory adjust tables
sa5 l.memory
sa1 x4+b1
sx6 x1+2
ix7 x5-x6 new length
ix6 x4+x6 new origin
sa6 a4
sa7 a5
sx2 x4+2 symbols origin
sa3 o.csyms
rj move
sa2 o.memory
sa1 x2 get length of macro defs
mx6 0
sa6 l.cysdef set length to zero
manage cysdef,x1 get room for defs
sa4 o.memory and transfer them
sa1 x4 length
ix3 x2+x3 origin calc
ix3 x3-x1 origin in table
sx2 x4+b1
rj move
sa4 o.memory update memory table
sa5 l.memory
sa1 x4
sx6 x1+b1
ix7 x5-x6 change length
ix6 x4+x6 and origin
sa6 a4
sa7 a5
sa1 x6 get cysmic length
mx6 0
sa6 l.cysmic set length to zero
manage cysmic,x1
sa4 o.memory and transfer to table
sa1 x4
ix3 x2+x3
ix3 x3-x1
sx2 x4+b1
rj move
sa4 o.memory
sa5 l.memory
sa1 x4
sx6 x1+b1 bump to macro names
ix7 x5-x6
ix6 x4+x6
sa6 a4
sa7 a5
sa1 x6 get length of macro names
mx6 0
sa6 l.cysmac set length to zero
manage cysmac,x1
sx1 x3
sx3 x2
sa2 o.memory
sx2 x2+b1
rj move
sx6 0 clear temp table
sa6 l.memory
eq cstcm --exit
*** load common systems text
lct ps return exit
recall x use xtext buffer
sa1 csystxt form fet entries
sx6 b1
bx6 x1+x6
sa6 x
rj mtd move tables down to make room
sa1 o.memory
sa2 o.endtab
ix2 x2-x1
sx0 x1 origin
sa0 x2 and length
lct0 rewind x
lct1 read x
lct2 readw x,x0,1 read 7700 table
ng x1,lct if eof
nz x1,lct1 if eor
sa2 x0 check format
lx2 18d
sx6 x2-770000b
zr x6,lct4
lct3 readw x,x0,a0 skip to end of record
zr x1,lgt3 loop
eq lgt1 loop
lct4 lx2 6
sx5 x2 skip table
lct5 readw x,x0,1
sx5 x5-1
nz x5,lct5
readw x,x0,1
nz x1,lct -- error exit
sa1 x0
sa2 =50000101bs36
bx6 x1-x2
ax6 36
nz x6,lct wrong overlay, exit
readw x,x0+b1,a0-b1
zr x1,lct6 if not enough room
sx0 b0
eq lct return
lct6 message lcta,,r
eq lct exit
lcta data c*insufficient storage for cst text.*
*insert cps064.1768
pseudo 4,cmtext
pseudo 4,cst
*/ end mod
}