|
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: »RENAME80«
└─⟦670c0171b⟧ Bits:30005246 COMAL-80 version 1.3 (MIKADOS)
└─ ⟦this⟧ »RENAME80«
└─⟦6980b4520⟧ Bits:30003618 MIKADOS start diskette med DDE COMAL-80 version 1.5
└─ ⟦this⟧ »RENAME80«
0100 // PNM 05.09.1980, COMAL80 VERSION 24.04.1982 0110 // PURGE80 0120 DIM NAVN$ OF 18,DREVN$ OF 9,FILNAVN$ OF 9,FILTYPE$ OF 1 0130 DIM FILNA$ OF 9,SIDSTECHAR$ OF 1 0140 INTEGER FLAG,FOREVER,Y,INDEX 0150 PRINT 0160 PRINT "RENAME80 - AENDRING AF FILNAVN" 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 INPUT "INDTAST DET NUVAERENDE FILNAVN (MED ETIKETTE): ":NAVN$ 0230 EXEC KONVERTOGMOVE(NAVN$,INDEX,DREVN$,SIDSTECHAR$,FLAG) 0240 IF SIDSTECHAR$<>":" OR INDEX>9 OR INDEX=1 THEN FLAG:=1 0250 INDEX:=INDEX+1 0260 EXEC KONVERTOGMOVE(NAVN$,INDEX,FILNAVN$,SIDSTECHAR$,FLAG) 0270 IF LEN(FILNAVN$)>8 OR LEN(FILNAVN$)<1 OR NAVN$(18)<>"" THEN FLAG:=1 0280 IF SIDSTECHAR$=":" THEN FLAG:=1 0290 UNTIL FLAG=0 0300 REPEAT 0310 PRINT "INDTAST FILTYPE "; 0320 INPUT "(K FOR PROGRAM-/DATAFILER, B FOR BINAERFILER): ":FILTYPE$ 0330 UNTIL FILTYPE$="K" OR FILTYPE$="B" 0340 REPEAT 0350 FLAG:=0;NAVN$:="";FILNA$:="" 0360 INPUT "INDTAST DET NYE FILNAVN (UDEN ETIKETTE): ":NAVN$ 0370 INDEX:=1 0380 EXEC KONVERTOGMOVE(NAVN$,INDEX,FILNA$,SIDSTECHAR$,FLAG) 0390 IF LEN(FILNA$)>8 OR LEN(FILNA$)<1 THEN FLAG:=1 0400 UNTIL FLAG=0 0410 EXEC RENAME 0420 UNTIL FOREVER 0430 PROC RENAME 0440 CALL "SYSPROG:OMDØB" 0450 IF FLAG<>0 THEN 0460 PRINT "RENAME MISLYKKEDES. FEJLKODE ";FLAG 0470 STOP 0480 ELSE 0490 PRINT DREVN$;":";FILNAVN$;" ER OMDØBT TIL ";DREVN$;":";FILNA$ 0500 ENDIF 0510 ENDPROC RENAME 0520 PROC KONVERTOGMOVE(NFRA$,REF I,REF NTIL$,REF CH$,REF F) 0530 Y:=1 0540 REPEAT 0550 CH$:=NFRA$(I) 0560 IF CH$=>"a" AND CH$<="å" THEN CH$:=CHR$(ORD(CH$)-32) 0570 IF CH$<>":" THEN 0580 IF (CH$=>"0" AND CH$<="9") OR (CH$=>"A" AND CH$<="Å") OR CH$="_" THEN 0590 NTIL$(Y):=CH$;Y:=Y+1;I:=I+1 0600 ELSE 0610 IF CH$<>"" THEN 0620 F:=1 0630 // EXIT ;ULOVLIGT TEGN 0640 ENDIF 0650 ENDIF 0660 ENDIF 0670 UNTIL Y=LEN(NFRA$)+1 OR CH$=":" OR CH$="" OR LEN(NTIL$)=>9 OR I=>18 0680 ENDPROC KONVERTOGMOVE
20100 // PNM 05.09.1980, COMAL80 VERSION 24.04.19822▶0f◀0110 // PURGE80▶0f◀<0120 DIM NAVN$ OF 18,DREVN$ OF 9,FILNAVN$ OF 9,FILTYPE$ OF 1<%0130 DIM FILNA$ OF 9,SIDSTECHAR$ OF 1%!0140 INTEGER FLAG,FOREVER,Y,INDEX!▶0b◀0150 PRINT ▶0b◀+0160 PRINT "RENAME80 - AENDRING AF FILNAVN"+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?B0220 INPUT "INDTAST DET NUVAERENDE FILNAVN (MED ETIKETTE): ":NAVN$B<0230 EXEC KONVERTOGMOVE(NAVN$,INDEX,DREVN$,SIDSTECHAR$,FLAG)<;0240 IF SIDSTECHAR$<>":" OR INDEX>9 OR INDEX=1 THEN FLAG:=1;▶13◀0250 INDEX:=INDEX+1▶13◀>0260 EXEC KONVERTOGMOVE(NAVN$,INDEX,FILNAVN$,SIDSTECHAR$,FLAG)>H0270 IF LEN(FILNAVN$)>8 OR LEN(FILNAVN$)<1 OR NAVN$(18)<>"" THEN FLAG:=1H$0280 IF SIDSTECHAR$=":" THEN FLAG:=1$▶11◀0290 UNTIL FLAG=0▶11◀\f 0300 REPEAT \f ▶1e◀0310 PRINT "INDTAST FILTYPE ";▶1e◀E0320 INPUT "(K FOR PROGRAM-/DATAFILER, B FOR BINAERFILER): ":FILTYPE$E'0330 UNTIL FILTYPE$="K" OR FILTYPE$="B"'\f 0340 REPEAT \f !0350 FLAG:=0;NAVN$:="";FILNA$:=""!<0360 INPUT "INDTAST DET NYE FILNAVN (UDEN ETIKETTE): ":NAVN$<\r0370 INDEX:=1\r<0380 EXEC KONVERTOGMOVE(NAVN$,INDEX,FILNA$,SIDSTECHAR$,FLAG)<30390 IF LEN(FILNA$)>8 OR LEN(FILNA$)<1 THEN FLAG:=13▶11◀0400 UNTIL FLAG=0▶11◀▶10◀0410 EXEC RENAME▶10◀▶12◀0420 UNTIL FOREVER▶12◀▶10◀0430 PROC RENAME▶10◀▶19◀0440 CALL "SYSPROG:OMDØB"▶19◀▶15◀0450 IF FLAG<>0 THEN ▶15◀/0460 PRINT "RENAME MISLYKKEDES. FEJLKODE ";FLAG/ 0470 STOP 0480 ELSE B0490 PRINT DREVN$;":";FILNAVN$;" ER OMDØBT TIL ";DREVN$;":";FILNA$B▶0b◀0500 ENDIF ▶0b◀▶13◀0510 ENDPROC RENAME▶13◀<0520 PROC KONVERTOGMOVE(NFRA$,REF I,REF NTIL$,REF CH$,REF F)< 0530 Y:=1 \f 0540 REPEAT \f ▶12◀0550 CH$:=NFRA$(I)▶12◀90560 IF CH$=>"a" AND CH$<="å" THEN CH$:=CHR$(ORD(CH$)-32)9▶16◀0570 IF CH$<>":" THEN ▶16◀K0580 IF (CH$=>"0" AND CH$<="9") OR (CH$=>"A" AND CH$<="Å") OR CH$="_" THEN K 0590 NTIL$(Y):=CH$;Y:=Y+1;I:=I+1 0600 ELSE ▶15◀0610 IF CH$<>"" THEN ▶15◀ 0620 F:=1 ▶1b◀0630 // EXIT ;ULOVLIGT TEGN▶1b◀▶0b◀0640 ENDIF ▶0b◀▶0b◀0650 ENDIF ▶0b◀▶0b◀0660 ENDIF ▶0b◀H0670 UNTIL Y=LEN(NFRA$)+1 OR CH$=":" OR CH$="" OR LEN(NTIL$)=>9 OR I=>18H▶1a◀0680 ENDPROC KONVERTOGMOVE▶1a◀▶00◀▶00◀ BE INVOKED.▶17◀C;******************************************************************C▶01◀;▶01◀▶01◀;▶01◀▶0b◀ COND▶0b◀A CONSM:P3 ;DEFINITION OF RELATIVE ADDR. IN WORK AREAA▶01◀;▶01◀▶01◀;▶01◀▶0b◀ ROOT▶0b◀▶07◀CONSB::▶07◀▶01◀;▶01◀▶01◀;▶01◀▶07◀NIV50::▶07◀▶07◀NIV65::▶07◀6 PUSH PSW ;SAVE REGISTERS AFTER INTERRUPT6▶10◀ PUSH B▶10◀▶10◀ PUSH D▶10◀▶10◀ PUSH H▶10◀▶01◀;▶01◀- MVI D,3 ;INTERRUPT STATUS MASK-▶01◀;▶01◀= LXI H,CN1BF ;DETERMINE INTERRUPTING INTERFACE PORT=▶16◀ MVI E,C1DAc