1   Noesc : On Error Goto Oops
   20   Rem *****************************************************
   30   Rem *
   40   Rem * Library Builder for Cromemco 32K Structured Basic
   45   Rem *       version 00.10  --  October 28, 1979
   50   Rem *       Copyright (c) 1979 Cromemco, Inc.
   55   Rem *
   60   Rem *****************************************************
   71   Set 0,-1
   72   Imode : I=2.5 : If I=2.5 Then Run
   73   Close
   99   Rem -------------------
  100   Rem declare variables
  101   Rem -------------------
  110   Dim Sector$(127),Header$(47)
  120   Dim Q$(0)
  130   Dim File'msg$(50)
  140   Dim Misc$(100)
  150   Dim Nmlen$(0),Varname$(40),Vartype$(0),Varmisc$(20),File$(30)
  160   Dim Pnmlen$(0),Pnm$(40),Svlibfile$(30)
  170   Dim Phdr$(20)
  399   Rem ----------------------------
  400   Rem initialize variables, etc.
  401   Rem ----------------------------
  410   Screen'clear$=Chr$(27)+"E          "
  500   @ Screen'clear$ : @ : @ : @
  505   Print"  Libbuild.lis version 00.10"
  510   Print"  Copyright (c) 1979 Cromemco, Inc."
  515     For I=1 To 3000 : Next I
 1010   Rem *****************
 1020   Rem *
 1030   Rem * the main menu
 1040   Rem *
 1050   Rem *****************
 1090 *Restart
 1100   @ Screen'clear$ : @ : @
 1105 *Select
 1106   Esc : On Esc Goto Queryfunc
 1107   @ : @
 1108   Print"32K STRUCTURED BASIC Library Utility" : @
 1110   Print"Select a function:" : @
 1120   Print"V -- View PROCEDURE names within a SAVEd program"
 1130   Print"I -- display Index of a library file"
 1140   Print"A -- Add a SAVEd program to a library file"
 1150   Print"D -- Delete a module from a library"
 1160   Print"C -- Create a new library file"
 1166   Print"Q -- Quit"
 1170 *Queryfunc
 1180   @ : @
 1190   Print"function ? --->>> "; : Get\0\Q$(0,0)
 1191   Print Q$ : @ : @ : @ Screen'clear$
 1195   If Len(Q$)=0 Then Goto Bad'select
 1200   If Q$>"Z" Then Q$=Chr$(Asc(Q$)-32)
 1210   Sel=Pos("VIADCQ",Q$,0)+1
 1220   If Sel>0 Then Goto Call'function
 1225 *Bad'select
 1230   Print" invalid function request...retry..." : @
 1240   Goto Select
 1500   Rem *
 1510   Rem * call the selected routine
 1520   Rem *
 1530 *Call'function
 1535   Noesc
 1540   On Sel Gosub Do'view,Do'index,Do'add,Do'del,Do'create,Quit
 1550   Close
 1560   Esc : On Esc Goto Restart
 1570   @ : @"******** end of function ********"
 1600   Gosub Wait
 1620   Goto Restart
 3000   Rem *************
 3010   Rem *
 3020   Rem * Q -- Quit
 3030   Rem *
 3040   Rem *************
 3050 *Quit
 3060   Close
 3080   Print"-- ""LIBBUILD"" terminating --"
 3090   Goto The'end
 5000   Rem *****************************************************
 5010   Rem *
 5020   Rem * V -- view proccedure names within a saved program
 5030   Rem *
 5040   Rem *****************************************************
 5050   Rem
 5060 *Do'view : Print"-- VIEW --" : @
 5065   File'msg$="What SAVEd program to View "
 5070   File=1 : Gosub Open'user'file
 5075   @ : @
 5080   Svfl=File
 5090   Get\Svfl\I : Rem get the check word at start of file
 5100   If I Then Goto Ok'to'view
 5110   Close\Svfl\
 5120   @ : @ : Print"not a SAVEd program...command ignored" : @ : @
 5130   Return
 5140   Rem
 5150 *Ok'to'view
 5160   Put\Svfl,0,0\
 5170   Gosub Read'header : Rem get the goodies about the file
 5200   Nfile=Svfl
 5210   Nbytes=Stasize : Rem ignore program per se
 5220   Gosub Skip'nbytes
 5290   Rem then show the names of all procs
 5300   Gosub Show'procnames
 5380   Close\Svfl\
 5990   Return
 6000   Rem ***************************************
 6010   Rem *
 6020   Rem * C -- Create a new procedure library
 6030   Rem *
 6040   Rem ***************************************
 6050 *Do'create : Print"-- CREATE --" : @
 6060   @ : @ : Input"What is the name of the new library file ? ",File$
 6065   On Error Goto Errcreate
 6070   Create File$
 6075   On Error Goto Oops
 6080   File=1 : Open\File\File$
 6085   Svlibfile$=File$
 6090   Rem
 6100   Rem * now put out a blank proc library header
 6110   Rem
 6120   Zero=0 : Rem an integer value of 0
 6130   Available=1024/128 : Rem first available pgm spot is at 1k bytes
 6190   Rem
 6200   Put\File\Zero : Rem says this is a library
 6210   Put\File\Chr$(16),File$(0,-16) : Rem just put name out there for now
 6220   Put\File\Available : Rem says where first availbale spot in file is
 6230   Put\File\Zero : Rem end of procedure name table
 6290   Sector$=""
 6300     For I=1 To 7 : Put\File\Sector$(-1) : Next I
 6310   Close\File\
 6320   Return
 6800 *Errcreate
 6810   @ : @ : Print"could not CREATE the file specified:"
 6820   Print"   bad filename OR file already exists OR no disk space"
 6830   @ : @ : Print"take corrective action and try again"
 6840   @
 6990   Return
 7000   Rem ***************************************************
 7010   Rem *
 7020   Rem * A -- Add a SAVEd program to an existing library
 7030   Rem *
 7040   Rem ***************************************************
 7060 *Do'add : Print"-- ADD --" : @
 7070   File'msg$="What library file to use "
 7080   Libfile=2 : File=Libfile
 7090   Gosub Open'user'file
 7100   File'msg$="What SAVEd program are we ADDing "
 7110   Svfl=1 : File=Svfl : Gosub Open'user'file
 7120   Gosub Read'header : Rem header from save file
 7130   Gosub Read'lib'header : Rem and header from library
 7200   Rem now position library file past all procnames
 7210     Repeat
 7220     Gosub Getpnm
 7290     Until(Not Pnmlen)
 7300   Put\Libfile,T1,T2\ : Rem reposition at the zero byte
 7310   If Psect>=Available Then Goto Libsize'err
 7400   Rem *
 7410   Rem * now move all procedures that are defined in SAVEd
 7420   Rem *         program to index of library
 7430   Rem *
 7450   Nbytes=Stasize : Nfile=Svfl : Gosub Skip'nbytes : Rem ignore program
 7460   Cnt'of'pns=0
 7470   Varspace=Varsize
 7480     Repeat
 7500     Gosub Read'variable : Varspace=Varspace-Vcntr
 7510     If Binand(Vartype,%0078%)<>%0078% Then Goto No'move'pname
 7515     If Varaddr=0 Then Goto No'move'pname
 7520     Rem **** we have a procedure name ****
 7530     Put\Libfile\Nmlen$(0,0),Varname$(0,-Nmlen),Available
 7540     Cnt'of'pns=Cnt'of'pns+1
 7550     If Iostat(Libfile,1)>7 Then Goto Libsize'err
 7590   *No'move'pname
 7650     Until(Varspace<=0)
 7700   Rem
 7710   Rem ** now we have moved all possible procnames
 7720   Rem
 7730   If Cnt'of'pns Then Goto Ok'to'add'programs
 7740   @ : @ : Print"No procedures defined in that SAVEd program."
 7750   Print"ADD request ignored."
 7760 *Quitadd : Close
 7790   Return
 7800   Rem
 7810   Rem ** now move program from SAVEd file to library
 7820   Rem
 7830 *Ok'to'add'programs
 7835   Put\Libfile\Chr$(0) : Rem ensure that an end-of-library byte is written
 7840   Put\Libfile,Available\ : Rem just to position ourselves
 7850   Put\Svfl,0,0\ : Rem and back to start of saved file
 7900     Repeat
 7920     Get\Svfl\Sector$(0,-128)
 7930     Put\Libfile\Sector$(0,-128)
 7940     Until Iostat(Svfl,0) : Rem non-zero implies eof
 7950   Rem
 7960   Available=Iostat(Libfile,1)+1 : Rem past eof on libfile
 7965   Sector$="" : Put\Libfile\Sector$(-1),Sector$(-1) : Rem ensure no holes
 7970   Put\Libfile,0,19\Available : Rem 19 is a magic number, right??
 7980   Close
 7990   Return
 8000   Rem **********
 8010 *Libsize'err
 8020   @ : @ : Print"Internal error in library file." : @ : @
 8030   Print"Use the Index command to list all Procedures in library file."
 8050   Print"Keep all SAVEd files which were used to build this library." : @
 8060   Print"You may try to build a new library using the Add command."
 8070   Goto Abort
 9010   Rem *****************************************************
 9020   Rem *
 9030   Rem * I -- show Index of all procedures in this library
 9040   Rem *
 9050   Rem *****************************************************
 9090 *Do'index : Print"-- list INDEX --" : @
 9100   Libfile=2 : File=Libfile : File'msg$="What library file to use "
 9110   Gosub Open'user'file
 9120   Gosub Read'lib'header : Rem open library file and read its header
 9130   @ : @ : Print" ( ";Int((Available+7.0)/8.0);" k bytes used )" : @
 9135   Svmaddr=0 : Mnum=1
 9140     Repeat
 9150     Gosub Getpnm
 9160     If Not Pnmlen Then Goto Last'pname
 9190     If Pnmaddr<>Svmaddr Then Print"Module number ";Mnum : Mnum=Mnum+1
 9200     Svmaddr=Pnmaddr
 9205     Esc : On Esc Goto Index'esc
 9208     Print Tab(8);Pnm$
 9215     Noesc
 9290   *Last'pname : Until(Not Pnmlen)
 9300   Return
 9400 *Index'esc
 9410   Pnmlen=0 : Goto Last'pname
