DataMuseum.dk

top - download

    Length: 5056 (0x13c0)
    Types: TextFile
    Notes: Mikados_K
    Names: »NØDSTOP.K«

└─⟦5630b2e42⟧ Bits:30009005 START APRIL 1985 aft april 1985 (PASCAL kildetekster)
    └─⟦this⟧ »NØDSTOP.K« 
└─⟦6c21327e0⟧ Bits:30008986 LINIMATIC K-FILER (IKKE HELT UPTODTATE)
    └─⟦this⟧ »NØDSTOP.K« 

Mikados K File

PROGRAM NØDSTOP;
TYPE
PARMARRAY=PACKED ARRAY (1..39) OF CHAR;
NAME    =STRING(10);
PCB     =^INTEGER;
MESSAGETYPE=(ÅBEN,LUK,LÆSPOST,LÆSPOSTX,NÆSTE,NÆSTEX,SLET,SLETX,GEMPOST,
             INDSÆT,INITIER,UTILMELD,UAFMELD,PTILMELD,PAFMELD,STOPSYS,        
             RETURNHEAD,RETURNSTAT);                                    
MESSAGE =RECORD
           KOMMANDO:MESSAGETYPE;
           INFO:INTEGER 
         END;
CPSTAT  =RECORD
           CPPCB        :INTEGER;
           STATUS       :ARRAY (1..100) OF INTEGER
         END;
STATFILE=FILE OF CPSTAT;
AR      =ARRAY (0..0) OF INTEGER;
VAR               
FORCED  :^PARMARRAY;
CPSTATUS:STATFILE;
FUSK    :AR;
CPPCB   :PCB;
BESKED  :MESSAGE;
FNAVN   :STRING(20);
I,
MLÆNGDE,         
MSTATUS :INTEGER;
SEMAFOR :NAME;
PROCEDURE SENDM(RECEIVER:PCB;VAR CONTENTS:MESSAGE;
                LENGTH:INTEGER;VAR STATUS:INTEGER);EXTERNAL;
PROCEDURE RECEIV(VAR SENDER:PCB;VAR CONTENTS:MESSAGE;
                 VAR LENGTH:INTEGER);EXTERNAL;
PROCEDURE RESERV(RESOURCE:NAME;EXCLUSIVE,WAIT:BOOLEAN;
                 VAR STATUS:INTEGER);EXTERNAL;
PROCEDURE RELEAS(RESOURCE:NAME;VAR STATUS:INTEGER);EXTERNAL;
PROCEDURE IOC;
VAR     CH:STRING(1);
        IOR:INTEGER;
BEGIN
  IOR:=IORESULT;
  IF IOR<>0 THEN                            
  BEGIN                                     
    CLEARSCREEN;                            
    GOTOXY(1,10);                           
    WRITELN('Pladefejl ',IOR:5,' RETURN');  
    CH:=' ';                                
    EDIT(CH);                               
    IF CH<>'R' THEN EXIT(NØDSTOP)             
  END                                       
END;
 
BEGIN
  FNAVN:='CPSTATUS:P1:1:S';
  REWRITE(CPSTATUS,FNAVN);IOC;
  SEEK(CPSTATUS,1);IOC;
  GET(CPSTATUS);IOC;
  (*$R-*) FUSK(1):=CPSTATUS^.CPPCB;(*$R+*)
  CLOSE(CPSTATUS);
  REPEAT
    REPEAT
      GOTOXY(1,20);
      WRITE('FILNR ');
      READLN;READ(I)
    UNTIL IORESULT=0;
    IF I>0 THEN
    BEGIN
      BESKED.KOMMANDO:=LUK;
      BESKED.INFO:=I;
      (*$XT*) WRITELN('SENDM LUK'); (*$X-*)
      SENDM(CPPCB,BESKED,4,MSTATUS);
      IF MSTATUS<>0 THEN BEGIN WRITELN('2:',MSTATUS:5);READLN END;
      (*$XT*) WRITELN('RECEIV'); (*$X-*)
      RECEIV(CPPCB,BESKED,MLÆNGDE);
      IF BESKED.INFO<>0 THEN
      BEGIN
        WRITELN('LUKNING AFVIST, RETURN ',BESKED.INFO);
        READLN
      END 
    END
  UNTIL I=0
END.