File UNUM

Directory of image this file is from
This file as a plain text file

*20
/// UNUM
	 
/MANN-WHITNEY UTEST DONE ON TWO INPUT
/SETS OF NUMFILES.  
/PRINTS N0,N1,N1+N2,N0XN1,U0,U1,
/AS WELL AS X*0 & X*1.
/DOES NOT PRINT RANKED LIST.
/HANDLES CASE OF EQUAL VALUES.
	 
/MAXIMUM OF 666 VALUES PER CATEGORY MAY
/BE ENTERED,I.E., N0 AND N1 MUST EACH
/BE LESS THAN 667.
	 
/A HEADER MESSAGE NOT TO EXCEDE 28 CHARACTERS
/MAY BE ENTERED.
/TAKES ALL ENTRIES IN F0 FILES AS
/ONE SET ON VALUES. SAME FOR F1.
	 
/ONE MAY OMIT INPUT FILE LISTS. IF SO,
/ASSUMPTION IS MADE THAT CORE WAS LOADED
/BY A PREVIOUS PASS,I.E., PASS WITH TCHINUM.
/DF 6 & 17, 7 & 17 ARE ORDERED BUT NO
/VALUES ARE DESTROYED.
	 
/REQUIRES 12K OF CORE.
/CORE MAP:  IF2,QN3 - PROGRAM
/           IF5 ----- PROGRAM
/           DF6,7 --- F0 VALUES
/           DF10 ---- NUMFILE PBLOCK IN QN7
/           DF11 ---- CURRENT NUMFILE
/           DF12 ---- INPUT NUMFILE NAME LISTS
/           DF16,17 - F1 VALUES
	 
/LODSYM NOT NEEDED, PBLOCK ADDED.
	 
	SEGMNT 5
	*20
	 
BEG,	JMP FILGET	/SETUP FILES
	 
/ITEMS FILE0
START,	LDA I
	4
	PICK
	0
	0
	JMP ZERCHK	/?=0
	STORE
	CC
	FIX
	FAC
	ISTOR1
	NC
/ITEMS FILE1
	LDA I
	4
	PICK
KP1,	1
	0
	JMP ZERCHK	/?=0
	STORE
	DD
	FIX
	FAC
	ISTOR1
	ND
	LOAD
	DD
	FMUL
	CC
	STORE
	NN
	 
/CHECK FOR BIG(2DF) OR SMALL(1DF) FILES.
	LIF 2
	JMP CHKSIZ
	 
/SORT FILE0 ONTO SELF
/
CHKRET,	LDA
	NC
	STA
	MAXSRT
	ADD KM1
	APO
	CLR
	STC SORTSZ
	JMP SORT
/
/SORT FILE1 ONTO SELF
	LDA
	ND
	STA
	MAXSRT
	ADD KM1
	APO
	CLR
	STC SORTSZ
	ADD KP1
	JMP SORT
	EJECT
	 
	 
//PROCESSING COMMAND SEQUENCE.
/FIRST GET U0 BY ASKING
/FOR NUM OF F0S LESS THAN EACH F1.
/THEN REPEAT FOR NUM F1S LESS THAN EACH
/FO,I.E., U1.
	JMP SETA0   /F0=FA;F1=FB
	JMP COMPAR  /GET U0
	 
	JMP SETA1   /F1=FA;F0=FB
	JMP COMPAR  /GET U1
	 
	JMP COMPUT  / X*1 & X*0 & TYPEOUT
//END COMMAND SEQUENCE.
	 
/SET FA=F0 & FB=F1.
SETA0,	LDA I		/SET UP MAX NUMS
NC,	0		/N(F0)
	STC NA		/N(FA)
	ADD ND		/N(F1)
	STC NB		/N(FB)
	ADD KP1		/SET UP PICKS
	STA
	B1
	STC B2
	STC A1
	STC A2
	LDA I		/SET UP FOR U0
	U0
	STC UN
	LDA I		/CLR FADUN FLG
KNOP,	NOP
	STC FLG
	JMP 0		/LEAVE
/END SETA0.
	 
/SET FA=F1 & FB=F0.
SETA1,	LDA I		/SET UP MAX NUMS
ND,	0		/N(F1)
	STC NA		/N(FA)
	ADD NC		/N(F0)
	STC NB		/N(FB)
	ADD KP1		/SET UP PICKS
	STA
	A1
	STC A2
	STC B1
	STC B2
	LDA I		/SET UP FOR U1
	U1
	STC UN
	ADD KNOP	/CLR FADUN FLG
	STC FLG
	JMP 0		/LEAVE
