PACKET ds 4 access DEFINES ds 4 : 
 
PROC ds 4 : 
 INT VAR segment, block nr , i , adr , byte ; 
 TEXT VAR key , eingabe ; 
 BOOL VAR new headline ; 
 page ; 
 put ("Segment:") ; 
 get (segment) ; 
 ROW 256 INT VAR space ; 
 block nr := 0 ; 
 new headline := FALSE ; 
 REP 
  IF new headline THEN out (""1""5"") 
  ELSE page 
  FI ; 
  put (" Segment:") ; put (text(segment,5)) ; (* Cursor 1-16 *) 
  put (", Block:") ; put (text(block nr,5)) ; (* Cursor 17-31 *) 
  put (", Wortaddr:") ; out (hex8 (segment)) ; 
                        put (text(hex16((""0""+code(blocknr))ISUB1),5)) ; 
  put ("Wahl : + - e s b w a h d o") ; (* ^ Cursor 32 - 51 *) 
  IF NOT new headline THEN 
     line ; (* ^ 52 - 77 *)
     adr := (""0"" + code (block nr)) ISUB 1 ; 
     FOR i FROM 0 UPTO 255 REP 
       space (i+1) := get word (segment, i + adr) 
     PER ; 
     dump (space) 
  FI ; 
  out (""1"") ; 
  new headline := FALSE ; 
  inchar (key) ; 
  out (key) ; 
  IF key = "+" THEN IF block nr = 255 
                       THEN block nr := 0 ; 
                            segment INCR 1 
                       ELSE block nr INCR 1 
                    FI
  ELIF key = "-" THEN IF block nr = 0 AND segment > 0
                         THEN block nr := 255 ; 
                              segment DECR 1 
                      ELIF block nr > 0 THEN block nr DECR 1 
                      FI
  ELIF key = "s" THEN cursor (11,1) ;
                      eingabe := text (segment) ;
                      editget (eingabe, 1000, 5) ; 
                      segment := int (eingabe) 
  ELIF key = "b" THEN cursor (26,1) ; 
                      eingabe := hex8 (block nr) ;
                      editget (eingabe, 1000, 5) ; 
                      block nr := integer (eingabe) 
  ELIF key = "w" THEN cursor (44,1) ; 
                      eingabe := hex16 (adr) ; 
                      edit get (eingabe, 1000, 5) ; 
                      adr := integer (eingabe) ; 
                      eingabe := hex16 (get word (segment, adr)) ; 
                      cursor (32,1) ; 
                      put (",NeuesWort:") ; 
                      editget (eingabe, 1000,5) ; 
                      put word (segment, adr, integer (eingabe)) ; 
  ELIF key = "d" THEN cursor (32,1) ; 
                      new headline := TRUE ; 
                      put (", Dez->Hex:") ; 
                      REAL VAR r ; 
                      get (r) ; 
                      cursor (32,1) ; 
                      put (", - Taste - Hex:") ; 
                      IF r < 256.0 AND r >= 0.0 THEN put (hex8 (int(r))) 
                      ELIF r < 0.0 THEN put (hex16 (int (r))) 
                      ELIF r < 32768.0 THEN put (hex16 (int(r))) 
                      ELSE put (hex16 (int (r - 65536.0))) 
                      FI ; pause
  ELIF key = "h" THEN cursor (32,1) ; 
                      new headline := TRUE ; 
                      put (", Hex->Dez:") ; 
                      getline (eingabe) ; 
                      cursor (32,1) ; 
                      put (", - Taste - Dez:") ; 
                      put (integer (eingabe)) ; 
                      IF integer (eingabe) < 0 THEN put (",  Positiv:") ; 
                         put (positiv (eingabe)) 
                      FI ; pause 
  ELIF key = "a" THEN cursor (32,1) ; 
                      new headline := TRUE ; 
                      put (", ASCII->Hex (Taste)"5"") ; 
                      inchar (eingabe) ; 
                      put (" = ") ; put (hex8 (code (eingabe))) ; 
                      put ("- Taste -") ; 
                      pause 
  ELIF key = "o" THEN cursor (32,1) ; 
                      new headline := TRUE ; 
                      put (", Hex->0Opcde:") ; 
                      getline (eingabe) ; 
                      cursor (32,1) ; 
                      put (", - Taste - :") ; 
                      put (eumel0 opcode (integer (eingabe))) ; 
                      pause 
 FI ; 
 UNTIL key = "e" PER ; 
 
ENDPROC ds 4 ; 
 
PROC dump (ROW 256 INT CONST page) : 
 INT VAR i,j ,k ;
 TEXT VAR t := "                        " ;
 k := 1 ; j := 1 ; 
 put ("00:") ; 
 FOR i FROM 1 UPTO 256 WHILE incharety <> ""27""REP
   put hex16 (page (i)) ; 
   replace (t, j, ascii (page (i))) ; 
   j := j + 2 ; 
   IF ((j-1) MOD 8) = 0 THEN out (" ") FI ;
   IF k = 22 AND j = 9 THEN j := 25 ; 34 TIMESOUT " " FI ; 
   IF j = 25 THEN 
      out (" ") ; out (t) ; 
      replace (t, 1, "                        ") ;
      IF k < 22 THEN 
         line ;
         out(hex8 (i)); put (":") 
      FI ;
      k := k + 1 ; 
      j := 1 
  FI ;
