DataMuseum.dk

top - download

    Length: 7586 (0x1da2)
    Types: TextFile
    Names: »HELP.S«

└─⟦f81e11cf7⟧ Bits:30005196 8" CR80 Floppy CR80FD_0194 ( CR/D/2497 TEST-TDX VS0102 Source moduler Att. Holger Bay 820208/AEK )
    └─⟦d066df9e9⟧ 
        └─ ⟦this⟧ »HELP.S« 

TextFile

«ff»
"HELP.S          "
"----------------"

FUNCTION GET_PARAM_INDEX(PARAMNAME : NAME_TYPE) : INTEGER;
"**********************************************************************
  AUTHOR:           TLM
  DATE:             810317
***********************************************************************
  COMMENTS:
***********************************************************************
  CHANGE RECORD:
  VERSION    AUTHOR/DATE    DESCRIPTION OF CHANGE
  -------    -----------    ---------------------
**********************************************************************"
VAR   I           : INTEGER;
      FOUND       : BOOLEAN;
BEGIN
   I := 0;
   FOUND := FALSE;
   IF PARAMETERCOUNT >= 1 THEN
      REPEAT
         I := SUCC(I);
         IF PARAMNAME = FORM_PARAMS[I].NAME THEN
         BEGIN
            FOUND := TRUE;
            GET_PARAM_INDEX := I;
         END;
      UNTIL FOUND OR (I = PARAMETERCOUNT);
   IF NOT FOUND THEN GET_PARAM_INDEX := -1;
END; " GET_PARAM_INDEX "
«ff»
FUNCTION GET_PROCEDURE_ADR(PROCNAME : NAME_TYPE) : INTEGER;
"**********************************************************************
  AUTHOR:           TLM
  DATE:             810317
***********************************************************************
  COMMENTS:
***********************************************************************
  CHANGE RECORD:
  VERSION    AUTHOR/DATE    DESCRIPTION OF CHANGE
  -------    -----------    ---------------------
**********************************************************************"
VAR   I        : INTEGER;
      FOUND    : BOOLEAN;
BEGIN
   I := 0;
   FOUND := FALSE;
   IF PROCEDURECOUNT >= 1 THEN
      REPEAT
         I := SUCC(I);
         IF PROCNAME = PROCEDURES[I].NAME THEN
         BEGIN
            GET_PROCEDURE_ADR := PROCEDURES[I].CODE_ADR;
            FOUND := TRUE;
         END;
      UNTIL FOUND OR (I = PROCEDURECOUNT);
   IF NOT FOUND THEN GET_PROCEDURE_ADR := -1;
END; " GET_PROCEDURE_ADR "
«ff»
FUNCTION GET_PARAMETER_COUNT(PROCNAME : NAME_TYPE) : INTEGER;
"**********************************************************************
  AUTHOR:           TLM
  DATE:             810402
***********************************************************************
  COMMENTS:
***********************************************************************
  CHANGE RECORD:
  VERSION    AUTHOR/DATE    DESCRIPTION OF CHANGE
  -------    -----------    ---------------------
**********************************************************************"
VAR   I        : INTEGER;
      FOUND    : BOOLEAN;
BEGIN
   I := 0;
   FOUND := FALSE;
   IF PROCEDURECOUNT >= 1 THEN
      REPEAT
         I := SUCC(I);
         IF PROCNAME = PROCEDURES[I].NAME THEN
         BEGIN
            GET_PARAMETER_COUNT := PROCEDURES[I].NO_OF_PARAMS;
            FOUND := TRUE;
         END;
      UNTIL FOUND OR (I = PROCEDURECOUNT);
   IF NOT FOUND THEN GET_PARAMETER_COUNT := -1;
END; " GET_PARAMETER_COUNT "
«ff»
PROCEDURE GET_FD(CRID : INTEGER; VAR F : FILE);
"**********************************************************************
  AUTHOR:           TLM
  DATE:             810319
***********************************************************************
  COMMENTS:
***********************************************************************
  CHANGE RECORD:
  VERSION    AUTHOR/DATE    DESCRIPTION OF CHANGE
  -------    -----------    ---------------------
**********************************************************************"
VAR   I        :  INTEGER;
      FOUND    :  BOOLEAN;