/END SETA1.
	 
	 
/ROUTINE TO COMPARE FA & FB. SET UP A
/U VALUE AT PNTR IN LOCATION UN.  CALCULATES
/U FOR FA ON BASIS OF NUM OF FAS LESS THAN
/EACH VALUE OF FB. HANDLES TIES BY ADDING
/IN 0.5.
COMPAR,	SET 3
	0
	FZER		/ZERO STOREAGE
	STORE
	SMLCNT
	STORE
	USUM
	STC HAFLG	/CLR TIE CNTR
	 
/GET FIRST ENTRY IN FA.
	LDA I
KP20,	20
	PICK
A1,	0		/0,1
	0
	STORE
	TEM		/FA
	 
/SAME FOR FB.
	ADD KP20
	PICK
B1,	0		/1,0
	0
	STORE
	TEM1		/FB
	 
/SET UP CNTRS.
	ADD KP1
	STA
	INUMA
	STC INUMB
	 
	 
/MAIN COMPARISON SEQUENCE.
COMFF,	LOAD
	TEM1		/FB
	FSUB
	TEM		/FA
	 
/NOW CHECK FOR TIES.
	FAZE
	JMP  NOTIE	/NO
	 
TIE,	LOAD		/YES
	FPHALF
	ADD KP1		/INCREMENT
	ADM I		/TIE CNTR.
HAFLG,	0
	JMP FLG
	 
/NO TIE, SO WHICH BIGGER?
NOTIE,	FAPO
	JMP FAB		/FA BIGGER
	LOAD		/FA SMALLER
	FONE
	 
/CHK FLG TO SEE IF FA IS FINISHED.
FLG,	0		/NOP, JMP FAB
	 
/GOT HERE SO FA NOT DUN, SO ADD TO SMLCNT.
	FADD
	SMLCNT
	STORE
	SMLCNT
	 
/GET NEW FA BUT FIRST SEE IF DUN.
NEWFA,	LDA I
INUMA,	0
	SAGE
NA,	0
	SKP
	JMP BIGR	/FA DUN
	ADD KP20	/GET NEW FA
	PICK
A2,	0		/0,1
	0
	STORE
	TEM
	ADD KP1		/INC CNTR
	ADM
	INUMA
	JMP COMFF	/GO BACK
	 
BIGR,	LDA I
	JMP FAB
	STC FLG
	JMP FLG
	 
	 
/FA IS BIGGER SO ADD IN COUNTS IN SMLCNT
/TO USUM & GET NEXT FB.
FAB,	LOAD		/ADD SMLCNT
	SMLCNT
	FADD 
	USUM
	STORE
	USUM
	 
/GET A NEW FB BUT FIRST CHECK FOR END OF
/FB. IF FOUND, WE ARE DUN.
NEWFB,	LDA I
INUMB,	0
	SAE I
NB,	0
	SKP
	JMP FBE		/FB DUN
	ADD KP20	/NOT DUN, GET NEW FB
	PICK
B2,	0		/1,0
	0
	 
/NOW WE HAVE NEW FB IN FAC. IF THE NEW FB
/IS NOT THE SAME AS THE OLD FB (TEM1), THEN
/WE CORRECT SMLCNT FOR PAST TIES WITH FIXCNT.
/BUT IF OLD & NEW FBS ARE EQUAL  AND  THERE
/ARE PAST TIES (HAFLG NONZERO) THEN WE DO NOT
/DO A FIXCNT.
	STORE
	SAGEX		/NEW FB
	ADD KP1		/INC CNTR
	ADM
	INUMB
	FCOMP
	FADD
	TEM1		/OLD FB
	FAZE		/EQUAL?
	 
	JMP FIXCNT	/NO, FIX SMLCNT
	JMP FAB		/YES
	 
	 
