DataMuseum.dk

top - download

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

└─⟦5630b2e42⟧ Bits:30009005 START APRIL 1985 aft april 1985 (PASCAL kildetekster)
    └─⟦this⟧ »CPLISTE.K« 

Mikados K File

PROGRAM MCPLISTE;
(*SKELET TIL ALM. PROGRAMMER, DER BRUGER ISF-SYSTEMET*)
CONST
      MAXRECSIZE=1000;
(*@@*)
      PROGRAMNR=3;
TYPE
PARMARRAY=PACKED ARRAY (1..39) OF CHAR;
NIVEAU=(MENIG,SERGENT,LØJTNANT,KAPTAJN,MAJOR,OBERST,GENERAL,HSM,UMULIUS);
POSTADR=0..MAXRECSIZE;
COMMBUF =ARRAY (POSTADR) OF INTEGER;(*commbuf(0)=filnr,resten er posten*)
POINTREC=^COMMBUF;
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,IREC:INTEGER 
         END;
AR=ARRAY (-4..-4) OF INTEGER;
ARAR=PACKED ARRAY(-11..-10) OF CHAR;
RAR=ARRAY (0..0) OF REAL;
VAR    PARM:^PARMARRAY;
       USERNIVEAU:NIVEAU;
       F:STRING(18);
       IER,MODE,IREC,STATUSER,REMUSERS,
       I:INTEGER;
       FNAVN:STRING(18);
       SEMAFOR:NAME;
       FILEINIT:BOOLEAN;
       SNYD:AR;
       CPPCB:PCB;
       COMREC:POINTREC;
       BESKED:MESSAGE;
(*$P*)
PROCEDURE BAD(IDENT,STATUS:INTEGER);
BEGIN
  GOTOXY(1,23);
  WRITE('BAD',IDENT:5,STATUS:5);
  READLN
END;
PROCEDURE ALLOCA(VAR ADDRESS:POINTREC;LENGTH:INTEGER;
                 VAR STATUS:INTEGER);
EXTERNAL;
PROCEDURE DEALLO(ADDRESS:POINTREC;VAR STATUS:INTEGER);
EXTERNAL;
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;
(*$IUDFØR*)
(*$P*)
BEGIN
  SEMAFOR:='ALLOCOMBUF';
(*@@KUN NØDVENDIGT, HVIS USERNIVEAU SKAL BRUGES
  I:=ORD(PARM^(1))-48;
  USERNIVEAU:=MENIG;
  WHILE I>0 DO
  BEGIN
    USERNIVEAU:=SUCC(USERNIVEAU);
    I:=I-1
  END;*)                                                              (*$R-*)
  SNYD(-3):=0;
  FOR I:=6 DOWNTO 2 DO SNYD(-3):=10*SNYD(-3)+ORD(PARM^(I))-48;
  IF PARM^(7)='-' THEN SNYD(-3):=-SNYD(-3);                           (*$R+*)
  UDFØR(PTILMELD,SNYD);
  UDFØRT(PTILMELD,SNYD);
  IF IER<>0 THEN BAD(1,IER);
  CLEARSCREEN;
  WRITE('Ikke-implementeret facilitet, RETURN ');
  READLN;
  UDFØR(PAFMELD,SNYD);
  UDFØRT(PAFMELD,SNYD);
  IF IER<>0 THEN BAD(2,IER);
  FNAVN:='       ';
  FOR I:=1 TO 7 DO FNAVN(I):=PARM^(I);
  CHAIN('HOVED   *1',FNAVN,CPPCB);
  IF IORESULT<>0 THEN WRITELN('IORESULT ',IORESULT)
END.