Command?  read 20

Posted: Fri  Nov 21, 1986   8:52 PM PST              Msg: MGIG-2492-7696
From:   CHHU
To:     chhu
Subj:   to Nick from Baker

  
Dear Nick

     Enclosed is a revised copy of the checksum file. Since you demanded a
refund of all the money you paid for it, I decided to give you a hastily
conceived, ill thought out revision instead. If this does not do the trick,
tough luck, get Paul Hogan to do it instead. Oh well, I guess I'll redo it
if you STILL don't like it, I just need SOMETHING to B_ _ _ _ about.....
Heck if 2^20 isn't enough, what is???????????????

                               John Baker
       LEX    'CKSUMLEX'
*
*      NIBASC '
*      NIBHEX 802E   LEX type
*      CON(2) 0      flags=0
*      NIBHEX 0000   Mn/Hr
*      NIBHEX 000068 Dy/Mo/Yr
*      REL(5) FILEND
*
       TITLE  Checksum generator Ver<861119>, JR Baker
*
       CON(2) #5E    last scratch
       CON(2) #4B    see JRBTOKEN for assignment
       CON(2) #4B
       CON(5) 0      no links
       NIBHEX F      no speed table
       REL(4) (TxTbSt)+1 offset to text table
       CON(4) 0      no message table
       CON(5) 0      no poll handler
*
FUNCR0 EQU #2F89B
FILXQ$ EQU #09B95
eFSPEC EQU #0003A
BSERR  EQU #0939A
FINDF+ EQU #09F63
HDFLT  EQU #1B31B
FNRTN2 EQU #0F219
*
*      MAIN TABLE
*
       CON(3) (TxEn01)-(TxTbSt)
       REL(5) CKSUM             CKSUM(<file specifier>)
       NIBHEX F      a Function, numeric
*
*      TEXT TABLE
*
TxTbSt
TxEn01
       CON(1) (TxEnTm)-(*)-4
       NIBASC 'CKSUM'
       CON(2) #4B    see JRBTOKEN for assignment
TxEnTm
       NIBHEX 1FF    table terminator
*
***********************************************************
**
**    Name: CKSUM
**
** Purpose: does a checksum on an arbitrary file
**
**   Entry: file specifier on mathstack
**
**    Exit: returns 12 form on stack, resumes exp. execute
**
**   Calls: FILXQ$, FINDF+, HDFLT, <FNRTN2>
**
**    Uses: everything available to expressions
**
**  Levels: 7 (FILXQ$)
**
**   Notes: compute checksum starting at chain length field
**          works with any filetype however except for
**          executable files, results can be misleading
**
**          also... for RAM based code which allocates data
**          storage within the file (BSS x), results can
**          be in error, caveat emptor!
**
***********************************************************
*
       NIBHEX 411    mandates 1 string
CKSUM
       CD0EX
       D0=(5) FUNCR0
       DAT0=C A      save pc
       GOSBVL FILXQ$ execute file specifier
       GOC    CKSUM1 continue if specifier good
       LC(4)  eFSPEC else error
bserr
       GOVLNG BSERR
CKSUM1
       CD1EX
       D1=(5) (FUNCR0)+5
       DAT1=C A      save stack pointer
       GOSBVL FINDF+ search for file
       GOC    bserr  error if not found
       AD1EX         else, swap file start to A(A)
       D1=(5) (FUNCR0)+5
       C=DAT1 A
       D1=C          restore stack pointer
       D0=A          point to file start
       D0=D0+ 16
       D0=D0+ 16     step to chain length field
       A=DAT0 A      read file length
       AD0EX
       R0=A          save chain start
       D0=D0- 4      initialise count
       AD0EX
       B=A    A      save count
       A=0    A      initialise checksum
CKSUM2
       C=DAT0 A      read memory
       D0=D0+ 1      step to next nibble
       A=A+C  A      add to sum
       ONC   CKSUM3 jump if no carry
       A=A+1  A      else increment
CKSUM3
       B=B-1  A      decrement count
       ?B#0   A      done ?
       GOYES  CKSUM2 no, loop
       C=R0
       D0=C          restore chain address
       D=C    A
       C=DAT0 A      read chain length
       D=D+C  A      compute end
       D=D-1  A
       D=D-1  A
       D=D-1  A      adjust end to prevent overread
       C=0    A
CKSUM5
       C=DAT0 X      read memory
       A=A+C  A      add to sum
       GONC   CKSUM4 jump if no carry
       A=A+1  A      else increment sum
CKSUM4
       D0=D0+ 3      point to next group
       CD0EX
       ?C>=D  A      done ?
       GOYES  CKSUM6 yes
       CD0EX         no, restore C(A) & D0
       GOTO   CKSUM5 loop
CKSUM6
       GOSBVL HDFLT  convert to 12 form
       SETHEX        restore mode
       C=A    W      copy result to C
       D0=(5) FUNCR0
       A=DAT0 A      read pc
       GOVLNG FNRTN2 exit to expression controller
*
       END