/CODE TO INCREMENT SMLCNT BY 0.5 TIMES
/NUMBER OF TIES,  BUT  OLNY IF NEW
/FB IS NOT EQUAL TO OLD FB.
/0.5 WAS COUNTED IN AT TIME OF TIE.  BUT 
/FOR LARGER NEW FBS, 1 SHOULD BE COUNTED
/IN EACH TIME. FIXCNT MAKES THIS CORRECTION.
FIXCNT,	SFLOAT
	HAFLG		/NUM TIES
	FMUL
	FPHALF		/C(FAC)= TIES X 0.5
	FADD
	SMLCNT
	STORE
	SMLCNT
	STC HAFLG	/CLR TIE CNTR
	LOAD
	SAGEX
	STORE
	TEM1
	JMP COMFF
/END FIXCNT.
	 
	 
/FB & ALL PROCESSING DUN. SET UP U0 OR
/U1 & LEAVE.
FBE,	LOAD
	USUM
	STORE
UN,	0		/U0,U1
	JMP 3		/LEAVE
/END COMPAR.
	 
	 
	 
/SEQUENCE TO COMPUTE & TYPEOUT RESULTS.
COMPUT,	LIF 4
	MESOUT
	CRLF
	LIF 4
	MESOUT
	CRLF
	SETWRD
	0600
	 
/COMPUTE X*
	LOAD
	CC		/N0
	FADD
	DD		/N1
	FADD 
	FONE
	FMUL
	NN		/NOXN1
	FDIV
	F12
	SQRT
	FAC
	STORE
	TEM	/SQRT([<N0+N1+1>N0XN1]\F12)
	 
	LOAD
	NN		/NOXN1
	OUTPUT
	NMES1		/N0XN1
	FDIV
	FP2
	STORE
	TEM1		/ (N0XN1)\2
	 
	SETWRD
	1041
	LOAD
	U1
	OUTPUT
	U1M1		/U1
/
	FSUB
	TEM1		/U1-TEM1
	FAPO
	FCOMP
	FDIV
	TEM		/X*1
	SETWRD
	1243
	OUTPUT
	X1M		/X*1
/
	SETWRD
	1041
	LOAD
	U0
	OUTPUT
	U0M1		/U0
/
	FSUB
	TEM1		/U0-TEM1
	FAPO
	FCOMP
	FDIV
	TEM		/X*0
	SETWRD
	1243
	OUTPUT
	X0M		/X*0
/
	SETWRD
	0600
	LOAD
	CC		/N0
	OUTPUT
	N0M		/N0
	LOAD
	DD		/N1
	OUTPUT
	N1M		/N1
	FADD
	CC
	OUTPUT
	TN		/N0+N1
	LIF 4
	MESOUT
	N0MES		/N0
	LIF 4
	MESOUT
	N1MES		/N1
	LIF 4
	MESOUT
	TNMES		/N0+N1
	LIF 4
	MESOUT
	NMES		/N0XN1
	LIF 4
	MESOUT
	U0MES		/U0
	LIF 4
	MESOUT
	U1MES		/U1
	LIF 4
	MESOUT
	X0MES		/X*0
	LIF 4
	MESOUT
	X1MES		/X*1
/
	LIF 4
	JMP 20		/STOP
	EJECT
/
/MESSAGES AND VARIABLES
/
N0MES,	TEXT .N0= .
N0M,	0
	0
	0
	4543
	 
N1MES,	TEXT .N1= .
N1M,	0
	0
	0
	4543
	 
TNMES,	TEXT .N1+N2=.
TN,	0
	0
	0
	4543
	 
NMES,	TEXT .NN= .
NMES1,	0
	0
	0
CRLF,	4543
	 
U0MES,	TEXT .U0= .
U0M1,	0
	0
	0
	0
	4543
	 
X0MES,	TEXT .X*0=.
X0M,	0
	0
	0
	0
	0
	4543
	 
U1MES,	TEXT .U1= .
U1M1,	0
	0
	0
	0
	4543
	 
X1MES,	TEXT .X*1=.
X1M,	0
	0
	0
	0
	0
	4543
	 
F0MES,	TEXT .0 .
F0M,	0
	0
	0
	0
	0
	4543
	  
F1MES,	TEXT .1 .
F1M,	0
	0
	0
	0
	0
	4543
	 
/BUFFERS.
NN,	0
	0
	0
USUM,	0
	0
	0
U0,	0
	0
	0
SMLCNT,	
U1,	0
	0
	0
TEM,	0
	0
	0
DD,	0
	0
	0
CC,	0
	0
	0
TEM1,	0
	0
	0
FPHALF,	0
	2000
	0
FP1,	
FONE,	1
	2000
	0
