|
DataMuseum.dkPresents historical artifacts from the history of: MIKADOS |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about MIKADOS Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 2528 (0x9e0)
Types: TextFile
Notes: Mikados TextFile, Mikados_K
Names: »PURGE80«
└─⟦670c0171b⟧ Bits:30005246 COMAL-80 version 1.3 (MIKADOS)
└─ ⟦this⟧ »PURGE80«
└─⟦6980b4520⟧ Bits:30003618 MIKADOS start diskette med DDE COMAL-80 version 1.5
└─ ⟦this⟧ »PURGE80«
0100 // PNM 05.09.1980, COMAL80 VERSION 27.04.1982 0110 // PURGE80 0120 DIM NAVN$ OF 18,DREVN$ OF 9,FILNAVN$ OF 9,FILTYPE$ OF 1 0130 DIM SIDSTECHAR$ OF 1 0140 INTEGER FLAG,FOREVER,INDEX,Y 0150 PRINT 0160 PRINT "PURGE80 - SLET EN FIL" 0170 PRINT "PROGRAMMET STOPPES VED AT TRYKKE PAA ESC" 0180 REPEAT 0190 PRINT 0200 REPEAT 0210 NAVN$:="";FILNAVN$:="";DREVN$:="";FLAG,FOREVER:=0;INDEX:=1 0220 PRINT "INDTAST "; 0230 INPUT "'ETIKETTE:FILNAVN' FOR DEN FIL, DER 0NSKES SLETTET: ":NAVN$ 0240 EXEC KONVERTOGMOVE(NAVN$,INDEX,DREVN$,SIDSTECHAR$,FLAG) 0250 IF SIDSTECHAR$<>":" OR INDEX>9 OR INDEX=1 THEN FLAG:=1 0260 INDEX:=INDEX+1 0270 EXEC KONVERTOGMOVE(NAVN$,INDEX,FILNAVN$,SIDSTECHAR$,FLAG) 0280 IF LEN(FILNAVN$)>8 OR LEN(FILNAVN$)<1 OR NAVN$(18)<>"" THEN FLAG:=1 0290 IF SIDSTECHAR$=":" THEN FLAG:=1 0300 UNTIL FLAG=0 0310 REPEAT 0320 PRINT "INDTAST FILTYPE "; 0330 INPUT "(K FOR PROGRAM-/DATAFILER, B FOR BINAERFILER): ":FILTYPE$ 0340 UNTIL FILTYPE$="K" OR FILTYPE$="B" 0350 EXEC PURGE 0360 UNTIL FOREVER 0370 PROC PURGE 0380 CALL "SYSPROG:PERGE" 0390 IF FLAG<>0 THEN 0400 PRINT "PURGE MISLYKKEDES. FEJLKODE ";FLAG 0410 STOP 0420 ELSE 0430 PRINT DREVN$;":";FILNAVN$;" ER NU SLETTET" 0440 ENDIF 0450 ENDPROC PURGE 0460 PROC KONVERTOGMOVE(NFRA$,REF I,REF NTIL$,REF CH$,REF F) 0470 Y:=1 0480 REPEAT 0490 CH$:=NFRA$(I) 0500 IF CH$=>"a" AND CH$<="å" THEN CH$:=CHR$(ORD(CH$)-32) 0510 IF CH$<>":" THEN 0520 IF (CH$=>"0" AND CH$<="9") OR (CH$=>"A" AND CH$<="Å") OR CH$="_" THEN 0530 NTIL$(Y):=CH$;Y:=Y+1;I:=I+1 0540 ELSE 0550 IF CH$<>"" THEN 0560 F:=1 0570 EXIT // ULOVLIGT TEGN 0580 ENDIF 0590 ENDIF 0600 ENDIF 0610 UNTIL Y=LEN(NFRA$)+1 OR CH$=":" OR CH$="" OR LEN(NTIL$)=>9 OR I=>18 0620 ENDPROC KONVERTOGMOVE
20100 // PNM 05.09.1980, COMAL80 VERSION 27.04.19822▶0f◀0110 // PURGE80▶0f◀<0120 DIM NAVN$ OF 18,DREVN$ OF 9,FILNAVN$ OF 9,FILTYPE$ OF 1<▶19◀0130 DIM SIDSTECHAR$ OF 1▶19◀!0140 INTEGER FLAG,FOREVER,INDEX,Y!▶0b◀0150 PRINT ▶0b◀"0160 PRINT "PURGE80 - SLET EN FIL""50170 PRINT "PROGRAMMET STOPPES VED AT TRYKKE PAA ESC"5\f
0180 REPEAT \f
▶0b◀0190 PRINT ▶0b◀\f
0200 REPEAT \f
?0210 NAVN$:="";FILNAVN$:="";DREVN$:="";FLAG,FOREVER:=0;INDEX:=1?▶16◀0220 PRINT "INDTAST ";▶16◀G0230 INPUT "'ETIKETTE:FILNAVN' FOR DEN FIL, DER 0NSKES SLETTET: ":NAVN$G<0240 EXEC KONVERTOGMOVE(NAVN$,INDEX,DREVN$,SIDSTECHAR$,FLAG)<;0250 IF SIDSTECHAR$<>":" OR INDEX>9 OR INDEX=1 THEN FLAG:=1;▶13◀0260 INDEX:=INDEX+1▶13◀>0270 EXEC KONVERTOGMOVE(NAVN$,INDEX,FILNAVN$,SIDSTECHAR$,FLAG)>H0280 IF LEN(FILNAVN$)>8 OR LEN(FILNAVN$)<1 OR NAVN$(18)<>"" THEN FLAG:=1H$0290 IF SIDSTECHAR$=":" THEN FLAG:=1$▶11◀0300 UNTIL FLAG=0▶11◀\f
0310 REPEAT \f
▶1e◀0320 PRINT "INDTAST FILTYPE ";▶1e◀E0330 INPUT "(K FOR PROGRAM-/DATAFILER, B FOR BINAERFILER): ":FILTYPE$E'0340 UNTIL FILTYPE$="K" OR FILTYPE$="B"'▶0f◀0350 EXEC PURGE▶0f◀▶12◀0360 UNTIL FOREVER▶12◀▶0f◀0370 PROC PURGE▶0f◀▶19◀0380 CALL "SYSPROG:PERGE"▶19◀▶15◀0390 IF FLAG<>0 THEN ▶15◀.0400 PRINT "PURGE MISLYKKEDES. FEJLKODE ";FLAG.
0410 STOP
0420 ELSE
/0430 PRINT DREVN$;":";FILNAVN$;" ER NU SLETTET"/▶0b◀0440 ENDIF ▶0b◀▶12◀0450 ENDPROC PURGE▶12◀<0460 PROC KONVERTOGMOVE(NFRA$,REF I,REF NTIL$,REF CH$,REF F)< 0470 Y:=1 \f
0480 REPEAT \f
▶12◀0490 CH$:=NFRA$(I)▶12◀90500 IF CH$=>"a" AND CH$<="å" THEN CH$:=CHR$(ORD(CH$)-32)9▶16◀0510 IF CH$<>":" THEN ▶16◀K0520 IF (CH$=>"0" AND CH$<="9") OR (CH$=>"A" AND CH$<="Å") OR CH$="_" THEN K 0530 NTIL$(Y):=CH$;Y:=Y+1;I:=I+1
0540 ELSE
▶15◀0550 IF CH$<>"" THEN ▶15◀ 0560 F:=1 ▶1a◀0570 EXIT // ULOVLIGT TEGN▶1a◀▶0b◀0580 ENDIF ▶0b◀▶0b◀0590 ENDIF ▶0b◀▶0b◀0600 ENDIF ▶0b◀H0610 UNTIL Y=LEN(NFRA$)+1 OR CH$=":" OR CH$="" OR LEN(NTIL$)=>9 OR I=>18H▶1a◀0620 ENDPROC KONVERTOGMOVE▶1a◀▶00◀▶00◀▶00◀▶00◀▶00◀▶1a◀▶01◀+▶1b◀▶01◀#Af▶01◀ ▶00◀▶00◀▶00◀▶00◀▶00◀▶00◀TE:=CD"▶10◀ INX B▶10◀▶12◀ MOV A,E▶12◀▶10◀ STAX B▶10◀▶10◀ INX B▶10◀▶12◀ MOV A,D▶12◀" STAX B ;SIDSTE:=CD"▶12◀ POP PSW▶12◀
RET
▶01◀ ▶01◀(FIRST: LDAX B ;A:=KÆDENS LÆNGDE(▶1e◀ ANA A ;TEST A▶1e◀) JZ FEMPT ;JMP HVIS TOM KÆDE)▶10◀ DCR A▶10◀* STAX B ;LÆNGDE:=LÆNGDE - 1*! INX B ;BC->FIRST!\r LDAX B\r! MOV E,A ;DE:=FIRST!▶10◀ INX B▶10◀▶10◀ LDAX B▶10◀▶12◀ MOV D,A▶12◀' DCX B ;BC->FIRST(IGEN)'& LDAX D ;FIRST:=CD.LINK&▶10◀ STAX B▶10◀▶10◀ INX B▶10◀▶10◀ INX D▶10◀▶10◀ LDAX D▶10◀. STAX B ;FØRSTE(2):=CD.LINK(21).$ DCX D ;DE:= CD IGEN$▶1c◀ c