|
DataMuseum.dkPresents historical artifacts from the history of: Ohio Scientific Inc. |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Ohio Scientific Inc. Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 5104 (0x13f0)
Notes: OS65UFile, OSU65U-BASIC
Names: »INSERT«
└─⟦2f57871a3⟧ Bits:30009355 Ohio Scientific OS-OMS Nucleus, delvist oversat til dansk
└─⟦this⟧ »INSERT«
00001 PRINT"** PROGRAM NOT EXECUTABLE FROM THE CONSOLE **":RUN"DBMSYS","PASS" 00002 CLOSE:CLEAR:REM 1/79 RECORD INSERTER (INSERT) 00003 REM 00004 REM LINES 1-200 SET FLAGS,POKES,VARIABLES,ETC. 00005 K0=0:K1=1:K2=2:K3=3:K4=4:K5=5:K6=6:K7=7:K8=8:K9=9:KW=10:KZ=32 00006 FORX=K1TOKZ:PRINT:NEXT:FLAG11:FLAG9:REM FLG11-SPACE SUPP FLG9-50,000 00007 DIML$(100),FL(100),FP(100),D$(100) 00010 REM PEEK FOR CURRENT DEVICE 00011 DV(K1)=PEEK(9832):IFDV(K1)>127THENDV(K1)=DV(K1)-128+K4 00012 DV$(K1)=CHR$(DV(K1)+65) 00020 PRINT:PRINT"OS-DMS RECORD INSERT":PRINT"--------------------":PRINT 00197 REM 00198 REM *************** MASTER FILE VERIFICATION *************** 00199 REM 00200 PRINT:INPUT"DEVICE MASTER FILE IS STORED ON ";DV$(K2) 00205 IF DV$(K2)="" THEN DV$(K2)=DV$(K1): GOTO 300 00210 IFLEN(DV$(K2))>K1THENPRINT:PRINT"WHAT!":GOTO200 00215 IFDV$(K2)<"A"ORDV$(K2)>"E"THENPRINT:PRINT"WHAT!":GOTO200 00297 REM 00298 REM *************** PICKUP FILENAME & PASSWORD *************** 00299 REM 00300 PRINT:INPUT"MASTER FILE NAME,PASSWORD ";M$,P$ 00305 IFM$=""ORP$=""THENPRINT:PRINT"WHAT!":GOTO300 00310 IFLEN(M$)<K5THENM$=M$+" ":GOTO310 00315 IFLEN(M$)=K6ANDRIGHT$(M$,K1)="0"GOTO330 00320 IF LEN(M$)>=K6 THEN PRINT: PRINT"IMPROPER FILENAME": GOTO 300 00325 IFLEN(M$)<K6THENM$=M$+"0":REM XXXXX0 00330 IFP$="."ORP$="."THENP$="ANAN" 00335 IFLEN(P$)<>K4THENPRINT:PRINT"IMPROPER PASSWORD":GOTO300 00340 DEVDV$(K2):REM SELECT NEW DEVICE 00345 OPENM$,P$,K1:REM OPEN FILE 00350 PRINT:PRINT"PLEASE WAIT":PRINT 00397 REM 00398 REM *************** VERIFY FILE NAME IN HEADER *************** 00399 REM 00400 INDEX<K1>=K0:INPUT%K1,N$:IFN$=LEFT$(M$,K5)GOTO410 00405 ERR$="FILE HEADER MISMATCH":GOTO40000:REM ERROR HANDLER 00410 INDEX<K1>=K6:INPUT%K1,TY:REM VERIFY MASTER FILE TYPE 00415 IFTY<>KWTHENERR$="NOT A MASTER FILE TYPE":GOTO40000 00420 INDEX<K1>=K9:INPUT%K1,EODF:REM GET END OF DATA INDEX 00425 INDEX<K1>=20:INPUT%K1,BODF:REM GET START OF DATA INDEX 00430 REM CHK IF DATA EXIST IN FILE 00435 IFEODF<=BODFTHENERR$="FILE EMPTY":GOTO40000 00440 INDEX<K1>=31:INPUT%K1,RL:REM GET RECORD LENGTH 00445 INDEX<K1>=42:INPUT%K1,NR:REM GET # OF RECORDS 00450 REM DOUBLE CHK FOR DATA IN THE FILE 00455 IFNR<K1THENERR$="FILE EMPTY":GOTO40000 00460 REM EVERYTHING IN THE FILE SEEMS 'OK' 00465 REM GET FIELD NAMES,LENGTHS & OFFSETS 00470 REM L$(N)=NAME FL(N)=LENGHT FP(N)=OFFSET 00475 TT=K0:TF=K1:A1=480:INDEX<K1>=53:REM TT=OFFSET TF=# OF FIELDS 00480 INPUT%K1,L$(TF):INPUT%K1,FL(TF):FP(TF)=TT 00485 T=TT+FL(TF):IFINDEX(K1)<BODFTHENTF=TF+K1:GOTOA1 00490 IFINDEX(K1)>BODFTHENERR$="FILE HEADER ERROR":GOTO40000 00495 REM ALL FIELD NAMES,LENGHTS & OFFSETS ARE ENTERED & SET 00497 REM 00498 REM *************** INPUT INSERT SPECIFICATIONS *************** 00499 REM 00500 IFNR=INT((EODF-BODF)/RL)GOTO565 00505 PRINT:INPUT"# OF RECORDS TO INSERT IN THE MASTER FILE ";A$:A=VAL(A$) 00510 IFA<>INT(A)THENPRINT:PRINT"WHAT!":GOTO505 00511 IF A>=1 GOTO 515 00512 A=1: PRINT : INPUT"WILL INSERT ONE RECORD (OK) ";QA$ 00513 IF LEFT$(QA$,1)="N" GOTO 505 00515 E=NR-INT((EODF-BODF)/RL):IFE=>ATHEN:EDF=EODF+(A*RL):GOTO530 00520 PRINT"** THE MAXIUM # OF RECORDS THAT MAY BE INSERTED ON THIS FILE IS"; 00525 PRINTE;"**":PRINT:GOTO500 00530 RC=INT((EODF-BODF)/RL):RR=RC+A:INDEX<K1>=K9:PRINT%K1,EDF 00535 PRINT:PRINT"INSERT";A;:INPUT"RECORDS AFTER RECORD # ";B$:B=VAL(B$) 00540 IFB<>INT(B)THENPRINT:PRINT"WHAT!":GOTO535 00541 IF B>=1 GOTO 545 00542 B=1: PRINT:INPUT"WILL INSERT STARTING AT RECORD ONE (OK) ";QA$ 00543 IF LEFT$(QA$,1)="N" GOTO 535 00545 IFB>NR-ETHENPRINT:PRINT"* LAST RECORD IN FILE IS RECORD #";NR-E;"*":GOTO535 00550 O$="0":RP=K1:POKE2972,13:POKE2976,13:REM PERMIT ,:& IN DATA FIELDS 00555 IFLEN(S1$)<71THENS1$=S1$+" ":GOTO555 00560 FORX=K1TOKZ:PRINT:NEXT:PRINT"PLEASE WAIT":GOTO600 00565 PRINT"** THIS FILE IS FULL!! NO OTHER RECORDS MAY BE ADDED TO THIS FI"; 00570 PRINT"LE!! **":GOTO51100 00596 REM 00597 REM MOVE THE LATTER RECORDS TO NEW POSITION FIRST 00598 REM *************** MOVE RECORDS TO NEW INDEX *************** 00599 REM 00600 C=RC-B:B1=605:FORX=K1TOTF:FL(X)=FL(X)-K1:NEXT:IFB=NR-EGOTO625 00605 INDEX<K1>=BODF+((RC-RP)*RL):FORX=K1TOTF:INPUT%K1,D$(X):NEXT 00610 INDEX<K1>=BODF+((RR-RP)*RL):FORX=K1TOTF:PRINT%K1,RIGHT$(S1$+D$(X),FL(X)) 00615 NEXT:RP=RP+K1:IFRP<=CGOTOB1 00620 REM PRINT ZEROS TO THE INSERTED RECORDS IN THE FILE 00625 INDEX<K1>=BODF+(B*RL):FORN=K1TOA:FORX=K1TOTF 00630 PRINT%K1,RIGHT$(S1$+O$,FL(X)):NEXT:NEXTN:GOTO51100 00697 REM 00698 REM *************** ERROR HANDLERS IN LINE 40000 ON *************** 00699 REM 40000 REM ERROR EXPANSION GOES HERE 40010 PRINT:PRINTERR$:PRINT:CLOSE:GOTO51000:REM COMMON EXIT PATH 50000 REM LINE 50,000 ERROR HANDLER 50010 ER=PEEK(10226):EL=PEEK(11774)+PEEK(11775)*256 50015 REM CHK FOR 'NON-EXISTANT ENTRY ERROR' 50020 IFER=128THENERR$="INVALID FILENAME":GOTO51050 50025 REM CHK FOR 'END OF FILE HIT' ERROR 50030 IFER=132THENERR$="END OF FILE ERROR":GOTO51000 50035 REM CHK FOR ACCESS RIGHTS VIOLATION 50040 IFER=130THENERR$="ACCESS RIGHTS VIOLATION":GOTO51000 50045 REM MAYBE A SYSTEM ERROR I.E. CHANNEL NOT OPEN ERROR 50050 IFER=129THENERR$="CANNOT ACCESS FILE":GOTO51050 50055 REM OTHER ERRORS ARE HARD ERRORS 50060 ERR$="DISC ERROR CODE "+STR$(ER)+" IN LINE "+STR$(EL) 50065 REM PICKUP DISC ADDR. WHERE ERROR OCCURED 50070 EA=K0:FORI=4TO1STEP-1:EA=EA*256+PEEK(9889+I):NEXTI 50080 DV(K4)=PEEK(9832):IFDV(K4)>127THENDV(K4)=DV(K4)-128+K4 50090 PRINT"ERROR ON DEVICE "+CHR$(DV(K4)+65)+" AT DISC ADDRESS";EA 51000 REM ERROR MESSAGE PRINT CODE ENTRY AT '51000' CLOSES FILE 51020 CLOSE 51040 REM ENTRY ST '51050' DOES NOT CLOSE THE CHANNEL 51050 PRINT:PRINT:PRINT"***** ERROR *****":PRINT:PRINT 51051 XC=XC+1:IFXC<2GOTO51060 51052 PRINT"** CHECK TO SEE IF THE DISKETTE(S) ARE IN THE PROPER DRIVE **":PRINT 51060 PRINT ERR$: ERR$="" 51100 REM COMMON EXIT PATH 51101 IFER<1THENFORX=1TO32:PRINT:NEXT 51105 IF ER<1THENPRINT"*** END OF INSERTION ***" 51106 PRINT:INPUT"ENTER A C TO CONTINUE ";QS$:FORX=1TO32:PRINT:NEXT 51110 DEVCHR$(DV(K1)+65):REM SELECT ORIGINAL DEVICE 51120 POKE2972,58:POKE2976,44:REM DISABLE :,& IN DATA FIELD 51130 FLAG12:REM DISABLE SPACE SUPP 51150 CLOSE:RUN"DBMSYS","PASS"