KP2,	
FP2,	2
	2000
	0
F12,	4
	3000
	0
KM1,	-1
	EJECT
/
/SUBROUTINE TO SORT A FILE
/ONTO ITSELF
/
SORT,	STA
	SF1
	STA
	SF2
	STA
	SF3
	STC SF4
	ADD 0
	STC SORTX
	STC PASNUM
/
/ONE PASS
/
ONEP,	CLR
	STC INUM
	STC SWPFLG
ONEP1,	LDA
	INUM
	ADA I
	20
	PICK
SF1,	0
	0
	STORE
	TEM
	LDA
	INUM
	ADA I
	21
	PICK
SF2,	0
	0
	STORE
	TEM1
	FSUB
	TEM
	FAPO
	JMP SWAP
	LDA I
	1
	ADM
	INUM
	SAE I
SORTSZ,	0
	JMP ONEP1
/
	LDA I
SWPFLG,	0
	AZE I
	JMP SORTX-1
	LDA I
	1
	ADM I
PASNUM,	0
	SAE I
MAXSRT,	0
	JMP ONEP
	NOP		/JMP CLOSE
SORTX,	JMP
/
/
SWAP,	LDA
	0
	STC SWAPX
	LDA I
	1
	STC SWPFLG
	LOAD
	TEM1
	LDA
	INUM
	ADA I
	20
	PICK
SF3,	0
	1
	LOAD
	TEM
	LDA I
INUM,	0
	ADA I
	21
	PICK
SF4,	0
	1
SWAPX,	JMP
	 
	 
/
/ROUTINE TO CHECK FOR ZERO ENTRIES IN
/A FILE. IF SO TYPES MESSAGE
/AND RESTARTS PROGRAM.
ZERCHK,	FAZE
	JMP 0
	LIF 4
	MESOUT
	MZER
	JMP 20		/RESTART PROG
	 
MZER,	TEXT %ZERO FILE ENTRIES %
	4543
	 
	 
/SUBROUTINE SAGE DOES SKIP IF VALUE
/IN AC IS GREATER OR EQUAL TO CONTENTS OF P+1.
/DOES NOT DESTROY AC, DF, OR BETA REGISTERS.
	 
	SAGE=JMP .
	STC SAGEX+1	/SAVE AC
	ADD 1
	STC SAGEX+3	/SAVE BETA 1
	SET 1
	0
	ADD 1
	STA
	SAGEX+2		/ORIG RTRN JUMP
	BCL I
	6000
	STC 1
/NOW COMPARE VALUES.
	LDA 1
	COM
	ADD SAGEX+1
	AZE I
	JMP .+7		/EQUAL
	APO I		/NOT EQUAL
	JMP .+5		/GRTR
	CLR		/LESS
/NOW SET UP RETURN JUMPS.
	ADD SAGEX+2
	ADD KP1
	JMP .+4
	CLR
	ADD SAGEX+2
	ADD KP2
	STC SAGEX
	SET 1		/RESTORE BETA 1
	SAGEX+3
	ADD SAGEX+1	/RESTORE AC
SAGEX,	0		/LEAVE, RTRN JUMP
	0		/AC
	0		/ORIG RTRN JMP
	0		/BETA1
/SAGEX IS OFTEN USED AS A FP REGISTER AS WELL.
/END SAGE.
	 
/NOW FOLLOWS A ROUTINE TO SUBSTITUTE
/FOR 2DILFIL.
	 
/TYPE OUT PROGRAM NAME.
FILGET,	
D0,	LIF 4
	MESOUT
	 M0		/TCHINUM
	 
/INITIALIZE TO GET BOTH F0 & F1 LISTS.
	LDA I
	LIF 4
	STA
	GETF0
	STC GETF1
	 
/ASK FOR INPUT UNITS.
	LIF 4
	INUNITS
	 
/ASK FOR MESSAGE AS TYPEOUT HEADER.
D1,	LIF 4
	INTRACT
	 CJ1
	 M1		/MESSAGE:
	 
CJ1,	T1
	J1
	 
T1,	YES
	NO
	0
	 
J1,	JMP BEG		/CR
	JMP D1		/? YES
	JMP NOMES	/NO
	JMP .+1		/NUM
	 
/MOVE MESSAGE FROM INBUF & PLACE IN BUFOUT.
	LDF 4
	SET I 1
	4\INBUF-1
	SET I 2
	4\BUFOUT-1
	SET I 3
	-34		/28(10)
	 