BEGIN
   I := 0;
   FOUND := FALSE;
   F := -1;
   REPEAT
      I := SUCC(I);
      IF CHANNELS[I].OPEN THEN
         IF CHANNELS[I].CRID = CRID THEN
         BEGIN
            FOUND := TRUE;
            F := CHANNELS[I].F;
         END;
   UNTIL FOUND OR (I >= MAX_CHANNEL);
END; " GET_FD "
«ff»
PROCEDURE GET_PARAMETER(VM, PARAMNO, PC, SP : INTEGER; VAR P : INTEGER);
"**********************************************************************
  AUTHOR:           TLM
  DATE:             810319
***********************************************************************
  COMMENTS:
   This procedure decides whether the parameter is a variable or
   a constant.
   If it is a variable, it is fetched from the runtime stack,
   otherwise it is fetched from the code (relative to current pc)
   Parameter description:
      VM          :  variable mask showing if constant or variable
      PARAMNO     :  parameter index in code
      PC          :  current program counter
      SP          :  current runtime stack pointer
      P           :  parameter value (return)
***********************************************************************
  CHANGE RECORD:
  VERSION    AUTHOR/DATE    DESCRIPTION OF CHANGE
  -------    -----------    ---------------------
**********************************************************************"
BEGIN
   IF TESTBIT(VM, PARAMNO) THEN
      P := STACK[SP + CODE[PC + XPARAMS + PARAMNO] ]
   ELSE
      P := CODE[PC + XPARAMS + PARAMNO];
END; " GET_PARAMETER "
«ff»
PROCEDURE PERFORM_DUMP(BUFFERNO, PATTERNNO,
                       STARTADDR, ENDADDR : INTEGER);
"**********************************************************************
  AUTHOR:           TLM
  DATE:             810423
***********************************************************************
  COMMENTS:
**********************************************************************"
VAR   I, J, W     :  INTEGER;
      START       :  INTEGER;
BEGIN
   CLEARBREAKS;
   START := STARTADDR;
   IF PATTERNNO = 0 THEN
   BEGIN
      IF ((BUFFERNO >= 1) AND (BUFFERNO <= MAX_BUFFERS))
         AND
         ((START >= 0) AND (START <= MAX_BUFFER_SIZE))
      THEN
      BEGIN
         START := START - (START MOD 16);
         REPEAT
            WRITENL;
            WRITEHEX(START);
            WRITEBYTE('L');
            I := 0;
            J := 0;
            REPEAT
               IF ((START + I) <= MAX_BUFFER_SIZE) AND
                  ((START + I) < ENDADDR) THEN
               BEGIN
                  WRITEBYTE(' ');
                  WRITEHEX(BUFFERS[BUFFERNO].BUFFER[START + I]);
                  J := SUCC(J);
               END;
               I := SUCC(I);
            UNTIL I = 8;
            IF J < 8 THEN
               FOR W := J TO 7 DO WRITETEXT('      (:0:)');
            I := 0;
            REPEAT
               IF ((START + I) <= MAX_BUFFER_SIZE) AND
                  ((START + I) < ENDADDR) THEN
               BEGIN
                  IF I = 0 THEN WRITETEXT('  (:0:)');
                  FOR J := 1 TO 2 DO
                  BEGIN
                     W := BUFFERS[BUFFERNO].BUFFER[START + I];
                     CASE J OF
                        1 : W := IAND(W, #00FF);
                        2 : W := RIGHTSHIFT(W, 8)
                     END;
                     IF (W >= 32) AND (W < 127) THEN WRITEBYTE(CHR(W))
                                                ELSE WRITEBYTE('.');
                  END;
               END;
               I := SUCC(I);
            UNTIL I = 8;
            START := START + I;
         UNTIL BREAKED OR (START >= MAX_BUFFER_SIZE)
               OR (START >= ENDADDR);
         WRITENL;
      END
   END
   ELSE
      IF (PATTERNNO >= 1) AND (PATTERNNO <= MAX_PATTERNS) THEN
      BEGIN
         FOR I := 0 TO MAX_PATTERN_SIZE - 1 DO
         BEGIN
            IF (I MOD 8) = 0 THEN
            BEGIN
               WRITENL;
               WRITEHEX(I);
               WRITEBYTE('L');
            END;
            WRITEBYTE(' ');
            WRITEHEX(PATTERNS[PATTERNNO].PATTERN[I + 1]);
         END;
         WRITENL;
      END;
END; " PERFORM_DUMP "