User Tools

Site Tools

cmpupd(cm160000,t77770)  -*- mode: update;-*-
*ident    cstc
*deck     compcom
*delete   cps064.2  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
cdc/nos2/job/cmpmods.txt ยท Last modified: 2023/08/05 15:32 by Site Administrator