🚀 go-pugleaf

---------------------------------------------------------------------------

    Utility CHECK provides a way to find the length of a file (in bytes,
and in lines for text files), and sorting out different versions of files 
(by comparing their CRC's).
    There are two files, CHECK.ACT and CRC.ACT. CRC shows a progression from
a straight Action version, updCRCa, to a machine language version updCRCx
of updCRCa, to a straight Action version that uses a table but is fastest.
    If you compile and write and executable file to be run without recompiling,
consider removing the ; from SET $491... so it will not run on top of
something else. If you have the run-time libraries SYSLIB and SYSIO, remove
the ; from those INCLUDEs to make an executable file that doesn't need the
Action cartridge to run.
    At least with DOS XL, CHECK can be re-run without re-reading it off disk
by just typing 'RUN'. This is the purpose of 'Entry'.
    Other features useful in other programs include:
        fast disk read
        error handling
        fixing up the DOS file name (force upper case, prefix D: if needed)
        locating the buffer
        run-time library does not set device=0; do it yourself in case.

----------------------------------------------------------------------
    Bruce Langdon  L-472                langdon%lll-lcc@lll-crg.ARPA
    Physics Department                  "langdon#bruce%d"@lll-mfe.ARPA
    Lawrence Livermore National Laboratory       
    Livermore, CA 94550                 (415) 422-5444
UUCP: ..{gymble,ihnp4,seismo}!lll-crg!lll-lcc!langdon
---------------------------------------------------------------------------

; CHECK 8/17/85-12/21, A. B. Langdon

; Determine length, CRC and checksum of file.
; Also number of lines, for text file.

;SET $491=$4000 SET 14=$491^
BYTE JMP=[$4C]: CARD Entry
;INCLUDE "D:SYSLIB.ACT"
;INCLUDE "D:SYSIO.ACT"

; Using channel 1, Close caused "system error" with DOS 2.1 but not DOS XL.
; ACS bbs has a block read (BLKIO.ACT) in machine code segments that is
; smaller and has a general purpose call to CIO. Here, I'll leave mine
; as it illustrates use of the language and is just as fast.

; First global ARRAY, other than BYTE ARRAY of length less than 257,
; is placed AFTER rest of program (undocumented?).
BYTE ARRAY buffer(257)   ; locate the buffer.

CARD FLen, ; File length up to 64K
     i, CSum, NLines
BYTE OpOK, CSum0=CSum, CSum1=CSum+1, text

BYTE CIO_status ; global for CIO return value (per ACS convention)

INCLUDE "CRC.ACT"

CARD FUNC GetAD(BYTE chan CARD addr, len) ; Block read
  TYPE IOCB=[BYTE hid,dno,com,sta
             CARD badr,put,blen
             BYTE aux1,aux2,aux3,aux4,aux5,aux6]
  IOCB POINTER ic
  BYTE chan16
  BYTE POINTER b
  chan16 = (chan&$07) LSH 4
  ic = $340+chan16
  ic.com = 7 ; read
  ic.blen = len
  ic.badr = addr
  [$AE chan16 $20 $E456 $8C CIO_status] ; LDX chan, JSR CIO; STY CIO_status
  FLen ==+ ic.blen  ; this to RETURN is special to this application.
  IF CIO_status = $88 THEN
    EOF(chan)=1
    IF (FLen&$FF) = 0 THEN ; likely last sector of
      b = addr+ic.blen-1      ; a DOS 4 file.
      WHILE b^ = 0 DO
        b ==- 1
        ic.blen ==- 1
        FLen == -1
      OD
    FI
  FI
  b = addr
  FOR i = 1 TO ic.blen DO
    IF b^ = $9B THEN NLines ==+ 1 FI
    CSum0 ==+ b^
    CSum1 ==+ CSum0
    updCRC(b^)
    b ==+ 1
  OD
RETURN (ic.blen)

CARD FUNC GetCD(BYTE chan) ; Read a word
  CARD c
  GetAD(chan,@c,2)
RETURN (c)

PROC FixFlSp(BYTE ARRAY FileSpec)
  IF FileSpec(2)<>': AND FileSpec(3)<>': THEN ; prefix "D:" to file name
    FileSpec^==+2
    i=FileSpec^
    WHILE i>2 DO
      FileSpec(i)=FileSpec(i-2)
      i==-1
    OD
    FileSpec(1)='D  FileSpec(2)=':
  FI
; Could also convert to upper case: if >$60 then subtract $20.
RETURN

PROC SysErr(BYTE errno)

PROC MyError(BYTE errno)
  IF errno=$80 THEN Error=SysErr Error(errno) FI ; break quits
  PrintF("error %I. Try again%E",errno)
  OpOK=0
RETURN

PROC End=*() [$68$AA$68$CD$2E8$90$5$CD$2E6$90$F3 $48$8A$48$60]
; entry: PLA; TAX; PLA; CMP MEMLO+1; BCC lab; CMP MEMTOP+1; BCC entry;
; lab: PHA; TXA; PHA; RTS
; Trace back thru RTS's and return to cartridge or DOS.
; From ACS bulletin board.

PROC CHECK()
  CHAR ARRAY FileSpec(20)
  BYTE b, SHFLOK=$2BE
  CARD fwa, lwa, BufLen, MEMTOP=$2E5, MEMLO=$2E7
  BufLen=MEMTOP-$80-buffer
  SysErr=Error
  DO
    Print("File Spec=")
    SHFLOK=$40 ; upper case
    InputS(FileSpec)
    IF FileSpec^=0 THEN END() FI
    FixFlSp(FileSpec)
    Close(2)
    OpOK=1 Error=MyError Open(2,FileSpec,4,0)
  UNTIL OpOK OD
  Error=SysErr
  FLen=0 CSum=0 CRC=0 text=1 NLines=0

; With DOS 4, this artifice ensures 
; that each GetAD reads one byte into
; next sector, to anticipate EOF.
  BufLen ==& $FF00
  GetAD(2,buffer,1)
  IF buffer(0) = $FF THEN text=0 FI

  WHILE EOF(2) = 0 DO
    GetAD(2,buffer,BufLen)
  OD
  updCRC(0) updCRC(0)
  PrintF("End of file. %H bytes%E",FLen)
  PrintF(" checksum=%H, CRC=%H%E",CSum,CRC)
  IF text THEN
    PrintF("%I lines%E",NLines)
  FI
  Close(2)
RETURN

PROC Main()
  device=0 ; in case MAC/65 has been here

  SetupCRC()

  DO
    CHECK()
    PrintE(" (RETURN to end)")
  OD
RETURN

SET Entry=Main
---------------------------------------------------------------------------

MODULE; CRC.ACT    12/21/85 A. B. Langdon
;  Before use, do SetupCRC().
;  For each data set, first set global CRC=0.
;  After calling updCRC(data) with all
; data bytes, do updCRC(0) twice.
;  If CRCx is the CRC of a byte string,
; then the CRC of that string, followed by
; the hi and lo bytes of CRCx, is zero.

CARD CRC: BYTE CRCl=CRC, CRCh=CRC+1
CARD ARRAY CRCtable(256)

;PROC updCRCa(BYTE b) ; Action version
;  From C code by D. Krantz,
; Dr. Dobb's Journal, June 1985.
; Takes 99 jiffies for 2000 bytes.
; BYTE i
; CARD flag
; FOR i=0 TO 7 DO
;   flag = CRC&$8000
;   CRC ==LSH 1
;   IF b&$80 THEN CRC ==% 1 FI
;   IF flag THEN CRC ==XOR $1021 FI
;   b ==LSH 1
; OD
;RETURN

PROC updCRC(BYTE b)
; Adaptation to this CRC of the algorithm
; by W.D.Schwaderer, PC Tech Journal, 4/85.
; Takes 14 jiffies for 2000 bytes.
  CARD tem
  BYTE teml=tem, temh=tem+1
  teml = b
  temh = CRCl
  CRC = tem XOR CRCtable(CRCh)
RETURN

PROC updCRCx=*(BYTE b)
; Machine language for Dr. Dobb's routine.
; Takes 35 jiffies for 2000 bytes.
  [$85$A0]            ; STA $A0
  [$A2$8]             ; loop over 8 bits
  [$26$A0]            ; 3 byte shift of data
  [$2E CRC $2E CRC+1]          ; and CRC
  [$90$10 $AD CRC $49$21 $8D CRC] ; if carry, then XOR
  [$AD CRC+1 $49$10 $8D CRC+1] ; poly bits
  [$CA $D0$E3]        ; loop
RETURN

PROC SetupCRC()
  FOR i=0 TO $FF DO ; set up CRC table
    CRCl=0 CRCh=i
    updCRCx(0)
    CRCtable(i)=CRC
  OD                ; <0.1 sec.
RETURN

MODULE; end CRC
---------------------------------------------------------------------------