home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / asmutl / sload.lbr / SLOAD.SQL / SLOAD.SPL
Encoding:
Text File  |  1987-01-24  |  4.4 KB  |  237 lines
  1.     file(2,i,o)
  2.     byte(err,i,gsa,j,val,b,ext,r,n,k,chk,tst[5],max,open)
  3.     word(comd,sadd,curr,w,br,bw,padd,sp,base,top,alc,y)
  4.     byte(inpf[21],outf[21],file[21],dufn[21])
  5.     byte(line[81],stk[64],aloc[0])
  6.  
  7.     tabl(name)
  8.       data('Written: by Harris Landsberg  12/18/86')
  9.       data('for non-profit use only  Revision 1.00')
  10.     endt()
  11.     code('    lxi    h,0')
  12.     code('    dad    sp')
  13.     code('    shld    ysp')
  14.     code('    lxi    sp,ystk+60')
  15.     code('    lhld    6')
  16.     code('    lxi    d,-3200')
  17.     code('    dad    d')
  18.     code('    shld    ytop')
  19.     addr(aloc,base)
  20.     movw(81H,comd)
  21.     whil(&comd,le,' ')
  22.       cond(&comd,eq,0)    jump(nofile)
  23.       inrw(comd)
  24.     endl()
  25.     asgn(0,i,j,k,ext,open)
  26.     whil(&comd,gt,' ')
  27.       asgn(&comd,inpf[i],file[j],dufn[k])
  28.       case(&comd)
  29.         when(':')    asgn(0FFH,j)
  30.         when('.')    asgn(1,ext)    asgn(0,file[j],dufn[k])
  31.       endc()
  32.       inrw(comd)    inrb(i,j,k)
  33.     endl()
  34.     asgn(0,inpf[i],file[j],dufn[k])
  35.     cond(ext,eq,0)    scat('.HEX',inpf)
  36.     asgn(0,i,k,ext)
  37.     whil(&comd,le,' ')
  38.       cond(&comd,eq,0)    jump(outfl)
  39.       inrw(comd)
  40.     endl()
  41.     whil(&comd,gt,' ')
  42.       cond(&comd,eq,'.')    asgn(1,ext)
  43.       asgn(&comd,outf[i])
  44.       inrw(comd)      inrb(i)
  45.     endl()
  46.     dcrb(i)
  47.     cond(outf[i],eq,':')    asgn(1,k)
  48.     inrb(i)
  49. $outfl    asgn(0,outf[i])
  50.     cond(i,eq,0)    scpy(dufn,outf)
  51.     cond(k,eq,1)    scat(file,outf)
  52.     cond(ext,eq,0)    scat('.COM',outf)
  53.  
  54.     open(1,inpf,'i')
  55.     ferr(err)
  56.     cond(err,ne,0)
  57.     begn()
  58. $nofile      pstr('SOURCE ')
  59.       call(pfile)
  60.       pstr(' NOT FOUND')
  61.       jump(exit)
  62.     endb()
  63.  
  64.     asgn(0,gsa)
  65.     movw(0,br,bw,padd,sadd,alc)
  66. $readh    rstr(1,line)
  67.     ferr(err)
  68.     cond(err,gt,0)
  69.     begn()
  70.       call(pfile)
  71.       pstr(' READ')
  72.       call(perr)
  73.       jump(exit)
  74.     endb()
  75.     cond(line,ne,':')
  76.     begn()
  77.       call(pinv)
  78.       pstr('RECORD TYPE')
  79.       jump(exit)
  80.     endb()
  81.     smid(line,tst,2,2)    * number of bytes
  82.     call(hexd)
  83.     asgn(b,chk,max)
  84.     addw(br,w,br)
  85.     cond(b,eq,0)    jump(finis)
  86.     smid(line,tst,4,4)    * load address
  87.     call(hexd)
  88.     addb(chk,w[0],chk)
  89.     addb(chk,w[1],chk)
  90.     cond(gsa,eq,0)
  91.     begn()
  92.       movw(w,curr,sadd,padd)
  93.       asgn(1,gsa)
  94.     endb()
  95.     comp(w,lt,curr)
  96.     begn()
  97.       pstr('INVERTED LOAD')
  98.       call(paddr)
  99.       jump(exit)
  100.     endb()
  101. $iscur    comp(curr,ne,w)
  102.     begn()
  103.       asgn(0,b)
  104.       call(load)
  105.       inrw(curr)
  106.       jump(iscur)
  107.     endb()
  108.     smid(line,tst,8,2)    * Unused
  109.     call(hexd)
  110.     addb(chk,b,chk)
  111.     asgn(10,n)
  112.     forb(r,1,max)        * Bytes
  113.       smid(line,tst,n,2)
  114.       call(hexd)
  115.       addb(chk,b,chk)
  116.       call(load)
  117.       addb(n,2,n)
  118.     next()
  119.     smid(line,tst,n,2)    * checksum
  120.     call(hexd)
  121.     addb(chk,b,chk)
  122.     cond(chk,ne,0)
  123.     begn()
  124.       pstr('CHECK SUM')
  125.       call(perr)
  126.       jump(atit)
  127.     endb()
  128.     btow(max,w)
  129.     addw(curr,w,curr)
  130.     subw(curr,1,padd)
  131.     jump(readh)
  132.  
  133. $load    * load into .COM file
  134.     asgn(b,&base)
  135.     inrw(alc,base,bw)
  136.     comp(base,gt,top)
  137.     begn()
  138. $write      cond(open,eq,0)    call(opout)
  139.       addr(aloc,base)
  140.       forw(y,1,alc)
  141.         wchr(2,&base)
  142.         ferr(err)
  143.         cond(err,ne,0)
  144.         begn()
  145.           call(pfile)
  146.           pstr(' WRITE')
  147.           call(perr)
  148.           jump(exit)
  149.         endb()
  150.         inrw(base)
  151.       next()
  152.       addr(aloc,base)
  153.       movw(0,alc)
  154.     endb()
  155.     retn()
  156.  
  157. $finis    * Finish Off work
  158.     call(write)
  159.     loop(128)
  160.       wchr(2,0)
  161.     enlp()
  162.     code('    lxi    h,xfcb+37')
  163.     code('    mvi    c,16')
  164.     code('    call    xuusr')
  165.     code('    inr    a')
  166.     code('    sta    yerr')
  167.     cond(err,eq,0)
  168.     begn()
  169.       call(pcann)
  170.       pstr('CLOSE ')
  171.       call(pfile)
  172.       jump(exit)
  173.     endb()
  174.     prln()
  175.     chex(sadd,file)
  176.     zfil(file,tst,4)
  177.     pstr('START')    call(paddr)
  178.     chex(padd,file)
  179.     zfil(file,tst,4)
  180.     pstr('LAST ')    call(paddr)
  181.     chex(br,file)
  182.     zfil(file,tst,4)
  183.     pstr('BYTES READ    ',)        call(ptst)
  184.     divw(bw,128,w)
  185.     modw(bw,128,bw)
  186.     comp(bw,ne,0)    inrw(w)
  187.     chex(w,file)
  188.     zfil(file,tst,2)
  189.     pstr('RECORDS WRITTEN ')    call(ptst)
  190. $exit    code('    lhld    ysp')
  191.     code('    sphl')
  192.     retn()
  193.  
  194. $opout    open(2,outf,'o')
  195.     ferr(err)
  196.     cond(err,ne,0)
  197.     begn()
  198.       call(pcann)
  199.       pstr('CREATE ')
  200.       call(pfile)
  201.       jump(exit)
  202.     endb()
  203.     asgn(1,open)
  204.     retn()
  205.  
  206. $hexd    * Test Digit for validity
  207.     asgn(0,val,i)
  208.     whil(tst[i],ne,0)
  209.       asgn(tst[i],j)
  210.       inrb(i)
  211.       cond(j,ge,'0')
  212.         cond(j,le,'9')    cont()
  213.       cond(j,ge,'A')
  214.         cond(j,le,'F')    cont()
  215.       asgn(1,val)
  216.       extl()
  217.     endl()
  218.     cond(val,eq,0)
  219.     begn()
  220.       shex(tst,w)
  221.       wtob(w,b)
  222.       retn()
  223.     endb()
  224.     call(pinv)
  225.     pstr('HEX DIGIT')
  226. $atit    chex(curr,file)
  227.     zfil(file,tst,4)
  228.     pstr(' AT ',tst)
  229.     jump(exit)
  230. $pfile    pstr('FILE')    retn()
  231. $perr    pstr(' ERROR')    retn()
  232. $pinv    pstr('INVALID ')    retn()
  233. $pcann    pstr('CANNOT ')    retn()
  234. $paddr    pstr(' ADDRESS ')
  235. $ptst    pstr(tst)    prln()    retn()
  236. OR')    retn()
  237. $pinv    pstr('INVALID