/BIT MAPPED GRAPHICS PLOTTING SYSTEM XLIST OFF IFNDEF OFF IFNDEF ON XLIST ON / LAST EDIT: 2/14/89 15:09:00 TR / THIS SYSTEM PLOTS PAIRS ONTO AN HDS3200 GRAPHICS TERMINAL / IT CAN TAKE INPUT FRROM A FILE BY DEFAULT OR INPU FROM THE CONSOLE WHEN /T IS USED / IT ALSO DOES SCALING WHEN THOSE PARAMETERS ARE INDICATED IN THE FILE SPECIFICATION /THE SPECIFICATION FILE CONSISTS OF THE FOLLOWING: / #VARIBLES, #POINTS / # OF THE X VARIABLE, # OF THE Y VARIABLE / MINIMUM X VALUE, MAXIMUM X VALUE / MINIMUM Y VALUE, MAXIMUM Y VALUE / MINIMUM X DISPLAY, MAXIMUM X DISPLAY / MINIMUM Y DISPLAY, MAXIMUM Y DISPLAY /THIS FILE IS FOLLOWED BY THE DATA CONSISTING OF COLUMNS OF NUMBERS /SYSTEM PARAMETER DEFINITIONS CODFLD= 0^10 /FIELD WHERE CODE IS MESFLD= 0^10 /MESSAGE FIELD BUFF= 6600 /BUFFER FOR FILE XFLD= 2^10 /X COORDINATE DATA FIELD. YFLD= 3^10 /Y COORDINATE DATA FIELD. ABSPNT= 400 /NUMBER OF ABSSISSANT POINTS. ORDPNT= 3000 /NUMBER OF ORDINATE POINTS. ORDWRD= ORDPNT-1%14+1 /NUMBER OF Y AXIS WORDS. ABSOFFS=ABSPNT%2 /X AXIS OFFSET ORDOFFS=ORDPNT%2 /Y AXIS OFFSET ORDSCL= 1000 /SCALE FOR ORDINATE ABSSCL= 400 /SCALE FOR ABSCISSANT ORDSCO= ORDSCL%2 /SCALE OFFSET ABSSCO= ABSSCL%2 /ABSCISANT SCALE OFFSET RADIUS= 20 /RADIUS OF CIRCULAR DISK POINT SEPAR= 54 /SEPARATOR FOR PAIRS EAE= 1 /USE REAL EAE /P?S MONITOR DEFINITIONS SBOOT= 7600 /SYSTEM BOOTSTRAP LOCATION SCRSIZE=7611 /SOFTWARE CORE SIZE WORD SDATE= 7610 /CURRENT DATE WORD SFILES= 7757 /LOCATION FOR FILES SOUTFLS=7607 /OUTPUT FILE COUNT SPARM= 7756 /EQUALS PARAMETER SWAL= 7604 /SWITCHES /A-/L SWMX= 7605 /SWITCHES /M-/X SWY9= 7606 /SWITCHES /Y-/9 SYSIO= 7640 /I/O ROUTINES /PROCESSOR DEFINITIONS: NL0000= CLA /LOAD AC WITH 0000 NL0001= CLA IAC /LOAD AC WITH 0001 NL0002= CLA CLL CML RTL /LOAD AC WITH 0002 NL0003= CLA STL IAC RAL /LOAD AC WITH 0003 NL0004= CLA CLL IAC RTL /LOAD AC WITH 0004 NL0006= CLA STL IAC RTL /LOAD AC WITH 0006 NL0100= CLA IAC BSW /LOAD AC WITH 0100 NL2000= CLA CLL CML RTR /LOAD AC WITH 2000 NL3777= CLA CLL CMA RAR /LOAD AC WITH 3777 NL4000= CLA CLL CML RAR /LOAD AC WITH 4000 NL5777= CLA CLL CMA RTR /LOAD AC WITH 5777 NL6000= CLA STL IAC RTR /LOAD AC WITH 6000 NL7775= CLA CLL CMA RTL /LOAD AC WITH 7775 NL7776= CLA CLL CMA RAL /LOAD AC WITH 7776 NL7777= CLA CMA /LOAD AC WITH 7777 / PROCESSOR DEPENDENT DEFINITIONS TTY= 0003 /GENERIC TELETYPE KEYBOARD CODE LINE= 0046 /USE DEVICE 46/47 I/O TO TERMINAL KEYCODE=TTY^10+6000 /SKELETON KEYBOARD CODE PRTCODE=TTY+1^10+6000 /SKELETON TELEPRINTER CODE HDSINCOD=LINE^10+6000 /HDS INPUT CODE HDSDSCOD=LINE+1^10+6000 /HDS OUTPUT CODE KCCIOT= KEYCODE+2 /CLEAR KEYBOARD FLAG, AC, SET READER RUN KRBIOT= KEYCODE+6 /CLEAR KEYBOARD FLAG, LOAD CHARACTERS INTO AC, /SET READER RUN KRSIOT= KEYCODE+4 /OR CHARACTER INTO AC, DON'T CLEAR KEYBOARD FLAG KSFIOT= KEYCODE+1 /SKIP ON KEYBOARD FLAG TLSIOT= PRTCODE+6 /LOAD OUTPUT BUFFER, CLEAR FLAG TSFIOT= PRTCODE+1 /SKIP ON OUTPUT FLAG RKIEIOT=HDSINCOD+5 /LOAD INTERRUPT ENABLE PER AC[11] RKRBIOT=HDSINCOD+6 /READ REMOTE,CLEAR FLAG RKSFIOT=HDSINCOD+1 /SKIP ON REMOTE INPUT FLAG RTLSIOT=HDSDSCOD+6 /TRANSMIT CHAR,CLEAR FLAG RTSFIOT=HDSDSCOD+1 /SKIP ON TRANSMIT FLAG / CHARACTER DEFINITIONS ESC= 0033 / CHARACTER FS= "\&37 / CHARACTER GS= 0035 / CHARACTER (THIS IS ^]) US= 0037 / CHARACTER PAGE 0 /START AT THE BEGINNING ZBLOCK 10-. /GET TO AUTO-INCREMENT LOCATION XR1, .-. /1ST AUTO INDEX REG XR2, .-. /2ND AUTO INDEX REG XR3, .-. /AUTO INDEX REG 3 XR4, .-. /AUTO INDEX REG 4 ZBLOCK 20-. X, .-. /HOLDS X ADDRESS OF TERMINAL Y, .-. /HOLDS Y ADDRESS OF TERMINAL FILEPNT,.-. /FILE POINTER MTMP1, .-. /FILE POINTER TEMPORARY GETPTR, .-. /MOVING POINNTER IN CHARBUFF INCHAR, .-. /HOLDS INPUT CHARACTER PAGE READPNT,CAF /CLEAN UP TLS /SET PRINTER FLAG SWAB /GET MODE B EAE TAD I (SWMX) /GET THE SWITCHES AND (20) /LOOK FOR T SWITCH DCA I (TSWITCH) /STORE IN TSWITCH TAD I (TSWITCH) /GET IT BACK SZA CLA /IF ZERO THEN SKIP JMP CONSLIN /GET INPUT FROM CONSOLE TAD (SFILES-1) /GET LOCATION OF FILES TAD I (SOUTFLS) /ADD OUTPUT FILES DCA FILEPNT /STORE IT TAD FILEPNT /GET BACK FILE POINTER DCA MTMP1 /STORE TEMPORARILY ISZ MTMP1 /BUMP UP FILE POINTER TAD I MTMP1 /GET THE FILE SNA CLA /IF REAL FILE THEN SKIP JMP I (SBOOT) /ELSE BOOT CONSLIN,JMS I (PARGET) /READ THE PARAMETERS TAD I (PARNUM) /GET THE NUMBER OF POINTS CIA /NEGATE DCA TEMCNT /STORE AS POINT COUNTER JMS I (INITERM) /INITIALIZE TERMINAL JMS I (SCLINI) /SETUP SCALE PARAMETERS DATLUP, JMS I (GETDAT) /READ X AND Y DATA VALUE /THE ABSCISSA IS IN IN , THE ORDINATE IS IN JMS I (SCLDAT) /SCALE THE NUMBERS JMS I (SETARC) /SETUP CIRCLE JMS I [STROUT];ARCBUF;0 /OUTPUT IT ISZ TEMCNT /IF FINISHED ALL POINTS THEN SKIP JMP DATLUP /ELSE GO GET MORE DATA JMS I (AXISDR) /DRAW AXES JMP I (SBOOT) /BOOTSTRAP TEMCNT, .-. /NUMBER OF POINTS COUNTER PAGE /SUBROUTINE TO GET THE PARAMETERS FOR PLOTTING PARGET, .-. /SUBROUTINE HEADER TAD (-14) /GET 12 PARAMETERS DCA PARCNT /STORE AS COUNTER TAD (PARVAR-1) /GET THE FIRST POINTER TO PARS DCA XR1 /STORE AS AUTO INDEX REGISTER PARRED, JMS I (REANUM) /READ THE NUMBER DCA I XR1 /STORE IT ISZ PARCNT /IF DONE ALL POINTS THEN SKIP JMP PARRED /ELSE GO READ MORE PARAMETERS JMP I PARGET /RETURN PARCNT, .-. /PARAMETER COUNT PARVAR, .-. /NUMBER OF VARAIABLES PARNUM, .-. /THE NUMBER OF POINTS PARX, .-. /THE X PARAMETER NUMBER PARY, .-. /THE Y PARAMETER NUMBER XMIN, .-. /MINIMUM X VALUE XMAX, .-. /MAXIMUM X VALUE YMIN, .-. /MINIMUM Y VALUE YMAX, .-. /MAXIMUM Y VALUE DXMIN, .-. /MINIMUM X DISPLAY DXMAX, .-. /MAXIMUM X DISPLAY DYMIN, .-. /MINIMUM Y VALUE DYMAX, .-. /MAXIMUM Y VALUE PAGE /SUBROUTINE TO GET THE DATA AND STORE THEM IN AND GETDAT, .-. /SUBROUTINE HEADER CLA /CLEAN UP TAD I (PARVAR) /GET THE NUMBER OF VARIABLES CIA /NEGATE DCA GETCNT /STORE AS COUNT TAD (DATLOC-1) /GET POINTER TO STORE LINE OF DATA DCA XR1 /STORE IN AUTO INDEX REGISTER GETRED, JMS I (REANUM) /READ A NUMBER DCA I XR1 /STORE IT ISZ GETCNT /SKIP IF ALL ARE DONE JMP GETRED /ELSE DO MORE TAD (DATLOC-2) /GET LOC OF DATA-1 TAD I (PARY) /POINT TO Y VARIABLE DCA XR1 /STORE INTO AUTO INDEX REGISTER TAD I XR1 /GET THE VARIABLE DCA Y /PUT INTO TAD (DATLOC-2) /GET LOCATION OF DATA-1 TAD I (PARX) /POINT TO X VARIABLE DCA XR1 /STORE INTO AUTO INDEX REGISTER TAD I XR1 /GET X VARIABLE DCA X /STORE INTO X JMP I GETDAT /RETURN TO CALLER GETCNT, .-. /COUNTER DATLOC, ZBLOCK 40 /UP TO 40 VARIBLES PAGE /ROUTINE FOR SCALING THE DATA INTO SCREEN MEMORY SCLDAT, .-. /SCALING ROUTINE NL7776 /SETUP THE SIGN DCA SCLSGN /FOR NEGATIVE TESTING TAD SCLMLX /GET MULTIPLIER VALUE MQL /PUT INTO MQ TAD X /GET X JMS I (SGNMUL) /DO A SIGNED MULTIPLY DAD; SCLOFX /ADD OFFSET SMA /IF NEGATIVE THEN SKIP JMP .+3 /ELSE JUMP AHEAD DCM /NEGATE ISZ SCLSGN /INDICATE NEGATIVE DVI; SCLDVX /DIVIDE BY RANGE SWP /GET ONLY 12 BITS ISZ SCLSGN /SKIP IF NEG DIVIDEND SKP /ELSE SKIP CIA /NEGATE DCA X /STORE BACK IN X NL7776 /SETUP THE SIGN DCA SCLSGN /FOR NEGATIVE TESTING TAD SCLMLY /GET MULTIPLIER VALUE MQL /PUT INTO MQ TAD Y /GET X JMS I (SGNMUL) /DO A SIGNED MULTIPLY DAD; SCLOFY /ADD OFFSET SMA /IF NEGATIVE THEN SKIP JMP .+3 /ELSE JUMP AHEAD DCM /NEGATE ISZ SCLSGN /INDICATE NEGATIVE DVI; SCLDVY /DIVIDE BY RANGE SWP /GET ONLY 12 BITS ISZ SCLSGN /SKIP IF NEG DIVIDEND SKP /ELSE SKIP CIA /NEGATE DCA Y /STORE BACK IN Y JMP I SCLDAT /RETURN TO CALLER SCLMLX, .-. /SCALE SLOPE FOR X SCLDVX, .-. /RANGE PARAMETER X SCLOFX, ZBLOCK 2 /SCALE OFFSET FOR X SCLMLY, .-. /SCALE SLOPE FOR Y SCLDVY, .-. /RANGE PARAMETER Y SCLOFY, ZBLOCK 2 /SCALE OFFSET FOR Y SCLSGN, .-. /SIGN FLAG /ROUTINE FOR DRAWING AXES ONTO SCREEN AXISDR, .-. /DRAW AXIS ROUTINE JMS I [STROUT];VECMODE;0 /POSITION POINTER CLA /CLEAN UP TAD I (DXMAX) /GET MAXIMUM X DISPLAY DCA X /STORE INTO X VALUE TAD I (DYMIN) /GET MINIMUM Y DISPLAY DCA Y /STORE IN Y VALUE JMS I (SETADR) /TURN INTO ADDRESS COMPONENTS JMS I [STROUT] /OUTPUT ADRBUFF;0 /THE VALUES TAD I (DXMIN) /GET MINIMUM X DISPLAY DCA X /PUT INTO X JMS I (SETADR) /TURN INTO ADDRESS COMPONENTS JMS I [STROUT] /OUTPUT NEW POINT FOR VECTOR ADRBUFF;0 /MODE TAD I (DYMAX) /GET MAXIMUM Y DISPLAY DCA Y /STORE IN Y VALUE JMS I (SETADR) /TURN INTO ADDRESS COMPONENTS JMS I [STROUT] /OUTPUT NEW ADRBUFF;0 /VECTOR JMP I AXISDR /RETURN TO CALLER /SUBROUTINE TO PERFORM SIGNED MULTIPLICATION SGNMUL, .-. /SUBROUTINE HEADER DCA MULARG /STORE IT NL7776 /GETA -2 DCA GRPSGN /STORE AS SIGN TAD MULARG /GET IT BACK SMA /IF NEGATIVE THEN SKIP JMP .+3 /ELSE JUMP AHEAD CIA /MAKE NEGATIVE ISZ GRPSGN /INDICATE BY SIGN DCA MULARG /STORE AS ARGUMENT MUY;MULARG /MULTIPLY ISZ GRPSGN /IF SIGN IS SET THEN SKIP JMP I SGNMUL /ELSE RETURN DCM /AND NEGATE JMP I SGNMUL /RETURN TO CALLER GRPSGN, .-. /HOLDS SIGN MULARG, .-. /MULTIPLY ARGUMENT PAGE SETADR, .-. /ADDRESS SETUP ROUTINE SETZAP, JMP SETVEC /**** NOT /1 **** NOP TAD Y /GET Y ADDRESS RTL;RTL;RTL /%200 AND [37] /JUST HIGH FIVE BITS TAD [40] /MAKE IT ASCII DCA ADRBUFFER+0 /STORE AS HI-Y TAD Y /GET Y AGAIN AND [3] /JUST LOW TWO BITS CLL RTL /MOVE UP DCA ADRBUFFER+1 /SAVE FOR NOW TAD Y /GET Y AGAIN RTR /%4 AND [37] /JUST MIDDLE FIVE BITS TAD [140] /MAKE IT ASCII DCA ADRBUFFER+2 /STORE AS LO-Y TAD X /GET X ADDRESS RTL;RTL;RTL /%200 AND [37] /JUST HIGH FIVE BITS TAD [40] /MAKE IT ASCII DCA ADRBUFFER+3 /STORE AS HI-X TAD X /GET X AGAIN RTR /%4 AND [37] /JUST MIDDLE FIVE BITS TAD [100] /MAKE IT ASCII DCA ADRBUFFER+4 /STORE AS LO-X TAD X /GET X AGAIN AND [3] /JUST LOW TWO BITS TAD ADRBUFFER+1 /ADD ON LOW Y BITS (SHIFTED) TAD [140] /MAKE IT ASCII WITH MARGIN 1 DCA ADRBUFFER+1 /STORE COMPOSITE EXTRA BYTE JMP I SETADR /RETURN / COMES HERE IF IN VECTOR ADDRESS MODE. SETVEC, TAD Y /GET UNSIGNED Y VALUE RTR;RTR;RAR /%40 AND [177] /JUST HIGH SEVEN BITS TAD [40] /MAKE IT ASCII DCA ADRBUFFER+0 /STORE AS HI-Y TAD Y /GET Y AGAIN AND [37] /JUST FIVE LOW BITS TAD [140] /MAKE IT ASCII DCA ADRBUFFER+1 /STORE AS LO-Y TAD X /GET X VALUE RTR;RTR;RAR /%40 AND [177] /JUST HIGH SEVEN BITS TAD [40] /MAKE IT ASCII DCA ADRBUFFER+2 /STORE AS HI-X TAD X /GET X AGAIN RTR /%4 AND [37] /JUST FIVE MIDDLE BITS TAD [100] /MAKE IT ASCII DCA ADRBUFFER+3 /STORE AS LO-X DCA ADRBUFFER+4 /ZERO FIFTH WORD JMP I SETADR /RETURN ADRBUFF,ZBLOCK 6 /ADDRESS TRANSMISSION BUFFER PAGE / SUBROUTINE TO DRAW ARCS IN VECTOR MODE SETARC, .-. /SUBROUTINE HEADER CLA /CLEAN UP TAD (PLTCRX) /GET THE X-PARAMETER ADDRESS DCA PPLTCR /STORE AS POINTER TAD X /GET THE X VALUE JMS STRCOR /GO STORE THE CHARACTERS TAD (PLTCRY) /GET THE Y-PARAMETER ADDRESS DCA I (PPLTCR) /STORE IT AS POINTER TAD Y /GET THE Y VALUE JMS STRCOR /GO STORE THE CHARACTERS JMP I SETARC / THIS SUBROUTINE STORES THE DIGITS IN A LIST FOR A NUMBER STRCOR, .-. /SUBROUTINE HEADER MQL DVI;S1000 /DIVIDE BY A THOUSAND SWP /GET HIGH ORDER DIGIT TAD (60) /TURN INTO ASCII DCA I PPLTCR /STORE IT ISZ PPLTCR /BUMP TO NEXT CHARATER POSITION DVI; S100 /GET NEXT DIGIT SWP /GET DIGIT TAD (60) /TURN INTO ASCII DCA I PPLTCR /STORE IT ISZ PPLTCR /BUMP UP TO NEXT CHARACTER POS DVI; S10 /DIVIDE BY 10 SWP /GET QUOTIENT TAD (60) /TURN INTO ASCII DCA I PPLTCR /STORE IT ISZ PPLTCR /BUMP UP POINTER SWP /GET LOWEST DIGIT TAD (60) /TURN INTO ASCII DCA I PPLTCR /STORE IT JMP I STRCOR /RETURN TO CALLER PPLTCR, .-. /POINTER TO NUMBER LIST S1000, 1750 /DECIMAL 1000 S100, 144 /DECIMAL 100 S10, 12 /DECIMAL 10 ARCBUF, ESC;"/&177 PLTCRX, ZBLOCK 4;";&177 /HOLDS X VALUE FOR VECTOR MODE PLTCRY, ZBLOCK 4;";&177 /HOLDS Y VALUE FOR VECTOR MODE R, "2&177;"0&177;";&177 /RADIUS OF DISK T, ";&177 / P, ";&177 / ARCFIL, 0061;"B&177;0 /FILL UP CIRCLE AND END SEQUENCE PAGE / STRING OUTPUT ROUTINE. STROUT, .-. /STRING OUTPUT ROUTINE CLA /CLEAN UP STRLUP, TAD I STROUT /GET AN ARGUMENT SNA /SKIP IF END OF ARGUMENTS JMP I STROUT /RETURN IF NO MORE STRINGS DCA STRPTR /STASH THE LATEST POINTER ISZ STROUT /BUMP TO NEXT ARGUMENT FOR NEXT TIME STRLOOP,TAD I STRPTR /GET A CHARACTER SNA /END OF A STRING? JMP STRLUP /YES, GO GET ANOTHER STRING JMS TERMOUT /NO, SEND THIS CHARACTER ISZ STRPTR /BUMP TO NEXT JMP STRLOOP /GO DO ANOTHER CHARACTER STRPTR, .-. /STRING POINTER TERMOUT,.-. /TERMINAL OUTPUT ROUTINE DCA TERMTMP /SAVE PASSED VALUE TERMLUP,JMS INTEST /TEST FOR DC1/DC3 TAD TERMTMP /GET THE CHARACTER RTSFIOT /FLAG UP? JMP TERMLUP /NO, WAIT FOR IT RTLSIOT /YES, OUTPUT IT JMS INTEST /TEST FOR DC1/DC3 JMP I TERMOUT /RETURN TERMTM, .-. /TEMPORARY INTEST, .-. /TEST FOR DC1/DC3 INPUT JMS INTERM /TEST FOR A CHARACTER JMP I INTEST /WASN'T ANY TAD (-"S!300) /COMPARE TO <^S> SZA CLA /SKIP IF IT MATCHES JMP I INTEST /RETURN IF NOT INWAIT, JMS INCHAR /TEST FOR A CHARACTER JMP INWAIT /MUST WAIT FOR IT TAD (-"Q!300) /COMPARE TO <^Q> SZA CLA /SKIP IF IT MATCHES JMP INWAIT /GO BACK AND WAIT FOR IT JMP I INTEST /RETURN INTERM, .-. /GET AN INPUT CHARACTER CLA /CLEAN UP RKSFIOT /FLAG UP? JMP I INTERM /NO, JUST RETURN RKRBIOT /YES, READ IT IN AND [177] /JUST SEVEN-BIT ISZ INTERM /BUMP RETURN ADDRESS JMP I INTERM /TAKE SKIP RETURN PAGE / ROUTINE TO SETUP SCALE AND OFFSET PARAMETERS SCLINI, .-. /SUBROUTINE HEADER CLA /CLEAN UP TAD I (DXMIN) /GET MINIMUM DISPLAY X CIA /SUBTRACT FROM TAD I (DXMAX) /MAXIMUM DISPLAY VALUE DCA I (SCLMLX) /STORE MULTIPLIER TAD I (XMIN) /GET THE MINIMUM X CIA /SUBTRACT FROM TAD I (XMAX) /MAXIMUM X DCA I (SCLDVX) /STORE IN DIVIDE TAD I (DYMIN) /GET MINIMUM DISPLAY Y CIA /SUBTRACT FROM TAD I (DYMAX) /MAXIMUM DISPLAY VALUE DCA I (SCLMLY) /STORE MULTIPLIER TAD I (YMIN) /GET THE MINIMUM Y CIA /SUBTRACT FROM TAD I (YMAX) /MAXIMUM Y DCA I (SCLDVY) /STORE IN DIVIDE TAD I (DXMAX) /GET DISP MAX DCA SCTMP1 /STORE TEMPORARY TAD I (XMIN) /GET X MINIMUM DCA SCTMP2 /STORE TEMPORARY JMS SCLPROD /GET SIGNED PRODUCT DCM /NEGATE DST; SCINTM /STORE IT CLA /CLEAN UP TAD I (DXMIN) /GET X MIN DCA SCTMP1 /STORE TEMP TAD I (XMAX) /GET X MAX DCA SCTMP2 /STORE TEMP JMS SCLPROD /GET PRODUCT DAD; SCINTM /ADD BACK DOUBLE PRECISION NUMBER DST; SCLOFX /STORE OFFSET CLA /CLEAN UP TAD I (DYMAX) /GET DISP MAX DCA SCTMP1 /STORE TEMPORARY TAD I (YMIN) /GET X MINIMUM DCA SCTMP2 /STORE TEMPORARY JMS SCLPROD /GET SIGNED PRODUCT DCM /NEGATE DST; SCINTM /STORE IT CLA /CLEAN UP TAD I (DYMIN) /GET X MIN DCA SCTMP1 /STORE TEMP TAD I (YMAX) /GET X MAX DCA SCTMP2 /STORE TEMP JMS SCLPROD /GET PRODUCT DAD; SCINTM /ADD BACK DOUBLE PRECISION NUMBER DST; SCLOFY /STORE OFFSET CAM /CLEAN UP JMP I SCLINI /RETURN TO CALLER SCINTM, ZBLOCK 2 /DOUBLE PRECISION TEMP / ROUTINE TO DO SIGNED MULTIPLICATION SCLPROD,.-. /SUBROUTINE HEADER NL7776 /SETUP SIGN FLAG DCA SCISGN /FOR NEGATIVE NOS TAD SCTMP1 /GET FIRST ARG SMA /IF NEG THEN SKIP JMP .+3 /ELSE JUMP AHEAD CIA /NEGATE ISZ SCISGN /INDICATE NEGATIVE MQL /STORE INTO MQ TAD SCTMP2 /GET SECOND ARG JMS I (SGNMUL) /MULTIPLY ISZ SCISGN /SKIP IF ARG WAS NEG SKP /ELSE SKIP AROUND DCM /NEGATE JMP I SCLPROD /RETURN TO CALLER SCISGN, .-. /SIGN FLAG SCTMP1, .-. /FIRST ARGUMENT SCTMP2, .-. /SECOND ARGUMENT PAGE / TERMINAL INITIALIZATION ROUTINE. INITERM,.-. /INITIALIZE THE TERMINAL CLA /CLEAN UP RKIEIOT /PREVENT TERMINAL INTERRUPTS RTLSIOT /SET OUTPUT FLAG CDF CODFLD /ENSURE MAIN FIELD TAD I (SWMX) /GET /M-/X SWITCHES RAR /X TO LINK SZL CLA /SKIP IF NOT SET DCA XZAP /ELSE ZAP THE LIST OUT TAD I (SWY9) /GET /Y-/9 SWITCHES AND (400) /JUST /1 SWITCH / SZA CLA /SKIP IF OFF JMP LEAVIT /JUMP IF ON TAD (NOP) /GET A NOP DCA I (SETZAP) /ZAP IT IN LEAVIT, JMS I [STROUT] /SEND STRINGS TO TERMINAL XZAP, BLAMEM /BLANK THE ALPHA SCREEN **** /X **** 0000 UNGMEM /UNBLANK THE GRAPHICS SCREEN DSGMEM /DISPLAY THE GRAPHICS MEMORY NDSPACE /NON-DESTRUCTIVE SPACE IN GRAPHICS ALPHA MODE EGACLR /ENTER GRAPHICS ALPHA MODE, CLEAR SCREEN PPM /ENTER POINT PLOT MODE VECMODE /VECTOR MODE 0 /THIS ENDS THE LIST JMP I INITERMINAL /RETURN PAGE STRBUFF,ZBLOCK 201 /STRING BUFFER / TERMINAL SEQUENCES. / GOTO ALPHA MODE WITHOUT CHANGING POSITION (FROM VECTOR MODE). ANOMOVE,US; 0 /JUST GOTO ALPHA MODE / BLANK ALPHA MEMORY. BLAMEM, ESC; "[&177; "1&177; "/&177 /BLANK ALPHA MEMORY "V&177+40; 0 / CLEAR GRAPHICS MEMORY. CLRMEM, ESC; "Y&37; 0 /CLEAR GRAPHICS MEMORY / DISPLAY GRAPHICS MEMORY. DSGMEM, ESC; "T&37; 0 /DISPLAY GRAPHICS MEMORY / ENTER GRAPHICS ALPHA MODE, CLEAR GRAPHICS MEMORY. EGACLR, ESC; "L&37; 0 /GRAPHICS ALPHA WITH CLEAR / NON-DESTRUCTIVE CHARACTER IN GRAPHICS ALPHA MODE. NDSPACE,ESC; "/&177; "2&177; "L&177+40 /SPACE JUST MOVES / ENTER POINT PLOT MODE. PPM, FS; 0 /ENTER POINT PLOT MODE / UNBLANK GRAPHICS MEMORY. UNGMEM, ESC; "[&177; "2&177; "/&177 /UNBLANK GRAPHICS MEMORY "V&177+40; 0 / GOTO VECTOR MODE (FROM POINT PLOT MODE). VECMODE,GS; 0 /GOTO VECTOR MODE / CHARACTER SIZE TABLE. SIZTABL,";&177 /SMALLEST ":&177 /VERY SMALL "9&177 /SMALL "8&177 /STANDARD "1&177 /DOUBLE "2&177 /TRIPLE "3&177 /QUADRUPLE "8&177 /STANDARD (ALTERNATE) PAGE PAGE /THIS SUBROUTINE READS A DECIMAL NUMBER FROM THE KEYBOARD AND /RETURNS IT IN THE AC AFTER A CARRIAGE RETURN HAS BEEN HIT REANUM, .-. /SUBROUTINE HEADER CLA /CLEAN UP DCA REAFLG /CLEAN UP SIGN FLAG DCA REAWRD /REAWRD TO BEGIN WITH JMS I (GETBUFF) /GET A BUFFER TAD (CHRBUFF) /POINT TO BEGINNING OF BUFFER DCA GETPTR /STORE IN POINTER JMS I (GETDIGIT) /GET A DIGIT JMP REMINUS /PROCESS MINUS SIGN JMP RENXDI+2 /ELSE PROCESS DIGIT RENXDI, JMS I (GETDIG) /GET A DIGIT FROM BUFFER JMP REERCK /CHECK FOR DELIM OR ERROR AND (17) /ELSE MASK OFF DIGIT DCA REATMP /STORE TEMPORARILY TAD REAWRD /GET THE WORD TO BE RETURNED MQL MUY;R10 /MULTIPLY BY 10 SWP /GET RESULT INTO AC TAD REATMP /ADD BACK WHATS IN THE TEMPORARY DCA REAWRD /PUT BACK IN THE WORD TO BE RET JMP RENXDI /GO BACK FOR MORE CHARACTERS REARET, TAD REAWRD /PUT RETURN WORD INTO AC ISZ REAFLG /SKIP IF FLAG INDICATES POS NUMBER SKP /ELSE SKIP OVER CIA /NEGATE JMP I REANUM /RETURN TO CALLER REAWRD, .-. /HOLDS THE WORD TO BE RETURNED REATMP, .-. /A LOCAL TEMPORARY REAFLG, .-. /SIGN FLAG R10, 12 /MULTIPLICATION CONSTANT /COMES HERE ON DELIMITER OR ERROR REERCK, SNA CLA /IF NON ZERO THEN SKIP JMP REARET /ELSE RETURN NUMBER JMS I (SCRIBE);MSERROR/PRINT ERROR MESSAGE HLT /HALT ON ERROR / COMES HERE TO PROCESS NEGATIVE NUMBERS REMINUS,TAD (-"-!200) /SUBTRACT THE <-> CHAR SZA /IF ZERO THEN SKIP JMP REERCK /ELSE PROCESS AS ERROR NL7777 /INDICATE NEGATIVE BY DCA REAFLG /SETTING FLAG JMP RENXDI /GO PROCESS MORE DIGITS /THIS SUBROUTINE PRINTS SIGNED OR UNSIGNED NUMBERS ON CONSOLE /CALLING IT WITH A ZERO IS A SIGNED NUMBER PRNNUM, .-. /SUBROUTINE HEADER SNA CLA /IF NONZERO THEN SKIP AND DO SIGNED PRINTING JMP PRNPOS-1 /ELSE JMP AND PRINT UNSIGNED TAD PRNTMP /GET THE NUMBER SMA /SKIP IF NUMBER IS NEGATIVE JMP PRNPOS /JUMP IF POSITIVE CIA /ELSE NEGATE DCA PRNTMP /STORE IT TAD ("-) /GET MINUS SIGN JMS I (P7CH) /PRINT THE CHARACTER TAD PRNTMP /GET THE NUMBER PRNPOS, MQL DVI ;P1000 /DIVIDE BY 1000 DCA PRNTMP /STORE BACK REMAINDER MQA /GET QUOTIENT TAD (60) /TURN INTO CHARACTER JMS I (P7CH) /GO PRINT IT TAD PRNTMP /GET NUMBER BACK MQL DVI ;P100 /DIVIDE BY 100 DCA PRNTMP /STORE REMAINDER MQA /GET THE QUOTIENT TAD (60) /TURN INTO CHARACTER JMS I (P7CH) /PRINT THE CHARACTER TAD PRNTMP /GET THE NUMBER BACK MQL DVI ;P10 /DIVIDE BY 10 DCA PRNTMP /STORE REMAINDER MQA /GET THE QUOTIENT TAD (60) /TURN INTO CHARACTER JMS I (P7CH) /PRINT THE CHARACTER TAD PRNTMP /GET THE FINAL REMAINDER TAD (60) /TURN INTO CHARACTER JMS I (P7CH) /PRINT IT JMP I PRNNUM /RETURN TO CALLER PRNTMP, .-. /HOLDS NUMBER P1000, 1750 /DECIMAL 1000 P100, 144 /DECIMAL 100 P10, 12 /DECIMAL 10 PAGE / GET INPUT BUFFER ROUTINE. GETBUFF,.-. /GET INPUT BUFFER GRESTAR,TAD (CHRBUFF) /RESET THE DCA GETPTR /OUTPUT POINTER GETINP, JMS I (INPUT) /**** **** JMS I (INPUT) GOTINPU,JMS I (GESSUB) /TRY TO FIND CHTBL-1 /SPECIAL CHARACTERS TAD [-40] /COMPARE LATEST TO CONTROL CHARACTER SPA CLA /SKIP IF GREATER JMP GCMBEEP /IGNORE BAD CONTROL CHARACTERS TAD INCHAR /GET THE CHARACTER TAD [-140] /COMPARE TO LOWER-CASE LIMIT GCMZAP, SPA /**** /U **** NOP!400 TAD [40] /RESTORE CASE TAD [100] /RESTORE THE CHARACTER SKP /DON'T DO STUFF! GOTHT, TAD [" &177] / BECOMES DCA GBTEMP /SAVE IT TAD GETPTR /GET OUTPUT POINTER TAD (-CHRBEND) /COMPARE TO BUFFER LIMIT SMA CLA /SKIP IF NOT AT END YET JMP GCMBEEP /JUMP IF IT IS TAD GBTEMP /GET THE CHARACTER DCA I GETPTR /STORE IN THE BUFFER ISZ GETPTR /BUMP THE POINTER TAD GBTEMP /GET THE CHARACTER JMS I [P7CH] /PRINT IT JMP GETINPUT /KEEP GOING / COMES HERE ON BAD INPUT OR FULL BUFFER. GCMBEEP,TAD [7] /GET A JMS I [P7CH] /RING IT JMP GETINPUT /KEEP GOING / COMES HERE ON ANY CHARACTER GOTESC, TAD ("$&177) /GET A "$" JMS I [P7CH] /PRINT IT DCA I GETPTR /DELIMIT THE BUFFER NL4000 /INDICATE SEEN CRENTRY,DCA I (ESCAPSW) /STORE THE SWITCH JMP I GETBUFFER /RETURN / COMES HERE ON <^U>. DELETL, TAD ["^&177] /GET AN "^" JMS I [P7CH] /PRINT IT TAD ("U&177) /GET A "U" JMS I [P7CH] /PRINT IT JMS I [CRLF] /DO A , JMP GRESTART /RESTART / COMES HERE ON . GOTCR, DCA I GETPTR /DELIMIT THE BUFFER JMS I [CRLF] /DO A , JMP CRENTRY /CONTINUE THERE / COMES HERE ON . LFVIEW, JMS I [CRLF] /DO A , TAD (CHRBUF) /RESET THE DCA GBTEMP /BUFFER POINTER TAD GMSFLG /FLAG WHETHER TO REPEAT MESSAGE SNA /IF NON ZERO THEN REPEAT JMP PRBLUP /ELSE JUMP AHEAD NL7777 /INDICATE THAT MESSAGE SHOULD BE REPEATED ON LF JMS I (SCRIBE);GMSPTR,.-. /REPRINT THE MESSAGE PRBLUP, TAD GBTEMP /GET THE POINTER VALUE CIA /INVERT FOR TEST TAD GETPTR /COMPARE TO MAIN POINTER SNA CLA /SKIP IF NOT THERE YET JMP GETINPUT /JUMP IF DONE PRINTING THE BUFFER TAD I GBTEMP /GET THE CURRENT CHARACTER JMS I [P7CH] /PRINT IT ISZ GBTEMP /BUMP TO NEXT JMP PRBLUP /KEEP GOING GMSFLG, .-. /MESSAGE FLAG / COMES HERE ON ANY BACKSPACING CHARACTER. BACKSP, NL7777 /-1 TAD GETPTR /BACKUP THE POINTER DCA GBTEMP /SAVE FOR NOW TAD GBTEMP /GET IT BACK TAD (-CHRBUFF) /COMPARE TO LOWER LIMIT SPA CLA /SKIP IF OK JMP GCMBEEP /COMPLAIN IF TOO FAR BACK BZAP, JMP HARDRUBOUT /**** NOT /B **** 0000 TAD GBTEMP /GET UPDATED VALUE DCA GETPTR /USE IT IN POINTER TAD ["H&37] /GET JMS I [P7CH] /PRINT IT TAD [" &177] /GET A JMS I [P7CH] /PRINT IT TAD ["H&37] /GET JMS I [P7CH] /PRINT IT JMP GETINPUT /KEEP GOING / COMES HERE IF BACKSPACING ON HARD-COPY TERMINAL. HARDRUB,TAD ("\&177) /GET DELIMITER JMS I [P7CH] /PRINT IT RUBAGN, NL7777 /BACKUP TAD GETPTR /GET THE POINTER DCA GBTEMP /SAVE UPDATED VALUE TAD GBTEMP /GET IT BACK TAD (-CHRBUFF) /COMPARE TO LOWER LIMIT SPA CLA /SKIP IF OK JMP RUBDONE /JUMP IF TOO FAR TAD GBTEMP /GET THE NEW VALUE DCA GETPTR /STORE IT TAD I GETPTR /GET THE OLD CHARACTER JMS I [P7CH] /PRINT IT JMS I [INPUT] /GET FURTHER INPUT HERE JMS I (GESSUB) /CHECK IF A RUBTBL-1 /BACKSPACING CHARACTER RUBDONE,DCA GBTEMP /STORE LATEST OR TAD ("\&177) /GET TRAILING DELIMITER JMS I [P7CH] /PRINT IT TAD GBTEMP /GET THE LATEST (OR ) DCA INCHAR /APPEAR TO HAVE INPUT JMP GOTINPUT /GO USE IT THERE GBTEMP, .-. /TEMPORARY GMSBUF, .-. /HOLDS MESSAGE POINTER FOR VIEW CHRBUFF= . CHRBUFF,ZBLOCK 6 /6 CHARS IN BUFFER CHRBEND,0 /END OF BUFFER PAGE /COMMAND TABLE SEARCH ROUTINE GESSUB, .-. /COMMAND TABLE SEARCH ROUTINE CLA /CLEAN UP TAD I GESSUB /GET THE INLINE POINTER DCA GCTEMP /STASH IT ISZ GESSUB /BUMP PAST POINTER GCMLUP, ISZ GCTEMP /BUMP TO NEXT TAD I GCTEMP /GET AN ENTRY ISZ GCTEMP /BUMP TO NEXT SNA /END OF TABLE? JMP GCMEND /YES, FORGET IT TAD INCHAR /COMPARE TO LATEST SZA CLA /SKIP IF IT MATCHES JMP GCMLUP /JUMP IF NOT TAD I GCTEMP /GET THE ADDRESS DCA GCTEMP /STASH IT JMP I GCTEMP /GO THERE GCMEND, TAD INCHAR /GET THE CHARACTER BACK JMP I GESSUB /RETURN GCTEMP, .-. /TEMPORARY /SPECIAL CHARACTER TABLE CHTBL, -"I!300;GOTHT / -33; GOTESC / -176; GOTESC /176 -175; GOTESC /175 -"U!300;DELETL /<^U> -"M!300;GOTCR / -"J!300;LFVIEW / -137; BACKSP / -"H!300;BACKSP / -177; BACKSP / /SPECIAL RUBOUT CHARACTER TABLE RUBTBL, -177; RUBAGN / -137; RUBAGN / -"H!300;RUBAGN / / GET A DIGIT ROUTINE. GETDIGI,.-. /GET A DIGIT ROUTINE JMS ENDTEST /TEST IF A DELIMITER JMP I GETDIGIT /RETURN IF SO JMS GETCHR /GET A CHARACTER DCA ENDTEST /STORE CHARATER TEMPORARY TAD ENDTEST /GET IT BACK TAD (-"-!200) /SUBTRACT MINUS SIGN SZA CLA /SKIP IF ZERO JMP .+3 /ELSE JUMP AHEAD TAD ENDTEST /GET BACK CHARACTER JMP GEDIEX /BUMP POINTER AND EXIT TAD ENDTEST /GET CHARACTER TAD (-"8!200-2) /ADD ON UPPER LIMIT CLL /CLEAR LINK FOR TEST TAD ("8+2-"0) /ADD ON RANGE SNL /SKIP IF VALID JMP BADDIGIT /JUMP IF NOT ISZ GETDIGIT /TAKE SKIP RETURN GEDIEX, ISZ GETPTR /BUMP TO NEXT CHARACTER SKP /DON'T SET BAD VALUE BADDIGI,NL7777 /INDICATE BAD DIGIT JMP I GETDIGIT /RETURN ENDTEST,.-. /SUBROUTINE HEADER CLA /CLEAN UP TAD I GETPTR /GET THE CHARACTER SZA CLA /IF ZERO THEN SKIP AND RETURN JMP .+2 /ELSE JUMP AHEAD JMP I ENDTEST /RETURN ISZ ENDTEST /TAKE SKIP RETURN JMP I ENDTEST /THEN RETURN / GET A CHARACTER FROM INPUT BUFFER ROUTINE. GETCHR, .-. /GET A CHARACTER ROUTINE SKP CLA /CLEAN UP AND DON'T DO IT YET GETCAGN,ISZ GETPTR /BUMP TO NEXT TAD I GETPTR /GET A CHARACTER TAD (-"/!200) /COMPARE TO "/" SNA /SKIP IF OTHER JMP I GETCHR /RETURN ZERO TAD [-" +"/] /COMPARE TO SNA /SKIP IF DIFFERENT JMP GETCAGN /ELSE TOSS IT TAD (-140+" -200) /COMPARE TO LOWER-CASE LIMIT SPA /SKIP IF LOWER-CASE TAD [40] /DON'T FOLD UPPER-CASE TAD [100] /RESTORE THE CHARACTER JMP I GETCHR /RETURN PAGE / SUPPORT ROUTINES. / GETS ONE CHARACTER FROM KEYBOARD OR FILE AND RETURNS IT IN INPUT, .-. /INPUT ROUTINE INPUTAG,JMS CHKUP /CHECK FOR INPUT TAD TSWITCH /GET SWITCHES SZA CLA /IF ZERO THEN SKIP JMP INPKEY /ELSE GET INPUT FROM KEYBOARD JMS I (GIVCHR) /GET CHARACTER FROM FILE DCA INCHAR /STORE CHARACTER INPKEY, TAD INCHAR /WAS THERE ANY? SNA /SKIP IF SO JMP INPUTAG /ELSE WAIT FOR IT JMP I INPUT /RETURN TSWITCH,.-. /SWITCH TO USE KEYBOARD CHKUP, .-. /CHECK FOR <^P>, <^C>, ETC. JMS CTLCTST /TEST FOR <^C>, ETC. SZA /SKIP IF NOTHING THERE TAD (-"Q!300) /ELSE COMPARE TO <^Q> SNA /SKIP IF SOMETHING ELSE JMP CHKCLR /IGNORE <^Q> IAC /TAD (-"P+"Q)/IS IT <^P>? SNA /SKIP IF NOT JMP PHIT /JUMP IF SO TAD (-"R+"P) /IS IT <^R>? SNA /SKIP IF NOT JMP RHIT /JUMP IF SO TAD [-"S+"R] /IS IT <^S>? SZA CLA /SKIP IF SO JMP I CHKUP /RETURN IF NOT JMS CTLCTST /WAIT FOR <^Q> TAD (-"Q!300) /IS IT <^Q>? SZA CLA /SKIP IF SO JMP .-3 /GO BACK IF NOT CHKCLR, DCA INCHAR /CLEAR INPUT BUFFER JMP I CHKUP /RETURN CTLCTST,.-. /CHECK FOR <^C>, ETC. CLA /CLEAN UP CHKKSF, KSFIOT /**** CONSOLE **** CIF MCS+10 CHKJMP, JMP I CTLCTST /**** CONSOLE **** JMS INCON CHKKRS, KRSIOT/OR KRBIOT /**** CONSOLE **** JMP I CTLCTST AND [177] /JUST SEVEN BITS DCA INCHAR /SAVE IT NL7775 /-3 TAD INCHAR /COMPARE TO LATEST SNA /SKIP IF NOT <^C> ISZ I (SCRSIZE) /ELSE SET SOFT INDICATOR SPA SNA CLA /SKIP IF <^D> OR HIGHER JMP I [SBOOT] /ELSE GO SAVE LAST BUFFER AND LEAVE CHKKCC, KCCIOT/OR 0000 /**** CONSOLE **** 0000 TAD INCHAR /GET THE CHARACTER JMP I CTLCTST /RETURN /OUTPUTS A CHARACTER WITH KEYBOARD CHECKING P7CH, .-. /SEVEN-BIT OUTPUT ROUTINE DCA P7TEMP /SAVE PASSED VALUE P7AGN, JMS CHKUP /CHECK FOR <^C>, ETC. TAD P7TEMP /GET THE CHARACTER JMS P7OUT /TRY TO OUTPUT IT JMP P7AGN /CHECK INPUT WHILE WAITING JMS CHKUP /CHECK FOR <^C>, ETC. JMP I P7CH /RETURN /OUTPUTS A CHARACTER P7OUT, .-. /SEVEN BIT I/O ROUTINE P7TSF, TSFIOT /**** CONSOLE **** CIF MCS+10 P7JMP, JMP I P7OUT /**** CONSOLE **** JMS OUTCON P7TLS, TLSIOT /**** CONSOLE **** JMP I P7OUT CLA!400 /CLEAN UP ISZ P7OUT /BUMP RETURN ADDRESS JMP I P7OUT /RETURN / COMES HERE IF <^P> HIT. PHIT, TAD ["^&177] /GET AN "^" JMS P7OUT /PRINT IT JMP .-1 /WAIT FOR IT TAD ("P&177) /GET A "P" JMS P7OUT /PRINT IT JMP .-1 /WAIT FOR IT JMP I [SBOOT] /RESTART / COMES HERE IF <^R> HIT. RHIT, TAD ["^&177] /GET AN "^" JMS P7OUT /PRINT IT JMP .-1 /WAIT FOR IT TAD ("R&177) /GET A "P" JMS P7OUT /PRINT IT JMP .-1 /WAIT FOR IT JMP I [SBOOT] /RESTART CRLF, .-. /, ROUTINE CLA /CLEAN UP FOR DIRTY CALLERS TAD ["M&37] /GET A JMS I [P7CH] /GO PRINT IT TAD ("J&37) /GET A JMS I [P7CH] /GO PRINT IT JMP I CRLF /RETURN ESCRLF, .-. / SWITCH TEST ROUTINE CLA /CLEAN UP JUST IN CASE TAD ESCAPSW /GET INDICATOR SMA CLA /SKIP IF SET TO INITIAL VALUE JMP I ESCRLF /RETURN IF SET TO SECOND VALUE OR NOT SET AT ALL NL2000 /SET SECOND VALUE DCA ESCAPSW /STORE NEW INDICATOR FOR NEXT TIME JMS I [CRLF] /DO A , NOW JMP I ESCRLF /RETURN / ROTATE THREE LEFT ROUTINE. RTL3, .-. /ROTATE THREE LEFT CLL RTL;RAL /MOVE THREE TO THE LEFT JMP I RTL3 /RETURN / OCTAL PRINTOUT ROUTINE. PRTOCT, .-. /OCTAL PRINT ROUTINE DCA LENSET /SAVE PASSED VALUE TAD (-4) /SETUP THE DCA VERCHK /DIGIT COUNT OCTLUP, TAD LENSET /GET THE VALUE JMS I [RTL3] /MOVE UP ONE DIGIT DCA LENSET /STORE BACK TAD LENSET /GET IT AGAIN RAL /ADJUST LATEST TO LOW-ORDER AND [7] /JUST LATEST DIGIT TAD ["0&177] /MAKE IT ASCII JMS I [P7CH] /PRINT IT ISZ VERCHK /DONE YET? JMP OCTLUP /NO, KEEP GOING JMP I PRTOCT /YES, RETURN P7TEMP, .-. /TEMPORARY FOR OUTPUT ESCAPSW,.-. /ESCAPE SWITCH LENSET, .-. /STORAGE FOR OCTAL PRINT NUMBER VERCHK, .-. /COUNTER FOR OCTAL PRINT ROUTIN PAGE / MESSAGE PRINTING ROUTINE WITH SPECIAL CONSIDERATION. ESCRIBE,.-. /SCRIBE WITH ROUTINE JMS I [ESCRLF] /CHECK IF , NEEDED HERE TAD ESCRIBE /GET OUR CALLER DCA SCRIBE /MAKE IT THEIRS SKP /DON'T EXECUTE HEADER! / MESSAGE PRINTING ROUTINE. SCRIBE, .-. /MESSAGE PRINT ROUTINE DCA I (GMSFLG) /STORE IN FLAG FOR LFVIEW TAD I SCRIBE /GET MESSAGE POINTER DCA SCRPTR /STASH IT TAD SCRPTR /GET BACK MESSAGE DCA I (GMSPTR) /STORE IT ISZ SCRIBE /BUMP PAST ARGUMENT TAD (140) /INITIALIZE TO LOWER-CASE CASZP1, DCA SCRCASE /**** /U **** CLA!400 SCRLUP, CDF MESFLD /GET THE MESSAGE FIELD TAD I SCRPTR /GET LEFT HALF-WORD DCA SCRTMP /STORE IT HERE IN OUR FIELD TAD SCRTMP /GET THE WORD BACK RTR;RTR;RTR /MOVE OVER CDF CODFLD /MAKE SURE WE ARE IN OUR FIELD JMS SCRPRNT /PRINT IT TAD SCRTMP /GET RIGHT HALF-WORD JMS SCRPRNT /PRINT IT ISZ SCRPTR /BUMP TO NEXT PAIR JMP SCRLUP /KEEP GOING SCRPRNT,.-. /CHARACTER PRINT ROUTINE AND [77] /JUST SIX-BIT SNA /END OF MESSAGE? JMP I SCRIBE /YES, RETURN TO ORIGINAL CALLER DCA SCRCHAR /NO, SAVE FOR NOW TAD SCRCHAR /GET IT BACK TAD (-"%!200) /IS IT "%"? SNA /SKIP IF NOT JMP SCRCRLF /JUMP IF IT MATCHES TAD [-"^+100+"%] /IS IT "^" SNA CLA /SKIP IF NOT JMP SCRFLIP /JUMP IF IT MATCHES TAD SCRCHAR /GET THE CHARACTER AND [40] /DOES CASE MATTER? SNA CLA /SKIP IF NOT TAD SCRCASE /ELSE GET PREVAILING CASE TAD SCRCHAR /GET THE CHARACTER JMS I [P7CH] /PRINT THE CHARACTER JMP I SCRPRNT /RETURN SCRCRLF,JMS I [CRLF] /DO A , JMP I SCRPRNT /RETURN SCRFLIP,TAD SCRCASE /GET CURRENT CASE CIA /INVERT IT TAD (140+100) /ADD SUM OF POSSIBLE VALUES CASZP2, DCA SCRCASE /**** /U **** CLA!400 JMP I SCRPRNT /RETURN SCRCAS, .-. /HOLDS CASE SCRPTR, .-. /POINTER TO MESSAGE SCRCHA, .-. /THE CHARACTER SCRTMP, .-. /TEMPORARY STORAGE PAGE /SUBROUTINE TO INPUT CHARACTERS FROM A PQS FILE GIVCHR,.-. /SUBROUTINE RETURN JMP I GTRIM /JMP TO CO ROUTINE GTRIM, GIVEOF /END OF FILE AND (77) /MASK LOWER BITS SNA /SKIP ON NONZERO CHAR JMP GNXWRD /GET NEXT WORD IF A ZERO DCA GTEMP /STORE CHARACTER TAD GTEMP /GET IT BACK TAD (-40) /GET A BLANK SNA CLA /IF NON ZERO THEN SKIP JMP I GTRIM /ELSE GET NEXT CHARACTER TAD GTEMP /GET BACK CHARACTER TAD (-SEPAR) /IS IT A TAB? SZA CLA /IF YES THE SKIP JMP .+3 /ELSE JUMP AHEAD TAD ["M&37] /GET CARRIAGE RETURN JMP I GIVCHR /RETURN TAD GTEMP /GET BACK CHARACTER TAD (40) /CONVERT TO ASCII CHARACTER AND (77) /MASK OFF LOW BITS TAD (40) /ADD BACK 40 JMP I GIVCHR /RETURN GETMOR, TAD I GPNTR /GET THE WORD IN THE BUFFER SNA /CHECK FOR END OF FILE (0) JMP GIVEOF /END OF FILE GET ANOTHER BSW /GET CHARACTER INTO LOW ORDER BITS ON PDP8/E JMS GTRIM /GO RETURN 8 BIT ASCII CHARACTER TAD I GPNTR /GET SECOND CHARACTER IN LOW ORDER BITS JMS GTRIM /GO RETURN 8 BIT ASCII CHARACTER GETMR2, ISZ GPNTR /MOVE TO NEXT WORD TAD GPNTR /GET WORD ADDRESS TAD (-BUFF-200 /HAVE WE GONE THROUGH GSYSIO, SZA CLA /THE BUFFER JMP GETMOR /NO,GET MORE CHARACTERS GEOB, JMS I GSYSIO /YES, CALL I/O ROUTINES FOR ANOTHER BLOCK GBUFF, BUFF /BUFFER LOCATION GFUN, 1^100 /READ 1 BLOCK INTO FIELD 0 GBLK, .-. /BEGIN BLOCK # ISZ GBLK /NEXT BLOCK TAD GBUFF /GET BUFFER LOCATION DCA GPNTR /PUT INTO POINTER JMP GETMOR /GO GET MORE GIVEOF, ISZ FILEPNT /INCR FILE POINT TAD I FILEPNT /GET THE FILE AND (7770 /MASK HIGH 9 BITS SNA JMP I (7600) /BOOTSTRAP DCA GBLK TAD I FILEPNT AND (7) TAD (1^100) DCA GFUN JMP GEOB GNXWRD, TAD (GETMR2) /GET ADDRESS FOR OBTAINING NEW WORD DCA GTRIM /STORE INTO CROUTINE ARGUMENT TAD ["M&37] /GET CARRIAGE RETURN JMP I GIVCHR /RETURN GPNTR, .-. /TEMPORARY LOCATION GTEMP, .-. /TEMPORARY PAGE /THIS IS THE BUFFER WHERE ALL MESSAGES ARE STORED MSERRO, TEXT /%^ERROR IN NUMBER! TRY AGAIN/;0 PAGE 35 XLIST OFF IFZERO EAE < XLIST ON /EAE SIMULATION FOR THE PDP 8/E /MODE A AND B OPERATION /THE FOLLOWING FUNCTIONS ARE IMPLEMENTED /SWAB,SWBA,MUY,DVI,DAD,DCM,SHL,SHR,ROTL,ROTR /SWITCH FROM MODE A TO MODE B XSWAB, .-. /SUBROUTINE HEADER CLA /CLEAN UP TAD (TAD I XDCM) /GET THE INDIRECT INSTRUCTION SWBAENT,DCA XMMODE /STORE IN MODE WORD TAD XMMODE /GET MUL WORD MODE DCA XDMODE /STORE IN DIV WORD MODE JMP I XSWAB /RETURN TO CALLER /SWITCH FROM MODE B TO MODE A XSWBA, .-. /SUBROUTINE HEADER CLA /CLEAN UP TAD XSWBA /GET RETURN ADDRESS DCA XSWAB /STORE THERE TAD (TAD XDCM) /GET THE GET INSTRUCTION JMP SWBAENT /FINISH THERE XMUL, .-. /MULTIPLY SUBROUTINE CLA CLL /CLEAN UP TAD (-15) /SET UP DCA ROTL /USE ROTL AS STEP COUNT TAD I XMUL /GET ARGUMENT DCA XDCM /STORE TEMPORARILY XMROT, JMS ROTR /ROTATE RIGHT ISZ ROTL /COUNT STEPS(INIT STPCNT=-13 SKP JMP XMULFIN /FINISH THERE SNL /LOW ORDER BIT=1? JMP XMROT /NO,ROTATE AGAIN CLL /YES,GET RID OF LOW BIT XMMODE, TAD XDCM /***TAD I XDCM*** JMP XMROT /GET NEXT BIT OF MULTIPLICAND XMULFIN,ISZ XMUL /GET TO NEXT WORD JMP I XMUL /GET BACK TO CALLER ROTR, .-. /ROTATION SUBROUTINE RAR /ROT AC SWP /GET MQ RAR /ROTATE IT SWP /FINISH ROT RIGHT JMP I ROTR /WITH LOW BIT IN LINK ROTL, .-. /ROT LEFT SUBROUTINE SWP /GET MQ RAL /ROTATE LEFT SWP /GET BACK AC RAL /ROTATE AGAIN JMP I ROTL /GET BACK TO CALLER XDVI, .-. /EAE SIMULATED DIVIDE DCA AC /STORE HIGH DIVIDEND IN AC MQA /GET MQ DCA MQ /STORE IN MQ TAD I XDVI /GET ARGUMENT DCA XDCM /STORE THERE XDMODE, TAD XDCM /***TAD I XDCM*** CIA /NEGATE IT DCA MDVSOR /STORE IT /NOW CHECK FOR OVERFLOW TAD AC /GET BACK AC STL CMA /SET LINK AND COMPLEMENT AC TAD I XDVI /ADD THE DIVISOR SNL CLA /IF NO OVERFLOW THEN SKIP SKP /ELSE SKIP AGAIN JMP XDVOUT /LEAVE ROUTINE WITH LINK SET IF OVERFLOW /IF THERE IS NO OVERFLOW START DIVISION ALGORITHM TAD (-14) /GET -12 DCA SFTCNTR /STORE AS SHIFT COUNTER XDIVLP, TAD MQ /GET THE MQ CLL RAL /SHIFT 25 PLACES DCA MQ /TO THE TAD AC /LEFT RAL DCA AC TAD AC /GET BACK HIGH PART OF DIVIDEND TAD MDVSOR /ADD -THE DIVISOR SZL /IF LINK IS ZERO, RESTORE BY LEAVING IT ALONE DCA AC /ELSE UPDATE THE DIVIDEND SZL CLA /IF LINK WAS ZERO DON'T SET BIT IN LOW MQ ISZ MQ /ELSE DO SET THE BIT ISZ SFTCNTR /SKIP IF DONE TWELVE TIMES JMP XDIVLP /ELSE GO BACK AND DO MORE TAD MQ MQL /PUT QUOTIENT IN REAL MQ TAD AC /GET BACK REAL AC XDVOUT, ISZ XDVI /TAKE SKIP RETURN JMP I XDVI /AND RETURN AC, .-. /HOLDS AC VALUE MQ, .-. /HOLDS MQ VALUE MDVSOR, .-. /HOLDS MINUS THE DIVISOR SFTCNTR,.-. /HOLDS STEP COUNTER VALUE XDCM, .-. /DOUBLE PREC. COMPL. SWP CLL CMA IAC /CLEAR LINK AND NEGATE SWP CMA /COMPLEMENT SZL /IF PREVIOUS CIA DIDN'T SET LINK THEN SKIP IAC /ELSE ADD ONE JMP I XDCM /RETURN TO CALLER XDAD, .-. /DOUBLE PRECISION ADD ROUTINE DCA XDCM /STORE TEMPORARILY TAD I XDAD /GET POINTER TO ARGUMENT DCA XDVI /STORE TEMPORARILY MQA /GET LOW ORDER WORD CLL /CLEAR LINK FOR 13 BIT ARITH TAD I XDVI /ADD LOW ORDER WORDS TOGETHER ISZ XDVI /POINT TO NEXT WORD MQL /PUT RESULTS IN TAD XDCM /GET BACK HIGH ORDER WORD SZL /IF THE LINK WAS NOT SET THEN SKIP IAC /ELSE INCREMENT BY 1 TAD I XDVI /ADD HIGH ORDER ARGUMENT ISZ XDAD /SET PROPER RETURN JMP I XDAD /RETURN PAGE XSHL, .-. /SHIFT LEFT ROUTINE DCA SHLTM1 /TEMP FOR HIGH BITS TAD (NOP) /GET NOP DCA XSHRE3 /STORE OVER (JMS ROTR) INSTRUCTION TAD (JMS I (ROTL))/GET THE ROTATE LEFT DCA XSHRE2 /STORE IT IN LINE XSHRE1, TAD I XSHL CMA DCA XSHR TAD SHLTM1 XSHRE3, JMS I (ROTR) CLL XSHRE2, JMS I (ROTL) ISZ XSHR JMP XSHRE3 ISZ XSHL JMP I XSHL XSHR, .-. /SHIFT RIGHT ROUTINE DCA SHLTM1 TAD XSHR DCA XSHL TAD (NOP) DCA XSHRE2 TAD (JMS I (ROTR)) /RESTORE THE ROTATE RIGHT INSTRUCTION DCA XSHRE3 /FOR USE BY THIS SUBROUTINE JMP XSHRE1 /ENTER THE LEFT SUBROUTINE AND CONTINUE SHLTM1, .-. /SHIFT LEFT TEMPORARY XLIST OFF > XLIST ON