DataMuseum.dk

top - download

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

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

Mikados K File

PROGRAM START;
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(START)             
  END                                       
END;
 
BEGIN
  SEMAFOR:='CHECCPSTAT';
  (*$XT*) WRITELN('RESERV ',SEMAFOR); (*$X-*)
  RESERV(SEMAFOR,TRUE,TRUE,MSTATUS);
  IF MSTATUS<>0 THEN BEGIN WRITELN('1:',MSTATUS:5);READLN END;
  FNAVN:='CPSTATUS:P1:1:S';
  REWRITE(CPSTATUS,FNAVN);IOC;
  SEEK(CPSTATUS,1);IOC;
  GET(CPSTATUS);IOC;
  IF (CPSTATUS^.CPPCB=0) OR (FORCED^(1)='1') THEN
  BEGIN
    FNAVN:='CP       1';
    FNAVN(9):=CHR(16*3+1);
                   (*^BANKNR 1..4*)
    (*$XT*) WRITELN('CHAIN CP'); (*$X-*)
    CHAIN(FNAVN,' ',CPPCB);IOC;
    (*$R-*) CPSTATUS^.CPPCB:=FUSK(1); (*$R+*)
    SEEK(CPSTATUS,1);IOC;
    PUT(CPSTATUS);IOC 
  END 
  ELSE (*$R-*) FUSK(1):=CPSTATUS^.CPPCB;(*$R+*)
  CLOSE(CPSTATUS);
  BESKED.KOMMANDO:=UTILMELD;
  (*$XT*) WRITELN('SENDM UTILMELD'); (*$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);
  (*$XT*) WRITELN('RELEAS'); (*$X-*)
  RELEAS(SEMAFOR,MSTATUS);
  IF MSTATUS<>0 THEN BEGIN WRITELN('3:',MSTATUS:5);READLN END;
  IF BESKED.INFO<>0 THEN
  BEGIN
    WRITELN('TILMELDING AFVIST, RETURN ',BESKED.INFO);
    READLN
  END
  ELSE
  BEGIN
    FNAVN:='023456+';    
    IF (FORCED^(1)='Æ') AND (FORCED^(2) IN (.'0'..'8'.)) THEN
       FNAVN(1):=FORCED^(2);
          (*^NIVEAU*)
    (*$R-*)
    IF FUSK(1)<0 THEN
    BEGIN
      FUSK(1):=-FUSK(1);
      FNAVN(7):='-' 
    END;
    FOR I:=2 TO 6 DO 
    BEGIN (*CP'S PCB*)
      FNAVN(I):=CHR(FUSK(1) MOD 10 +48);        
      FUSK(1):=FUSK(1) DIV 10
    END;
    (*$R+*)
    (*$XT*) WRITELN('CHAIN HOVED'); (*$X-*)
    CHAIN('HOVED   *1',FNAVN,CPPCB);IOC
  END;
  (*$XT*) WRITELN('START STOPPER') (*$X-*)
END.