This is a cross-referenced version of readecma.plan, to download the unmodified
source try readecma.plan.
#PROGRAM /GFREADECMA(15AM,22AM,DBM,EBM)
#PAGE
#INCLUDE IOHEAD(/DEFS)
#INCLUDE STACK(/DEFS)
#INCLUDE ECMA(/DEFS)
#PERMANENT GFREADLN
#PROGRAM
# Read a 7bit ECMA character from the buffer.
# return -1 on EOL, caller must call READLN
# That means we need to know the difference between
# end of buffer and end of line.
# ERR = READECMA(FD)
# Conversion between ICL 6 bit and ECMA
# init:
# if (shifted) {
# shift = 0140; # alpha
# delta = FALSE;
# }
# if (!shift) {
# switch (ch) {
# case 000 ... 037: // '0' ... '?'
# return ch ^ 060;
# case 040 ... 077;
# return ch ^ 0140;
# }
# }
# else {
# if (delta) {
# switch (ch) {
# case 000 ... 037:
# output (ch ^ 020);
# break;
# case 064 ... 067:
# output (ch ^ 0150); // ^T => $
# break;
# case 070 .. 073:
# output (ch + 0104); // ^X => |
# break;
# }
# delta = false;
# }
# else {
# switch (ch) {
# case 000 ... 037:
# output (ch ^ 060);
# break;
#
# case 040 ... 073;
# output (ch ^ shift);
# break;
#
# case 074:
# shift = 0140; /* alpha */;
# break;
#
# case 075:
# shift = 0100; /* beta */
# break;
#
# case 076:
# delta = true;
# break;
#
# case 077:
# break;
#
# }
# }
# }
#SET ARGS=0
#DEFINE ARGFD=ARGS
#SET ARGS=ARGS+1
# Define stack frame
#SET STFRAME=SXFRAME
# Arguments
#DEFINE STFD=SXPAR1 [ FD
#SET STFRAME=STFRAME+1
# Locals
#DEFINE STDESC=STFRAME [ FDESC
#SET STFRAME=STFRAME+1
#DEFINE STRET=STFRAME [ return addr for internal
#SET STFRAME=STFRAME+1
STACK 2
OBEY ARGFD(1)
LDX 0 0(3) [ get FD
STO 0 STFD(2) [ save for later
ADN 1 ARGS
# Pascal callable entry point
#CUE GPREADECMA
BEGIN 2 3,1,STFRAME
LDX 0 STFD(2)
STO 0 SXPAR1(3) [ check if FD is open)
STOZ SXPAR2(3) [ read mode
CALL 1 GPIOCHECK
BNG 6 BYE
LDX 3 6 [ get FDESC to X3
LDX 7 FDSHIFTMOD(3) [ get current shift modifier
LDX 1 FDNEXT(3)
LDX 4 FDCHARS(3)
GET BNZ 4 *+2 [ carry on if buffer not empty
CALL 0 MORE [ get more data
SBN 4 1
LDCH 6 0(1) [ get char from buf
BCHX 1 *+1
STO 6 5
SBNC 5 #40 [ less than #40 no shifting
BCS NSHFT
BZE 7 SIX [ jif 6 bit input
SBN 5 #74-#40 [ is this a shift?
BNG 5 SHFT [ nope
BZE 5 ALFA [ jif alpha shift
SBN 5 1 [ is this a beta?
BZE 5 BETA
SBN 5 1 [ delta maybe?
BNZ 5 GET [ nope, filler, ignore
BNZ 4 *+2 [ something after the delta?
CALL 0 MORE [ get more data if not
SBN 4 1 [ consume char after delta
LDCH 6 0(1) [ get delta ch
BCHX 1 *+1
STO 6 5
SBNC 5 #40 [ CTRL is DELTA 00..37
BCS CTRL
SBNC 5 #64-#40 [ DELTA T => $
BCS GET [ ignore nonsense DELTA
LDX 5 6
SBN 5 #74 [ DELTA $ illegal
BPZ 5 GET [ ignore nonsense
ADN 5 4
BPZ 5 LSHFT
USHFT ADN 6 #50 [ #64 .. #67 => Uppercase SHIFTS
BRN DONE [ i.e $ ] ^ ul
LSHFT ADN 6 #0104 [ 070 .. 073 => Lowercase SHIFTS
BRN DONE [ i.e. | } ~ DEL
CTRL ERN 6 #020 [ 000 .. 017 => 0x10 (DLE) .. 0x1f (US)
# [ 020 .. 037 => 0x00 (NUL) .. 0x0f (SI)
# If we are reading from *TR and we get a LF at end of
# buffer then return EOL
LDX 0 FDTYPE(3)
BNZ 0 DONE [ not *TR
BNZ 4 DONE [ not end of buffer
LDN 0 ECMANL [ is it LF (newline in ECMA speak)?
BXE 0 6,EOL [ if so this is EOL
BRN DONE
ALFA LDN 7 SMODALPHA [ set shift flag
BRN GET
BETA LDN 7 SMODBETA [ set shift flag
BRN GET
EOL NGN 6 1
BRN DONE
NSHFT ERN 6 #060 [ #00 .. #17 => "0" .. "?"
BRN DONE [ #20 .. #37 => " " .. "/"
SIX ERN 6 SMODALPHA [ Sixbit like alpha shift
BRN DONE
SHFT ERX 6 7 [ #40..#77 => SHIFTED
DONE STO 7 FDSHIFTMOD(3) [ save current shift modifier
STO 1 FDNEXT(3) [ next char to read
STO 4 FDCHARS(3) [ chars left in buffer
BYE END 2 1,0
# Internal function to get more data
# Enter with
# X0 link
# X2 base
# X3 FDESC
# X7 shift flag
# Exit with
# X1 next char in buf
# X2 base
# X3 FDESC
# X4 chars left in buf
# X7 shift flag
# Branches directly to EOL if
# - record from *FH was not partial
# - read gives EOF
MORE LDX 4 FDTYPE(3) [ reading from *TR?
BZE 4 MRTR [ ignore partial flag
LDX 4 FDFLAGS(3)
ANDN 4 FLAGPART
BZE 4 EOL [ not partial rec, it's eol
BRN MRIN
MRTR LDN 4 #4 [ turn on "previous shift"
ORS 4 FDPERI(3) [ bit in PERI command
MRIN STO 7 FDSHIFT(3) [ save shift flag
STO 0 STRET(2) [ save internal return
STO 3 STDESC(2) [ save FDESC
STACK 3
LDX 0 STFD(2)
STO 0 SXPAR1(3)
CALL 1 GPREADLN
BNG 6 EOL [ quit if I/O error or EOF
LDX 3 STDESC(2)
LDX 4 FDCHARS(3)
LDX 1 FDNEXT(3)
LDX 7 FDSHIFT(3)
LDX 0 STRET(2)
BZE 4 MORE [ loop back if no chars in rec
EXIT 0 0 [ return
#END
#FINISH