{ PICSKMS.INC - Pascal Integrated Communications System - Miscellaneous routines } { 6/4/87 Ver. 1.6 Copyright 1987 by Les Archambault } (* function test_bit(var num;bit_num:integer):boolean; var subject:integer absolute num; dummy:integer; begin dummy:=subject; dummy:=dummy shr bit_num; if odd(dummy) then test_bit:=true else test_bit:=false; end; *) function test_bit(var num;bit_num:integer):boolean; var subject:integer absolute num; begin test_bit:=odd(subject shr bit_num); end; procedure FindSect(req: FileName; var Drive, User: integer; var found: boolean); { Find file section from requested name } var this: SectPtr; conf_num:integer; begin this := SectBase; while (req <> this^.SectName) and (this <> nil) do this := this^.next; conf_num:=this^.sectconf; found := ((req = this^.SectName) and (cold or (user_rec.access >= this^.SectAccs) or test_bit(user_rec.conf_flags,conf_num))); if found then begin Drive := this^.SectDrive; User := this^.SectUser end end; function min(x, y: integer): integer; { Return minimum of two integers } begin if x < y then min := x else min := y end; function max(x, y: integer): integer; { Return greater of two integers } begin if x > y then max := x else max := y end; function trim(st: StrStd): StrStd; { Remove leading and trailing blanks } var i, j: integer; begin i := 1; j := length(st); while (st[i] = ' ') and (i <= j) do i := succ(i); while (st[j] = ' ') and (j >= i) do j := pred(j); trim := copy(st, i, succ(j - i)) end; function pad(st: StrStd; i: integer): StrStd; { Pad string with spaces to length of i } begin while length(st) < i do st := st + ' '; pad := st end; function intstr(n, w: integer): Str10; { Return a string value (width 'w')for the input integer ('n') } var st: Str10; begin str(n:w, st); intstr := st end; function strint(st: Str10): integer; { Convert string to integer } var x, code: integer; begin if st[1] = '+' then delete(st, 1, 1); if st = '' then code := 1 else val(st, x, code); if code = 0 then strint := x else strint := 0 { Error, return with 0 } end; procedure updcrc(var crc: integer; acc: integer); { Update CRC with passed value } begin inline($2A/crc/ { LD HL,(crc) ; point to crc } $5E/ { LD E,(HL) ; put crc into DE } $23/ { INC HL ; } $56/ { LD D,(HL) ; } $EB/ { EX DE,HL ; put it into HL } $ED/$4B/acc/ { LD BC,(acc) ; get acc into C } $06/$08/ { LD B,8 ; shift 8 times } $CB/$01/ { UPDLP: RLC C ; shift input } $ED/$6A/ { ADC HL,HL ; shift crc } $30/$08/ { JR NC,SKIPIT ; jump if no carry} $7C/ { LD A,H ; xor with $1021 } $EE/$10/ { XOR 10H ; use $8005 for } $67/ { LD H,A ; CRC-16 } $7D/ { LD A,L ; } $EE/$21/ { XOR 21H ; } $6F/ { LD L,A ; } $10/$F0/ { SKIPIT: DJNZ UPDLP ; done? } $EB/ { EX DE,HL ; result to DE } $72/ { LD (HL),E ; then into } $2B/ { DEC HL ; into } $73) { LD (HL),D ; memory } end; function unsigned_to_real(u : integer) : real; { convert unsigned integer to real } { note: INT is a function that returns a REAL!!!} begin if u >= 0 then unsigned_to_real := Int(u) else if u = $8000 then unsigned_to_real := 32768.0 else unsigned_to_real := 65536.0 + u end; function long_to_real(l : long) : real; { convert long integer to a real } { note: INT is a function that returns a REAL!!! } var r : real; s : (POS, NEG); const rcon = 65536.0; begin if l.h >= 0 then begin r := Int(l.h) * rcon; s := POS end else begin s := NEG; if l.h = $8000 then r := rcon * rcon else r := Int(-l.h) * rcon end; r := r + unsigned_to_real(l.l); if s = NEG then long_to_real := -r else long_to_real := r end; { end of PICSkms.inc }