BKMES,	LDH I 1
	STH I 2
	SAE I
	45
	SKP
	 JMP GOTMES	/45=END OF MES
	XSK I 3
	JMP BKMES
	HLT		/MESSAGE TOO LARGE
	 
NOMES,	LDA I
	4543
	STC BUFOUT
	JMP D2
	 
GOTMES,	LDA I
	43
	STH I 2
/END D1, MESSAGE HANDLER.
	 
	 
/NEW F0 NUMFILE LIST?
D2,	LIF 4
	INTRACT
	 CJ2
	 M2		/F0 NUMFILES?:
	 
CJ2,	T1
	J2
	 
J2,	JMP BEG		/CR
	JMP D2A		/YES
	JMP NOF0        /NO
	JMP D2		/? NUM
	 
/OLD F0 HANDLER.
NOF0,	LDA I
	JMP GETF1
	STC GETF0
	JMP D3
	 
/NEW F0 LIST HANDLER.
D2A,	LIF 4
	TABSET
	 0
	 LDF 12
	 2000
	 400
	 
F0NAM,	LIF 4		/ASK F0 NAMES
	INTABLE
	 0
/END D2, F0 LIST HANDLER.
	 
	 
/NEW F1 NUMFILE LIST?
D3,	LIF 4
	INTRACT
	 CJ3
	 M3		/F1 NUMFILES?:
	 
CJ3,	T1
	J3
	 
J3,	JMP BEG		/CR
	JMP D3A		/YES
	JMP NOF1	/NO
	JMP D3		/? NUM
	 
/OLD F1 LIST HANDLER.
NOF1,	LDA I
	JMP TYPMES
	STC GETF1
	JMP SETVAL
	 
/NEW F1 LIST HANDLER.
D3A,	LIF 4
	TABSET
	 1
	 LDF 12
	 3000
	 400
	 
F1NAM,	LIF 4		/ASK F1 NAMES
	INTABLE
	 1
/END D3, F1 LIST HANDLER.
	 
	 
	 
/SETUP TO GET VALUES FROM F1 & F0.
SETVAL,	LDF 4
	LDA I
	7110
	STA
	WORD1		/PBLK
	LDA I
	4411
	STA
	WORD2		/DATA
/INITIALIZE F0 DF (6) AND F1 DF (16).
	CLR
	ADD KLDF6
	STC F0DF
	ADD KLDF16
	STC F1DF
	 
/NOW LOAD F0 FROM ITS INPUT FILES.
GETF0,	0		/LIF 4, JMP GETF1
	TABINI
	 0
	 
KLDF6,	LDF 6
	FZER
	STORE
	2000		/F0(0)=0
	STORE
	2014		/F0(4)=0
	 
	SET I 6
	2060		/F0(16) PNTR
	 
NXTF0,	LIF 4
	TABGET
	 0
	 JMP GETF1	/F0 DUN
	 HLT		/MISSING
	 
F0VAL,	JMP NUMSET	/SET BETA 10 & 11
BKF0,	LDF 11		/MOVE VALUE
	LOAD
	4\11
F0DF,	0		/LDF 6,7
	STORE
	4\6
	LOAD
	FP1
	LDF 6
	FADD
	2014
	STORE
	2014
	 
/WATCH FOR DF OVERFLOW.
	XSK 6		/SKP ON 3777
	 JMP .+6	/NO OVERFLOW
	LDA I 6		/OVERFLOW, BUMP 6
	CLR
	ADD F0DF	/BUMP DF
	ADD KP1
	STC F0DF
	 
	XSK I 10	/DUN THIS NUMFILE?
	 JMP BKF0	/NO
	JMP NXTF0	/YES, GET NEXT F0
/END GETF0.
	 
/NOW LOAD F1 FROM ITS INPUT FILES.
GETF1,	0		/LIF 4, JMP TYPMES
	TABINI
	 1
	 
KLDF16,	LDF 16
	FZER
	STORE
	2014		/F1(4)=0
	LOAD
	FP1
	STORE
	2000		/F1(0)=1
	 
	SET I 16
	2060		/F1(16) PNTR
	 
NXTF1,	LIF 4
	TABGET
	 1
	 JMP TYPMES	/F1 DUN
	 HLT		/MISSING
	 
	 
