File RESTOR.PA (PAL assembler source file)

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

/TSS/8 SAT RESTORE (VERSION 0001)
/
/BOB CURRIER		[77,00] [0,4]
/
/THIS PROGRAM IS DESIGNED TO RESTORE AND UPDATE THE SAT TABLE
/IN FIP. IT MUST RUN ON ACCOUNT 1 (THE SYSTEM ACCOUNT) IN ORDER
/TO ACCESS THE MFD. IT ALSO EXPECTS THE PRESENCE ON A DISK
/OVERLAY ON ACCT. 4 <DISK>. THIS PROGRAM IS DESIGNED TO RUN ONLY
/ON THE TSS/8.22B MONITOR AT NEWPORT-MESA DATA PROCESSING.
/
/THE FOLLOWING TABLES ARE SET UP IN CORE AT RUNTIME:
/
/	BUFFER		2600-2646
/	PSAT		2647-3377
/	UFDTBL		3400-3777
/	SEGTBL		4000-4377
/	BUFFER		4400-7777
/

/ /PAGE ZERO CONSTANTS AND DATA / / /DEFINITION OF AUTO INDEX REGISTERS / RETPNT=10 TABPNT=11 SEGPNT=12 CLEARP=13 UFDPNT=14 PSATP=15 AX=16 / /DEFINITION OF SYSTEM CONSTANTS / FIPFLD=01 /DISK TRACK OF FIP PSAT=2650 /LOCATION OF THE PSEUDO-SAT IN THIS FILE / /DEFINITION OF USER FUNCTIONS / *0020 PUTSEG=JMS I . SEGPUT CLEAR=JMS I . CLEAR1 ONEZER=JMS I . ZERO1 PUTNUM=JMS I . NUMBER PUTCHR=JMS I . ASCOUT CRLF=JMS I . CRLFB ASCIN=JMS I . KEYBRD YESNO=JMS I . YESN1 / /SOME CONSTANTS VARIABLES AND COUNTERS / K2650, 2650 WIPER, 0 M3400, -3400 K4377, 4377 INDIV, 0 K3777, 3777 K3377, 3377 K4403, 4403 MFDPNT, 0 M7, -7 MFDCNT, 0 K7, 7 K4400, 4400 MFDTMP, 0 K3, 3 M3, -3 WRDNUM, 0 SEGNUM, 0 M14, -14 K13, 13 BITNUM, 0 SEGTMP, 0 SEGHLD, 0 BITCNT, 0 M400, -400 CLECNT, 0 K2, 2 M2, -2 ERR, 0 K3402, 3402 K7700, 7700 M4, -4 POINT, 0 NEXPNT, 0 RETTMP, 0 STBNUM, 0 BUFF, 0 TEMPNT, 0 UFDCNT, 0 PSATCN, 0 SATBIG, 0 K7520, 7520 LOOCNT, 0 DI, 4451 SK, 6353 K7516, 7516 M261, -261 K7517, 7517 RPNT, 0 PPNT, 0 STWNUM, 0 STBCNT, 0 STORE, 0 K14, 14 STTMPH, 0 STWCNT, 0 STMASK, 0 K260, 260 K2647, 2647 K2646, 2646 K205, 205 K2600, 2600 / /DATA BLOCKS / / /BLOCK TO OPEN A FILE / OPNBLK, .+1 FILNM, 0 /NUMBER OF THE FILE CHANNEL ACTOWN, 0 /ACCOUNT # OF THE FILE OWNER NAME, 0 /FILENAME IN NEXT 3 LOCS 0 0 / /BLOCK TO READ OR WRITE A FILE / RWBLK, .+1 HIGH, 0 /HIGH ORDER DISK ADDRESS RWNUM, 0 /FILE CHANNEL WC, 0 /WORD COUNT CA, 0 /CORE ADDRESS RWADR, 0 /LOCATION IN FILE TO BEGIN OPERATION -1 DSKERR, 0 /ERROR WORD / /ENTRY TO PROGRAM / *0000 JMP I .+1 /RUN WITH THE "E" COMMAND 0200 /START HLT /HALT ON ^C
/THE REAL PROGRAM / *0200 CLA CLL IAC RAL /RESTART AT 2 SRA ACT /IS IT ACCT 1? CLL RAR SNA CLA HLT /NO--THATS A NO-NO CRLF /YES--TELL HIM SO WITH A <CR/LF> TAD (OMS1) /"TSS/8 RESTORE" PUTCHR P 15 CRLF CRLF TAD K2650 /CLEAR OUT OUR BUFFERS DCA WIPER DCA I WIPER /DEPOSIT ZEROES 2650-7777 ISZ WIPER JMP .-2 IAC DCA ACTOWN /ACCT 1 OWNS THE MFD DCA FILNM /FILE CHANNEL 0 TAD (NAME) /THIS IS 'DE PLACE WHO /FOR A WHO!! TAD OPNBLK OPEN /OPEN THE MFD SZA /OKAY? JMS ERROR /NO-- DCA HIGH /YES--CLEAR HIGH ORDER DISK ADDR DCA RWNUM /FILE CHANNEL 0 DCA DSKERR /ZERO OUT ERROR WORD TAD M3400 /7 SEGS WORTH DCA WC TAD K4377 /STICK IT >4400 DCA CA TAD RWBLK RFILE TAD DSKERR /WAS IT A COOL READ? SZA /??? JMS ERROR /NOT REALLY-- TAD (IMES1) /YES--ASK HIM IF HE WANTS INDIV OPTION PUTCHR P 5 YESNO /YES OR NO ANSWER IAC /YES-- SKP /NO-- JMP .-6 /THE DUMMY TYPED A ILLEGAL CHAR DCA INDIV /STORE IN OPTION WORD TAD K3777 /START OF SEGTBL DCA TABPNT TAD K3377 /START OF UFDTBL DCA UFDPNT TAD I K4403 /GET FIRST LINK WORD OF MFD SNA /ZERO? JMP MFDONE /YES--THIS IS AN IMPOSSIBLE CONDITION BUT /WE WILL TREAT IT AS THOUGH THERE WERE NO FILES IN THE MFD (HA!) DCA MFDPNT /NO--STORE AS POINTER MFDLOP, TAD M7 /ONLY 7 SEGS/UFD DCA MFDCNT /STORE TAD K7 /POINT TO RETREIVAL POINTER TAD K4400 /CONVERT TO REAL DCA MFDTMP /STORE TAD I MFDTMP /GET RETREVIAL POINTER TAD K4400 DCA RETPNT /STORE IN AX 10. EVEN THOUGH THIS WILL /CAUSE US TO BYPASS THE FIRST WORD OF THE RETREVIAL BLOCK, WE DON'T /CARE, AS THE FIRST WORD SHOULD ALWAYS BE 0 TAD MFDPNT /WORD 0 TAD K3 /LINK WORD TAD K4400 DCA MFDTMP /STORE IT TAD M3 /3 WORDS IN UFD NAME DCA UFDCNT /STORE IN COUNTER TAD MFDPNT /GET WORD 0 TAD K4400 /CONVERT DCA MFDPNT /TUCK IT AWAY TAD I MFDPNT /GET A WORD DCA I UFDPNT /STORE IN UFDTBL ISZ MFDPNT /INCREMENT POINTER TO NAME ISZ UFDCNT /3 WORDS? JMP .-4 /NO--BACK FOR MORE TAD I MFDTMP /YES--GET LINK WORD DCA MFDPNT /STORE FOR NEXT TIME THROUGH TAD I RETPNT /GET A SEGMENT # SNA /ZERO?? JMP MFDINC /YES--END 'O THE LINE DCA I TABPNT /STORE IN SEGTBL VIA AX 11 ISZ MFDCNT /7 SEGMENTS YET? JMP .-5 /NO--LOOP ON THROUGH MFDINC, TAD MFDTMP SNA CLA JMP MFDONE JMP MFDLOP MFDONE, CLA CLL PUTSEG /EMPTY THE SEGTBL JMP RSEG / /ROUTINE TO CLEAR THE SEGTBL / /CALL: CLEAR / CLEAR1, 0 /IT'S A SUBROUTINE TAD K3377 /START OF THE SEGTBL DCA CLEARP /STORE IN AX 13 TAD M400 /LENGTH OF THE SEGTBL DCA CLECNT DCA I CLEARP ISZ CLECNT JMP .-2 JMP I CLEAR1 /ALL DONE!!! (THIS ROUTINE) / /ERROR ROUTINE / /THIS ROUTINE IS CALLED VIA A JMS ANYTIME AN ERROR CONDITION IS /DETECTED. THE FIRST THING THIS ROUTINE DOES IS CHECK TO SEE /IF THE ERROR CODE IN THE AC IS A SHORT FILE ERROR (CODE 2). /IF IT IS, THE ERROR IS IGNORED, AS WE ASSUME MOST UFD'S ARE /LESS THAN 7 SEGMENTS LONG. IF IT IS NOT A SHORT FILE ERROR /WE WANT TO INFORM THE USER VIA THE MESSAGE "RESTORE ERROR AT /USER LOC XXXX", RESTORE THE ERROR CODE INTO THE AC, AND HLT. / ERROR, 0 TAD M2 /CHECK FOR SHORT FILE SNA /IS IT A SHORT FILE?? JMP I ERROR /YES--IGNORE IT--IT'S OK TAD K2 /NO--GET BACK WHUT WE 'AD DCA ERR /STORE FOR LATER RETREVIAL TAD (ERRMS1) /"RESTORE ERROR AT USER LOC" PUTCHR P 22 STA /AC_7777 TAD ERROR /BACK UP ERROR ADDRESS PUTNUM /OUTPUT THE ADR. S 4 CRLF CRLF TAD ERR /RESTORE ERROR CODE TO AC HLT /AND HALT........... PAGE
/ /THIS IS THE ROUTINE TO TAKE THE SEGTBL AND STICK IT INTO THE PSAT, /THEN ZERO THE SEGTBL. / SEGPUT, 0 TAD K3777 /START OF SEGTBL DCA SEGPNT DCA WRDNUM /CLEAR WORD COUNTER SEGLOP, TAD I SEGPNT /GET SEG # SNA /ZERO?? JMP SEGWIP /YES--CLEAR SEGTBL DCA SEGNUM /NO--STORE IT TAD SEGNUM /GET IT AGAIN TAD M14 /14 (8) BITS/WORD SMA SZA /ARE WE DOWN TO BITS? SKP /NO--SKIP! JMP SEGDON /YES--JUMP! ISZ WRDNUM /NO--INCREMENT THE WORD COUNT JMP SEGLOP /GO AGAIN SEGDON, TAD K13 /CONVERT TO POSITIVE DCA BITNUM /STORE IT TAD WRDNUM /GET WORD # TAD (PSAT) /ADD START OF PSEUDO-SAT DCA SEGTMP /STORE AS POINTER TAD I SEGTMP /GET WORD IN THE PSAT DCA SEGHLD /HOLD IT TAD BITNUM /GET BIT NUMBER CMA /CONVERT TO A COUNTER DCA BITCNT /STORE IT CLA CLL CML /AC_0 L_1 RAR ISZ BITCNT /ROTATE ONCE FOR EACH BIT JMP .-2 /STILL SOME MORE TAD SEGHLD /GET THE WORD BACK SZL /CHECK FOR OVERFLOW JMS ERROR /OVERFLOW!!!! THAT'S A NO-NO DCA I SEGTMP /STORE NEW WORD IN THE SAT JMP SEGLOP /BACK FOR MORE SEGWIP, CLA CLL CLEAR JMP I SEGPUT / /THIS IS THE ROUTINE TO WRITE THE PSAT ONTO DISK, OVERLAYING /THE OLD SAT WITH OUR NEW ONE. BEFORE WE DO THIS, HOWEVER, WE /CHECK WITH THE USER TO SEE IF HE WANTS IT WRITTEN. / WRITES, CLA CLL CRLF TAD (WMS1) /"WRITE?" PUTCHR P 5 YESNO JMP .+3 HLT JMP .-6 TAD PSATCN /GET THE PEUDO-SATCNT DCA I K2647 /STORE AT TOP OF SAT TAD (FIPFLD) /DISK TRACK OF FIP (1) DCA HIGH /STORE AS HIGH ORDER FILE ADDR. CLA CLL IAC RAL DCA RWNUM /FILE CHANNEL 2 TAD K2646 /START OF PSAT+PSATCN DCA CA TAD M261 DCA WC /261 WORDS. DCA DSKERR /CLEAR THE ERROR WORD TAD RWBLK /SET UP FOR......... WFILE /.......WRITE! TAD DSKERR /CHECK ERROR WORD SZA /ZERO? JMS ERROR /NO--YUCCHH!!!!!! CRLF /YES--FANCY UP OUTPUT TAD (DONMS1) /"SAT RESTORED" PUTCHR P 14 CRLF CRLF HLT / /THIS IS A VERY SIMPLE ROUTINE..........IF WHEN ENTERED, THE AC=0 /IT PRINTS A "0"......IF IT IS NOT......IT PRINTS A "1" / ZERO1, 0 SZA CLA IAC TAD K260 PUTCHR 1 JMP I ZERO1 / /THIS IS THE <YESNO> ROUTINE. IT WORKS IN CONJUNCTION WITH <ASCIN> /TO PROVIDE A SIMPLE WAY OF ACCEPTING KEYBOARD RESPONSES........... / /CALL: YESNO / (YES ANSWER RETURN) / (NO ANSWER RETURN) / (ERRONEOUS ANSWER RETURN) / YESN1, 0 TAD K205 /KEY BOARD BREAK MASK KSB TAD (YESN2) /"? " PUTCHR P 2 ASCIN /GET KEYBOARD INPUT TAD I K2600 /GET FIRST CHARACTER INPUT TAD (-"Y) /IS IS A "Y"?? SNA CLA JMP I YESN1 /YES-- ISZ YESN1 /NO--SIMULATE SKIP TAD I K2600 /GET CHAR AGAIN TAD (-"N) /IS IT AN "N"?? SNA CLA JMP I YESN1 /YES-- JUMP SKIP ISZ YESN1 /NO--SKIP ANOTHER JMP I YESN1 PAGE
/ /THIS IS THE ROUTINE TO READ THE UFDTBL, OPEN EACH UFD /AND ADD THE SEGMENTS USED BY IT TO THE PSAT. IT ALSO /HANDLES THE INDIV OPTION. / RSEG, CLA CLL TAD K3402 /START OF UFDTBL AFTER THE MFD DCA UFDPNT /AX 14 RSEG2, TAD I UFDPNT /GET THE FIRST WORD OF UFD NAME SNA /ZERO? JMP PUTSAT /YES--WE'RE DONE HERE!! DCA NAME /STORE IN OPENING BLOCK TAD UFDPNT /WORD 2 DCA NAME+1 /STORE TAD UFDPNT /LAST WORD OF THIS UFD DCA NAME+2 IAC DCA ACTOWN /ALL UFD'S ON ACCT 1 IAC /OPEN ON CHANNEL 1 DCA FILNM TAD OPNBLK OPEN SZA /WAS IT SUCCESSFUL?? JMS ERROR /NO-- DCA HIGH /YES--CLEAR HIGH ORDER WORD IAC DCA RWNUM /UFD OPEN ON CHANNEL 1 DCA DSKERR /CLEAR ERROR WORD TAD M3400 /SEVEN SEGMENTS DCA WC TAD K4377 /INTO BUFFER # 2 DCA CA DCA RWADR /START AT FILE ADDRESS 0 TAD RWBLK RFILE TAD DSKERR /ANY ERRORS? SZA /??????????? JMS ERROR /YEP-- TAD INDIV /NO--GET INDIV OPTION WORD SNA CLA /ARE WE INDIVING?? JMP RSEG3 /NO-- TAD NAME /YES--GET ACCT # TAD M4 /IS IT ACCOUNT 4? SNA CLA JMP RSEG2 /YES--DONT SAVE ANYTHING AT ALL TAD NAME AND K7700 /CHECK FOR ZERO-SERIES SNA CLA JMP RSEG3 /ZERO-SERIES.......SAVE FILES YNER, TAD (MES1) /"SAVE FILES FOR USER" PUTCHR P 24 TAD NAME /PRINT ACCT # PUTNUM S 4 YESNO JMP RSEG3 /YES-- SKP /NO--DELETE 'EM JMP YNER /ERROR-- TAD K4400 /CLEAR UFD BUFFER DCA POINT DCA I POINT /ZEROES!! ISZ POINT /ZERO 4400-7777 JMP .-2 DCA HIGH IAC /FILE CHANNEL 1 DCA RWNUM DCA DSKERR /WIPE OUT ERROR WORD TAD M3400 /SEVEN SEGMENTS AS USUAL DCA WC TAD K4377 /BUFFER # 2 DCA CA DCA RWADR TAD RWBLK WFILE /ZERO OUT THE UFD (THIS EFFECTIVLY /DELETES ALL HIS FILES) TAD DSKERR SZA /ERROR? JMS ERROR /YES--MOST LIKELY SHORT FILE JMP RSEG2 /NO--JUMP RSEG3, TAD K3777 DCA TABPNT TAD I K4403 /GET FIRST POINTER DCA NEXPNT /STORE AS POINTER RSEG4, TAD NEXPNT SNA /ZERO LINK WORD? JMP RSEG5 /YES--DONE HERE TAD K7 TAD K4400 DCA RETTMP TAD K4400 DCA RETPNT TAD NEXPNT TAD K4403 DCA RETTMP DCA NEXPNT RSEG8, TAD RETPNT /GET RETREVIL POINTER DCA TEMPNT /STORE TAD I TEMPNT /GET NEW POINTER DCA RETPNT /STORE TAD M7 /ONLY 7 SEGS/BLOCK DCA UFDCNT /STORE AS COUNTER RSEG7, ISZ TEMPNT /NEXT WORD. TAD I TEMPNT /GET SEG # SNA /ZERO? JMP RSEG6 /YES--SEE IF LAST BUFFER DCA I TABPNT /NO--STORE IN SEGTBL ISZ UFDCNT /ALL 7? JMP RSEG7 /NO-- RSEG6, TAD RETPNT /YES--GET NEXT POINTER SNA /ZERO? JMP RSEG4 /YES--ALL DONE THIS UFD TAD RETPNT /NO--GET POINTER TAD K4400 /CONVERT DCA RETPNT /STORE JMP RSEG8 /JUMP RSEG5, PUTSEG JMP RSEG2 /BACK FOR ANOTHER UFD! PAGE
/ /WE NOW HAVE THE PSEUDO-SAT (PSAT) IN CORE 2650-3377. WE MUST NOW TALLY /UP SATCNT AND STORE IT, THEN, IF THE OPERATOR WISHES, WE WILL CHECK AGAINST /THE DISK RESIDENT SAT AND NOTE ANY DIFFERANCES, FINALLY WE WILL CHECK TO /SEE IF WE WANT TO WRITE OUT THE NEW SAT;IF NOT <HLT>;IF YES--DO IT!! / /CAUTION IS RECOMMENDED IN LISTING PSAT/SAT DIFFERANCES IF YOU HAVE NOT /SAVED ALL USER FILES. THE ERROR MESSAGES WOULD BE VERY LONG AND TIME /CONSUMING WHILE NOT TELLING YOU ANYTHING. / PUTSAT, CLA CLL TAD (PSAT-1) DCA PSATP /AX 15 DCA PSATCN /CLEAR SEGMENT COUNTER TAD K7520 DCA SATBIG STCNTL, CLA CLL TAD M14 DCA LOOCNT /14 (8) BITS/WORD TAD I PSATP CLL STCNTM, RAL SNL SKP ISZ PSATCN ISZ LOOCNT /ARE WE DONE 1 WORD? JMP STCNTM /NO-- ISZ SATBIG /YES--ARE WE DONE WHOLE PSAT? JMP STCNTL /NO--BACK FOR ANOTHER WORD CLA CLL IAC RTL /ACCOUNT # 4 DCA ACTOWN TAD DI /<D><I>IN EXCESS 40 DCA NAME TAD SK /<S><K>IN EXCESS 40 DCA NAME+1 DCA NAME+2 TAD OPNBLK OPEN SZA /ERROR? JMS ERROR /YOU BETCHA' TAD (FIPFLD) DCA HIGH CLA CLL IAC RAL DCA RWNUM TAD K7516 DCA CA TAD M261 DCA WC TAD K7517 DCA RWADR /SAT INCLUDING SATCNT DCA DSKERR TAD RWBLK RFILE TAD DSKERR SZA JMS ERROR CRLF TAD (SATMS1) /"SATCNT=" PUTCHR P 7 TAD I K7517 /FETCH SATCNT PUTNUM D 4 CRLF TAD (SATMS2) /"PSATCN=" PUTCHR P 7 TAD PSATCN /GET IT PUTNUM /PUT IT D 4 CRLF TAD (SATMS3) /"SEGS=" PUTCHR P 5 SEGS PUTNUM D 4 CRLF CRLF TAD (VERIM1) /"VERIFY?" PUTCHR P 6 YESNO JMP .+3 JMP WRITES JMP .-6 TAD K7520 DCA RPNT /POINTER TO THE REAL SAT TAD K2650 DCA PPNT /POINTER TO THE PSEUDO-SAT DCA STWNUM /CLEAR WORD COUNTER TAD I RPNT /GET WORD OUT OF REAL SAT CMA AND I PPNT /AND IT WITH CORRESPONDING WORD FROM PSEUDO SAT SNA JMP STINC /IDENTICAL ANUDR, TAD M14 /WE HAVE AT LEAST ONE DIFFERANCE DCA STBCNT /USE AS BIT COUNTER DCA STBNUM /CLEAR JMP STLST PAGE
STLST, CLL RAL SNL JMP SATIN DCA STORE TAD STWNUM CIA DCA STWCNT CIA DCA STWCNT TAD K14 ISZ STWCNT JMP .-2 TAD STBNUM DCA STTMPH TAD (STMS4) /SEG #= PUTCHR P 6 TAD STTMPH /OUTPUT SEGMENT # PUTNUM D 4 TAD (STMS5) /SAT= PUTCHR P 5 TAD STBNUM CMA DCA STWCNT CLA CLL CML RAR ISZ STWCNT JMP .-2 DCA STMASK TAD I RPNT AND STMASK ONEZER TAD (STMS6) /PSAT= PUTCHR P 6 TAD I PPNT AND STMASK ONEZER CRLF TAD STORE SATIN, ISZ STBNUM ISZ STBCNT JMP STLST STINC, ISZ STWNUM ISZ PPNT ISZ RPNT JMP ANUDR JMP WRITES PAGE
/ /A PAGE OF MESSAGES / OMS1, TEXT "TSS/8 RESTORE" IMES1, TEXT "INDIV" ERRMS1, TEXT "RESTORE ERROR AT USER LOC " MES1, TEXT "SAVE FILES FOR USER " SATMS1, TEXT "SATCNT=" SATMS2, TEXT "PSATCN=" SATMS3, TEXT "SEGS=" VERIM1, TEXT "VERIFY" STMS4, TEXT "SEG #=" STMS5, TEXT " SAT=" STMS6, TEXT " PSAT=" WMS1, TEXT "WRITE" DONMS1, TEXT "SAT RESTORED" YESN2, TEXT "? "
PAGE / /UTILITY ROUTINE-----ASCOUT / / /CHARACTER TYPING ROUTINE / /CALL: TAD (ADDR OF 1ST CHAR / PUTCHR / (NUMBER OF CHRS / /THE WORD COUNT ALSO CONTAINS THE FOLLOWING /PARAMETERS: / / BIT 0 IS SET IF THEY ARE PACKED / BIT 1 IS SET IF THEY ARE PACKED IN TSS/8 / INTERNAL CODE (EXCESS 40) / /NOTE: IF ONLY ONE CHAR IS SPECIFIED IT IS ASSUMED / TO BE IN THE AC. / P=4000 T=2000 ASCOUT, 0 DCA CHRPTR TAD I ASCOUT STA TAD I ASCOUT SZA CLA JMP .+6 TAD CHRPTR TLS CLA ISZ ASCOUT JMP I ASCOUT TAD I ASCOUT AND (77) CIA DCA OUTCNT TAD I ASCOUT SPA CLA JMP UNPACK TAD I CHRPTR TLS CLA ISZ CHRPTR ISZ OUTCNT JMP .-5 OTCEXT, CLA ISZ ASCOUT JMP I ASCOUT UNPACK, TAD I ASCOUT RTL; CLA SZL TAD (40) DCA CONVRT NPCK1, TAD I CHRPTR RTR; RTR; RTR JMS EXPAND ISZ OUTCNT SKP JMP OTCEXT TAD I CHRPTR JMS EXPAND ISZ CHRPTR ISZ OUTCNT JMP NPCK1 JMP OTCEXT CONVRT, 0 EXPAND, 0 TAD CONVRT AND (77) DCA SIXBIT TAD SIXBIT AND (40) SNA CLA TAD (100) TAD (200) TAD SIXBIT TLS CLA JMP I EXPAND SIXBIT, 0 CHRPTR, 0 OUTCNT, 0 / /CRLF ROUTINE / CRLFB, 0 CLA CLL TAD CRLFMS PUTCHR 2 JMP I CRLFB CRLFMS, .+1 215; 212
PAGE / /UTILITY ROUTINE-----PUTNUM / / /THIS IS A ROUTINE TO TAKE THE VALUE IN THE /AC AND OUTPUT IT. IT ALSO CONTAINS SEVERAL /OPTIONS OUTLINED BELOW. / /CALL: TAD (NUMBER TO BE OUTPUT) / PUTNUM / (OPTION AS BELOW:) / / BIT 0=1 TO SUPRESS LEADING ZEROES / BIT 1=1 TO CONVERT THE VALUE TO DECIMAL / BITS 9-11 CONTAIN THE NUMBER OF PLACES TO FILL / /EXAMPLE: / / TAD (23) / PUTNUM / S D 2 / /FOR SIMPLICITY WE HAVE DEFINED S=4000 AND D=2000 TO /SET THE CORRECT BITS FOR SUPRESSION AND DECIMAL MODE. / /IN THE EXAMPLE ABOVE THE VALUE 25 WOULD HAVE BEEN TYPED /ON THE USERS TERMINAL. / S=4000 /SUPRESS LEADING ZEROES D=2000 /CONVERT VALUE TO DECIMAL NUMBER, 0 DCA NUM0 TAD I NUMBER RAL CLA TAD (240) SNL TAD (20) DCA P1000 TAD P1000 DCA P100 TAD P100 DCA P10 TAD P10 DCA P1 TAD (P1) DCA NUMPTR TAD I NUMBER RAL SPA CLA JMP NUMDEC NUMOCT, TAD NUM0 AND K7 TAD K260 DCA I NUMPTR STA TAD NUMPTR DCA NUMPTR TAD NUM0 AND (7770) SNA JMP NUMOUT CLL RTR RAR DCA NUM0 JMP NUMOCT NUMOUT, TAD I NUMBER AND K7 DCA NUMARG TAD NUMARG CIA IAC TAD (P1) PUTCHR NUMARG, 0 ISZ NUMBER JMP I NUMBER /NOW COMES THE ROUTINE TO CONVERT TO DECIMAL NUMDEC, DCA THOU DCA HUN DCA TEN DCA ONE DECTST, TAD NUM0 SMA JMP ND1000-1 AND (3777) TAD (60) DCA NUM0 ISZ THOU ISZ THOU JMP DECTST CLA ND1000, TAD NUM0 TAD (-1750) SPA JMP ND100-1 DCA NUM0 ISZ THOU JMP ND1000 CLA ND100, TAD NUM0 TAD (-144) SPA JMP ND10-1 DCA NUM0 ISZ HUN JMP ND100 CLA ND10, TAD NUM0 TAD (-12) SPA JMP ND1-1 DCA NUM0 ISZ TEN JMP ND10 CLA ND1, TAD NUM0 DCA ONE TAD THOU SZA JMP NMD1 TAD HUN SZA JMP NMD2 TAD TEN SZA JMP NMD3 JMP NMD4 NMD1, TAD K260 DCA P1000 TAD HUN NMD2, TAD K260 DCA P100 TAD TEN NMD3, TAD K260 DCA P10 NMD4, TAD ONE TAD K260 DCA P1 JMP NUMOUT THOU, 0 HUN, 0 TEN, 0 ONE, 0 P1000, 0 P100, 0 P10, 0 P1, 0 NUM0, 0 NUMPTR, 0
PAGE / /UTILITY ROUTINE-----ASCIN / / /THIS IS A ROUTINE TO ACCEPT INPUT FROM THE KEYBOARD. /IT HANDLES <CR>, <LF>, <RO>, ^A, ^X, ^R. IT EXPECTS /THE BREAK MASK TO BE SET TO 0205 UPON THE ENTRANCE /TO THIS ROUTINE. / /IN ADDITION TO THE BREAK MASK THESE LOCATIONS MUST BE SET UP; / BUFFER LOCATION CONTAINING START OF BUFFER-1 / AX /MUST BE AN AUTO/INDEX REGISTER / KEYBRD, 0 TAD M100 DCA KSRBLK+1 TAD BUFF DCA KSRBLK+2 /WE NOW HAVE OURSELVES SET UP FOOR A KSR KSF /ANYTHING IN THE OLD BUFFER? JMP .-1 /NO--THIS WILL CAUSE MONITOR TO SIT AROUND TAD KSRBLK KSR /THERE IS SOMETHING!! GET IT! TAD I KSRBLK+2 /GET DELIMITER CHARACTER DCA CHRTMP /STORE FOR A WHILE TAD DLMSTK /START OF DELIMITER LIST DCA AX /STORE IN AN AUTO-INDEX REGISTER TAD I AX SNA /IS THE CHAR A 0? JMP I KEYBRD /YES--BLOW UP TAD CHRTMP /NO--GET OUR TYPED IN DELIMITER SZA CLA /DO THEY MATCH? JMP .-5 /NO--TRY UNTIL THEY DO TAD DLMSTK /YES--NOW WE MUST FIGURE WHERE TO GO CIA TAD AX /ADDR OF THE DELIMITER TAD PNTSTK /STACK OF POINTERS TO APPROPRIATE ROUTINES DCA CHRTMP /STORE IT TAD I CHRTMP /POINTER TO THE ROUTINE DCA CHRTMP /STORE IT AGAIN JMP I CHRTMP /GO TO THE CORRECT ROUTINE / /THIS IS A LIST OF THE LEGAL DELIMITERS / DLMSTK, . -215 /-<CR> -212 /-<LF> -377 /-<RO> -201 /-^A -230 /-^X -222 /-^R 0000 /END OF LIST / /LIST OF POINTERS TO THE VARIOUS ROUTINES, THEY /CORESSPOND TO THE DELIMITER LIST / PNTSTK, . CR /<CR> HANDLER CR /ALSO HANDLES <LF> DEL /<RO> HANDLER RO /^A HANDLER DEL /^X HANDLER CNTRLR /^R HANDLER CR, STA /7777 OUT CR OR LF DCA I KSRBLK+2 CRLF JMP I KEYBRD DEL, TAD (CANCEL) PUTCHR P 3 CRLF JMP I KEYBRD /THIS SHOULD BE CHANGED TO AN ERROR RETURN CANCEL, TEXT /XXX/ RO, STA TAD KSRBLK+2 DCA CHRTMP /BACK UP TO RUBBED CHAR TAD BUFF /CHECK TO IF RO OFF END OF STRING CIA TAD CHRTMP SNA CLA /IS IT?? JMP KEYBRD+5 /YES--IGNORE TAD I CHRTMP /NO--GET RUBBED CHAR TLS /PRINT IT CLA CLL CMA RAL /AC_7776 (-2) TAD KSRBLK+2 DCA KSRBLK+2 /BACK UP POINTER PAST <RO> AND CHAR JMP KEYBRD+5 /GO GET SOME MORE CNTRLR, TAD BUFF DCA CHRPNT ISZ CHRPNT TAD I CHRPNT /GET THE CHAR SNA /IS IT 0? JMP .+3 /YES--END O LINE TLS /NO--TYPE IT JMP CNTRLR+2 /LOOP ON THROUGH STA /BACK UP POINTER PAST ^R TAD KSRBLK+2 DCA KSRBLK+2 JMP KEYBRD+5 M100, -100 CHRPNT, 0 CHRTMP, 0 KSRBLK, .+1 0 0 $$$



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