15000   Rem ***************************************
15010   Rem *
15020   Rem * D -- Delete a module from a library
15030   Rem *
15040   Rem ***************************************
15100 *Do'del : Print"-- DELETE --" : @
15110   File'msg$="What library file to use "
15120   Libfile=2 : File=Libfile : Gosub Open'user'file
15130   @ : @ : Print"Give the name of a procedure which is in the module"
15140   Input"   you wish to delete. >>> ",Varname$
15150     For I=0 To Len(Varname$)-1
15160     If Varname$(I,-1)>="a" And Varname$(I,-1)<="z" Then Varname$(I,-1)=Chr$(Asc(Varname$(I,-1))-32)
15170     Next I
15250   Gosub Read'lib'header
15300   Svmaddr=0
15310     Repeat
15320     Gosub Getpnm
15330     If Not Pnmlen Then Goto Nomore
15350     If Pnmaddr<>Svmaddr Then Svsect=T1 : Svbyte=T2
15380     Svmaddr=Pnmaddr : If Pnm$=Varname$ Then Pnmlen=-1
15390   *Nomore : Until(Pnmlen<=0)
15400   Rem either out of names or found right one
15410   If Pnmlen=0 Then Goto Nonames
15500   Rem *
15510   Rem * must delete a module
15520   Rem *
15580   Rem [ look for first proc name not in to-be-deleted module ]
15590     Repeat : Gosub Getpnm
15600     Until((Not Pnmlen) Or(Svmaddr<>Pnmaddr))
15602   Nxtmaddr=Pnmaddr : Rem addr of next module
15605   Rem [found -- move all succeeding directory entries 'down' in file ]
15610     Repeat
15620     Put\Libfile,T1,T2\ : Rem reposition to start of next procname
15630     Gosub Getpnm : T1=Iostat(Libfile,1) : T2=Iostat(Libfile,2)
15660     If Pnmlen Then  Do
15665       Put\Libfile,Svsect,Svbyte\Pnmlen$(0,0),Pnm$(0,-Pnmlen)
15670       Put\Libfile\Pnmaddr-(Nxtmaddr-Svmaddr) : Rem module moves this much
15680       Svsect=Iostat(Libfile,1) : Svbyte=Iostat(Libfile,2)
15685       Enddo
15690     Until(Not Pnmlen)
15710   Put\Libfile,Svsect,Svbyte\Chr$(0)
15800   Rem ***      now we have moved directory up...move program up   ***
15810   Rem    svmaddr = addr of module to be deleted
15820   Rem   nxtmaddr = addr of next module
15850     Repeat
15870     Get\Libfile,Nxtmaddr\Sector$(-1) : T0=Iostat(Libfile,0)
15880     Put\Libfile,Svmaddr\Sector$(-1)
15890     Nxtmaddr=Nxtmaddr+1 : Svmaddr=Svmaddr+1
15900     Until T0 : If T0<>1 Then Print"oops" : Stop
15910   Get\Libfile,0,19\Available
15920   Put\Libfile,0,19\Available-(Nxtmaddr-Svmaddr)
15990   Return
16900   Rem
16910 *Nonames : @ : @ : Print"No such Procedure in this library."
16930   Return
40000   Rem **************************
40010   Rem *
40020   Rem * read in program header
40030   Rem *
40040   Rem **************************
40050 *Read'header
40060   Get\Svfl\Stabot,Statop,Varbot,Vartop,Lblbot,Lbltop
40070   Get\Svfl\Misc$(0,-36)
40090   Stasize=Binsub(Statop,Stabot)
40100   Varsize=Binsub(Vartop,Varbot)
40110   Lblsize=Binsub(Lbltop,Lblbot)
40120   If Varsize=0 Then @ : @ : Print"no variables at all in this SAVEd pgm" : Goto Abort
40990   Return
42000   Rem ************************************
42010   Rem *
42020   Rem * read an item from variable table
42030   Rem *
42040   Rem ************************************
42050 *Read'variable
42060   Get\Svfl\Nmlen$(0,0)
42070   Nmlen=Asc(Nmlen$)
42080   Varname$=""
42090   Get\Svfl\Varname$(0,-Nmlen),Vartype$(0,0),Varaddr
42100   Vartype=Asc(Vartype$)
42105   Varflag=Binand(Vartype,%0020%)
42110   If Varflag=0 Then Get\Svfl\Varmisc$(0,-9)
42120   Vcntr=1+Nmlen+1+2+((Not Varflag)*9)
42990   Return
44000   Rem ***************************************
44010   Rem *
44020   Rem * skip 'nbytes' from the file 'nfile'
44040   Rem *      (these bytes are thrown away)
44050   Rem *
44060   Rem ***************************************
44070 *Skip'nbytes
44080   Psect=Iostat(Nfile,1) : Pbyte=Iostat(Nfile,2) : Rem current file pos
44090   Nsect=Int(Nbytes/128) : Rem number of sectors in request
44100   Nch=Nbytes-128*Nsect : Rem left over bytes
44110   Nsect=Nsect+Psect : Rem new sector position
44120   Nch=Nch+Pbyte : Rem and new character position
44130   Rem NOTE that nch may be > 127 ; but PUT really doesn't care
44400   Put\Nfile,Nsect,Nch\
44990   Return
46000   Rem **********************************************
46010   Rem *
46020   Rem * simply reads all variables from 'svfl' and
46030   Rem *      displays all that are procedure names
46040   Rem *
46050   Rem **********************************************
46060 *Show'procnames
46070     Repeat
46080     Gosub Read'variable
46090     If Binand(Vartype,%0078%)<>%0078% Then Goto Not'a'proc
46100     Esc : On Esc Goto Show'esc
46105     If Varaddr=0 Then Print"    calls ";
46110     Print Varname$
46120     Noesc
46180   *Not'a'proc
46290     Varsize=Varsize-Vcntr
46300     Until(Varsize<=0)
46390   Return
46500 *Show'esc
46510   Varsize=0 : Goto Not'a'proc
48000   Rem ********************************
48010   Rem *
48020   Rem * open a file as named by user
48030   Rem *
48040   Rem ********************************
48050 *Open'user'file
48055   Esc : On Esc Goto Open'esc
48060   @ : Print File'msg$; : Input File$
48065   Noesc
48070   If Len(File$)=0 Then  Do
48080     If File=Libfile Then  Do
48090       If Len(Svlibfile$) Then  Do
48100         File$=Svlibfile$ : Rlherr=0
48105         Print"     [ using library file """;File$;""" ]" : @
48110         Else : Rlherr=1
48111         Enddo
48112       Else : Rlherr=1
48113       Enddo
48114     Else : Rlherr=0
48115     Enddo
48117   If Rlherr Then Goto Open'user'file
48119   On Error Goto Open'err
48120   Open\File\File$
48121   On Error Goto Oops
48125   If File=Libfile Then Svlibfile$=File$
48130   Return
48300 *Open'esc
48310   @ : @ : @
48320   Input"Do you wish to QUIT now (yes or no) ? ",Q$
48330   If Q$(0,0)="Y" Or Q$(0,0)="y" Then Goto Abort
48340   Goto Open'user'file
48400 *Open'err
48410   If Sys(3)<>134 Then Goto Oops
48430   @ : @ : Print"File does not exist."
48440   @ : Print" ...try again.." : @
48490   Goto Open'user'file
50000   Rem *****************************************************
50010   Rem *
50020   Rem * set up 'available' by reading library file header
50030   Rem *
50040   Rem *****************************************************
50050 *Read'lib'header
50060   Get\Libfile\Available : Rem not really...just a check
50070   If Available=0 Then Goto Ok'to'rdlib
50078 *Bad'lib
50080   @ : @ : Print"Not a valid library." : Goto Abort
50090   Rem
50100 *Ok'to'rdlib
50110   Get\Libfile\Pnmlen$(0,-1),Phdr$(0,-16)
50120   If Asc(Pnmlen$)<>16 Then Goto Bad'lib
50130   Get\Libfile\Available : Rem the real thing
50140   Rem
50990   Return
70000   Rem **********************************
70100 *Getpnm
70105   T1=Iostat(Libfile,1) : T2=Iostat(Libfile,2)
70110   Get\Libfile\Pnmlen$(0,0) : Pnmlen=Asc(Pnmlen$)
70120   Pnm$="" : If Not Pnmlen Then Return
70130   Get\Libfile\Pnm$(0,-Pnmlen),Pnmaddr
70190   Return
90000   Rem ********************
90010   Rem *
90020   Rem * wait for any key
90030   Rem *
90040   Rem ********************
90100 *Wait
90110   Print"[ hit any key to continue ]"
90120   Get\0\Q$
90130   Return
98000   Rem ****************************
98010   Rem *
98020   Rem * oops -- unexpected error
98030   Rem *
98040   Rem ****************************
98060 *Oops
98100   On Error Stop
98110   On Esc Stop
98120   Esc
98130   @ : Print"UNEXPECTED ERROR ENCOUNTERED"
98140   @ : Print"system error number ";Sys(3);" occurred."
98150   @ : Print"must abort this session"
98190   Goto Abort
98999   Rem ******************************************
99000   Rem
99010   Rem abort a run
99020   Rem
99030 *Abort
99035   Close : Esc : On Esc Stop
99040   @ : @ : @"aborting run and restarting" : @
99050     For I=1 To 5
99060     Print Chr$(7);
99070       For J=1 To 300
99080       Next J
99090     Next I
99100   Gosub Wait
99110   Run
99999 *The'end : Esc : Scr : End