zork-1978-04/zork/scrmbl.1

TITLE SCRMBL
.MLLIT=1

A=1
B=2
C=3
D=4
E=5
X1=6
X2=7
X3=10
X4=11
DPT=12
T=13
TT=14
SCR=16
P=17

TYIC==1		; tty input
TYOC==2		; tty output
DKIC==3		; input source
DKOC==4		; output sink
DTYOC==5	; display output (for smearing)

REVRSE:	0	; 0 for scramble, -1 for unscramble

; starting location
GO:	MOVEI P,PDL
	SETZB DPT,EOF'
	SETZ OUTPTR'

; open tty channels
	.OPEN TYIC,[24,,'TTY]
	 .LOSE
	.OPEN TYOC,[5,,'TTY]
	 .LOSE
	.CALL [SETZ ? 'CNSGET ? MOVEI TYOC ? MOVEM ? MOVEM ? SETZM A]
	 SETZB A,SOFTTY'
	CAIN A,%TNSFW
	 SETOM SOFTTY		; software tty
	.STATUS TYOC,A
	ANDI A,77
	SETZM DISTTY
	CAIE A,2
	 JRST RDJCL
; here display tty, so open a channel in display mode
	SETOM DISTTY'		; display tty
	.OPEN DTYOC,[21,,'TTY]
	 .LOSE

; read command, if any
RDJCL:	.SUSET [.ROPTION,,A]
	TLNN A,40000		; any jcl?
	 JRST NOJCL
	.BREAK 12,[5,,JCLBUF]	; get it
	MOVE A,[440700,,JCLBUF]
	MOVEM A,COMPTR'

; I THINK DEFAULT SHOULD BE LCF = 99% OF USAGE (MARC -- 2/13/78)
; dir defaults to sname
;	.SUSET [.RSNAME,,A]
;	MOVEM A,INDIR
	.SUSET [.RXJNAME,,A]
	CAMN A,[SIXBIT /UNSCR/]
	 SETOM REVRSE

; parse jcl
	MOVEI E,INDEV
	PUSHJ P,SCNAME
	MOVEI E,OUTDEV
	PUSHJ P,SCNAME
	PUSHJ P,GETSYL

; set up default for unscrambling
; if scrambling, default is fn1 plus letter Z on end
; if unscrambling, default is fn1 with letter Z removed from end
INDEF:	SKIPE OUTFN1
	 JRST DODEF
      	SKIPN REVRSE
	 JRST SCRDEF
; here unscrambling
	MOVE A,[440600,,INFN1]
INLOOP:	ILDB B,A
	CAIE B,'Z
	 JRST INDEF1
	CAMN A,[600,,INFN1]
	 JRST INMAKE
	MOVE C,A
	ILDB B,C
	JUMPN B,INLOOP
INMAKE:	SETZ C,		; dump a space
	JRST DMAKE
INDEF1:	CAME A,[600,,INFN1]
	 JRST INLOOP
	JRST INMAKE

; set up defaults for scrambling
SCRDEF:	MOVE A,[440600,,INFN1]
OULOOP:	CAMN A,[600,,INFN1]
	 JRST OUMAKE
	ILDB B,A
	JUMPE B,OUMAKE
	JRST OULOOP
OUMAKE:	MOVEI C,'Z	; dump a Z

; here dump a space or a Z into file name
DMAKE:	MOVE B,INFN1
	MOVEM B,OUTFN1
	HRRI A,OUTFN1
	DPB C,A

; set up output file defaults
DODEF:	MOVE A,INDEV
	SKIPN OUTDEV
	 MOVEM A,OUTDEV
	MOVE A,INFN1
	SKIPN OUTFN1
	 MOVEM A,OUTFN1
	MOVE A,INFN2
	SKIPN OUTFN2
	 MOVEM A,OUTFN2
	MOVE A,INDIR
	SKIPN OUTDIR
	 MOVEM A,OUTDIR

; here to hack second name cruftage:  if no second name given, it
; is set up so that input and output files will have same second name
; creation dates of files are always set up to be the same
	SKIPE INFN2
	 JRST OPNFLS
	MOVSI A,(SIXBIT ">")
	MOVEM A,INFN2

; open input file
OPNFLS:	.CALL [SETZ ? SIXBIT /OPEN/ ? [.BII,,DKIC]
		INDEV ? INFN1 ? INFN2 ? INDIR ? SETZB LSTERR']
	 JRST INFAIL
; read its creation date
	.CALL [SETZ ? 'RFDATE ? MOVEI DKIC ? SETZM CDATE']
	 .LOSE
	SKIPE OUTFN2
	 JRST SMASH
; read its second name if necessary
	.CALL [SETZ ? SIXBIT /RCHST/ ? MOVEI DKIC ? MOVEM ? MOVEM ? MOVEM OUTFN2 ? SETZM]
	 .LOSE
	MOVE A,OUTFN2
	MOVEM A,INFN2

; check if (un)scring to self
SMASH:	MOVE A,INFN1
	CAME A,OUTFN1
	 JRST ASK
	MOVE A,INFN2
	CAME A,OUTFN2
	 JRST ASK
	MOVE A,INDEV
	CAME A,OUTDEV
	 JRST ASK
	MOVE A,INDIR
	CAME A,OUTDIR
	 JRST ASK
; going to same file, ask for confirmation
	MOVEI A,[ASCIZ /Uns/]
	SKIPN REVRSE
	 MOVEI A,[ASCIZ /S/]
	PUSHJ P,TYPE7
	MOVEI A,[ASCIZ /crambling to self? Confirm? /]
	PUSHJ P,TYPE7
	PUSHJ P,YESNO
	CAIN A,"Y
	 JRST ASK
	MOVEI A,[ASCIZ /Aborted./]
	PUSHJ P,TYPE7
	JRST KILL


	
; ask yes/no question
YESNO:	.IOT TYIC,A
	CAIN A,^Q
	 JRST KILL		; ^Q means kill
	CAIL A,"a
	 CAILE A,"z
	  CAIA
	   SUBI A,40
	.IOT TYOC,[^M]
	.IOT TYOC,[^J]
	POPJ P,

; get password
REASK:	.IOT TYOC,[^M]
	.IOT TYOC,[^J]
ASK:	MOVEI A,[ASCIZ /Password? /]
	PUSHJ P,TYPE7
	PUSHJ P,GETSCR		; read password

; confirm password
CONFRM:	.IOT TYOC,[^M]
	.IOT TYOC,[^J]
	MOVE A,SCR
	PUSHJ P,WTYPE6		; type it out (briefly)
	PUSHJ P,PERASE		; now flush it
; get confirmation
DBLCHK:	MOVEI A,[ASCIZ /Okay? /] ; confirm the password
	PUSHJ P,TYPE7
	PUSHJ P,YESNO
	CAIN A,"N		; N is no
	 JRST REASK
	CAIN A,"R
	 JRST CONFRM		; R is reconfirm
	CAIE A,"Y
	 JRST DBLCHK		; Y is yes, anything else asks again

; open output file
	.CALL [SETZ ? SIXBIT /OPEN/ ? [.BIO,,DKOC]
		OUTDEV ? [SIXBIT "_SCRM_"] ? [SIXBIT ">"] ? OUTDIR ? SETZB LSTERR]
	 JRST OUTFAI

; encryption
;  SCR/ password

	MOVSI E,-4
	MOVE TT,SCR
BYTLUP:	LSHC T,9
	ANDI T,377
	HRLM T,X1(E)
	MOVE T,ROUT(E)
	HRRM T,X1(E)
	AOBJN E,BYTLUP

	CAMG X1,X2
	 EXCH X1,X2
	CAMG X3,X4
	 EXCH X3,X4
	CAMG X1,X3
	 EXCH X1,X3
	CAMG X2,X4
	 EXCH X2,X4
	CAMG X2,X3
	 EXCH X2,X3

	LDB A,[320100,,SCR]
	HRRZ B,16
	SKIPE A
	 HLRZ B,16
	LDB A,[100100,,SCR]
	JUMPE A,[LSH B,1 ? JRST .+2]
	HRL B,A
	LDB A,[210100,,SCR]
	SKIPE A
	 MOVN B,B
	MOVEM B,RAN'

	MOVSI C,-4
	SETZ E,
	HLLM E,X1(C)
	PUSHJ P,@(C)X1
	AOBJN C,.-2

	SKIPN REVRSE
	 JRST SCRBEG
	MOVE A,SC1
	EXCH A,SC4
	MOVEM A,SC1
	MOVE A,SC2
	EXCH A,SC3
	MOVEM A,SC2
	HRLZ A,SHFSIZ
	MOVN A,A
	HLRM A,SHFSIZ

SCRBEG:
SCRLUP:	PUSHJ P,GETWRD
	SKIPE REVRSE
	 JRST SC1
	PUSHJ P,RANDOM
	XOR A,B

SC1:	0
SC2:	0
SC3:	0
SC4:	0

	SKIPN REVRSE
	 JRST SCRL50
	PUSHJ P,RANDOM
	XOR A,B

SCRL50:	MOVEM A,-1(DPT)		; output encrypted word
	JRST SCRLUP		; and loop

; encryption routines

RANDOM:	MOVE B,RAN'
	FMPB B,RAN
	TSC B,B
CPOPJ:	POPJ P,

ROUT:	XCMPL
	XSWAP
	XXOR
	XROT

XCMPL:	LDB A,[331000,,SCR]
	IDIVI A,3
	ANDI A,1
	MOVE B,COMPL(A)
	MOVEM B,SC1(C)
	POPJ P,

XSWAP:	LDB A,[221000,,SCR]
	LDB B,[111000,,SCR]
	ANDCM A,B
	IDIVI A,3
	ANDI A,1
	MOVE A,SWAP(A)
	MOVEM A,SC1(C)
	POPJ P,

XXOR:	LDB A,[111000,,SCR]
	LDB B,[331000,,SCR]
	ADD A,B
	LSH A,-3
	ANDI A,1
	MOVE A,MASK(A)
	MOVEM A,SC1(C)
	POPJ P,

XROT:	MOVE A,SCR
	IMUL A,A
	ANDI A,77
	LDB B,[000100,,SCR]
	SKIPE B
	MOVN A,A
	HRRM A,SHFSIZ
	MOVE A,SHIFT
	MOVEM A,SC1(C)
	POPJ P,

COMPL:	SETCM A,A
	JFCL
SWAP:	MOVS A,A
	JFCL
MASK:	XOR A,SCR
	JFCL
SHIFT:	ROT A,@SHFSIZ
SHFSIZ:	0

; i/o routine:  the buffer at datloc is used for both input and output,
; with the encrypted words replacing the unencrypted ones.  this sort of
; makes it tough to have the encryption process be based on more than one
; word at a time.

; get a word of input
GETWRD:	MOVE A,(DPT)
	AOBJN DPT,CPOPJ
; output old buffer
	SKIPN A,OUTPTR
	 JRST GETBUF
	ADD A,[1,,0]		; kludge for aobjn
	.IOT DKOC,A
	JUMPL A,[.LOSE]
; read a new buffer
GETBUF:	SKIPE EOF
	 JRST EXIT		; done, no more input
	MOVE DPT,[-DATLEN,,DATLOC]
	.IOT DKIC,DPT
	JUMPGE DPT,[MOVE DPT,[-<DATLEN+1>,,DATLOC]
		    MOVEM DPT,OUTPTR'
		    JRST GETWRD]
; partial buffer
	ADD DPT,[DATLEN,,0]
	MOVN DPT,DPT
	HRRI DPT,DATLOC
	MOVEM DPT,OUTPTR
	SETOM EOF
	JUMPL DPT,GETWRD
; end
EXIT:	.CALL [SETZ ? SIXBIT "RENMWO" ? MOVEI DKOC ? OUTFN1 ? SETZ OUTFN2]
	 .LOSE
     	.CALL [SETZ ? 'SFDATE ? MOVEI DKOC ? SETZ CDATE]
	 .LOSE
	.CLOSE DKIC,
	.CLOSE DKOC,
KILL:	.BREAK 16,124000

; various error messages

NOJCL:	MOVEI A,[ASCIZ /JCL must be given: <infile>,<outfile>
/]
	PUSHJ P,TYPE7
	JRST KILL

INFAIL:	MOVEI A,[ASCIZ /Input open of /]
	MOVEI B,INDEV
FAIL:	PUSHJ P,TYPE7
	PUSHJ P,PFILE
	MOVEI A,[ASCIZ / failed: /]
	PUSHJ P,TYPE7
	.CALL [SETZ ? SIXBIT "OPEN" ? [0,,0] ? [SIXBIT "ERR"] ? [4] ? SETZ LSTERR]
	 .LOSE
FAILUP:	.IOT 0,A
	CAIN A,^L
	 JRST FAILX
	JUMPLE A,FAILX
	.IOT TYOC,A
	JRST FAILUP
FAILX:	.CLOSE 0,
	JRST KILL

OUTFAI:	MOVEI A,[ASCIZ /Output open of /]
	MOVEI B,OUTDEV
	JRST FAIL
RENFAI:	MOVEI A,[ASCIZ /Rename to /]
	MOVEI B,OUTDEV
	JRST FAIL

PFILE:	MOVE A,(B)
	PUSHJ P,TYPE6
	.IOT TYOC,[":]
	MOVE A,3(B)
	PUSHJ P,TYPE6
	.IOT TYOC,[";]
	MOVE A,1(B)
	PUSHJ P,TYPE6
	.IOT TYOC,[" ]
	MOVE A,2(B)
	PUSHJ P,TYPE6
	POPJ P,

; password reading and printing

; smear password after giving luser brief glance
; on display consoles, erase smear as well
PERASE:	MOVEI A,15.
	.SLEEP A,
	MOVE A,[440700,,SMEAR]
	MOVEI B,.SML
	.CALL [SETZ ? SIXBIT "SIOT" ? MOVEI TYOC ? A ? SETZ B]
	 JFCL
	MOVE A,[440700,,[.BYTE 7 ? ^P ? "H ? 8 ? ^P ? "L]]
	MOVEI B,5
	SKIPE DISTTY
	 .CALL [SETZ ? SIXBIT "SIOT" ? MOVEI DTYOC ? A ? SETZ B]
	  JFCL
	.IOT TYOC,[^M]
	.IOT TYOC,[^J]
	MOVE A,[441000,,TDNOP]
	MOVEI B,.TDL
	SKIPE SOFTTY
	 .CALL [SETZ ? SIXBIT "SIOT" ? MOVSI %TJSIO ? MOVEI TYOC ? A ? SETZ B]
	  JFCL
	POPJ P,

; a buffer full of tdnops
TDNOP:	.BYTE 10
	REPEAT 400,%TDNOP
	.TDL==.BYTC
	.BYTE

; a smear
SMEAR:	.BYTE 7
	^M ? "W ? "X ? "M ? "Q ? "S ? "Y
	^M ? "X ? "M ? "Q ? "S ? "Y ? "W
	^M ? "M ? "Q ? "S ? "Y ? "W ? "X
	^M ? "Q ? "S ? "Y ? "W ? "X ? "M
	^M ? "S ? "Y ? "W ? "X ? "M ? "Q
	^M ? "Y ? "W ? "X ? "M ? "Q ? "S
	.SML==.BYTC
	.BYTE

WTYPE6:	MOVEM A,WORD6'
	MOVE A,[440600,,WORD6]
	MOVEM A,WD6PT'
	MOVEI A,6
	MOVEM A,CNT6'
	ILDB A,WD6PT
	ADDI A,40
	.IOT TYOC,A
	SOSLE CNT6
	JRST .-4
	POPJ P,

TYPE6:	PUSH P,A
	HRRI A,(P)
	HRLI A,440600
TYP6LP:	TLNN A,770000
	 JRST POPAJ
	ILDB 0,A
	JUMPE 0,POPAJ
	ADDI 0,40
	.IOT TYOC,0
	JRST TYP6LP
POPAJ:	POP P,A
	POPJ P,

TYPE7:	HRLI A,440700	; set up byte pointer (addr in a as arg.)
	MOVEM A,PT7'	; store so don't need extra acc
PSHOUT:	ILDB A,PT7	; get char
	JUMPE A,CPOPJ	; stop when zero char reached (^@)
	.IOT TYOC,A
	JRST PSHOUT	; loop forever

GETSCR:	MOVE C,CHPT
	.IOT TYIC,A
	CAIN A,^Q
	 JRST KILL
	CAIN A,177
	 JRST RUBOUT
	CAIN A,^M
	 JRST RETURN
	HLLZ B,C
	CAMN B,[-1,,0]
	 JRST GETSCR+1
	PUSH C,A
	JRST GETSCR+1

RETURN:	CAMN C,CHPT
	 JRST GETSCR
RETUR1:	HLLZ A,C
	CAMN A,[-1,,0]
	 JRST FULL
	PUSH C,[40]
	JRST RETUR1

FULL:	MOVE C,[440600,,SCR]
	MOVSI B,-6
FULLUP:	MOVE A,SCRLOC(B)
	SUBI A,40
	CAIL A,100
	 SUBI A,40
	IDPB A,C
	AOBJN B,FULLUP
	POPJ P,

RUBOUT:	CAMN C,CHPT
	 JRST GETSCR
	POP C,A
	JRST GETSCR+1

; file name reading

INDEV:	SIXBIT /DSK/
INFN1:	0
INFN2:	0
INDIR:	SIXBIT /LCF/

OUTDEV:	SIXBIT /DSK/
OUTFN1:	0
OUTFN2:	0
OUTDIR:	0

SCNAME:	MOVSI	C,-4
	HRRI	C,1(E)
SCNGET:	PUSHJ	P,GETSYL
	JUMPE	B,SCNX
	CAIN	A,':
	 MOVEM	B,(E)
	CAIN	A,';
	 MOVEM	B,3(E)
	JUMPG	A,SCNGET
	MOVEM	B,(C)
	JUMPL	A,SCNX
	AOBJN	C,SCNGET
SCNX:	POPJ	P,

; get a syllable from command buffer
GETSYL:	PUSH	P,[0]
	MOVEI	B,(P)
	HRLI	B,440600
GETSLP:	PUSHJ	P,GETCCA
	JUMPL	A,GETSX
	CAIN	A,"/
	 JRST	GETSWT
	CAIN	A,^Q
	 JRST	GETQOT
	SUBI	A,40
	JUMPL	A,GETSX
	JUMPE	A,GETSP
	CAIE	A,':
	 CAIN	A,';
	  JRST	GETSX
GETSPT:	CAIL	A,100
	 SUBI	A,40
	TLNN	B,770000
	 JRST	GETSLP
	IDPB	A,B
	JRST	GETSLP

GETSWT:	PUSHJ	P,GETCCA
	SUBI	A,40
	CAIL	A,100
	 SUBI	A,40
	CAIN	A,'U
	 SETOM	REVRSE
	JRST	GETSLP

GETQOT:	ILDB	A,COMPTR
	SUBI	A,40
	JUMPGE	A,GETSPT
	JRST	GETSX
GETSP:	TLNE	B,400000
	JRST	GETSLP
GETSX:	POP	P,B		; character word
	POPJ	P,

GETCCA:	ILDB	A,COMPTR
	JUMPE	A,GETCCX
	CAIN	A,^I
	 MOVEI	A,40
	CAIE	A,^C
	 CAIN	A,^M
	  JRST	GETCCX
	CAIN	A,",
GETCCX:	SETOM	A
	POPJ	P,

CHPT:	-7,,SCRLOC-1
SCRLOC:	BLOCK 7
PDL:	BLOCK 70

JCLBUF:	BLOCK 50

	DATLEN==2000
DATLOC:	BLOCK DATLEN

	END GO