DataMuseum.dk

top - download

    Length: 9388 (0x24ac)
    Types: TextFile
    Names: »CONSOLE.S«

└─⟦18a2fd90d⟧ Bits:30005144 8" CR80 Floppy CR80FD_0132 ( CR/D/2479 CRD2479: En-CPU CPU/CACHE TEST- PROGRAMMER node: master: CRP5 )
    └─⟦56889de57⟧ 
        └─ ⟦this⟧ »CONSOLE.S« 

TextFile

CONST "*****  GENERAL STATUS CONSTANTS  *****"

      BUSY = 15;

      "*****  MAP INSTRUCTIONS FOR AV24 I/O PORT *****"

      WRITE_BLOCKSIZE    = #89D3;
      WRITE_TIME         = #89D4;
      WRITE_STOPCHAR     = #89D5;
      WRITE_MODE         = #89D6;

      READ_INPUT_STATUS  = #89D0;
      WRITE_INPUT_COMMAND= READ_INPUT_STATUS;

      READ_ISIZE         = #89D1;
      READ_ISTART        = #89D2;

      READ_INPUT_DATA    = #8C00;

      READ_OUTPUT_STATUS = #89D8;
      WRITE_OUTPUT_COMMAND = READ_OUTPUT_STATUS;

      WRITE_OSIZE        = #89D9;
      WRITE_OSTART       = #89DA;

      WRITE_OUTPUT_DATA  = #8E00;

      "****** OC INTERFACE ******"

      BLOCKSIZE = 511;
      STOPCHAR  =  13;
      TIME      =  0 ;  "NO TIMEOUT WILL OCCUR
      AUTO_ECHO_MODE = 1;  "ON


      "****** CONDITIONAL COMPILATION *****"

      NRSIGN = FALSE;

VAR
      HEXCH : ARRAY [0..15] OF CHAR   ;  "ASCII CHARACTERS FOR"
                                         "HEX. INTEGERS       "

VAR
      CH_COUNT : INTEGER;      "POINTER TO CURRENT CHARACTER
      CH_COUNT1: INTEGER;

      LOC_COUNT,LOC_COUNT1: INTEGER;

      OUTBUF, INBUF : INTEGER;

      LAST_IN  : INTEGER;      "LAST INPUT CHARACTER READ
      BREAK_JUMP_LOC: INTEGER; "LOC TO BEE JUMPED TO AFTER 'BREAK'

