jph@whuxle.UUCP (05/25/84)
#R:unc:-724700:whuxle:21300008:000:11925
whuxle!jph May 12 10:10:00 1984
Here is a library creation program that I obtained from a
bulletin board.
===================================
10 DEFINT A-Z
20 DEF FNH2$(C)=RIGHT$("00"+HEX$(C),2)
30 DEF FNZ(H,L)=((H MOD &H25)*256 + L) MOD &H25
40 DEF FNR(H,L)=((H MOD HSIZE)*256 + L) MOD HSIZE
50 DEF FNS$(S$)=SPACE$(40-LEN(S$)\2)+S$
60 MAXSYM=1000: DIM SYMB$(MAXSYM), SYMBLOCK(MAXSYM), SYMLOC(MAXSYM)
70 MAXBLK=127: DIM BLKSYM(MAXBLK), BLKSTR(MAXBLK), BLKOVF(MAXBLK)
100 PRINT
110 PRINT FNS$("MAKELIB - A program to create library [.LIB] files.")
120 PRINT
130 PRINT FNS$("Copyright 1983 by Dan Oetting, all commercial rights reserved.")
140 PRINT
150 PRINT FNS$("Version (Preliminary) 0.00 ")
160 PRINT FNS$("Release date: 03-NOV-1983")
170 PRINT FNS$("Last Modification: 31-DEC-1983")
180 PRINT: PRINT
190 ON ERROR GOTO 8000
200 REM Makelib Create an object library file
205 FILEOK=0: WHILE NOT FILEOK
210 INPUT "Library file [.LIB]";LIBFILE$
215 IF LIBFILE$="" THEN SYSTEM
220 IF INSTR(LIBFILE$,".")=0 THEN LIBFILE$=LIBFILE$+".lib"
230 GOSUB 1000 'Init lib file
235 WEND
240 GOSUB 4490 'init symb tab
250 REM Object file loop
260 INPUT "Object file [.OBJ]";OBJFILE$: IF OBJFILE$="" THEN 480
270 IF INSTR(OBJFILE$,".")=0 THEN OBJFILE$=OBJFILE$+".obj"
280 IF INSTR(OBJFILE$,"*") THEN PRINT: PRINT "List of files matching '" ;OBJFILE$;"'": FILES OBJFILE$: PRINT "Enter each file separatly." : PRINT: GOTO 250
290 SAVELOC=LOFFSET
300 GOSUB 2000 'Init object buffer
310 READING=-1
320 WHILE READING 'REM Object record loop
330 GOSUB 2130 'Get record type and size
340 IF NOT FILEOK THEN GOTO 440
350 IF RTYPE=&H80 THEN GOSUB 3000: GOTO 420 'Process Title record
360 IF RTYPE=&H90 THEN GOSUB 3080: GOTO 420 'Process Global record
370 IF RTYPE=&H8A THEN READING=0: GOTO 420 'End record
380 IF (RTYPE=&HA2) OR (RTYPE=&H8C) OR (RTYPE=&H96) OR (RTYPE=&H98) OR (RTYPE=&H9A) OR (RTYPE=&H9C) OR (RTYPE=&HA0) THEN GOTO 420 'Pass
390 IF RTYPE=&HF0 THEN S$="Cannot includ library file.":GOSUB 2460:GOTO 440
400 IF (RTYPE=0) OR (RSIZE=0) OR (RSIZE>256) THEN S$="Premature end of file": GOSUB 2460: GOTO 440
410 PRINT "Unknown record type (";FNH2$(RTYPE);"), length ";RSIZE; " at offset ";OBJREC*128+OBJPOS-3;" in object file '";OBJFILE$;"'."
420 REM End current record
430 GOSUB 2190
440 WEND
450 REM Process end of object file
460 GOSUB 2250 'Flush buffer
470 GOTO 250 'loop for next file
480 REM produce hash table of global symbols
490 GOSUB 1170 'align lib file
500 HSTART=LOFFSET
510 GOSUB 6000 'Compute size of hash table
520 PRINT:PRINT " HSTART =";HSTART, " HSIZE =";HSIZE, "(blocks)": PRINT
530 GOSUB 4000 'Init block table
540 FOR SYM=1 TO LASTSYM
550 S$=SYMB$(SYM): GOSUB 4050: SYMBLOCK(SYM)=BLK
560 NEXT SYM
570 FOR BLK=0 TO HSIZE-1
580 GOSUB 4190 'init block
590 FOR SYM=1 TO LASTSYM
600 IF SYMBLOCK(SYM)=BLK THEN S$=SYMB$(SYM): GOSUB 4250 'add symb
610 NEXT SYM
620 GOSUB 4410 'put hash block
630 NEXT BLK
640 GOSUB 1210 'Close library file
650 SYSTEM
1000 REM Initialize library file buffer
1005 FILEOK=0
1010 OPEN LIBFILE$ FOR INPUT AS #1:CLOSE #1 'if not found then skip to open
1020 PRINT "File '";LIBFILE$;"' already exists! Should it be deleted";: BEEP
1030 GOSUB 6110: IF NOT YES THEN RETURN
1040 KILL LIBFILE$
1050 OPEN LIBFILE$ AS #1 LEN=128
1060 FIELD #1, 128 AS LBUF$
1070 LSET LBUF$=STRING$(128,0)
1080 PUT #1: PUT #1: PUT #1: PUT #1
1090 LOFFSET=1: LQPOS=0: FILEOK=-1
1100 RETURN 'resume here on open error
1110 REM Copy object buffer to lib file
1120 LSET LBUF$=OBUF$
1130 REM Dump library file buffer
1140 PUT #1
1150 IF LQPOS<3 THEN LQPOS=LQPOS+1 ELSE LQPOS=0: LOFFSET=LOFFSET+1
1160 RETURN
1170 REM Allign to next block
1180 LSET LBUF$=STRING$(128,0)
1190 WHILE LQPOS<>0: GOSUB 1130: WEND
1200 RETURN
1210 REM Close library file
1220 LSET LBUF$=STRING$(128,0)
1230 MID$(LBUF$,1)=CHR$(&HF0)+MKI$(&H1FD)+CHR$(0)+MKI$(HSTART*2)+CHR$(0) +MKI$(HSIZE)
1240 PUT #1,1 'First (quarter) block
1250 CLOSE #1
1260 RETURN
2000 REM Init object file buffer
2010 OPEN OBJFILE$ FOR INPUT AS #2:CLOSE #2
2020 OPEN OBJFILE$ AS #2 LEN=128
2030 FIELD #2, 128 AS OBUF$
2040 GET #2: OBJPOS=0: OBJREC=0 'Load first block
2050 FILEOK=-1
2060 RETURN
2070 REM Grab a byte from object buffer
2080 IF NOT FILEOK THEN RETURN
2090 WHILE OBJPOS>=128:GOSUB 1110:GET #2:OBJPOS=OBJPOS-128:OBJREC=OBJREC+1:WEND
2100 OBJPOS=OBJPOS+1: RCOUNT=RCOUNT-1
2110 CH$=MID$(OBUF$,OBJPOS,1)
2120 RETURN
2130 REM Get record type and size
2140 IF NOT FILEOK THEN RETURN
2150 GOSUB 2070: RTYPE=ASC(CH$)
2160 GOSUB 2310: RSIZE=WORD: IF RSIZE<0 THEN S$="Record too big.": GOSUB 2460
2170 RCOUNT=RSIZE
2180 RETURN
2190 REM Advance to next record
2200 IF NOT FILEOK THEN RETURN
2210 IF RCOUNT<=0 THEN S$="Record scan error.": GOSUB 2460: RETURN
2220 OBJPOS=OBJPOS+RCOUNT-1
2230 GOSUB 2070 'gets the check byte at end of record
2240 RETURN
2250 REM Close object file, flush buffer
2260 IF NOT FILEOK THEN RETURN
2270 IF OBJPOS>0 THEN GOSUB 1110
2280 GOSUB 1170 'align lib to next block
2290 CLOSE #2 'done with obj file
2300 RETURN
2310 REM Get word value WORD
2320 IF NOT FILEOK THEN RETURN
2330 GOSUB 2070: CH1$=CH$
2340 GOSUB 2070
2350 WORD=CVI(CH1$+CH$)
2360 RETURN
2370 REM Get string S$
2380 IF NOT FILEOK THEN RETURN
2390 GOSUB 2070: SIZE=ASC(CH$)
2400 IF SIZE>127 OR SIZE>=RCOUNT THEN S$="String too big.": GOSUB 2460: RETURN
2410 S$=SPACE$(SIZE)
2420 FOR I=1 TO SIZE
2430 GOSUB 2070: MID$(S$,I,1)=CH$
2440 NEXT I
2450 RETURN
2460 REM Abort processing current object file
2470 PRINT: PRINT S$: BEEP
2480 PRINT "File '";OBJFILE$;"' will not be included in '";LIBFILE$;"'."
2490 PRINT
2500 GET #1, 4*SAVELOC-1 'restore library file position
2510 LASTSYM=SAVESYM 'restore symbol table
2520 READING=0
2530 FILEOK=0
2540 RETURN
3000 REM Process title record
3010 GOSUB 2370 'Get string
3020 IF NOT FILEOK THEN RETURN
3030 PRINT "TITLE ";S$
3040 OBJLOC=LOFFSET
3050 S$=S$+"!"
3060 GOSUB 4530 'Add S$ to symbol tab
3070 RETURN
3080 REM Process global record
3090 GOSUB 2070: GOSUB 2070 'Skip two bytes
3100 WHILE RCOUNT>1
3110 GOSUB 2370 'get s$
3120 GOSUB 2310 'get WORD
3130 GOSUB 2070 'get byte CH$
3140 IF NOT FILEOK THEN RETURN
3150 PRINT "GLOBAL ";S$;" = ";HEX$(WORD);":";HEX$(ASC(CH$))
3160 GOSUB 4530 'Add S$ to symbol tab
3170 WEND
3180 RETURN
4000 REM Initialize hash block table
4010 FOR I=0 TO HSIZE-1
4020 BLKSYM(I)=0: BLKSTR(I)=0: BLKOVF(I)=0
4030 NEXT I
4040 RETURN
4050 REM assign symbol to block
4060 GOSUB 5000 'Hash symbol S$
4070 BLK=H2START 'Initial try
4080 FOR BCOUNT=1 TO HSIZE
4090 IF BLKSTR(BLK)+LEN(S$)>470 THEN 4140
4100 IF BLKSYM(BLK)>=&H25 THEN 4140
4110 BLKSTR(BLK)=BLKSTR(BLK)+3+(LEN(S$) OR 1)
4120 BLKSYM(BLK)=BLKSYM(BLK)+1
4130 RETURN
4140 REM This block is full, overflow to next
4150 BLKOVF(BLK)=BLKOVF(BLK)+1
4160 BLK=(BLK+H2INC) MOD HSIZE
4170 NEXT BCOUNT
4180 PRINT "Hash table is full!": STOP
4190 REM Initialize hash block
4200 FOR I=0 TO 3
4210 HBLK$(I)=STRING$(128,0)
4220 NEXT I
4230 STRPOS=&H26
4240 RETURN
4250 REM Add symbol S$ to hash block
4260 GOSUB 5000 'Hash symbol S$
4270 SPTR=H1START 'Initial try
4280 FOR I=1 TO &H25
4290 IF ASC(MID$(HBLK$(0),SPTR+1,1))=0 GOTO 4330
4300 SPTR=(SPTR+H1INC) MOD &H25
4310 NEXT I
4320 PRINT "Oops it dosn't fit! This is a bug!":STOP
4330 MID$(HBLK$(0),SPTR+1)=CHR$(STRPOS\2)
4340 S$=CHR$(LEN(S$))+S$+MKI$(SYMLOC(SYM))
4350 MID$(HBLK$(STRPOS\128),(STRPOS MOD 128)+1)=S$
4360 STRPOS=STRPOS+LEN(S$)
4370 IF STRPOS >511 THEN PRINT "Too many strings in the block!":STOP
4380 IF ((STRPOS-1) MOD 128)+1 < LEN(S$) THEN MID$(HBLK$(STRPOS\128),1)=RIGHT$(S$,STRPOS MOD 128)
4390 IF (STRPOS AND 1) = 1 THEN STRPOS=STRPOS+1
4400 RETURN
4410 REM Put hash block
4420 PRINT "... Block";BLK, BLKSYM(BLK);" Symbols, ";BLKSTR(BLK);" Bytes, "; BLKOVF(BLK);" Overflow."
4430 IF BLKOVF(BLK)>0 THEN MID$(HBLK$(0),&H25+1)=CHR$(&HFF) ELSE MID$(HBLK$(0),&H25+1)=CHR$(STRPOS\2)
4440 FOR I=0 TO 3
4450 LSET LBUF$=HBLK$(I)
4460 GOSUB 1130
4470 NEXT I
4480 RETURN
4490 REM Initialize symbol table
4500 LASTSYM=0 'Last symbol added to table
4510 STRSIZE=0 'Total bytes in symbols
4520 RETURN
4530 REM Add symbol S$ to symbol table
4540 LASTSYM=LASTSYM+1
4550 IF LASTSYM>MAXSYM THEN PRINT "Too many symbols":STOP
4560 SYMB$(LASTSYM)=S$
4570 STRSIZE=STRSIZE+LEN(S$)
4580 SYMBLOCK(LASTSYM)=-1
4590 SYMLOC(LASTSYM)=OBJLOC
4600 RETURN
5000 REM Compute hash numbers
5010 RH=0: RL=0: LH=0: LL=0:
5020 FOR I=LEN(S$) TO 1 STEP -1
5030 GOSUB 5200: GOSUB 5250
5040 C=ASC(MID$(S$,I)) OR &H20
5050 RL=RL XOR C
5060 LL=LL XOR C
5070 NEXT I
5080 H1START=FNZ(RH,RL): H2INC=FNR(LH,LL)
5090 RH=0: RL=LEN(S$) OR &H20: LH=0: LL=RL:
5100 FOR I=1 TO LEN(S$)-1
5110 GOSUB 5200: GOSUB 5250
5120 C=ASC(MID$(S$,I)) OR &H20
5130 RL=RL XOR C
5140 LL=LL XOR C
5150 NEXT I
5160 H1INC=FNZ(RH,RL): H2START=FNR(LH,LL)
5170 IF H1INC=0 THEN H1INC=1
5180 IF H2INC=0 THEN H2INC=1
5190 RETURN
5200 REM rotate rh,rl right by 2 bits
5210 C = RL
5220 RL = ((RL\4) OR (RH*64)) AND 255
5230 RH = ((RH\4) OR (C*64)) AND 255
5240 RETURN
5250 REM rotate lh,ll left by 2 bits
5260 C = LH
5270 LH = ((LH*4) OR (LL\64)) AND 255
5280 LL = ((LL*4) OR (C\64)) AND 255
5290 RETURN
6000 REM Compute size of hash table
6010 HSIZE=(STRSIZE+LASTSYM*5)\380 + 1
6020 I=LASTSYM/30: IF I>HSIZE THEN HSIZE=I
6030 IF HSIZE<=3 THEN RETURN
6040 HSIZE=HSIZE OR 1
6050 REM Raise HSIZE to nearest prime
6060 IF HSIZE>MAXBLK THEN STOP 'This is too big to handle!
6070 FOR I=3 TO SQR(HSIZE) STEP 2
6080 IF (HSIZE MOD I)=0 THEN HSIZE=HSIZE+2: GOTO 6050 'try next
6090 NEXT I
6100 RETURN
6110 REM Inquire for YES/NO answer
6120 INPUT " [Yes/No]";S$: I=ASC(S$) AND &HDF
6130 YES=(I=ASC("Y")): NO=(I=ASC("N"))
6140 RETURN
8000 REM Error processing
8010 ON ERROR GOTO 8000
8020 IF ERL<>1010 THEN GOTO 8060
8030 IF ERR=53 THEN RESUME 1050 'skip if file not found
8040 BEEP: PRINT: PRINT "Error opening '";LIBFILE$;"'.": PRINT: BEEP
8050 RESUME 1100
8060 IF ERL<>2010 THEN ON ERROR GOTO 0
8070 IF ERR=53 THEN S$="File '"+OBJFILE$+"' not found.": GOTO 8120
8080 IF ERR=64 THEN S$="Bad file name '"+OBJFILE$+"'.": GOTO 8120
8090 IF ERR=68 THEN S$="Device '"+OBJFILE$+"' is unavailable.": GOTO 8120
8100 IF ERR=71 THEN S$="Disk for '"+OBJFILE$+"' is not ready.": GOTO 8120
8110 S$="Error opening '"+OBJFILE$+"'."
8120 PRINT: PRINT S$: BEEP
8130 PRINT "File '";OBJFILE$;"' has not been added to '";LIBFILE$;"'."
8140 PRINT
8150 RESUME 250
10000 REM Program index
10010 GOTO 200 'Makelib main program
10020 '
10030 GOSUB 1000 'Init lib file
10040 GOSUB 1130 'Dump library file buffer
10050 GOSUB 1170 'Allign to next block
10060 GOSUB 1210 'Close library file
10070 '
10080 GOSUB 2000 'Init obj file
10090 GOSUB 2070 'Get byte CH$
10100 GOSUB 2130 'get RTYPE and RSIZE
10110 GOSUB 2190 'Advance to next rec
10120 GOSUB 2250 'Close obj file
10130 GOSUB 2310 'Get word value WORD
10140 GOSUB 2370 'Get string S$
10150 '
10160 GOSUB 3000 'Process title record
10170 GOSUB 3080 'Process global record
10180 '
10190 GOSUB 4000 'Init hash table
10200 GOSUB 4050 'assign symbol to block
10210 GOSUB 4190 'Initialize hash block
10220 GOSUB 4250 'Add symbol S$ to hash block
10230 GOSUB 4410 'Close hash block
10240 GOSUB 4490 'Initialize symbol table
10250 GOSUB 4530 'Add symbol S$ to symbol table
10260 '
10270 GOSUB 5000 'Compute hash numbers
10280 GOSUB 5200 'rotate rh,rl right by 2 bits
10290 GOSUB 5250 'rotate lh,ll left by 2 bits
10300 GOSUB 6000 'Compute size of hash table
10310 REM