DataMuseum.dk

top - download

    Length: 4992 (0x1380)
    Types: TextFile
    Notes: Mikados_K
    Names: »SKELETON.K«

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

Mikados K File

PROGRAM SKELETON;
(*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*)
(*$IFISFPROC*)
(*$P*)
PROCEDURE REGVEDL;
(*@@BRUGERPOSTER, F.EKS.*)
TYPE
PPOST=RECORD
      AA:ARAR;
      A:AR;
      AAA:RAR;
      CONTENTS: ARRAY (1..100) OF INTEGER
END;
(*@@BRUGERVARIABLE, F.EKS.*)
VAR
    POST:PPOST;
(*$P*)
PROCEDURE ERROR(VAR REC:AR);
VAR CH:STRING(1);
BEGIN
                                                                      (*$R-*)
  WRITELN('FEJL I REGISTER ',REC(-3),' FEJLKODE ',IER,' RETURN');     (*$R+*)
  CH:=' ';EDIT(CH);
  ICLOSE(POST.A);
  EXIT(REGVEDL)
END;
PROCEDURE OFEJL(VAR REC:AR);
VAR I:INTEGER;
BEGIN
  GOTOXY(1,20);                                                       (*$R-*)
  WRITELN('REGISTERFEJL ',IER,' I ',REC(-3),                           
          ' . SITUATIONEN ER FORSØGT REDDET.');                       (*$R+*)
  WRITELN('TAST 0, HVIS DER SKAL FORTSÆTTES');                         
  REPEAT GOTOXY(40,21);READLN;READ(I) UNTIL IORESULT=0;
  IF I<>0 THEN ERROR(REC);
  CLEARSCREEN
END;
(*@@BRUGERPROGRAMMETS PROCEDURER, EVT. BRUGERPROGRAMMET SOM EN PROCEDURE*)
(*$P*)
BEGIN
  CLEARSCREEN;
(*@@ÅBNING AF EN ISF-FIL, EKS.*)                                      (*$R-*)
  POST.A(-3):=5; (*FILNR*)                                            (*$R+*)
  MODE:=3;(*SKRIV*)
  IOPEN(POST.A);IF IER<>0 THEN OFEJL(POST.A);
(*@@EKSEMPEL SLUT*)
        
(*@@BRUGERHOVEDPROGRAM, ELLER KALD AF SAMME*)
                   
(*@@LUKNING AF EN ISF-FIL*)
  ICLOSE(POST.A);
  CLEARSCREEN;
  IF IER<>0 THEN BAD(6,IER)
END;
(*$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);
  REGVEDL;
  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('L       *1',CONCAT('HOVED:P1,',FNAVN),CPPCB);
  IF IORESULT<>0 THEN WRITELN('IORESULT ',IORESULT)
END.