INIT
      HEXCH [00..00] = '0';
      HEXCH [01..01] = '1';
      HEXCH [02..02] = '2';
      HEXCH [03..03] = '3';
      HEXCH [04..04] = '4';
      HEXCH [05..05] = '5';
      HEXCH [06..06] = '6';
      HEXCH [07..07] = '7';
      HEXCH [08..08] = '8';
      HEXCH [09..09] = '9';
      HEXCH [#A..#A] = 'A';
      HEXCH [#B..#B] = 'B';
      HEXCH [#C..#C] = 'C';
      HEXCH [#D..#D] = 'D';
      HEXCH [#E..#E] = 'E';
      HEXCH [#F..#F] = 'F';

      CH_COUNT   = 0;
      CH_COUNT1  = BLOCKSIZE + 1;  "FORCES READING OF FIRST BUFFER
      LAST_IN    = STOPCHAR     ;  "          DITTO

      LOC_COUNT = 0;
      LOC_COUNT1= 0;

      OUTBUF    = 0;
      INBUF     = 0;
"PAGE«ff»
EXPORT PROCEDURE INIT_OC
"======================"
                (R7;   " C   BREAK JUMP LOCATION
                 R6);            "LINK"
VAR S7, LINK: INTEGER;
BEGIN
  R6 => LINK;
  R7 => BREAK_JUMP_LOC;
  CIO(BLOCKSIZE=>R7, WRITE_BLOCKSIZE=>R6);
  CIO(TIME     =>R7, WRITE_TIME  =>R6);
  CIO(STOPCHAR   =>R7, WRITE_STOPCHAR=>R6);
  CIO(AUTO_ECHO_MODE =>R7, WRITE_MODE=>R6);
  BREAK_JUMP_LOC => R7;
  EXIT(LINK);
END; "INIT_IF"

"PAGE«ff»
FORWARD PROCEDURE OUTTEXT(R3;R6);

EXPORT
PROCEDURE FLUSHOUT (R6);
CONST
  TRANSMIT_DATA = #8000;
  OUTPUT_BUFFER_EMPTY = 8;
VAR
  LINK,S7: INTEGER;
BEGIN
  R6=>LINK;
  R7=>S7;
  CH_COUNT=>R6;
  IF R6 EXTRACT 1 <> 0
    THEN BEGIN
      WRITE_OUTPUT_DATA=>R7 IOR (LOC_COUNT=>R6);
      CIO(OUTBUF=>R6, R7);
    END;

  CIO(0=>R6, WRITE_OSTART=>R7);
  CIO(CH_COUNT=>R6, WRITE_OSIZE=>R7);

  0=>R6;
  R6=>CH_COUNT; R6=>LOC_COUNT; R6=>OUTBUF;

  CIO(TRANSMIT_DATA=>R6, WRITE_OUTPUT_COMMAND=>R7);

  REPEAT
    SIO(R6, READ_OUTPUT_STATUS=>R7);
  UNTIL NOT R6[BUSY];

  S7=>R7;
  EXIT(LINK);
END;

"PAGE«ff»
EXPORT PROCEDURE OUTCHAR
"======================"
                  (R3;             "CHARACTER
                   R6);            "LINK"
VAR
  LINK,S3,S7: INTEGER;
BEGIN
  R6=>LINK; R3=>S3; R7=>S7;
  CH_COUNT=>R6;
  IF R6 EXTRACT 1 <> 0
    THEN
      BEGIN
        OUTBUF=>R7 IOR (R3 SHIFTLL 8);
        LOC_COUNT=>R3;
        CIO(R7, WRITE_OUTPUT_DATA=>R6 IOR R3);
        R3+1=>LOC_COUNT;
        0=>R7=>OUTBUF;
      END
    ELSE
      R3=>OUTBUF;
  ADDRESS(CH_COUNT)=>R6;
  INC(R6@INTEGER);
  IF R6@INTEGER >= BLOCKSIZE + 1 THEN FLUSHOUT(R6);
  S3=>R3; S7=>R7;
  EXIT(LINK);
END; "OUTCHAR"
«ff»
EXPORT PROCEDURE OUTTEXT
"======================"
                  (R3;     "ADDRESS OF TEXT"
                   R6);    "LINK"
"--------------------------------------------------------
" PRINT A STRING OF CHARACTERS
" TERMINATED BY (:0:)
"--------------------------------------------------------
VAR
  SAVEREGS: ARRAY [0..7] OF INTEGER;
BEGIN
   R7 => SAVEREGS[7];
   STC(6,ADDRESS(SAVEREGS[7])=>R7);
   R3 => R2;
   0=>R4;
   REPEAT
      OUTCHAR(R2@STRING[R4] => R3, R6);
      R4 + 1;
   UNTIL R3 = 0;
   UNS (7,ADDRESS(SAVEREGS[0])=>R7);
   EXIT(R6);
END; "OUTTEXT"

"PAGE«ff»
EXPORT
PROCEDURE CHECKBREAK (R6);
"R3 IS DESTROYED IN CASE OF BREAK OR ERROR
CONST
  "BIT NUMBERS"
  BREAK       =  9;
  IOV         = 10;
  PARITY_ERR  = 11;
  TIMED_OUT   = 13;
VAR
  LINK: INTEGER;
BEGIN
  R6=>LINK;
  SIO(R6, READ_INPUT_STATUS=>R6);
  IF NOT R6[BUSY] THEN
  BEGIN
    IF R6[BREAK] THEN
    BEGIN
      OUTTEXT(ADDRESS(' *BREAK(:0:)')=>R3,R6);
      EXIT(BREAK_JUMP_LOC);
    END;
    IF R6[IOV] THEN
    BEGIN
      OUTTEXT(ADDRESS(' *OVERFLOW IN BUF(:0:)')=>R3,R6);
      EXIT(BREAK_JUMP_LOC);
    END;
    IF R6[PARITY_ERR] THEN
    BEGIN
      OUTTEXT(ADDRESS(' *PAR ERR IN BUF(:0:)')=>R3,R6);
      EXIT(BREAK_JUMP_LOC);
    END;
    IF R6[TIMED_OUT] THEN
    BEGIN
      OUTTEXT(ADDRESS(' *TIMED OUT(:0:)')=>R3,R6);
      EXIT(BREAK_JUMP_LOC);
    END;
  END;
  EXIT(LINK);
END;

"PAGE«ff»
EXPORT PROCEDURE OUTNEWLINE
"========================="
                           (R6);   "LINK"
"--------------------------------------------------------
" PRINT A CR CHARACTER ON THE CONSOLE
" THEN ISSUE 8 FILLER CHARACTERS ( NULLS) TO GIVE THE CARRIAGE
" TIME TO RETURN BEFORE THE NL (LINE FEED) CHARACTER IS ISSUED.
"--------------------------------------------------------
VAR S2, S3, S6 : INTEGER;
BEGIN
   R2 => S2; R3 => S3;   R6 => S6;
   OUTCHAR(CR => R3, R6);
   0 => R2;
   NULL => R3;
   REPEAT
      OUTCHAR( R3, R6);
   UNTIL ( R2 + 1) = 8;
   OUTCHAR( NL => R3, R6);
   FLUSHOUT(R6);
   S2 => R2;
   S3 => R3;
   EXIT(S6);
END; "OUTNEWLINE"
"PAGE«ff»
EXPORT PROCEDURE OUTHEX
"====================="
               (R3;        "INTEGER TO BE PRINTED"
                R6);       "LINK"
"--------------------------------------------------------
" OUTPUT AN INTEGER IN ITS HEX.
" REPRESENTATION PRECEDED WITH A BLANK OR SHARP
"--------------------------------------------------------
VAR
  SAVEREGS: ARRAY [0..7] OF INTEGER;
BEGIN
   R7 => SAVEREGS[7];
   STC(6,ADDRESS(SAVEREGS[7])=>R7);

%WHEN NRSIGN = FALSE SKIP
   OUTCHAR('#'=>R3, R6);
%COMPILE
%WHEN NRSIGN = TRUE SKIP
   OUTCHAR(SP=>R3, R6);
%COMPILE
   SAVEREGS[3]=>R4;
   0 => R5;
   REPEAT
      R4 SHIFTLC 4;
      R4=>R6 EXTRACT 4;
      OUTCHAR(HEXCH[R6]=>R3, R6);
   UNTIL R5+1 = 4;

   CHECKBREAK(R6);

   UNS (7,ADDRESS(SAVEREGS[0])=>R7);
   EXIT(R6);
END; "OUTHEXA"

"PAGE«ff»

EXPORT PROCEDURE OUTINT
"====================="
               (R3;        "INTEGER TO BE PRINTED"
                R6);       "LINK"
"--------------------------------------------------------
" OUTPUT AN INTEGER IN ITS DECIMAL
" REPRESENTATION (UNSIGNED AND WITH LEADING ZEROES SUPPRESSED)
" THIS ROUTINE DON'T USE DIVIDE INSTRUCTION !!.
"--------------------------------------------------------
VAR
  SAVEREGS:   ARRAY[ 0..7] OF INTEGER;
  EXP_OF_TEN: ARRAY[ 1..4] OF INTEGER;
  LINE:       ARRAY [0..4] OF CHAR;

INIT
   EXP_OF_TEN = 10, 100, 1000, 10000;

BEGIN
   R7 => SAVEREGS[7];
   STC(6,ADDRESS(SAVEREGS[7])=>R7);

   4 => R4;
   REPEAT
     EXP_OF_TEN[ R4] => R1;
     0 => R0;
     0 => R2;
     WHILE R3 >= ( R2 + R1) DO  R0 + 1;
     R2 - R1;
     R3 - R2;
     R0 + '0' => LINE[ R4];
   UNTIL ( R4 - 1) = 0;
   R3 + '0' => LINE[ R4];

   TRUE => R0;
   4 => R4;
   REPEAT
      LINE[ R4] => R3;
      IF R0 = TRUE LOGAND R4 >= 1 LOGAND R3 = '0'
         THEN SP => R3
         ELSE FALSE => R0;
      OUTCHAR( R3, R6);
   UNTIL ( R4 - 1) < 0;


   UNS (7,ADDRESS(SAVEREGS[0])=>R7);
   EXIT(R6);
END; "OUT INTEGER"


"PAGE«ff»
EXPORT PROCEDURE IN_BYTE
"======================"
                        (R3;       "CHARACTER VALUE (RETURN)"
                         R6);       "LINK"
CONST
  CLEAR_INPUT_BUFFER = #8001;
  GET_DATA           = #8000;
  IBR = 8;
VAR
  SAVE: ARRAY [0..7] OF INTEGER;
BEGIN
  R7=>SAVE[7]; STC(6, ADDRESS(SAVE[7])=>R7);
  CH_COUNT1=>R0; LOC_COUNT1=>R1;
  IF R0 >= BLOCKSIZE+1 LOGOR LAST_IN=>R6 = STOPCHAR THEN
  BEGIN
    CIO(CLEAR_INPUT_BUFFER=>R7, WRITE_INPUT_COMMAND=>R6);
    REPEAT
      SIO(R7, READ_INPUT_STATUS=>R6);
    UNTIL NOT R7[BUSY];

    0=>R0; 0=>R1;
    CIO(GET_DATA=>R7, WRITE_INPUT_COMMAND=>R6);
    REPEAT
      CHECKBREAK(R6);
      SIO(R7, READ_INPUT_STATUS=>R6);
    UNTIL NOT R7[BUSY];

  END "NEW BUFFER";
  IF R0=>R6 EXTRACT 1 = 0
   THEN
     BEGIN
       SIO(R3, READ_INPUT_DATA=>R6 IOR R1);
       R3=>INBUF;
       R3 EXTRACT 7;
       R1+1=>LOC_COUNT1;
     END
   ELSE
     INBUF=>R3 SHIFTRL 8;

  R3=>LAST_IN;
  R3=>SAVE[3];

  R0+1=>CH_COUNT1;

  UNS(7,ADDRESS(SAVE[0])=>R7);
  EXIT(R6);
END; "IN_BYTE"

"page«ff»
type charclass = (alfa, numeric, delimiter);

export
procedure getchar (r0;  "char
                   r7;  "charclass
                   r6); "link
var
  s3,link: integer;
begin
  r6=>link; r3=>s3;
  in_byte (r3, r6); r3=>r0;
  if r3 >= 'A'
    then alfa=>r7
    else
  if r3 >= '0' logand r3 <'9'+1
    then numeric=>r7
    else delimiter=>r7;

  s3=>r3;
  exit(link);
end;

export
procedure inhexa (r3;  "hexa
                  r0;  "delimiter
                  r6); "link
var
   s7,link: integer;
begin
  r6=>link;
  r7=>s7;
  getchar (r0, r7, r6);
  0=>r3;
  while r7 < delimiter logand r0 < 'G' do
  begin
    if r7 = numeric then r0-'0' else r0-('A'-10);
    r3 shiftll 4 + r0;
    getchar (r0, r7, r6);
  end;
  s7=>r7;
  exit(link);
end;

 O