F1VAL,	JMP NUMSET	/SET BETA 10 & 11
BKF1,	LDF 11		/MOVE VALUE
	LOAD
	4\11
F1DF,	0		/LDF 16,17
	STORE
	4\16
	LOAD
	FP1
	LDF 16
	FADD
	2014
	STORE
	2014
	 
/WATCH FOR DF OVERFLOW.
	XSK 16		/SKP ON 3777
	 JMP .+6	/NO OVERFLOW
	LDA I 16	/OVERFLOW, BUMP 16
	CLR
	ADD F1DF	/BUMP LDF
	ADD KP1
	STC F1DF
	 
	XSK I 10	/DUN THIS NUMFILE?
	 JMP BKF1	/NO
	JMP NXTF1	/YES, GET NEXT F1
/END GETF1.
	 
	 
/ROUTINE TO SET BETA 10 & 11 FOR MOVING VALUES
/FROM NUMFILE TO DF6,7,16, & 17.
NUMSET,	LDF 10		/PBLK DF
	LDA
	P20		/NUM ENTRIES
	COM
	STC 10		/CNTR
	 
	SET I 11	/PNTR
	2000
	JMP 0		/LEAVE
/END NUMSET.
	 
	 
/NOW TYPE OUT HEADER MESSAGE.
TYPMES,	LIF 4
	MESOUT
	 BUFOUT-1
	 
	SETWRD
	0400
	LDF 6		/TYPOUT N0,N1,& DF
	LOAD
	2014		/NUM0
	OUTPUT
	NUM0
	LDF 16
	FADD
	2014		/NUM1
	FSUB
	FP1
	OUTPUT
	DF
	LOAD
	2014
	OUTPUT
	NUM1
	 
	LIF 4
	MESOUT
	 BUF2
	 
FILGX,	JMP START
	 
/MESSAGES.
M0,	TEXT %UNUM%
	4543
	4040
BUFOUT,	00
	00
	00
	00
	00
	00
	00
	00
	00
	00
	00
	00
	00
	00
	00
	 
M1,	TEXT %MESSAGE:%
M2,	TEXT %F0 FILES?:%
M3,	TEXT %F1 FILES?:%
BUF2,	TEXT %N0= %
NUM0,	00
	00
	4040
	TEXT %N1= %
NUM1,	00
	00
	4040
	TEXT %DF= %
DF,	00
	00
	4543
/END FILGET.
	 
/ROUTINE TO JUMP TO PICK MIMIC ROUTINE
/IN IF2.
/RTRN VIA BETA 17 IS HANDLED IN IF2.
	PICK=JMP .
	SET 17
	0
	LIF 2
AAEND5,	JMP PIK2	/LEAVE
/END PICK IMITATOR.
/END IF5 PROGRAMMING.
	 
	 
	 
/NOW STARTS IF2 PROGRAMMING.
	SEGMNT 2
	*1400
PIK2,	MUL I		/AC= ITEM NUM
	3
SWITCH,	SAGEE		/SAGEE,JMP PIK2A
	1777
	 
	 JMP PIK2A	/1774 OR LESS
	 
	ADD C1		/>=2000
	STC 1		/PNTR
	LDA I		/SET 2ND DF
	LDF 7
	JMP PIK2B
	 
PIK2A,	ADA I
	2000
	STC 1		/PNTR
	LDA I		/SET 1ST DF
	LDF 6
PIK2B,	STC LHDF
	 
	LDF 5
	LDA		/BETA17 OF IF5
	2017
	STC 4
	LDA 4		/0-1, F0-F1
	ROL 3		/0-10
	ADA I
LHDF,	0		/LDF 6 OR 7
	STC PIKDF	/LDF 6,16,7,OR17
	 
	LDA I
	LOAD		/744=LOAD, 745=STORE
	ADA I 4		/READ=0, WRITE=1
	STC PIKCOM
	XSK I 4
	LDA
	4
	STA		/RESET BETA17,IF5
	2017
	 
/NOW GET WANTED VALUE.
PIKDF,	0		/LDF 6,7,16,17
PIKCOM,	0		/LOAD, STORE
	1		/PNTR
	 
/RTRN TO IF 5.
	LIF 5
	JMP 17		/LEAVE
C1,	1
C2,	2
	 
