File EDITOR.PA (PAL assembler source file)

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

/INTERACTIVE MODE EDITOR FOR EDUSYSTEM-30 BASIC
/
/23-NOV-71		P. KNUEVEN, B. SMITH
/
/COPYRIGHT 1971		OREGON MUSEUM OF SCIENCE & INDUSTRY
/			PORTLAND, OREGON
/
/ ENTRY POINT = 1000


/ AUTO-INDEX REGISTERS
	XR1=11
	XR2=12
	XR3=13
	XR4=14

/ CONSTANTS WHICH CAN BE GENERATED IN AC
	K0001=CLA IAC
	K4000=CLA STL RAR

/ LP08 LINE PRINTER IOT'S
	LSF=6661		/SKIP ON LINE PRINTER FLAG
	LPC=6666		/LOAD PRINT CHARACTER

/ EAE MICROINSTRUCTIONS
	MQL=7421		/LOAD AC INTO MQ, CLEAR AC
	MQA=7501		/READ MQ INTO AC
	CAM=7621		/CLEAR AC AND MQ

	*0
L77,	77
MAX,	TAD PLINE2
	DCA I PBASE
	JMS I PGETNUM
	TAD NUM
	DCA I PMAXINS
	JMP I PREADY
PMAXINS,MAXINS

/ POINTERS TO GLOBAL ROUTINES

	*20
READ,	DREAD
WRITE,	DWRITE
PPRINT,	PRINT		/PRINT RTN PTR MUST BE AT 22!!
PINPUT,	INPUT
RDFILE,	READFILE
WRFILE,	WRITEFILE
PMOVE,	MOVE
L200=PMOVE
LOWOUT,	OUTPUT
LOWIN,	INPUT
PNORMAL,NORMAL
PKOMAND,KOMAND
PGETLINE,	GETLINE
PFINDNEXT,	FINDNEXT
PGETNUM,GETNUM
COMMAND,KOMAND
PHEDING,HEDING
PREADY,	READY
POUTPUT,OUTPUT
PANOTHER,ANOTHER
PPACK,	PACK
USR,	7700
DSKHND,	0
	GETUSR=JMS I .
	USRGET
	DISMISS=JMS I .
	USROUT
	GETDSK=JMS I .
	DSKGET

/ POINTERS TO SYSTEM COMMUNICATIONS AREA

PREC,	REC
PRDTIM,	RDTIM
PLPTFLG,LPTFLG
PDEBNOL,DEBNOL
PKFLG,	KFLG
PRUNCNT,RUNCNT
PRUNNO,	RUNNO
PPFLG,	PFLG		/0 -> NOT IN PRIV MODE; 1 -> IN PRIV MODE
PSYSIO,	SYSIO
PTXTLEN,TXTLEN

/ OTHER GLOBAL POINTERS