PER ; 
ENDPROC dump ; 
 
 
TEXT PROC ascii (INT CONST wert) : 
 TEXT VAR t := "  " ; 
 replace (t, 1, wert) ; 
 IF (t SUB 1) < " " OR (t SUB 1) > ""126"" THEN replace (t, 1, ".") FI ; 
 IF (t SUB 2) < " " OR (t SUB 2) > ""126"" THEN replace (t, 2, ".") FI ;
 t 
ENDPROC ascii ; 
 
PROC put hex16 (INT CONST wert) :
 TEXT VAR t := "  " ; 
 replace (t, 1, wert) ; 
 out hex digit (code (t SUB 1) DIV 16) ; 
 out hex digit (code (t SUB 1) AND 15) ;
 out hex digit (code (t SUB 2) DIV 16) ; 
 out hex digit (code (t SUB 2) AND 15) ; 
ENDPROC put hex16 ;
 
PROC out hex9 (INT CONST wert) : 
 out hex digit (wert DIV 256) ; 
 out hex digit (wert DIV 16 AND 15) ; 
 out hex digit (wert AND 15) 
ENDPROC out hex9 ; 
 
TEXT PROC hex8 (INT CONST wert) : 
 hex digit (wert DIV 16) + 
 hex digit (wert AND 15) 
ENDPROC hex8 ; 
 
TEXT PROC hex16 (INT CONST wert) :
 TEXT VAR t := "  " ; 
 replace (t, 1, wert) ; 
 hex digit (code (t SUB 2) DIV 16) + 
 hex digit (code (t SUB 2) AND 15) + 
 hex digit (code (t SUB 1) DIV 16) + 
 hex digit (code (t SUB 1) AND 15) 
ENDPROC hex16 ;
 
TEXT PROC hex digit (INT CONST wert) : 
 IF wert < 10 THEN code (wert + 48) 
 ELSE code (wert + 55) 
 FI 
ENDPROC hex digit ; 
 
PROC out hex digit (INT CONST wert) : 
 IF wert < 10 THEN out (code (wert + 48)) 
 ELSE out (code (wert + 55)) 
 FI 
ENDPROC out hex digit ; 
 
INT PROC integer (TEXT CONST hex addr) : 
 INT VAR i ; 
 REAL VAR summe := 0.0 ; 
 FOR i FROM 1 UPTO length (hex addr) REP 
  summe := summe * 16.0 ; 
  summe INCR real (digit) 
 PER ; 
 IF summe > 32767.0 THEN int (summe - 65536.0)
 ELSE int (summe) 
 FI. 
 
digit : 
 TEXT CONST char := hex addr SUB i ; 
 IF char >= "a" THEN code (char) - 87 
 ELIF char >= "A" THEN code (char) - 55 
 ELSE code (char) - 48 
 FI 
ENDPROC integer ; 
 
REAL PROC positiv (TEXT CONST wert) : 
 INT VAR i ; 
 REAL VAR summe := 0.0 ; 
 FOR i FROM 1 UPTO length (wert) REP 
  summe := summe * 16.0 ; 
  summe INCR real (digit) 
 PER ; 
 summe . 
 
digit : 
 TEXT CONST char := wert SUB i ; 
 IF char >= "a" THEN code (char) - 87 
 ELIF char >= "A" THEN code (char) - 55 
 ELSE code (char) - 48 
 FI 
ENDPROC positiv ; 
 
TEXT PROC eumel0 opcode (INT CONST word) : 
 INT VAR op1 := (word AND 31744) DIV 1024 , 
         op2 := (word AND 768) DIV 128 , 
         low := word AND 255 , 
         long data := (word AND 768) * 2 + (word AND 255) ;
 IF word < 0 THEN op2 INCR 1 ; long data INCR 256 FI ; 
 SELECT op1 OF 
  CASE 0 : "LN " + text (low) 
  CASE 1 : "LN " + text (long data) 
  CASE 2 : "MOV " 
  CASE 3 : "INC1 " 
  CASE 4 : "DEC1 " 
  CASE 5 : "INC " 
  CASE 6 : "DEC " 
  CASE 7 : "ADD " 
  CASE 8 : "SUB " 
  CASE 9 : "CLEAR " 
  CASE 10 : "TEST " 
  CASE 11 : "EQU " 
  CASE 12 : "LSEQ " 
  CASE 13 : "FMOV " 
  CASE 14 : "FADD " 
  CASE 15 : "FSUB " 
  CASE 16 : "FMULT " 
  CASE 17 : "FDIV " 
  CASE 18 : "FLSEQ " 
  CASE 19 : "TMOV " 
  CASE 20 : "TEQU "
  CASE 21 : "LSEQU " 
  CASE 22 : "ACCDS " 
  CASE 23 : "REF " 
  CASE 24 : "SUBS " 
  CASE 25 : "SEL " 
  CASE 26 : "PPV " 
  CASE 27 : "PP " 
  CASE 28 : "BR " + hex8 (low) 
  CASE 29 : "BR " + hex16 (long data) 
  CASE 30 : "CALL " 
  OTHERWISE op 31 
 ENDSELECT. 
 
op31 : 
SELECT op 2 OF 
 CASE 0 : "IS """ + code (low) + """" 
 CASE 1 : "STIM " + hex8 (low) 
 CASE 2 : "MOVX " 
 CASE 3 : "PW " 
 CASE 4 : "GW " 
 CASE 5 : "PENTER " + hex8 (low) 
 CASE 6 : "ESC " + text (low) 
 CASE 7 : "LONGA " + eumel 0 opcode ((low AND 124) * 256) 
 OTHERWISE "?????" 
ENDSELECT 
ENDPROC eumel 0 opcode 
 
ENDPACKET ds 4 access