DataMuseum.dk

top - metrics - download

    Length: 8176 (0x1ff0)
    Notes: OS65UFile, OSU65U-BASIC
    Names: »MACCRE«

└─⟦2f57871a3⟧ Bits:30009355 Ohio Scientific OS-OMS Nucleus, delvist oversat til dansk
    └─⟦this⟧ »MACCRE« 

BASIC

00001 PRINT"THIS PROGRAM NOT EXECUTABLE FROM THE CONSOLE": STOP
00002 REM ENTRY INTO ALL PROGRAMS HERE (PROG=7727 BYTE(S) )
00005 REM MACCRE (CREATE WITH PARAM'S PASSED IN 'PASVAL')
00010 HS=72898560
00011 FS=275968
00020 FLAG 9: REM REPLACED POKE FOR 'GOTO 50000' WITH FLAG
00110 CB=9889: JV=8778: VL=192: VH=36
00115 REM POKE USR VECTOR
00120 POKE JV,VL: POKE JV+1,VH
00130 REM POKE PTR'S TO GET$ AND PUT$
00170 ZV=9431: POKE ZV+1,243: POKE ZV+2,40
00180 POKE ZV+4,232: POKE ZV+5,40
00200 ST=9899: LS=9902
00205 REM PICKUP LOCATION AND SIZE OF THE DIRECT.
00210 EN=PEEK(ST)*256+PEEK(ST+1)*65536+PEEK(ST+2)*16777216
00215 IF EN=3584 THEN FG=1: REM CHK FOR DIR ON TRK #1.
00220 ES=PEEK(LS)*256+PEEK(LS+1)*65536+PEEK(LS+2)*16777216
00230 EN=EN+ES: REM EN NOW EQUALS END OF DIR.
00240 REM SET S.O.T. TO START OF DIRECT.
00250 DB=16: DL=PEEK(ST): DM=PEEK(ST+1): DH=PEEK(ST+2): OF=0
00300 REM INPUT PARAMS FROM DATA FILE
00310 OPEN"PASVAL","PASS",1
00320 INPUT %1,DV$(1): REM GET DEV TO CREATE ON
00330 INPUT %1,F$: REM GET FILE NAME
00340 INPUT %1,BN: REM GET FILE LENGTH
00350 INPUT %1,E$: REM GET FILE TYPE
00360 INPUT %1,A$: REM GET ACCESS RIGHTS
00370 INPUT %1,PW$: REM GET PASSWORD
00380 INPUT %1,DV$(2): REM GET DEV TO RETURN TO
00390 INPUT %1,CALLER$: REM GET CALLER'S NAME
00392 INPUT %1,PW$(2): REM GET CALLER'S PASSWORD
00394 INPUT %1,R: REM GET CALLER'S RETURN LINE NUMBER
00399 REM POKE L.O.T.
00400 NL=0: NH=1: POKE CB+5,NL: POKE CB+6,NH
00500 RL=242: RH=38: POKE CB+7,RL: POKE CB+8,RH
00505 REM CRUNCH DEVICE
00510 IF DV$(1)>="A" AND DV$(1)<="E" THEN GOTO 530
00520 ERR$="DEVICE SELECT = "+DV$(1): GOTO 41000
00530 DV(1)=PEEK(9832): IF DV(1)>127 THEN DV(1)=DV(1)-128+4
00532 DEV DV$(1)
00534 IF DV$(1)<"E" THEN DV$(1)="FL": GOTO 550
00538 IF DV$(1)>"D" THEN DV$(1)="HD"
00540 REM CRUNCH NAME
00550 F(1)=LEN(F$)
00560 IF F(1)=6 GOTO 590: REM R1*
00570 ERR$="NAME LENGTH = "+STR$(F(1)): GOTO 41000
00580 REM R1*
00590 FOR X=1 TO 6: NF(X)=ASC(MID$(F$,X,1)): NEXT X
00600 REM CRUNCH LENGTH
00610 IF BN=INT(BN) AND BN>0 GOTO 630
00620 ERR$="DISC LENGTH = "+STR$(BN): GOTO 41000
00630 BN=BN+271: LH=INT(BN/16777216)
00635 BN=INT(BN/256)*256
00640 OB=BN-LH*16777216: LM=INT(OB/65536)
00650 OB=OB-LM*65536: LL=INT(OB/256)
00660 REM CRUNCH ACCESS RIGHTS
00670 IF A$="N" THEN AR=0: GOTO 720
00680 IF A$="R" THEN AR=1: GOTO 720
00690 IF A$="W" THEN AR=2: GOTO 720
00700 IF A$="RW" THEN AR=3: GOTO 720
00710 ERR$="ACCESS RIGHTS = "+A$: GOTO 41000
00720 REM CRUNCH FILE TYPE
00730 IF E$="D" THEN EY=0: GOTO 770
00740 IF E$="B" THEN EY=1: GOTO 770
00750 IF E$="O" THEN EY=2: GOTO 770
00760 ERR$="TYPE = "+E$: GOTO 41000
00770 AS=AR+EY*4
00780 REM CRUNCH PASSWORD
00790 IF PW$="." THEN PL=0: PH=0: PW$="ANAN": GOTO 1020: REM R1*
00800 IF LEN(PW$)=4 GOTO 820
00810 ERR$="PASSWORD = "+PW$: GOTO 41000
00820 FOR X=1 TO 4: PW(X)=ASC(MID$(PW$,X,1)): NEXT X
00830 IF PW(1)<65 OR PW(1)>80 THEN PW(1)=15: GOTO 850
00840 PW(1)=PW(1)-65
00850 IF PW(2)<78 OR PW(2)>93 THEN PW(2)=15: GOTO 870
00860 PW(2)=PW(2)-78
00870 IF PW(3)<65 OR PW(3)>80 THEN PW(3)=15: GOTO 890
00880 PW(3)=PW(3)-65
00890 IF PW(4)<78 OR PW(4)>93 THEN PW(4)=15: GOTO 910
00900 PW(4)=PW(4)-78
00910 PL=PW(2)+PW(1)*16: PH=PW(4)+PW(3)*16
01000 REM START OF DIR CRUNCH
01010 REM
01020 MX(1)=PEEK(ST): MX(2)=PEEK(ST+1): MX(3)=PEEK(ST+2)
01030 LX(1)=0: LX(2)=0: LX(3)=0: REM INITIAL LENGTH IS ZER0
01050 X=0: DD=0: GOSUB 35020: REM GET THE DIRECTORY
01080 RT=RL+RH*256+OF: IF PEEK(RT)=0 THEN EF=1: GOTO 1255
01085 REM PICKUP DISC ADDR. AND LENGTH
01090 FOR X=0 TO 2
01100 MX(X+1)=PEEK(RT+9+X): LX(X+1)=PEEK(RT+12+X)
01110 NEXT X
01120 REM CHK FOR DUPLICATE NAME
01140 SN=0: FOR X=0 TO 5
01150 IF PEEK(RT+X)=NF(X+1) THEN SN=SN+1: NEXT X
01160 IF SN<6 GOTO 1200
01170 ERR$=F$+" IS A PREVIOUSLY USED FILE NAME": GOTO 41000
01200 EF=0: OF=OF+16: REM BUMP PTR TO NEXT ENTRY IN DIR
01210 IF EF=0 AND (RT+32)<=(RL+(RH*256)+256) GOTO 1080
01215 PRINT"PLEASE WAIT"
01218 REM BUMP PAGE IN DISC ADDR
01220 DL=DL+1: IF DL>255 THEN DL=DL-256: DM=DM+1
01230 IF DM>255 THEN DM=DM-256: DH=DH+1
01240 DT=((DL*256)+(DM*65536)+(DH*16777216))
01250 OF=0: IF DT<EN GOTO 1050
01252 GOTO 1350: REM DIRECTORY FULL ERROR EXIT
01255 DT=((DL*256)+(DM*65536)+(DH*16777216))
01260 BF=(MX(1)*256)+(MX(2)*65536)+(MX(3)*16777216)
01270 BF=BF+((LX(1)*256)+(LX(2)*65536)+(LX(3)*16777216))
01280 REM CHK FOR DIR 'FULL'
01300 IF DV$(1)="FL" THEN BF=FS-BF
01310 IF DV$(1)="HD" THEN BF=HS-BF
01320 BF=BF-((LL*256)+(LM*65536)+(LH*16777216))
01340 IF RT-(RL+RH*256+16+DT)<=EN GOTO 1360
01350 ERR$="DIRECTORY FULL": GOTO 41000
01360 TT=((LX(1)*256)+(LX(2)*65536)+(LX(3)*16777216))
01370 TT=TT+(MX(1)*256+MX(2)*65536+MX(3)*16777216)
01380 TT=TT+(LL*256+LM*65536+LH*16777216)
01390 IF DV$(1)="FL" AND TT<=FS GOTO 1450
01400 IF DV$(1)="HD" AND TT<=HS GOTO 1450
01410 ERR$="TOO LONG": GOTO 41000
01420 REM
01430 REM GET FHP
01450 POKE CB+1,0: POKE CB+2,MX(1): POKE CB+3,MX(2): POKE CB+4,MX(3)
01460 X=0: DD=0: GOSUB 35050: REM BRING IN AREA CONTAINING FHP
01470 MX(4)=(MX(1)*256)+(MX(2)*65536)+(MX(3)*16777216)
01480 MX(5)=MX(4)+(LX(1)*256+LX(2)*65536+LX(3)*16777216)
01490 PF=0: IF INT(MX(4)/3584)=INT(MX(5)/3584) THEN PF=1: GOTO 1520
01500 FP=INT((MX(5)-INT(MX(5)/3584)*3584)/256)
01510 POKE 18208,FP: POKE 18320,FP
01520 PP=(PEEK(RL+RH*256+15) AND 240)
01530 IF PF=0 THEN PP=PP+15
01540 IF PF=1 THEN PP=PP+INT((MX(5)-INT(MX(5)/3584)*3584)/256)
01550 POKE RL+RH*256+15,PP
01555 REM WRITE OUT FHP
01560 X=1: DD=1: GOSUB 35050: REM WRITE OUT FHP
01610 Y=RL+RH*256+1: POKE CB+5,17: POKE CB+6,0: REM SET LOT
01611 IF FG<>1 GOTO 1620: REM SKIP IF DIR NOT ON TRK #1
01612 POKE CB+5,16: REM L.O.T. ADJ TO ELIMINATE LEADING <CR>
01613 REM  ADJ S.O.T. TO SKIP OVER LEADING <CR>
01614 TP(1)=PEEK(CB+7): TP(2)=PEEK(CB+8): PICKUP CURRENT S.O.T.
01615 TP(1)=TP(1)+1: IF TP(1)>255 THEN TP(1)=TP(1)-256: TP(2)=TP(2)+1
01616 POKE CB+7,TP(1): POKE CB+8,TP(2): REM POKE NEW S.O.T.
01620 FOR X=0 TO 5: POKE Y+X,NF(X+1): NEXT X: REM POKE OUT NAME
01630 POKE Y-1,13: REM POKE <CR> INTO END OF PREVIOUS FILE
01640 POKE Y+6,PL: POKE Y+7,PH: REM POKE PASSWORD
01650 POKE Y+8,AS: REM POKE ATTRIBUTES
01660 MX(6)=MX(1)+LX(1): MX(7)=MX(2)+LX(2): MX(8)=MX(3)+LX(3)
01670 IF MX(6)>255 THEN MX(6)=MX(6)-256: MX(7)=MX(7)+1
01680 IF MX(7)>255 THEN MX(7)=MX(7)-256: MX(8)=MX(8)+1
01700 POKE Y+9,MX(6): POKE Y+10,MX(7): POKE Y+11,MX(8)
01710 REM POKE LENGTH INTO FILE HEADER
01720 POKE Y+12,LL: POKE Y+13,LM: POKE Y+14,LH
01730 IF PF=1 THEN PP=INT((MX(4)-INT(MX(4)/3584)*3584)/256)*16
01740 IF PF=0 THEN PP=240
01750 POKE Y+15,PP: REM POKE PREV/NXT PTR
01760 IF FG=1 GOTO 1800: REM SKIP FOR DIR ON TRK #1
01770 MX(6)=MX(6)-1: IF MX(6)<0 THEN MX(6)=MX(6)+256: MX(7)=MX(7)-1
01780 IF MX(7)<0 THEN MX(7)=MX(7)+256: MX(8)=MX(8)-1
01790 REM POKE DISC ADR INTO CNTRL BLK
01800 POKE CB+1,255: POKE CB+2,MX(6): POKE CB+3,MX(7): POKE CB+4,MX(8)
01805 IF FG=1 THEN POKE CB+1,0: REM POKE 0 INTO DISC ADDR. LOW
01810 X=1: DD=1: GOSUB 35050: REM WRITE OUT FILE HEADER
01850 DB=DB+RT- (RL+RH*256)
01860 IF DB>255 THEN DB=DB-256: DL=DL+1
01870 IF DL>255 THEN DL=DL-256: DM=DM+1
01880 IF DM>255 THEN DM=DM-256: DH=DH+1
01900 RL=RL+1: IF RL>255 THEN RL=RL-256: RH=RH+1
01920 POKE CB+5,16: POKE CB+7,RL: POKE CB+8,RH
01930 X=1: DD=1: GOSUB 35020: REM WRITE OUT ENTRY TO DIR
02000 REM OUTPUT PARAMS TO DATA FILE
02005 ERR$="OK"
02040 DEV CHR$(DV(1)+65): INDEX<1>=0
02060 PRINT %1,ERR$: REM PRINT ERROR STATUS
02070 PRINT %1,F$: REM PRINT NAME
02080 DA=MX(6)*256+MX(7)*65536+MX(8)*16777216
02090 PRINT %1,DA: REM OUTPUT DISC START ADDR. OF FILE
02100 PRINT %1,BN: REM OUTPUT LENGTH OF FILE
02110 PRINT %1,E$: REM OUTPUT FILE TYPE
02120 PRINT %1,A$: REM OUTPUT FILE ACCESS RIGHTS
02130 PRINT %1,PW$: REM OUTPUT FILE'S PASSWORD
02160 CLOSE: REM CLOSE PARAM FILE
02170 DEV DV$(2): REM SELECT CALLER'S DEVICE
02180 POKE 8778,208: POKE 8779,16: REM RESTORE USR TO 'FC ERROR'
02185 REM R1* REMOVED POKE TO TURN OFF 'GOTO 50000'
02190 RUN CALLER$,PW$(2),R: REM RETURN TO CALLER
35020 POKE CB+1,DB: POKE CB+2,DL: POKE CB+3,DM: POKE CB+4,DH
35030 REM DD=0=READ   DD=1=WRITE
35050 ERR=3
35060 X=USR(DD)
35070 IF X=0 THEN RETURN
35080 IF X<>0 THEN ERR=ERR-1
35090 IF X<>0 AND ERR<>0 GOTO 35060
35095 ERR$="": REM RESET ERROR STRING
35100 IF DD=0 THEN ERR$="A READ "
35110 IF DD=1 THEN ERR$="A WRITE "
35120 ERR$=ERR$+"ERROR AT "
35130 FOR I=4 TO 1 STEP -1: ET=ET*256+PEEK(CB+I): NEXT I
35140 ERR$=ERR$+STR$(ET)+" "
35150 ERR$=ERR$+"ON DEVICE ": DV(1)=PEEK(9832)
35155 IF DV(1)>127 THEN DV(1)=DV(1)-128+4
35158 DV$(1)=CHR$(DV(1)+65): ERR$=ERR$+DV$(1)+" "
35160 ERR$=ERR$+"ERROR CODE "+STR$(X)
41000 REM ERROR EXIT PATH FOR SOFT ERRORS
41020 REM EXPAND ERROR RECOVERY HERE
41030 GOTO 2040: REM EXIT TO COMMON EXIT PATH
50000 REM 'ON DISC ERROR' ENTRY POINT
50020 ERR$="": REM NULL OUT ERROR MESSAGE STRING
50030 EC=PEEK(10226): REM EC=DISC ERROR CODE
50040 EL=PEEK(11174)+PEEK(11175)*256: REM LINE # WHERE ERR OCCURRED
50050 IF EC=133 THEN CLOSE 1: GOTO EL: REM 'FILE ALREADY OPEN' ERR
50060 IF EC=129 THEN OPEN"PASVAL","PASS",1: GOTO EL
50070 ERR$="ERROR "+STR$(EC)+" IN LINE "+STR$(EL)
50080 DV(1)=PEEK(9832): IF DV(1)>127 THEN DV(1)=DV(1)-128+4
50090 ERR$=ERR$+" ON DEVICE "+CHR$(DV(1)+65)
50100 GOTO 2040