PFILE,	400
FILEND,	7377		/(CAN'T READ THE LAST PAGE)
PLINEM1,7777
PLINE,	0
PLINE1,	1
PLINE2,	2
PLINE3,	3
	L3=PLINE3
PBASE,	BASE

/ GLOBAL VARIABLES

HOLD,	0
POINT,	0
LCTR,	0
FROM,	0
CHAR,	0
LINENO,	0
NUM,	0
OFFSET,	0
TO,	0
PNCH,	0
LFLG,	0
	TFLG=LFLG
DSK,	0
SPINSAV,0
LFFLAG,	0
LASTL,	0
LASTLP,	0
TEMP1,	0
TEMP,	0
TEMP3,	0
	ONE=TEMP3

/ GLOBAL CONSTANTS

L12,	12
L122,	122
L177,	177
L207,	207
L212,	212
L215,	215
L237,	237
L4100,	4100
L5252,	5252
L7766,	7766
L7700,	7700
L7741,	7741
L7775,	7775
L7745,	7745
L7575,	7575
L7653,	7653
MFILE,	-400
M12,	-12

OUTPUT,	0
	TSF
	JMP .-1
	TLS
	CLA
	JMP I OUTPUT
PASSF,	1		/0 -> NO ECHO; THIS DOES NOT AFFECT THE ECHO COMMAND;
			/  USED TO KEEP PASSWORD FROM ECHOING
ECHOF,	1		/ECHO COMMAND FLAG; ODD -> ECHO; EVEN -> NO ECHO
ECHO,	ISZ ECHOF
L7600,	7600		/EFFECTIVELY A NOP
	JMP I PREADY
WHATM,	TEXT /WHAT?_/
	*.-1
L37,	37
L337,	337

CRLF,	0
	TAD L215
	JMS I POUTPUT
	TAD L212
	JMS I POUTPUT
	JMP I CRLF

USELPT,	0
	TAD I PLPTFLG
	SNA CLA
	JMP .+3
	TAD LPTOUT
	DCA POUTPUT
	STA
	JMS CRLF
	JMP I USELPT
LPTOUT,	LP08

	PAGE

MOVE, 0 DCA TO TAD I MOVE DCA FROM ISZ MOVE TAD TO CLL CIA TAD FROM SNL CLA JMP TOGT CDF 10 KEEPON, TAD I FROM SNA JMP LAST DCA I TO ISZ FROM ISZ TO JMP KEEPON LAST, DCA I TO CDF JMP I MOVE TOGT, TAD FROM DCA POINT CDF 10 LOOK, TAD I POINT SNA CLA JMP GOTIT ISZ POINT JMP LOOK GOTIT, TAD TO TAD POINT CMA CML IAC TAD FILEND TAD FROM SNL CLA JMP OKFITS CDF JMS I PPRINT OVFLOW JMP I PANOTHER OKFITS, TAD FROM CIA TAD TO TAD POINT DCA TO TAD POINT CMA TAD FROM DCA FROM LOOP, TAD I POINT DCA I TO CLA CMA TAD POINT DCA POINT CLA CMA TAD TO DCA TO ISZ FROM JMP LOOP CDF JMP I MOVE GETNUM, 0 DCA OFFSET DCA NUM LUP, TAD OFFSET CLL RAR TAD I PBASE DCA TEMP CDF 10 TAD I TEMP CDF SZL JMP .+4 RTR RTR RTR AND L77 TAD L7741 SNA DCA LCTR TAD L7745 CLL TAD L12 DCA TEMP SNL JMP I GETNUM TAD NUM CLL RAL SZL SPA JMP EXITE RAL TAD NUM SZL SPA JMP EXITE RAL TAD TEMP SZL JMP EXITE DCA NUM ISZ OFFSET JMP LUP EXITE, CLA JMS I PPRINT LINNO JMP I PANOTHER OVFLOW, TEXT /_NO ROOM IN FILE_/ NEWM, TEXT /NEW/ LPT, K0001 TTY, DCA I PLPTFLG JMP I PREADY *372 RUN, JMS I PHEDING JMS I WRFILE JMS I READ 0 -22 BPASS1 PAGE
NEW, CDF 10 DCA I PFILE CDF DCA I PPFLG NAME, JMS I PPRINT NEWM JMS GETNAME JMP I PREADY OLD, JMS I PPRINT OLDM DCA I PPFLG JMS GETNAME JMP I .+1 LOAD GETNAME, 0 DCA LASTLP JMS I PPRINT NAMEM JMS PAD TAD (HEADLINE-1 JMS I (HIMOV -3 TAD (PSNAME /CONVERT TO PS/8 FORMAT DCA PAD /(REMOVE SPACES) TAD (HEADLINE DCA TEMP CLA CLL CMA RTL DCA TEMP3 GETLP, TAD I TEMP AND L7700 CLL RAL SZA RAR DCA I PAD TAD I TEMP AND L77 TAD (-40 SZA TAD (40 TAD I PAD DCA I PAD ISZ TEMP ISZ PAD ISZ TEMP3 JMP GETLP TAD I (PSNAME /MAKE SURE THERE'S A NAME! SNA CLA JMP GETNAME+2 JMP I GETNAME PAD, 0 JMS I PGETLINE STA TAD LCTR DCA LCTR TAD (-14 DCA TEMP3 TAD (40 JMS I PPACK ISZ TEMP3 JMP .-3 JMP I PAD HEADER, JMS PAD TAD (HEADLINE+3 JMS I (HIMOV -6 JMP I PREADY HSIN, 0 DCA TEMP TWAIT, AND I 0 AND I 0 RSF JMP TIMEO DCA TFLG TAD L200 RRB RFC JMP I HSIN TIMEO, ISZ TEMP JMP TWAIT TAD LOWIN DCA PINPUT ISZ PASSF TAD TFLG SNA CLA JMP I PNORMAL DCA TFLG KSF JMP .-1 JMP I PANOTHER PACK, 0 DCA CHAR TAD LCTR TAD (-770 SPA CLA JMP SHORT JMS I PPRINT LONGM JMP I (NEWLINE SHORT, TAD LCTR CLL RAR TAD PLINE DCA TEMP CDF 10 SZL JMP ODDCTR TAD CHAR CLL RTL RTL RTL PATCH1, DCA I TEMP CDF ISZ LCTR JMP I PACK ODDCTR, TAD I TEMP AND L7700 TAD CHAR JMP PATCH1 PAGE
NOLINE, ISZ I PDEBNOL READY, TAD LOWOUT DCA POUTPUT JMS I PPRINT READYM KCC ANOTHER,DCA PNCH /HELP LIST/PUNCH ROUTINE CDF /JUST IN CASE JMS I PGETLINE TAD PLINE DCA BASE JMS I PGETNUM TAD OFFSET SNA CLA JMP I COMMAND TAD LASTL CLL CIA TAD NUM SZL CLA TAD LASTLP TAD PFILE DCA BASE TAD NUM DCA LASTL LINEMORE, JMS I PGETNUM TAD NUM CLL CIA TAD LASTL SNA CLA JMP EQNUM SNL JMP LASTWD JMS FINDNEXT JMP LINEMORE FINDNEXT, 0 CDF 10 LOOK4, TAD I BASE SNA JMP LASTWD AND L7700 TAD L4100 SNA CLA JMP .+4 TAD I BASE AND L77 TAD L7741 ISZ BASE SZA CLA JMP LOOK4 CDF JMP I FINDNEXT LASTWD, CDF JMS GETCNT TAD TEMP3 CIA TAD BASE JMS I PMOVE BASE, 0 BRING2, TAD PLINE DCA TEMP2 CDF 10 BRING, TAD I TEMP2 DCA I BASE ISZ BASE ISZ TEMP2 ISZ TEMP3 JMP BRING CDF JMP ANOTHER EQNUM, TAD BASE DCA TEMP1 JMS FINDNEXT TAD BASE DCA TEMP2 TAD TEMP1 DCA BASE TAD LCTR IAC CLL RAR TAD TEMP1 JMS I PMOVE TEMP2, 0 JMS GETCNT JMP BRING2 GETCNT, 0 TAD BASE TAD MFILE DCA LASTLP TAD LCTR SNA JMP ANOTHER CLL CMA CML IAC RAR DCA TEMP3 JMP I GETCNT DEBUG, K4000 TAD I PDEBNOL DCA I PDEBNOL JMP I PREADY XSCRATCH,CDF 10 DCA I PFILE CDF JMP I PREADY HEDING, 0 JMS USELPT JMS CRLF CDF 10 TAD I PLINE2 CDF TAD (-1610 SNA CLA JMP I HEDING JMS I PPRINT HEADLINE JMP I HEDING OLDM, TEXT /OLD/ TAPE, TAD (HSIN DCA PINPUT RFC ISZ LFFLAG ISZ TFLG TAD PANOTHER DCA COMMAND DCA PASSF JMP I PANOTHER PAGE
*1000 HELLO, TLS DCA I PDEBNOL DCA I PCHAIN DCA I PBREAK CDF 10 DCA I PFILE CDF ISZ I PSYSIO JMP .+3 JMS I PPRINT IOERR TAD I PTXTLEN SZA CLA JMS I RDFILE DCA I PSYSIO JMP I PREADY PBREAK, BREAK PCHAIN, CHAIN IOERR, TEXT 'I/O ERROR' WHAT, JMS I PPRINT WHATM JMP I PANOTHER BYE, TAD (BOOT /SET RESTART ADDRESS AT 7400 DCA I (7745 JMS I WRFILE /SAVE CURRENT TEXT JMP I L7600 PUNCH, ISZ PNCH JMP LIST+1 LIST, JMS I PHEDING TAD PLINE3 DCA I PBASE JMS I PGETNUM TAD NUM DCA LINENO TAD PFILE DCA I PBASE MOREFL, JMS I PGETNUM TAD LINENO CLL CIA TAD NUM SZL CLA JMP GOTTIT JMS I PFINDNEXT JMP MOREFL GOTTIT, TAD I PBASE DCA STADR TAD PNCH SNA CLA JMP .+4 TAD (HSOUT DCA POUTPUT PLS K0001 CDF 10 JMS I PPRINT STADR, 0 JMP I PREADY HSOUT, 0 PSF JMP .-1 PLS CLA JMP I HSOUT HIMOV, 0 DCA XR2 TAD PLINEM1 DCA XR1 TAD I HIMOV DCA TEMP ISZ HIMOV CDF 10 TAD I XR1 CDF DCA I XR2 ISZ TEMP JMP .-5 JMP I HIMOV LOGX=2450 LOGHD=3631 LFREE=3600 LOG, JMS USELPT JMS I READ 3600 -11 BATLOG CLA IAC JMS I PPRINT LOGHD TAD (LOGX-1 DCA I (LFREE /CLEAR LOG DCA I (LOGX+1200 JMS I WRITE 3600 -1 BATLOG JMP I PREADY LINNO, TEXT /LINE NO. TOO BIG_/ LONGM, TEXT /_LINE TOO LONG_/ DELM, TEXT / DELETED_/ PAGE
GETLINE,0 NEWLINE,DCA LCTR CDF 10 DCA I PLINE2 /HELP HEADING ROUTINE DCA I PLINE3 /HELP LIST ROUTINE CDF NEWCHAR,JMS I PINPUT DCA HOLD TAD HOLD AND L177 SNA JMP NEWCHAR TAD (-177 SZA JMP NORUB TAD LFFLAG SZA CLA JMP NEWCHAR JMP BACKS NORUB, IAC /LOOK FOR ALL THE ALTMODES SZA IAC SZA TAD (142 SZA JMP NODLT TAD LFFLAG SZA CLA JMP NEWLINE JMS I PPRINT DELM JMP NEWLINE NODLT, TAD (-104 SZA JMP NOLARR BACKS, CLA CMA TAD LCTR SPA CLA DCA LCTR TAD L337 JMP CHAROUT NOLARR, TAD L122 SZA JMP NOCRET TAD L37 JMS I PPACK TAD ECHOF AND PASSF SZA CLA JMS CRLF CLA CMA TAD LCTR SNA CLA JMP NEWLINE JMP I GETLINE NOCRET, TAD L3 SNA JMP NEWCHAR TAD L7653 CLL TAD L77 SNL CLA JMP BADCHAR TAD HOLD AND L77 SZA JMS I PPACK JMP CHOUT1 BADCHAR,TAD L207 CHAROUT,DCA HOLD CHOUT1, TAD ECHOF AND PASSF SNA CLA JMP NEWCHAR TAD HOLD JMS I POUTPUT JMP NEWCHAR PRINT, 0 DCA LFLG TAD .+3 /GET PRINT FIELD RDF DCA LILOOP-2 CDF TAD I PRINT DCA TEMP ISZ PRINT HLT KCC LILOOP, TAD I TEMP RTR RTR RTR JMS FILL TAD I TEMP JMS FILL NLINE, ISZ TEMP KSF JMP LILOOP KRS TAD L7575 /CHECK FOR ^C SZA CLA JMP LILOOP-1 JMS CRLF PRRET, DCA LFLG CDF JMP I PRINT FILL, 0 AND L77 SNA JMP PRRET TAD L7741 SZA JMP REGULAR JMS CRLF TAD LFLG SZA CLA JMP NLINE JMP I FILL REGULAR, SPA TAD (100 TAD L237 JMS I POUTPUT JMP I FILL PAGE
READFILE, 0 TAD I PTXTLEN DCA .+4 CDF 10 JMS I READ 0400 7750 FILEREC JMP I READFILE WRITEFILE, 0 JMS GETLENGTH CIA DCA I PTXTLEN TAD I PTXTLEN DCA .+4 CDF 10 JMS I WRITE 0400 7750 FILEREC JMP I WRITEFILE INPUT, 0 CLL TAD L5252 DCA SPINSAV INPUTX, DCA I PRDTIM TAD L7775 DCA LP08 TAD SPINSAV SPIN, ISZ NUMOUT SKP CMA CML RAL /MARCH TO THE LEFT KSF JMP TTEST DCA SPINSAV KCC TAD L200 KRS JMP I INPUT TTEST, ISZ I PRDTIM JMP SPIN ISZ LP08 JMP SPIN DCA SPINSAV TAD LFFLAG SNA CLA JMP INPUTX NORMAL, TAD PKOMAND DCA COMMAND DCA LFFLAG JMP I PREADY LP08, 0 LPC CLA LSF JMP .-1 JMP I LP08 GETLENGTH, 0 TAD (377 DCA XR4 CDF 10 TAD I XR4 SZA CLA JMP .-2 CDF TAD XR4 TAD L7600 RTL RTL RTL AND L37 JMP I GETLENGTH LENGTH, JMS GETLENGTH IAC CLL RAR /CONVERT TO BLOCKS JMS NUMOUT JMP I PREADY NUMOUT, 0 TAD M12 ISZ ZERO SMA JMP .-3 TAD ("9+1 DCA ONE TAD ZERO TAD ("0-1 JMS I POUTPUT TAD ONE JMS I POUTPUT JMS CRLF DCA ZERO JMP I NUMOUT ZERO, 0 READYM, TEXT /_READY_/ PAGE
MD=LA UNSAVE, GETUSR /IN CASE WE LOAD THE 'DSK:' GETDSK TAD DSK /DEVICE FOR DELETE CIF 10 JMS I USR 4 PSNAME 0 /0 LENGTH TO DELETE JMP LERROR /NO FILE TO DELETE DISMISS /GET RID OF MONITOR JMP I PREADY LERROR, JMS I PPRINT NOTFND DISMISS JMP I PANOTHER ALTER, KCC KSF JMP .-1 KCC AREAD, LAS DCA RDNO TAD RDNO DCA WRNO JMS I READ L4000, 4000 -2 RDNO, 0 CAM JMP LA+1 HUH, KSF JMP .-1 KRB TAD MD SNA JMP DEP IAC SNA JMP CANCEL TAD ("C-"L SNA JMP LA TAD ("L-"N SNA JMP NEX TAD ("N-"R SNA JMP AREAD TAD ("R-"W SZA CLA JMP DISP AWRITE, JMS I WRITE 4000 -2 WRNO, 0 CANCEL, CAM JMP I PREADY LA, OSR SNA SZL /NEVER SKIPS; SNEAKY WAY TO GET CONSTANT -"D AND (377 MQL MQA TAD L4000 DCA TO DISP, TAD I TO JMP HUH DEP, LAS DCA I TO JMP DISP NEX, TAD TO CLL IAC JMP LA+1 USRGET, 0 CIF 10 JMS I USR 10 /LOCK THE USR IN CORE TAD L200 /AND TELL EVERYBODY DCA USR /WE DID IT JMP I USRGET USROUT, 0 TAD USR /IF THE USR IS IN, SPA CLA /GET RID OF IT JMP I USROUT /ALREADY GONE CIF 10 JMS I USR 11 /BYE-BYE TAD L7700 /RESET POINTER DCA USR JMP I USROUT DSKGET, 0 /GET THE 'DSK:' HANDLER TAD DSKP-1 /HAVE WE ALREADY DONE THIS? SZA CLA JMP I DSKGET /GUESS SO - POINTERS ALREADY SET CIF 10 JMS I USR /DON'T CALL USR FIRST (MIGHT BE 1 /CATALOG) 5723 /CODE FOR 'DSK:' 0 DSKP, 7200 /LOAD AT 7200 JMP I (DERROR /WHAT DO YOU MEAN, NO DSK:?? TAD DSKP-1 /MOVE DEVICE # DCA DSK TAD DSKP /AND ENTRY POINT DCA DSKHND JMP I DSKGET ROOMM, TEXT /NO ROOM_/ NOTFND, TEXT /FILE NOT FOUND_/ FILEM, TEXT /BAD FILE_/ PAGE
KOMAND, TAD PTRCOM DCA XR1 CFIND, TAD I XR1 SNA JMP I (WHAT CDF 10 TAD I PLINE SNA CLA JMP YETH CDF ISZ XR1 UP1, ISZ XR1 JMP CFIND YETH, TAD I PLINE1 CDF AND L7700 TAD I XR1 SZA CLA JMP UP1 TAD I XR1 CLL RAR DCA TEMP DCA I (LASTLP /IN CASE THIS CHANGES TEXT TAD I PPFLG RAL SZA CLA /IF NO PRIVILEGED FACILITY: CLA JMP I TEMP JMP I (WHAT / / TABLE OF SYSTEM COMMANDS / / FORMAT OF ENTRY / 1ST WORD: -(FIRST TWO LETTERS OF COMMAND NAME) / 2ND WORD: -(LEFT-JUSTIFIED THIRD LETTER OF COMMAND NAME) / 3ND WORD: (ADDR. OF PROCESSING ROUTINE)^2 + P / IF P=0 COMMAND IS PRIVILEGED / IF P=1 COMMAND IS NOT PRIVILEGED / PTRCOM, . -1714;-0400; OLD^2+1 -1605;-2700; NEW^2+1 -2225;-1600; RUN^2+1 -1501;-3000; MAX^2+0 -1417;-0700; LOG^2+0 /IF NO BATCH LOG: WHAT^2+0 -1420;-2400; LPT^2+1 /IF NO LP08 PRINTER: WHAT^2+0 -2424;-3100; TTY^2+1 -2301;-2600; SAVE^2+0 -2205;-2300; RESEQUENCE^2+1 -1411;-2300; LIST^2+1 -1601;-1500; NAME^2+1 -0301;-2400; CATLOG^2+1 -2303;-2200; XSCRATCH^2+1 -2516;-2300; UNSAVE^2+0 -0201;-2400; BATCH^2+1 /IF NO BATCH CAPABILITY: WHAT^2+0 -2401;-2000; TAPE^2+1 -1005;-0100; HEADER^2+0 -1405;-1600; LENGTH^2+1 -0405;-0200; DEBUG^2+0 -0503;-1000; ECHO^2+1 -2025;-1600; PUNCH^2+1 /IF NO HIGH-SPEED PUNCH: WHAT^2+0 -1617;-1400; NOLINE^2+1 -2001;-2300; PASSWORD^2+0 /IF NO PRIVILEGE COMMAND CAPABILITY: WHAT^2+0 -2022;-1100; PRIVILEGE^2+1 /IF NO PRIVILEGE COMMAND CAPABILITY: WHAT^2+0 -0114;-2400; ALTER^2+0 -2324;-0100; STACK^2+1 /IF NO BATCH CAPABILITY: WHAT^2+0 -0231;-0500; BYE^2+1 0 PAGE
PRIVILEGE, DCA PASSF JMS I (PAD CDF 10 TAD I PLINE TAD PASS1 SZA JMP BADP TAD I PLINE1 TAD PASS2 SZA JMP BADP TAD I PLINE2 TAD PASS3 SZA BADP, STA CDF DCA I PPFLG ISZ PASSF ISZ I PPFLG JMP I PREADY JMS I PPRINT BADPM JMP I PREADY PASSWORD, DCA PASSF JMS I (PAD CDF 10 TAD I PLINE CIA DCA PASS1 TAD I PLINE1 CIA DCA PASS2 TAD I PLINE2 CDF CIA DCA PASS3 JMS I WRITE 2000 -2 EDITOR+4 ISZ PASSF JMP I PREADY PASS1, -1715 / -(SYSTEM PASSWORD CHAR. 1 AND 2) PASS2, -2311 / -(SYSTEM PASSWORD CHAR. 3 AND 4) PASS3, -4040 / -(SYSTEM PASSWORD CHAR. 5 AND 6) BADPM, TEXT /INVALID PASSWORD_/ NAMEM, TEXT / FILE NAME--/ / THE VARIABLE "BASE" IS USED BY THE BATCH ROUTINE / MAKE SURE IT DOESN'T CLOBBER ANYTHING IMPORTANT STACK, ISZ I PKFLG BATCH, TAD (RDREDT DCA I PREC DCA I PRUNCNT TSF JMP .-1 TAD I PPFLG SNA SPA CLA /IF NO PRIVILEGED COMMAND CAPABILITY: SKP CLA JMP NOPRIV TAD PLINE3 DCA I PBASE JMS I PGETNUM TAD NUM SNA SETIT, TAD ASSUM CIA DCA I PRUNNO JMP I (BOOT NOPRIV, TAD I PKFLG SMA CLA JMP SETIT JMP I (BOOT ASSUM, 2 PNAME, 0 /PRINT A FILE NAME CLA CLL CMA RTL DCA TEMP3 TAD I TO JMS TWOCHR ISZ TO ISZ TEMP3 JMP .-4 JMS TWOCHR TAD LINENO JMS I (NUMOUT JMP I PNAME TWOCHR, 0 DCA CHAR TAD CHAR CLL RTR RTR RTR JMS ONECHR TAD CHAR JMS ONECHR JMP I TWOCHR ONECHR, 0 AND L77 SZA TAD (-40 SPA TAD (100 TAD (240 JMS I POUTPUT JMP I ONECHR PAGE
SAVE, JMS I (GETLENGTH/BEFORE WE CALL THE MONITOR IAC /PAGES -> BLOCKS CLL RAR DCA SBLOCK GETUSR GETDSK TAD SBLOCK-1 DCA SNAME TAD SBLOCK CLL RTL /SHIFT FOR ENTER RTL TAD DSK /DEVICE # CIF 10 JMS I USR /ENTER OUTPUT FILE 3 SNAME, 0 0 JMP SERROR /NO ROOM FOR OUTPUT TAD DSK CIF 10 JMS I USR /CLOSE FILE 4 PSNAME SBLOCK, 0 HLT /HUH? TAD SNAME /MOVE STARTING BLOCK DCA SWRITE TAD (20 /FOR WRITE TAD SBLOCK LENTER, CLL RTL /COMPUTE FUNCTION WORD RTL IAC /FIELD 1 RTL RAL IAC /BEGIN SEARCH FORWARD DCA SFUN DISMISS /RESTORE PROGRAM AREA JMS I DSKHND SFUN, 0 0400 /STARTING ADDRESS SWRITE, 0 JMP I (DERROR JMP I PREADY LOAD, GETUSR GETDSK TAD SBLOCK-1 DCA LNAME TAD DSK CIF 10 JMS I USR 2 /LOOKUP FILE LNAME, PSNAME 0 /USELESS LENGTH JMP I (LERROR CLL TAD LNAME+1 /MAKE CURSORY CHECK FOR WRONG FILE TAD (16 /(CHECK FILE LENGTH) SNL CLA JMP LERR1 TAD LNAME DCA SWRITE TAD LNAME+1 CLL CIA JMP LENTER LERR1, JMS I PPRINT FILEM /"BAD FILE" DISMISS JMP I PANOTHER SERROR, JMS I PPRINT ROOMM /"NO ROOM" JMP LERR1+2 CATLOG, JMS USELPT GETDSK CLA IAC /DIRECTORY STARTS IN BLOCK 1 CATLP, DCA CBLOCK JMS I DSKHND 0210 /READ INTO FIELD 1 0000 /(USE COMMAND LINE BUFFER) CBLOCK, 0 JMP I (DERROR TAD (4 DCA XR1 CDF 10 ENTRY, TAD I XR1 /CHECK FIRST WORD OF THIS ENTRY SNA CLA JMP EMPTY /EMPTY FILE TAD XR1 /SAVE POINTER TO NAME DCA TO ISZ XR1 /BUMP TO EXTENSION ISZ XR1 TAD I XR1 DCA LINENO /SAVE FOR A BIT TAD I (4 /WHILE WE SKIP WASTE WORDS CLL CIA TAD XR1 DCA XR1 TAD LINENO /CHECK FOR '.30' EXTENSION TAD (-6360 SZA CLA JMP EMPTY TAD I XR1 /ZERO LENGTH SAYS TENATIVE FILE SNA JMP EMPTY+1 /IGNORE SUCH THINGS CLL CIA DCA LINENO JMS I (PNAME /PRINT THIS ENTRY SKP EMPTY, ISZ XR1 ISZ I PLINE /LOOP ON # OF ENTRIES JMP ENTRY TAD I PLINE2 CDF SZA JMP CATLP JMP I PREADY PAGE
ATABLE=4000 /LINE # BUFFER ACOUNT=7200 RESEQUENCE, JMS I (INIT /RESEQUENCE PROCESSOR TAD (ATABLE DCA EPTR TAD (132 DCA NUMBER DCA LAST1 DCA I EPTR ISZ EPTR TAD NUMBER DCA I EPTR ISZ EPTR MAKTAB, JMS I (NUMGET JMP END1 SNA JMP NONUM DCA I EPTR TAD I EPTR CIA TAD LAST1 SNA CLA JMP NONUM TAD I EPTR DCA LAST1 ISZ EPTR TAD NUMBER TAD (12 DCA NUMBER TAD NUMBER DCA I EPTR ISZ EPTR NONUM, TAD LETTER JMP .+3 PMINS4, JMS I (GETCH JMP END1 TAD (-37 SNA CLA JMP MAKTAB JMP PMINS4 END1, JMS I (INIT TAD EPTR CIA TAD (ATABLE CLL CML RAR DCA I (ECOUNT ELINE, DCA I (QCNT JMS I (GETCH JMP I (END2 DCA LETTER TAD LETTER JMS I (NUMTST JMP NOTNUM JMS I (NUMGET JMP I (END2 JMS I (TRAN JMS I (PUTNUM NOTNUM, CLA JMP .+4 WHATISIT, JMS I (GETCH JMP I (END2 DCA LETTER TAD LETTER JMS I (PUTCH TAD LETTER TAD (-40 SNA JMP WHATISIT TAD (27 SNA JMP I (EIF TAD ("I-"G SNA JMP I (ECOOL TAD (-30 FLUSH2, SNA JMP ELINE TAD (3 SNA JMS BCKSLA TAD (-13 SNA CLA JMS I (AQFLU FLUSH, JMS I (GETCH JMP I (END2 DCA LETTER FLUSHN, TAD LETTER JMS I (PUTCH TAD LETTER TAD (-37 JMP FLUSH2 BCKSLA, 0 TAD I (QCNT SZA CLA JMP I BCKSLA JMP ELINE LETTER, 0 EPTR, 0 NUMBER, 0 LAST1, 0 PAGE
EIF, JMS SUBR TAD (-6 SZA CLA JMP I (FLUSH ELOOK, JMS SUBR TAD (-5 SZA JMP TLOOK JMS SUBR TAD (-16 SZA CLA JMP ELOOK ICOOL, JMS I (GETCH JMP END2 DCA LETR TAD LETR JMS NUMTST JMP ENOT JMS I (NUMGET JMP END2 JMS TRAN JMS I (PUTNUM JMP I (FLUSHN ENOT, CLA TAD LETR JMS I (PUTCH TAD LETR TAD (-37 SNA CLA JMP I (ELINE JMP ICOOL TLOOK, TAD (-17 SZA CLA JMP ELOOK JMS SUBR TAD (-17 SZA CLA JMP ELOOK JMP ICOOL NUMTST, 0 TAD (-72 SMA JMP I NUMTST TAD (12 SPA JMP I NUMTST ISZ NUMTST JMP I NUMTST SUBR, 0 JMS I (GETCH JMP END2 DCA LETR TAD LETR JMS I (PUTCH TAD LETR TAD (-40 SNA JMP SUBR+1 IAC SNA JMP I (ELINE TAD (3 SNA JMS I (BCKSLA TAD (-13 SNA CLA JMS I (AQFLU TAD LETR JMP I SUBR END2, CLA CLL JMS I (PUTCH JMS I (PUTCH JMS I (PUTCH JMP I (FIXIO /RESTORE TEXT AREA TRAN, 0 CIA DCA TTEMP TAD ECOUNT DCA TCOUNT TAD (ATABLE DCA TTABLE TLOOP, TAD I TTABLE TAD TTEMP SNA CLA JMP FOWND ISZ TTABLE ISZ TTABLE ISZ TCOUNT JMP TLOOP TAD TTEMP CIA JMP I TRAN FOWND, ISZ TTABLE TAD I TTABLE JMP I TRAN LETR, 0 TTEMP, 0 TCOUNT, 0 TTABLE, 0 ECOUNT, ACOUNT PAGE
GETCH, 0 TAD MQ CLL RTL RTL RTL DCA MQ2 TAD MQ2 AND (7700 DCA MQ TAD MQ2 AND (37 RAL SNA JMP NXTWD TAD (-42 SZA JMP .+4 CLA CLL CML RAR TAD QCNT DCA QCNT TAD (42 ISZ GETCH JMP I GETCH NXTWD, CDF 10 TAD I GETPTR CDF ISZ GETPTR SZA JMP GETCH+2 JMP I GETCH PUTCH, 0 CDF 10 JMP I COPTR COPTR, 0 CDF JMP I PUTCH JMS COPTR PCHAR1, CLL RTL RTL RTL DCA I PUTPTR TAD I PUTPTR TAD (-3700 SNA CLA JMP PCHAR2+2 JMS COPTR PCHAR2, TAD I PUTPTR DCA I PUTPTR ISZ PUTPTR ISZ OUTCNT JMP PCHAR1-1 DCA I (6777 /SET EOF ON OVERFLOW FIXIO, TAD PUTPTR /SHIFT BUFFERS UP CIA DCA PUTCH TAD PUTPTR TAD (400 DCA GETPTR CDF 10 FIXLP, CLA CMA TAD GETPTR DCA GETPTR CLA CMA TAD PUTPTR DCA PUTPTR TAD I PUTPTR DCA I GETPTR ISZ PUTCH JMP FIXLP CDF JMP I PREADY INIT, 0 DCA MQ DCA PUTPTR TAD (400 DCA GETPTR TAD (PCHAR1 DCA COPTR TAD (-7000 DCA OUTCNT JMP I INIT AQFLU, 0 TAD QCNT SZA CLA JMP I AQFLU JMS GETCH JMP I (END2 DCA GETCH TAD GETCH JMS PUTCH TAD GETCH TAD (-37 SZA CLA JMP AQFLU+1 JMP I (ELINE QCNT, 0 MQ, 0 MQ2, 0 GETPTR, 0 PUTPTR, 0 OUTCNT, 0 PAGE
PUTNUM, 0 CMA DCA Y DCA L JMS DIV 1750 JMS DIV 144 JMS DIV 12 JMS DIV 1 TAD L SZA CLA JMP I PUTNUM TAD (60 JMS I (PUTCH JMP I PUTNUM Y, 0 L, 0 DIV, 0 DCA O CLA CLL CML TAD Y TAD I DIV ISZ O SZL JMP .-3 CIA TAD I DIV CIA DCA Y CLA CMA TAD O SZA ISZ L TAD (60 DCA O ISZ DIV TAD L SNA CLA JMP I DIV TAD O JMS I (PUTCH JMP I DIV O, 0 NUMGET, 0 DCA VAL JMS I (GETCH JMP I NUMGET DCA LTR TAD LTR JMS I (NUMTST JMP NG DCA Y TAD VAL CLL RAL SZL JMP NG RAL SZL JMP NG TAD VAL SZL JMP NG RAL SZL JMP NG TAD Y SNL JMP NUMGET+1 NG, CLA TAD LTR DCA I (LETTER TAD LTR DCA I (LETR TAD VAL ISZ NUMGET JMP I NUMGET VAL, 0 LTR, 0 ECOOL, JMS I (GETCH JMP I (END2 DCA I (LETTER TAD I (LETTER JMS I (NUMTST JMP ESKIP JMS NUMGET JMP I (END2 JMS I (TRAN JMS PUTNUM JMP I (FLUSHN ESKIP, CLA TAD I (LETTER JMS I (PUTCH JMP ECOOL PAGE



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