HP3000-L Archives

June 2003, Week 3

HP3000-L@RAVEN.UTC.EDU

Options: Use Monospaced Font
Show Text Part by Default
Show All Mail Headers

Message: [<< First] [< Prev] [Next >] [Last >>]
Topic: [<< First] [< Prev] [Next >] [Last >>]
Author: [<< First] [< Prev] [Next >] [Last >>]

Print Reply
Subject:
From:
Wirt Atmar <[log in to unmask]>
Reply To:
Date:
Mon, 16 Jun 2003 14:37:46 EDT
Content-Type:
text/plain
Parts/Attachments:
text/plain (114 lines)
Bill asks:

> Do any of you know of a way using the original BASIC/3000 (not the Business
>  Basic) of avoiding KSAMUTIL.PUB.SYS and Building (and later purging) a KSAM
>  file?
>
>  I don't think it is (reasonably) possible but thought I would put this to
>  the collective wisdom...

The following code should fill the Bill. It builds and purges both CM and NM
KSAM files, based on the type of machine that the code is currently being run
on:

========================================

5490 REM *************************************************************
 5500 REM
 5510 REM   Create the KSAM file definition
 5520 REM
 5530 REM *************************************************************
 5540 IF F4=0 THEN DO      [F4 = 0   ==> CM KSAM mode]
 5550   SYSTEM Z,"PURGE "+DEB$(N$)  <-- purge existing KSAM file
 5560   SYSTEM Z,"PURGE "+DEB$(N$)+"K"
 5570 DOEND
 5580 K0$[1,255]=" "
 5590 K0$[1,8]=DEB$(N$)+"K"
 5600 K0$[9;4]='0'0'0'0
 5610 K0$[13;8]="DISC"
 5620 K0$[31;2]='0'2
 5630 K1=K0
 5640 IF K1>16 THEN K1=16
 5650 K0$[33;2]='0+CHR$(K1)
 5660 K2=1
 5670 FOR Z=1 TO K1
 5680   IF L0[Z,2]=0 THEN T1=1
 5690   ELSE T1=5
 5700   K0$[35+(Z-1)*8;2]=CHR$(T1*16)+CHR$(L0[Z,1])
 5710   K2=L0[Z,3]
 5720   K0$[37+(Z-1)*8;2]=CHR$(INT(K2/256))+CHR$(K2-INT(K2/256)*256)
 5730   K0$[39+(Z-1)*8;2]='128'4
 5740   K0$[41+(Z-1)*8;2]='0'128
 5750   L0[Z,4]=1
 5760 NEXT Z
 5770 IF F4=0 THEN DO
 5780   IF S5=0 THEN DO   [S5 = size of KSAM to be built, in records]
 5790     S5=ABS(INT(5L8/(F1*F6)))
 5800     IF S5>32 THEN S5=32
 5810     IF S5<1 THEN S5=1
 5820     S5=F1*S5
 5830   DOEND
 5840   IF F[40]=0 THEN DO   [F(40) = 0 --> classic HP3000; 1 --> RISC]
 5850     CALL BUILDKSAM(N$,F5,FNM(2052),FNM(5),F6,K0$,S5,K8)
 5860   DOEND
 5870   ELSE DO
 5880     CALL BUILDKSAM(N$,F5,FNM(6148),FNM(5),F6,K0$,S5,K8)
 5890   DOEND
 5900 DOEND
 5910 ELSE DO
 5920   IF F[40]=0 THEN DO
 5930     CALL BUILDKSAM(N$,F5,FNM(2055),FNM(3),F6,K0$,F1,K8)
 5940   DOEND
 5950   ELSE DO
 5960     CALL BUILDKSAM(N$,F5,FNM(6151),FNM(3),F6,K0$,F1,K8)
 5970   DOEND
 5980 DOEND
 5990 IF K8>0 THEN DO
 6000   CALL FERRORMSG(K8,I2$,K9)
 6010   I2$="BUILDKSAM: "+I2$
 6020   E=411
 6030   GOTO 7930
 6040 DOEND
 6050 REM *************************************************************

========================================

The matching, necessary SPL routine (watch for email-imposed wraps):

========================================

 518     <<******************************************************
  519     *
  520     *   BUILDKSAM
  521     *
  522     *     Routine to build a KSAM database from data supplied
  523     *
  524     ******************************************************>>
  525     PROCEDURE
BUILDKSAM(FNAME,FNUM,FOPTS,AOPTS,RECSIZE,KPARMS,FSIZE,ERROR);
  526     BYTE ARRAY FNAME;
  527     BYTE ARRAY KPARMS;
  528     INTEGER AOPTS,FOPTS,RECSIZE;
  529     REAL FSIZE;
  530     REAL ERROR;
  531     INTEGER FNUM;
  532     BEGIN
  533        INTRINSIC FCHECK,FOPEN;
  534        INTEGER ERRCODE;
  535        DOUBLE FILESIZE;
  536        ERROR:=0.0;
  537        FILESIZE:=FIXT(FSIZE);
  538        FNUM:=FOPEN(FNAME,FOPTS,AOPTS,RECSIZE,,KPARMS,,,,FILESIZE,32);
  539        IF <> THEN BEGIN
  540          FCHECK(,ERRCODE);
  541          ERROR:=REAL(ERRCODE);
  542        END;
  543     END;

========================================

Wirt Atmar

* To join/leave the list, search archives, change list settings, *
* etc., please visit http://raven.utc.edu/archives/hp3000-l.html *

ATOM RSS1 RSS2