/CHECK FOR BIG OR SMALL SIZE FILES.
CHKSIZ,	LDF 5
	LDA
	2\NC		/F0 SIZE
	SAGEE
	500		/320(10)
	SKP
	 JMP BIGSIZ
	LDA
	2\ND		/F1 SIZE
	SAGEE
	500
	JMP SMLSIZ
	 
BIGSIZ,	LDA I		/BIG FILE
	SAGEE
	STC SWITCH
	LIF 5
	JMP CHKRET
	 
SMLSIZ,	LDA I		/SMALL FILE
	JMP PIK2A
	JMP BIGSIZ+2
/END PIK2.
/// SAGEE
	 
/SUBROUTINE SAGEE DOES SKIP IF VALUE
/IN AC IS GREATER OR EQUAL TO CONTENTS OF P+1.
/DOES NOT DESTROY AC, DF, OR BETA REGISTERS.
	 
	SAGEE=JMP .
	STC SAGEEX+1	/SAVE AC
	ADD 1
	STC SAGEEX+3	/SAVE BETA 1
	SET 1
	0
	ADD 1
	STA
	SAGEEX+2	/ORIG RTRN JUMP
	BCL I
	6000
	STC 1
/NOW COMPARE VALUES.
	LDA 1
	COM
	ADD SAGEEX+1
	AZE I
	JMP .+7		/EQUAL
	APO I		/NOT EQUAL
	JMP .+5		/GRTR
	CLR		/LESS
/NOW SET UP RETURN JUMPS.
	ADD SAGEEX+2
	ADD C1
	JMP .+4
	CLR
	ADD SAGEEX+2
	ADD C2
	STC SAGEEX
	SET 1		/RESTORE BETA 1
	SAGEEX+3
	ADD SAGEEX+1	/RESTORE AC
SAGEEX,	0		/LEAVE, RTRN JUMP
	0		/AC
	0		/ORIG RTRN JMP
	0		/BETA 1
AAEND2,	0
/SAGEEX IS OFTEN USED AS A FP REGISTER AS WELL.
/END SAGEE.
/END IF2 PROGRAMMING.
	 
/END PROGRAM.
/END PROGRAM.
	 
/PBLOCK FOLLOWS
	NOLIST
//PBLOCK
	P20=3420	/NO.SEG IN ENSM
/
/COMMAND DECODER ASSIGNMENTS
/
/
	STOP=JMP 20
	SCAN=JMP 21
	STRSCN=JMP 21
	INUNIT=JMP 22
	STORIT=JMP 23
	GETFIL=JMP 24
	GETFST=JMP 24
	GETNAM=JMP 25
	GETNXT=JMP 25
	DIRINI=JMP 26
	DIRLST=JMP 27
	ASSIGN=JMP 30
	DEASS=JMP 31
	OUTUNIT=JMP 32
	LODBLK=JMP 33
	RUNBLK=JMP 34
	FIND=JMP 35
	CALL=JMP 37
	UNCALL=JMP 40
	RUNPRG=JMP 41
	INTRACT=JMP 42
	MESOUT=JMP 43
	DISK=JMP 44
	TABSET=JMP 45
	INTABLE=JMP 46
	MISSNG=JMP 47
	TABGET=JMP 50
	TABPUT=JMP 51
	TABZER=JMP 52
	MAKDIL=JMP 53
	TABINI=JMP 54
	MGETNAM=JMP 55
	MGETFIL=JMP 56
	MSTORIT=JMP 57
/
/COMMAND LOCATIONS.
/
	FILNAM=2320
	WORD1=2323
	WORD2=2324
	INBUF=2325
/COMMAND NUMBERS.
	YES=17
	NO=20
/EXEC3 ASSIGNMENTS
/
	OPR=500
	IOF=6002
	ION=6001
	EXC=1710
	REXC=540
	RLSW=514
	RRSW=515
/FLOATING POINT DEFINITIONS.
/
	FAC=0
	STARTE=740
	FSUB=741
	FMUL=742
	FDIV=743
	LOAD=744
	STORE=745
	SETWRD=746
	INPUT=747
	OUTPUT=750
	ISTOR1=751
	SQRT=752
	DFLOAT=753
	SFLOAT=754
	FIX=755
	FADD=756
	ISTOR2=757
	STARTF=760
	FCOMP=761
	FZER=762
	FAPO=763
	FAZE=764
	RECIP=765
	LIST
/END PBLOCK
///END UNUM
/MAY 76
/FHD



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search